PSIVRP1 ;BIR/MLM-REPRINT IV LABELS FROM WARD OR MANUFACTURING LIST (CONT. FROM PSIVRP) ;20 JUN 94 / 3:22 PM
;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA 2191.
;
DEQ ;
S STR=$S(LAST("LIST")="M":"LIST^PSIVT^PSIVDT^X1^X2^DFN^ON",1:"LIST^PSIVT^WRD^PSIVDT^DFN^ON") F X=1:1:$L(STR,"^") S @$P(STR,"^",X)=LAST($P(STR,"^",X))
S PSIVT=$E(PSIVDT,1),PSIVOD(PSIVT)=$E(PSIVDT,2,$L(PSIVDT)) D @($S($D(^PS(55,"PSIVWLM",PSIVSN,PSIVDT)):"MONL",1:"WONL")),QUIT
Q
GTDATE ;
I $D(PSR) S PSIVDT=$O(PSR(PSIVDT)) Q:PSIVDT="" S PSIVT=$E(PSIVDT,1),PSIVOD(PSIVT)=$E(PSIVDT,2,$L(PSIVDT)) D @($S($D(^PS(55,"PSIVWLM",PSIVSN,PSIVDT)):"X1",1:"WRD"))
Q
WONL ;
L +^PS(55,"PSIVWL",PSIVSN):1 E W:$Y @IOF W !!,"**** WARNING --- LABELS NOT RUN, WARD LIST IN PROGRESS" Q
D WON L -^PS(55,"PSIVWL",PSIVSN)
Q
MONL ;
L +^PS(55,"PSIVWLM",PSIVSN):1 E W:$Y @IOF W !!,"**** WARNING --- LABELS NOT RUN, MANUFACTURING LIST IN PROGRESS",! Q
D MON L -^PS(55,"PSIVWLM",PSIVSN)
Q
WRD ;
S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) G:WRD=""!(PSIVDT="") GTDATE I WRD="",('$D(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT))) G GTDATE
WDFN ;
S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN)) G:DFN="" WRD
WON ;
S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,+DFN,ON)) G:ON="" WDFN Q:DFN=NEXT("DFN")&(ON=NEXT("ON")) D MEOWRPT^PSIVLBL1 G WON
Q
X1 ;
S X1=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1)) I X1="" S WRD="" G GTDATE
X2 ;
S X2=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2)) G:X2="" X1
MDFN ;
S DFN=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,DFN)) G:DFN="" X2
MON ;
S ON=$O(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,+DFN,ON)) G:ON="" MDFN Q:DFN=NEXT("DFN")&(ON=NEXT("ON")) S WRD=$S($D(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,DFN,ON)):$P(^(ON),"^",2),1:"") D MEOWRPT^PSIVLBL1 G MON
Q
GTMES ;
S (WRD,ON)="" F X=0:0 S WRD=$O(^PS(55,"PSIVWL",PSIVSN,WRD)) Q:WRD="" S PSIVDT="" F X=0:0 S PSIVDT=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT)) Q:PSIVDT="" I PSIVDT[Y D GTMES1
Q
GTMES1 ;
S DFN="" F X=0:0 S DFN=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN)) Q:DFN=""!$D(PS(PSIVDT)) S ON="" F X=0:0 S ON=$O(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN,ON)) Q:ON=""!(ON="OK") D GTMES2
Q
GTMES2 ;
I $D(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN,ON)),$P(^(ON),"^",4) S PS(PSIVDT)=""
Q
QUIT ;
K C,D1,DFN,DIC,FILE,I,J,JJ,LAST,LIST,NAD,NEXT,NF,ON,P,POP,PRO,PS,PSCT,PSIVCD,PSIVMT,PSIVNOL,PSGDT,PSM,PSR,PSIVDRG,PSIVDT,PSIVDTS,PSIVST,PSIVT,PSIVOD,STR
K VAERR,WRD,X1,X2,X3,XT,XQUIT,Z,ZTDESC,ZTIO,ZTRTN,ZTSAVE D ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVRP1 2577 printed Sep 23, 2025@19:41:07 Page 2
PSIVRP1 ;BIR/MLM-REPRINT IV LABELS FROM WARD OR MANUFACTURING LIST (CONT. FROM PSIVRP) ;20 JUN 94 / 3:22 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ;
DEQ ;
+1 SET STR=$SELECT(LAST("LIST")="M":"LIST^PSIVT^PSIVDT^X1^X2^DFN^ON",1:"LIST^PSIVT^WRD^PSIVDT^DFN^ON")
FOR X=1:1:$LENGTH(STR,"^")
SET @$PIECE(STR,"^",X)=LAST($PIECE(STR,"^",X))
+2 SET PSIVT=$EXTRACT(PSIVDT,1)
SET PSIVOD(PSIVT)=$EXTRACT(PSIVDT,2,$LENGTH(PSIVDT))
DO @($SELECT($DATA(^PS(55,"PSIVWLM",PSIVSN,PSIVDT)):"MONL",1:"WONL"))
DO QUIT
+3 QUIT
GTDATE ;
+1 IF $DATA(PSR)
SET PSIVDT=$ORDER(PSR(PSIVDT))
if PSIVDT=""
QUIT
SET PSIVT=$EXTRACT(PSIVDT,1)
SET PSIVOD(PSIVT)=$EXTRACT(PSIVDT,2,$LENGTH(PSIVDT))
DO @($SELECT($DATA(^PS(55,"PSIVWLM",PSIVSN,PSIVDT)):"X1",1:"WRD"))
+2 QUIT
WONL ;
+1 LOCK +^PS(55,"PSIVWL",PSIVSN):1
IF '$TEST
if $Y
WRITE @IOF
WRITE !!,"**** WARNING --- LABELS NOT RUN, WARD LIST IN PROGRESS"
QUIT
+2 DO WON
LOCK -^PS(55,"PSIVWL",PSIVSN)
+3 QUIT
MONL ;
+1 LOCK +^PS(55,"PSIVWLM",PSIVSN):1
IF '$TEST
if $Y
WRITE @IOF
WRITE !!,"**** WARNING --- LABELS NOT RUN, MANUFACTURING LIST IN PROGRESS",!
QUIT
+2 DO MON
LOCK -^PS(55,"PSIVWLM",PSIVSN)
+3 QUIT
WRD ;
+1 SET WRD=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD))
if WRD=""!(PSIVDT="")
GOTO GTDATE
IF WRD=""
IF ('$DATA(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT)))
GOTO GTDATE
WDFN ;
+1 SET DFN=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN))
if DFN=""
GOTO WRD
WON ;
+1 SET ON=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,+DFN,ON))
if ON=""
GOTO WDFN
if DFN=NEXT("DFN")&(ON=NEXT("ON"))
QUIT
DO MEOWRPT^PSIVLBL1
GOTO WON
+2 QUIT
X1 ;
+1 SET X1=$ORDER(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1))
IF X1=""
SET WRD=""
GOTO GTDATE
X2 ;
+1 SET X2=$ORDER(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2))
if X2=""
GOTO X1
MDFN ;
+1 SET DFN=$ORDER(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,DFN))
if DFN=""
GOTO X2
MON ;
+1 SET ON=$ORDER(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,+DFN,ON))
if ON=""
GOTO MDFN
if DFN=NEXT("DFN")&(ON=NEXT("ON"))
QUIT
SET WRD=$SELECT($DATA(^PS(55,"PSIVWLM",PSIVSN,PSIVDT,PSIVT,X1,X2,DFN,ON)):$PIECE(^(ON),"^",2),1:"")
DO MEOWRPT^PSIVLBL1
GOTO MON
+2 QUIT
GTMES ;
+1 SET (WRD,ON)=""
FOR X=0:0
SET WRD=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD))
if WRD=""
QUIT
SET PSIVDT=""
FOR X=0:0
SET PSIVDT=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT))
if PSIVDT=""
QUIT
IF PSIVDT[Y
DO GTMES1
+2 QUIT
GTMES1 ;
+1 SET DFN=""
FOR X=0:0
SET DFN=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN))
if DFN=""!$DATA(PS(PSIVDT))
QUIT
SET ON=""
FOR X=0:0
SET ON=$ORDER(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN,ON))
if ON=""!(ON="OK")
QUIT
DO GTMES2
+2 QUIT
GTMES2 ;
+1 IF $DATA(^PS(55,"PSIVWL",PSIVSN,WRD,PSIVDT,DFN,ON))
IF $PIECE(^(ON),"^",4)
SET PS(PSIVDT)=""
+2 QUIT
QUIT ;
+1 KILL C,D1,DFN,DIC,FILE,I,J,JJ,LAST,LIST,NAD,NEXT,NF,ON,P,POP,PRO,PS,PSCT,PSIVCD,PSIVMT,PSIVNOL,PSGDT,PSM,PSR,PSIVDRG,PSIVDT,PSIVDTS,PSIVST,PSIVT,PSIVOD,STR
+2 KILL VAERR,WRD,X1,X2,X3,XT,XQUIT,Z,ZTDESC,ZTIO,ZTRTN,ZTSAVE
DO ENIVKV^PSGSETU
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
