QAPSCRN1 ;557/THM-USER INPUT FOR SURVEYS, PART 2 [ 07/24/96 2:37 PM ]
;;2.0;Survey Generator;**5**;Jun 20, 1995
Q
;
EN1 K NEWREC S:'$D(FILEDA) FILEDA=IFN S (DIC,DIE)="^QA(748.3,",DR="3///i;4///@",DA=FILEDA D ^DIE
K DUOUT,DTOUT,DSTOP,STOP,EDIT
I SVST'="s"!(+LQUES=0) S:$O(^QA(748.3,FILEDA,2,0))]"" EDIT=1 D ^QAPDEM1 K EDIT G:$D(STOP) QUIT
I $D(FSTOP),'$D(EDIT) W !!,"Demographics file error - response deleted !",!! H 3 S DA=FILEDA,DIK="^QA(748.3," D ^DIK G QUIT
;
KILL 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
G:$D(FSTOP)!($D(STOP)) SUSPND
W @IOF,! S QAPHDR=TITLE_" - Data Entry" X QAPBAR W !!
K DA,STOP S QAPOUT=0 S:'$D(QAPCNT) QAPCNT=0 S:'$D(CQUES) CQUES=0
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
.D OUT3 D:QAPOUT=1 ABORT S:QAPOUT=0&('$D(RESUME)) CQUES=DISP,QAPCNT=DISP K RESUME Q:QAPOUT=1
G:$D(STOP) QUIT
;
S QLINE=$Y-1
EDITA X CLEOP1 W !!,"Do you want to edit your answers" S %=2 D YN^DICN D:$D(DTOUT) ABORT G:$D(STOP) QUIT
I $D(%Y),%Y["?" W !!,"Enter Y to edit the answers or N to continue",!," and complete the survey." H 3 G EDITA
I %=1 D ^QAPEDI1,^%ZISC W @IOF,! X QAPBAR,CLEOP I $D(DSTOP)!($D(STOP)) G QUIT
;
COMPL 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
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.",!!
I $D(%Y),%Y["?" W "If you declare this survey completed, you will not be",!,"allowed to make any further changes to it.",!
I $D(%Y),%Y["?" W !!,"Press RETURN " R ANS:DTIME D:'$T ABORT G:$D(STOP) QUIT G COMPL
I %=1 S DA=FILEDA,(DIC,DIE)="^QA(748.3,",DR="3////c" D ^DIE W !!,"Survey completed. " H 2 G QUIT
I %<1 G EDITA
I %=2 S QAPOUT=0 D ABORT I '$D(STOP) G:QAPOUT=0 COMPL
;
QUIT K WPNEWREC G EXIT^QAPUTIL
;
OUT3 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,!
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 !!
W "Question ",DISP,":",!!
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,!
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
W @IOF,! X QAPBAR W !!
Q
;
ABORT K DTOUT,DUOUT,STOP,% S:'$D(QAPCNT) QAPCNT=0 S:'$D(CQUES) CQUES=0
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
I $D(%Y),%Y["?" W !!,"Enter Y to suspend this survey",!?6,"^ to resume answer entry",!?6,"N to possibly abort this entry"
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.",!!
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
I %<1 S RESUME=1 G ABORT1
;
SUSPND S:'$D(QAPCNT) QAPCNT=0 S:'$D(CQUES) CQUES=0
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
I %<1,'$D(DTOUT) S RESUME=1 G ABORT1
;
ABORT0 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
I $D(%Y),%Y["?" W !!,"Enter Y to abort or N to continue. ",! H 3 G ABORT0
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
I $D(%Y),%Y["?" W !!,"Enter Y to abort or N to continue. " H 3 X CLEOP G ABORT0
I $D(DTOUT) G SUSPND
I %'=1 S RESUME=1 G ABORT1
;
DEL I %=1 S DA=FILEDA,DIK="^QA(748.3," D ^DIK W *7,!!,">> Survey responses deleted! << " S STOP=1 H 3 Q
;
ABORT1 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
W @IOF,! X QAPBAR,CLEOP
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPSCRN1 4588 printed Nov 22, 2024@17:48:29 Page 2
QAPSCRN1 ;557/THM-USER INPUT FOR SURVEYS, PART 2 [ 07/24/96 2:37 PM ]
+1 ;;2.0;Survey Generator;**5**;Jun 20, 1995
+2 QUIT
+3 ;
EN1 KILL NEWREC
if '$DATA(FILEDA)
SET FILEDA=IFN
SET (DIC,DIE)="^QA(748.3,"
SET DR="3///i;4///@"
SET DA=FILEDA
DO ^DIE
+1 KILL DUOUT,DTOUT,DSTOP,STOP,EDIT
+2 IF SVST'="s"!(+LQUES=0)
if $ORDER(^QA(748.3,FILEDA,2,0))]""
SET EDIT=1
DO ^QAPDEM1
KILL EDIT
if $DATA(STOP)
GOTO QUIT
+3 IF $DATA(FSTOP)
IF '$DATA(EDIT)
WRITE !!,"Demographics file error - response deleted !",!!
HANG 3
SET DA=FILEDA
SET DIK="^QA(748.3,"
DO ^DIK
GOTO QUIT
+4 ;
KILL IF $DATA(DSTOP)
IF '$DATA(EDIT)
WRITE *7,!!,"Timed out ! - response deleted !",!!,*7
HANG 3
if '$DATA(FILEDA)
SET FILEDA=IFN
SET DA=FILEDA
SET DIK="^QA(748.3,"
DO ^DIK
GOTO QUIT
+1 if $DATA(FSTOP)!($DATA(STOP))
GOTO SUSPND
+2 WRITE @IOF,!
SET QAPHDR=TITLE_" - Data Entry"
XECUTE QAPBAR
WRITE !!
+3 KILL DA,STOP
SET QAPOUT=0
if '$DATA(QAPCNT)
SET QAPCNT=0
if '$DATA(CQUES)
SET CQUES=0
+4 FOR
KILL WPNEWREC
SET DISP=$ORDER(^QA(748.25,"E",SURVEY,DISP))
if (DISP="")!(QAPOUT=1)!($DATA(STOP))
QUIT
FOR QUES=0:0
SET QUES=$ORDER(^QA(748.25,"E",SURVEY,DISP,QUES))
if QUES=""
QUIT
Begin DoDot:1
+5 DO OUT3
if QAPOUT=1
DO ABORT
if QAPOUT=0&('$DATA(RESUME))
SET CQUES=DISP
SET QAPCNT=DISP
KILL RESUME
if QAPOUT=1
QUIT
End DoDot:1
+6 if $DATA(STOP)
GOTO QUIT
+7 ;
+8 SET QLINE=$Y-1
EDITA XECUTE CLEOP1
WRITE !!,"Do you want to edit your answers"
SET %=2
DO YN^DICN
if $DATA(DTOUT)
DO ABORT
if $DATA(STOP)
GOTO QUIT
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to edit the answers or N to continue",!," and complete the survey."
HANG 3
GOTO EDITA
+2 IF %=1
DO ^QAPEDI1
DO ^%ZISC
WRITE @IOF,!
XECUTE QAPBAR
XECUTE CLEOP
IF $DATA(DSTOP)!($DATA(STOP))
GOTO QUIT
+3 ;
COMPL KILL %
SET QLINE=3
XECUTE CLEOP1
IF QAPOUT=0
WRITE !,BLDON,"(Type ^ to edit answers)",BLDOFF,!!,"Is it Ok to register this survey as complete"
SET %=2
DO YN^DICN
if $DATA(DTOUT)
DO ABORT
if $DATA(STOP)
GOTO QUIT
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter ^ edit your responses",!?6,"N to suspend/abort this response",!,?6,"Y to continue and register your survey as complete.",!!
+2 IF $DATA(%Y)
IF %Y["?"
WRITE "If you declare this survey completed, you will not be",!,"allowed to make any further changes to it.",!
+3 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Press RETURN "
READ ANS:DTIME
if '$TEST
DO ABORT
if $DATA(STOP)
GOTO QUIT
GOTO COMPL
+4 IF %=1
SET DA=FILEDA
SET (DIC,DIE)="^QA(748.3,"
SET DR="3////c"
DO ^DIE
WRITE !!,"Survey completed. "
HANG 2
GOTO QUIT
+5 IF %<1
GOTO EDITA
+6 IF %=2
SET QAPOUT=0
DO ABORT
IF '$DATA(STOP)
if QAPOUT=0
GOTO COMPL
+7 ;
QUIT KILL WPNEWREC
GOTO EXIT^QAPUTIL
+1 ;
OUT3 IF $ORDER(^QA(748.25,SURVEY,1,QUES,4,0))]""
FOR I=0:0
SET I=$ORDER(^QA(748.25,SURVEY,1,QUES,4,I))
if I=""!(+I=0)
Begin DoDot:1
End DoDot:1
if I=""!(+I=0)
QUIT
SET X=$PIECE(^QA(748.25,SURVEY,1,QUES,4,I,0),U,1)
WRITE X,!
+1 IF $ORDER(^QA(748.25,SURVEY,1,QUES,4,0))]""
WRITE *7,!!,"Press RETURN "
READ ANS:DTIME
if '$TEST
GOTO SUSPND
WRITE @IOF,!
XECUTE QAPBAR
WRITE !!
+2 WRITE "Question ",DISP,":",!!
+3 FOR I=0:0
SET I=$ORDER(^QA(748.25,SURVEY,1,QUES,2,I))
if I=""!(+I=0)
QUIT
SET X=$PIECE(^QA(748.25,SURVEY,1,QUES,2,I,0),U,1)
WRITE X,!
+4 KILL X
SET QAPX=$PIECE(^QA(748.25,SURVEY,1,QUES,1),U)
if QAPX="m"
DO USINPT^QAPCHX
if QAPX="t"
DO QATF^QAPCHX
if QAPX="y"
DO QAYN^QAPCHX
if QAPX="w"
DO WP^QAPCHX
if QAPOUT
QUIT
+5 WRITE @IOF,!
XECUTE QAPBAR
WRITE !!
+6 QUIT
+7 ;
ABORT KILL DTOUT,DUOUT,STOP,%
if '$DATA(QAPCNT)
SET QAPCNT=0
if '$DATA(CQUES)
SET CQUES=0
+1 XECUTE CLEOP
SET QAPOUT=0
WRITE !!,*7,"Do you wish to suspend this survey and continue later"
SET %=1
DO YN^DICN
if $DATA(DTOUT)
GOTO SUSPND
+2 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to suspend this survey",!?6,"^ to resume answer entry",!?6,"N to possibly abort this entry"
+3 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"If you suspend this survey you may finish it later or",!,"make any changes you wish, then complete the rest of it.",!!
+4 IF $DATA(%Y)
IF %Y["?"
WRITE "If you abort your entry, your answers will be erased.",!,"A ^ will allow you to resume answer entry.",!!,"Press RETURN "
READ ANS:DTIME
if '$TEST
SET DTOUT=1
if '$TEST
GOTO SUSPND
GOTO ABORT
+5 IF %<1
SET RESUME=1
GOTO ABORT1
+6 ;
SUSPND if '$DATA(QAPCNT)
SET QAPCNT=0
if '$DATA(CQUES)
SET CQUES=0
+1 IF $DATA(DTOUT)!(%=1)
if $DATA(DTOUT)
WRITE !!,"Timed out.. Survey suspended."
SET (DIC,DIE)="^QA(748.3,"
SET DA=FILEDA
SET DR="3////s;4////"_QAPCNT_";5////"_CQUES
DO ^DIE
WRITE !!,"Ok, see you later."
HANG 2
SET (QAPOUT,STOP)=1
QUIT
+2 IF %<1
IF '$DATA(DTOUT)
SET RESUME=1
GOTO ABORT1
+3 ;
ABORT0 KILL DTOUT,DUOUT,STOP,%,%Y
XECUTE CLEOP
WRITE !!,"Do you want to abort the survey entry"
SET %=2
DO YN^DICN
if $DATA(DTOUT)
GOTO SUSPND
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to abort or N to continue. ",!
HANG 3
GOTO ABORT0
+2 IF %=1
WRITE !!,*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"
SET %=2
DO YN^DICN
IF $DATA(DUOUT)
SET QAPOUT=1
QUIT
+3 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to abort or N to continue. "
HANG 3
XECUTE CLEOP
GOTO ABORT0
+4 IF $DATA(DTOUT)
GOTO SUSPND
+5 IF %'=1
SET RESUME=1
GOTO ABORT1
+6 ;
DEL IF %=1
SET DA=FILEDA
SET DIK="^QA(748.3,"
DO ^DIK
WRITE *7,!!,">> Survey responses deleted! << "
SET STOP=1
HANG 3
QUIT
+1 ;
ABORT1 XECUTE CLEOP
SET QAPOUT=0
if '$DATA(QUES)
SET QUES=+LQUES
SET QUES=QUES-.001
XECUTE CLEOP
WRITE !!,"No action taken - Press RETURN to continue "
READ ANS:DTIME
SET QAPOUT=0
IF '$TEST
DO ABORT
IF $DATA(STOP)
QUIT
+1 WRITE @IOF,!
XECUTE QAPBAR
XECUTE CLEOP
+2 QUIT
