BMCRR8.m

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

 ;;4.0;REFERRED CARE INFO SYSTEM;**9**;JAN 09, 2006;Build 101

 ;

 ;

 ;

START ;

 ;BMC*4.0*9 REMOVED REF TO ICD9

 W:$D(IOF) @IOF W !!,"This report will list potentially high cost cases.  To determine whether a ",!,"case is potentially high cost, a taxonomy of ICD Diagnosis codes is used."

 W !!,"This report is not available to those who are not full coding their referrals.",!

 W "Inhouse Referrals are exlcuded",!

 W !!,"Please enter the range of referral initiated dates that you are interested in.",!

 S BMCHCTAX=$O(^ATXAX("B","BMC POTENTIAL HIGH COST DX",""))

 I 'BMCHCTAX W $C(7),$C(7),!!,"HIGH COST TAXONOMY MISSING!!!! NOTIFY SITE MANAGER",! G XIT

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

 K DIR

ED ;get ending date

 ;BMC*4.0*8 REMOVED "P" FR DIR PAR

 W ! S DIR(0)="D^"_BMCBD_"::E",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

 ;

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) D

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

 S XBRP="^BMCRR8P",XBRC="^BMCRR81",XBRX="XIT^BMCRR8",XBNS="BMC"

 D ^XBDBQUE

 D XIT

 Q

BROWSE ;

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

 S XBRC="^BMCRR81",XBRX="XIT^BMCRR8",XBIOP=0 D ^XBDBQUE

 Q

XIT ;EP - CALLED FROM BMCRR8

 D KILL^AUPNPAT

 K BMC80D,BMC80E,BMCBD,BMCBT,BMCBTH,BMCCOL,BMCD,BMCED,BMCET,BMCFAC,BMCFILE,BMCFOUN,BMCG,BMCHCTAX,BMCHRN,BMCJOB,BMCNODE,BMCODAT,BMCOPT,BMCP,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCX

 K DA,C,DFN,DIR,DIRUT,DIWF,DIWL,DIWR,DTOUT,DUOUT,X,X1,X2,Y,Z

 Q

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

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;**9**;JAN 09, 2006;Build 101

 +2       ;

 +3       ;

 +4       ;

START     ;

 +1       ;BMC*4.0*9 REMOVED REF TO ICD9

 +2        IF $DATA(IOF)

               WRITE @IOF

           WRITE !!,"This report will list potentially high cost cases.  To determine whether a ",!,"case is potentially high cost, a taxonomy of ICD Diagnosis codes is used."

 +3        WRITE !!,"This report is not available to those who are not full coding their referrals.",!

 +4        WRITE "Inhouse Referrals are exlcuded",!

 +5        WRITE !!,"Please enter the range of referral initiated dates that you are interested in.",!

 +6        SET BMCHCTAX=$ORDER(^ATXAX("B","BMC POTENTIAL HIGH COST DX",""))

 +7        IF 'BMCHCTAX

               WRITE $CHAR(7),$CHAR(7),!!,"HIGH COST TAXONOMY MISSING!!!! NOTIFY SITE MANAGER",!

               GOTO XIT

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

 +4        KILL DIR

ED        ;get ending date

 +1       ;BMC*4.0*8 REMOVED "P" FR DIR PAR

 +2        WRITE !

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

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

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               GOTO BD

 +4        SET BMCED=Y

 +5        SET X1=BMCBD

           SET X2=-1

           DO C^%DTC

           SET BMCSD=X

 +6       ;

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 D

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

               DO BROWSE

               DO XIT

               QUIT 

 +7        SET XBRP="^BMCRR8P"

           SET XBRC="^BMCRR81"

           SET XBRX="XIT^BMCRR8"

           SET XBNS="BMC"

 +8        DO ^XBDBQUE

 +9        DO XIT

 +10       QUIT 

BROWSE    ;

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

 +2        SET XBRC="^BMCRR81"

           SET XBRX="XIT^BMCRR8"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

XIT       ;EP - CALLED FROM BMCRR8

 +1        DO KILL^AUPNPAT

 +2        KILL BMC80D,BMC80E,BMCBD,BMCBT,BMCBTH,BMCCOL,BMCD,BMCED,BMCET,BMCFAC,BMCFILE,BMCFOUN,BMCG,BMCHCTAX,BMCHRN,BMCJOB,BMCNODE,BMCODAT,BMCOPT,BMCP,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCX

 +3        KILL DA,C,DFN,DIR,DIRUT,DIWF,DIWL,DIWR,DTOUT,DUOUT,X,X1,X2,Y,Z

 +4        QUIT