- 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 Jan 18, 2025@03:28:23 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