- 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.