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

PSIVMAN.m

Go to the documentation of this file.
PSIVMAN ;BIR/RGY,PR-COMPILE MAN LST FROM WRD LIST ;27 NOV 95 / 12:57 PM
 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
 ;
START S Y=1 W !!,"Run manufacturing list for DATE: TODAY//" R X:DTIME G:'$T Q S:X="" X="T" G Q:X["^" I X'["?" S %DT="EX" D ^%DT
 G:Y<1 START
 I X["?" S HELP="MLL" D ^PSIVHLP S X="?" D ^%DT G START
 S PSIVDT=Y\1 D ^PSIVWL1 G:'$D(PSIVOD)!('$D(PSIVCD)) Q
 I PSIVPR'=ION D QUE G Q
DEQ ;MANUFACTURING LIST START HERE
 L +^PS(55,"PSIVWLM",PSIVSN):1 E  W:$Y @IOF W !!,"****WARNING --- MANUFACTURING LIST NOT RUN****" G Q
 S PSIVT="" F I=0:0 S PSIVT=$O(PSIVOD(PSIVT)) Q:PSIVT=""  K ^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT)) S WRD="",PSIVGL1="PSIVWLM",PSIVGL2=PSIVT_PSIVOD(PSIVT) F I=0:0 S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) Q:WRD=""  D RGY
 S PSIVTTM="" F JJ=0:0 S PSIVTTM=$O(PSIVOD(PSIVTTM)) Q:PSIVTTM=""  S PSIVGL2=PSIVTTM_PSIVOD(PSIVTTM) D ENT^PSIVMAN1
Q L -^PS(55,"PSIVWLM",PSIVSN) W:'$D(PSIVPR)&($Y) @IOF S:$D(ZTQUEUED) ZTREQ="@"
 K D,DA,JJ,JJ1,NOFLG,ON,P,PSCT,PSIVDT,PSIVOD,PSIVMT,PSIVGL1,PSIVGL2,PSIVSL,WRD,PSIVT,PSIVTTM,%,%T,%DT,DFN,I,X,Y,ZTM,ZTSK,ADD,PSIV1,PSIV,IOP,PSIVCD,PSIVT,TOTAL,VAERR,Z D ENIVKV^PSGSETU Q
RGY F DFN=0:0 S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN)) Q:'DFN  D RGY1
 Q
RGY1 F ON=0:0 S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON)) Q:'ON  S PSIVTTM=+^(ON)_"^"_WRD I PSIVTTM D SETP I "EOHPD"'[P(17) D ENS
 Q
SETP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
 Q
QUE S ZTIO=PSIVPR,ZTDESC="PRINT IV MANUFACTURING LIST",ZTRTN="DEQ^PSIVMAN",PSIVT="" F I=0:0 S PSIVT=$O(PSIVMT(PSIVT)) Q:PSIVT=""  S (ZTSAVE("PSIVCD("""_PSIVT_""")"),ZTSAVE("PSIVMT("""_PSIVT_""")"),ZTSAVE("PSIVOD("""_PSIVT_""")"))=""
 F X="PSIVSN","PSIVDT","PSIVSITE","PSJSYSW0","PSJSYSP0","PSJSYSU" S ZTSAVE(X)=""
 D ^%ZTLOAD W:$D(ZTSK) !,"Queued." Q
 ;
ENS ;
 S P(4)=$P(^PS(55,DFN,"IV",ON,0),"^",4)
SETS S PSIVSOL=$S($D(^(+$O(^PS(55,DFN,"IV",ON,"SOL",0)),0)):^(0),1:"zz7") I PSIVSOL S PSIVSOL=$S($D(^PS(52.7,+PSIVSOL,0)):$E($P(^(0),"^"),1,10)_"^"_$P(PSIVSOL,"^",2),1:+PSIVSOL)_"^"_7_";"_+PSIVSOL
 ;
SETA S PSIVADD=$S($D(^(+$O(^PS(55,DFN,"IV",ON,"AD",0)),0)):^(0),1:"zz6") I PSIVADD S PSIVADD=$S($D(^PS(52.6,+PSIVADD,0)):$E($P(^(0),"^"),1,10)_"^"_$P(PSIVADD,"^",2),1:+PSIVADD)_"^"_6_";"_+PSIVADD
 S ^(0)=$S($D(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,P(4),$S("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVADD,1:PSIVSOL),0)):+^(0),1:0)+PSIVTTM,^($S("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVSOL,1:PSIVADD),DFN,ON)=PSIVTTM
 K PSIVTTM,PSIVADD,PSIVSOL Q