BMEMED ; IHS/PHXAO/TMJ - ACTUAL UPDATES OF RECORDS - 560 FILE PROCESS ;
;;1.0T1;MEDICAID ELIGIBILITY DOWNLOAD;;JUN 25, 2003
;BMEGMED Global established by Routine BMEGMED.
;This Sets Every Record in AHCCCS File from the BMEGMED(Global
;
;This Routine $0's through Global ^BMEGMED(
;This Routine completes the ACTUAL RPMS DOWNLOAD
;by updating the RPMS MEDICAID ELIGIBILITY File, the
;RPMS Master Control File and the Monthly No Match File
;
;
BEGIN ;Establish Date/Time/Count Variables
;Establish Run Counters
;
;S FILE="MED0120001.TXT" ;Hard Set for Testing Only on just this routine
;
S BMEMNEW=0 ;New Adds to Med Eligibility File
S BMEMUPDT=0 ;Updates to Med Eligibility File
S BMESSNCT=0 ;SSN Matches Only in No Match File
S BMEKIDCT=0 ;KID's Care Counter in No Match File
S BMETOTCT=0 ;Total Records Actually Processed - New or Update
S BMENOCT=0 ; Variable used to not count News & Updates twice
S BMEGTOT=0 ;Grand Total all Records regardless of action
S BMEBTIME=$$NOW^XLFDT
;
INS ;GET ARIZONA MEDICAID INTERNAL NUMBER FROM THE INSURER FILE-PHX AREA
S DIC="^AUTNINS(",DIC(0)="XZIMO",X="MEDICAID" D ^DIC
I Y'=-1 S BMEINS=$P(Y,"^",1)
E G END2 ;Quit if no Insurer - don't write message
;
D START
S BMEETIME=$$NOW^XLFDT
D LOG
D END
Q
;
START ;BEGIN $O THRU ^BMEGMED( -created by Routine BMEGMED
;which reads all records in AHCCCS File 1-420 Position &
;sets full record in ^BMEGMED(Global
;S BMEMRATE=""
;
K ^TMP($J),^BMETMED ;Kill off $Job and Previous Month's BMETMED Global
;
S ^BMETMED(0)="BME MEDICAID NO MATCH^90332DI"
A ; -- BEGIN $O THRU BMEGMED(GLOBAL CREATED BY ROUTINE BMEGMED
S BMEIFN=0 F S BMEIFN=$O(^BMEGMED(BMEIFN)) Q:'BMEIFN D
. S BMEREC=^BMEGMED(BMEIFN),BMEMSSN=$E(BMEREC,27,35),BMEMNUM=$E(BMEREC,18,26),BMEMLNAM=$E(BMEREC,108,130),BMEMDOB=$E(BMEREC,143,150),BMEMSEX=$E(BMEREC,142,142),BMEFNAM=$E(BMEREC,131,140)
. Q:$E(BMEREC,1,2)="XX" ;Quit -Last BMEIFN Record is end of File
. S BMEMLNAM=$P(BMEMLNAM," ",1) ; Strip out spaces on Medicaid Last Name
. S BMEFNAM=$P(BMEFNAM," ",1) ;Strip out spaces on Medicaid First Name
. S BMEMFULN=BMEMLNAM_","_BMEFNAM ;Medicaid Full Name
. S BMEMRATE="" S BMEMKID="" S BMESSNCK="" S BMENOCT=0 S BMEGTOT=BMEGTOT+1
. D MEDNUM ;Check the Med Elig Number before SSN
. I BMENUMCK=0 S DFN=$O(^DPT("SSN",+BMEMSSN,0)) I 'DFN N BMEREC,BMEMSSN,BMEMNUM D ^BMEMED0 Q
. . D MEDNAME ;Check Medicaid Elig File's Medicaid Name (if exists)
. S BMESDOB=$P(^DPT(DFN,0),U,3) ;VA PT DOB
. S BMEMDOB=$$DOB ; AHCCCS DOB
. S BMESSEX=$P(^DPT(DFN,0),U,2),BMESFULN=$P(^(0),U) ; VA PT SEX
. S BMESLNAM=$P(BMESFULN,",",1) ; VA PT FULL LAST NAME
. S BMEMRATE=$E(BMEREC,355,358) ;AHCCCS Rate Code-Ck for Kids Care
. S BMEMEED=$$EED,BMEMEBD=$$EBD ;AHCCCS PAYMENT TO/FROM DT
. S BMEMERD=$$ERD,BMECOVTP=$E(BMEREC,106,107) ;Enrollment Dt - CT=Coverage Type)
. S BMENOCT=0 ;Variable for Not counting New & Updates twice
. I BMEMRATE>5999&(BMEMRATE<7000) S BMEMKID="Y" S BMEKIDCT=BMEKIDCT+1 N BMEREC,BMEMSSN,BMEMNUM D ^BMEMED0 Q ;Quit if KIDS CARE-Per J. Hathcoat 1/25/01
. I BMEMLNAM'=BMESLNAM&(BMENAMCK'=1) S BMESSNCT=BMESSNCT+1 S BMESSNCK="Y" N BMEREC,BMEMSSN,BMEMNUM D ^BMEMED0 Q ; Quit if no match on Med Name or Last Name
. I BMEMDOB'=BMESDOB S BMESSNCT=BMESSNCT+1 S BMESSNCK="Y" N BMEREC,BMEMSSN,BMEMNUM D ^BMEMED0 Q ;Quit on DOB No Match
. I BMEMSEX'=BMESSEX S BMESSNCT=BMESSNCT+1 S BMESSNCK="Y" N BMEREC,BMEMSSN,BMEMNUM D ^BMEMED0 Q ;Quit if no match on Sex
. D NEW,UP0,MED
. S BMETOTCT=BMETOTCT+1 ;Total Record Count - Regardless of action
Q
;
MED ; -- add eligiblity date(s)/data
S BMEIEN=$O(^AUPNMCD("B",DFN,0)) Q:'BMEIEN
Q:$P($G(^AUPNMCD(BMEIEN,11,BMEMEBD,0)),U,2)=BMEMEED ;Quit if Both Beg/End Match already
S:'$D(^AUPNMCD(BMEIEN,11,0)) $P(^(0),U,2)="9000004.11D"
S BMELEBD=$P($G(^AUPNMCD(BMEIEN,11,0)),U,3) ;Last Beg Date entered
I BMELEBD="" D
. S $P(^AUPNMCD(BMEIEN,11,0),U,3)=BMEMEBD
. . S $P(^AUPNMCD(BMEIEN,11,0),U,4)=$P(^(0),U,4)+1
. S DR=".01///"_BMEMEBD_";.03////"_BMECOVTP ; Add Beginning DT Only
. S DIE="^AUPNMCD("_BMEIEN_",11,",DA(1)=BMEIEN,DA=BMEMEBD D ^DIE K DIE,DR,DA,DINUM
. I BMENOCT=0 S BMEMUPDT=BMEMUPDT+1 D UPDATES^BMEMSTR ;Update Count-Update Master List
I BMELEBD'="" D
. S BMELEED=$P($G(^AUPNMCD(BMEIEN,11,BMELEBD,0)),U,2)
. I BMELEED'="" S $P(^AUPNMCD(BMEIEN,11,0),U,3)=BMEMEBD
. . I BMELEED'="" S $P(^AUPNMCD(BMEIEN,11,0),U,4)=$P(^(0),U,4)+1
. I BMELEED'="" S DR=".01///"_BMEMEBD_";03////"_BMECOVTP ; Add Beg DT Only
. I BMELEED'="" S DIE="^AUPNMCD("_BMEIEN_",11,",DA(1)=BMEIEN,DA=BMEMEBD D ^DIE K DIE,DR,DA,DINUM I BMENOCT=0 S BMEMUPDT=BMEMUPDT+1 D UPDATES^BMEMSTR Q
. D STILLACT^BMEMSTR ;Existing Patient fell through-Still Active Only/no Update
Q
;
NEW ; -- create new entry in medicaid eligible
Q:$O(^AUPNMCD("B",+DFN,0)) ;Quit if already in Medicaid Eligibility File
D ^XBFMK K DIADD,DINUM
S X=DFN,DIC="^AUPNMCD(",DIC(0)="L",DLAYGO=9000004
S DIC("DR")=".02////"_BMEINS_";.03////"_BMEMNUM_";.04////"_3_";2101////"_BMEMFULN
S DIC("DR")=DIC("DR")_";.07////"_BMESSEX_";.08////"_DT_";.12////"_BMEMRATE
;K DD,DO
D FILE^DICN S BMEIEN=+Y D ^XBFMK K DIADD,DINUM
S BMEMNEW=BMEMNEW+1 ;Counter for New Adds to Medicaid Eligibility file
S BMENOCT=1 ;Don't count again on Date Updates UP0
D NEW^BMEMSTR
Q
;
UP0 ; -- update 0th node - Patient Demographics Only
S BMEIEN=$O(^AUPNMCD("B",DFN,0)) Q:'BMEIEN
S:'$P(^AUPNMCD(BMEIEN,0),U,2) $P(^AUPNMCD(BMEIEN,0),U,2)=BMEINS
S:'$P(^AUPNMCD(BMEIEN,0),U,3) $P(^AUPNMCD(BMEIEN,0),U,3)=BMEMNUM
S:'$P(^AUPNMCD(BMEIEN,0),U,4) $P(^AUPNMCD(BMEIEN,0),U,4)=3
S DIE="^AUPNMCD(",DA=BMEIEN,DR="2101////"_BMEMFULN_";.08////"_DT_";.12////"_BMEMRATE
D ^DIE K DIE,DR,DA
;I BMENOCT=0 S BMEMUPDT=BMEMUPDT+1 ;Counter for Updates only to Medicaid Eligibility File
Q
;
END ; -- cleanup
S BMEGTOT=BMEGTOT-1
;W !!,"End of Download Update!!!",!
;W !!
;W "Total Records Processed: "_BMEGTOT
;W !,"Total Action Records Process: "_BMETOTCT
;W !,"Total New Records Added: "_BMEMNEW
;W !,"Total Updated Records: "_BMEMUPDT
;W !,"Total Records with SSN Match Only: "_BMESSNCT
;W !!,"Total KID's Care: "_BMEKIDCT
;
K BMEIFN,DFN,BMEIEN,BMEMEED,BMEMEBD,BMECOVTP,BMEMNUM,BMEMSEX,BMEREC,BMECNT,BMEMFULN,BMEFNAM,BMENAMCK,MEDNAME,BMEMIEN,BMEFNAM,BMEMDOB,BMEMRATE
K BMEMNEW,BMEMUPDT,BMESSNCT,BMETOTCT,BMENOCT,BMEGTOT,BMEBTIME,BMEMKID,BMEKIDCT,BMEETIME
Q
;
EED() ; -- eligibility end date
;N X,Y S X=$E(BMEREC,412,419) D ^%DT Q Y
N X,Y S BMEYYYY=$E(BMEREC,412,415),BMEMMDD=$E(BMEREC,416,419)
S BMEMEED=BMEMMDD_BMEYYYY
S X=BMEMEED D ^%DT Q Y
;
EBD() ; -- eligibility beg date
;N X,Y S X=$E(BMEREC,404,411) D ^%DT Q Y
N X,Y S BMEYYYY=$E(BMEREC,347,350),BMEMMDD=$E(BMEREC,351,354)
S BMEMEBD=BMEMMDD_BMEYYYY
S X=BMEMEBD D ^%DT Q Y
;
EHIS() ; -- eligibilities after date/flag
N X1,X2,X S X1=DT,X2=-180 D C^%DTC Q X
;
HRCN() ;EP; -- IHS health record number
Q $P($G(^AUPNPAT(+$G(DFN),41,+$G(DUZ(2)),0)),"^",2)
;
ERD() ;EP -- Eligibility Enrollment Dt (Same as Beg Date on Roster)
;Roster Positions 347-354
N X,Y S BMEYYYY=$E(BMEREC,347,350),BMEMMDD=$E(BMEREC,351,354)
S BMEMERD=BMEMMDD_BMEYYYY
S X=BMEMERD D ^%DT Q Y
;N X,Y S X=$E(BMEREC,404,411) D ^%DT Q Y
;
DOB() ;EP - Date of AHCCCS Birth Date Conversion
N X,Y S BMEYYYY=$E(BMEREC,143,146),BMEMMDD=$E(BMEREC,147,150)
S BMEMDOB=BMEMMDD_BMEYYYY
S X=BMEMDOB D ^%DT Q Y
;
LOG ;Update BME MEDICAL ELIGIBLE DOWNLOAD LOG
;W !!,"The Download Process is Now Complete!!"
;W !!,"I will now update the Download Log with the final run documentation",!
;The .01 Entry is Today's Date at time of run - BMEBTIME Variable
D ^XBFMK K DIADD,DINUM
S X=BMEBTIME,DIC="^BMEMLOG(",DIC(0)="L",DLAYGO=90333
S DIC("DR")=".02////"_BMEETIME_";.03////"_BMEGTOT_";.04///"_BMETOTCT_";.05////"_BMESSNCT_";1///"_BMEKIDCT
S DIC("DR")=DIC("DR")_";.06////"_BMEMNEW_";.07////"_BMEMUPDT_";.08////"_BMEFILE
D FILE^DICN S IEN=+Y D ^XBFMK K DIADD,DINUM
;
;W !!,"Log File Updated",!
;
Q
;
END2 ;Abnormal Termination - Medicaid Insurer missing from Insurer File
;W !,"The Insurer - ARIZONA MEDICAID -missing from the Insurer File",!
;W !,"The Initial Process of creating the BMEGMED Global is complete",!
;W "however, the Update Run (BMEMED) cannot be ran - See your Site Manager",!!
Q
;
MEDNAME ;Check Med Elig Medicaid Name-If exists for match
;
S BMENAMCK=0
S BMEMIEN=$O(^AUPNMCD("B",+DFN,0))
Q:'BMEMIEN
S BMEMEDNA=$P($G(^AUPNMCD(BMEMIEN,21)),U,1)
Q:BMEMEDNA=""
I BMEMEDNA=BMEMFULN S BMENAMCK=1
Q
;
MEDNUM ;Check Med Elig Number against RPMS
;
S BMENUMCK=0
S BMEMIEN=$O(^AUPNMCD("AE",BMEMNUM,0))
Q:'BMEMIEN
S BMEMEDNU=$P($G(^AUPNMCD(BMEMIEN,0)),U,3)
Q:BMEMEDNU=""
I BMEMEDNU=BMEMNUM S BMENUMCK=1 S DFN=$P($G(^AUPNMCD(BMEMIEN,0)),U,1)
Q
;
BMEMED ; IHS/PHXAO/TMJ - ACTUAL UPDATES OF RECORDS - 560 FILE PROCESS ;
+1 ;;1.0T1;MEDICAID ELIGIBILITY DOWNLOAD;;JUN 25, 2003
+2 ;BMEGMED Global established by Routine BMEGMED.
+3 ;This Sets Every Record in AHCCCS File from the BMEGMED(Global
+4 ;
+5 ;This Routine $0's through Global ^BMEGMED(
+6 ;This Routine completes the ACTUAL RPMS DOWNLOAD
+7 ;by updating the RPMS MEDICAID ELIGIBILITY File, the
+8 ;RPMS Master Control File and the Monthly No Match File
+9 ;
+10 ;
BEGIN ;Establish Date/Time/Count Variables
+1 ;Establish Run Counters
+2 ;
+3 ;S FILE="MED0120001.TXT" ;Hard Set for Testing Only on just this routine
+4 ;
+5 ;New Adds to Med Eligibility File
SET BMEMNEW=0
+6 ;Updates to Med Eligibility File
SET BMEMUPDT=0
+7 ;SSN Matches Only in No Match File
SET BMESSNCT=0
+8 ;KID's Care Counter in No Match File
SET BMEKIDCT=0
+9 ;Total Records Actually Processed - New or Update
SET BMETOTCT=0
+10 ; Variable used to not count News & Updates twice
SET BMENOCT=0
+11 ;Grand Total all Records regardless of action
SET BMEGTOT=0
+12 SET BMEBTIME=$$NOW^XLFDT
+13 ;
INS ;GET ARIZONA MEDICAID INTERNAL NUMBER FROM THE INSURER FILE-PHX AREA
+1 SET DIC="^AUTNINS("
SET DIC(0)="XZIMO"
SET X="MEDICAID"
DO ^DIC
+2 IF Y'=-1
SET BMEINS=$PIECE(Y,"^",1)
+3 ;Quit if no Insurer - don't write message
IF '$TEST
GOTO END2
+4 ;
+5 DO START
+6 SET BMEETIME=$$NOW^XLFDT
+7 DO LOG
+8 DO END
+9 QUIT
+10 ;
START ;BEGIN $O THRU ^BMEGMED( -created by Routine BMEGMED
+1 ;which reads all records in AHCCCS File 1-420 Position &
+2 ;sets full record in ^BMEGMED(Global
+3 ;S BMEMRATE=""
+4 ;
+5 ;Kill off $Job and Previous Month's BMETMED Global
KILL ^TMP($JOB),^BMETMED
+6 ;
+7 SET ^BMETMED(0)="BME MEDICAID NO MATCH^90332DI"
A ; -- BEGIN $O THRU BMEGMED(GLOBAL CREATED BY ROUTINE BMEGMED
+1 SET BMEIFN=0
FOR
SET BMEIFN=$ORDER(^BMEGMED(BMEIFN))
IF 'BMEIFN
QUIT
Begin DoDot:1
+2 SET BMEREC=^BMEGMED(BMEIFN)
SET BMEMSSN=$EXTRACT(BMEREC,27,35)
SET BMEMNUM=$EXTRACT(BMEREC,18,26)
SET BMEMLNAM=$EXTRACT(BMEREC,108,130)
SET BMEMDOB=$EXTRACT(BMEREC,143,150)
SET BMEMSEX=$EXTRACT(BMEREC,142,142)
SET BMEFNAM=$EXTRACT(BMEREC,131,140)
+3 ;Quit -Last BMEIFN Record is end of File
IF $EXTRACT(BMEREC,1,2)="XX"
QUIT
+4 ; Strip out spaces on Medicaid Last Name
SET BMEMLNAM=$PIECE(BMEMLNAM," ",1)
+5 ;Strip out spaces on Medicaid First Name
SET BMEFNAM=$PIECE(BMEFNAM," ",1)
+6 ;Medicaid Full Name
SET BMEMFULN=BMEMLNAM_","_BMEFNAM
+7 SET BMEMRATE=""
SET BMEMKID=""
SET BMESSNCK=""
SET BMENOCT=0
SET BMEGTOT=BMEGTOT+1
+8 ;Check the Med Elig Number before SSN
DO MEDNUM
+9 IF BMENUMCK=0
SET DFN=$ORDER(^DPT("SSN",+BMEMSSN,0))
IF 'DFN
NEW BMEREC,BMEMSSN,BMEMNUM
DO ^BMEMED0
QUIT
+10 ;Check Medicaid Elig File's Medicaid Name (if exists)
DO MEDNAME
+11 ;VA PT DOB
SET BMESDOB=$PIECE(^DPT(DFN,0),U,3)
+12 ; AHCCCS DOB
SET BMEMDOB=$$DOB
+13 ; VA PT SEX
SET BMESSEX=$PIECE(^DPT(DFN,0),U,2)
SET BMESFULN=$PIECE(^(0),U)
+14 ; VA PT FULL LAST NAME
SET BMESLNAM=$PIECE(BMESFULN,",",1)
+15 ;AHCCCS Rate Code-Ck for Kids Care
SET BMEMRATE=$EXTRACT(BMEREC,355,358)
+16 ;AHCCCS PAYMENT TO/FROM DT
SET BMEMEED=$$EED
SET BMEMEBD=$$EBD
+17 ;Enrollment Dt - CT=Coverage Type)
SET BMEMERD=$$ERD
SET BMECOVTP=$EXTRACT(BMEREC,106,107)
+18 ;Variable for Not counting New & Updates twice
SET BMENOCT=0
+19 ;Quit if KIDS CARE-Per J. Hathcoat 1/25/01
IF BMEMRATE>5999&(BMEMRATE<7000)
SET BMEMKID="Y"
SET BMEKIDCT=BMEKIDCT+1
NEW BMEREC,BMEMSSN,BMEMNUM
DO ^BMEMED0
QUIT
+20 ; Quit if no match on Med Name or Last Name
IF BMEMLNAM'=BMESLNAM&(BMENAMCK'=1)
SET BMESSNCT=BMESSNCT+1
SET BMESSNCK="Y"
NEW BMEREC,BMEMSSN,BMEMNUM
DO ^BMEMED0
QUIT
+21 ;Quit on DOB No Match
IF BMEMDOB'=BMESDOB
SET BMESSNCT=BMESSNCT+1
SET BMESSNCK="Y"
NEW BMEREC,BMEMSSN,BMEMNUM
DO ^BMEMED0
QUIT
+22 ;Quit if no match on Sex
IF BMEMSEX'=BMESSEX
SET BMESSNCT=BMESSNCT+1
SET BMESSNCK="Y"
NEW BMEREC,BMEMSSN,BMEMNUM
DO ^BMEMED0
QUIT
+23 DO NEW
DO UP0
DO MED
+24 ;Total Record Count - Regardless of action
SET BMETOTCT=BMETOTCT+1
End DoDot:1
+25 QUIT
+26 ;
MED ; -- add eligiblity date(s)/data
+1 SET BMEIEN=$ORDER(^AUPNMCD("B",DFN,0))
IF 'BMEIEN
QUIT
+2 ;Quit if Both Beg/End Match already
IF $PIECE($GET(^AUPNMCD(BMEIEN,11,BMEMEBD,0)),U,2)=BMEMEED
QUIT
+3 IF '$DATA(^AUPNMCD(BMEIEN,11,0))
SET $PIECE(^(0),U,2)="9000004.11D"
+4 ;Last Beg Date entered
SET BMELEBD=$PIECE($GET(^AUPNMCD(BMEIEN,11,0)),U,3)
+5 IF BMELEBD=""
Begin DoDot:1
+6 SET $PIECE(^AUPNMCD(BMEIEN,11,0),U,3)=BMEMEBD
+7 SET $PIECE(^AUPNMCD(BMEIEN,11,0),U,4)=$PIECE(^(0),U,4)+1
+8 ; Add Beginning DT Only
SET DR=".01///"_BMEMEBD_";.03////"_BMECOVTP
+9 SET DIE="^AUPNMCD("_BMEIEN_",11,"
SET DA(1)=BMEIEN
SET DA=BMEMEBD
DO ^DIE
KILL DIE,DR,DA,DINUM
+10 ;Update Count-Update Master List
IF BMENOCT=0
SET BMEMUPDT=BMEMUPDT+1
DO UPDATES^BMEMSTR
End DoDot:1
+11 IF BMELEBD'=""
Begin DoDot:1
+12 SET BMELEED=$PIECE($GET(^AUPNMCD(BMEIEN,11,BMELEBD,0)),U,2)
+13 IF BMELEED'=""
SET $PIECE(^AUPNMCD(BMEIEN,11,0),U,3)=BMEMEBD
+14 IF BMELEED'=""
SET $PIECE(^AUPNMCD(BMEIEN,11,0),U,4)=$PIECE(^(0),U,4)+1
+15 ; Add Beg DT Only
IF BMELEED'=""
SET DR=".01///"_BMEMEBD_";03////"_BMECOVTP
+16 IF BMELEED'=""
SET DIE="^AUPNMCD("_BMEIEN_",11,"
SET DA(1)=BMEIEN
SET DA=BMEMEBD
DO ^DIE
KILL DIE,DR,DA,DINUM
IF BMENOCT=0
SET BMEMUPDT=BMEMUPDT+1
DO UPDATES^BMEMSTR
QUIT
+17 ;Existing Patient fell through-Still Active Only/no Update
DO STILLACT^BMEMSTR
End DoDot:1
+18 QUIT
+19 ;
NEW ; -- create new entry in medicaid eligible
+1 ;Quit if already in Medicaid Eligibility File
IF $ORDER(^AUPNMCD("B",+DFN,0))
QUIT
+2 DO ^XBFMK
KILL DIADD,DINUM
+3 SET X=DFN
SET DIC="^AUPNMCD("
SET DIC(0)="L"
SET DLAYGO=9000004
+4 SET DIC("DR")=".02////"_BMEINS_";.03////"_BMEMNUM_";.04////"_3_";2101////"_BMEMFULN
+5 SET DIC("DR")=DIC("DR")_";.07////"_BMESSEX_";.08////"_DT_";.12////"_BMEMRATE
+6 ;K DD,DO
+7 DO FILE^DICN
SET BMEIEN=+Y
DO ^XBFMK
KILL DIADD,DINUM
+8 ;Counter for New Adds to Medicaid Eligibility file
SET BMEMNEW=BMEMNEW+1
+9 ;Don't count again on Date Updates UP0
SET BMENOCT=1
+10 DO NEW^BMEMSTR
+11 QUIT
+12 ;
UP0 ; -- update 0th node - Patient Demographics Only
+1 SET BMEIEN=$ORDER(^AUPNMCD("B",DFN,0))
IF 'BMEIEN
QUIT
+2 IF '$PIECE(^AUPNMCD(BMEIEN,0),U,2)
SET $PIECE(^AUPNMCD(BMEIEN,0),U,2)=BMEINS
+3 IF '$PIECE(^AUPNMCD(BMEIEN,0),U,3)
SET $PIECE(^AUPNMCD(BMEIEN,0),U,3)=BMEMNUM
+4 IF '$PIECE(^AUPNMCD(BMEIEN,0),U,4)
SET $PIECE(^AUPNMCD(BMEIEN,0),U,4)=3
+5 SET DIE="^AUPNMCD("
SET DA=BMEIEN
SET DR="2101////"_BMEMFULN_";.08////"_DT_";.12////"_BMEMRATE
+6 DO ^DIE
KILL DIE,DR,DA
+7 ;I BMENOCT=0 S BMEMUPDT=BMEMUPDT+1 ;Counter for Updates only to Medicaid Eligibility File
+8 QUIT
+9 ;
END ; -- cleanup
+1 SET BMEGTOT=BMEGTOT-1
+2 ;W !!,"End of Download Update!!!",!
+3 ;W !!
+4 ;W "Total Records Processed: "_BMEGTOT
+5 ;W !,"Total Action Records Process: "_BMETOTCT
+6 ;W !,"Total New Records Added: "_BMEMNEW
+7 ;W !,"Total Updated Records: "_BMEMUPDT
+8 ;W !,"Total Records with SSN Match Only: "_BMESSNCT
+9 ;W !!,"Total KID's Care: "_BMEKIDCT
+10 ;
+11 KILL BMEIFN,DFN,BMEIEN,BMEMEED,BMEMEBD,BMECOVTP,BMEMNUM,BMEMSEX,BMEREC,BMECNT,BMEMFULN,BMEFNAM,BMENAMCK,MEDNAME,BMEMIEN,BMEFNAM,BMEMDOB,BMEMRATE
+12 KILL BMEMNEW,BMEMUPDT,BMESSNCT,BMETOTCT,BMENOCT,BMEGTOT,BMEBTIME,BMEMKID,BMEKIDCT,BMEETIME
+13 QUIT
+14 ;
EED() ; -- eligibility end date
+1 ;N X,Y S X=$E(BMEREC,412,419) D ^%DT Q Y
+2 NEW X,Y
SET BMEYYYY=$EXTRACT(BMEREC,412,415)
SET BMEMMDD=$EXTRACT(BMEREC,416,419)
+3 SET BMEMEED=BMEMMDD_BMEYYYY
+4 SET X=BMEMEED
DO ^%DT
QUIT Y
+5 ;
EBD() ; -- eligibility beg date
+1 ;N X,Y S X=$E(BMEREC,404,411) D ^%DT Q Y
+2 NEW X,Y
SET BMEYYYY=$EXTRACT(BMEREC,347,350)
SET BMEMMDD=$EXTRACT(BMEREC,351,354)
+3 SET BMEMEBD=BMEMMDD_BMEYYYY
+4 SET X=BMEMEBD
DO ^%DT
QUIT Y
+5 ;
EHIS() ; -- eligibilities after date/flag
+1 NEW X1,X2,X
SET X1=DT
SET X2=-180
DO C^%DTC
QUIT X
+2 ;
HRCN() ;EP; -- IHS health record number
+1 QUIT $PIECE($GET(^AUPNPAT(+$GET(DFN),41,+$GET(DUZ(2)),0)),"^",2)
+2 ;
ERD() ;EP -- Eligibility Enrollment Dt (Same as Beg Date on Roster)
+1 ;Roster Positions 347-354
+2 NEW X,Y
SET BMEYYYY=$EXTRACT(BMEREC,347,350)
SET BMEMMDD=$EXTRACT(BMEREC,351,354)
+3 SET BMEMERD=BMEMMDD_BMEYYYY
+4 SET X=BMEMERD
DO ^%DT
QUIT Y
+5 ;N X,Y S X=$E(BMEREC,404,411) D ^%DT Q Y
+6 ;
DOB() ;EP - Date of AHCCCS Birth Date Conversion
+1 NEW X,Y
SET BMEYYYY=$EXTRACT(BMEREC,143,146)
SET BMEMMDD=$EXTRACT(BMEREC,147,150)
+2 SET BMEMDOB=BMEMMDD_BMEYYYY
+3 SET X=BMEMDOB
DO ^%DT
QUIT Y
+4 ;
LOG ;Update BME MEDICAL ELIGIBLE DOWNLOAD LOG
+1 ;W !!,"The Download Process is Now Complete!!"
+2 ;W !!,"I will now update the Download Log with the final run documentation",!
+3 ;The .01 Entry is Today's Date at time of run - BMEBTIME Variable
+4 DO ^XBFMK
KILL DIADD,DINUM
+5 SET X=BMEBTIME
SET DIC="^BMEMLOG("
SET DIC(0)="L"
SET DLAYGO=90333
+6 SET DIC("DR")=".02////"_BMEETIME_";.03////"_BMEGTOT_";.04///"_BMETOTCT_";.05////"_BMESSNCT_";1///"_BMEKIDCT
+7 SET DIC("DR")=DIC("DR")_";.06////"_BMEMNEW_";.07////"_BMEMUPDT_";.08////"_BMEFILE
+8 DO FILE^DICN
SET IEN=+Y
DO ^XBFMK
KILL DIADD,DINUM
+9 ;
+10 ;W !!,"Log File Updated",!
+11 ;
+12 QUIT
+13 ;
END2 ;Abnormal Termination - Medicaid Insurer missing from Insurer File
+1 ;W !,"The Insurer - ARIZONA MEDICAID -missing from the Insurer File",!
+2 ;W !,"The Initial Process of creating the BMEGMED Global is complete",!
+3 ;W "however, the Update Run (BMEMED) cannot be ran - See your Site Manager",!!
+4 QUIT
+5 ;
MEDNAME ;Check Med Elig Medicaid Name-If exists for match
+1 ;
+2 SET BMENAMCK=0
+3 SET BMEMIEN=$ORDER(^AUPNMCD("B",+DFN,0))
+4 IF 'BMEMIEN
QUIT
+5 SET BMEMEDNA=$PIECE($GET(^AUPNMCD(BMEMIEN,21)),U,1)
+6 IF BMEMEDNA=""
QUIT
+7 IF BMEMEDNA=BMEMFULN
SET BMENAMCK=1
+8 QUIT
+9 ;
MEDNUM ;Check Med Elig Number against RPMS
+1 ;
+2 SET BMENUMCK=0
+3 SET BMEMIEN=$ORDER(^AUPNMCD("AE",BMEMNUM,0))
+4 IF 'BMEMIEN
QUIT
+5 SET BMEMEDNU=$PIECE($GET(^AUPNMCD(BMEMIEN,0)),U,3)
+6 IF BMEMEDNU=""
QUIT
+7 IF BMEMEDNU=BMEMNUM
SET BMENUMCK=1
SET DFN=$PIECE($GET(^AUPNMCD(BMEMIEN,0)),U,1)
+8 QUIT
+9 ;
