- 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
- 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
