Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUDBQUE

PSUDBQUE.m

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