AGDBQUE.m

AGDBQUE ; IHS/ASDS/EFG - DOUBLE QUEING SHELL HANDLER ;    

 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 ;

 ;Thanks to Linda Lehman for the code

 ;

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

 ;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

 ;

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

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

 ;AGQ("RP") - print routine

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

 ;AGQ("NS") - name space of variables to auto load in

 ;            ZTSAVE("NS*")=""

 ;

 ;optionals

 ;

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

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

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

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

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

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

 ;

SET ;Set up AGQ variables

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

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

 S AGQ("X")="ZTSAVE("""_AGQ("NS")_"*"")"

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

DEV1 ;Select Device

 W !!

 K IO("Q")

 S %ZIS="NPQ"

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

 D ^%ZIS

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

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

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

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

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

 S AGQ("IO")=IO

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

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

 S AGQ("IOT")=IOT

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

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

QUE1 ;que

 I IO'=IO(0) D  K IO("Q"),AGQ,AG,AGD Q

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

 . S ZTRTN="DEQUE1^AGDBQUE"

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

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

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

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

 . D ^%ZTLOAD

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

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

 . S X=1 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:AGQ("RC")]"" @(AGQ("RC"))

 D @(AGQ("RP"))

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

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

END ;EP  ;> cleanup

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

 I $D(ZTQUEUED) D KILL^%ZTLOAD

 K AGQ,ZTSK,IO("Q"),AGD,AG

 Q

EOP ;END OF PAGE (Original code from EOP^AGUTL)

 ;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

AGDBQUE   ; IHS/ASDS/EFG - DOUBLE QUEING SHELL HANDLER ;    

 +1       ;;7.1;PATIENT REGISTRATION;;AUG 25,2005

 +2       ;

 +3       ;Thanks to Linda Lehman for the code

 +4       ;

 +5       ;****************************************************************

 +6       ;VARIABLES NEEDED BY PASSING PROGRAM

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

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

 +9       ;your existing routines) mandatories

 +10      ;

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

 +12      ;            present AGQ("RP") will still be queued w/ AGQ("ION"))

 +13      ;AGQ("RP") - print routine

 +14      ;AGQ("RX") - exit routine that cleans variables

 +15      ;AGQ("NS") - name space of variables to auto load in

 +16      ;            ZTSAVE("NS*")=""

 +17      ;

 +18      ;optionals

 +19      ;

 +20      ;AGQ("ION")         - forced printer ION with _";"_ characteristics

 +21      ;AGQ("IOPAR")=IOPAR - of preselected device

 +22      ;AGQ("FQ")=1        - force queuing

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

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

 +25      ;****************************************************************

 +26      ;

SET       ;Set up AGQ variables

 +1        SET AGQ("RC")=$GET(AGQ("RC"))

 +2        SET AGQ("NS")=$GET(AGQ("NS"))

 +3        SET AGQ("X")="ZTSAVE("""_AGQ("NS")_"*"")"

 +4       ;-------------------------------

DEV1      ;Select Device

 +1        WRITE !!

 +2        KILL IO("Q")

 +3        SET %ZIS="NPQ"

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

 +5        DO ^%ZIS

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

               SET DUOUT=""

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

               GOTO END

 +7        SET AGQ("ION")=ION_";"_IOST_";"_IOM_";"_IOSL

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

               Begin DoDot:1

 +9                SET AGQ("ION")=$PIECE(AGQ("ION"),";",1,2)

 +10               SET $PIECE(AGQ("ION"),";",3)=IO("DOC")

               End DoDot:1

 +11       SET AGQ("IO")=IO

 +12       SET AGQ("IOPAR")=$GET(IOPAR)

 +13       SET AGQ("CPU")=$GET(IOCPU)

 +14       SET AGQ("IOT")=IOT

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

               IF IO=IO(0)

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

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

                       GOTO END

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

QUE1      ;que

 +1        IF IO'=IO(0)

               Begin DoDot:1

 +2                SET ZTDESC="Double Que Computing  "_AGQ("RC")_"  "_AGQ("RP")

 +3                SET ZTRTN="DEQUE1^AGDBQUE"

 +4                IF $DATA(AGQ("DTH"))

                       SET ZTDTH=AGQ("DTH")

 +5                IF AGQ("CPU")]""

                       SET ZTCPU=AGQ("CPU")

 +6                SET ZTSAVE("AG*")=""

 +7                IF AGQ("NS")]""

                       SET @AGQ("X")=""

 +8                DO ^%ZTLOAD

 +9                IF $GET(ZTSK)

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

 +10               IF '$GET(ZTSK)

                       WRITE !,*7,"REPORTING ABORTED"

 +11               SET X=1

                   DO EOP

 +12               DO HOME^%ZIS

               End DoDot:1

               KILL IO("Q"),AGQ,AG,AGD

               QUIT 

 +13      ;-------------------------------

SLAVE     ;Open slave device

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

               SET IOP=ION

               DO ^%ZIS

 +2       ;-------------------------------

DEQUE1    ;EP - 1st deque | do computing routine

 +1        IF AGQ("RC")]""

               DO @(AGQ("RC"))

 +2        DO @(AGQ("RP"))

 +3       ;close slave printer

           IF $DATA(IO("S"))

               DO ^%ZISC

 +4       ;-------------------------------

END       ;EP  ;> cleanup

 +1       ;>perform cleanup

           DO @(AGQ("RX"))

 +2        IF $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

 +3        KILL AGQ,ZTSK,IO("Q"),AGD,AG

 +4        QUIT 

EOP       ;END OF PAGE (Original code from EOP^AGUTL)

 +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