ABSPOSUQ ; IHS/OIT/CNI/SCR - DOUBLE QUEING SHELL HANDLER ;
;;1.0;PHARMACY POINT OF SALE;**39**;JUN 21, 2001;Build 38
;Taken from ABMDRDBQ
;;
;
; VARIABLES NEEDED BY PASSING PROGRAM
;(to change to your name space replace all 'ABSP' with your 'NAME SPACE' ... be sure to watch how the variables map with your existing routines)
; mandatories
;
; ABSPQ("RC")-compute routine (required for double queuing. If not present ABSPQ("RP") will still be queued with ABSPQ("ION"))
; ABSPQ("RP")-print routine
; ABSPQ("RX")-exit routine that cleans variables
; ABSPQ("NS")-name space of variables to auto load in ZTSAVE("NS*")=""
;
; optionals
;
; ABSPQ("ION")-forced printer ION with _";"_ characteristics
; ABSPQ("IOPAR") = IOPAR of preselected device
; ABSPQ("FQ")=1 force queuing
; ABSPQ("SL")=1 - if slave printing is allowed when queuing
; ABSPQ("DTH")=FM date time of computing/printing .. or .. =$H
;
SET(ABSPQ) ;SET UP ABSPQ VARIABLES
S ABSPQ("RC")=$G(ABSPQ("RC")),ABSPQ("NS")=$G(ABSPQ("NS")),ABSPQ("X")="ZTSAVE("""_ABSPQ("NS")_"*"")"
;
DEV1 ;>Select Device
W !! S %ZIS="NPQ",%ZIS("A")="Output DEVICE: " D ^%ZIS
I $G(POP)!'$D(IO) S DUOUT="" W !,"REPORTING ABORTED",!,*7 G END ;--->
S ABSPQ("ION")=ION_";"_IOST_";"_$S($D(ABSP(132)):132,1:80)_";"_IOSL
I $D(IO("DOC")) S ABSPQ("ION")=$P(ABSPQ("ION"),";",1,2),$P(ABSPQ("ION"),";",3)=IO("DOC")
S ABSPQ("IO")=IO,ABSPQ("IOPAR")=$G(IOPAR),ABSPQ("CPU")=$G(IOCPU),ABSPQ("IOT")=IOT
I $D(IO("Q")),IO=IO(0),'$G(ABSPQ("SL")) W !,"Queing to slave printer not allowed ... Report Aborting" G END ;--->
;I $D(ABSP(132)) D ^ABSPDR16 Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
;
QUE1 ;que
I IO'=IO(0) D K IO("Q"),ABSPQ,ABSP,ABSPD Q
.S ZTDESC="Double Que Computing "_ABSPQ("RC")_" "_ABSPQ("RP"),ZTRTN="DEQUE1^ABSPOSUQ"
.S:$D(ABSPQ("DTH")) ZTDTH=ABSPQ("DTH") S:ABSPQ("CPU")]"" ZTCPU=ABSPQ("CPU") S ZTSAVE("ABSP*")="" S:ABSPQ("NS")]"" @ABSPQ("X")=""
.D ^%ZTLOAD
.W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
.W:'$G(ZTSK) !,*7,"REPORTING ABORTED"
.D EOP
.D HOME^%ZIS
;
SLAVE ;OPEN SLAVE DEVICE
I $D(IO("S")) S IOP=ION D ^%ZIS
;
DEQUE1 ;EP ;> 1st deque | do computing routine
;
D:ABSPQ("RC")]"" @(ABSPQ("RC"))
D @(ABSPQ("RP"))
I $E(IOST)="C" D I 1
.Q:IOT'["TRM"
.Q:$D(ZTQUEUED)
.Q:$D(IO("S"))
.Q:$D(DTOUT)!($D(DIROUT))!($D(DUOUT))
.W ! S DIR(0)="FO",DIR("A")="(REPORT COMPLETE)" D ^DIR K DIR
E W !!,"E N D O F R E P O R T" W:$Y $$EN^ABMVDF("IOF")
;D 10^ABMDR16:$D(ABSP("PRINT",16))
I $D(IO("S")) D ^%ZISC ;> close slave printer
;
;--------
END ;EP ;> cleanup
;
;D @(ABSPQ("RX")) ;>perform cleanup
I $D(ZTQUEUED) D KILL^%ZTLOAD
K ABSPQ,ZTSK
Q
EOP(X) ;EP - end of page
;X=0, 1, or 2
Q:$G(IOT)'["TRM"
Q:$E($G(IOST))'="C"
Q:$D(IO("S"))
Q:$D(ZTQUEUED)
F W ! Q:$Y+4>IOSL
Q:X=2
S DIR(0)="E"
S:X=1 DIR("A")="Enter RETURN to continue"
D ^DIR
K DIR
Q
ABSPOSUQ ; IHS/OIT/CNI/SCR - DOUBLE QUEING SHELL HANDLER ;
+1 ;;1.0;PHARMACY POINT OF SALE;**39**;JUN 21, 2001;Build 38
+2 ;Taken from ABMDRDBQ
+3 ;;
+4 ;
+5 ; VARIABLES NEEDED BY PASSING PROGRAM
+6 ;(to change to your name space replace all 'ABSP' with your 'NAME SPACE' ... be sure to watch how the variables map with your existing routines)
+7 ; mandatories
+8 ;
+9 ; ABSPQ("RC")-compute routine (required for double queuing. If not present ABSPQ("RP") will still be queued with ABSPQ("ION"))
+10 ; ABSPQ("RP")-print routine
+11 ; ABSPQ("RX")-exit routine that cleans variables
+12 ; ABSPQ("NS")-name space of variables to auto load in ZTSAVE("NS*")=""
+13 ;
+14 ; optionals
+15 ;
+16 ; ABSPQ("ION")-forced printer ION with _";"_ characteristics
+17 ; ABSPQ("IOPAR") = IOPAR of preselected device
+18 ; ABSPQ("FQ")=1 force queuing
+19 ; ABSPQ("SL")=1 - if slave printing is allowed when queuing
+20 ; ABSPQ("DTH")=FM date time of computing/printing .. or .. =$H
+21 ;
SET(ABSPQ) ;SET UP ABSPQ VARIABLES
+1 SET ABSPQ("RC")=$GET(ABSPQ("RC"))
SET ABSPQ("NS")=$GET(ABSPQ("NS"))
SET ABSPQ("X")="ZTSAVE("""_ABSPQ("NS")_"*"")"
+2 ;
DEV1 ;>Select Device
+1 WRITE !!
SET %ZIS="NPQ"
SET %ZIS("A")="Output DEVICE: "
DO ^%ZIS
+2 ;--->
IF $GET(POP)!'$DATA(IO)
SET DUOUT=""
WRITE !,"REPORTING ABORTED",!,*7
GOTO END
+3 SET ABSPQ("ION")=ION_";"_IOST_";"_$SELECT($DATA(ABSP(132)):132,1:80)_";"_IOSL
+4 IF $DATA(IO("DOC"))
SET ABSPQ("ION")=$PIECE(ABSPQ("ION"),";",1,2)
SET $PIECE(ABSPQ("ION"),";",3)=IO("DOC")
+5 SET ABSPQ("IO")=IO
SET ABSPQ("IOPAR")=$GET(IOPAR)
SET ABSPQ("CPU")=$GET(IOCPU)
SET ABSPQ("IOT")=IOT
+6 ;--->
IF $DATA(IO("Q"))
IF IO=IO(0)
IF '$GET(ABSPQ("SL"))
WRITE !,"Queing to slave printer not allowed ... Report Aborting"
GOTO END
+7 ;I $D(ABSP(132)) D ^ABSPDR16 Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
+8 ;
QUE1 ;que
+1 IF IO'=IO(0)
Begin DoDot:1
+2 SET ZTDESC="Double Que Computing "_ABSPQ("RC")_" "_ABSPQ("RP")
SET ZTRTN="DEQUE1^ABSPOSUQ"
+3 IF $DATA(ABSPQ("DTH"))
SET ZTDTH=ABSPQ("DTH")
IF ABSPQ("CPU")]""
SET ZTCPU=ABSPQ("CPU")
SET ZTSAVE("ABSP*")=""
IF ABSPQ("NS")]""
SET @ABSPQ("X")=""
+4 DO ^%ZTLOAD
+5 IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued.",!
+6 IF '$GET(ZTSK)
WRITE !,*7,"REPORTING ABORTED"
+7 DO EOP
+8 DO HOME^%ZIS
End DoDot:1
KILL IO("Q"),ABSPQ,ABSP,ABSPD
QUIT
+9 ;
SLAVE ;OPEN SLAVE DEVICE
+1 IF $DATA(IO("S"))
SET IOP=ION
DO ^%ZIS
+2 ;
DEQUE1 ;EP ;> 1st deque | do computing routine
+1 ;
+2 IF ABSPQ("RC")]""
DO @(ABSPQ("RC"))
+3 DO @(ABSPQ("RP"))
+4 IF $EXTRACT(IOST)="C"
Begin DoDot:1
+5 IF IOT'["TRM"
QUIT
+6 IF $DATA(ZTQUEUED)
QUIT
+7 IF $DATA(IO("S"))
QUIT
+8 IF $DATA(DTOUT)!($DATA(DIROUT))!($DATA(DUOUT))
QUIT
+9 WRITE !
SET DIR(0)="FO"
SET DIR("A")="(REPORT COMPLETE)"
DO ^DIR
KILL DIR
End DoDot:1
IF 1
+10 IF '$TEST
WRITE !!,"E N D O F R E P O R T"
IF $Y
WRITE $$EN^ABMVDF("IOF")
+11 ;D 10^ABMDR16:$D(ABSP("PRINT",16))
+12 ;> close slave printer
IF $DATA(IO("S"))
DO ^%ZISC
+13 ;
+14 ;--------
END ;EP ;> cleanup
+1 ;
+2 ;D @(ABSPQ("RX")) ;>perform cleanup
+3 IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+4 KILL ABSPQ,ZTSK
+5 QUIT
EOP(X) ;EP - end of page
+1 ;X=0, 1, or 2
+2 IF $GET(IOT)'["TRM"
QUIT
+3 IF $EXTRACT($GET(IOST))'="C"
QUIT
+4 IF $DATA(IO("S"))
QUIT
+5 IF $DATA(ZTQUEUED)
QUIT
+6 FOR
WRITE !
IF $Y+4>IOSL
QUIT
+7 IF X=2
QUIT
+8 SET DIR(0)="E"
+9 IF X=1
SET DIR("A")="Enter RETURN to continue"
+10 DO ^DIR
+11 KILL DIR
+12 QUIT
