- QAPUTIL ;557/THM-SURVEY GENERATOR UTILITIES [ 06/02/95 11:36 AM ]
- ;;2.0;Survey Generator;;Jun 20, 1995
- ;
- SCREEN ;screen parameters
- S IOP="HOME" D ^%ZIS,DT^DICRW K IOP
- D ENS^%ZISS S RVON=IORVON,RVOFF=IORVOFF,CEOP=IOEDEOP,BLDON=IOINHI,BLDOFF=IOINLOW,TOPBOT=IOSTBM,IOTM=8,IOBM=24,$P(SPACE," ",85)="" D KILL^%ZISS
- ;I IOST?1"C-VT100"!(IOST?1"C-VT320"),TOPBOT]""
- W:TOPBOT]"" @TOPBOT
- S QAPBAR="W RVON,?(80-$L(QAPHDR)\2),QAPHDR,$E(SPACE,$X,77),RVOFF,!"
- S CLEOP="S DX=0,DY=4 X IOXY W CEOP,!" ;leaves header intact
- S CLEOP1="S DX=0,DY=QLINE X IOXY W CEOP,!" ;resets input line on ?
- Q ;kill variables via calling program
- ;
- EXIT ;package-wide variable kill; used by most programs
- D ^%ZISC I IOST?1"C-VT100"!(IOST?1"C-VT320") S IOTM=1,IOBM=24 W @TOPBOT,@IOF,!
- X ^%ZOSF("EON") K ^TMP($J)
- K %,%DT,%ZIS,%X,%Y,%Z,ACTION,ANS,ANSDA,ANSTEXT,ANSTYPE,ANSW,BANNER,BNKOFF,BNKON,C,CEOP,CHOICE,CLEOP,CLEOP1,CNT,CNTA,CQUES,CURSTAT,D,DO,D1,DA,DAX,DD,DELETE,DEMDTA,DEMO,DEMOG,DEMQUES,DEMTYPE,DI,DIC,DIC,DIE,DIF,DIFQ,DIK,DINUM,DIR
- K DIRUT,QAPQN,DISP,DISYS,DIU,DLAYGO,DO,DQ,DR,DTA,DTOUT,DUOUT,DX,DY,EDIT,EXIT,FILEDA,FILENAME,FILENUM,FIND,GRADIENT,I,IFN,INCMSG,INCREM,INSERT,IOTM,IOBM,IOP,LINE,LORD,LPART,LQUES,MSSG,MSSG0,NINCREM,NLINE,NOPEN,NSRVDA,QAPXX
- K NUM,NWNAM,ODEMOG,OSRVDA,OSRVNAM,OSRVQDA,OUT,PART,PART1,PASSWORD,PASSX,PCNT,PG,POP,PQUES,PRESPON,QA,QANS,QAP,QAPBAR,QAPCNT,QAPDATE,QAPEDTR,QAPFILE,QAPHD,QAPHDR,QAPNAME,QAPOUT,QAPSURV,QAPX,QLINE,QNAME,QNUM,QUES,QUES1,QUIT,QY,QZ
- K REM,RESUME,RVOFF,RVON,S,DISYS,SITE,SORT,SORTTXT,SPACE,SS,STOP,SUBJ,SURVEY,SVST,SVSTAT,SVYNAME,TITLE,TOF,TOPBOT,TOTANS,TOTPART,USER,USERPRT,X,XX,Y,YY,ZTDESC,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK,BANNER1,DMAN,DEMERR
- K RESPONDA,RESPCNT,J,D0,D1,DEMPTR,DANS,SQUEST,CCNT,SCNT,ICNT,QAPNOANS,BLDON,BLDOFF,CNTPG,CREATE,MSGSKP,QAPDUZ,QNUMANS,STATUS,XCNT,ANSX,LFTLBL,RGTLBL,LSTNUM,INP,INP1,QCNT,QUESCNT,BYPASS,BLANKS,DEML,DEMVAL,QUEST,RESPD,WPPRT
- K BLANKNA,BYPASSNA,CODE,DEMONAME,DQUES,FILEPTR,MEANING,OWNER,QAPSELCT,VERS,XDA,XMTEXT,DSTOP,FSTOP,XMSUB,SVYSITE,NEWDA,NEWDA1,SVYNAME,AUTHED,NEWNAME,ONFILE,XMZ,XCNP,XCM,NEWREC,XMDUZ,XMMG,DMANMSTR,%I,LASTDATE
- Q
- ;
- INSTRUCT K OUT
- I '$D(BANNER),IOST?1"C-".E D BAN
- W !,"Description:",!! F NLINE=0:0 S NLINE=$O(^QA(748,SURVEY,2,NLINE)) Q:NLINE=""!($D(OUT)) S X=^QA(748,SURVEY,2,NLINE,0) W X,! I IOST?1"C-".E,$Y>(IOSL-6) W !!,"Press RETURN to continue " R ANS:DTIME S:'$T!(ANS[U) OUT=1 Q:$D(OUT) D BAN
- W !!,"Instructions:",!! F NLINE=0:0 S NLINE=$O(^QA(748,SURVEY,4,NLINE)) Q:NLINE=""!($D(OUT)) S X=^QA(748,SURVEY,4,NLINE,0) W X,! I IOST?1"C-".E,$Y>(IOSL-6) W !!,"Press RETURN to continue " R ANS:DTIME S:'$T!(ANS[U) OUT=1 Q:$D(OUT) D BAN
- I $D(OUT) K ANS Q
- W !,"- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -" X:$D(TOF) TOF I $D(QAPOUT),QAPOUT=1 Q
- W ! X:$D(TOF) TOF I $D(QAPOUT),QAPOUT=1 Q
- W ! X:$D(TOF) TOF I $D(QAPOUT),QAPOUT=1 Q
- Q
- ;
- BAN I '$D(BANNER),IOST?1"C-".E W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Instructions" X QAPBAR W !
- I $D(BANNER) D HDR^QAPPT1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPUTIL 3067 printed Jan 18, 2025@03:39:44 Page 2
- QAPUTIL ;557/THM-SURVEY GENERATOR UTILITIES [ 06/02/95 11:36 AM ]
- +1 ;;2.0;Survey Generator;;Jun 20, 1995
- +2 ;
- SCREEN ;screen parameters
- +1 SET IOP="HOME"
- DO ^%ZIS
- DO DT^DICRW
- KILL IOP
- +2 DO ENS^%ZISS
- SET RVON=IORVON
- SET RVOFF=IORVOFF
- SET CEOP=IOEDEOP
- SET BLDON=IOINHI
- SET BLDOFF=IOINLOW
- SET TOPBOT=IOSTBM
- SET IOTM=8
- SET IOBM=24
- SET $PIECE(SPACE," ",85)=""
- DO KILL^%ZISS
- +3 ;I IOST?1"C-VT100"!(IOST?1"C-VT320"),TOPBOT]""
- +4 if TOPBOT]""
- WRITE @TOPBOT
- +5 SET QAPBAR="W RVON,?(80-$L(QAPHDR)\2),QAPHDR,$E(SPACE,$X,77),RVOFF,!"
- +6 ;leaves header intact
- SET CLEOP="S DX=0,DY=4 X IOXY W CEOP,!"
- +7 ;resets input line on ?
- SET CLEOP1="S DX=0,DY=QLINE X IOXY W CEOP,!"
- +8 ;kill variables via calling program
- QUIT
- +9 ;
- EXIT ;package-wide variable kill; used by most programs
- +1 DO ^%ZISC
- IF IOST?1"C-VT100"!(IOST?1"C-VT320")
- SET IOTM=1
- SET IOBM=24
- WRITE @TOPBOT,@IOF,!
- +2 XECUTE ^%ZOSF("EON")
- KILL ^TMP($JOB)
- +3 KILL %,%DT,%ZIS,%X,%Y,%Z,ACTION,ANS,ANSDA,ANSTEXT,ANSTYPE,ANSW,BANNER,BNKOFF,BNKON,C,CEOP,CHOICE,CLEOP,CLEOP1,CNT,CNTA,CQUES,CURSTAT,D,DO,D1,DA,DAX,DD,DELETE,DEMDTA,DEMO,DEMOG,DEMQUES,DEMTYPE,DI,DIC,DIC,DIE,DIF,DIFQ,DIK,DINUM,DIR
- +4 KILL DIRUT,QAPQN,DISP,DISYS,DIU,DLAYGO,DO,DQ,DR,DTA,DTOUT,DUOUT,DX,DY,EDIT,EXIT,FILEDA,FILENAME,FILENUM,FIND,GRADIENT,I,IFN,INCMSG,INCREM,INSERT,IOTM,IOBM,IOP,LINE,LORD,LPART,LQUES,MSSG,MSSG0,NINCREM,NLINE,NOPEN,NSRVDA,QAPXX
- +5 KILL NUM,NWNAM,ODEMOG,OSRVDA,OSRVNAM,OSRVQDA,OUT,PART,PART1,PASSWORD,PASSX,PCNT,PG,POP,PQUES,PRESPON,QA,QANS,QAP,QAPBAR,QAPCNT,QAPDATE,QAPEDTR,QAPFILE,QAPHD,QAPHDR,QAPNAME,QAPOUT,QAPSURV,QAPX,QLINE,QNAME,QNUM,QUES,QUES1,QUIT,QY,QZ
- +6 KILL REM,RESUME,RVOFF,RVON,S,DISYS,SITE,SORT,SORTTXT,SPACE,SS,STOP,SUBJ,SURVEY,SVST,SVSTAT,SVYNAME,TITLE,TOF,TOPBOT,TOTANS,TOTPART,USER,USERPRT,X,XX,Y,YY,ZTDESC,ZTIO,ZTQUEUED,ZTRTN,ZTSAVE,ZTSK,BANNER1,DMAN,DEMERR
- +7 KILL RESPONDA,RESPCNT,J,D0,D1,DEMPTR,DANS,SQUEST,CCNT,SCNT,ICNT,QAPNOANS,BLDON,BLDOFF,CNTPG,CREATE,MSGSKP,QAPDUZ,QNUMANS,STATUS,XCNT,ANSX,LFTLBL,RGTLBL,LSTNUM,INP,INP1,QCNT,QUESCNT,BYPASS,BLANKS,DEML,DEMVAL,QUEST,RESPD,WPPRT
- +8 KILL BLANKNA,BYPASSNA,CODE,DEMONAME,DQUES,FILEPTR,MEANING,OWNER,QAPSELCT,VERS,XDA,XMTEXT,DSTOP,FSTOP,XMSUB,SVYSITE,NEWDA,NEWDA1,SVYNAME,AUTHED,NEWNAME,ONFILE,XMZ,XCNP,XCM,NEWREC,XMDUZ,XMMG,DMANMSTR,%I,LASTDATE
- +9 QUIT
- +10 ;
- INSTRUCT KILL OUT
- +1 IF '$DATA(BANNER)
- IF IOST?1"C-".E
- DO BAN
- +2 WRITE !,"Description:",!!
- FOR NLINE=0:0
- SET NLINE=$ORDER(^QA(748,SURVEY,2,NLINE))
- if NLINE=""!($DATA(OUT))
- QUIT
- SET X=^QA(748,SURVEY,2,NLINE,0)
- WRITE X,!
- IF IOST?1"C-".E
- IF $Y>(IOSL-6)
- WRITE !!,"Press RETURN to continue "
- READ ANS:DTIME
- if '$TEST!(ANS[U)
- SET OUT=1
- if $DATA(OUT)
- QUIT
- DO BAN
- +3 WRITE !!,"Instructions:",!!
- FOR NLINE=0:0
- SET NLINE=$ORDER(^QA(748,SURVEY,4,NLINE))
- if NLINE=""!($DATA(OUT))
- QUIT
- SET X=^QA(748,SURVEY,4,NLINE,0)
- WRITE X,!
- IF IOST?1"C-".E
- IF $Y>(IOSL-6)
- WRITE !!,"Press RETURN to continue "
- READ ANS:DTIME
- if '$TEST!(ANS[U)
- SET OUT=1
- if $DATA(OUT)
- QUIT
- DO BAN
- +4 IF $DATA(OUT)
- KILL ANS
- QUIT
- +5 WRITE !,"- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -"
- if $DATA(TOF)
- XECUTE TOF
- IF $DATA(QAPOUT)
- IF QAPOUT=1
- QUIT
- +6 WRITE !
- if $DATA(TOF)
- XECUTE TOF
- IF $DATA(QAPOUT)
- IF QAPOUT=1
- QUIT
- +7 WRITE !
- if $DATA(TOF)
- XECUTE TOF
- IF $DATA(QAPOUT)
- IF QAPOUT=1
- QUIT
- +8 QUIT
- +9 ;
- BAN IF '$DATA(BANNER)
- IF IOST?1"C-".E
- WRITE @IOF,!
- SET QAPHDR="Survey Title: "_TITLE
- XECUTE QAPBAR
- SET QAPHDR="Instructions"
- XECUTE QAPBAR
- WRITE !
- +1 IF $DATA(BANNER)
- DO HDR^QAPPT1
- +2 QUIT