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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVMAN 2503 printed Sep 23, 2025@19:40:31 Page 2
PSIVMAN ;BIR/RGY,PR-COMPILE MAN LST FROM WRD LIST ;27 NOV 95 / 12:57 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
+2 ;
START SET Y=1
WRITE !!,"Run manufacturing list for DATE: TODAY//"
READ X:DTIME
if '$TEST
GOTO Q
if X=""
SET X="T"
if X["^"
GOTO Q
IF X'["?"
SET %DT="EX"
DO ^%DT
+1 if Y<1
GOTO START
+2 IF X["?"
SET HELP="MLL"
DO ^PSIVHLP
SET X="?"
DO ^%DT
GOTO START
+3 SET PSIVDT=Y\1
DO ^PSIVWL1
if '$DATA(PSIVOD)!('$DATA(PSIVCD))
GOTO Q
+4 IF PSIVPR'=ION
DO QUE
GOTO Q
DEQ ;MANUFACTURING LIST START HERE
+1 LOCK +^PS(55,"PSIVWLM",PSIVSN):1
IF '$TEST
if $Y
WRITE @IOF
WRITE !!,"****WARNING --- MANUFACTURING LIST NOT RUN****"
GOTO Q
+2 SET PSIVT=""
FOR I=0:0
SET PSIVT=$ORDER(PSIVOD(PSIVT))
if PSIVT=""
QUIT
KILL ^PS(55,"PSIVWLM",PSIVSN,PSIVT_PSIVOD(PSIVT))
SET WRD=""
SET PSIVGL1="PSIVWLM"
SET PSIVGL2=PSIVT_PSIVOD(PSIVT)
FOR I=0:0
SET WRD=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD))
if WRD=""
QUIT
DO RGY
+3 SET PSIVTTM=""
FOR JJ=0:0
SET PSIVTTM=$ORDER(PSIVOD(PSIVTTM))
if PSIVTTM=""
QUIT
SET PSIVGL2=PSIVTTM_PSIVOD(PSIVTTM)
DO ENT^PSIVMAN1
Q LOCK -^PS(55,"PSIVWLM",PSIVSN)
if '$DATA(PSIVPR)&($Y)
WRITE @IOF
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL 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
DO ENIVKV^PSGSETU
QUIT
RGY FOR DFN=0:0
SET DFN=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN))
if 'DFN
QUIT
DO RGY1
+1 QUIT
RGY1 FOR ON=0:0
SET ON=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVT_PSIVOD(PSIVT),DFN,ON))
if 'ON
QUIT
SET PSIVTTM=+^(ON)_"^"_WRD
IF PSIVTTM
DO SETP
IF "EOHPD"'[P(17)
DO ENS
+1 QUIT
SETP SET Y=^PS(55,DFN,"IV",ON,0)
FOR X=1:1:23
SET P(X)=$PIECE(Y,"^",X)
+1 QUIT
QUE SET ZTIO=PSIVPR
SET ZTDESC="PRINT IV MANUFACTURING LIST"
SET ZTRTN="DEQ^PSIVMAN"
SET PSIVT=""
FOR I=0:0
SET PSIVT=$ORDER(PSIVMT(PSIVT))
if PSIVT=""
QUIT
SET (ZTSAVE("PSIVCD("""_PSIVT_""")"),ZTSAVE("PSIVMT("""_PSIVT_""")"),ZTSAVE("PSIVOD("""_PSIVT_""")"))=""
+1 FOR X="PSIVSN","PSIVDT","PSIVSITE","PSJSYSW0","PSJSYSP0","PSJSYSU"
SET ZTSAVE(X)=""
+2 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Queued."
QUIT
+3 ;
ENS ;
+1 SET P(4)=$PIECE(^PS(55,DFN,"IV",ON,0),"^",4)
SETS SET PSIVSOL=$SELECT($DATA(^(+$ORDER(^PS(55,DFN,"IV",ON,"SOL",0)),0)):^(0),1:"zz7")
IF PSIVSOL
SET PSIVSOL=$SELECT($DATA(^PS(52.7,+PSIVSOL,0)):$EXTRACT($PIECE(^(0),"^"),1,10)_"^"_$PIECE(PSIVSOL,"^",2),1:+PSIVSOL)_"^"_7_";"_+PSIVSOL
+1 ;
SETA SET PSIVADD=$SELECT($DATA(^(+$ORDER(^PS(55,DFN,"IV",ON,"AD",0)),0)):^(0),1:"zz6")
IF PSIVADD
SET PSIVADD=$SELECT($DATA(^PS(52.6,+PSIVADD,0)):$EXTRACT($PIECE(^(0),"^"),1,10)_"^"_$PIECE(PSIVADD,"^",2),1:+PSIVADD)_"^"_6_";"_+PSIVADD
+1 SET ^(0)=$SELECT($DATA(^PS(55,PSIVGL1,PSIVSN,PSIVGL2,P(4),$SELECT("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVADD,1:PSIVSOL),0)):+^(0),1:0)+PSIVTTM
SET ^($SELECT("PS"[P(4)!(P(23)="P"!(P(23)="S")):PSIVSOL,1:PSIVADD),DFN,ON)=PSIVTTM
+2 KILL PSIVTTM,PSIVADD,PSIVSOL
QUIT
