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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGTI 1951 printed Oct 16, 2024@18:04:09 Page 2
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
