QAPPT1 ;557/THM-PRINT DRAFT/FINAL COPY, PART 2 [ 08/23/96  8:48 AM ]
 ;;2.0;Survey Generator;**4,6**;Jun 20, 1995
 ;
PRINT U IO S (QAPOUT,PG)=0,BANNER="   * DRAFT COPY *   "
 I IOST?1"P-".E!(IOST?1"PK-".E) S TOF="I $Y>(IOSL-10) W !!,""Continued on next page"",! D HDR^QAPPT1"
 I IOST?1"C-".E S TOF="I $Y>(IOSL-6) W !!,""Press RETURN to continue or '^' to exit "" R ANS:DTIME S:'$T!(ANS[U) QAPOUT=1 Q:QAPOUT=1  I QAPOUT'=1  D HDR^QAPPT1"
 S MSGSKP="Question skipped",$P(LINE,"-",IOM)="",QAPDATE=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
 S SITE=$P($$SITE^VASITE,U),SITE=$P($G(^DIC(4,+SITE,0)),U,1),SITE=$S(+SITE>10000:"",1:"V A Medical Center ")_SITE S:ACTION="D" SITE=BANNER_SITE_BANNER D HDR,INSTRUCT^QAPUTIL ;is a VA hosp or other?
 G:$D(OUT) EXIT D DEMLST^QAPUTIL2 G:QAPOUT=1 EXIT
 F QAPQN=0:0 S QAPQN=$O(^QA(748.25,"E",SURVEY,QAPQN)) Q:QAPQN=""!(QAPOUT=1)  F QNUM=0:0 S QNUM=$O(^QA(748.25,"E",SURVEY,QAPQN,QNUM)) Q:QNUM=""  DO
 .S QAPX=$P(^QA(748.25,SURVEY,1,QNUM,1),U)
 .I ACTION="D" X TOF Q:QAPOUT=1  W:QAPX="w" "  [Word Processing]"
 .;print header
 .I $O(^QA(748.25,SURVEY,1,QNUM,4,0))]"" W ! X TOF Q:QAPOUT=1  F I=0:0 S I=$O(^QA(748.25,SURVEY,1,QNUM,4,I)) D:I=""!(+I=0)  Q:I=""!(+I=0)!(QAPOUT=1)  S X=$P(^QA(748.25,SURVEY,1,QNUM,4,I,0),U,1) W X,! X TOF Q:QAPOUT=1
 .I $O(^QA(748.25,SURVEY,1,QNUM,4,0))]"" W !!
 .;print question
 .W ! X TOF Q:QAPOUT=1  W QAPQN,".  " F I=0:0 S I=$O(^QA(748.25,SURVEY,1,QNUM,2,I)) D:I=""!(+I=0)  Q:I=""!(+I=0)!(QAPOUT=1)  S X=$P(^QA(748.25,SURVEY,1,QNUM,2,I,0),U,1) W X,! X TOF Q:QAPOUT=1
 ..D USINPT:QAPX="m",QATF:QAPX="t",QAYN:QAPX="y",WP:QAPX="w" Q:'$T!(QAPOUT=1)
 Q:$D(USERPRT)
 I '$D(OUT),QAPOUT=0,IOST?1"C-".E W !!,"Press RETURN to end " R ANS:DTIME
 G EXIT
 ;
EXIT D ^%ZISC Q:$D(USERPRT)
 Q:$D(CREATE)  G EXIT^QAPUTIL
 ;
