QAPEDI1 ;557/THM-EDIT ALL/PART OF SURVEY ANSWERS [ 07/12/95 11:56 AM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
;called from QAPSCRN
;
EN K EDIT S QAPOUT=0 W @IOF,! S QAPHDR="Edit Survey Answers" X QAPBAR
S TITLE=$P(^QA(748,SURVEY,0),U,6) K DIR,OUT,Y
S DIR("?",1)=" E to edit all (including demographics)"
S DIR("?",2)=" I to edit individual questions (no demographics)"
S DIR("?",3)=" P to print a copy of your answers for yourself"
S DIR("?")=" Q to QUIT (also '^' or <RETURN>)"
W !!! S DIR("A")="Selection",DIR(0)="SO^E:Edit All Questions (including demographics);I:Edit Individual Questions (no demographics);P:Print a copy for yourself;Q:Quit (also uparrow or <RETURN>)"
D ^DIR S:$D(DTOUT) STOP=1 G:$D(DTOUT) ABORT^QAPSCRN1 G:$D(DIRUT) EXIT S ACTION=X
S ACTION=$TR(ACTION,"eipq","EIPQ")
I ACTION="Q" G EXIT
I ACTION="I" G INDIV
I ACTION="E" G EDITALL
I ACTION="P" S USERPRT=1,%ZIS="AEQ" W !! D ^%ZIS G:POP EN
I ACTION="P",$D(IO("Q")) S ZTREQ="@",ZTIO=ION,ZTRTN="USERPRT^QAPPT1",ZTDESC="Survey Printing for user "_DUZ F X="SURVEY","FILEDA","USERPRT" S ZTSAVE(X)=""
I ACTION="P",$D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task #",ZTSK,!! H 2 D ^%ZISC G EN
I ACTION="P" D USERPRT^QAPPT1,^%ZISC
G EN
;
INDIV K DANS F I=0:0 S I=$O(^QA(748.25,"E",SURVEY,I)) Q:I="" F J=0:0 S J=$O(^QA(748.25,"E",SURVEY,I,J)) Q:J="" S DANS(I,J)=I,DANS(I)=I,CNT=I
I $D(QAPCNT),'$D(QNUMANS) S QNUMANS=QAPCNT
F I=QNUMANS+1:1:CNT K DANS(I)
Q:$D(EDIT)
I ACTION="I" S QAPOUT=0 DO G:QAPOUT=1 EN G:$D(OUT) EN D:$D(STOP) ABORT^QAPSCRN1 G:$D(STOP) EXIT
DIS .K QDIS,STOP
.W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Editing Individual Questions" X QAPBAR
.W !,">> Question number: " R QUESED:DTIME S:'$T STOP=1 Q:$D(STOP) I QUESED=""!(QUESED[U) S QAPOUT=1 Q
.I QUESED="?" D HELPLK^QAPUTIL1 Q:$D(STOP) G:QUESED="" DIS I QAPQN]"" S (QUESED,QDIS)=ANSX W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR
.I QUESED?2.99"?" W !!,"Entry must be numeric, greater than zero and previously answered." H 3 G DIS
.I QUESED["?",'$D(QDIS) G DIS
.I QUESED]"" S QDIS=QUESED S QAPHDR="Editing Individual Questions" X CLEOP W !,">> Question number: ",QDIS K ANSX
.I QUESED'?1.3N,QUESED'?1.3N1"."1.3N,+QUESED>0 W !!,"Question entry must be numeric.",*7 H 2 G DIS
.S QUESED=+$G(DANS(QUESED)),QNAME=$O(^QA(748.25,"E",SURVEY,+QUESED,0)) I +QNAME>0 S QNAME=$P(^QA(748.25,SURVEY,1,QNAME,0),U)
.I +QNAME=0 W !!,*7,"That question was not found. The question must be",!,"numeric, greater than zero, and already answered.",!! W !!,"Press RETURN " R ANS:DTIME S:'$T STOP=1 S:ANS[U QAPOUT=1 Q:QAPOUT=1!($D(STOP)) G DIS
.S QUES=+$O(^QA(748.3,FILEDA,1,"B",QNAME,0))
.S QUEST=QNAME W !! D HDIS Q:$D(STOP)
.W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Editing Individual Questions" X QAPBAR W !
.F I=0:0 S I=$O(^QA(748.25,SURVEY,1,QNAME,2,I)) Q:I=""!(+I=0) S X=$P(^QA(748.25,SURVEY,1,QNAME,2,I,0),U,1) W X,!
.S QAPX=$P(^QA(748.25,SURVEY,1,QNAME,1),U) D USINPT^QAPCHX1:QAPX="m",QATF^QAPCHX1:QAPX="t",QAYN^QAPCHX1:QAPX="y",WP^QAPCHX1:QAPX="w" Q:QAPOUT!$D(STOP)
G INDIV
;
EDITALL S EDIT=1 K STOP
D INDIV,^QAPDEM1 G:QAPOUT=1 EN D:$D(STOP)!($D(DSTOP)) ABORT^QAPSCRN1 G:$D(STOP)!($D(DSTOP)) EXIT S QAPOUT=0
F QAPQN=0:0 S QAPQN=$O(DANS(QAPQN)) Q:QAPQN=""!(QAPOUT=1)!($D(STOP)) F QUEST=0:0 S QUEST=$O(DANS(QAPQN,QUEST)) Q:QUEST="" DO I QAPOUT=1!($D(STOP)) S QUEST=999
.D HDIS Q:$D(STOP)
.S QAPHDR="Survey Title: "_TITLE W @IOF,! X QAPBAR S QAPHDR="Edit All Questions Sequentially" X QAPBAR W !
.W ">> Question number: ",QAPQN,!! S QNAME=QUEST
.S QUES=$O(^QA(748.3,FILEDA,1,"B",QUEST,0)) Q:QUES=""
.F I=0:0 S I=$O(^QA(748.25,SURVEY,1,QNAME,2,I)) Q:I=""!(+I=0) S X=$P(^QA(748.25,SURVEY,1,QNAME,2,I,0),U,1) W X,!
.S QAPX=$P(^QA(748.25,SURVEY,1,QNAME,1),U) D USINPT^QAPCHX1:QAPX="m",QATF^QAPCHX1:QAPX="t",QAYN^QAPCHX1:QAPX="y",WP^QAPCHX1:QAPX="w" I QAPOUT=1!('$T) Q
.;I $O(DANS(QAPQN))]"" W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Edit All Questions Sequentially" X QAPBAR,CLEOP
I $D(STOP) D ABORT^QAPSCRN1 G EXIT
K EDIT G EN
;
EXIT K ANS,ANSTYPE,ANSW,DR,DX,DY,GRADIENT,PRESPON,QUESED,QDIS,QNAME,USERPRT
Q ;kill other variables in calling program
;
HDIS X CLEOP I $O(^QA(748.25,SURVEY,1,QUEST,4,0))]"" F I=0:0 S I=$O(^QA(748.25,SURVEY,1,QUEST,4,I)) D:I=""!(+I=0) Q:I=""!(+I=0) S X=$P(^QA(748.25,SURVEY,1,QUEST,4,I,0),U,1) W X,!
I $O(^QA(748.25,SURVEY,1,QUEST,4,0))]"" W *7,!!,"Press RETURN " R ANS:DTIME S:'$T STOP=1 Q:$D(STOP) W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Editing Individual Questions" X QAPBAR,CLEOP
Q
;
DOC ;QDIS=question display # user sees
;QUESED=question selected by user
;QNAME=actual question pointer in 748.25
;QUES=question in response file, for QAPCHX1
;DANS()=array of answers on completed survey that a user can select
; to edit.
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPEDI1 4936 printed Jan 18, 2025@03:39:24 Page 2
QAPEDI1 ;557/THM-EDIT ALL/PART OF SURVEY ANSWERS [ 07/12/95 11:56 AM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
+3 ;called from QAPSCRN
+4 ;
EN KILL EDIT
SET QAPOUT=0
WRITE @IOF,!
SET QAPHDR="Edit Survey Answers"
XECUTE QAPBAR
+1 SET TITLE=$PIECE(^QA(748,SURVEY,0),U,6)
KILL DIR,OUT,Y
+2 SET DIR("?",1)=" E to edit all (including demographics)"
+3 SET DIR("?",2)=" I to edit individual questions (no demographics)"
+4 SET DIR("?",3)=" P to print a copy of your answers for yourself"
+5 SET DIR("?")=" Q to QUIT (also '^' or <RETURN>)"
+6 WRITE !!!
SET DIR("A")="Selection"
SET DIR(0)="SO^E:Edit All Questions (including demographics);I:Edit Individual Questions (no demographics);P:Print a copy for yourself;Q:Quit (also uparrow or <RETURN>)"
+7 DO ^DIR
if $DATA(DTOUT)
SET STOP=1
if $DATA(DTOUT)
GOTO ABORT^QAPSCRN1
if $DATA(DIRUT)
GOTO EXIT
SET ACTION=X
+8 SET ACTION=$TRANSLATE(ACTION,"eipq","EIPQ")
+9 IF ACTION="Q"
GOTO EXIT
+10 IF ACTION="I"
GOTO INDIV
+11 IF ACTION="E"
GOTO EDITALL
+12 IF ACTION="P"
SET USERPRT=1
SET %ZIS="AEQ"
WRITE !!
DO ^%ZIS
if POP
GOTO EN
+13 IF ACTION="P"
IF $DATA(IO("Q"))
SET ZTREQ="@"
SET ZTIO=ION
SET ZTRTN="USERPRT^QAPPT1"
SET ZTDESC="Survey Printing for user "_DUZ
FOR X="SURVEY","FILEDA","USERPRT"
SET ZTSAVE(X)=""
+14 IF ACTION="P"
IF $DATA(IO("Q"))
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Queued as task #",ZTSK,!!
HANG 2
DO ^%ZISC
GOTO EN
+15 IF ACTION="P"
DO USERPRT^QAPPT1
DO ^%ZISC
+16 GOTO EN
+17 ;
INDIV KILL DANS
FOR I=0:0
SET I=$ORDER(^QA(748.25,"E",SURVEY,I))
if I=""
QUIT
FOR J=0:0
SET J=$ORDER(^QA(748.25,"E",SURVEY,I,J))
if J=""
QUIT
SET DANS(I,J)=I
SET DANS(I)=I
SET CNT=I
+1 IF $DATA(QAPCNT)
IF '$DATA(QNUMANS)
SET QNUMANS=QAPCNT
+2 FOR I=QNUMANS+1:1:CNT
KILL DANS(I)
+3 if $DATA(EDIT)
QUIT
+4 IF ACTION="I"
SET QAPOUT=0
Begin DoDot:1
DIS KILL QDIS,STOP
+1 WRITE @IOF,!
SET QAPHDR="Survey Title: "_TITLE
XECUTE QAPBAR
SET QAPHDR="Editing Individual Questions"
XECUTE QAPBAR
+2 WRITE !,">> Question number: "
READ QUESED:DTIME
if '$TEST
SET STOP=1
if $DATA(STOP)
QUIT
IF QUESED=""!(QUESED[U)
SET QAPOUT=1
QUIT
+3 IF QUESED="?"
DO HELPLK^QAPUTIL1
if $DATA(STOP)
QUIT
if QUESED=""
GOTO DIS
IF QAPQN]""
SET (QUESED,QDIS)=ANSX
WRITE @IOF,!
SET QAPHDR="Survey Title: "_TITLE
XECUTE QAPBAR
+4 IF QUESED?2.99"?"
WRITE !!,"Entry must be numeric, greater than zero and previously answered."
HANG 3
GOTO DIS
+5 IF QUESED["?"
IF '$DATA(QDIS)
GOTO DIS
+6 IF QUESED]""
SET QDIS=QUESED
SET QAPHDR="Editing Individual Questions"
XECUTE CLEOP
WRITE !,">> Question number: ",QDIS
KILL ANSX
+7 IF QUESED'?1.3N
IF QUESED'?1.3N1"."1.3N
IF +QUESED>0
WRITE !!,"Question entry must be numeric.",*7
HANG 2
GOTO DIS
+8 SET QUESED=+$GET(DANS(QUESED))
SET QNAME=$ORDER(^QA(748.25,"E",SURVEY,+QUESED,0))
IF +QNAME>0
SET QNAME=$PIECE(^QA(748.25,SURVEY,1,QNAME,0),U)
+9 IF +QNAME=0
WRITE !!,*7,"That question was not found. The question must be",!,"numeric, greater than zero, and already answered.",!!
WRITE !!,"Press RETURN "
READ ANS:DTIME
if '$TEST
SET STOP=1
if ANS[U
SET QAPOUT=1
if QAPOUT=1!($DATA(STOP))
QUIT
GOTO DIS
+10 SET QUES=+$ORDER(^QA(748.3,FILEDA,1,"B",QNAME,0))
+11 SET QUEST=QNAME
WRITE !!
DO HDIS
if $DATA(STOP)
QUIT
+12 WRITE @IOF,!
SET QAPHDR="Survey Title: "_TITLE
XECUTE QAPBAR
SET QAPHDR="Editing Individual Questions"
XECUTE QAPBAR
WRITE !
+13 FOR I=0:0
SET I=$ORDER(^QA(748.25,SURVEY,1,QNAME,2,I))
if I=""!(+I=0)
QUIT
SET X=$PIECE(^QA(748.25,SURVEY,1,QNAME,2,I,0),U,1)
WRITE X,!
+14 SET QAPX=$PIECE(^QA(748.25,SURVEY,1,QNAME,1),U)
if QAPX="m"
DO USINPT^QAPCHX1
if QAPX="t"
DO QATF^QAPCHX1
if QAPX="y"
DO QAYN^QAPCHX1
if QAPX="w"
DO WP^QAPCHX1
if QAPOUT!$DATA(STOP)
QUIT
End DoDot:1
if QAPOUT=1
GOTO EN
if $DATA(OUT)
GOTO EN
if $DATA(STOP)
DO ABORT^QAPSCRN1
if $DATA(STOP)
GOTO EXIT
+15 GOTO INDIV
+16 ;
EDITALL SET EDIT=1
KILL STOP
+1 DO INDIV
DO ^QAPDEM1
if QAPOUT=1
GOTO EN
if $DATA(STOP)!($DATA(DSTOP))
DO ABORT^QAPSCRN1
if $DATA(STOP)!($DATA(DSTOP))
GOTO EXIT
SET QAPOUT=0
+2 FOR QAPQN=0:0
SET QAPQN=$ORDER(DANS(QAPQN))
if QAPQN=""!(QAPOUT=1)!($DATA(STOP))
QUIT
FOR QUEST=0:0
SET QUEST=$ORDER(DANS(QAPQN,QUEST))
if QUEST=""
QUIT
Begin DoDot:1
+3 DO HDIS
if $DATA(STOP)
QUIT
+4 SET QAPHDR="Survey Title: "_TITLE
WRITE @IOF,!
XECUTE QAPBAR
SET QAPHDR="Edit All Questions Sequentially"
XECUTE QAPBAR
WRITE !
+5 WRITE ">> Question number: ",QAPQN,!!
SET QNAME=QUEST
+6 SET QUES=$ORDER(^QA(748.3,FILEDA,1,"B",QUEST,0))
if QUES=""
QUIT
+7 FOR I=0:0
SET I=$ORDER(^QA(748.25,SURVEY,1,QNAME,2,I))
if I=""!(+I=0)
QUIT
SET X=$PIECE(^QA(748.25,SURVEY,1,QNAME,2,I,0),U,1)
WRITE X,!
+8 SET QAPX=$PIECE(^QA(748.25,SURVEY,1,QNAME,1),U)
if QAPX="m"
DO USINPT^QAPCHX1
if QAPX="t"
DO QATF^QAPCHX1
if QAPX="y"
DO QAYN^QAPCHX1
if QAPX="w"
DO WP^QAPCHX1
IF QAPOUT=1!('$TEST)
QUIT
+9 ;I $O(DANS(QAPQN))]"" W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Edit All Questions Sequentially" X QAPBAR,CLEOP
End DoDot:1
IF QAPOUT=1!($DATA(STOP))
SET QUEST=999
+10 IF $DATA(STOP)
DO ABORT^QAPSCRN1
GOTO EXIT
+11 KILL EDIT
GOTO EN
+12 ;
EXIT KILL ANS,ANSTYPE,ANSW,DR,DX,DY,GRADIENT,PRESPON,QUESED,QDIS,QNAME,USERPRT
+1 ;kill other variables in calling program
QUIT
+2 ;
HDIS XECUTE CLEOP
IF $ORDER(^QA(748.25,SURVEY,1,QUEST,4,0))]""
FOR I=0:0
SET I=$ORDER(^QA(748.25,SURVEY,1,QUEST,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,QUEST,4,I,0),U,1)
WRITE X,!
+1 IF $ORDER(^QA(748.25,SURVEY,1,QUEST,4,0))]""
WRITE *7,!!,"Press RETURN "
READ ANS:DTIME
if '$TEST
SET STOP=1
if $DATA(STOP)
QUIT
WRITE @IOF,!
SET QAPHDR="Survey Title: "_TITLE
XECUTE QAPBAR
SET QAPHDR="Editing Individual Questions"
XECUTE QAPBAR
XECUTE CLEOP
+2 QUIT
+3 ;
DOC ;QDIS=question display # user sees
+1 ;QUESED=question selected by user
+2 ;QNAME=actual question pointer in 748.25
+3 ;QUES=question in response file, for QAPCHX1
+4 ;DANS()=array of answers on completed survey that a user can select
+5 ; to edit.
