BMCCLOS2.m

BMCCLOS2 ; IHS/OIT/FCJ - Auto Close of CHS Referrals ;    [ 05/15/2006  12:23 PM ]

 ;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101

 ;IHS/ITSC/FCJ TEST FOR SR

 ;IHS/OIT/FCJ ADDED NEW SORT BY DATE OF SERVICE, ADDED NEW TYPE ALL,

 ;ADDED BOTH TO INP/OUT SELECTION

 ;

 ;

 ;

 W !?12,"********  AUTOMATIC CLOSE OF REFERRALS  ********",!

 W !,?25,"******WARNING*****",!

 ;W !,"This routine will LOOP through all referrals that were initiated in a date ",!,"range entered by the User --" ;IHS/OIT/FCJ

 W !,"This routine will LOOP through all referrals either by date initiated",!,"or by date of service, date range entered by the User --" ;IHS/OIT/FCJ

 W !,?20,"*****AUTOMATIC CLOSURE OF REFERRAL*****",!

 W "This Routine allows User to Select a specific INDIVIDUAL FACILITY Only!",!

 W "This Routine also allows the User to EXCLUDE a particular Local Category ",!

 W "This Routine allows the User to Select INPATIENT or OUTPATIENT Referrals Only!",!

 W "This Routine allows the User to Select TYPE of Referral (CHS,IHS,OTHER) Only!",!

 ;

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

 ;

KIND ;Ask for specific Type of Referral (IHS, CHS, OTHER)

 S DIR(0)="S^C:CHS;O:OTHER;I:IHS;A:ALL"

 S DIR("A")="Enter Type of Referral:",DIR("B")="ALL"

 S DIR("?")="You must select a Type from the List"

 K DA D ^DIR KILL DIR

 Q:$D(DIRUT)

 G:Y=0 ASK

 S BMCKIND=Y

ASK1 ;Restrict a Certain Local Category

 S BMCLCAT=0

 W ! S DIR(0)="Y0",DIR("A")="Would you like to EXCLUDE a particular Local Category in this report",DIR("B")="NO"

 S DIR("?")="To EXCLUDE a particular Local Category from this Report - Answer Yes."

 D ^DIR K DIR

 G:$D(DIRUT) ASK

 I 'Y G TYPE

CAT ;Category Restriction

 S BMCLCAT=0

 S DIC="^BMCLCAT(",DIC(0)="AEQM",DIC("A")="Enter the Local Category to EXCLUDE: "

 D ^DIC K DIC

 Q:$D(DIRUT)

 G:Y=0 TYPE

 S BMCLCAT=+Y

 ;

 ;

TYPE ;Select Inpatient Or Outpatient

 ;

 S DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH"

 S DIR("A")="Select Inpatient or Outpatient",DIR("B")="O"

 S DIR("?")="You must choose Inpatient or Outpatient"

 K DA D ^DIR KILL DIR

 Q:$D(DIRUT)

 G:Y=0 CAT

 S BMCTYP=Y

 ;

 ;IHS/OIT/FCJ ADDED NXT SECTION TO ALLOW SORT BY DOS

SORT ;SORT BY DATE INITIATED OR BY DATE OF SERVICE

 W !! S DIR(0)="S^I:DATE INITIATED;S:DATE OF SERVICE",DIR("B")="I"

 S DIR("A")="Select close by Date Initiated or by Date of Service"

 D ^DIR K DIR

 Q:$D(DIRUT)

 G:Y=0 TYPE

 S BMCDTS=Y

 ;IHS/OIT/FCJ END OF CHANGES

BD ;get beginning date

 W !! S DIR(0)="D^::EP"

 S DIR("A")="Enter beginning Referral Date "_$S(BMCDTS="I":"Initiated",1:"of Service")

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G ASK

 S BMCBD=Y

ED ;get ending date

 W ! S DIR(0)="D^"_BMCBD_"::EP"

 S DIR("A")="Enter ending Referral Date "_$S(BMCDTS="I":"Initiated",1:"of Service")

 D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) G BD

 S BMCED=Y

 S X1=BMCBD,X2=-1 D C^%DTC S BMCSD=X

 ;

PROCESS ;Process Data

 ;D ^BMCCLOS3  ;IHS/OIT/FCJ

 D @$S(BMCDTS="S":"DOS^BMCCLOS3",1:"DRI^BMCCLOS3")  ;IHS/OIT/FCJ

 ;

XIT ;

 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,BMCLCAT,BMCCT,BMCFAC,BMCRIEN,BMCRSTAT,BMCTYP,BMCTYP,BMCKIND,BMCDTS,BMCCLS,BMCADOS

 D KILL^AUPNPAT

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

 Q

