- 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 ;
