BMCRR22.m

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