PSOCSTX ;BHAM ISC/SAB - COMMON CALL FOR ALL THE COST REPORTS ; 09/09/99 08:00
;;7.0;OUTPATIENT PHARMACY;**31**;DEC 1997
CDT 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
I $E(DT,1,5)'=$E(Y,1,5),+$E(Y,6,7)>1 D CTR Q:$G(CTR)
I $E(DT,1,5)'=$E(BEGDATE,1,5),+$E(BEGDATE,6,7)>0 S BEGDATE=$E(BEGDATE,1,5)_"00"
W ! S %DT("A")="ENDING DATE: ",%DT="AEP" D ^%DT S:Y<0!($D(DTOUT)) CTR=1 Q:$G(CTR)
S ENDDATE=Y,X1=DT,X2=Y D ^%DTC
I X>1,$E(DT,1,5)'=$E(Y,1,5) S ENDDATE=$E(ENDDATE,1,5)_"00"
I $E(DT,1,5)=$E(Y,1,5),+$E(Y,6,7)=0 S ENDDATE=DT-1
Q
CTR ;Check for valid month selection
K DIR S DIR(0)="Y",DIR("A")="Continue generating the monthly report ",DIR("B")="YES"
S DIR("A",1)="Breakdown of daily data is not available for the past months "
S DIR("A",2)="only monthly reports can be generated."
S DIR("?")="Breakdown of daily cost is available only for the current month."
S DIR("?",1)="Preferred format for past month start date entry is MMYY."
S DIR("?",2)="The month-end process accumulates the monthly totals for the current"
S DIR("?",3)="month and removes the daily cost breakdowns."
D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT))!(Y<1) CTR=1 Q:$G(CTR)
S BEGDATE=$E(BEGDATE,1,5)_"00"
Q
CMC K DIR S DIR(0)="Y",DIR("A")="Do you want to look at data concerning a specific "_TTA,DIR("B")="YES"
S DIR("?")="Report can be obtained for a particluar "_TTA_" by entering YES"
S DIR("?",1)="Enter NO to generate the report for all "_TTB_" or ^ to quit."
D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) CTR=1 Q:$G(CTR) S IFN=Y
Q
DRS D CMC Q:$G(CTR)
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
Q
CTP W !!,"Report for the period: " S Y=BEGDATE D DT^DIO2 W " to " S Y=ENDDATE D DT^DIO2 W " will be generated "
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"
S DIR("?")="If the period shown is incorrect Enter NO or ^ to quit"
S DIR("?",1)="Daily cost breakdown is available only for the current month and can be"
S DIR("?",2)="obtained by selecting the start date & the end date within the current month."
D ^DIR K DIR S:$D(DUOUT)!($D(DTOUT)) CTR=1 Q:$G(CTR) S:Y<1 RP=1
Q
PRV D CMC Q:$G(CTR)
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
Q
PTS D CMC Q:$G(CTR)
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
Q
HD D HD0
W !!,$G(TT1),!,$G(TT2),! F I=1:1:RRM W "-"
Q
HD0 I PAGE>1,$E(IOST)="C" S DIR(0)="E" D ^DIR I $D(DIRUT) S CTR=1 Q
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
W ?$S(RP=12:90,1:71),"Page: ",PAGE S PAGE=PAGE+1
Q
HDC S RRM=$S(RP=12:110,1:80) S CTR=0,PAGE=1
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")
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:"")
S TTB=TTA_$S(RP=6:"",1:"s")
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)"
I RP=2!(RP=5) S C1=41,C2=47,C3=53
E S C1=37,C2=43,C3=52
S TT0="Drug Costs by "_$G(TT)_" for the period: "
S TT1="",$E(TT1,C1)="Orign",$E(TT1,C3)="Total",$E(TT1,65)="Total",$E(TT1,73)="Avg Cost"
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"
Q
HDN W !!,"**No Data Found for Requested Date Range for "
I IFN W TTA_" ",@TTC
E W "All "_TTA_"s"
W "**",!! D EX Q
DVC 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
Q
PRT 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)
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)
Q
FTX D FTU^PSOCSTX W !,"Total" D FTT^PSOCSTX,FTU^PSOCSTX W ! Q
FTU W !,?(C1-1),"-----",?(C2-1),"-----",?(C3-1),"-----",?59,"----------",?72,"--------"
Q
FTT 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)
Q
EX W ! W:$E(IOST)'["C" @IOF D ^%ZISC
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
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="@"
Q
DVS D CMC Q:$G(CTR)
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
Q
SUB S T1=T1+CNTO,T2=T2+CNTR,T3=T3+CNT,T4=T4+COST,(CNTO,CNTR,COST,CNT,AVG)=0
Q
TOT S CNTO=T1,CNTR=T2,CNT=T3,COST=T4 D HD:($Y+2)>IOSL D FTX Q
ZER S (CNT,CNTO,CNTR,COST,T1,T2,T3,T4)=0 Q
PAS 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)=""
Q
PSOCSTX ;BHAM ISC/SAB - COMMON CALL FOR ALL THE COST REPORTS ; 09/09/99 08:00
+1 ;;7.0;OUTPATIENT PHARMACY;**31**;DEC 1997
CDT KILL QUIT,%DT
WRITE !
SET %DT(0)=-DT
SET %DT("A")="BEGINNING DATE: "
SET %DT="AEP"
DO ^%DT
IF Y<0!($DATA(DTOUT))
SET CTR=1
IF CTR
QUIT
SET (%DT(0),BEGDATE)=Y
+1 IF $EXTRACT(DT,1,5)'=$EXTRACT(Y,1,5)
IF +$EXTRACT(Y,6,7)>1
DO CTR
IF $GET(CTR)
QUIT
+2 IF $EXTRACT(DT,1,5)'=$EXTRACT(BEGDATE,1,5)
IF +$EXTRACT(BEGDATE,6,7)>0
SET BEGDATE=$EXTRACT(BEGDATE,1,5)_"00"
+3 WRITE !
SET %DT("A")="ENDING DATE: "
SET %DT="AEP"
DO ^%DT
IF Y<0!($DATA(DTOUT))
SET CTR=1
IF $GET(CTR)
QUIT
+4 SET ENDDATE=Y
SET X1=DT
SET X2=Y
DO ^%DTC
+5 IF X>1
IF $EXTRACT(DT,1,5)'=$EXTRACT(Y,1,5)
SET ENDDATE=$EXTRACT(ENDDATE,1,5)_"00"
+6 IF $EXTRACT(DT,1,5)=$EXTRACT(Y,1,5)
IF +$EXTRACT(Y,6,7)=0
SET ENDDATE=DT-1
+7 QUIT
CTR ;Check for valid month selection
+1 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Continue generating the monthly report "
SET DIR("B")="YES"
+2 SET DIR("A",1)="Breakdown of daily data is not available for the past months "
+3 SET DIR("A",2)="only monthly reports can be generated."
+4 SET DIR("?")="Breakdown of daily cost is available only for the current month."
+5 SET DIR("?",1)="Preferred format for past month start date entry is MMYY."
+6 SET DIR("?",2)="The month-end process accumulates the monthly totals for the current"
+7 SET DIR("?",3)="month and removes the daily cost breakdowns."
+8 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))!(Y<1)
SET CTR=1
IF $GET(CTR)
QUIT
+9 SET BEGDATE=$EXTRACT(BEGDATE,1,5)_"00"
+10 QUIT
CMC KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you want to look at data concerning a specific "_TTA
SET DIR("B")="YES"
+1 SET DIR("?")="Report can be obtained for a particluar "_TTA_" by entering YES"
+2 SET DIR("?",1)="Enter NO to generate the report for all "_TTB_" or ^ to quit."
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET CTR=1
IF $GET(CTR)
QUIT
SET IFN=Y
+4 QUIT
DRS DO CMC
IF $GET(CTR)
QUIT
+1 IF IFN
SET DIC(0)="AEQM"
SET DIC="^PSDRUG("
SET DIC("A")="Select DRUG: "
DO ^DIC
KILL DIC
IF Y<0
SET CTR=1
IF CTR
QUIT
SET DRUG=+Y
+2 QUIT
CTP WRITE !!,"Report for the period: "
SET Y=BEGDATE
DO DT^DIO2
WRITE " to "
SET Y=ENDDATE
DO DT^DIO2
WRITE " will be generated "
+1 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Continue generating the "_$SELECT(RRM>80:132,1:80)_" column report for the shown period "
SET DIR("B")="YES"
+2 SET DIR("?")="If the period shown is incorrect Enter NO or ^ to quit"
+3 SET DIR("?",1)="Daily cost breakdown is available only for the current month and can be"
+4 SET DIR("?",2)="obtained by selecting the start date & the end date within the current month."
+5 DO ^DIR
KILL DIR
IF $DATA(DUOUT)!($DATA(DTOUT))
SET CTR=1
IF $GET(CTR)
QUIT
IF Y<1
SET RP=1
+6 QUIT
PRV DO CMC
IF $GET(CTR)
QUIT
+1 IF IFN
SET DIC("S")="I $G(^VA(200,+Y,""PS""))]"""""
SET DIC(0)="AEQM"
SET DIC="^VA(200,"
SET DIC("A")="Select Provider: "
DO ^DIC
KILL DIC
IF Y<0
SET CTR=1
IF CTR
QUIT
SET PHY=+Y
+2 QUIT
PTS DO CMC
IF $GET(CTR)
QUIT
+1 IF IFN
SET DIC(0)="AEQM"
SET DIC="^PS(53,"
SET DIC("A")="Select Patient Status: "
DO ^DIC
KILL DIC
IF Y<0
SET CTR=1
IF CTR
QUIT
SET STA=+Y
+2 QUIT
HD DO HD0
+1 WRITE !!,$GET(TT1),!,$GET(TT2),!
FOR I=1:1:RRM
WRITE "-"
+2 QUIT
HD0 IF PAGE>1
IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)
SET CTR=1
QUIT
+1 WRITE @IOF,!,$GET(TT0)
SET Y=BEGDATE
DO DT^DIO2
WRITE " to "
SET Y=ENDDATE
DO DT^DIO2
WRITE !,"Run Date: "
SET Y=DT
DO DT^DIO2
+2 WRITE ?$SELECT(RP=12:90,1:71),"Page: ",PAGE
SET PAGE=PAGE+1
+3 QUIT
HDC SET RRM=$SELECT(RP=12:110,1:80)
SET CTR=0
SET PAGE=1
+1 SET TT=$SELECT(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")
+2 SET TTA=$SELECT(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:"")
+3 SET TTB=TTA_$SELECT(RP=6:"",1:"s")
+4 SET TTC="$P(^"_$SELECT(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)"
+5 IF RP=2!(RP=5)
SET C1=41
SET C2=47
SET C3=53
+6 IF '$TEST
SET C1=37
SET C2=43
SET C3=52
+7 SET TT0="Drug Costs by "_$GET(TT)_" for the period: "
+8 SET TT1=""
SET $EXTRACT(TT1,C1)="Orign"
SET $EXTRACT(TT1,C3)="Total"
SET $EXTRACT(TT1,65)="Total"
SET $EXTRACT(TT1,73)="Avg Cost"
+9 SET TT2=$GET(TT)
SET $EXTRACT(TT2,C1)="Fills"
SET $EXTRACT(TT2,C2)="Refil"
SET $EXTRACT(TT2,C3)="Fills"
SET $EXTRACT(TT2,65)="Cost"
SET $EXTRACT(TT2,73)="per Fill"
+10 QUIT
HDN WRITE !!,"**No Data Found for Requested Date Range for "
+1 IF IFN
WRITE TTA_" ",@TTC
+2 IF '$TEST
WRITE "All "_TTA_"s"
+3 WRITE "**",!!
DO EX
QUIT
DVC KILL %ZIS,IOP,POP,ZTSK
SET PSOION=ION
SET %ZIS="QM"
DO ^%ZIS
KILL %ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
KILL IOP,PSOION
SET CTR=1
+1 QUIT
PRT SET FILLS=($PIECE(Y,"^",2)+$PIECE(Y,"^",3))
SET CNT=CNT+FILLS
SET CNTO=CNTO+$PIECE(Y,"^",2)
SET CNTR=CNTR+$PIECE(Y,"^",3)
SET COST=COST+$PIECE(Y,"^",4)
+1 WRITE !,$GET(TTX),?(C1-1),$JUSTIFY($PIECE(Y,"^",2),5),?(C2-1),$JUSTIFY($PIECE(Y,"^",3),5),?(C3-1),$JUSTIFY(FILLS,5),?59,$JUSTIFY($PIECE(Y,"^",4),10,2),?72
SET AVG=$SELECT(FILLS=0:0,1:($PIECE(Y,"^",4)/FILLS))
WRITE $JUSTIFY(AVG,8,2)
+2 QUIT
FTX DO FTU^PSOCSTX
WRITE !,"Total"
DO FTT^PSOCSTX
DO FTU^PSOCSTX
WRITE !
QUIT
FTU WRITE !,?(C1-1),"-----",?(C2-1),"-----",?(C3-1),"-----",?59,"----------",?72,"--------"
+1 QUIT
FTT WRITE ?(C1-1),$JUSTIFY(CNTO,5),?(C2-1),$JUSTIFY(CNTR,5),?(C3-1),$JUSTIFY(CNT,5),?59,$JUSTIFY(COST,10,2),?72
SET AVG=$SELECT(CNT=0:0,1:(COST/CNT))
WRITE $JUSTIFY(AVG,8,2)
+1 QUIT
EX WRITE !
IF $EXTRACT(IOST)'["C"
WRITE @IOF
DO ^%ZISC
+1 KILL ^TMP($JOB),%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
+2 KILL 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
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
DVS DO CMC
IF $GET(CTR)
QUIT
+1 IF IFN
SET DIC(0)="AEQM"
SET DIC="^PS(59,"
SET DIC("A")="Select Division: "
DO ^DIC
KILL DIC
IF Y<0
SET CTR=1
IF $GET(CTR)
QUIT
SET IFN=1
SET DIV=+Y
+2 QUIT
SUB SET T1=T1+CNTO
SET T2=T2+CNTR
SET T3=T3+CNT
SET T4=T4+COST
SET (CNTO,CNTR,COST,CNT,AVG)=0
+1 QUIT
TOT SET CNTO=T1
SET CNTR=T2
SET CNT=T3
SET COST=T4
IF ($Y+2)>IOSL
DO HD
DO FTX
QUIT
ZER SET (CNT,CNTO,CNTR,COST,T1,T2,T3,T4)=0
QUIT
PAS FOR G="BEGDATE","ENDDATE","IFN","DRUG","PHY","STA","CLA","DIV","CTR","RP","RRM","PAGE","TT","TT0","TT1","TT2","TTA","TTB","TTC","C1","C2","C3"
IF $DATA(@G)
SET ZTSAVE(G)=""
+1 QUIT
