ABSPOSUQ.m

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