QAPPTUSR.m

QAPPTUSR ;557/THM-PRINT HARD COPY FOR USERS [ 06/13/96  3:34 PM ]

 ;;2.0;Survey Generator;**5**;Jun 20, 1995

 ;

 D SCREEN^QAPUTIL

EN K USERPRT W @IOF,! S QAPHDR="Print a Survey Hardcopy" X QAPBAR S QAPHDR="Survey Selection" X QAPBAR

 W !!,"This program allows you to print a hardcopy of a survey for your",!,"review ",BLDON,"before",BLDOFF," you actually participate in it.",!!,"It will not print answers you have previously made to this or",!,"other surveys.",!!

 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,STATUS=$P(^QA(748,SURVEY,0),U,4),TITLE=$P(^(0),U,6),ACTION="F"

 I STATUS'="r" W !!,*7,"This survey cannot be printed now.  Its status is ",BLDON,$S(STATUS="d":"Under development",1:"Active life expired"),BLDOFF,".",!!,"Press RETURN  " R ANS:DTIME G:'$T EXIT^QAPPT1 G EN

 W @IOF,! S QAPHDR="Printing Survey Title: "_TITLE 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","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 ---QAPPTUSR   1232     printed  Mar 13, 2025@21:43:31                                                                                                                                                                                                    Page 2

QAPPTUSR  ;557/THM-PRINT HARD COPY FOR USERS [ 06/13/96  3:34 PM ]

 +1       ;;2.0;Survey Generator;**5**;Jun 20, 1995

 +2       ;

 +3        DO SCREEN^QAPUTIL

EN         KILL USERPRT

           WRITE @IOF,!

           SET QAPHDR="Print a Survey Hardcopy"

           XECUTE QAPBAR

           SET QAPHDR="Survey Selection"

           XECUTE QAPBAR

 +1        WRITE !!,"This program allows you to print a hardcopy of a survey for your",!,"review ",BLDON,"before",BLDOFF," you actually participate in it.",!!,"It will not print answers you have previously made to this or",!,"other surveys.",!!

 +2        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

 +3        SET SURVEY=+Y

           SET STATUS=$PIECE(^QA(748,SURVEY,0),U,4)

           SET TITLE=$PIECE(^(0),U,6)

           SET ACTION="F"

 +4        IF STATUS'="r"

               WRITE !!,*7,"This survey cannot be printed now.  Its status is ",BLDON,$SELECT(STATUS="d":"Under development",1:"Active life expired"),BLDOFF,".",!!,"Press RETURN  "

               READ ANS:DTIME

               if '$TEST

                   GOTO EXIT^QAPPT1

               GOTO EN

 +5        WRITE @IOF,!

           SET QAPHDR="Printing Survey Title: "_TITLE

           XECUTE QAPBAR

 +6        SET %ZIS="AEQ"

           SET %ZIS("A")="Output device: "

           DO ^%ZIS

           if POP

               GOTO EXIT^QAPPT1

 +7        IF $DATA(IO("Q"))

               SET ZTREQ="@"

               SET ZTIO=ION

               SET ZTRTN="PRINT^QAPPT1"

               SET ZTDESC="Print "_TITLE_" Survey"

               FOR X="SURVEY","TITLE","ACTION"

                   SET ZTSAVE(X)=""

 +8        IF $DATA(IO("Q"))

               DO ^%ZTLOAD

               if $DATA(ZTSK)

                   WRITE !!,"Queued as task #",ZTSK,!!

               HANG 2

               KILL ZTSK

               GOTO EXIT^QAPPT1

 +9        GOTO ^QAPPT1