- BMCRR22 ; IHS/PHXAO/TMJ - list patients currently in active, outpatient referral status ;
- ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- ;3.9.04 IHS/ITSC/FCJ CALL made to the wrong routine
- ;
- ;
- ;
- START ;
- W:$D(IOF) @IOF
- W !,"This report will list patients currently referred for outpatient services",!,"at outside referral facilities. The definition of 'currently referred for is",!
- W !?5,"- the referral is an Outpatient referral"
- W !?5,"- the best available beginning (actual or estimated) date is today or",!?7,"earlier and ",!?5,"- the actual end date of service is blank or on or after",!?7," today's date of ",$$FMTE^XLFDT(DT,"5D")
- W !?5,"- the status of the referral is active",!,?5,"- Inhouse Referrals are excluded",!
- SORT ;sort by?
- S BMCSTYPE=""
- S DIR(0)="S^F:Facility Referred to;C:Case Manager;P:Patient Name;R:Referring Physician",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",BMCSTYPE="R":"IHS Referring Physician")_" on a separate page",DIR("B")="N" K DA D ^DIR K DIR
- I $D(DIRUT) G SORT
- S BMCSPAGE=Y
- ;
- OUTPUT ;Print Output Summary or Detail
- S BMCOUTP=""
- S DIR(0)="S^D:Detailed Report Listing;S:Summary Report Listing",DIR("A")="Select Report Printing",DIR("B")="D" K DA D ^DIR K DIR
- I $D(DIRUT) G XIT
- S BMCOUTP=Y
- SECREF ;PRINT SEC REF AS A SEPARATE ENTRY
- S BMCTYPR=""
- S DIR(0)="Y",DIR("A")="Would you like to print the Secondary Referrals as Separate entries",DIR("B")="N" K DA D ^DIR K DIR
- I $D(DIRUT) G XIT
- S BMCTYPR=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
- I BMCOUTP="D" G DETAIL
- ;
- SUMMARY ;Print Summary Report
- S XBRP="^BMCRR7P",XBRC="^BMCRR71",XBRX="XIT^BMCRR22",XBNS="BMC"
- D ^XBDBQUE
- D XIT
- Q
- DETAIL ;Print Detail
- S XBRP="^BMCRR22P",XBRC="^BMCRR221",XBRX="XIT^BMCRR22",XBNS="BMC"
- D ^XBDBQUE
- D XIT
- Q
- BROWSE ;
- I BMCOUTP="S" D BROWSE1,XIT Q
- S XBRP="VIEWR^XBLM(""^BMCRR22P"")"
- S XBRC="^BMCRR221",XBRX="XIT^BMCRR22",XBIOP=0 D ^XBDBQUE
- Q
- XIT ;EP - CALLED FROM BMCRR22
- D KILL^AUPNPAT
- K BMC80D,BMC80E,BMCBT,BMCBTH,BMCCOL,BMCET,BMCFAC,BMCFILE,BMCG,BMCHRN,BMCJOB,BMCNODE,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSORT,BMCSPAGE,BMCSTYPE,BMCX
- K DA,DFN,DIR,DIRUT,DIWF,DIWL,DIWR,DTOUT,X,Y,BMCTYPR
- Q
- ;
- BROWSE1 ;Summary Browse
- S XBRP="VIEWR^XBLM(""^BMCRR7P"")"
- S XBRC="^BMCRR71",XBRX="XIT^BMCRR22",XBIOP=0 D ^XBDBQUE
- BMCRR22 ; IHS/PHXAO/TMJ - list patients currently in active, outpatient referral status ;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- +2 ;3.9.04 IHS/ITSC/FCJ CALL made to the wrong routine
- +3 ;
- +4 ;
- +5 ;
- START ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,"This report will list patients currently referred for outpatient services",!,"at outside referral facilities. The definition of 'currently referred for is",!
- +3 WRITE !?5,"- the referral is an Outpatient referral"
- +4 WRITE !?5,"- the best available beginning (actual or estimated) date is today or",!?7,"earlier and ",!?5,"- the actual end date of service is blank or on or after",!?7," today's date of ",$$FMTE^XLFDT(DT,"5D")
- +5 WRITE !?5,"- the status of the referral is active",!,?5,"- Inhouse Referrals are excluded",!
- SORT ;sort by?
- +1 SET BMCSTYPE=""
- +2 SET DIR(0)="S^F:Facility Referred to;C:Case Manager;P:Patient Name;R:Referring Physician"
- 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",BMCSTYPE="R":"IHS Referring Physician")_" on a separate page"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- GOTO SORT
- +4 SET BMCSPAGE=Y
- +5 ;
- OUTPUT ;Print Output Summary or Detail
- +1 SET BMCOUTP=""
- +2 SET DIR(0)="S^D:Detailed Report Listing;S:Summary Report Listing"
- SET DIR("A")="Select Report Printing"
- SET DIR("B")="D"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- GOTO XIT
- +4 SET BMCOUTP=Y
- SECREF ;PRINT SEC REF AS A SEPARATE ENTRY
- +1 SET BMCTYPR=""
- +2 SET DIR(0)="Y"
- SET DIR("A")="Would you like to print the Secondary Referrals as Separate entries"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- GOTO XIT
- +4 SET BMCTYPR=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 IF BMCOUTP="D"
- GOTO DETAIL
- +8 ;
- SUMMARY ;Print Summary Report
- +1 SET XBRP="^BMCRR7P"
- SET XBRC="^BMCRR71"
- SET XBRX="XIT^BMCRR22"
- SET XBNS="BMC"
- +2 DO ^XBDBQUE
- +3 DO XIT
- +4 QUIT
- DETAIL ;Print Detail
- +1 SET XBRP="^BMCRR22P"
- SET XBRC="^BMCRR221"
- SET XBRX="XIT^BMCRR22"
- SET XBNS="BMC"
- +2 DO ^XBDBQUE
- +3 DO XIT
- +4 QUIT
- BROWSE ;
- +1 IF BMCOUTP="S"
- DO BROWSE1
- DO XIT
- QUIT
- +2 SET XBRP="VIEWR^XBLM(""^BMCRR22P"")"
- +3 SET XBRC="^BMCRR221"
- SET XBRX="XIT^BMCRR22"
- SET XBIOP=0
- DO ^XBDBQUE
- +4 QUIT
- XIT ;EP - CALLED FROM BMCRR22
- +1 DO KILL^AUPNPAT
- +2 KILL BMC80D,BMC80E,BMCBT,BMCBTH,BMCCOL,BMCET,BMCFAC,BMCFILE,BMCG,BMCHRN,BMCJOB,BMCNODE,BMCOPT,BMCPG,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSORT,BMCSPAGE,BMCSTYPE,BMCX
- +3 KILL DA,DFN,DIR,DIRUT,DIWF,DIWL,DIWR,DTOUT,X,Y,BMCTYPR
- +4 QUIT
- +5 ;
- BROWSE1 ;Summary Browse
- +1 SET XBRP="VIEWR^XBLM(""^BMCRR7P"")"
- +2 SET XBRC="^BMCRR71"
- SET XBRX="XIT^BMCRR22"
- SET XBIOP=0
- DO ^XBDBQUE
