source: FOIAVistA/tag/r/CMOP-PSX/PSXCSSUM.m@ 1569

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1PSXCSSUM ;BIR/JMB-Drug Cost by Facility Report ;08 Oct 97 5:31 PM
2 ;;2.0;CMOP;**38**;11 Apr 97
3 ;Get user input
4 D BEG^PSXCSUTL G:$G(PSXOUT) EX1
5DEV ;Device handling
6 W ! K %ZIS,ZTSK,IOP,POP S %ZIS("B")="",PSXION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSXION D ^%ZIS K POP,PSXION G EX
7 I $E(IOST)["C"!($G(IOM)<132) W !!,"Printout must be sent to a 132-column printer!",!! G DEV
8 K PSXION I $D(IO("Q")) S ZTDESC="CMOP Drug Cost by Facility",ZTRTN="START^PSXCSSUM" F PSXG="PSXBDT","PSXEDT","PSXDV","PSXFAC" S:$D(@PSXG) ZTSAVE(PSXG)=""
9 I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report queued to print!!",! K ZTSK G EX
10START ;Queued entry point
11 U IO K ^TMP($J) S $P(PSXDLN,"=",89)="",$P(PSXSLN,"-",89)=""
12 ;Determines loop to use based on user input
13 D @($S($G(PSXFAC)=""&($G(PSXDV)=""):"ALL",$G(PSXFAC)'=""&($G(PSXDV)=""):"ALLDV",$G(PSXFAC)'=""&($G(PSXDV)'=""):"DATE",1:"EX")) G PRINT
14ALL ;Loops thru all facilities
15 F PSXFAC=0:0 S PSXFAC=$O(^PSX(552.5,PSXFAC)) Q:'PSXFAC S PSXDV="" F S PSXDV=$O(^PSX(552.5,PSXFAC,1,"B",PSXDV)) Q:PSXDV="" D DATE
16 Q
17ALLDV ;Loops thru all divisions
18 S PSXDV="" F S PSXDV=$O(^PSX(552.5,PSXFAC,1,"B",PSXDV)) Q:PSXDV="" D DATE
19 Q
20DATE ;Entry point if specific fac & div OR this is called by ALL & ALLDV
21 S PSXIDV=$O(^PSX(552.5,PSXFAC,1,"B",PSXDV,0)) ; this line had been commented out INP,Cache3 birm
22 ;I $E(PSXBDT,6,7)="01" S PSXBDT=(PSXBDT)-1 ;this line from cache3 INP, do not know origin
23 F PSXDT=(PSXBDT-1):0:PSXEDT S PSXDT=$O(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT)) Q:'PSXDT!(PSXDT>PSXEDT) D
24 .F PSXDG=0:0 S PSXDG=$O(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG)) Q:'PSXDG D:$D(^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG,0)) DRUG
25 Q
26DRUG ;Gets drug data & sets ^TMP nodes
27 S PSXDV=$E(PSXDV,1,25),Y=^PSX(552.5,PSXFAC,1,PSXIDV,1,PSXDT,1,PSXDG,0)
28 I '$D(^TMP($J,PSXFAC,PSXDV)) S ^TMP($J,PSXFAC,PSXDV)=$P(Y,"^",2)_"^"_$P(Y,"^",3)_"^"_$P(Y,"^",4) Q
29 S $P(^TMP($J,PSXFAC,PSXDV),"^")=$P(^(PSXDV),"^")+$P(Y,"^",2),$P(^TMP($J,PSXFAC,PSXDV),"^",2)=$P(^(PSXDV),"^",2)+$P(Y,"^",3),$P(^TMP($J,PSXFAC,PSXDV),"^",3)=$P(^(PSXDV),"^",3)+$P(Y,"^",4)
30 Q
31PRINT ;Print report if no data found
32 I '$D(^TMP($J)) D HD W !!?50,">>>>> NO DRUG COST INFORMATION FOUND <<<<<" Q
33 D NOW^%DTC S Y=% X ^DD("DD") S PSXRUN=Y,PSXPG=1,Y=PSXBDT X ^DD("DD") S PSXBDTR=Y,Y=PSXEDT X ^DD("DD") S PSXEDTR=Y
34 ;If data found, loops thru ^TMP global
35 F PSXFAC=0:0 S PSXFAC=$O(^TMP($J,PSXFAC)) Q:'PSXFAC S (PSXCNT,PSXCNTO,PSXCNTR,PSXCOST)=0 D HD D
36 .S PSXDV="",PSXDVCNT=0 F S PSXDV=$O(^TMP($J,PSXFAC,PSXDV)) Q:PSXDV="" S PSXDVCNT=PSXDVCNT+1 D
37 ..D HD:($Y+4)>IOSL S Y=^TMP($J,PSXFAC,PSXDV),PSXFLS=($P(Y,"^")+$P(Y,"^",2)),PSXCNT=PSXCNT+PSXFLS,PSXCNTO=PSXCNTO+$P(Y,"^"),PSXCNTR=PSXCNTR+$P(Y,"^",2),PSXCOST=PSXCOST+$P(Y,"^",3)
38 ..W !,PSXDV,?29,$J($P(Y,"^"),6,0),?41,$J($P(Y,"^",2),6,0),?51,$J(PSXFLS,6,0),?62,$J($P(Y,"^",3),10,2),?78 S PSXAVG=$S(PSXFLS=0:0,1:($P(Y,"^",3)/PSXFLS)) W $J(PSXAVG,10,2)
39 .I PSXDVCNT>1 W !!,PSXSLN,!,"TOTAL",?29,$J(PSXCNTO,6),?41,$J(PSXCNTR,6),?51,$J(PSXCNT,6),?62,$J(PSXCOST,10,2),?78 S PSXAVG=$S(PSXCNT=0:0,1:(PSXCOST/PSXCNT)) W $J(PSXAVG,10,2)
40EX W !,@IOF D ^%ZISC
41EX1 G END^PSXCSUTL
42HD ;N X,Y S X=PSXFAC,DIC(0)="MNZ",DIC=4 S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S PSXFACN=$S($G(Y(0,0))]"":Y(0,0),1:"UNKNOWN") K DIC,X,Y ;****DOD L1
43 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)
44 S Y=$$GET1^DIQ(4,Y,.01) S PSXFACN=$S($G(Y)]"":Y,1:"UNKNOWN") K X,Y
45 W:PSXPG>1 @IOF W !,"PRINTED: ",PSXRUN,?(84-$L(PSXPG)),"PAGE ",PSXPG S PSXPG=PSXPG+1
46 W !!?(62-$L(PSXFACN)/2),"DRUG COSTS BY FACILITY FOR ",PSXFACN,!?(85-$L(PSXBDTR)-$L(PSXEDTR)/2),PSXBDTR," TO ",PSXEDTR
47 W !!,?30,"ORIGN",?52,"TOTAL",?67,"TOTAL",?80,"AVG COST",!,"DIVISION",?30,"FILLS",?40,"REFILLS",?52,"FILLS",?68,"COST",?80,"per FILL",!,PSXDLN
48 Q
Note: See TracBrowser for help on using the repository browser.