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

BARDBQ01.m

Go to the documentation of this file. 
  1. BARDBQ01 ; IHS/SD/TMM - DOUBLE QUEING SHELL HANDLER - MULTI COPIES ; 07/16/2010
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**3,19**;OCT 26, 2005
  1.  ;
  1.  ; 1. 07/16/2010 TMM Create new routine from BARDBQUE to prompt for and print 
  1.  ;                     multiple report copies
  1.  ;
  1.  ; ==========================================================================
  1.  ; ----------------
  1.  ; R E Q U I R E D
  1.  ; ----------------
  1.  ; VARIABLES NEEDED BY PASSING PROGRAM
  1.  ; (to change to your name space replace all 'BAR' with your
  1.  ; 'NAME SPACE' ... be sure to watch how the variables map with your
  1.  ; existing routines) mandatories
  1.  ;
  1.  ; BARQ("RC") - compute routine (required for double queuing. If not
  1.  ;              present BARQ("RP") will still be queued w/ BARQ("ION"))
  1.  ; BARQ("RP") - print routine
  1.  ; BARQ("RX") - exit routine that cleans variables
  1.  ; BARQ("NS") - name space of variables to auto load in ZTSAVE("NS*")=""
  1.  ;
  1.  ; ----------------
  1.  ; O P T I O N A L 
  1.  ; ----------------
  1.  ; BARQ("ION")         - forced printer ION with _";"_ characteristics
  1.  ; BARQ("IOPAR")=IOPAR - of preselected device
  1.  ; BARQ("FQ")=1        - force queuing
  1.  ; BARQ("SL")=1        - if slave printing is allowed when queuing
  1.  ; BARQ("DTH")=FM      - date time of computing/printing .. or .. =$H
  1.  ; BARQ("QUE")=Q       - to allow queuing to a device (adds "Q" to %ZIS)
  1.  ; BAR("MARGIN")=M     - to prompt for for right margin (adds "M" to %ZIS)
  1.  ; BAR("MULTI")=1       - Prompt for and print multiple report copies
  1.  ; *********************************************************************
  1.  ;
  1. EN ; new entry point
  1.  ; 
  1.  ;
  1. SET ;
  1.  ; Set up BARQ variables
  1.  S BARQ("RC")=$G(BARQ("RC"))
  1.  S BARQ("NS")=$G(BARQ("NS"))
  1.  S BARQ("X")="ZTSAVE("""_BARQ("NS")_"*"")"
  1.  ; -------------------------------
  1.  ;
  1. DEV1 ;
  1.  W !!
  1.  K IO("Q")
  1.  ;remove Queuing for Receipts, parameter can be passed by calling routine using BARQ("QUE")
  1.  ;M819*DEL*TMM*20100723  D SETZIS         ;sets %ZIS
  1.  S %ZIS="NP"_$G(BARQ("QUE"))_$G(BARQ("MARGIN"))
  1.  S BARZIS=%ZIS    ;%ZIS is killed off in ^%ZIS
  1.  S %ZIS("A")="Output DEVICE: "
  1.  D ^%ZIS
  1.  I $G(POP)!'$D(IO) S DUOUT="" W !,"REPORTING ABORTED",!,*7 G END
  1.  I $D(IO("Q")),IO=IO(0),'$G(BARQ("SL")) W !,"Queing to slave printer not allowed ... Report Aborting" G END
  1.  ;
  1.  S BARCOPY=0
  1.  I +$G(BAR("MULTI")) S BARCOPY=$$ASKCOPY()
  1.  I $D(DUOUT)!$D(DUOUT)=1 Q
  1.  I $D(DIROUT) S BARSTOP=1 Q
  1.  ; -------------------------------
  1.  ; If report should be queued, Queue it and Quit
  1.  I BARZIS["Q" D QUE1 Q
  1.  ; -------------------------------
  1. SLAVE ;
  1.  ; Open slave device
  1.  S IOP=$G(ION)_";"_$G(IOST)_";"_$G(IOM)_";"_$G(IOSL)
  1.  I $D(IO("S")) D ^%ZIS     ;open slave device
  1.  I '$D(IO("S")) D ^%ZIS    ;open device        ;M819*ADD*TMM*20100723
  1.  I POP W !!,"REPORTING ABORTED" G END
  1.  ; -------------------------------
  1.  ;
  1. DEQUE1 ;EP  Entry point for queued reports
  1.  ; 1st deque | do computing routine
  1. MULT ;   Print report
  1.  N BARCNT
  1.  S BARCNT=0
  1.  F BARCNT=1:1 D  Q:BARCNT=BARCOPY
  1.  . I BARCNT=1,BARQ("RC")]"" D @(BARQ("RC"))      ;compute data
  1.  . D @(BARQ("RP"))
  1.  . I '$D(IOF) S IOF="#"
  1.  . W @IOF
  1.  I $D(IO("S")) D ^%ZISC          ; close slave printer
  1.  I '$D(IO("S")) D ^%ZISC         ; close printer  ;M819*ADD*TMM*20100723
  1.  ; -------------------------------
  1.  ;
  1. END ; EP  ;> cleanup
  1.  ;
  1.  D @(BARQ("RX"))                    ;>perform cleanup
  1.  I $D(ZTQUEUED) D KILL^%ZTLOAD
  1.  K BAR,BARD,BARQ,BARSAVE,BARZIS,IO("Q"),ZTSK
  1.  Q
  1.  ; -------------------------------
  1.  ;
  1. ASKCOPY() ;EP  Propmt for # of copies to print
  1.  K DIR,DTOUT,DUOUT,DIROUT,DIRUT
  1.  S DIR(0)="NA^1:10:0"
  1.  S DIR("B")=1
  1.  S DIR("A")="Number of copies:  "
  1.  K DA
  1.  D ^DIR
  1.  I $D(DIROUT)!$D(DTOUT)!$D(DUOUT) Q 0
  1.  Q X
  1.  ; -------------------------------
  1.  ;
  1. QUE1 ;
  1.  ; queue if selected device not = home device
  1.  I IO=IO(0) Q
  1.  I IO'=IO(0) D  K IO("Q"),BARQ,BAR,BARD Q
  1.  . S ZTDESC="Double Que Computing  "_BARQ("RC")_"  "_BARQ("RP")
  1.  . S ZTRTN="DEQUE1^BARDBQUE"
  1.  . S:$D(BARQ("DTH")) ZTDTH=BARQ("DTH")
  1.  . S:BARQ("CPU")]"" ZTCPU=BARQ("CPU")
  1.  . S ZTSAVE("BAR*")=""
  1.  . S:BARQ("NS")]"" @BARQ("X")=""
  1.  . 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
  1.  . D ^%ZTLOAD
  1.  . W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
  1.  . W:'$G(ZTSK) !,*7,"REPORTING ABORTED"
  1.  . D EOP^BARUTL(1)
  1.  . D HOME^%ZIS             ;resets required IO variables
  1.  Q