- ABMDRDBQ ; IHS/ASDST/DMJ - DOUBLE QUEING SHELL HANDLER ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;Original;TMD;03/25/96 11:32 AM
- ;;
- ;IHS/DSD/DMJ - 3/22/1999 - NOIS HQW-0399-100107 Patch 1
- ; Modified check to IOT to allow 'virtual' terminals
- ;
- ; VARIABLES NEEDED BY PASSING PROGRAM
- ;(to change to your name space replace all 'ABM' with your 'NAME SPACE' ... be sure to watch how the variables map with your existing routines)
- ; mandatories
- ;
- ; ABMQ("RC")-compute routine (required for double queuing. If not present ABMQ("RP") will still be queued with ABMQ("ION"))
- ; ABMQ("RP")-print routine
- ; ABMQ("RX")-exit routine that cleans variables
- ; ABMQ("NS")-name space of variables to auto load in ZTSAVE("NS*")=""
- ;
- ; optionals
- ;
- ; ABMQ("ION")-forced printer ION with _";"_ characteristics
- ; ABMQ("IOPAR") = IOPAR of preselected device
- ; ABMQ("FQ")=1 force queuing
- ; ABMQ("SL")=1 - if slave printing is allowed when queuing
- ; ABMQ("DTH")=FM date time of computing/printing .. or .. =$H
- ;
- SET ;SET UP ABMQ VARIABLES
- S ABMQ("RC")=$G(ABMQ("RC")),ABMQ("NS")=$G(ABMQ("NS")),ABMQ("X")="ZTSAVE("""_ABMQ("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 ABMQ("ION")=ION_";"_IOST_";"_$S($D(ABM(132)):132,1:80)_";"_IOSL
- I $D(IO("DOC")) S ABMQ("ION")=$P(ABMQ("ION"),";",1,2),$P(ABMQ("ION"),";",3)=IO("DOC")
- S ABMQ("IO")=IO,ABMQ("IOPAR")=$G(IOPAR),ABMQ("CPU")=$G(IOCPU),ABMQ("IOT")=IOT
- I $D(IO("Q")),IO=IO(0),'$G(ABMQ("SL")) W !,"Queing to slave printer not allowed ... Report Aborting" G END ;--->
- I $D(ABM(132)) D ^ABMDR16 Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- ;
- QUE1 ;que
- I IO'=IO(0) D K IO("Q"),ABMQ,ABM,ABMD Q
- .S ZTDESC="Double Que Computing "_ABMQ("RC")_" "_ABMQ("RP"),ZTRTN="DEQUE1^ABMDRDBQ"
- .S:$D(ABMQ("DTH")) ZTDTH=ABMQ("DTH") S:ABMQ("CPU")]"" ZTCPU=ABMQ("CPU") S ZTSAVE("ABM*")="" S:ABMQ("NS")]"" @ABMQ("X")=""
- .D ^%ZTLOAD
- .W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
- .W:'$G(ZTSK) !,*7,"REPORTING ABORTED"
- .D EOP^ABMDUTL(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:ABMQ("RC")]"" @(ABMQ("RC"))
- D @(ABMQ("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(ABM("PRINT",16))
- I $D(IO("S")) D ^%ZISC ;> close slave printer
- ;
- ;--------
- END ;EP ;> cleanup
- ;
- D @(ABMQ("RX")) ;>perform cleanup
- I $D(ZTQUEUED) D KILL^%ZTLOAD
- K ABMQ,ZTSK
- Q
- ABMDRDBQ ; IHS/ASDST/DMJ - DOUBLE QUEING SHELL HANDLER ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;Original;TMD;03/25/96 11:32 AM
- +3 ;;
- +4 ;IHS/DSD/DMJ - 3/22/1999 - NOIS HQW-0399-100107 Patch 1
- +5 ; Modified check to IOT to allow 'virtual' terminals
- +6 ;
- +7 ; VARIABLES NEEDED BY PASSING PROGRAM
- +8 ;(to change to your name space replace all 'ABM' with your 'NAME SPACE' ... be sure to watch how the variables map with your existing routines)
- +9 ; mandatories
- +10 ;
- +11 ; ABMQ("RC")-compute routine (required for double queuing. If not present ABMQ("RP") will still be queued with ABMQ("ION"))
- +12 ; ABMQ("RP")-print routine
- +13 ; ABMQ("RX")-exit routine that cleans variables
- +14 ; ABMQ("NS")-name space of variables to auto load in ZTSAVE("NS*")=""
- +15 ;
- +16 ; optionals
- +17 ;
- +18 ; ABMQ("ION")-forced printer ION with _";"_ characteristics
- +19 ; ABMQ("IOPAR") = IOPAR of preselected device
- +20 ; ABMQ("FQ")=1 force queuing
- +21 ; ABMQ("SL")=1 - if slave printing is allowed when queuing
- +22 ; ABMQ("DTH")=FM date time of computing/printing .. or .. =$H
- +23 ;
- SET ;SET UP ABMQ VARIABLES
- +1 SET ABMQ("RC")=$GET(ABMQ("RC"))
- SET ABMQ("NS")=$GET(ABMQ("NS"))
- SET ABMQ("X")="ZTSAVE("""_ABMQ("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 ABMQ("ION")=ION_";"_IOST_";"_$SELECT($DATA(ABM(132)):132,1:80)_";"_IOSL
- +4 IF $DATA(IO("DOC"))
- SET ABMQ("ION")=$PIECE(ABMQ("ION"),";",1,2)
- SET $PIECE(ABMQ("ION"),";",3)=IO("DOC")
- +5 SET ABMQ("IO")=IO
- SET ABMQ("IOPAR")=$GET(IOPAR)
- SET ABMQ("CPU")=$GET(IOCPU)
- SET ABMQ("IOT")=IOT
- +6 ;--->
- IF $DATA(IO("Q"))
- IF IO=IO(0)
- IF '$GET(ABMQ("SL"))
- WRITE !,"Queing to slave printer not allowed ... Report Aborting"
- GOTO END
- +7 IF $DATA(ABM(132))
- DO ^ABMDR16
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- +8 ;
- QUE1 ;que
- +1 IF IO'=IO(0)
- Begin DoDot:1
- +2 SET ZTDESC="Double Que Computing "_ABMQ("RC")_" "_ABMQ("RP")
- SET ZTRTN="DEQUE1^ABMDRDBQ"
- +3 IF $DATA(ABMQ("DTH"))
- SET ZTDTH=ABMQ("DTH")
- IF ABMQ("CPU")]""
- SET ZTCPU=ABMQ("CPU")
- SET ZTSAVE("ABM*")=""
- IF ABMQ("NS")]""
- SET @ABMQ("X")=""
- +4 DO ^%ZTLOAD
- +5 IF $GET(ZTSK)
- WRITE !,"Task # ",ZTSK," queued.",!
- +6 IF '$GET(ZTSK)
- WRITE !,*7,"REPORTING ABORTED"
- +7 DO EOP^ABMDUTL(1)
- +8 DO HOME^%ZIS
- End DoDot:1
- KILL IO("Q"),ABMQ,ABM,ABMD
- 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 ABMQ("RC")]""
- DO @(ABMQ("RC"))
- +3 DO @(ABMQ("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 IF $DATA(ABM("PRINT",16))
- DO 10^ABMDR16
- +12 ;> close slave printer
- IF $DATA(IO("S"))
- DO ^%ZISC
- +13 ;
- +14 ;--------
- END ;EP ;> cleanup
- +1 ;
- +2 ;>perform cleanup
- DO @(ABMQ("RX"))
- +3 IF $DATA(ZTQUEUED)
- DO KILL^%ZTLOAD
- +4 KILL ABMQ,ZTSK
- +5 QUIT
