PSOCSTX.m

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