source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVDCR2.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1PSIVDCR2 ;BIR/PR,MLM-CONT. PRINT DRUG COST REPORT ;07 OCT 97 / 9:30 AM
2 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
3P1 ;Print drug name and bag counts
4 S I=" BAGS",N=""
5 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
6 Q
7P2 ;Sum bags for summary, get unit measure, print total drug cost and units
8 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)
9 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
10 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)
11 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 !
12 Q
13NO ;No patient data. This is indirection @S
14 S (U1,U2,U3,U4,WT,C1,C2,C3,C4)=0
15BRIEF ;Run a condensed report if $D(BRIEF). A condensed report will never
16 ;include patient data.
17 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
18 Q
19Y ;Patient data. This is indirection @S
20 S (U1,U2,U3,U4,WT,C1,C2,C3,C4)=0
21 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
22 Q
23Y1 ;Patient data continued
24 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
25 Q
261 ;Sum ward or patient units to get total drug units (U1-U4)
27 ;Sum ward or patient costs to get total drug cost (C1-C4)
28 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)
29 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)
30 ;
31 ;Sum total patient units to get total ward units.
32 ;Sum total patient cost to get total ward cost.
33 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)
34 Q
352 ;If patient data, print total ward units and total ward costs
36 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)
37 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 !
38 Q
39HI ;Check low/high cost
40 ;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
41 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
42 E S OK=0
43 Q
44F ;Form feed
45 D:$Y+5>IOSL H^PSIVDCR1
46 Q
Note: See TracBrowser for help on using the repository browser.