source: WorldVistAEHR/trunk/r/SURVEY_GENERATOR-QAP/QAPEDI1.m@ 711

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1QAPEDI1 ;557/THM-EDIT ALL/PART OF SURVEY ANSWERS [ 07/12/95 11:56 AM ]
2 ;;2.0;Survey Generator;;Jun 20, 1995
3 ;
4 ;called from QAPSCRN
5 ;
6EN K EDIT S QAPOUT=0 W @IOF,! S QAPHDR="Edit Survey Answers" X QAPBAR
7 S TITLE=$P(^QA(748,SURVEY,0),U,6) K DIR,OUT,Y
8 S DIR("?",1)=" E to edit all (including demographics)"
9 S DIR("?",2)=" I to edit individual questions (no demographics)"
10 S DIR("?",3)=" P to print a copy of your answers for yourself"
11 S DIR("?")=" Q to QUIT (also '^' or <RETURN>)"
12 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>)"
13 D ^DIR S:$D(DTOUT) STOP=1 G:$D(DTOUT) ABORT^QAPSCRN1 G:$D(DIRUT) EXIT S ACTION=X
14 S ACTION=$TR(ACTION,"eipq","EIPQ")
15 I ACTION="Q" G EXIT
16 I ACTION="I" G INDIV
17 I ACTION="E" G EDITALL
18 I ACTION="P" S USERPRT=1,%ZIS="AEQ" W !! D ^%ZIS G:POP EN
19 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)=""
20 I ACTION="P",$D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task #",ZTSK,!! H 2 D ^%ZISC G EN
21 I ACTION="P" D USERPRT^QAPPT1,^%ZISC
22 G EN
23 ;
24INDIV 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
25 I $D(QAPCNT),'$D(QNUMANS) S QNUMANS=QAPCNT
26 F I=QNUMANS+1:1:CNT K DANS(I)
27 Q:$D(EDIT)
28 I ACTION="I" S QAPOUT=0 DO G:QAPOUT=1 EN G:$D(OUT) EN D:$D(STOP) ABORT^QAPSCRN1 G:$D(STOP) EXIT
29DIS .K QDIS,STOP
30 .W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Editing Individual Questions" X QAPBAR
31 .W !,">> Question number: " R QUESED:DTIME S:'$T STOP=1 Q:$D(STOP) I QUESED=""!(QUESED[U) S QAPOUT=1 Q
32 .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
33 .I QUESED?2.99"?" W !!,"Entry must be numeric, greater than zero and previously answered." H 3 G DIS
34 .I QUESED["?",'$D(QDIS) G DIS
35 .I QUESED]"" S QDIS=QUESED S QAPHDR="Editing Individual Questions" X CLEOP W !,">> Question number: ",QDIS K ANSX
36 .I QUESED'?1.3N,QUESED'?1.3N1"."1.3N,+QUESED>0 W !!,"Question entry must be numeric.",*7 H 2 G DIS
37 .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)
38 .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
39 .S QUES=+$O(^QA(748.3,FILEDA,1,"B",QNAME,0))
40 .S QUEST=QNAME W !! D HDIS Q:$D(STOP)
41 .W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Editing Individual Questions" X QAPBAR W !
42 .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,!
43 .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)
44 G INDIV
45 ;
46EDITALL S EDIT=1 K STOP
47 D INDIV,^QAPDEM1 G:QAPOUT=1 EN D:$D(STOP)!($D(DSTOP)) ABORT^QAPSCRN1 G:$D(STOP)!($D(DSTOP)) EXIT S QAPOUT=0
48 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
49 .D HDIS Q:$D(STOP)
50 .S QAPHDR="Survey Title: "_TITLE W @IOF,! X QAPBAR S QAPHDR="Edit All Questions Sequentially" X QAPBAR W !
51 .W ">> Question number: ",QAPQN,!! S QNAME=QUEST
52 .S QUES=$O(^QA(748.3,FILEDA,1,"B",QUEST,0)) Q:QUES=""
53 .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,!
54 .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
55 .;I $O(DANS(QAPQN))]"" W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Edit All Questions Sequentially" X QAPBAR,CLEOP
56 I $D(STOP) D ABORT^QAPSCRN1 G EXIT
57 K EDIT G EN
58 ;
59EXIT K ANS,ANSTYPE,ANSW,DR,DX,DY,GRADIENT,PRESPON,QUESED,QDIS,QNAME,USERPRT
60 Q ;kill other variables in calling program
61 ;
62HDIS 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,!
63 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
64 Q
65 ;
66DOC ;QDIS=question display # user sees
67 ;QUESED=question selected by user
68 ;QNAME=actual question pointer in 748.25
69 ;QUES=question in response file, for QAPCHX1
70 ;DANS()=array of answers on completed survey that a user can select
71 ; to edit.
Note: See TracBrowser for help on using the repository browser.