*! VERSION 1.0 14/6/98, for STATA version 5.0
*! WARNING!  This program is in testing only, and does not incorporate full
*! data protection features
program def zb_qrm   /* Analyse des questions a reponses multiples */
version 5.0
qui disp "4 parameters" _n _col(5)  "1: Root name of original variables" /*
                */  _n _col(5)  "2: Number of orig variables" /*
                */  _n _col(5)  "3: Root name of the new variables" /*
                */  _n _col(5)  "4: Number of codes" _n(2)



/*      ----------- Program ---------------------
4 parameters
   1: Root name of original variables
   2: Number of orig variables
   3: Root name of the new variables
   4: Number of codes

e.g.: four orig variables prof1 prof2 prof3 prof4 with 10 possible codes
      the new variables start with "prf"
      calling zb_qrm :  zb_qrm prof 4 prf 10

      creates 11 variables :
                   prf    : combination variable - string-variable
                   prf1   : containing code 1  in 1 / 0 code
                   prf2   : containing code 2  in 1 / 0 code
           till    prf10  : containing code 10 in 1 / 0 code   */


disp "Racine var.exist.:  $_1" _column(28) " / Nombre de var. : $_2"
disp "Racine nouv. var.:  $_3" _column(28) " / Nombre de codes: $_4"
quietly  {
#delimit ;
confirm ex string $_1 ; confirm integer number $_2 ;
confirm ex string $_3 ; confirm integer number $_4 ;
local Rve "$_1"       ; local Nve "$_2";
local Rnv "$_3"       ; local Nnv "$_4";
#delimit cr

local inew = 1
while $_inew <= $_Nnv {
  local Vnew  "$_Rnv$_inew"
  gen byte $_Vnew = 0
  format $_Vnew %1.0f
  local iold = 1
  while $_iold <= $_Nve {
     local Vold="$_Rve$_iold"
     /* disp "$_Vnew  -- $_Vold -- $_inew" */
     replace $_Vnew = $_Vnew | ($_Vold == $_inew)
     local iold = $_iold + 1
  }
  local inew= $_inew + 1
}

tempvar xv
gen str1 $_xv=" "
gen str1 `Rnv' = ""
local Vold = "$_Rve" + "1"
local labname : value label $_Vold
local inew = 1
noisily disp _n "Varname" _col(13) "Abs.  Pourcentage du total"
noisily disp    "-------" _col(13) "----  --------------------"
while $_inew <= $_Nnv {
  local Vnew  "$_Rnv$_inew"
  capt local Vnlab :  label $_labname $_inew
  label var $_Vnew "$_Vnlab"
  quietly sum $_Vnew if $_Vnew == 1
  noisily disp "$_Vnew" _col(10) %5.0f _result(1)   /*
             */           _col(18) %5.1f (_result(1)*100/_N) "%" _col(30) "$_Vnlab"
  quietly replace $_xv="."
  quietly replace $_xv="1" if ($_Vnew==1)
  quietly replace $_Rnv = $_Rnv + $_xv
  local inew= $_inew + 1
}}
noisily tab `Rnv'

end /* end zb_qrm */