Routine: BMCRR3

BMCRR3 ; IHS/PHXAO/TMJ - list patients for which medical and/or cost data has not been received ;

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

START ;

 W !,"This report will present a list of high cost users.  The user will enter",!,"a date range and a dollar amount which will serve as the indicator of high",!,"cost.  "

 W "All referrals incurred by a patient in that date range will be totalled.",!,"If the total cost is greater than or equal to the dollar amount entered by the",!,"user, that patient will be considered a high cost user.",!

 W !,"The Total Cost can be either IHS COST or TOTAL COST.",!

 W !,"If ACTUAL Cost is available, it will be used.  If not available, estimated",!,"cost is used.  Inhouse Referrals are NOT included.",!

D ;DATE RANGE

BD ;get beginning date

 W ! S DIR(0)="D^::EP",DIR("A")="Enter beginning Referral Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G XIT

 S BMCBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_BMCBD_"::EP",DIR("A")="Enter ending Referral Date"  D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S BMCED=Y

 S X1=BMCBD,X2=-1 D C^%DTC S BMCSD=X

DOLLAR ;

 W ! S DIR(0)="90001,1101",DIR("A")="Enter a dollar amount that will be used to determine high cost" K DA D ^DIR K DIR

 I Y="" G BD

 I $D(DIRUT) G BD

 S BMCAMT=Y

COST ;

 S BMCCOST=""

 S DIR(0)="S^I:BEST AVAILABLE IHS COST;T:BEST AVAILABLE TOTAL COST",DIR("A")="Use which COST in determining high cost users",DIR("B")="I" K DA D ^DIR K DIR

 I $D(DIRUT) G DOLLAR

 S BMCCOST=Y

ZIS ;call to XBDBQUE

 K BMCOPT

 W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR

 I $D(DIRUT) S BMCQUIT="" Q

 S BMCOPT=Y

 G:$G(BMCQUIT) COST

 I $G(BMCOPT)="B" D BROWSE,XIT Q

 S XBRP="^BMCRR3P",XBRC="^BMCRR31",XBRX="XIT^BMCRR3",XBNS="BMC"

 D ^XBDBQUE

 D XIT

BROWSE ;

 S XBRP="VIEWR^XBLM(""^BMCRR3P"")"

 S XBRC="^BMCRR31",XBRX="XIT^BMCRR3",XBIOP=0 D ^XBDBQUE

XIT ;EP - CALLED FROM BMCRR3

 D KILL^AUPNPAT

 K BMC11,BMC80D,BMC80E,BMCAMT,BMCBD,BMCBT,BMCBTH,BMCCOST,BMCDOLL,BMCED,BMCET,BMCHRN,BMCJOB,BMCOPT,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD

 K DA,DFN,DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,Y

BMCRR3    ; IHS/PHXAO/TMJ - list patients for which medical and/or cost data has not been received ;

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;

 +3       ;

 +4       ;

START     ;

 +1        WRITE !,"This report will present a list of high cost users.  The user will enter",!,"a date range and a dollar amount which will serve as the indicator of high",!,"cost.  "

 +2        WRITE "All referrals incurred by a patient in that date range will be totalled.",!,"If the total cost is greater than or equal to the dollar amount entered by the",!,"user, that patient will be considered a high cost user.",!

 +3        WRITE !,"The Total Cost can be either IHS COST or TOTAL COST.",!

 +4        WRITE !,"If ACTUAL Cost is available, it will be used.  If not available, estimated",!,"cost is used.  Inhouse Referrals are NOT included.",!

D         ;DATE RANGE

BD        ;get beginning date

 +1        WRITE !

           SET DIR(0)="D^::EP"

           SET DIR("A")="Enter beginning Referral Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO XIT

 +3        SET BMCBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_BMCBD_"::EP"

           SET DIR("A")="Enter ending Referral Date"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        IF $DATA(DIRUT)

               GOTO BD

 +3        SET BMCED=Y

 +4        SET X1=BMCBD

           SET X2=-1

           DO C^%DTC

           SET BMCSD=X

 +5       ;

DOLLAR    ;

 +1        WRITE !

           SET DIR(0)="90001,1101"

           SET DIR("A")="Enter a dollar amount that will be used to determine high cost"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF Y=""

               GOTO BD

 +3        IF $DATA(DIRUT)

               GOTO BD

 +4        SET BMCAMT=Y

COST      ;

 +1        SET BMCCOST=""

 +2        SET DIR(0)="S^I:BEST AVAILABLE IHS COST;T:BEST AVAILABLE TOTAL COST"

           SET DIR("A")="Use which COST in determining high cost users"

           SET DIR("B")="I"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO DOLLAR

 +4        SET BMCCOST=Y

ZIS       ;call to XBDBQUE

 +1        KILL BMCOPT

 +2        WRITE !

           SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"

           SET DIR("A")="Do you wish to"

           SET DIR("B")="P"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               SET BMCQUIT=""

               QUIT

 +4        SET BMCOPT=Y

 +5        IF $GET(BMCQUIT)

               GOTO COST

 +6        IF $GET(BMCOPT)="B"

               DO BROWSE

               DO XIT

               QUIT

 +7        SET XBRP="^BMCRR3P"

           SET XBRC="^BMCRR31"

           SET XBRX="XIT^BMCRR3"

           SET XBNS="BMC"

 +8        DO ^XBDBQUE

 +9        DO XIT

 +10       QUIT

BROWSE    ;

 +1        SET XBRP="VIEWR^XBLM(""^BMCRR3P"")"

 +2        SET XBRC="^BMCRR31"

           SET XBRX="XIT^BMCRR3"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

XIT       ;EP - CALLED FROM BMCRR3

 +1        DO KILL^AUPNPAT

 +2        KILL BMC11,BMC80D,BMC80E,BMCAMT,BMCBD,BMCBT,BMCBTH,BMCCOST,BMCDOLL,BMCED,BMCET,BMCHRN,BMCJOB,BMCOPT,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD

 +3        KILL DA,DFN,DIR,DIRUT,DTOUT,DUOUT,X,X1,X2,Y

 +4        QUIT

BMCRR3.m