source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPSCRN1.m@ 1720

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1QAPSCRN1 ;557/THM-USER INPUT FOR SURVEYS, PART 2 [ 07/24/96 2:37 PM ]
2 ;;2.0;Survey Generator;**5**;Jun 20, 1995
3 Q
4 ;
5EN1 K NEWREC S:'$D(FILEDA) FILEDA=IFN S (DIC,DIE)="^QA(748.3,",DR="3///i;4///@",DA=FILEDA D ^DIE
6 K DUOUT,DTOUT,DSTOP,STOP,EDIT
7 I SVST'="s"!(+LQUES=0) S:$O(^QA(748.3,FILEDA,2,0))]"" EDIT=1 D ^QAPDEM1 K EDIT G:$D(STOP) QUIT
8 I $D(FSTOP),'$D(EDIT) W !!,"Demographics file error - response deleted !",!! H 3 S DA=FILEDA,DIK="^QA(748.3," D ^DIK G QUIT
9 ;
10KILL I $D(DSTOP),'$D(EDIT) W *7,!!,"Timed out ! - response deleted !",!!,*7 H 3 S:'$D(FILEDA) FILEDA=IFN S DA=FILEDA,DIK="^QA(748.3," D ^DIK G QUIT
11 G:$D(FSTOP)!($D(STOP)) SUSPND
12 W @IOF,! S QAPHDR=TITLE_" - Data Entry" X QAPBAR W !!
13 K DA,STOP S QAPOUT=0 S:'$D(QAPCNT) QAPCNT=0 S:'$D(CQUES) CQUES=0
14 F K WPNEWREC S DISP=$O(^QA(748.25,"E",SURVEY,DISP)) Q:(DISP="")!(QAPOUT=1)!($D(STOP)) F QUES=0:0 S QUES=$O(^QA(748.25,"E",SURVEY,DISP,QUES)) Q:QUES="" DO
15 .D OUT3 D:QAPOUT=1 ABORT S:QAPOUT=0&('$D(RESUME)) CQUES=DISP,QAPCNT=DISP K RESUME Q:QAPOUT=1
16 G:$D(STOP) QUIT
17 ;
18 S QLINE=$Y-1
19EDITA X CLEOP1 W !!,"Do you want to edit your answers" S %=2 D YN^DICN D:$D(DTOUT) ABORT G:$D(STOP) QUIT
20 I $D(%Y),%Y["?" W !!,"Enter Y to edit the answers or N to continue",!," and complete the survey." H 3 G EDITA
21 I %=1 D ^QAPEDI1,^%ZISC W @IOF,! X QAPBAR,CLEOP I $D(DSTOP)!($D(STOP)) G QUIT
22 ;
23COMPL K % S QLINE=3 X CLEOP1 I QAPOUT=0 W !,BLDON,"(Type ^ to edit answers)",BLDOFF,!!,"Is it Ok to register this survey as complete" S %=2 D YN^DICN D:$D(DTOUT) ABORT G:$D(STOP) QUIT
24 I $D(%Y),%Y["?" W !!,"Enter ^ edit your responses",!?6,"N to suspend/abort this response",!,?6,"Y to continue and register your survey as complete.",!!
25 I $D(%Y),%Y["?" W "If you declare this survey completed, you will not be",!,"allowed to make any further changes to it.",!
26 I $D(%Y),%Y["?" W !!,"Press RETURN " R ANS:DTIME D:'$T ABORT G:$D(STOP) QUIT G COMPL
27 I %=1 S DA=FILEDA,(DIC,DIE)="^QA(748.3,",DR="3////c" D ^DIE W !!,"Survey completed. " H 2 G QUIT
28 I %<1 G EDITA
29 I %=2 S QAPOUT=0 D ABORT I '$D(STOP) G:QAPOUT=0 COMPL
30 ;
31QUIT K WPNEWREC G EXIT^QAPUTIL
32 ;
33OUT3 I $O(^QA(748.25,SURVEY,1,QUES,4,0))]"" F I=0:0 S I=$O(^QA(748.25,SURVEY,1,QUES,4,I)) D:I=""!(+I=0) Q:I=""!(+I=0) S X=$P(^QA(748.25,SURVEY,1,QUES,4,I,0),U,1) W X,!
34 I $O(^QA(748.25,SURVEY,1,QUES,4,0))]"" W *7,!!,"Press RETURN " R ANS:DTIME G:'$T SUSPND W @IOF,! X QAPBAR W !!
35 W "Question ",DISP,":",!!
36 F I=0:0 S I=$O(^QA(748.25,SURVEY,1,QUES,2,I)) Q:I=""!(+I=0) S X=$P(^QA(748.25,SURVEY,1,QUES,2,I,0),U,1) W X,!
37 K X S QAPX=$P(^QA(748.25,SURVEY,1,QUES,1),U) D USINPT^QAPCHX:QAPX="m",QATF^QAPCHX:QAPX="t",QAYN^QAPCHX:QAPX="y",WP^QAPCHX:QAPX="w" Q:QAPOUT
38 W @IOF,! X QAPBAR W !!
39 Q
40 ;
41ABORT K DTOUT,DUOUT,STOP,% S:'$D(QAPCNT) QAPCNT=0 S:'$D(CQUES) CQUES=0
42 X CLEOP S QAPOUT=0 W !!,*7,"Do you wish to suspend this survey and continue later" S %=1 D YN^DICN G:$D(DTOUT) SUSPND
43 I $D(%Y),%Y["?" W !!,"Enter Y to suspend this survey",!?6,"^ to resume answer entry",!?6,"N to possibly abort this entry"
44 I $D(%Y),%Y["?" W !!,"If you suspend this survey you may finish it later or",!,"make any changes you wish, then complete the rest of it.",!!
45 I $D(%Y),%Y["?" W "If you abort your entry, your answers will be erased.",!,"A ^ will allow you to resume answer entry.",!!,"Press RETURN " R ANS:DTIME S:'$T DTOUT=1 G:'$T SUSPND G ABORT
46 I %<1 S RESUME=1 G ABORT1
47 ;
48SUSPND S:'$D(QAPCNT) QAPCNT=0 S:'$D(CQUES) CQUES=0
49 I $D(DTOUT)!(%=1) W:$D(DTOUT) !!,"Timed out.. Survey suspended." S (DIC,DIE)="^QA(748.3,",DA=FILEDA,DR="3////s;4////"_QAPCNT_";5////"_CQUES D ^DIE W !!,"Ok, see you later." H 2 S (QAPOUT,STOP)=1 Q
50 I %<1,'$D(DTOUT) S RESUME=1 G ABORT1
51 ;
52ABORT0 K DTOUT,DUOUT,STOP,%,%Y X CLEOP W !!,"Do you want to abort the survey entry" S %=2 D YN^DICN G:$D(DTOUT) SUSPND
53 I $D(%Y),%Y["?" W !!,"Enter Y to abort or N to continue. ",! H 3 G ABORT0
54 I %=1 W !!,*7,"If you abort now, all data entered so far will be erased.",!,"You must complete the survey for it to be counted.",!!,"Do you REALLY want to abort this survey" S %=2 D YN^DICN I $D(DUOUT) S QAPOUT=1 Q
55 I $D(%Y),%Y["?" W !!,"Enter Y to abort or N to continue. " H 3 X CLEOP G ABORT0
56 I $D(DTOUT) G SUSPND
57 I %'=1 S RESUME=1 G ABORT1
58 ;
59DEL I %=1 S DA=FILEDA,DIK="^QA(748.3," D ^DIK W *7,!!,">> Survey responses deleted! << " S STOP=1 H 3 Q
60 ;
61ABORT1 X CLEOP S QAPOUT=0 S:'$D(QUES) QUES=+LQUES S QUES=QUES-.001 X CLEOP W !!,"No action taken - Press RETURN to continue " R ANS:DTIME S QAPOUT=0 I '$T D ABORT I $D(STOP) Q
62 W @IOF,! X QAPBAR,CLEOP
63 Q
Note: See TracBrowser for help on using the repository browser.