- 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 Jan 18, 2025@03:04:37 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