source: FOIAVistA/tag/r/CMOP-PSX/PSXCSDC1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1PSXCSDC1 ;BIR/JMB-Drug Cost by Drug Report-CONTINUED ;04/08/97 2:06 PM
2 ;;2.0;CMOP;**38**;11 Apr 97
3PRINT D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y
4 ;Sets tab stops based on if specific/all drugs is selected by user
5 I '$D(PSXID) S PSXTH1=37,PSXTH2=49,PSXTH3=62,PSXTH4=80,PSXTH5=89,PSXTH6=100,PSXT1=36,PSXT2=50,PSXT3=61,PSXT4=75,PSXT5=87,PSXT6=102,PSXLGN=115
6 I $D(PSXID) S PSXTH=27,PSXTH1=61,PSXTH2=71,PSXTH3=81,PSXTH4=91,PSXTH5=104,PSXTH6=118,PSXT=27,PSXT1=60,PSXT2=71,PSXT3=80,PSXT4=89,PSXT5=102,PSXT6=122,PSXLGN=132
7 S PSXLGN=$S($D(PSXID):132,1:115),$P(PSXDLN,"=",PSXLGN)="",$P(PSXSLN,"-",PSXLGN)="",PSXPG=1
8 D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y,Y=PSXBDT X ^DD("DD") S PSXBDTR=Y,Y=PSXEDT X ^DD("DD") S PSXEDTR=Y
9 ;If no data found, prints header & "no data found"
10 I '$D(^TMP($J)) D NODATA G EX
11 ;If data found, loops thru ^TMP global & prints report
12 F PSXFAC=0:0 S PSXFAC=$O(^TMP($J,PSXFAC)) Q:'+PSXFAC S (PSXCNT,PSXCNTO,PSXCNTR,PSXCOST,PSXTOT)=0 D:$D(PSXID) HD D D SUB^PSXCSDC2
13 .K PSXSUB S PSXDV="" F S PSXDV=$O(^TMP($J,PSXFAC,PSXDV)) Q:PSXDV="" S PSXSUB(PSXDV)="0^0^0^0^0^" D:'$D(PSXID) HD D D:'$D(PSXID) SUBDV^PSXCSDC2
14 ..S PSXNAM="" F S PSXNAM=$O(^TMP($J,PSXFAC,PSXDV,PSXNAM)) Q:PSXNAM="" D
15 ...D:($Y+4)>IOSL HD S Y=^TMP($J,PSXFAC,PSXDV,PSXNAM),PSXFLS=($P(Y,"^")+$P(Y,"^",2)),PSXCNT=PSXCNT+PSXFLS,PSXCNTO=PSXCNTO+$P(Y,"^"),PSXCNTR=PSXCNTR+$P(Y,"^",2),PSXCOST=PSXCOST+$P(Y,"^",3)
16 ...W:'$D(PSXID) !,$E(PSXNAM,1,36) W:$D(PSXID) !,$E(PSXDV,1,25),?27,$E(PSXNAM,1,30)
17 ...W ?PSXT1,$J($P(Y,"^"),6,0),?PSXT2,$J($P(Y,"^",2),6,0),?PSXT3,$J(PSXFLS,6,0),?PSXT4,$J($P(Y,"^",3),10,2),?PSXT5 S PSXAVG=$S(PSXFLS=0:0,1:($P(Y,"^",3)/PSXFLS)) W $J(PSXAVG,10,2)
18 ...S PSXAVCST=$P(Y,"^",3)/$P(Y,"^",4) W ?PSXT6,$J(PSXAVCST,8,3),?122,$P(Y,"^",5) ; Y,"^",5 added as cmop-leav local code
19 ...S $P(PSXSUB(PSXDV),"^")=$P(PSXSUB(PSXDV),"^")+$P(Y,"^"),$P(PSXSUB(PSXDV),"^",2)=$P(PSXSUB(PSXDV),"^",2)+$P(Y,"^",2)
20 ...S $P(PSXSUB(PSXDV),"^",3)=$P(PSXSUB(PSXDV),"^",3)+PSXFLS,$P(PSXSUB(PSXDV),"^",4)=$P(PSXSUB(PSXDV),"^",4)+$P(Y,"^",3)
21 ...S $P(PSXSUB(PSXDV),"^",5)=$P(PSXSUB(PSXDV),"^",5)+$P(Y,"^",4)
22EX W !,@IOF D ^%ZISC
23EX1 K ^TMP($J) D END^PSXCSUTL Q
24HD ;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
25 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)
26 S:+Y Y=$$GET1^DIQ(4,Y,.01)
27 S PSXFACN=$S($G(Y)]"":Y,1:"UNKNOWN") K X,Y
28 W:PSXPG>1 @IOF W !,"PRINTED: ",PSXRUN,?PSXTH6,"PAGE ",PSXPG S PSXPG=PSXPG+1
29 W !!?(PSXLGN-18-$L(PSXFACN)/2),"DRUG COST BY DRUG FOR ",PSXFACN,!?(PSXLGN-4-$L(PSXBDTR)-$L(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR
30 W:'$D(PSXID) !,"DIVISION: ",$S(PSXTOT:"ALL DIVISIONS",1:PSXDV)
31 W !!?PSXTH1,"ORIGN",?PSXTH3,"TOTAL",?PSXTH4,"TOTAL",?PSXTH5,"AVG COST"
32 W ?PSXTH6,"AVG COST per"
33 W !
34 W:PSXTOT "DIVISION" W:'PSXTOT&('$D(PSXID)) "DRUG" W:$D(PSXID) "DIVISION",?40,"DRUG"
35 W ?PSXTH1,"FILLS",?PSXTH2,"REFILLS",?PSXTH3,"FILLS",?PSXTH4," COST",?PSXTH5,"per FILL"
36 W ?PSXTH6,"DISPENSE UNIT"
37 W !,PSXDLN
38 Q
39NODATA ;Prints report for no data found
40 W !,"PRINTED: ",PSXRUN,?PSXTH6,"PAGE 1"
41 W !!?(PSXLGN-32),"DRUG COST BY DRUG FOR ALL FACILITIES",!?(PSXLGN-4-$L(PSXBDTR)-$L(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR
42 W:'$D(PSXID) !,"DIVISION: ALL DIVISIONS"
43 W !!?PSXTH1,"ORIGN",?PSXTH3,"TOTAL",?PSXTH4,"TOTAL",?PSXTH5,"AVG COST",!
44 W "DRUG" W ?PSXTH1,"FILLS",?PSXTH2,"REFILLS",?PSXTH3,"FILLS",?PSXTH4," COST",?PSXTH5,"per FILL",!,PSXDLN
45 W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<"
46 Q
Note: See TracBrowser for help on using the repository browser.