PSIVDCR1 ;BIR/PR,MLM-PRINT DRUG COST REPORT ;29 SEP 94 / 10:09 AM
;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
W ;Entry to print report.
I $D(LCO),$D(^UTILITY($J)) S V="" F V=0:0 S V=$O(^UTILITY($J,V)) Q:'V S DRUG="" F J=0:0 S DRUG=$O(^UTILITY($J,V,"H",DRUG)) Q:DRUG="" S:$D(^UTILITY($J,V,"H",DRUG,0)) DC=$P(^(0),U,5) I DC'>UCO,(DC'<LCO) D RESORT
I $D(LCO) F V=0:0 S V=$O(^UTILITY($J,V)) Q:'V K ^UTILITY($J,V,"H")
S (B1,B2,B4,B3,G5,E,G1,G2,G4,G3)=0,OK=1,L1="==============",L2="--------------"
U IO S S=$S($D(PQ):"Y",1:"NO"),Y=I7 X ^DD("DD") S H=Y,Y=I8 X ^DD("DD") S H=H_" THROUGH "_Y,%H=$H D YX^%DTC S US="PRINTED BY: "_($P(^VA(200,DUZ,0),U))_" ON "_Y D H I '$D(^UTILITY($J)) W !,"NO DATA." W:$E(IOST)'="C"&($Y) @IOF D ^%ZISC G K
D P,K Q
H ;Header
S E=E+1 W:$Y @IOF W !?60,"IV DRUG COST REPORT ("_$S($D(BRIEF)&($D(SMO)):"SUMMARY ONLY",$D(BRIEF)&('$D(SMO)):"CONDENSED",1:"REGULAR"),") FOR:",?120,"PAGE:",E
W !?60,H,!?60,I15,!?60,I10,!?60,US,!! I '$D(LP) W:'$D(SMO) ?122,"UNITS",!,"IV ROOM/DRUG" W $S('$D(BRIEF):"/WARD",1:"")_$S($D(PQ):"/PATIENT",1:""),?35,"DISPENSED",?56,"(DESTROYED)",?77,"RECYCLED",?96,"CANCELLED",?124,"COST",!
F Q=1:1:132 W "=" W:Q=132 !
Q
P ;Print IV room, grand total cost
F V=0:0 D F S V=$O(^UTILITY($J,V)) W:'V ! Q:'V W:'$D(SMO) !,"IV ROOM: ",$S($D(^PS(59.5,V,0)):$P(^(0),U),1:"NF") S (N,N1,P)="" S DC="" F J=0:0 S DC=$O(^UTILITY($J,V,DC)) Q:DC="" D P1^PSIVDCR2
I $D(LCO),'$D(^UTILITY("PSIV",$J)) W !,"NO DATA." W:$E(IOST)'="C"&($Y) @IOF D ^%ZISC G K
F L=1:1:2 D F W:'$D(SMO) !?30,L1,?53,L1,?71,L1,?90,L1,?117,L1 I L=2 W !!?11,"GRAND TOTAL COST: ",?28,"$",$J(G1,14,2),?52,"$",$J(G2,14,2),?70,"$",$J(G3,14,2),?89,"$",$J(G4,14,2),?113,"$",$J(G5,17,2)
;
S ;Print high/low cost in descending sort
K LP I I2="HIGH",'$D(SMO) S LP=1 D H W !,"DESCENDING SORT:"
I $D(LP) S V="" F I=0:0 S V=$O(^UTILITY("PSIV",$J,V)) Q:V="" D F W !!,"IV ROOM: ",V,! S C="" F S C=$O(^UTILITY("PSIV",$J,V,C)) Q:'C S SD="" F Q=0:0 S SD=$O(^UTILITY("PSIV",$J,V,C,SD)) Q:SD="" D F W ?30,SD,?90,"$",$J(^(SD),15,2),!
SP ;Print out summary page
I B1!(G1) S LP=1 I '$D(SMO) D H
I B1 W !!!!?16,"BAG SUMMARY:"
I W !,?17,"DESTROYED",?40,"=",?40,$J(B2/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS",!?17,"RECYCLED",?40,"=",?40,$J(B3/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS",!?17,"CANCELLED",?40,"=",?40,$J(B4/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS"
I G1 W !!?16,"COST SUMMARY:"
I W !,?17,"DESTROYED",?40,"=",?40,$J(G2/G1*100,6,2)_" %",?80,"OF DISPENSED COST",!?17,"RECYCLED",?40,"=",?40,$J(G3/G1*100,6,2)_" %",?80,"OF DISPENSED COST",!?17,"CANCELLED",?40,"=",?40,$J(G4/G1*100,6,2)_" %",?80,"OF DISPENSED COST"
;
TM ;
W !!!?17,"FINISHED PRINTING ON: " D NOW^%DTC S Y=% X ^DD("DD") W Y,@IOF K ZTSK D ^%ZISC
K ;
S:$D(ZTQUEUED) ZTREQ="@"
K %,A,B,B1,B2,B3,B4,C,CC,C1,C3,C2,C3,C4,C5,DATA,DC,DD,E,G1,G2,G3,G4,G5,GG,H,I,II,I2,I6,I7,I8,I10,L,L1,L2,LP,N,N1,OK,P,P1,P2,P3,P4,P5,PQ,Q,SD,SUS,U1,U2,U3,U4,UCO,V1,V2,V3,V4,WT,^UTILITY("PSIV",$J)
Q
;
F ;Form feed
I $Y+5>IOSL D H
Q
RESORT ;
S ^UTILITY($J,V,-DC,DRUG,0)=^UTILITY($J,V,"H",DRUG,0),WD="" F J=0:0 S WD=$O(^UTILITY($J,V,"H",DRUG,WD)) Q:WD="" S PN="" F J=0:0 S PN=$O(^UTILITY($J,V,"H",DRUG,WD,PN)) Q:PN="" D RESORT1
Q
RESORT1 ;
S:$D(^UTILITY($J,V,"H",DRUG,WD,PN,0)) ^UTILITY($J,V,-DC,DRUG,WD,PN,0)=^UTILITY($J,V,"H",DRUG,WD,PN,0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVDCR1 3341 printed Sep 23, 2025@19:40:08 Page 2
PSIVDCR1 ;BIR/PR,MLM-PRINT DRUG COST REPORT ;29 SEP 94 / 10:09 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
W ;Entry to print report.
+1 IF $DATA(LCO)
IF $DATA(^UTILITY($JOB))
SET V=""
FOR V=0:0
SET V=$ORDER(^UTILITY($JOB,V))
if 'V
QUIT
SET DRUG=""
FOR J=0:0
SET DRUG=$ORDER(^UTILITY($JOB,V,"H",DRUG))
if DRUG=""
QUIT
if $DATA(^UTILITY($JOB,V,"H",DRUG,0))
SET DC=$PIECE(^(0),U,5)
IF DC'>UCO
IF (DC'<LCO)
DO RESORT
+2 IF $DATA(LCO)
FOR V=0:0
SET V=$ORDER(^UTILITY($JOB,V))
if 'V
QUIT
KILL ^UTILITY($JOB,V,"H")
+3 SET (B1,B2,B4,B3,G5,E,G1,G2,G4,G3)=0
SET OK=1
SET L1="=============="
SET L2="--------------"
+4 USE IO
SET S=$SELECT($DATA(PQ):"Y",1:"NO")
SET Y=I7
XECUTE ^DD("DD")
SET H=Y
SET Y=I8
XECUTE ^DD("DD")
SET H=H_" THROUGH "_Y
SET %H=$HOROLOG
DO YX^%DTC
SET US="PRINTED BY: "_($PIECE(^VA(200,DUZ,0),U))_" ON "_Y
DO H
IF '$DATA(^UTILITY($JOB))
WRITE !,"NO DATA."
if $EXTRACT(IOST)'="C"&($Y)
WRITE @IOF
DO ^%ZISC
GOTO K
+5 DO P
DO K
QUIT
H ;Header
+1 SET E=E+1
if $Y
WRITE @IOF
WRITE !?60,"IV DRUG COST REPORT ("_$SELECT($DATA(BRIEF)&($DATA(SMO)):"SUMMARY ONLY",$DATA(BRIEF)&('$DATA(SMO)):"CONDENSED",1:"REGULAR"),") FOR:",?120,"PAGE:",E
+2 WRITE !?60,H,!?60,I15,!?60,I10,!?60,US,!!
IF '$DATA(LP)
if '$DATA(SMO)
WRITE ?122,"UNITS",!,"IV ROOM/DRUG"
WRITE $SELECT('$DATA(BRIEF):"/WARD",1:"")_$SELECT($DATA(PQ):"/PATIENT",1:""),?35,"DISPENSED",?56,"(DESTROYED)",?77,"RECYCLED",?96,"CANCELLED",?124,"COST",!
+3 FOR Q=1:1:132
WRITE "="
if Q=132
WRITE !
+4 QUIT
P ;Print IV room, grand total cost
+1 FOR V=0:0
DO F
SET V=$ORDER(^UTILITY($JOB,V))
if 'V
WRITE !
if 'V
QUIT
if '$DATA(SMO)
WRITE !,"IV ROOM: ",$SELECT($DATA(^PS(59.5,V,0)):$PIECE(^(0),U),1:"NF")
SET (N,N1,P)=""
SET DC=""
FOR J=0:0
SET DC=$ORDER(^UTILITY($JOB,V,DC))
if DC=""
QUIT
DO P1^PSIVDCR2
+2 IF $DATA(LCO)
IF '$DATA(^UTILITY("PSIV",$JOB))
WRITE !,"NO DATA."
if $EXTRACT(IOST)'="C"&($Y)
WRITE @IOF
DO ^%ZISC
GOTO K
+3 FOR L=1:1:2
DO F
if '$DATA(SMO)
WRITE !?30,L1,?53,L1,?71,L1,?90,L1,?117,L1
IF L=2
WRITE !!?11,"GRAND TOTAL COST: ",?28,"$",$JUSTIFY(G1,14,2),?52,"$",$JUSTIFY(G2,14,2),?70,"$",$JUSTIFY(G3,14,2),?89,"$",$JUSTIFY(G4,14,2),?113,"$",$JUSTIFY(G5,17,2)
+4 ;
S ;Print high/low cost in descending sort
+1 KILL LP
IF I2="HIGH"
IF '$DATA(SMO)
SET LP=1
DO H
WRITE !,"DESCENDING SORT:"
+2 IF $DATA(LP)
SET V=""
FOR I=0:0
SET V=$ORDER(^UTILITY("PSIV",$JOB,V))
if V=""
QUIT
DO F
WRITE !!,"IV ROOM: ",V,!
SET C=""
FOR
SET C=$ORDER(^UTILITY("PSIV",$JOB,V,C))
if 'C
QUIT
SET SD=""
FOR Q=0:0
SET SD=$ORDER(^UTILITY("PSIV",$JOB,V,C,SD))
if SD=""
QUIT
DO F
WRITE ?30,SD,?90,"$",$JUSTIFY(^(SD),15,2),!
SP ;Print out summary page
+1 IF B1!(G1)
SET LP=1
IF '$DATA(SMO)
DO H
+2 IF B1
WRITE !!!!?16,"BAG SUMMARY:"
+3 IF $TEST
WRITE !,?17,"DESTROYED",?40,"=",?40,$JUSTIFY(B2/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS",!?17,"RECYCLED",?40,"=",?40,$JUSTIFY(B3/B1*100,6,2)_" %",?80,"OF DISPENSED BAGS",!?17,"CANCELLED",?40,"=",?40,$JUSTIFY(B4/B1*100,6,2)_" %",?80,"OF DISP
ENSED BAGS"
+4 IF G1
WRITE !!?16,"COST SUMMARY:"
+5 IF $TEST
WRITE !,?17,"DESTROYED",?40,"=",?40,$JUSTIFY(G2/G1*100,6,2)_" %",?80,"OF DISPENSED COST",!?17,"RECYCLED",?40,"=",?40,$JUSTIFY(G3/G1*100,6,2)_" %",?80,"OF DISPENSED COST",!?17,"CANCELLED",?40,"=",?40,$JUSTIFY(G4/G1*100,6,2)_" %",?80,"OF DISP
ENSED COST"
+6 ;
TM ;
+1 WRITE !!!?17,"FINISHED PRINTING ON: "
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
WRITE Y,@IOF
KILL ZTSK
DO ^%ZISC
K ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL %,A,B,B1,B2,B3,B4,C,CC,C1,C3,C2,C3,C4,C5,DATA,DC,DD,E,G1,G2,G3,G4,G5,GG,H,I,II,I2,I6,I7,I8,I10,L,L1,L2,LP,N,N1,OK,P,P1,P2,P3,P4,P5,PQ,Q,SD,SUS,U1,U2,U3,U4,UCO,V1,V2,V3,V4,WT,^UTILITY("PSIV",$JOB)
+3 QUIT
+4 ;
F ;Form feed
+1 IF $Y+5>IOSL
DO H
+2 QUIT
RESORT ;
+1 SET ^UTILITY($JOB,V,-DC,DRUG,0)=^UTILITY($JOB,V,"H",DRUG,0)
SET WD=""
FOR J=0:0
SET WD=$ORDER(^UTILITY($JOB,V,"H",DRUG,WD))
if WD=""
QUIT
SET PN=""
FOR J=0:0
SET PN=$ORDER(^UTILITY($JOB,V,"H",DRUG,WD,PN))
if PN=""
QUIT
DO RESORT1
+2 QUIT
RESORT1 ;
+1 if $DATA(^UTILITY($JOB,V,"H",DRUG,WD,PN,0))
SET ^UTILITY($JOB,V,-DC,DRUG,WD,PN,0)=^UTILITY($JOB,V,"H",DRUG,WD,PN,0)
+2 QUIT
