PSGTI.m

PSGTI ;BIR/CML3-UNIT DOSE-TASKMAN INTERFACE ;17 SEP 97 / 1:06 PM

 ;;5.0; INPATIENT MEDICATIONS ;**50**;16 DEC 97

 ;

ENPL ;

 K %ZIS,IO("Q"),IOP S PSGION=ION,%ZIS="Q",%ZIS("A")="Print on DEVICE: ",%ZIS("B")="" W ! D ^%ZIS K IOP,%ZIS I POP,'$D(IO("Q")) S IOP=PSGION D ^%ZIS S POP=1

 I '$D(IO("Q")) K PSGION,IOP Q

 K PSGTID,ZTSAVE S PSGTIR="EN^PSGPL1",ZTDESC="UNIT DOSE PICK LIST RUN" F X="PSGPLS","PSGPLF","PSGPLG","PSGPLWG","PSGPLWGP" S ZTSAVE(X)="" S:$D(PSJPRN) ZTSAVE("PSJPRN")=""

 I $G(RERUN) S ZTSAVE("OG")="",ZTSAVE("RERUN")=""

 I POP W !,?3,"The Pick List will compile, but not print." S ZTIO="" D ENNOIO S IOP=PSGION D ^%ZIS K IOP,PSGION S IO("Q")="" Q

 G ENTSK

 ;

EN3 ;

 K ZTSAVE S PSGTIR="ENQ^PSG"_RTN

 I RTN="DCT" D

 .S:$D(PSGDCLW) ZTSAVE("PSGDCLW(")="" S ZTDESC="UNIT DOSE DRUG COST REPORT" S:$D(PSGDCTD) ZTSAVE("PSGDCTD(")="" F X="PSGDCTA","PSGATTL","PSGCTTL","PSGCNT","PSGDCTB","PSGDCTL","PSGDCTS" S ZTSAVE(X)=""

 F X="PSGDCT","PSGDCLW","PSGDCTD","PRDRG","PMDRG1","PR","PSGCLS","PSGCLS1","PSGDATT","PSGDCTT","PSGDISP","PSGPM","PSGDCT(" S ZTSAVE(X)=""

 I RTN="PRVR" S (ZTSAVE("PSGPRVRF"),ZTSAVE("PSGPRVRP"))="" S:PSGPRVRF ZTSAVE("PSGPRVRF(")=""

 F X="STRT","STOP","SD","FD" S ZTSAVE(X)=""

 ;

ENDEV ;

 K %ZIS,IO("Q"),IOP,ZTSK S PSGION=ION,%ZIS="Q",%ZIS("A")="Select PRINT DEVICE: ",%ZIS("B")="" W ! D ^%ZIS K %ZIS

 I POP S IOP=PSGION D ^%ZIS S POP=1 G OUT

 K PSGION I '$D(IO("Q")) G OUT

 ;

ENTSK ;

 K ZTIO

 ;

ENNOIO ;

 K ZTDTH,ZTSK S ZTRTN="DQ^PSGTI" S:$D(PSGTID) ZTDTH=PSGTID S:$D(PSJSYSL) ZTSAVE("PSJSYSL")="" F X="PSJSYSW0","PSJSYSW","PSJSYSP","PSJSYSP0","PSJSYSL","PSJSYSU","PSGTIR" I $D(@X) S ZTSAVE(X)=""

 D ^%ZTLOAD D:'$D(PSGTINC) ^%ZISC W:'$D(ZTSK) $C(7),!?3,"(Task NOT queued.)"

 ;

OUT ;

 K %ZIS,IOP,PSGTID,PSGTIR,ZTDESC,ZTDTH,ZTRTN,ZTDESC,ZTSAVE Q

 ;

ENPAT ;

 S (ZTSAVE("PSGP"),ZTSAVE("PSGP(0)"),ZTSAVE("PSJP*"))="" G ENDEV

 ;

DQ ; all Taskman calls come through here

 D @PSGTIR S ZTREQ="@" Q

PSGTI     ;BIR/CML3-UNIT DOSE-TASKMAN INTERFACE ;17 SEP 97 / 1:06 PM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**50**;16 DEC 97

 +2       ;

