- 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 Mar 13, 2025@21:08:54 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
