source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPDEM.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1QAPDEM ;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 ;
7EN 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 ;
11DATA 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 ;
24EXIT Q ;kill variables in calling program
Note: See TracBrowser for help on using the repository browser.