BMEMED4 ; IHS/PHXAO/TMJ - Add Non Auto Eligibles to Medicaid File ;
;;1.0T1;MEDICAID ELIGIBILITY DOWNLOAD;;JUN 25, 2003
;
;This Routine is used to Manually Compare and Automatically
;update Patient Registration. The compare of Patients residing
;in the Temporary Monthly No Match File against RPMS Patient
;Registration allows the User to Update Medicaid Eligibility
;File upon comparison.
;
;
W @IOF
A ; -- driver
D LOOK I BMEIEN<1 D END Q
D DISP,PCHK I DFN<1 G A
D DISP,DIQ2
I $$SAME,$$MERGE D UPD
G A
;
LOOK ; -- ask patient to check for eligibility do lookup
W !! K DIC S DIC="^BMETMED(",DIC(0)="AEMQZ"
S DIC("A")="Please enter MEDICAID ROSTER Patient Name: "
D ^DIC S BMEIEN=+Y K DIC Q
;
DISP ; -- display all information to the user
W @IOF,!,"Medicaid Eligibility Roster Data",!
K DIC S DIC="^BMETMED(",DA=BMEIEN D EN^DIQ K DIC,DA,DR Q
;
DIQ2 ; -- display all information to the user
W !!,"RPMS patient file entry",!
N BMEREC S BMEREC=^DPT(DFN,0) W !,$P(BMEREC,U),?32,$P(BMEREC,U,2),?34,$P(BMEREC,U,9)
W ?46,"HRCN: ",$$HRCN^BMEMED S Y=$P(BMEREC,U,3) X ^DD("DD") W !,"DOB: ",Y
S BMEREC=$G(^DPT(DFN,.11)) W ?20,$P(BMEREC,U,4)," ",$$ST Q
;
ST() ; -- state
Q $P($G(^DIC(5,+$P(BMEREC,U,5),0)),U)
;
SAME() ; -- ask user if patient's are the same
W !! N X,Y,DIR S DIR(0)="Y",DIR("A")="Are these the same patient "
S DIR("B")="Y" D ^DIR Q $S($D(DIRUT):0,'Y:0,1:1)
;
MERGE() ; -- merge
W ! N X,Y,DIR S DIR(0)="Y",DIR("A")="Update the RPMS Medicated Eligibility File"
S DIR("B")="N" D ^DIR Q $S($D(DIRUT):0,'Y:0,1:1)
;
PCHK ; -- look up patient in patient file
N X,Y K DIC S DIC="^AUPNPAT(",DIC(0)="AEMQZ"
S DIC("A")="Please enter RPMS Patient Name: " D ^DIC S DFN=+Y K DIC Q
;
UPD ; -- update ssn and medicaid eligible
S BMEREC=^BMETMED(BMEIEN,0),SSN=$P(BMEREC,U,10) D:SSN
. ;Q:$O(^DPT("SSN",SSN,0))
. ;S DIE="^DPT(",DA=DFN,DR=".09///"_SSN N N,SSN D ^DIE
D INS
S BMEMEBD=+BMEREC,BMEMEED=$P($G(BMEREC),U,9),BMECOVTP=$P(BMEREC,U,8),BMENUM=$P(BMEREC,U,6),BMENAME=$P(BMEREC,U,2)
S BMEMDOB=$P(BMEREC,U,4) ; Medicaid Date of Birth 10/12/02
S BMESEX=$P(BMEREC,U,3),BMEMRATE=$P(BMEREC,U,13) W !,"I am updating the Medicaid Eligibility File now. "
D NEW,UP0,MED
Q
;
END ; -- cleanup
K DA,DFN,BMEMEBD,BMEMEED,BMECOVTP,SSN,BMEIEN,E,X,Y,N
Q
;
;
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 U IO(0) W !!,*7,"ERROR IN INSURER FILE..." G END
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 - 834 No longer has Ending Date
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
. I BMENEW=0 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 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 I BMENEW=0 D UPDATES^BMEMSTR Q
. D STILLACT^BMEMSTR ;Existing Patient fell through-Still Active Only/no Update
Q
;
NEW ; -- create new entry in medicaid eligible
D ^XBFMK K DIADD,DINUM
S BMENEW=0 ;Set Variable for New Record Add
Q:$O(^AUPNMCD("B",+DFN,0)) ;Quit if already in Medicaid Eligibility File
N X,Y S X=DFN,DIC="^AUPNMCD(",DIC(0)="L"
S DIC("DR")=".02////"_BMEINS_";.03////"_BMENUM_";.04////"_3_";2101////"_BMENAME
S DIC("DR")=DIC("DR")_";.07////"_BMESEX_";.08////"_DT_";.12////"_BMEMRATE_";2102////"_BMEMDOB
;
K DD,DO
D FILE^DICN S BMEIEN=+Y K DIC
D NEW^BMEMSTR
S BMENEW=1
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)=BMENUM
S:'$P(^AUPNMCD(BMEIEN,0),U,4) $P(^AUPNMCD(BMEIEN,0),U,4)=3
S DIE="^AUPNMCD(",DA=BMEIEN,DR="2101////"_BMENAME_";.08////"_DT_";.12////"_BMEMRATE_";2102////"_BMEMDOB
D ^DIE K DIE,DR,DA
Q
;
BMEMED4 ; IHS/PHXAO/TMJ - Add Non Auto Eligibles to Medicaid File ;
+1 ;;1.0T1;MEDICAID ELIGIBILITY DOWNLOAD;;JUN 25, 2003
+2 ;
+3 ;This Routine is used to Manually Compare and Automatically
+4 ;update Patient Registration. The compare of Patients residing
+5 ;in the Temporary Monthly No Match File against RPMS Patient
+6 ;Registration allows the User to Update Medicaid Eligibility
+7 ;File upon comparison.
+8 ;
+9 ;
+10 WRITE @IOF
A ; -- driver
+1 DO LOOK
IF BMEIEN<1
DO END
QUIT
+2 DO DISP
DO PCHK
IF DFN<1
GOTO A
+3 DO DISP
DO DIQ2
+4 IF $$SAME
IF $$MERGE
DO UPD
+5 GOTO A
+6 ;
LOOK ; -- ask patient to check for eligibility do lookup
+1 WRITE !!
KILL DIC
SET DIC="^BMETMED("
SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Please enter MEDICAID ROSTER Patient Name: "
+3 DO ^DIC
SET BMEIEN=+Y
KILL DIC
QUIT
+4 ;
DISP ; -- display all information to the user
+1 WRITE @IOF,!,"Medicaid Eligibility Roster Data",!
+2 KILL DIC
SET DIC="^BMETMED("
SET DA=BMEIEN
DO EN^DIQ
KILL DIC,DA,DR
QUIT
+3 ;
DIQ2 ; -- display all information to the user
+1 WRITE !!,"RPMS patient file entry",!
+2 NEW BMEREC
SET BMEREC=^DPT(DFN,0)
WRITE !,$PIECE(BMEREC,U),?32,$PIECE(BMEREC,U,2),?34,$PIECE(BMEREC,U,9)
+3 WRITE ?46,"HRCN: ",$$HRCN^BMEMED
SET Y=$PIECE(BMEREC,U,3)
XECUTE ^DD("DD")
WRITE !,"DOB: ",Y
+4 SET BMEREC=$GET(^DPT(DFN,.11))
WRITE ?20,$PIECE(BMEREC,U,4)," ",$$ST
QUIT
+5 ;
ST() ; -- state
+1 QUIT $PIECE($GET(^DIC(5,+$PIECE(BMEREC,U,5),0)),U)
+2 ;
SAME() ; -- ask user if patient's are the same
+1 WRITE !!
NEW X,Y,DIR
SET DIR(0)="Y"
SET DIR("A")="Are these the same patient "
+2 SET DIR("B")="Y"
DO ^DIR
QUIT $SELECT($DATA(DIRUT):0,'Y:0,1:1)
+3 ;
MERGE() ; -- merge
+1 WRITE !
NEW X,Y,DIR
SET DIR(0)="Y"
SET DIR("A")="Update the RPMS Medicated Eligibility File"
+2 SET DIR("B")="N"
DO ^DIR
QUIT $SELECT($DATA(DIRUT):0,'Y:0,1:1)
+3 ;
PCHK ; -- look up patient in patient file
+1 NEW X,Y
KILL DIC
SET DIC="^AUPNPAT("
SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Please enter RPMS Patient Name: "
DO ^DIC
SET DFN=+Y
KILL DIC
QUIT
+3 ;
UPD ; -- update ssn and medicaid eligible
+1 SET BMEREC=^BMETMED(BMEIEN,0)
SET SSN=$PIECE(BMEREC,U,10)
IF SSN
Begin DoDot:1
+2 ;Q:$O(^DPT("SSN",SSN,0))
+3 ;S DIE="^DPT(",DA=DFN,DR=".09///"_SSN N N,SSN D ^DIE
End DoDot:1
+4 DO INS
+5 SET BMEMEBD=+BMEREC
SET BMEMEED=$PIECE($GET(BMEREC),U,9)
SET BMECOVTP=$PIECE(BMEREC,U,8)
SET BMENUM=$PIECE(BMEREC,U,6)
SET BMENAME=$PIECE(BMEREC,U,2)
+6 ; Medicaid Date of Birth 10/12/02
SET BMEMDOB=$PIECE(BMEREC,U,4)
+7 SET BMESEX=$PIECE(BMEREC,U,3)
SET BMEMRATE=$PIECE(BMEREC,U,13)
WRITE !,"I am updating the Medicaid Eligibility File now. "
+8 DO NEW
DO UP0
DO MED
+9 QUIT
+10 ;
END ; -- cleanup
+1 KILL DA,DFN,BMEMEBD,BMEMEED,BMECOVTP,SSN,BMEIEN,E,X,Y,N
+2 QUIT
+3 ;
+4 ;
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 IF '$TEST
USE IO(0)
WRITE !!,*7,"ERROR IN INSURER FILE..."
GOTO END
+4 QUIT
+5 ;
+6 ;
MED ; -- add eligiblity date(s)/data
+1 SET BMEIEN=$ORDER(^AUPNMCD("B",DFN,0))
IF 'BMEIEN
QUIT
+2 ;Q:$P($G(^AUPNMCD(BMEIEN,11,BMEMEBD,0)),U,2)=BMEMEED ;Quit if Both Beg/End Match already - 834 No longer has Ending Date
+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
+10 ;Update Count-Update Master List
IF BMENEW=0
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 ; Add Beg DT Only
IF BMELEED'=""
SET DR=".01///"_BMEMEBD_";03////"_BMECOVTP
+14 IF BMELEED'=""
SET DIE="^AUPNMCD("_BMEIEN_",11,"
SET DA(1)=BMEIEN
SET DA=BMEMEBD
DO ^DIE
KILL DIE,DR,DA
IF BMENEW=0
DO UPDATES^BMEMSTR
QUIT
+15 ;Existing Patient fell through-Still Active Only/no Update
DO STILLACT^BMEMSTR
End DoDot:1
+16 QUIT
+17 ;
NEW ; -- create new entry in medicaid eligible
+1 DO ^XBFMK
KILL DIADD,DINUM
+2 ;Set Variable for New Record Add
SET BMENEW=0
+3 ;Quit if already in Medicaid Eligibility File
IF $ORDER(^AUPNMCD("B",+DFN,0))
QUIT
+4 NEW X,Y
SET X=DFN
SET DIC="^AUPNMCD("
SET DIC(0)="L"
+5 SET DIC("DR")=".02////"_BMEINS_";.03////"_BMENUM_";.04////"_3_";2101////"_BMENAME
+6 SET DIC("DR")=DIC("DR")_";.07////"_BMESEX_";.08////"_DT_";.12////"_BMEMRATE_";2102////"_BMEMDOB
+7 ;
+8 KILL DD,DO
+9 DO FILE^DICN
SET BMEIEN=+Y
KILL DIC
+10 DO NEW^BMEMSTR
+11 SET BMENEW=1
+12 QUIT
+13 ;
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)=BMENUM
+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////"_BMENAME_";.08////"_DT_";.12////"_BMEMRATE_";2102////"_BMEMDOB
+6 DO ^DIE
KILL DIE,DR,DA
+7 QUIT
+8 ;