USINPT K ANS S ANSTYPE=$P(^QA(748.25,SURVEY,1,QNUM,0),U,3),GRADIENT=$P(^(0),U,4)
 S INSERT=$S(ANSTYPE="a":"letter",1:"number"),CNTA=0
 F QANS=0:0 S QANS=$O(^QA(748.25,SURVEY,1,QNUM,3,QANS)) Q:QANS=""!(+QANS=0)  S CNTA=CNTA+1,ANS($S(ANSTYPE="a":$C(CNTA+96),1:CNTA))=$P(^QA(748.25,SURVEY,1,QNUM,3,QANS,0),U)
 I ANSTYPE="l" N QUES S QUES=QNUM D LIKRTLAB^QAPCHX X TOF Q:QAPOUT=1  K ANS,QANS
 I ANSTYPE'="l" W ! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 I ANSTYPE'="l" DO
 .S (X,Y,CNTA)=0 F  S X=$O(ANS(X)) Q:X=""  S CNTA=CNTA+1 ;count answers
 .S REM=CNTA#2,CNTA=(CNTA\2)+REM
 .F XX=1:1:CNTA S X=XX S:ANSTYPE="a" X=$C(X+96) W ?2,X,".  ",ANS(X) S:ANSTYPE="a" X=$C($A(X)+CNTA) S:ANSTYPE'="a" X=X+CNTA W:$D(ANS(X)) ?42,X,".  ",ANS(X),!
 I $D(REM),REM>0 W ! X TOF Q:QAPOUT=1
 W ! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 I $D(USERPRT) S QUES=$O(^QA(748.3,FILEDA,1,"B",QNUM,0)) Q:QUES=""  S PRESPON=$P(^QA(748.3,FILEDA,1,QUES,0),U,2) S:PRESPON=" " PRESPON=MSGSKP W ?5,"Response: ",PRESPON,! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 Q
 ;
QAYN W ! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 I $D(USERPRT) S QUES=$O(^QA(748.3,FILEDA,1,"B",QNUM,0)) Q:QUES=""  S PRESPON=$P(^QA(748.3,FILEDA,1,QUES,0),U,2)
 W ?15,"Yes",?28,"No",?40,"Not applicable",! X TOF Q:QAPOUT=1  W ! X TOF W ! X TOF Q:QAPOUT=1
 I $D(USERPRT) S PRESPON=$S(PRESPON="Y":"Yes",PRESPON="N":"No",PRESPON="NA":"Not applicable",1:MSGSKP) W ?5,"Response: ",PRESPON,! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 K ANSW,DIC,DIE,X
 Q
 ;
QATF W ! X TOF W ! X TOF Q:QAPOUT=1
 I $D(USERPRT) S QUES=$O(^QA(748.3,FILEDA,1,"B",QNUM,0)) Q:QUES=""  S PRESPON=$P(^QA(748.3,FILEDA,1,QUES,0),U,2),PRESPON=$S(PRESPON="T":"True",PRESPON="F":"False",1:MSGSKP)
 W ?15,"True",?30,"False",?43,"NA",! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 I $D(USERPRT) W ?5,"Response: ",PRESPON,! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 Q
 ;
WP W ! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 I $D(USERPRT) S QUES=$O(^QA(748.3,FILEDA,1,"B",QNUM,0)) Q:QUES=""
 I $D(USERPRT) F QZ=0:0 S QZ=$O(^QA(748.3,FILEDA,1,QUES,1,QZ)) Q:QZ=""  S QY=^QA(748.3,FILEDA,1,QUES,1,QZ,0) W ?3,QY,! X TOF Q:QAPOUT=1
 F QZ=0:0 S QZ=$O(^QA(748.25,SURVEY,1,QNUM,1,QZ)) Q:QZ=""  S QY=^QA(748.3,FILEDA,1,QUES,1,QZ,0) W ?3,QY,! X TOF Q:QAPOUT=1
 W ! X TOF Q:QAPOUT=1  W ! X TOF Q:QAPOUT=1
 Q
 ;
HDR S PG=PG+1 W:PG>1!(IOST?1"C-".E) @IOF W !,QAPDATE,?(IOM-$L(TITLE)\2),TITLE,?(IOM-12),"Page: ",PG,!,?(IOM-$L(SITE)\2),SITE,! W:$D(USERPRT) ?33,"User Response",!
 W !,LINE,!
 Q
 ;
USERPRT ;from QAPEDI1
 S TITLE=$P(^QA(748,SURVEY,0),U,6),ACTION="F",STATUS=$P(^QA(748.3,FILEDA,0),U,3)
 I '$D(USERPRT),(STATUS'="c") Q ;not individual & not complete
 ;Q:STATUS'="c"  ;no in-progress or suspended surveys
 D PRINT I IOST?1"C-".E I QAPOUT=0 W !!,"Press Return " R ANS:DTIME I '$T S QAPOUT=1
 Q