ENPL      ;

 +1        KILL %ZIS,IO("Q"),IOP

           SET PSGION=ION

           SET %ZIS="Q"

           SET %ZIS("A")="Print on DEVICE: "

           SET %ZIS("B")=""

           WRITE !

           DO ^%ZIS

           KILL IOP,%ZIS

           IF POP

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

                   SET IOP=PSGION

                   DO ^%ZIS

                   SET POP=1

 +2        IF '$DATA(IO("Q"))

               KILL PSGION,IOP

               QUIT 

 +3        KILL PSGTID,ZTSAVE

           SET PSGTIR="EN^PSGPL1"

           SET ZTDESC="UNIT DOSE PICK LIST RUN"

           FOR X="PSGPLS","PSGPLF","PSGPLG","PSGPLWG","PSGPLWGP"

               SET ZTSAVE(X)=""

               IF $DATA(PSJPRN)

                   SET ZTSAVE("PSJPRN")=""

 +4        IF $GET(RERUN)

               SET ZTSAVE("OG")=""

               SET ZTSAVE("RERUN")=""

 +5        IF POP

               WRITE !,?3,"The Pick List will compile, but not print."

               SET ZTIO=""

               DO ENNOIO

               SET IOP=PSGION

               DO ^%ZIS

               KILL IOP,PSGION

               SET IO("Q")=""

               QUIT 

 +6        GOTO ENTSK

 +7       ;

EN3       ;

 +1        KILL ZTSAVE

           SET PSGTIR="ENQ^PSG"_RTN

 +2        IF RTN="DCT"

               Begin DoDot:1

 +3                IF $DATA(PSGDCLW)

                       SET ZTSAVE("PSGDCLW(")=""

                   SET ZTDESC="UNIT DOSE DRUG COST REPORT"

                   IF $DATA(PSGDCTD)

                       SET ZTSAVE("PSGDCTD(")=""

                   FOR X="PSGDCTA","PSGATTL","PSGCTTL","PSGCNT","PSGDCTB","PSGDCTL","PSGDCTS"

                       SET ZTSAVE(X)=""

               End DoDot:1

 +4        FOR X="PSGDCT","PSGDCLW","PSGDCTD","PRDRG","PMDRG1","PR","PSGCLS","PSGCLS1","PSGDATT","PSGDCTT","PSGDISP","PSGPM","PSGDCT("

               SET ZTSAVE(X)=""

 +5        IF RTN="PRVR"

               SET (ZTSAVE("PSGPRVRF"),ZTSAVE("PSGPRVRP"))=""

               IF PSGPRVRF

                   SET ZTSAVE("PSGPRVRF(")=""

 +6        FOR X="STRT","STOP","SD","FD"

               SET ZTSAVE(X)=""

 +7       ;

ENDEV     ;

 +1        KILL %ZIS,IO("Q"),IOP,ZTSK

           SET PSGION=ION

           SET %ZIS="Q"

           SET %ZIS("A")="Select PRINT DEVICE: "

           SET %ZIS("B")=""

           WRITE !

           DO ^%ZIS

           KILL %ZIS

 +2        IF POP

               SET IOP=PSGION

               DO ^%ZIS

               SET POP=1

               GOTO OUT

 +3        KILL PSGION

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

               GOTO OUT

 +4       ;

ENTSK     ;

 +1        KILL ZTIO

 +2       ;

ENNOIO    ;

 +1        KILL ZTDTH,ZTSK

           SET ZTRTN="DQ^PSGTI"

           IF $DATA(PSGTID)

               SET ZTDTH=PSGTID

           IF $DATA(PSJSYSL)

               SET ZTSAVE("PSJSYSL")=""

           FOR X="PSJSYSW0","PSJSYSW","PSJSYSP","PSJSYSP0","PSJSYSL","PSJSYSU","PSGTIR"

               IF $DATA(@X)

                   SET ZTSAVE(X)=""

 +2        DO ^%ZTLOAD

           IF '$DATA(PSGTINC)

               DO ^%ZISC

           IF '$DATA(ZTSK)

               WRITE $CHAR(7),!?3,"(Task NOT queued.)"

 +3       ;

OUT       ;

 +1        KILL %ZIS,IOP,PSGTID,PSGTIR,ZTDESC,ZTDTH,ZTRTN,ZTDESC,ZTSAVE

           QUIT 

 +2       ;

ENPAT     ;

 +1        SET (ZTSAVE("PSGP"),ZTSAVE("PSGP(0)"),ZTSAVE("PSJP*"))=""

           GOTO ENDEV

 +2       ;

DQ        ; all Taskman calls come through here

 +1        DO @PSGTIR

           SET ZTREQ="@"

           QUIT