source: FOIAVistA/tag/r/CMOP-PSX/PSXCSMN1.m@ 1590

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1PSXCSMN1 ;BIR/JMB-Drug Cost by Drug for One Month CONTINUED ;10 Feb 2000 1:46 PM
2 ;;2.0;CMOP;**22,38**;11 Apr 97
3PRINT S $P(PSXDLN,"=",132)="" I $D(PSXID) S PSXDGID=PSXID D NAME^PSXCSUTL
4 S Y=PSXBDTH X ^DD("DD") S PSXBDTR=Y D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y
5 ;Prints report if no data found
6 I '$D(^TMP($J)) D HD W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<" G EX
7 ;If no data found, loop thru ^TMP global
8 F PSXFAC=0:0 S PSXFAC=$O(^TMP($J,PSXFAC)) Q:'+PSXFAC S (PSXCNT,PSXCOST,PSXQTY,PSXTOT)=0 D D SUB
9 .K PSXSUB S PSXDV="",PSXCNT=1 F S PSXDV=$O(^TMP($J,PSXFAC,PSXDV)) Q:PSXDV="" S PSXSUB(PSXDV)="0^0^0^0^" D:'$D(PSXID)!($D(PSXID)&(PSXCNT=1)) HD S PSXCNT=2 D D:'$D(PSXID) SUBDV
10 ..S PSXNAM="" F S PSXNAM=$O(^TMP($J,PSXFAC,PSXDV,PSXNAM)) Q:PSXNAM="" D
11 ...D:($Y+4)>IOSL HD S Y=^TMP($J,PSXFAC,PSXDV,PSXNAM),PSXCNT=PSXCNT+$P(Y,"^"),PSXCOST=PSXCOST+$P(Y,"^",2),PSXQTY=PSXQTY+$P(Y,"^",3)
12 ...S $P(PSXSUB(PSXDV),"^")=$P(PSXSUB(PSXDV),"^")+$P(Y,"^"),$P(PSXSUB(PSXDV),"^",2)=$P(PSXSUB(PSXDV),"^",2)+$P(Y,"^",2),$P(PSXSUB(PSXDV),"^",3)=$P(PSXSUB(PSXDV),"^",3)+$P(Y,"^",3)
13 ...S PSXAVCST=$P(Y,"^",2)/$P(Y,"^",3)
14 ...W:'$D(PSXID) !,PSXNAM,?50,$J($P(Y,"^"),6,0),?65,$J($P(Y,"^",3),6,0)
15 ...W:'$D(PSXID) ?75,$J($P(Y,"^",2),10,2),?95,$J(PSXAVCST,8,3),?120,$P(Y,"^",4)
16EX W !,@IOF D ^%ZISC
17EX1 G END^PSXCSUTL
18HD ;N X,Y S X=+PSXFAC,DIC(0)="MNZ",DIC=4 S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC K DIC ;****DOD L1
19 N X,Y S X=+PSXFAC,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) X=$E(X,2,99),AGNCY="DMIS" S Y=$$IEN^XUMF(4,AGNCY,X),Y=$$GET1^DIQ(4,Y,.01)
20 S PSXFACN=$S($G(Y)]"":Y,1:"UNKNOWN") K X,Y S PSXPG=PSXPG+1
21 W:PSXPG>1 @IOF W !,"PRINTED: ",PSXRUN,?121,"PAGE: "_PSXPG
22 W !?47,"MONTHLY DRUG COST REPORT FOR "_$S('$D(^TMP($J)):"ALL",1:PSXFACN),!?(132-$L(PSXBDTR)/2),PSXBDTR,!
23 W:'$D(PSXID) ?(90-$L(+$G(PSXRF))-$L(+$G(PSXMC))/2),"MINIMUM REFILLS OF "_+$G(PSXRF)_" AT A MINIMUM COST OF $"_+$G(PSXMC)
24 W:$D(PSXID) ?(128-$L(PSXNAM)/2),"FOR "_PSXNAM
25 W !,"DIVISION: "_$S($G(PSXTOT)!('$D(^TMP($J))):"ALL",1:PSXDV)
26 W !!,?51,"TOTAL",?65,"TOTAL",?80,"TOTAL" W:'$G(PSXTOT) ?91,"AVG COST per"
27 W ! W:$G(PSXTOT)!($D(PSXID)) "DIVISION" W:'$G(PSXTOT)&('$D(PSXID)) "DRUG"
28 W ?50,"FILLED",?64,"QUANTITY",?81,"COST" W:'PSXTOT ?91,"DISPENSE UNIT"
29 W ?125,"N/F",!,PSXDLN
30 Q
31SUBDV ;Division subtotal
32 W !?47,"----------",?62,"----------",?76,"----------"
33 W !,"DIVISION TOTAL",?49,$J($P(PSXSUB(PSXDV),"^"),7,0),?64,$J($P(PSXSUB(PSXDV),"^",3),7,0),?75,$J($P(PSXSUB(PSXDV),"^",2),10,2),!
34 Q
35SUB ;Facility grand total
36 G:$G(PSXSPDV)&($G(PSXID)'="") ONE S PSXCNTDV=0,PSXX="" F S PSXX=$O(PSXSUB(PSXX)) Q:PSXX="" S PSXCNTDV=PSXCNTDV+1
37 G:PSXCNTDV&($G(PSXID)'="") ONE
38 S PSXTOT=1 D:$Y+4>IOSL HD D:'$D(PSXID) HD S PSXTOT="0^0^0^0^",PSXX="" F S PSXX=$O(PSXSUB(PSXX)) Q:PSXX="" D
39 .S $P(PSXTOT,"^")=$P(PSXTOT,"^")+$P(PSXSUB(PSXX),"^"),$P(PSXTOT,"^",2)=$P(PSXTOT,"^",2)+$P(PSXSUB(PSXX),"^",2),$P(PSXTOT,"^",3)=$P(PSXTOT,"^",3)+$P(PSXSUB(PSXX),"^",3)
40 .W !,PSXX,?50,$J($P(PSXSUB(PSXX),"^"),6,0),?64,$J($P(PSXSUB(PSXX),"^",3),6,0),?75,$J($P(PSXSUB(PSXX),"^",2),10,2)
41 D:$Y+4>IOSL HD W !?47,"----------",?61,"----------",?75,"----------"
42 W !,"FACILITY TOTAL",?50,$J($P(PSXTOT,"^"),6,0),?63,$J($P(PSXTOT,"^",3),7,0),?75,$J($P(PSXTOT,"^",2),10,2)
43 Q
44ONE ;Print if facility has only 1 division
45 S PSXX="",PSXX=$O(PSXSUB(PSXX)) W !,PSXX,?50,$J($P(PSXSUB(PSXX),"^"),6,0),?65,$J($P(PSXSUB(PSXX),"^",3),6,0),?75,$J($P(PSXSUB(PSXX),"^",2),10,2)
46 S PSXAVCST=$P(PSXSUB(PSXX),"^",2)/$P(PSXSUB(PSXX),"^",3) W ?91,$J(PSXAVCST,8,3)
47 Q
Note: See TracBrowser for help on using the repository browser.