PSUDBQUE ; IHS/ADC/GTH - DOUBLE QUEUING SHELL HANDLER; 04 NOV 1997
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
; XB*3*5 - IHS/ADC/GTH 10-31-97
; Thanks to Paul Wesley, DSD, for the original routine.
; ---------------------------------------------------------
; Programmer documentation included at end of routine - PGMNOTE
; ---------------------------------------------------------
;
START ;
EN ;PEP for double queuing
NEW PSU ; use a fresh array in case of nesting double queues
; insure IO array is set fully
I ($D(IO)'>10) S IOP="HOME" D ^%ZIS
I $D(ZTQUEUED) S PSUFQ=1 S:'$D(PSUDTH) PSUDTH="NOW" ; insure auto-requeue if called from a queued
I '$D(PSURC),'$D(PSURP) Q ; insure one of RC or RP exist
I $D(PSUTITLE) S PSU("TITLE")=PSUTITLE K PSUTITLE
I IO="" S ION="NULL",(IOST,IOM,IOSL)=0
S PSU("IOP1")=ION_";"_IOST_";"_IOM_";"_IOSL ; store current IO params
I $G(IOPAR)]"" S PSU("IOPAR")=IOPAR ; store IOPAR
I $L($G(PSURC))=0 S PSURC="NORC^PSUDBQUE" ; no compute identified
S PSU("RC")=PSURC,PSU("RP")=$G(PSURP),PSU("RX")=$G(PSURX)
; load PSUNS="xx;yy;.." into PSU("NS",xx*) ...
S PSUNS=$TR("PSUNS",",",";") ; allow "," seperator
F PSUI=1:1 S PSUNSX=$P($G(PSUNS),";",PSUI) Q:PSUNSX="" S:(PSUNSX'["*") PSUNSX=PSUNSX_"*" S PSU("NS",PSUNSX)=""
S PSU("NS","PSU*")=""
; load PSUNS("xxx") array into PSU("NS","xxx")
S PSUNSX=""
F S PSUNSX=$O(PSUNS(PSUNSX)) Q:PSUNSX="" S PSU("NS",PSUNSX)=""
; if this is a double queue with PSU("IOP") setup .. pull the parameters out
; of a ^%ZIS call to set up the parameters without an open
S PSU("IOP")=$G(PSUIOP)
I $D(PSUIOP) S IOP=PSUIOP
; PSU*3*5 - IHS/ADC/GTH 10-31-97 start block
I $G(PSU("IOPAR"))]"" S %ZIS("IOPAR")=PSU("IOPAR") D
. I PSU("IOPAR")'?1"(""".E1""":""".E1""")" Q ; skip HFS if not an HFS
. S PSUHFSNM=$P(PSU("IOPAR"),":"),PSUHFSNM=$TR(PSUHFSNM,"()""")
. S PSUHFSMD=$P(PSU("IOPAR"),":",2),PSUHFSMD=$TR(PSUHFSMD,"()""")
. S %ZIS("HFSNAME")=PSUHFSNM,%ZIS("HFSMODE")=PSUHFSMD
. ;this code drops through
; PSU*3*5 - IHS/ADC/GTH 10-31-97 end block
ZIS ;
KILL IO("Q")
I $G(PSURC)]"",$G(PSURP)="" G ZISQ
S %ZIS="PQM"
D ^%ZIS ; get parameters without an open
I POP W !,"REPORTING-ABORTED",*7 G END1
S PSU("IO")=IO,PSU("IOP")=ION_";"_IOST_";"_IOM_";"_IOSL,PSU("IOPAR")=$G(IOPAR),PSU("CPU")=$G(IOCPU),PSU("ION")=ION
ZISQ ;
I '$D(IO("Q")),'$G(PSUFQ) D
. I $D(ZTQUEUED) S PSUFQ=1 Q
. I IO=IO(0),$G(PSURP)]"" Q
. KILL DIR
. S DIR(0)="Y",DIR("B")="Y",DIR("A")="Won't you queue this "
. D ^DIR
. KILL DIR
. I X["^" S PSUQUIT=1
. S:Y=1 IO("Q")=1
. Q
;
KILL PSU("ZTSK")
I $D(ZTQUEUED),$G(ZTSK) S PSU("ZTSK")=ZTSK
KILL ZTSK
; quit if user says so
I $G(PSUQUIT) KILL DIR S DIR(0)="E",DIR("A")="Report Aborted .. <CR> to continue" D ^DIR KILL DIR G END1
;
QUE1 ;
I ($D(IO("Q"))!($G(PSUFQ))) D K IO("Q") W:(($G(ZTSK))&('$D(PSU("ZTSK")))) !,"Tasked with ",ZTSK W:'$G(ZTSK) !,*7,"Que not successful ... REPORTING ABORTED" D:'$D(ZTQUEUED) ^%ZISC S IOP=PSU("IOP1") D:'$D(ZTQUEUED) ^%ZIS G END1 ;--->
. ;I '$D(ZTQUEUED),IO=IO(0),$G(PSURP)]"" W !,"Queing to slave printer not allowed ... Report Aborting" Q ;---^
. I $D(PSU("TITLE")) S ZTDESC=PSU("TITLE")_" compute"
. E S ZTDESC="Double Que COMPUTing "_PSURC_" "_$G(PSURP)
. S ZTIO="",ZTRTN="DEQUE1^PSUDBQUE"
. S:$D(PSUDTH) ZTDTH=PSUDTH
. S:$G(PSU("CPU"))]"" ZTCPU=PSU("CPU")
. S PSUNSX=""
. F S PSUNSX=$O(PSU("NS",PSUNSX)) Q:PSUNSX="" S ZTSAVE(PSUNSX)=""
. KILL PSURC,PSURP,PSURX,PSUNS,PSUFQ,PSUDTH,PSUIOP,PSUPAR,PSUDTH,PSUNSX,PSUI
. S ZTIO="" ; insure no device loaded
. D ^%ZTLOAD
. Q ; these do .s branch to END1
; (((if queued the above code branched to END)))
;
DEQUE1 ;> 1st deque
;
KILL PSURC,PSURP,PSURX,PSUNS,PSUFQ,PSUDTH,PSUIOP,PSUPAR,PSUDTH
KILL PSU("ZTSK")
I $D(ZTQUEUED),$G(ZTSK) S PSU("ZTSK")=ZTSK
;
COMPUTE ;>do computing | routine
;
D @(PSU("RC")) ; >>>PERFORM THE COMPUTE ROUTINE<<< ;stuffed if not provided with NORC^PSUDBQUE
;
QUE2 ;
;
I $D(ZTQUEUED) D G ENDC ;===> automatically requeue if queued
. Q:PSU("RP")=""
. I $D(PSU("TITLE")) S ZTDESC=PSU("TITLE")_" print"
. E S ZTDESC="Double Que PRINT "_PSU("RC")_" "_PSU("RP")
. S ZTIO=PSU("IO"),ZTDTH=$H,ZTRTN="DEQUE2^PSUDBQUE"
. S PSUNSX=""
. F S PSUNSX=$O(PSU("NS",PSUNSX)) Q:PSUNSX="" S ZTSAVE(PSUNSX)=""
. D SETIOPN K ZTIO
. D ^%ZTLOAD
. I '$D(ZTSK) S PSUERR="SECOND QUE FAILED" D @^%ZOSF("ERRTN") Q
. S PSUDBQUE=1
. Q ; ======> this branches to ENDC
;
; device opened from the first que ask
DEQUE2 ;>EP 2nd Deque | printing
KILL PSU("ZTSK")
I $D(ZTQUEUED),$G(ZTSK) S PSU("ZTSK")=ZTSK
;open printer device for printing with all selected parameters
G:(PSU("RP")="") END ;---> exit if no print
;
U IO
D @(PSU("RP")) ; >>>PERFORM PRINTING ROUTINE
;
;--------
END ;>End | cleanup
;
I $G(PSU("RX"))'="" D @(PSU("RX")) ; >>>PERFORM CLEANUP ROUTINE<<<
;
END0 ;EP - from compute cycle when PSU("RP") EXISTS
I $D(PSU("ZTSK")) S PSUTZTSK=$G(ZTSK),ZTSK=PSU("ZTSK") D KILL^%ZTLOAD K ZTSK S:$G(PSUTZTSK) ZTSK=PSUTZTSK KILL PSUTZTSK
END1 ;EP clean out PSU as passed in
D:'$D(ZTQUEUED) ^%ZISC
S IOP=PSU("IOP1") ; restore original IO parameters
D:'$D(ZTQUEUED) ^%ZIS
K IOPAR,IOUPAR,IOP
KILL PSU,PSURC,PSURP,PSURX,PSUNS,PSUFQ,PSUDTH,PSUIOP,PSUPAR,PSUDTH,PSUERR,PSUI,PSUNSX,PSUQUIT,PSUDBQUE
;
Q
ENDC ;EP - end computing cycle
I $G(PSU("RP"))="" G END
G END0
;
;----------------
;----------------
SUB ;>Subroutines
;----------
NORC ;used if no PSURC identified
Q
;
SETIOPN ;EP Set IOP parameters with (N)o open
Q:'$D(PSU("IOP"))
S IOP=PSU("IOP")
; PSU*3*5 - IHS/ADC/GTH 10-31-97 start block
I $G(PSU("IOPAR"))]"" S %ZIS("IOPAR")=PSU("IOPAR") D
. I PSU("IOPAR")'?1"(""".E1""":""".E1""")" Q ; skip HFS if not an HFS
. S PSUHFSNM=$P(PSU("IOPAR"),":"),PSUHFSNM=$TR(PSUHFSNM,"()""")
. S PSUHFSMD=$P(PSU("IOPAR"),":",2),PSUHFSMD=$TR(PSUHFSMD,"()""")
. S %ZIS("HFSNAME")=PSUHFSNM,%ZIS("HFSMODE")=PSUHFSMD
. Q
; PSU*3*5 - IHS/ADC/GTH 10-31-97 end block
S %ZIS="N"
S %H=299
D ^%ZIS
Q
PGMNOTE ;
;----------------------
;NOTES FOR PROGRAMMERS|
;----------------------
; VARIABLES NEEDED FROM CALLING PROGRAM
;
;MANDATORY
; Either PSURC=Compute Routine or PSURP=Print Routine.
;
;OPTIONAL
; PSURC= [label]^routine for code that will collect/compute data
; PSURP= [label]^routine for code that will perform output
; PSURX= [label]^routine for exit processing (clean up variables, etc.) HIGHLY RECOMMENDED.
; PSUNS= namespace(s) of variables to be auto-loaded into ZTSAVE("namespace*")=""
; ="DG;AUPN;PS;..." ; (will add '*'if missing).
; or="DG,AUPN,PS,..." ; (may be semi-colon or comma delimited)
; PSUNS("xxx")="" - ZTSAVE variable arrays where xxx is as described for ZTSAVE("xxxx")="".
; PSUFQ= 1 Force Queueing, =0 Prompt for Queueing
; PSUDTH= Tasking date.time in FM format.
; PSUIOP= pre-selected print device constructed with ION ; IOST ; IOSL ; IOM
; (mandatory if the calling routine is a queued routine).
; PSUPAR= %ZIS("IOPAR") values for host file with PSUIOP if needed.
;
;ACTIONS
; %ZIS with "PQM" is called by PSUDBQUE if '$D(PSUIOP).
;
; The user will be asked to queue if queuing has not been
; selected.
;
; IO variables for printing as necessary are automatically stored.
;
; PSUxx input variables are killed after loading into a PSU array.
;
; PSUDBQUE can be nested.
;
; The compute and print phases can call PSUDBQUE individually
; (PSUIOP is required).
;
; The appropriate %ZTSK node is killed.
;
;EX:
; S PSURC="C^AGTEST",PSURP="P^AGTEST",PSURX="END^AGTEST",PSUNS="AG"
; D ^PSUDBQUE ;handles foreground and tasking
; Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUDBQUE 8117 printed Dec 13, 2024@02:27:41 Page 2
PSUDBQUE ; IHS/ADC/GTH - DOUBLE QUEUING SHELL HANDLER; 04 NOV 1997
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ; XB*3*5 - IHS/ADC/GTH 10-31-97
+3 ; Thanks to Paul Wesley, DSD, for the original routine.
+4 ; ---------------------------------------------------------
+5 ; Programmer documentation included at end of routine - PGMNOTE
+6 ; ---------------------------------------------------------
+7 ;
START ;
EN ;PEP for double queuing
+1 ; use a fresh array in case of nesting double queues
NEW PSU
+2 ; insure IO array is set fully
+3 IF ($DATA(IO)'>10)
SET IOP="HOME"
DO ^%ZIS
+4 ; insure auto-requeue if called from a queued
IF $DATA(ZTQUEUED)
SET PSUFQ=1
if '$DATA(PSUDTH)
SET PSUDTH="NOW"
+5 ; insure one of RC or RP exist
IF '$DATA(PSURC)
IF '$DATA(PSURP)
QUIT
+6 IF $DATA(PSUTITLE)
SET PSU("TITLE")=PSUTITLE
KILL PSUTITLE
+7 IF IO=""
SET ION="NULL"
SET (IOST,IOM,IOSL)=0
+8 ; store current IO params
SET PSU("IOP1")=ION_";"_IOST_";"_IOM_";"_IOSL
+9 ; store IOPAR
IF $GET(IOPAR)]""
SET PSU("IOPAR")=IOPAR
+10 ; no compute identified
IF $LENGTH($GET(PSURC))=0
SET PSURC="NORC^PSUDBQUE"
+11 SET PSU("RC")=PSURC
SET PSU("RP")=$GET(PSURP)
SET PSU("RX")=$GET(PSURX)
+12 ; load PSUNS="xx;yy;.." into PSU("NS",xx*) ...
+13 ; allow "," seperator
SET PSUNS=$TRANSLATE("PSUNS",",",";")
+14 FOR PSUI=1:1
SET PSUNSX=$PIECE($GET(PSUNS),";",PSUI)
if PSUNSX=""
QUIT
if (PSUNSX'["*")
SET PSUNSX=PSUNSX_"*"
SET PSU("NS",PSUNSX)=""
+15 SET PSU("NS","PSU*")=""
+16 ; load PSUNS("xxx") array into PSU("NS","xxx")
+17 SET PSUNSX=""
+18 FOR
SET PSUNSX=$ORDER(PSUNS(PSUNSX))
if PSUNSX=""
QUIT
SET PSU("NS",PSUNSX)=""
+19 ; if this is a double queue with PSU("IOP") setup .. pull the parameters out
+20 ; of a ^%ZIS call to set up the parameters without an open
+21 SET PSU("IOP")=$GET(PSUIOP)
+22 IF $DATA(PSUIOP)
SET IOP=PSUIOP
+23 ; PSU*3*5 - IHS/ADC/GTH 10-31-97 start block
+24 IF $GET(PSU("IOPAR"))]""
SET %ZIS("IOPAR")=PSU("IOPAR")
Begin DoDot:1
+25 ; skip HFS if not an HFS
IF PSU("IOPAR")'?1"(""".E1""":""".E1""")"
QUIT
+26 SET PSUHFSNM=$PIECE(PSU("IOPAR"),":")
SET PSUHFSNM=$TRANSLATE(PSUHFSNM,"()""")
+27 SET PSUHFSMD=$PIECE(PSU("IOPAR"),":",2)
SET PSUHFSMD=$TRANSLATE(PSUHFSMD,"()""")
+28 SET %ZIS("HFSNAME")=PSUHFSNM
SET %ZIS("HFSMODE")=PSUHFSMD
+29 ;this code drops through
End DoDot:1
+30 ; PSU*3*5 - IHS/ADC/GTH 10-31-97 end block
ZIS ;
+1 KILL IO("Q")
+2 IF $GET(PSURC)]""
IF $GET(PSURP)=""
GOTO ZISQ
+3 SET %ZIS="PQM"
+4 ; get parameters without an open
DO ^%ZIS
+5 IF POP
WRITE !,"REPORTING-ABORTED",*7
GOTO END1
+6 SET PSU("IO")=IO
SET PSU("IOP")=ION_";"_IOST_";"_IOM_";"_IOSL
SET PSU("IOPAR")=$GET(IOPAR)
SET PSU("CPU")=$GET(IOCPU)
SET PSU("ION")=ION
ZISQ ;
+1 IF '$DATA(IO("Q"))
IF '$GET(PSUFQ)
Begin DoDot:1
+2 IF $DATA(ZTQUEUED)
SET PSUFQ=1
QUIT
+3 IF IO=IO(0)
IF $GET(PSURP)]""
QUIT
+4 KILL DIR
+5 SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Won't you queue this "
+6 DO ^DIR
+7 KILL DIR
+8 IF X["^"
SET PSUQUIT=1
+9 if Y=1
SET IO("Q")=1
+10 QUIT
End DoDot:1
+11 ;
+12 KILL PSU("ZTSK")
+13 IF $DATA(ZTQUEUED)
IF $GET(ZTSK)
SET PSU("ZTSK")=ZTSK
+14 KILL ZTSK
+15 ; quit if user says so
+16 IF $GET(PSUQUIT)
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Report Aborted .. <CR> to continue"
DO ^DIR
KILL DIR
GOTO END1
+17 ;
QUE1 ;
+1 ;--->
IF ($DATA(IO("Q"))!($GET(PSUFQ)))
Begin DoDot:1
+2 ;I '$D(ZTQUEUED),IO=IO(0),$G(PSURP)]"" W !,"Queing to slave printer not allowed ... Report Aborting" Q ;---^
+3 IF $DATA(PSU("TITLE"))
SET ZTDESC=PSU("TITLE")_" compute"
+4 IF '$TEST
SET ZTDESC="Double Que COMPUTing "_PSURC_" "_$GET(PSURP)
+5 SET ZTIO=""
SET ZTRTN="DEQUE1^PSUDBQUE"
+6 if $DATA(PSUDTH)
SET ZTDTH=PSUDTH
+7 if $GET(PSU("CPU"))]""
SET ZTCPU=PSU("CPU")
+8 SET PSUNSX=""
+9 FOR
SET PSUNSX=$ORDER(PSU("NS",PSUNSX))
if PSUNSX=""
QUIT
SET ZTSAVE(PSUNSX)=""
+10 KILL PSURC,PSURP,PSURX,PSUNS,PSUFQ,PSUDTH,PSUIOP,PSUPAR,PSUDTH,PSUNSX,PSUI
+11 ; insure no device loaded
SET ZTIO=""
+12 DO ^%ZTLOAD
+13 ; these do .s branch to END1
QUIT
End DoDot:1
KILL IO("Q")
if (($GET(ZTSK))&('$DATA(PSU("ZTSK"))))
WRITE !,"Tasked with ",ZTSK
if '$GET(ZTSK)
WRITE !,*7,"Que not successful ... REPORTING ABORTED"
if '$DATA(ZTQUEUED)
DO ^%ZISC
SET IOP=PSU("IOP1")
if '$DATA(ZTQUEUED)
DO ^%ZIS
GOTO END1
+14 ; (((if queued the above code branched to END)))
+15 ;
DEQUE1 ;> 1st deque
+1 ;
+2 KILL PSURC,PSURP,PSURX,PSUNS,PSUFQ,PSUDTH,PSUIOP,PSUPAR,PSUDTH
+3 KILL PSU("ZTSK")
+4 IF $DATA(ZTQUEUED)
IF $GET(ZTSK)
SET PSU("ZTSK")=ZTSK
+5 ;
COMPUTE ;>do computing | routine
+1 ;
+2 ; >>>PERFORM THE COMPUTE ROUTINE<<< ;stuffed if not provided with NORC^PSUDBQUE
DO @(PSU("RC"))
+3 ;
QUE2 ;
+1 ;
+2 ;===> automatically requeue if queued
IF $DATA(ZTQUEUED)
Begin DoDot:1
+3 if PSU("RP")=""
QUIT
+4 IF $DATA(PSU("TITLE"))
SET ZTDESC=PSU("TITLE")_" print"
+5 IF '$TEST
SET ZTDESC="Double Que PRINT "_PSU("RC")_" "_PSU("RP")
+6 SET ZTIO=PSU("IO")
SET ZTDTH=$HOROLOG
SET ZTRTN="DEQUE2^PSUDBQUE"
+7 SET PSUNSX=""
+8 FOR
SET PSUNSX=$ORDER(PSU("NS",PSUNSX))
if PSUNSX=""
QUIT
SET ZTSAVE(PSUNSX)=""
+9 DO SETIOPN
KILL ZTIO
+10 DO ^%ZTLOAD
+11 IF '$DATA(ZTSK)
SET PSUERR="SECOND QUE FAILED"
DO @^%ZOSF("ERRTN")
QUIT
+12 SET PSUDBQUE=1
+13 ; ======> this branches to ENDC
QUIT
End DoDot:1
GOTO ENDC
+14 ;
+15 ; device opened from the first que ask
DEQUE2 ;>EP 2nd Deque | printing
+1 KILL PSU("ZTSK")
+2 IF $DATA(ZTQUEUED)
IF $GET(ZTSK)
SET PSU("ZTSK")=ZTSK
+3 ;open printer device for printing with all selected parameters
+4 ;---> exit if no print
if (PSU("RP")="")
GOTO END
+5 ;
+6 USE IO
+7 ; >>>PERFORM PRINTING ROUTINE
DO @(PSU("RP"))
+8 ;
+9 ;--------
END ;>End | cleanup
+1 ;
+2 ; >>>PERFORM CLEANUP ROUTINE<<<
IF $GET(PSU("RX"))'=""
DO @(PSU("RX"))
+3 ;
END0 ;EP - from compute cycle when PSU("RP") EXISTS
+1 IF $DATA(PSU("ZTSK"))
SET PSUTZTSK=$GET(ZTSK)
SET ZTSK=PSU("ZTSK")
DO KILL^%ZTLOAD
KILL ZTSK
if $GET(PSUTZTSK)
SET ZTSK=PSUTZTSK
KILL PSUTZTSK
END1 ;EP clean out PSU as passed in
+1 if '$DATA(ZTQUEUED)
DO ^%ZISC
+2 ; restore original IO parameters
SET IOP=PSU("IOP1")
+3 if '$DATA(ZTQUEUED)
DO ^%ZIS
+4 KILL IOPAR,IOUPAR,IOP
+5 KILL PSU,PSURC,PSURP,PSURX,PSUNS,PSUFQ,PSUDTH,PSUIOP,PSUPAR,PSUDTH,PSUERR,PSUI,PSUNSX,PSUQUIT,PSUDBQUE
+6 ;
+7 QUIT
ENDC ;EP - end computing cycle
+1 IF $GET(PSU("RP"))=""
GOTO END
+2 GOTO END0
+3 ;
+4 ;----------------
+5 ;----------------
SUB ;>Subroutines
+1 ;----------
NORC ;used if no PSURC identified
+1 QUIT
+2 ;
SETIOPN ;EP Set IOP parameters with (N)o open
+1 if '$DATA(PSU("IOP"))
QUIT
+2 SET IOP=PSU("IOP")
+3 ; PSU*3*5 - IHS/ADC/GTH 10-31-97 start block
+4 IF $GET(PSU("IOPAR"))]""
SET %ZIS("IOPAR")=PSU("IOPAR")
Begin DoDot:1
+5 ; skip HFS if not an HFS
IF PSU("IOPAR")'?1"(""".E1""":""".E1""")"
QUIT
+6 SET PSUHFSNM=$PIECE(PSU("IOPAR"),":")
SET PSUHFSNM=$TRANSLATE(PSUHFSNM,"()""")
+7 SET PSUHFSMD=$PIECE(PSU("IOPAR"),":",2)
SET PSUHFSMD=$TRANSLATE(PSUHFSMD,"()""")
+8 SET %ZIS("HFSNAME")=PSUHFSNM
SET %ZIS("HFSMODE")=PSUHFSMD
+9 QUIT
End DoDot:1
+10 ; PSU*3*5 - IHS/ADC/GTH 10-31-97 end block
+11 SET %ZIS="N"
+12 SET %H=299
+13 DO ^%ZIS
+14 QUIT
PGMNOTE ;
+1 ;----------------------
+2 ;NOTES FOR PROGRAMMERS|
+3 ;----------------------
+4 ; VARIABLES NEEDED FROM CALLING PROGRAM
+5 ;
+6 ;MANDATORY
+7 ; Either PSURC=Compute Routine or PSURP=Print Routine.
+8 ;
+9 ;OPTIONAL
+10 ; PSURC= [label]^routine for code that will collect/compute data
+11 ; PSURP= [label]^routine for code that will perform output
+12 ; PSURX= [label]^routine for exit processing (clean up variables, etc.) HIGHLY RECOMMENDED.
+13 ; PSUNS= namespace(s) of variables to be auto-loaded into ZTSAVE("namespace*")=""
+14 ; ="DG;AUPN;PS;..." ; (will add '*'if missing).
+15 ; or="DG,AUPN,PS,..." ; (may be semi-colon or comma delimited)
+16 ; PSUNS("xxx")="" - ZTSAVE variable arrays where xxx is as described for ZTSAVE("xxxx")="".
+17 ; PSUFQ= 1 Force Queueing, =0 Prompt for Queueing
+18 ; PSUDTH= Tasking date.time in FM format.
+19 ; PSUIOP= pre-selected print device constructed with ION ; IOST ; IOSL ; IOM
+20 ; (mandatory if the calling routine is a queued routine).
+21 ; PSUPAR= %ZIS("IOPAR") values for host file with PSUIOP if needed.
+22 ;
+23 ;ACTIONS
+24 ; %ZIS with "PQM" is called by PSUDBQUE if '$D(PSUIOP).
+25 ;
+26 ; The user will be asked to queue if queuing has not been
+27 ; selected.
+28 ;
+29 ; IO variables for printing as necessary are automatically stored.
+30 ;
+31 ; PSUxx input variables are killed after loading into a PSU array.
+32 ;
+33 ; PSUDBQUE can be nested.
+34 ;
+35 ; The compute and print phases can call PSUDBQUE individually
+36 ; (PSUIOP is required).
+37 ;
+38 ; The appropriate %ZTSK node is killed.
+39 ;
+40 ;EX:
+41 ; S PSURC="C^AGTEST",PSURP="P^AGTEST",PSURX="END^AGTEST",PSUNS="AG"
+42 ; D ^PSUDBQUE ;handles foreground and tasking
+43 ; Q
