| 1 | QAPDEM ;557/THM-ADD SURVEY DEMOGRAPHICS [ 06/19/95  1:44 PM ]
 | 
|---|
| 2 |  ;;2.0;Survey Generator;;Jun 20, 1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;called by QAPEDIT
 | 
|---|
| 5 |  Q  ;enter properly
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | EN K DIC,DIE,DR,Y,STOP
 | 
|---|
| 8 |  W @IOF,! S QAPHDR="Subject: "_SUBJ X QAPBAR
 | 
|---|
| 9 |  S QAPHDR="Add/Edit Demographic Questions" X QAPBAR
 | 
|---|
| 10 |  ;
 | 
|---|
| 11 | DATA I $O(^QA(748.3,"B",SURVEY,0))]"" W *7,!!,"This survey has data associated with it and the demographic content",!,"may not be changed.",!!,"Press RETURN  " R ANS:DTIME S:'$T STOP=1 G EXIT
 | 
|---|
| 12 |  W !
 | 
|---|
| 13 |  S X=SUBJ,(DIE,DIC)="^QA(748,",DIC(0)="QLM" D ^DIC S DA=+Y G:Y<0!($D(DTOUT)) EXIT
 | 
|---|
| 14 |  S DR=".01;1;I X=""s"" S Y=""@1"";I X=""p"" S Y=""@2"";S Y=""@99"";@1;3;S Y=""@99"";@2;2;@99;4",DR(3,748.33)=".01:1"
 | 
|---|
| 15 |  ;add to subfile
 | 
|---|
| 16 |  W ! S DA(1)=+Y,DIC=DIC_DA(1)_",1,",DIC(0)="QAELM",DIC("P")=$P(^DD(748,3,0),U,2) D ^DIC I Y=-1 K DIC,DA G EXIT
 | 
|---|
| 17 |  S DIE=DIC S DA=+Y K DIC W !! D ^DIE G:$D(Y) EN I $D(DTOUT) S STOP=1 G EXIT
 | 
|---|
| 18 |  X CLEOP K FIND F DEMQUES=0:0 S DEMQUES=$O(^QA(748,SURVEY,1,DEMQUES)) Q:DEMQUES=""!(+DEMQUES=0)!($D(STOP))  S DEMDTA=^QA(748,SURVEY,1,DEMQUES,0) K STOP DO  Q:$D(STOP)
 | 
|---|
| 19 |  .I $P(DEMDTA,U,2)="p",$P(DEMDTA,U,3)="" W !,*7,"You have entered a pointer type in question ",DEMQUES," and",!,"have not specified any file.",! S FIND=1
 | 
|---|
| 20 |  .I $P(DEMDTA,U,2)="s",$O(^QA(748,SURVEY,1,DEMQUES,0))="" W !,*7,"You have entered a 'set of codes' type in question ",DEMQUES,!,"and not entered any codes.",! S FIND=1
 | 
|---|
| 21 |  I $D(FIND) W !,"Press RETURN  " R ANS:DTIME I '$T S STOP=1 Q
 | 
|---|
| 22 |  I '$D(STOP) G EN
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 | EXIT Q  ;kill variables in calling program
 | 
|---|