QAPPT0 ;557/THM-PRINT DRAFT/FINAL COPY [ 07/12/95 11:53 AM ]
;;2.0;Survey Generator;;Jun 20, 1995
;
D SCREEN^QAPUTIL
EN K USERPRT W @IOF,! S QAPHDR="Print a Survey" X QAPBAR S QAPHDR="Survey Selection" X QAPBAR
K DIC S DIC="^QA(748,",DIC(0)="AEQMZ",DIC("A")="Select a survey: " D ^DIC K DIC G:X=""!(X[U) EXIT^QAPPT1
S SURVEY=+Y,X=DUZ D HASH^XUSHSHP S USER=X,TITLE=$P(^QA(748,SURVEY,0),U,6)
H 1 W @IOF,! S QAPHDR="Print a Survey" X QAPBAR S QAPHDR=TITLE X QAPBAR
X CLEOP K DIR S DIR("A")="Selection",DIR(0)="SO^D:Print a draft copy;F:Print a Final Copy;Q:Quit (also uparrow or <RETURN>)" D ^DIR G:$D(DIRUT) EXIT^QAPPT1 S ACTION=$TR(X,"dfq","DFQ")
I ACTION="Q" G EXIT^QAPPT1
W @IOF,! S QAPHDR="Survey Title: "_TITLE X QAPBAR S QAPHDR="Printing a "_$S(ACTION="D":"Draft",1:"Final")_" Copy" X QAPBAR
S %ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS G:POP EXIT^QAPPT1
I $D(IO("Q")) S ZTREQ="@",ZTIO=ION,ZTRTN="PRINT^QAPPT1",ZTDESC="Print "_TITLE_" Survey" F X="SURVEY","TITLE","USER","ACTION" S ZTSAVE(X)=""
I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Queued as task #",ZTSK,!! H 2 K ZTSK G EXIT^QAPPT1
G ^QAPPT1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAPPT0 1133 printed Nov 22, 2024@17:48:22 Page 2
QAPPT0 ;557/THM-PRINT DRAFT/FINAL COPY [ 07/12/95 11:53 AM ]
+1 ;;2.0;Survey Generator;;Jun 20, 1995
+2 ;
+3 DO SCREEN^QAPUTIL
EN KILL USERPRT
WRITE @IOF,!
SET QAPHDR="Print a Survey"
XECUTE QAPBAR
SET QAPHDR="Survey Selection"
XECUTE QAPBAR
+1 KILL DIC
SET DIC="^QA(748,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select a survey: "
DO ^DIC
KILL DIC
if X=""!(X[U)
GOTO EXIT^QAPPT1
+2 SET SURVEY=+Y
SET X=DUZ
DO HASH^XUSHSHP
SET USER=X
SET TITLE=$PIECE(^QA(748,SURVEY,0),U,6)
+3 HANG 1
WRITE @IOF,!
SET QAPHDR="Print a Survey"
XECUTE QAPBAR
SET QAPHDR=TITLE
XECUTE QAPBAR
+4 XECUTE CLEOP
KILL DIR
SET DIR("A")="Selection"
SET DIR(0)="SO^D:Print a draft copy;F:Print a Final Copy;Q:Quit (also uparrow or <RETURN>)"
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT^QAPPT1
SET ACTION=$TRANSLATE(X,"dfq","DFQ")
+5 IF ACTION="Q"
GOTO EXIT^QAPPT1
+6 WRITE @IOF,!
SET QAPHDR="Survey Title: "_TITLE
XECUTE QAPBAR
SET QAPHDR="Printing a "_$SELECT(ACTION="D":"Draft",1:"Final")_" Copy"
XECUTE QAPBAR
+7 SET %ZIS="AEQ"
SET %ZIS("A")="Output device: "
DO ^%ZIS
if POP
GOTO EXIT^QAPPT1
+8 IF $DATA(IO("Q"))
SET ZTREQ="@"
SET ZTIO=ION
SET ZTRTN="PRINT^QAPPT1"
SET ZTDESC="Print "_TITLE_" Survey"
FOR X="SURVEY","TITLE","USER","ACTION"
SET ZTSAVE(X)=""
+9 IF $DATA(IO("Q"))
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Queued as task #",ZTSK,!!
HANG 2
KILL ZTSK
GOTO EXIT^QAPPT1
+10 GOTO ^QAPPT1
