Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSGTI

PSGTI.m

Go to the documentation of this file.
  1. PSGTI ;BIR/CML3-UNIT DOSE-TASKMAN INTERFACE ;17 SEP 97 / 1:06 PM
  1. ;;5.0; INPATIENT MEDICATIONS ;**50**;16 DEC 97
  1. ;
  1. ENPL ;
  1. 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
  1. I '$D(IO("Q")) K PSGION,IOP Q
  1. 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")=""
  1. I $G(RERUN) S ZTSAVE("OG")="",ZTSAVE("RERUN")=""
  1. 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
  1. G ENTSK
  1. ;
  1. EN3 ;
  1. K ZTSAVE S PSGTIR="ENQ^PSG"_RTN
  1. I RTN="DCT" D
  1. .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)=""
  1. F X="PSGDCT","PSGDCLW","PSGDCTD","PRDRG","PMDRG1","PR","PSGCLS","PSGCLS1","PSGDATT","PSGDCTT","PSGDISP","PSGPM","PSGDCT(" S ZTSAVE(X)=""
  1. I RTN="PRVR" S (ZTSAVE("PSGPRVRF"),ZTSAVE("PSGPRVRP"))="" S:PSGPRVRF ZTSAVE("PSGPRVRF(")=""
  1. F X="STRT","STOP","SD","FD" S ZTSAVE(X)=""
  1. ;
  1. ENDEV ;
  1. K %ZIS,IO("Q"),IOP,ZTSK S PSGION=ION,%ZIS="Q",%ZIS("A")="Select PRINT DEVICE: ",%ZIS("B")="" W ! D ^%ZIS K %ZIS
  1. I POP S IOP=PSGION D ^%ZIS S POP=1 G OUT
  1. K PSGION I '$D(IO("Q")) G OUT
  1. ;
  1. ENTSK ;
  1. K ZTIO
  1. ;
  1. ENNOIO ;
  1. 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)=""
  1. D ^%ZTLOAD D:'$D(PSGTINC) ^%ZISC W:'$D(ZTSK) $C(7),!?3,"(Task NOT queued.)"
  1. ;
  1. OUT ;
  1. K %ZIS,IOP,PSGTID,PSGTIR,ZTDESC,ZTDTH,ZTRTN,ZTDESC,ZTSAVE Q
  1. ;
  1. ENPAT ;
  1. S (ZTSAVE("PSGP"),ZTSAVE("PSGP(0)"),ZTSAVE("PSJP*"))="" G ENDEV
  1. ;
  1. DQ ; all Taskman calls come through here
  1. D @PSGTIR S ZTREQ="@" Q