BARDBQUE.m

BARDBQUE ; IHS/SD/LSL - DOUBLE QUEING SHELL HANDLER ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,19**;OCT 26, 2005

 ;

 ; *********************************************************************

 ; VARIABLES NEEDED BY PASSING PROGRAM

 ; (to change to your name space replace all 'BAR' with your

 ; 'NAME SPACE' ... be sure to watch how the variables map with your

 ; existing routines) mandatories

 ;

 ; BARQ("RC") - compute routine (required for double queuing. If not

 ;              present BARQ("RP") will still be queued w/ BARQ("ION"))

 ; BARQ("RP") - print routine

 ; BARQ("RX") - exit routine that cleans variables

 ; BARQ("NS") - name space of variables to auto load in ZTSAVE("NS*")=""

 ;

 ; optionals

 ;

 ; BARQ("ION")         - forced printer ION with _";"_ characteristics

 ; BARQ("IOPAR")=IOPAR - of preselected device

 ; BARQ("FQ")=1        - force queuing

 ; BARQ("SL")=1        - if slave printing is allowed when queuing

 ; BARQ("DTH")=FM      - date time of computing/printing .. or .. =$H

 ; *********************************************************************

 ;

SET ;

 ; Set up BARQ variables

 S BARQ("RC")=$G(BARQ("RC"))

 S BARQ("NS")=$G(BARQ("NS"))

 S BARQ("X")="ZTSAVE("""_BARQ("NS")_"*"")"

 ; -------------------------------

 ;

DEV1 ;

 ; Select Device

 W !!

 K IO("Q")

 S %ZIS="NPQ"

 ; IHS/SD/PKD - 05/25/10 - V1.8*19

 I $G(BAR("OPT"))="TDN" S %ZIS="QM"  ; ask width

 S %ZIS("A")="Output DEVICE: "

 D ^%ZIS

 I $G(POP)!'$D(IO) S DUOUT="" W !,"REPORTING ABORTED",!,*7 G END

 S BARQ("ION")=ION_";"_IOST_";"_IOM_";"_IOSL

 I $D(IO("DOC")) D

 . S BARQ("ION")=$P(BARQ("ION"),";",1,2)

 . S $P(BARQ("ION"),";",3)=IO("DOC")

 S BARQ("IO")=IO

 S BARQ("IOPAR")=$G(IOPAR)

 S BARQ("CPU")=$G(IOCPU)

 S BARQ("IOT")=IOT

 I $D(IO("Q")),IO=IO(0),'$G(BARQ("SL")) W !,"Queing to slave printer not allowed ... Report Aborting" G END

 ; -------------------------------

 ;

QUE1 ;

 ; que

 I IO'=IO(0) D  K IO("Q"),BARQ,BAR,BARD Q

 . S ZTDESC="Double Que Computing  "_BARQ("RC")_"  "_BARQ("RP")

 . S ZTRTN="DEQUE1^BARDBQUE"

 . S:$D(BARQ("DTH")) ZTDTH=BARQ("DTH")

 . S:BARQ("CPU")]"" ZTCPU=BARQ("CPU")

 . S ZTSAVE("BAR*")=""

 . S:BARQ("NS")]"" @BARQ("X")=""

 . I $G(ION)="HFS" S ZTIO("H")=IO  ;IHS/SD/TPF 7/6/2007 IM25238 DOUBLE QUEUER WOULD NOT USE FILE NAME ENTERED BY USER

 . D ^%ZTLOAD

 . W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!

 . W:'$G(ZTSK) !,*7,"REPORTING ABORTED"

 . D EOP^BARUTL(1)

 . D HOME^%ZIS

 ; -------------------------------

 ;

SLAVE ;

 ; Open slave device

 I $D(IO("S")) S IOP=ION D ^%ZIS

 ; -------------------------------

 ;

DEQUE1 ; EP 

 ; 1st deque | do computing routine

 ;

 D:BARQ("RC")]"" @(BARQ("RC"))

 D @(BARQ("RP"))

 I $D(IO("S")) D ^%ZISC        ; close slave printer

 ; -------------------------------

 ;

END ; EP  ;> cleanup

 ;

 D @(BARQ("RX")) ;>perform cleanup

 I $D(ZTQUEUED) D KILL^%ZTLOAD

 K BARQ,ZTSK,IO("Q"),BARD,BAR

 Q

