QAPPT0.m

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 ---QAPPT0   1133     printed  Apr 09, 2024@21:40:50                                                                                                                                                                                                      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