source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOCSTX.m@ 1076

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1PSOCSTX ;BHAM ISC/SAB - COMMON CALL FOR ALL THE COST REPORTS ; 09/09/99 08:00
2 ;;7.0;OUTPATIENT PHARMACY;**31**;DEC 1997
3CDT K QUIT,%DT W ! S %DT(0)=-DT,%DT("A")="BEGINNING DATE: ",%DT="AEP" D ^%DT S:Y<0!($D(DTOUT)) CTR=1 Q:CTR S (%DT(0),BEGDATE)=Y
4 I $E(DT,1,5)'=$E(Y,1,5),+$E(Y,6,7)>1 D CTR Q:$G(CTR)
5 I $E(DT,1,5)'=$E(BEGDATE,1,5),+$E(BEGDATE,6,7)>0 S BEGDATE=$E(BEGDATE,1,5)_"00"
6 W ! S %DT("A")="ENDING DATE: ",%DT="AEP" D ^%DT S:Y<0!($D(DTOUT)) CTR=1 Q:$G(CTR)
7 S ENDDATE=Y,X1=DT,X2=Y D ^%DTC
8 I X>1,$E(DT,1,5)'=$E(Y,1,5) S ENDDATE=$E(ENDDATE,1,5)_"00"
9 I $E(DT,1,5)=$E(Y,1,5),+$E(Y,6,7)=0 S ENDDATE=DT-1
10 Q
11CTR ;Check for valid month selection
12 K DIR S DIR(0)="Y",DIR("A")="Continue generating the monthly report ",DIR("B")="YES"
13 S DIR("A",1)="Breakdown of daily data is not available for the past months "
14 S DIR("A",2)="only monthly reports can be generated."
15 S DIR("?")="Breakdown of daily cost is available only for the current month."
16 S DIR("?",1)="Preferred format for past month start date entry is MMYY."
17 S DIR("?",2)="The month-end process accumulates the monthly totals for the current"
18 S DIR("?",3)="month and removes the daily cost breakdowns."
19 D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT))!(Y<1) CTR=1 Q:$G(CTR)
20 S BEGDATE=$E(BEGDATE,1,5)_"00"
21 Q
22CMC K DIR S DIR(0)="Y",DIR("A")="Do you want to look at data concerning a specific "_TTA,DIR("B")="YES"
23 S DIR("?")="Report can be obtained for a particluar "_TTA_" by entering YES"
24 S DIR("?",1)="Enter NO to generate the report for all "_TTB_" or ^ to quit."
25 D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) CTR=1 Q:$G(CTR) S IFN=Y
26 Q
27DRS D CMC Q:$G(CTR)
28 I IFN S DIC(0)="AEQM",DIC="^PSDRUG(",DIC("A")="Select DRUG: " D ^DIC K DIC S:Y<0 CTR=1 Q:CTR S DRUG=+Y
29 Q
30CTP W !!,"Report for the period: " S Y=BEGDATE D DT^DIO2 W " to " S Y=ENDDATE D DT^DIO2 W " will be generated "
31 K DIR S DIR(0)="Y",DIR("A")="Continue generating the "_$S(RRM>80:132,1:80)_" column report for the shown period ",DIR("B")="YES"
32 S DIR("?")="If the period shown is incorrect Enter NO or ^ to quit"
33 S DIR("?",1)="Daily cost breakdown is available only for the current month and can be"
34 S DIR("?",2)="obtained by selecting the start date & the end date within the current month."
35 D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) CTR=1 Q:$G(CTR) S:Y<1 RP=1
36 Q
37PRV D CMC Q:$G(CTR)
38 I IFN S DIC("S")="I $G(^VA(200,+Y,""PS""))]""""",DIC(0)="AEQM",DIC="^VA(200,",DIC("A")="Select Provider: " D ^DIC K DIC S:Y<0 CTR=1 Q:CTR S PHY=+Y
39 Q
40PTS D CMC Q:$G(CTR)
41 I IFN S DIC(0)="AEQM",DIC="^PS(53,",DIC("A")="Select Patient Status: " D ^DIC K DIC S:Y<0 CTR=1 Q:CTR S STA=+Y
42 Q
43HD D HD0
44 W !!,$G(TT1),!,$G(TT2),! F I=1:1:RRM W "-"
45 Q
46HD0 I PAGE>1,$E(IOST)="C" S DIR(0)="E" D ^DIR I $D(DIRUT) S CTR=1 Q
47 W @IOF,!,$G(TT0) S Y=BEGDATE D DT^DIO2 W " to " S Y=ENDDATE D DT^DIO2 W !,"Run Date: " S Y=DT D DT^DIO2
48 W ?$S(RP=12:90,1:71),"Page: ",PAGE S PAGE=PAGE+1
49 Q
50HDC S RRM=$S(RP=12:110,1:80) S CTR=0,PAGE=1
51 S TT=$S(RP=2:"Drug",RP=3:"Drug by Provider",RP=4:"Provider",RP=5:"Provider by Drug",RP=6:"Patient Status",RP=7:"Classification",RP=8:"Division",RP=9:"Division by Provider",RP=11:"Clinic",RP=12:"Division by Drug",1:"N/A")
52 S TTA=$S(RP=2!(RP=3):"drug",RP=4!(RP=5):"provider",RP=6:"patient status",RP=7:"classification",RP=8!(RP=9)!(RP=12):"division",RP=11:"clinic",1:"")
53 S TTB=TTA_$S(RP=6:"",1:"s")
54 S TTC="$P(^"_$S(RP=2!(RP=3):"PSDRUG(DRUG",RP=4!(RP=5):"VA(200,PHY",RP=6:"PS(53,STA",RP=7:"PS(50.605,CLA",RP=8!(RP=9)!(RP=12):"PS(59,DIV",RP=11:"SC(CLA",1:"N/A")_",0),U)"
55 I RP=2!(RP=5) S C1=41,C2=47,C3=53
56 E S C1=37,C2=43,C3=52
57 S TT0="Drug Costs by "_$G(TT)_" for the period: "
58 S TT1="",$E(TT1,C1)="Orign",$E(TT1,C3)="Total",$E(TT1,65)="Total",$E(TT1,73)="Avg Cost"
59 S TT2=$G(TT),$E(TT2,C1)="Fills",$E(TT2,C2)="Refil",$E(TT2,C3)="Fills",$E(TT2,65)="Cost",$E(TT2,73)="per Fill"
60 Q
61HDN W !!,"**No Data Found for Requested Date Range for "
62 I IFN W TTA_" ",@TTC
63 E W "All "_TTA_"s"
64 W "**",!! D EX Q
65DVC K %ZIS,IOP,POP,ZTSK S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION S CTR=1
66 Q
67PRT S FILLS=($P(Y,"^",2)+$P(Y,"^",3)),CNT=CNT+FILLS,CNTO=CNTO+$P(Y,"^",2),CNTR=CNTR+$P(Y,"^",3),COST=COST+$P(Y,"^",4)
68 W !,$G(TTX),?(C1-1),$J($P(Y,"^",2),5),?(C2-1),$J($P(Y,"^",3),5),?(C3-1),$J(FILLS,5),?59,$J($P(Y,"^",4),10,2),?72 S AVG=$S(FILLS=0:0,1:($P(Y,"^",4)/FILLS)) W $J(AVG,8,2)
69 Q
70FTX D FTU^PSOCSTX W !,"Total" D FTT^PSOCSTX,FTU^PSOCSTX W ! Q
71FTU W !,?(C1-1),"-----",?(C2-1),"-----",?(C3-1),"-----",?59,"----------",?72,"--------"
72 Q
73FTT W ?(C1-1),$J(CNTO,5),?(C2-1),$J(CNTR,5),?(C3-1),$J(CNT,5),?59,$J(COST,10,2),?72 S AVG=$S(CNT=0:0,1:(COST/CNT)) W $J(AVG,8,2)
74 Q
75EX W ! W:$E(IOST)'["C" @IOF D ^%ZISC
76 K ^TMP($J),%ZIS,ANS,AVG,BEGDATE,CNT,CNTO,CNTR,COST,CTR,RP,G,DIC,DRUG,DRUGX,ENDDATE,FILLS,I,IFN,IFNX,PAGE,PGM,PHY,PHYX,POP,PSDT,PSI
77 K UTL,VAL,VAR,X,Y,%DT,ZTRTN,ZTDESC,ZTSK,STAX,STA,CLA,CLAX,DIV,DIVX,TTA,TTB,TTC,T1,T2,T3,T4,C1,C2,C3,CTR,RP,TT,TT0,TT1,TT2,TTX,RRM S:$D(ZTQUEUED) ZTREQ="@"
78 Q
79DVS D CMC Q:$G(CTR)
80 I IFN S DIC(0)="AEQM",DIC="^PS(59,",DIC("A")="Select Division: " D ^DIC K DIC S:Y<0 CTR=1 Q:$G(CTR) S IFN=1,DIV=+Y
81 Q
82SUB S T1=T1+CNTO,T2=T2+CNTR,T3=T3+CNT,T4=T4+COST,(CNTO,CNTR,COST,CNT,AVG)=0
83 Q
84TOT S CNTO=T1,CNTR=T2,CNT=T3,COST=T4 D HD:($Y+2)>IOSL D FTX Q
85ZER S (CNT,CNTO,CNTR,COST,T1,T2,T3,T4)=0 Q
86PAS F G="BEGDATE","ENDDATE","IFN","DRUG","PHY","STA","CLA","DIV","CTR","RP","RRM","PAGE","TT","TT0","TT1","TT2","TTA","TTB","TTC","C1","C2","C3" S:$D(@G) ZTSAVE(G)=""
87 Q
Note: See TracBrowser for help on using the repository browser.