| 1 | QAPEDIT ;557/THM-CREATE/EDIT/MAINTAIN A SURVEY [ 05/18/95 7:03 AM ]
|
|---|
| 2 | ;;2.0;Survey Generator;;Jun 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | D SCREEN^QAPUTIL
|
|---|
| 5 | EN W @IOF,! S QAPHDR="Create/Edit/Maintain a Survey" X QAPBAR
|
|---|
| 6 | W ! S VERS=$P($T(+2),";;",2),VERS=$P(VERS,";",1) W ?68,"v "_VERS
|
|---|
| 7 | K DIR,OUT,DIC,STOP,Y W !! S DIR("?")="^D HELP2^QAPUTIL2"
|
|---|
| 8 | S DIR("A")="Selection"
|
|---|
| 9 | S DIR(0)="SO^C:Create a New Survey;B:Edit Basic Survey data;D:Add or Edit Demographic Survey Fields;E:Edit All Questions Sequentially;I:Add/Edit Individual Questions;P:Print a Survey;Q:Quit (also uparrow, or <RETURN>)"
|
|---|
| 10 | D ^DIR G:$D(DIRUT)!(X="") EXIT^QAPUTIL S ACTION=X,ACTION=$TR(ACTION,"cbdeipq","CBDEIPQ")
|
|---|
| 11 | I ACTION="C" D DV^QAPADD G:$D(STOP) EXIT^QAPUTIL G EN
|
|---|
| 12 | I ACTION="P" S CREATE=1 D ^QAPPT0 K CREATE G:$D(STOP) EXIT^QAPUTIL G EN
|
|---|
| 13 | I ACTION="Q" G EXIT^QAPUTIL
|
|---|
| 14 | ;
|
|---|
| 15 | BASIC W @IOF,! S QAPHDR="Survey Name Selection" X QAPBAR
|
|---|
| 16 | S DIC("S")="I $P(^(0),U,5)=DUZ!($D(^XUSEC(""QAP MANAGER"",DUZ)))!($D(^QA(748,""AB"",DUZ,+Y)))"
|
|---|
| 17 | S DIC="^QA(748,",DIC(0)="AEQMZ",DIC("A")="Survey NAME: " D ^DIC G:X=""!(X[U) EXIT^QAPUTIL S SURVEY=+Y,SUBJ=Y(0,0) K DIC("S")
|
|---|
| 18 | I ACTION="D" D EN^QAPDEM G:$D(DTOUT) EXIT^QAPUTIL G EN
|
|---|
| 19 | I ACTION="B" K STOP,OUT S DA=SURVEY,DIC="^QA(748,",DIC(0)="EQM",DR=".01;.015;.03;.04;4;.05;.08;.1;5;1;2",DIE=DIC,QAPHDR="Survey Name: "_SUBJ
|
|---|
| 20 | I ACTION="B" W @IOF,! X QAPBAR S QAPHDR="Change Basic Data" X QAPBAR D ^DIE G:$D(DTOUT) EXIT^QAPUTIL DO G EN
|
|---|
| 21 | .W !! I $O(^QA(748,DA,2,0))="" W !,*7,"The survey description was not entered !",! H 2
|
|---|
| 22 | .I $O(^QA(748,DA,4,0))="" W !,*7,"The survey instructions were not entered !",! H 2
|
|---|
| 23 | S SUBJ=$P(^QA(748,SURVEY,0),U) ;reset for name corrections
|
|---|
| 24 | G ^QAPEDIT1
|
|---|
