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 Dec 13, 2024@02:38:37 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
