BMCRR1.m

BMCRR1 ; 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 all referrals for which a discharge letter has not ",!,"been received.",!

 W !,"ALL referral records with or without an actual end date of service",!,"and no discharge letter received are listed.",!

 W !,"I User Selects a SPECIFIC FACILITY REFERRED TO, then only CHS Type Referrals-",!

 W "For that particular Vendor -  will be displayed",!

TIME ;

 S BMCTIME=""

 S DIR(0)="N^1:9999999:",DIR("A")="Please specify the minimum time overdue (in days)" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 S BMCTIME=Y

SORT ;

 S BMCSTYPE=""

 S BMCFAC=""

 S DIR(0)="S^F:Facility Referred to;T:Amount of Time Overdue",DIR("A")="Sort Report by",DIR("B")="F" K DA D ^DIR K DIR

 I $D(DIRUT) G TIME  ;IHS/PHXAO/ Quit if Uphat 6/14/99

 S BMCSTYPE=Y

 ;

 I BMCSTYPE="F" D ASKFAC ;If Facility Selected-Ask for specific facility

 ;

PAGE ;separate page for each

 S BMCSPAGE=""

 S DIR(0)="Y",DIR("A")="Do you want each "_$S(BMCSTYPE="T":"Time Bucket",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="^BMCRR1P",XBRC="^BMCRR11",XBRX="XIT^BMCRR1",XBNS="BMC"

 D ^XBDBQUE

 D XIT

 Q

BROWSE ;

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

 S XBRC="^BMCRR11",XBRX="XIT^BMCRR1",XBIOP=0 D ^XBDBQUE

 Q

XIT ;EP - CALLED FROM BMCRR1

 D KILL^AUPNPAT

 K BMC80D,BMC80E,BMCBT,BMCBTH,BMCET,BMCFAC,BMCHRN,BMCJOB,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSKIP,BMCSORT,BMCSPAGE,BMCSPEC,BMCSTYPE,BMCTIME

 K DA,DFN,DIR,DIRUT,DTOUT,Y,Z,%,%1

 Q

 ;

ASKFAC ;Ask for a specific Vendor

 ;S BMCFAC=0

 W ! S DIR(0)="Y0",DIR("A")="Would you like to include a Specific Facility Referred To? ",DIR("B")="NO"

 S DIR("?")="To Select a SPECIFIC Facility Referred To for this Report - Answer Yes."

 D ^DIR K DIR

 G:$D(DIRUT) SORT

 I 'Y Q

SELFAC ;Select a Specific Facility Referred To

 W ! S DIC="^AUTTVNDR(",DIC("A")="Enter Facility/Vendor Name: ",DIC(0)="AEMQ" D ^DIC K DIC

 I Y=-1 G ASKFAC

 S BMCFAC=+Y

 ;

BMCRR1    ; 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 all referrals for which a discharge letter has not ",!,"been received.",!

 +2        WRITE !,"ALL referral records with or without an actual end date of service",!,"and no discharge letter received are listed.",!

 +3        WRITE !,"I User Selects a SPECIFIC FACILITY REFERRED TO, then only CHS Type Referrals-",!

 +4        WRITE "For that particular Vendor -  will be displayed",!

TIME      ;

 +1        SET BMCTIME=""

 +2        SET DIR(0)="N^1:9999999:"

           SET DIR("A")="Please specify the minimum time overdue (in days)"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        SET BMCTIME=Y

SORT      ;

 +1        SET BMCSTYPE=""

 +2        SET BMCFAC=""

 +3        SET DIR(0)="S^F:Facility Referred to;T:Amount of Time Overdue"

           SET DIR("A")="Sort Report by"

           SET DIR("B")="F"

           KILL DA

           DO ^DIR

           KILL DIR

 +4       ;IHS/PHXAO/ Quit if Uphat 6/14/99

           IF $DATA(DIRUT)

               GOTO TIME

 +5        SET BMCSTYPE=Y

 +6       ;

 +7       ;If Facility Selected-Ask for specific facility

           IF BMCSTYPE="F"

               DO ASKFAC

 +8       ;

PAGE      ;separate page for each

 +1        SET BMCSPAGE=""

 +2        SET DIR(0)="Y"

           SET DIR("A")="Do you want each "_$SELECT(BMCSTYPE="T":"Time Bucket",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="^BMCRR1P"

           SET XBRC="^BMCRR11"

           SET XBRX="XIT^BMCRR1"

           SET XBNS="BMC"

 +8        DO ^XBDBQUE

 +9        DO XIT

 +10       QUIT 

BROWSE    ;

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

 +2        SET XBRC="^BMCRR11"

           SET XBRX="XIT^BMCRR1"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT 

XIT       ;EP - CALLED FROM BMCRR1

 +1        DO KILL^AUPNPAT

 +2        KILL BMC80D,BMC80E,BMCBT,BMCBTH,BMCET,BMCFAC,BMCHRN,BMCJOB,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSKIP,BMCSORT,BMCSPAGE,BMCSPEC,BMCSTYPE,BMCTIME

 +3        KILL DA,DFN,DIR,DIRUT,DTOUT,Y,Z,%,%1

 +4        QUIT 

 +5       ;

ASKFAC    ;Ask for a specific Vendor

 +1       ;S BMCFAC=0

 +2        WRITE !

           SET DIR(0)="Y0"

           SET DIR("A")="Would you like to include a Specific Facility Referred To? "

           SET DIR("B")="NO"

 +3        SET DIR("?")="To Select a SPECIFIC Facility Referred To for this Report - Answer Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO SORT

 +6        IF 'Y

               QUIT 

SELFAC    ;Select a Specific Facility Referred To

 +1        WRITE !

           SET DIC="^AUTTVNDR("

           SET DIC("A")="Enter Facility/Vendor Name: "

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +2        IF Y=-1

               GOTO ASKFAC

 +3        SET BMCFAC=+Y

 +4       ;