- BMCRR5 ; IHS/PHXAO/TMJ - patients without medical and/or cost data;
- ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- ;IHS/ITSC/FCJ ADDED VAR ;ADDED REQUEST TO SORT BY ALPHA
- ;
- START ;
- W:$D(IOF) @IOF
- W !,"This report will list patients who are currently under treatment at outside ",!,"referral facilities. The definition of those under treatment at outside"
- W !,"facilities is the following:"
- W !?5,"- the referral is an Inpatient referral"
- W !?5,"- the beginning date of service is today or earlier and the expected",!?7,"end date of service is on or after today's date of " W $$FMTE^XLFDT(DT)
- W !?5,"- the status of the referral is active",!,?5,"- Inhouse Referrals are excluded",!
- W !,"This transfer log will contain a 1-2 page detailed summary record display",!,"for each referral.",!
- ;
- ;
- 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
- S BMCSTYPA=""
- I BMCSTYPE'="P" D G:$D(DIRUT) SORT
- .S DIR(0)="Y",DIR("A")="Would you like entries listed alphabetically by patient name",DIR("B")="Y" K DA D ^DIR K DIR
- .Q:$D(DIRUT)
- .S BMCSTYPA=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
- 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
- Q:$D(DIRUT)
- 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) XIT
- I $G(BMCOPT)="B" D BROWSE,XIT Q
- S XBRP="^BMCRR5P",XBRC="^BMCRR51",XBRX="XIT^BMCRR5",XBNS="BMC"
- D ^XBDBQUE
- D XIT
- Q
- BROWSE ;
- S XBRP="VIEWR^XBLM(""^BMCRR5P"")"
- S XBRC="^BMCRR51",XBRX="XIT^BMCRR5",XBIOP=0 D ^XBDBQUE
- Q
- XIT ;EP - CALLED FROM BMCRR5
- D KILL^AUPNPAT
- K BMC1,BMC2,BMC80D,BMC80E,BMCAR,BMCBT,BMCBTH,BMCCOL,BMCCTR,BMCET,BMCFILE,BMCG,BMCH,BMCI,BMCJOB,BMCNODE,BMCOPT,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSTR,BMCV,BMCVDFN,BMCVDG,BMCVFILE,BMCVI,BMCVIGR,BMCVL,BMCVNM,BMCX,BMCY
- K %,C,D0,DA,DFN,DI,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,F,I,X,Y,Z
- K BMCD,BMCHRN,BMCSORT,BMCP,BMCSPAGE,BMCSTYPE,BMCTST,BMC15S,BMCRNUMB,BMCTYPR
- Q
- BMCRR5 ; IHS/PHXAO/TMJ - patients without medical and/or cost data;
- +1 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006
- +2 ;IHS/ITSC/FCJ ADDED VAR ;ADDED REQUEST TO SORT BY ALPHA
- +3 ;
- START ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,"This report will list patients who are currently under treatment at outside ",!,"referral facilities. The definition of those under treatment at outside"
- +3 WRITE !,"facilities is the following:"
- +4 WRITE !?5,"- the referral is an Inpatient referral"
- +5 WRITE !?5,"- the beginning date of service is today or earlier and the expected",!?7,"end date of service is on or after today's date of "
- WRITE $$FMTE^XLFDT(DT)
- +6 WRITE !?5,"- the status of the referral is active",!,?5,"- Inhouse Referrals are excluded",!
- +7 WRITE !,"This transfer log will contain a 1-2 page detailed summary record display",!,"for each referral.",!
- +8 ;
- +9 ;
- 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
- +5 SET BMCSTYPA=""
- +6 IF BMCSTYPE'="P"
- Begin DoDot:1
- +7 SET DIR(0)="Y"
- SET DIR("A")="Would you like entries listed alphabetically by patient name"
- SET DIR("B")="Y"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF $DATA(DIRUT)
- QUIT
- +9 SET BMCSTYPA=Y
- End DoDot:1
- IF $DATA(DIRUT)
- GOTO SORT
- +10 ;
- 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
- 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)
- QUIT
- +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 XIT
- +6 IF $GET(BMCOPT)="B"
- DO BROWSE
- DO XIT
- QUIT
- +7 SET XBRP="^BMCRR5P"
- SET XBRC="^BMCRR51"
- SET XBRX="XIT^BMCRR5"
- SET XBNS="BMC"
- +8 DO ^XBDBQUE
- +9 DO XIT
- +10 QUIT
- BROWSE ;
- +1 SET XBRP="VIEWR^XBLM(""^BMCRR5P"")"
- +2 SET XBRC="^BMCRR51"
- SET XBRX="XIT^BMCRR5"
- SET XBIOP=0
- DO ^XBDBQUE
- +3 QUIT
- XIT ;EP - CALLED FROM BMCRR5
- +1 DO KILL^AUPNPAT
- +2 KILL BMC1,BMC2,BMC80D,BMC80E,BMCAR,BMCBT,BMCBTH,BMCCOL,BMCCTR,BMCET,BMCFILE,BMCG,BMCH,BMCI,BMCJOB,BMCNODE,BMCOPT,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSTR,BMCV,BMCVDFN,BMCVDG,BMCVFILE,BMCVI,BMCVIGR,BMCVL,BMCVNM,BMCX,BMCY
- +3 KILL %,C,D0,DA,DFN,DI,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,F,I,X,Y,Z
- +4 KILL BMCD,BMCHRN,BMCSORT,BMCP,BMCSPAGE,BMCSTYPE,BMCTST,BMC15S,BMCRNUMB,BMCTYPR
- +5 QUIT
