| 1 | PSIVWRP ;BIR/PR-WARD/DRUG USAGE REPORT ;20 JUN 94 / 2:35 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
|
|---|
| 3 | S S=$S(I3&(I2):1,'I3&('I2):2,I3&('I2):3,1:4)
|
|---|
| 4 | I I2["NON" S S=$S(I3:5,1:6)
|
|---|
| 5 | I I2["." S S=$S('I3:7,1:8)
|
|---|
| 6 | S (TD,TC,PC)=0,ZF="TOTAL FOR WARD: ",Y=I7 X ^DD("DD") S F=Y,Y=I8 X ^DD("DD") S L=Y,H=F_" THROUGH "_L,Y=DT X ^DD("DD") S NOW=Y
|
|---|
| 7 | K ^UTILITY($J),VA F V=0:0 S V=$O(^PS(50.8,V)) Q:'V I $D(^PS(50.8,V,2)) F ST=I7-1:0 S ST=$O(^PS(50.8,V,2,ST)) Q:'ST!(ST>I8) S NA="" D @S
|
|---|
| 8 | Q G:'$D(I6) W S ZTIO=I6,ZTDESC="WARD/DRUG USAGE REPORT (IV)",ZTRTN="W^PSIVWRP",ZTDTH=$H
|
|---|
| 9 | F G="^UTILITY($J,","I7","I8","H","NOW","I3","I2","PC","TD","TC","ZF","I11","I10" S ZTSAVE(G)=""
|
|---|
| 10 | S %ZIS="QN",IOP=I6 D ^%ZIS,^%ZTLOAD G K
|
|---|
| 11 | W U IO I '$D(^UTILITY($J)) D H W !,$C(7),"No data." D ^%ZISC G K
|
|---|
| 12 | S AL="" F V=0:0 S V=$O(^UTILITY($J,V)) Q:'V D H W !,"IV ROOM: "_$P(^PS(59.5,V,0),U),! D P
|
|---|
| 13 | D T
|
|---|
| 14 | Q
|
|---|
| 15 | 5 ;N 1 w
|
|---|
| 16 | F J=0:0 S NA=$O(^PS(50.8,V,2,ST,2,"B",NA)) Q:NA="" S DA=$O(^(+$O(^(NA,0)),0)) I DA D:^(DA)=1&($D(^PS(50.8,V,2,ST,2,DA,0)))&($D(^(3,I3,0))) B
|
|---|
| 17 | Q
|
|---|
| 18 | 6 ;N all w
|
|---|
| 19 | F J=0:0 S NA=$O(^PS(50.8,V,2,ST,2,"B",NA)) Q:NA="" S DA=$O(^(+$O(^(NA,0)),0)) I DA,^(DA)=1,$D(^PS(50.8,V,2,ST,2,DA,0)) F I3=0:0 S I3=$O(^PS(50.8,V,2,ST,2,DA,3,I3)) Q:'I3 D B
|
|---|
| 20 | Q
|
|---|
| 21 | 1 ;1 d 1 w
|
|---|
| 22 | F J=0:0 S NA=$O(^PS(50.8,V,2,ST,2,"B",NA)) Q:NA="" S DA=$O(^(NA,I2,0)) I DA,$D(^PS(50.8,V,2,ST,2,DA,0)),$D(^(3,I3,0)) D B
|
|---|
| 23 | Q
|
|---|
| 24 | 2 ;
|
|---|
| 25 | F DA=0:0 S DA=$O(^PS(50.8,V,2,ST,2,DA)) Q:'DA I $D(^(DA,0)) F I3=0:0 S I3=$O(^PS(50.8,V,2,ST,2,DA,3,I3)) Q:'I3 I $D(^(I3,0)) D B
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | 3 ;
|
|---|
| 29 | F DA=0:0 S DA=$O(^PS(50.8,V,2,ST,2,DA)) Q:'DA I $D(^(DA,0)),$D(^(3,I3,0)) D B
|
|---|
| 30 | Q
|
|---|
| 31 | 4 ;
|
|---|
| 32 | F J=0:0 S NA=$O(^PS(50.8,V,2,ST,2,"B",NA)) Q:NA="" S DA=$O(^(NA,I2,0)) I DA F I3=0:0 S I3=$O(^PS(50.8,V,2,ST,2,DA,3,I3)) Q:'I3 D B
|
|---|
| 33 | Q
|
|---|
| 34 | 7 ;
|
|---|
| 35 | F J=0:0 S NA=$O(^PS(50.8,V,2,ST,2,"B",NA)) Q:NA="" F D5=0:0 S D5=$O(^PS(50.8,V,2,ST,2,"B",NA,D5)) Q:'D5 S DA=$O(^(D5,0)) Q:'DA D:I2["V." 71 I '$D(VA),$D(^PS(50.2,"AD",$P(I2,".",2),D5)) F I3=0:0 S I3=$O(^PS(50.8,V,2,ST,2,DA,3,I3)) Q:'I3 D B
|
|---|
| 36 | Q
|
|---|
| 37 | 71 ;
|
|---|
| 38 | S VA=1
|
|---|
| 39 | I I2["000" S MT=$E(I2,3,4) I $E($P(^PSDRUG(D5,0),U,2),1,2)=MT F I3=0:0 S I3=$O(^PS(50.8,V,2,ST,2,DA,3,I3)) Q:'I3 D B
|
|---|
| 40 | Q:I2["000"
|
|---|
| 41 | I $P(^PSDRUG(D5,0),U,2)=$P(I2,".",2) F I3=0:0 S I3=$O(^PS(50.8,V,2,ST,2,DA,3,I3)) Q:'I3 D B
|
|---|
| 42 | Q
|
|---|
| 43 | 8 ;
|
|---|
| 44 | F J=0:0 S NA=$O(^PS(50.8,V,2,ST,2,"B",NA)) Q:NA="" F D5=0:0 S D5=$O(^PS(50.8,V,2,ST,2,"B",NA,D5)) Q:'D5 S DA=$O(^(D5,0)) Q:'DA D:I2["V." 81 I '$D(VA),$D(^PS(50.2,"AD",$P(I2,".",2),D5)),$D(^PS(50.8,V,2,ST,2,DA,3,I3,0)) D B
|
|---|
| 45 | Q
|
|---|
| 46 | 81 ;
|
|---|
| 47 | S VA=1
|
|---|
| 48 | I I2["000" S MT=$E(I2,3,4) I $E($P(^PSDRUG(D5,0),U,2),1,2)=MT,$D(^PS(50.8,V,2,ST,2,DA,3,I3,0)) D B
|
|---|
| 49 | Q:I2["000"
|
|---|
| 50 | I $P(^PSDRUG(D5,0),U,2)=$P(I2,".",2),$D(^PS(50.8,V,2,ST,2,DA,3,I3,0)) D B
|
|---|
| 51 | Q
|
|---|
| 52 | B ;
|
|---|
| 53 | S G=^PS(50.8,V,2,ST,2,DA,0),G2=^PS(50.8,V,2,ST,2,DA,3,I3,0),DG=$P(G,U),CO=$P(G,U,5),UM=$P(G,U,6),UD=$P(G2,U,2),UR=$P(G2,U,3),DEST=$P(G2,U,4),UC=$P(G2,U,5)
|
|---|
| 54 | S J=$S($D(^UTILITY($J,V,I3,DG)):^(DG),1:CO_U_UM),^(DG)=$P(J,U,1,2)_U_($P(J,U,3)+UD)_U_(UD-UR-UC*CO+$P(J,U,4))_U_($P(J,U,5)+UR)_U_($P(J,U,6)+DEST)_U_($P(J,U,7)+UC)
|
|---|
| 55 | Q
|
|---|
| 56 | H ;
|
|---|
| 57 | W:$Y @IOF S PC=PC+1 W ?95,NOW,!!!,?56,"WARD/DRUG USAGE REPORT:",?99,"PG",?102,$J(PC,4),!,?56,H
|
|---|
| 58 | W !?56,I11,", ",I10
|
|---|
| 59 | W !!!?1," DRUG NAME",?38," DISPENSED",?57,"(DESTROYED)",?77,"RECYCLED",?95,"CANCELLED",?123,"DRUG COST" W !
|
|---|
| 60 | F LN=1:1:132 W "="
|
|---|
| 61 | W ! Q
|
|---|
| 62 | P K K F W=0:0 W:$D(K) !,?121,"-----------",!,?18,ZF,Z,?105,$J(K,27,4),!! D:$Y+5>IOSL H S K=0,W=$O(^UTILITY($J,V,W)) Q:'W D P1
|
|---|
| 63 | Q
|
|---|
| 64 | P1 ;
|
|---|
| 65 | S Z=$S($D(^DIC(42,W,0)):$P(^(0),U),1:"OUTPATIENT") W !?1,Z D:$Y+5>IOSL H F Y=0:0 S AL=$O(^UTILITY($J,V,W,AL)) Q:AL="" S K=K+$P(^(AL),U,4) D PD
|
|---|
| 66 | Q
|
|---|
| 67 | PD S G3=^UTILITY($J,V,W,AL),C=$P(G3,U,2),X=$P(^DD(52.6,2,0),U,3),X=$P(X,";",C),X=$P(X,":",2),C=X
|
|---|
| 68 | S TD=TD+$P(G3,U,3),TC=TC+$P(G3,U,4) W !,?2,$E(AL,1,36),?38,$J($P(G3,U,3),10,2)_" "_C,?57,$J($P(G3,U,6),10,2) W ?78,$J($P(G3,U,5),7,2),?96,$J($P(G3,U,7),7,2),?115,$J($P(G3,U,4),17,4)
|
|---|
| 69 | D:$Y+4>IOSL H
|
|---|
| 70 | Q
|
|---|
| 71 | T ;
|
|---|
| 72 | W !!,?120,"============"
|
|---|
| 73 | W !,?40,"GRAND TOTAL:",?112,$J(TC,20,4)
|
|---|
| 74 | W:$Y @IOF D ^%ZISC
|
|---|
| 75 | K K VA,AL,%,^UTILITY($J),V,B,C,DA,NOW,DG,F,H,L,G,G2,S,J,K,LN,NA,PC,I2,I3,UR,ST,TC,TD,CO,UD,UM,W,Y,Z,G3,I7,I8,ZF,DEST,UC,I9,I10,I11 S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 76 | Q
|
|---|
