BARDBQ01.m

BARDBQ01 ; IHS/SD/TMM - DOUBLE QUEING SHELL HANDLER - MULTI COPIES ; 07/16/2010

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

 ;

 ; 1. 07/16/2010 TMM Create new routine from BARDBQUE to prompt for and print 

 ;                     multiple report copies

 ;

 ; ==========================================================================

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

 ; R E Q U I R E D

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

 ; 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*")=""

 ;

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

 ; O P T I O N A L 

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

 ; 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

 ; BARQ("QUE")=Q       - to allow queuing to a device (adds "Q" to %ZIS)

 ; BAR("MARGIN")=M     - to prompt for for right margin (adds "M" to %ZIS)

 ; BAR("MULTI")=1       - Prompt for and print multiple report copies

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

 ;

EN ; new entry point

 ; 

 ;

SET ;

 ; Set up BARQ variables

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

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

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

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

 ;

DEV1 ;

 W !!

 K IO("Q")

 ;remove Queuing for Receipts, parameter can be passed by calling routine using BARQ("QUE")

 ;M819*DEL*TMM*20100723  D SETZIS         ;sets %ZIS

 S %ZIS="NP"_$G(BARQ("QUE"))_$G(BARQ("MARGIN"))

 S BARZIS=%ZIS    ;%ZIS is killed off in ^%ZIS

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

 D ^%ZIS

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

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

 ;

 S BARCOPY=0

 I +$G(BAR("MULTI")) S BARCOPY=$$ASKCOPY()

 I $D(DUOUT)!$D(DUOUT)=1 Q

 I $D(DIROUT) S BARSTOP=1 Q

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

 ; If report should be queued, Queue it and Quit

 I BARZIS["Q" D QUE1 Q

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

SLAVE ;

 ; Open slave device

 S IOP=$G(ION)_";"_$G(IOST)_";"_$G(IOM)_";"_$G(IOSL)

 I $D(IO("S")) D ^%ZIS     ;open slave device

 I '$D(IO("S")) D ^%ZIS    ;open device        ;M819*ADD*TMM*20100723

 I POP W !!,"REPORTING ABORTED" G END

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

 ;

DEQUE1 ;EP  Entry point for queued reports

 ; 1st deque | do computing routine

MULT ;   Print report

 N BARCNT

 S BARCNT=0

 F BARCNT=1:1 D  Q:BARCNT=BARCOPY

 . I BARCNT=1,BARQ("RC")]"" D @(BARQ("RC"))      ;compute data

 . D @(BARQ("RP"))

 . I '$D(IOF) S IOF="#"

 . W @IOF

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

 I '$D(IO("S")) D ^%ZISC         ; close printer  ;M819*ADD*TMM*20100723

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

 ;

END ; EP  ;> cleanup

 ;

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

 I $D(ZTQUEUED) D KILL^%ZTLOAD

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

 Q

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

 ;

ASKCOPY() ;EP  Propmt for # of copies to print

 K DIR,DTOUT,DUOUT,DIROUT,DIRUT

 S DIR(0)="NA^1:10:0"

 S DIR("B")=1

 S DIR("A")="Number of copies:  "

 K DA

 D ^DIR

 I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) Q 0

 Q X

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

 ;

QUE1 ;

 ; queue if selected device not = home device

 I IO=IO(0) Q

 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             ;resets required IO variables

 Q

BARDBQ01  ; IHS/SD/TMM - DOUBLE QUEING SHELL HANDLER - MULTI COPIES ; 07/16/2010

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

 +2       ;

 +3       ; 1. 07/16/2010 TMM Create new routine from BARDBQUE to prompt for and print 

 +4       ;                     multiple report copies

 +5       ;

 +6       ; ==========================================================================

 +7       ; ----------------

 +8       ; R E Q U I R E D

 +9       ; ----------------

 +10      ; VARIABLES NEEDED BY PASSING PROGRAM

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

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

 +13      ; existing routines) mandatories

 +14      ;

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

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

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

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

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

 +20      ;

 +21      ; ----------------

 +22      ; O P T I O N A L 

 +23      ; ----------------

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

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

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

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

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

 +29      ; BARQ("QUE")=Q       - to allow queuing to a device (adds "Q" to %ZIS)

 +30      ; BAR("MARGIN")=M     - to prompt for for right margin (adds "M" to %ZIS)

 +31      ; BAR("MULTI")=1       - Prompt for and print multiple report copies

 +32      ; *********************************************************************

 +33      ;