BMCCLOS2  ; IHS/OIT/FCJ - Auto Close of CHS Referrals ;    [ 05/15/2006  12:23 PM ]

 +1       ;;4.0;REFERRED CARE INFO SYSTEM;**2**;JAN 09, 2006;Build 101

 +2       ;IHS/ITSC/FCJ TEST FOR SR

 +3       ;IHS/OIT/FCJ ADDED NEW SORT BY DATE OF SERVICE, ADDED NEW TYPE ALL,

 +4       ;ADDED BOTH TO INP/OUT SELECTION

 +5       ;

 +6       ;

 +7       ;

 +8        WRITE !?12,"********  AUTOMATIC CLOSE OF REFERRALS  ********",!

 +9        WRITE !,?25,"******WARNING*****",!

 +10      ;W !,"This routine will LOOP through all referrals that were initiated in a date ",!,"range entered by the User --" ;IHS/OIT/FCJ

 +11      ;IHS/OIT/FCJ

           WRITE !,"This routine will LOOP through all referrals either by date initiated",!,"or by date of service, date range entered by the User --"

 +12       WRITE !,?20,"*****AUTOMATIC CLOSURE OF REFERRAL*****",!

 +13       WRITE "This Routine allows User to Select a specific INDIVIDUAL FACILITY Only!",!

 +14       WRITE "This Routine also allows the User to EXCLUDE a particular Local Category ",!

 +15       WRITE "This Routine allows the User to Select INPATIENT or OUTPATIENT Referrals Only!",!

 +16       WRITE "This Routine allows the User to Select TYPE of Referral (CHS,IHS,OTHER) Only!",!

 +17      ;

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       ;

KIND      ;Ask for specific Type of Referral (IHS, CHS, OTHER)

 +1        SET DIR(0)="S^C:CHS;O:OTHER;I:IHS;A:ALL"

 +2        SET DIR("A")="Enter Type of Referral:"

           SET DIR("B")="ALL"

 +3        SET DIR("?")="You must select a Type from the List"

 +4        KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               QUIT 

 +6        IF Y=0

               GOTO ASK

 +7        SET BMCKIND=Y

ASK1      ;Restrict a Certain Local Category

 +1        SET BMCLCAT=0

 +2        WRITE !

           SET DIR(0)="Y0"

           SET DIR("A")="Would you like to EXCLUDE a particular Local Category in this report"

           SET DIR("B")="NO"

 +3        SET DIR("?")="To EXCLUDE a particular Local Category from this Report - Answer Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO ASK

 +6        IF 'Y

               GOTO TYPE

CAT       ;Category Restriction

 +1        SET BMCLCAT=0

 +2        SET DIC="^BMCLCAT("

           SET DIC(0)="AEQM"

           SET DIC("A")="Enter the Local Category to EXCLUDE: "

 +3        DO ^DIC

           KILL DIC

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        IF Y=0

               GOTO TYPE

 +6        SET BMCLCAT=+Y

 +7       ;

 +8       ;

TYPE      ;Select Inpatient Or Outpatient

 +1       ;

 +2        SET DIR(0)="S^I:INPATIENT;O:OUTPATIENT;B:BOTH"

 +3        SET DIR("A")="Select Inpatient or Outpatient"

           SET DIR("B")="O"

 +4        SET DIR("?")="You must choose Inpatient or Outpatient"

 +5        KILL DA

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               QUIT 

 +7        IF Y=0

               GOTO CAT

 +8        SET BMCTYP=Y

 +9       ;

 +10      ;IHS/OIT/FCJ ADDED NXT SECTION TO ALLOW SORT BY DOS

SORT      ;SORT BY DATE INITIATED OR BY DATE OF SERVICE

 +1        WRITE !!

           SET DIR(0)="S^I:DATE INITIATED;S:DATE OF SERVICE"

           SET DIR("B")="I"

 +2        SET DIR("A")="Select close by Date Initiated or by Date of Service"

 +3        DO ^DIR

           KILL DIR

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        IF Y=0

               GOTO TYPE

 +6        SET BMCDTS=Y

 +7       ;IHS/OIT/FCJ END OF CHANGES

BD        ;get beginning date

 +1        WRITE !!

           SET DIR(0)="D^::EP"

 +2        SET DIR("A")="Enter beginning Referral Date "_$SELECT(BMCDTS="I":"Initiated",1:"of Service")

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               GOTO ASK

 +5        SET BMCBD=Y

ED        ;get ending date

 +1        WRITE !

           SET DIR(0)="D^"_BMCBD_"::EP"

 +2        SET DIR("A")="Enter ending Referral Date "_$SELECT(BMCDTS="I":"Initiated",1:"of Service")

 +3        DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               GOTO BD

 +5        SET BMCED=Y

 +6        SET X1=BMCBD

           SET X2=-1

           DO C^%DTC

           SET BMCSD=X

 +7       ;

PROCESS   ;Process Data

 +1       ;D ^BMCCLOS3  ;IHS/OIT/FCJ

 +2       ;IHS/OIT/FCJ

           DO @$SELECT(BMCDTS="S":"DOS^BMCCLOS3",1:"DRI^BMCCLOS3")

 +3       ;

XIT       ;

 +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,BMCLCAT,BMCCT,BMCFAC,BMCRIEN,BMCRSTAT,BMCTYP,BMCTYP,BMCKIND,BMCDTS,BMCCLS,BMCADOS

 +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