source: FOIAVistA/trunk/r/CMOP-PSX/PSXCSMN1.m@ 1518

PSXCSMN1 ;BIR/JMB-Drug Cost by Drug for One Month CONTINUED ;10 Feb 2000  1:46 PM
 ;;2.0;CMOP;**22,38**;11 Apr 97
PRINT S $P(PSXDLN,"=",132)="" I $D(PSXID) S PSXDGID=PSXID D NAME^PSXCSUTL
 S Y=PSXBDTH X ^DD("DD") S PSXBDTR=Y D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y
 ;Prints report if no data found
 I '$D(^TMP($J)) D HD W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<" G EX
 ;If no data found, loop thru ^TMP global
 F PSXFAC=0:0 S PSXFAC=$O(^TMP($J,PSXFAC)) Q:'+PSXFAC  S (PSXCNT,PSXCOST,PSXQTY,PSXTOT)=0 D  D SUB
 .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
 ..S PSXNAM="" F  S PSXNAM=$O(^TMP($J,PSXFAC,PSXDV,PSXNAM)) Q:PSXNAM=""  D
 ...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)
 ...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)
 ...S PSXAVCST=$P(Y,"^",2)/$P(Y,"^",3)
 ...W:'$D(PSXID) !,PSXNAM,?50,$J($P(Y,"^"),6,0),?65,$J($P(Y,"^",3),6,0)
 ...W:'$D(PSXID) ?75,$J($P(Y,"^",2),10,2),?95,$J(PSXAVCST,8,3),?120,$P(Y,"^",4)
EX W !,@IOF D ^%ZISC
EX1 G END^PSXCSUTL
HD ;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
 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)
 S PSXFACN=$S($G(Y)]"":Y,1:"UNKNOWN") K X,Y S PSXPG=PSXPG+1
 W:PSXPG>1 @IOF W !,"PRINTED: ",PSXRUN,?121,"PAGE: "_PSXPG
 W !?47,"MONTHLY DRUG COST REPORT FOR "_$S('$D(^TMP($J)):"ALL",1:PSXFACN),!?(132-$L(PSXBDTR)/2),PSXBDTR,!
 W:'$D(PSXID) ?(90-$L(+$G(PSXRF))-$L(+$G(PSXMC))/2),"MINIMUM REFILLS OF "_+$G(PSXRF)_" AT A MINIMUM COST OF $"_+$G(PSXMC)
 W:$D(PSXID) ?(128-$L(PSXNAM)/2),"FOR "_PSXNAM
 W !,"DIVISION: "_$S($G(PSXTOT)!('$D(^TMP($J))):"ALL",1:PSXDV)
 W !!,?51,"TOTAL",?65,"TOTAL",?80,"TOTAL" W:'$G(PSXTOT) ?91,"AVG COST per"
 W ! W:$G(PSXTOT)!($D(PSXID)) "DIVISION" W:'$G(PSXTOT)&('$D(PSXID)) "DRUG"
 W ?50,"FILLED",?64,"QUANTITY",?81,"COST" W:'PSXTOT ?91,"DISPENSE UNIT"
 W ?125,"N/F",!,PSXDLN
 Q
SUBDV ;Division subtotal
 W !?47,"----------",?62,"----------",?76,"----------"
 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),!
 Q
SUB ;Facility grand total
 G:$G(PSXSPDV)&($G(PSXID)'="") ONE S PSXCNTDV=0,PSXX="" F  S PSXX=$O(PSXSUB(PSXX)) Q:PSXX=""  S PSXCNTDV=PSXCNTDV+1
 G:PSXCNTDV&($G(PSXID)'="") ONE
 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
 .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)
 .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)
 D:$Y+4>IOSL HD W !?47,"----------",?61,"----------",?75,"----------"
 W !,"FACILITY TOTAL",?50,$J($P(PSXTOT,"^"),6,0),?63,$J($P(PSXTOT,"^",3),7,0),?75,$J($P(PSXTOT,"^",2),10,2)
 Q
ONE ;Print if facility has only 1 division
 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)
 S PSXAVCST=$P(PSXSUB(PSXX),"^",2)/$P(PSXSUB(PSXX),"^",3) W ?91,$J(PSXAVCST,8,3)
 Q