Routine: BMCRR17

BMCRR17 ; 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 list patients who have been hospitalized longer than",!," the Estimated Length of stay."

 W !,"The report will list any referral that meets the following criteria:"

 W !?5,"- the referral is an Inpatient referral"

 W !?5,"- the date of admission is today or earlier",!,?5,"- the actual discharge date is blank"

 W !?5,"- the status of the referral is active"

 W !?5,"- the actual LOS to date is greater than the Estimated LOS"

 W !?5,"note:  if the estimated LOS is not entered, the referral will",!?5,"NOT display on this report.  Inhouse Referrals are NOT included.",!

SORT ;sort by?

 S BMCSTYPE=""

 S DIR(0)="S^F:Facility Referred to;C:Case Manager;P:Patient Name",DIR("A")="Sort output by which of the above",DIR("B")="F" K DA D ^DIR K DIR

 I $D(DIRUT) G XIT

 S BMCSTYPE=Y

PAGE ;separate page for each

 S BMCSPAGE=""

 S DIR(0)="Y",DIR("A")="Do you want each "_$S(BMCSTYPE="C":"Case Manager",BMCSTYPE="P":"Patient",BMCSTYPE="F":"Facility")_" on a separate page",DIR("B")="N" K DA D ^DIR K DIR

 I $D(DIRUT) G SORT

 S BMCSPAGE=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) SORT

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

 S XBRP="^BMCRR17P",XBRC="^BMCRR171",XBRX="XIT^BMCRR17",XBNS="BMC"

 D ^XBDBQUE

 D XIT

BROWSE ;

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

 S XBRC="^BMCRR171",XBRX="XIT^BMCRR17",XBIOP=0 D ^XBDBQUE

XIT ;EP - CALLED FROM BMCRR17

 K BMC80D,BMC80E,BMCALOS,BMCBT,BMCBTH,BMCCOL,BMCD,BMCELOS,BMCET,BMCFILE,BMCG,BMCHRN,BMCI,BMCJOB,BMCNODE,BMCNOES,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSORT,BMCSPAGE,BMCSTR,BMCSTYPE,BMCX

 K C,DA,DFN,DIR,DIRUT,DIWF,DIWL,DIWR,DTOUR,O,X,Y,Z

 D KILL^AUPNPAT

BMCRR17   ; 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 list patients who have been hospitalized longer than",!," the Estimated Length of stay."

 +2        WRITE !,"The report will list any referral that meets the following criteria:"

 +3        WRITE !?5,"- the referral is an Inpatient referral"

 +4        WRITE !?5,"- the date of admission is today or earlier",!,?5,"- the actual discharge date is blank"

 +5        WRITE !?5,"- the status of the referral is active"

 +6        WRITE !?5,"- the actual LOS to date is greater than the Estimated LOS"

 +7        WRITE !?5,"note:  if the estimated LOS is not entered, the referral will",!?5,"NOT display on this report.  Inhouse Referrals are NOT included.",!

SORT      ;sort by?

 +1        SET BMCSTYPE=""

 +2        SET DIR(0)="S^F:Facility Referred to;C:Case Manager;P:Patient Name"

           SET DIR("A")="Sort output by which of the above"

           SET DIR("B")="F"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO XIT

 +4        SET BMCSTYPE=Y

PAGE      ;separate page for each

 +1        SET BMCSPAGE=""

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want each "_$SELECT(BMCSTYPE="C":"Case Manager",BMCSTYPE="P":"Patient",BMCSTYPE="F":"Facility")_" on a separate page"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO SORT

 +4        SET BMCSPAGE=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 SORT

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

               DO BROWSE

               DO XIT

               QUIT

 +7        SET XBRP="^BMCRR17P"

           SET XBRC="^BMCRR171"

           SET XBRX="XIT^BMCRR17"

           SET XBNS="BMC"

 +8        DO ^XBDBQUE

 +9        DO XIT

 +10       QUIT

BROWSE    ;

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

 +2        SET XBRC="^BMCRR171"

           SET XBRX="XIT^BMCRR17"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

XIT       ;EP - CALLED FROM BMCRR17

 +1        KILL BMC80D,BMC80E,BMCALOS,BMCBT,BMCBTH,BMCCOL,BMCD,BMCELOS,BMCET,BMCFILE,BMCG,BMCHRN,BMCI,BMCJOB,BMCNODE,BMCNOES,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSORT,BMCSPAGE,BMCSTR,BMCSTYPE,BMCX

 +2        KILL C,DA,DFN,DIR,DIRUT,DIWF,DIWL,DIWR,DTOUR,O,X,Y,Z

 +3        DO KILL^AUPNPAT

 +4        QUIT

BMCRR17.m