Routine: BMCRRSP

BMCRRSP ; IHS/PHXAO/TMJ - Secondary Providers By User Created/Timeframe

 ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 ;IHS/ITSC/FCJ ADDED SECTION TO ASK REF TYPE AND PRINT SUFFIX

 ;4.0 IHS/ITSC/FCJ CHGED BEG/END DT CALL TO BMCRUTL

 W !?10,"********  SECONDARY PROVIDER LETTERS BY DATE OF RECORDING  ********",!

 W !!,"This report will print a list of all Secondary Provider Letters that were ",!,"initiated in a date range entered by the user.",!

 W !,"This report allows User to Select and report for a INDIVIDUAL FACILITY Only!!",!

 W !,"This report also allows the User to Select a particular USER WHO CREATED",!,"the Letter ",!

 W !,"Inhouse Referrals are NOT included.",!

ASK ;

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

 I Y=-1 G XIT

 S BMCFAC=+Y

ASK1 ;Restrict to a Certain User who created the Letter

 S BMCCREV=0

 W ! S DIR(0)="Y0",DIR("A")="Restrict Report to a particular User Who Created the Letter",DIR("B")="NO"

 S DIR("?")="To RESTRICT Report to a particular User - Answer Yes."

 D ^DIR K DIR

 G:$D(DIRUT) ASK

 I 'Y G BD

REV ;User Who Created

 S BMCCREV=0

 S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Enter the Name of the User: "

 D ^DIC K DIC

 Q:$D(DIRUT)

 G:Y=0 BD

 S BMCCREV=+Y

BD ;get beginning date and ending date from BMCRUTL Routine

 D BD^BMCRUTL

 I $D(DIRUT) G ASK

ASKT ;ASK REFERRAL TYPE

 S DIR(0)="S^C:CHS;I:IHS (ANOTHER FACILTIY);O:OTHER;A:ALL (Excluding IN-HOUSE Referrals)"

 S DIR("B")="C",DIR("A")="Enter the Referral type or A for All"

 D ^DIR

 G:(Y="^")!(Y="") ASK

 S BMCCTYP=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="^BMCRRSPP",XBRC="^BMCRRSP1",XBRX="XIT^BMCRRSP",XBNS="BMC"

 D ^XBDBQUE

 D XIT

BROWSE ;

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

 S XBRC="^BMCRRSP1",XBRX="XIT^BMCRRSP",XBIOP=0 D ^XBDBQUE

XIT ;EP - CALLED FROM BMCRR20

 K BMCBD,BMCBT,BMCBTH,BMCCOL,BMCD,BMCDA,BMCDATE,BMCED,BMCET,BMCFILE,BMCG,BMCHRN,BMCIOM,BMCJOB,BMCNODE,BMCODAT,BMCOPT,BMCP,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCWP,BMCX,BMCC

 K BMCLOCC,BMCLOCI,BMCLOCP,BMCLOCPP,BMCCREV,BMCCTYP

 D KILL^AUPNPAT

 K %,C,D0,DA,DFN,DI,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,F,I,X,Y,Z

BMCRRSP   ; IHS/PHXAO/TMJ - Secondary Providers By User Created/Timeframe

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;;JAN 09, 2006

 +2       ;IHS/ITSC/FCJ ADDED SECTION TO ASK REF TYPE AND PRINT SUFFIX

 +3       ;4.0 IHS/ITSC/FCJ CHGED BEG/END DT CALL TO BMCRUTL

 +4       ;

 +5       ;

 +6        WRITE !?10,"********  SECONDARY PROVIDER LETTERS BY DATE OF RECORDING  ********",!

 +7        WRITE !!,"This report will print a list of all Secondary Provider Letters that were ",!,"initiated in a date range entered by the user.",!

 +8        WRITE !,"This report allows User to Select and report for a INDIVIDUAL FACILITY Only!!",!

 +9        WRITE !,"This report also allows the User to Select a particular USER WHO CREATED",!,"the Letter ",!

 +10       WRITE !,"Inhouse Referrals are NOT included.",!

ASK       ;

 +1        WRITE !

           SET DIC="^AUTTLOC("

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

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +2        IF Y=-1

               GOTO XIT

 +3        SET BMCFAC=+Y

 +4       ;

ASK1      ;Restrict to a Certain User who created the Letter

 +1        SET BMCCREV=0

 +2        WRITE !

           SET DIR(0)="Y0"

           SET DIR("A")="Restrict Report to a particular User Who Created the Letter"

           SET DIR("B")="NO"

 +3        SET DIR("?")="To RESTRICT Report to a particular User - Answer Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO ASK

 +6        IF 'Y

               GOTO BD

REV       ;User Who Created

 +1        SET BMCCREV=0

 +2        SET DIC="^VA(200,"

           SET DIC(0)="AEQM"

           SET DIC("A")="Enter the Name of the User: "

 +3        DO ^DIC

           KILL DIC

 +4        IF $DATA(DIRUT)

               QUIT

 +5        IF Y=0

               GOTO BD

 +6        SET BMCCREV=+Y

 +7       ;

BD        ;get beginning date and ending date from BMCRUTL Routine

 +1        DO BD^BMCRUTL

 +2        IF $DATA(DIRUT)

               GOTO ASK

ASKT      ;ASK REFERRAL TYPE

 +1        SET DIR(0)="S^C:CHS;I:IHS (ANOTHER FACILTIY);O:OTHER;A:ALL (Excluding IN-HOUSE Referrals)"

 +2        SET DIR("B")="C"

           SET DIR("A")="Enter the Referral type or A for All"

 +3        DO ^DIR

 +4        IF (Y="^")!(Y="")

               GOTO ASK

 +5        SET BMCCTYP=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="^BMCRRSPP"

           SET XBRC="^BMCRRSP1"

           SET XBRX="XIT^BMCRRSP"

           SET XBNS="BMC"

 +8        DO ^XBDBQUE

 +9        DO XIT

 +10       QUIT

BROWSE    ;

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

 +2        SET XBRC="^BMCRRSP1"

           SET XBRX="XIT^BMCRRSP"

           SET XBIOP=0

           DO ^XBDBQUE

 +3        QUIT

XIT       ;EP - CALLED FROM BMCRR20

 +1        KILL BMCBD,BMCBT,BMCBTH,BMCCOL,BMCD,BMCDA,BMCDATE,BMCED,BMCET,BMCFILE,BMCG,BMCHRN,BMCIOM,BMCJOB,BMCNODE,BMCODAT,BMCOPT,BMCP,BMCPG,BMCPN,BMCQUIT,BMCRCNT,BMCREF,BMCRREC,BMCSD,BMCWP,BMCX,BMCC

 +2        KILL BMCLOCC,BMCLOCI,BMCLOCP,BMCLOCPP,BMCCREV,BMCCTYP

 +3        DO KILL^AUPNPAT

 +4        KILL %,C,D0,DA,DFN,DI,DIC,DIQ,DIR,DIRUT,DIWF,DIWL,DIWR,DR,DTOUT,F,I,X,Y,Z

 +5        QUIT

BMCRRSP.m