BARDBQUE  ; IHS/SD/LSL - DOUBLE QUEING SHELL HANDLER ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,19**;OCT 26, 2005

 +2       ;

 +3       ; *********************************************************************

 +4       ; VARIABLES NEEDED BY PASSING PROGRAM

 +5       ; (to change to your name space replace all 'BAR' with your

 +6       ; 'NAME SPACE' ... be sure to watch how the variables map with your

 +7       ; existing routines) mandatories

 +8       ;

 +9       ; BARQ("RC") - compute routine (required for double queuing. If not

 +10      ;              present BARQ("RP") will still be queued w/ BARQ("ION"))

 +11      ; BARQ("RP") - print routine

 +12      ; BARQ("RX") - exit routine that cleans variables

 +13      ; BARQ("NS") - name space of variables to auto load in ZTSAVE("NS*")=""

 +14      ;

 +15      ; optionals

 +16      ;

 +17      ; BARQ("ION")         - forced printer ION with _";"_ characteristics

 +18      ; BARQ("IOPAR")=IOPAR - of preselected device

 +19      ; BARQ("FQ")=1        - force queuing

 +20      ; BARQ("SL")=1        - if slave printing is allowed when queuing

 +21      ; BARQ("DTH")=FM      - date time of computing/printing .. or .. =$H

 +22      ; *********************************************************************

 +23      ;

SET       ;

 +1       ; Set up BARQ variables

 +2        SET BARQ("RC")=$GET(BARQ("RC"))

 +3        SET BARQ("NS")=$GET(BARQ("NS"))

 +4        SET BARQ("X")="ZTSAVE("""_BARQ("NS")_"*"")"

 +5       ; -------------------------------

 +6       ;

DEV1      ;

 +1       ; Select Device

 +2        WRITE !!

 +3        KILL IO("Q")

 +4        SET %ZIS="NPQ"

 +5       ; IHS/SD/PKD - 05/25/10 - V1.8*19

 +6       ; ask width

           IF $GET(BAR("OPT"))="TDN"

               SET %ZIS="QM"

 +7        SET %ZIS("A")="Output DEVICE: "

 +8        DO ^%ZIS

 +9        IF $GET(POP)!'$DATA(IO)

               SET DUOUT=""

               WRITE !,"REPORTING ABORTED",!,*7

               GOTO END

 +10       SET BARQ("ION")=ION_";"_IOST_";"_IOM_";"_IOSL

 +11       IF $DATA(IO("DOC"))

               Begin DoDot:1

 +12               SET BARQ("ION")=$PIECE(BARQ("ION"),";",1,2)

 +13               SET $PIECE(BARQ("ION"),";",3)=IO("DOC")

               End DoDot:1

 +14       SET BARQ("IO")=IO

 +15       SET BARQ("IOPAR")=$GET(IOPAR)

 +16       SET BARQ("CPU")=$GET(IOCPU)

 +17       SET BARQ("IOT")=IOT

 +18       IF $DATA(IO("Q"))

               IF IO=IO(0)

                   IF '$GET(BARQ("SL"))

                       WRITE !,"Queing to slave printer not allowed ... Report Aborting"

                       GOTO END

 +19      ; -------------------------------

 +20      ;

QUE1      ;

 +1       ; que

 +2        IF IO'=IO(0)

               Begin DoDot:1

 +3                SET ZTDESC="Double Que Computing  "_BARQ("RC")_"  "_BARQ("RP")

 +4                SET ZTRTN="DEQUE1^BARDBQUE"

 +5                IF $DATA(BARQ("DTH"))

                       SET ZTDTH=BARQ("DTH")

 +6                IF BARQ("CPU")]""

                       SET ZTCPU=BARQ("CPU")

 +7                SET ZTSAVE("BAR*")=""

 +8                IF BARQ("NS")]""

                       SET @BARQ("X")=""

 +9       ;IHS/SD/TPF 7/6/2007 IM25238 DOUBLE QUEUER WOULD NOT USE FILE NAME ENTERED BY USER

                   IF $GET(ION)="HFS"

                       SET ZTIO("H")=IO

 +10               DO ^%ZTLOAD

 +11               IF $GET(ZTSK)

                       WRITE !,"Task # ",ZTSK," queued.",!

 +12               IF '$GET(ZTSK)

                       WRITE !,*7,"REPORTING ABORTED"

 +13               DO EOP^BARUTL(1)

 +14               DO HOME^%ZIS

               End DoDot:1

               KILL IO("Q"),BARQ,BAR,BARD

               QUIT 

 +15      ; -------------------------------

 +16      ;

SLAVE     ;

 +1       ; Open slave device

 +2        IF $DATA(IO("S"))

               SET IOP=ION

               DO ^%ZIS

 +3       ; -------------------------------

 +4       ;

DEQUE1    ; EP 

 +1       ; 1st deque | do computing routine

 +2       ;

 +3        IF BARQ("RC")]""

               DO @(BARQ("RC"))

 +4        DO @(BARQ("RP"))

 +5       ; close slave printer

           IF $DATA(IO("S"))

               DO ^%ZISC

 +6       ; -------------------------------

 +7       ;

END       ; EP  ;> cleanup

 +1       ;

 +2       ;>perform cleanup

           DO @(BARQ("RX"))

 +3        IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

 +4        KILL BARQ,ZTSK,IO("Q"),BARD,BAR

 +5        QUIT