EN        ; new entry point

 +1       ; 

 +2       ;

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        WRITE !!

 +2        KILL IO("Q")

 +3       ;remove Queuing for Receipts, parameter can be passed by calling routine using BARQ("QUE")

 +4       ;M819*DEL*TMM*20100723  D SETZIS         ;sets %ZIS

 +5        SET %ZIS="NP"_$GET(BARQ("QUE"))_$GET(BARQ("MARGIN"))

 +6       ;%ZIS is killed off in ^%ZIS

           SET BARZIS=%ZIS

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

 +8        DO ^%ZIS

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

               SET DUOUT=""

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

               GOTO END

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

               IF IO=IO(0)

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

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

                       GOTO END

 +11      ;

 +12       SET BARCOPY=0

 +13       IF +$GET(BAR("MULTI"))

               SET BARCOPY=$$ASKCOPY()

 +14       IF $DATA(DUOUT)!$DATA(DUOUT)=1

               QUIT 

 +15       IF $DATA(DIROUT)

               SET BARSTOP=1

               QUIT 

 +16      ; -------------------------------

 +17      ; If report should be queued, Queue it and Quit

 +18       IF BARZIS["Q"

               DO QUE1

               QUIT 

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

SLAVE     ;

 +1       ; Open slave device

 +2        SET IOP=$GET(ION)_";"_$GET(IOST)_";"_$GET(IOM)_";"_$GET(IOSL)

 +3       ;open slave device

           IF $DATA(IO("S"))

               DO ^%ZIS

 +4       ;open device        ;M819*ADD*TMM*20100723

           IF '$DATA(IO("S"))

               DO ^%ZIS

 +5        IF POP

               WRITE !!,"REPORTING ABORTED"

               GOTO END

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

 +7       ;

DEQUE1    ;EP  Entry point for queued reports

 +1       ; 1st deque | do computing routine

MULT      ;   Print report

 +1        NEW BARCNT

 +2        SET BARCNT=0

 +3        FOR BARCNT=1:1

               Begin DoDot:1

 +4       ;compute data

                   IF BARCNT=1

                       IF BARQ("RC")]""

                           DO @(BARQ("RC"))

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

 +6                IF '$DATA(IOF)

                       SET IOF="#"

 +7                WRITE @IOF

               End DoDot:1

               IF BARCNT=BARCOPY

                   QUIT 

 +8       ; close slave printer

           IF $DATA(IO("S"))

               DO ^%ZISC

 +9       ; close printer  ;M819*ADD*TMM*20100723

           IF '$DATA(IO("S"))

               DO ^%ZISC

 +10      ; -------------------------------

 +11      ;

END       ; EP  ;> cleanup

 +1       ;

 +2       ;>perform cleanup

           DO @(BARQ("RX"))

 +3        IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

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

 +5        QUIT 

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

 +7       ;

ASKCOPY() ;EP  Propmt for # of copies to print

 +1        KILL DIR,DTOUT,DUOUT,DIROUT,DIRUT

 +2        SET DIR(0)="NA^1:10:0"

 +3        SET DIR("B")=1

 +4        SET DIR("A")="Number of copies:  "

 +5        KILL DA

 +6        DO ^DIR

 +7        IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)

               QUIT 0

 +8        QUIT X

 +9       ; -------------------------------

 +10      ;

QUE1      ;

 +1       ; queue if selected device not = home device

 +2        IF IO=IO(0)

               QUIT 

 +3        IF IO'=IO(0)

               Begin DoDot:1

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

 +5                SET ZTRTN="DEQUE1^BARDBQUE"

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

                       SET ZTDTH=BARQ("DTH")

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

                       SET ZTCPU=BARQ("CPU")

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

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

                       SET @BARQ("X")=""

 +10      ;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

 +11               DO ^%ZTLOAD

 +12               IF $GET(ZTSK)

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

 +13               IF '$GET(ZTSK)

                       WRITE !,*7,"REPORTING ABORTED"

 +14               DO EOP^BARUTL(1)

 +15      ;resets required IO variables

                   DO HOME^%ZIS

               End DoDot:1

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

               QUIT 

 +16       QUIT