PSIVDCR2 ;BIR/PR,MLM-CONT. PRINT DRUG COST REPORT ;07 OCT 97 / 9:30 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
P1 ;Print drug name and bag counts
S I=" BAGS",N=""
F Q=0:0 S N=$O(^UTILITY($J,V,DC,N)) Q:N="" S G=^(N,0) D:I2="HIGH" HI I OK D:$D(SMO) P2 I '$D(SMO) D F W !!,$E(N,1,34),?37,$P(G,U,20)_I,?61,$P(G,U,22)_I,?78,$P(G,U,21)_I,?97,$P(G,U,23)_I,?122,$P(G,U,20)-$P(G,U,21)-$P(G,U,23)_I W ! D P2
Q
P2 ;Sum bags for summary, get unit measure, print total drug cost and units
S B1=B1+$P(G,U,20),B2=B2+$P(G,U,22),B3=B3+$P(G,U,21),B4=B4+$P(G,U,23)
S C=$P(G,U),CC=$P(^DD(52.6,2,0),U,3),CC=$P(CC,";",C),CC=$P(CC,":",2),C=CC D @S
I '$D(BRIEF) D F W !,?30,L1,?53,L1,?71,L1,?90,L1,?117,L1,!?10,"TOTAL DRUG UNITS:",?30,$J(U1,14,2)_" "_C,?53,$J(U2,14,2),?74,$J(U3,11,2),?93,$J(U4,11,2),?114,$J(U1-U3-U4,17,2)
I '$D(SMO) D F W !,?30,L1,?53,L1,?71,L1,?90,L1,?117,L1,!?10,"TOTAL DRUG COST:",?29,"$",$J(C1,14,2),?52,"$",$J(C2,14,2),?70,"$",$J(C3,14,2),?89,"$",$J(C4,14,2),?113,"$",$J(WT,17,2) W !
Q
NO ;No patient data. This is indirection @S
S (U1,U2,U3,U4,WT,C1,C2,C3,C4)=0
BRIEF ;Run a condensed report if $D(BRIEF). A condensed report will never
;include patient data.
S N1="" F Q=0:0 D F S N1=$O(^UTILITY($J,V,DC,N,N1)) Q:N1="" I N1'=0 S G=^(N1,"NO",0) W:'$D(BRIEF) !?2,"WARD: ",N1,?30,$J($P(G,U,8),14,2)_" "_C,?53,$J($P(G,U,10),14,2),?74,$J($P(G,U,9),11,2),?93,$J($P(G,U,11),11,2),?113,"$",$J($P(G,U),17,2) D 1
Q
Y ;Patient data. This is indirection @S
S (U1,U2,U3,U4,WT,C1,C2,C3,C4)=0
F Q=0:0 S (P1,P2,P3,P4,P5,V1,V2,V3,V4)=0 D F S N1=$O(^UTILITY($J,V,DC,N,N1)) Q:N1="" I N1'=0 W !?2,"WARD: ",N1 F J=0:0 D F S P=$O(^UTILITY($J,V,DC,N,N1,P)) D:P="" 2 Q:P="" S G=^(P,0) D Y1
Q
Y1 ;Patient data continued
W !?3,$E($P(P,"/"),1,18)," (",$E($P(^DPT($P(P,"/",2),0),U,9),6,9),")",?30,$J($P(G,U,8),14,2)_" "_C,?53,$J($P(G,U,10),14,2),?74,$J($P(G,U,9),11,2),?93,$J($P(G,U,11),11,2),?113,"$",$J($P(G,U),17,2) D 1
Q
1 ;Sum ward or patient units to get total drug units (U1-U4)
;Sum ward or patient costs to get total drug cost (C1-C4)
S U1=U1+$P(G,U,8),U2=U2+$P(G,U,10),U3=U3+$P(G,U,9),U4=U4+$P(G,U,11),WT=WT+$P(G,U),G5=G5+$P(G,U)
S C1=C1+$P(G,U,40),C2=C2+$P(G,U,42),C3=C3+$P(G,U,41),C4=C4+$P(G,U,43),G1=G1+$P(G,U,40),G2=G2+$P(G,U,42),G3=G3+$P(G,U,41),G4=G4+$P(G,U,43)
;
;Sum total patient units to get total ward units.
;Sum total patient cost to get total ward cost.
I $D(PQ) S P1=P1+$P(G,U,8),P2=P2+$P(G,U,10),P3=P3+$P(G,U,9),P4=P4+$P(G,U,11),P5=P5+$P(G,U),V1=V1+$P(G,U,40),V2=V2+$P(G,U,42),V3=V3+$P(G,U,41),V4=V4+$P(G,U,43)
Q
2 ;If patient data, print total ward units and total ward costs
D F W !?30,L2,?53,L2,?71,L2,?90,L2,?117,L2,!?6,"TOTAL WARD UNITS:",?30,$J(P1,14,2)_" "_C,?53,$J(P2,14,2),?74,$J(P3,11,2),?93,$J(P4,11,2),?114,$J(P1-P3-P4,17,2)
D F W !?30,L2,?53,L2,?71,L2,?90,L2,?117,L2,!?6,"TOTAL WARD COST:",?29,"$",$J(V1,14,2),?52,"$",$J(V2,14,2),?70,"$",$J(V3,14,2),?89,"$",$J(V4,14,2),?113,"$",$J(P5,17,2) W !
Q
HI ;Check low/high cost
;S DCO=$P(G,U,5) I DCO'>UCO&(DCO'<LCO) S OK=1,^UTILITY("PSIV",$J,$S($D(^PS(59.5,V,0)):$P(^(0),U),1:"NF"),999999999999999999-DCO,N)=DCO
S DCO=$P(G,U,5) I DCO'>UCO&(DCO'<LCO) S OK=1,^UTILITY("PSIV",$J,$S($D(^PS(59.5,V,0)):$P(^(0),U),1:"NF"),-DCO,N)=DCO
E S OK=0
Q
F ;Form feed
D:$Y+5>IOSL H^PSIVDCR1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVDCR2 3321 printed Sep 23, 2025@19:40:09 Page 2
PSIVDCR2 ;BIR/PR,MLM-CONT. PRINT DRUG COST REPORT ;07 OCT 97 / 9:30 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
P1 ;Print drug name and bag counts
+1 SET I=" BAGS"
SET N=""
+2 FOR Q=0:0
SET N=$ORDER(^UTILITY($JOB,V,DC,N))
if N=""
QUIT
SET G=^(N,0)
if I2="HIGH"
DO HI
IF OK
if $DATA(SMO)
DO P2
IF '$DATA(SMO)
DO F
WRITE !!,$EXTRACT(N,1,34),?37,$PIECE(G,U,20)_I,?61,$PIECE(G,U,22)_I,?78,$PIECE(G,U,21)_I,?97,$PIECE(G,U,23)_I,?122,$PIECE(G,U,20)-$PIECE(G,U,21)-$PIECE(G,U,23)_I
WRITE !
DO P2
+3 QUIT
P2 ;Sum bags for summary, get unit measure, print total drug cost and units
+1 SET B1=B1+$PIECE(G,U,20)
SET B2=B2+$PIECE(G,U,22)
SET B3=B3+$PIECE(G,U,21)
SET B4=B4+$PIECE(G,U,23)
+2 SET C=$PIECE(G,U)
SET CC=$PIECE(^DD(52.6,2,0),U,3)
SET CC=$PIECE(CC,";",C)
SET CC=$PIECE(CC,":",2)
SET C=CC
DO @S
+3 IF '$DATA(BRIEF)
DO F
WRITE !,?30,L1,?53,L1,?71,L1,?90,L1,?117,L1,!?10,"TOTAL DRUG UNITS:",?30,$JUSTIFY(U1,14,2)_" "_C,?53,$JUSTIFY(U2,14,2),?74,$JUSTIFY(U3,11,2),?93,$JUSTIFY(U4,11,2),?114,$JUSTIFY(U1-U3-U4,17,2)
+4 IF '$DATA(SMO)
DO F
WRITE !,?30,L1,?53,L1,?71,L1,?90,L1,?117,L1,!?10,"TOTAL DRUG COST:",?29,"$",$JUSTIFY(C1,14,2),?52,"$",$JUSTIFY(C2,14,2),?70,"$",$JUSTIFY(C3,14,2),?89,"$",$JUSTIFY(C4,14,2),?113,"$",$JUSTIFY(WT,17,2)
WRITE !
+5 QUIT
NO ;No patient data. This is indirection @S
+1 SET (U1,U2,U3,U4,WT,C1,C2,C3,C4)=0
BRIEF ;Run a condensed report if $D(BRIEF). A condensed report will never
+1 ;include patient data.
+2 SET N1=""
FOR Q=0:0
DO F
SET N1=$ORDER(^UTILITY($JOB,V,DC,N,N1))
if N1=""
QUIT
IF N1'=0
SET G=^(N1,"NO",0)
if '$DATA(BRIEF)
WRITE !?2,"WARD: ",N1,?30,$JUSTIFY($PIECE(G,U,8),14,2)_" "_C,?53,$JUSTIFY($PIECE(G,U,10),14,2),?74,$JUSTIFY($PIECE(G,U,9),11,2),?93,$JUSTIFY($PIECE(G,U,11),11,2),?113,"$",$JUSTIFY($PIECE(G,U),17,2)
DO 1
+3 QUIT
Y ;Patient data. This is indirection @S
+1 SET (U1,U2,U3,U4,WT,C1,C2,C3,C4)=0
+2 FOR Q=0:0
SET (P1,P2,P3,P4,P5,V1,V2,V3,V4)=0
DO F
SET N1=$ORDER(^UTILITY($JOB,V,DC,N,N1))
if N1=""
QUIT
IF N1'=0
WRITE !?2,"WARD: ",N1
FOR J=0:0
DO F
SET P=$ORDER(^UTILITY($JOB,V,DC,N,N1,P))
if P=""
DO 2
if P=""
QUIT
SET G=^(P,0)
DO Y1
+3 QUIT
Y1 ;Patient data continued
+1 WRITE !?3,$EXTRACT($PIECE(P,"/"),1,18)," (",$EXTRACT($PIECE(^DPT($PIECE(P,"/",2),0),U,9),6,9),")",?30,$JUSTIFY($PIECE(G,U,8),14,2)_" "_C,?53,$JUSTIFY($PIECE(G,U,10),14,2),?74,$JUSTIFY($PIECE(G,U,9),11,2),?93,...
... $JUSTIFY($PIECE(G,U,11),11,2),?113,"$",$JUSTIFY($PIECE(G,U),17,2)
DO 1
+2 QUIT
1 ;Sum ward or patient units to get total drug units (U1-U4)
+1 ;Sum ward or patient costs to get total drug cost (C1-C4)
+2 SET U1=U1+$PIECE(G,U,8)
SET U2=U2+$PIECE(G,U,10)
SET U3=U3+$PIECE(G,U,9)
SET U4=U4+$PIECE(G,U,11)
SET WT=WT+$PIECE(G,U)
SET G5=G5+$PIECE(G,U)
+3 SET C1=C1+$PIECE(G,U,40)
SET C2=C2+$PIECE(G,U,42)
SET C3=C3+$PIECE(G,U,41)
SET C4=C4+$PIECE(G,U,43)
SET G1=G1+$PIECE(G,U,40)
SET G2=G2+$PIECE(G,U,42)
SET G3=G3+$PIECE(G,U,41)
SET G4=G4+$PIECE(G,U,43)
+4 ;
+5 ;Sum total patient units to get total ward units.
+6 ;Sum total patient cost to get total ward cost.
+7 IF $DATA(PQ)
SET P1=P1+$PIECE(G,U,8)
SET P2=P2+$PIECE(G,U,10)
SET P3=P3+$PIECE(G,U,9)
SET P4=P4+$PIECE(G,U,11)
SET P5=P5+$PIECE(G,U)
SET V1=V1+$PIECE(G,U,40)
SET V2=V2+$PIECE(G,U,42)
SET V3=V3+$PIECE(G,U,41)
SET V4=V4+$PIECE(G,U,43)
+8 QUIT
2 ;If patient data, print total ward units and total ward costs
+1 DO F
WRITE !?30,L2,?53,L2,?71,L2,?90,L2,?117,L2,!?6,"TOTAL WARD UNITS:",?30,$JUSTIFY(P1,14,2)_" "_C,?53,$JUSTIFY(P2,14,2),?74,$JUSTIFY(P3,11,2),?93,$JUSTIFY(P4,11,2),?114,$JUSTIFY(P1-P3-P4,17,2)
+2 DO F
WRITE !?30,L2,?53,L2,?71,L2,?90,L2,?117,L2,!?6,"TOTAL WARD COST:",?29,"$",$JUSTIFY(V1,14,2),?52,"$",$JUSTIFY(V2,14,2),?70,"$",$JUSTIFY(V3,14,2),?89,"$",$JUSTIFY(V4,14,2),?113,"$",$JUSTIFY(P5,17,2)
WRITE !
+3 QUIT
HI ;Check low/high cost
+1 ;S DCO=$P(G,U,5) I DCO'>UCO&(DCO'<LCO) S OK=1,^UTILITY("PSIV",$J,$S($D(^PS(59.5,V,0)):$P(^(0),U),1:"NF"),999999999999999999-DCO,N)=DCO
+2 SET DCO=$PIECE(G,U,5)
IF DCO'>UCO&(DCO'<LCO)
SET OK=1
SET ^UTILITY("PSIV",$JOB,$SELECT($DATA(^PS(59.5,V,0)):$PIECE(^(0),U),1:"NF"),-DCO,N)=DCO
+3 IF '$TEST
SET OK=0
+4 QUIT
F ;Form feed
+1 if $Y+5>IOSL
DO H^PSIVDCR1
+2 QUIT
