BMEMED4 ; IHS/PHXAO/TMJ - Add Non Auto Eligibles to Medicaid File ; [ 06/11/03 3:29 PM ]
;
;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 IEN<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="^AZAMED(",DIC(0)="AEMQZ"
S DIC("A")="Please enter MEDICAID ROSTER Patient Name: "
D ^DIC S IEN=+Y K DIC Q
;
DISP ; -- display all information to the user
W @IOF,!,"Medicaid Eligibility Roster Data",!
K DIC S DIC="^AZAMED(",DA=IEN D EN^DIQ K DIC,DA,DR Q
;
DIQ2 ; -- display all information to the user
W !!,"RPMS patient file entry",!
N N S N=^DPT(DFN,0) W !,$P(N,U),?32,$P(N,U,2),?34,$P(N,U,9)
;W ?46,"HRCN: ",$$HRCN^ADGF S Y=$P(N,U,3) X ^DD("DD") W !,"DOB: ",Y
W ?46,"HRCN: ",$$HRCN^AZAMED S Y=$P(N,U,3) X ^DD("DD") W !,"DOB: ",Y ;IHS/ANMC/LJF 1/21/99 keep calls within namespace
S N=$G(^DPT(DFN,.11)) W ?20,$P(N,U,4)," ",$$ST Q
;
ST() ; -- state
Q $P($G(^DIC(5,+$P(N,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 N=^AZAMED(IEN,0),SSN=$P(N,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 EBD=+N,EED=$P(N,U,9),CT=$P(N,U,8),NUM=$P(N,U,6),NAME=$P(N,U,2)
S MDOB=$P(N,U,4) ; Medicaid Date of Birth 10/12/02
S SEX=$P(N,U,3),MRATE=$P(N,U,13) W !,"I am updating the Medicaid Eligibility File now. "
D NEW,UP0,MED
Q
;
END ; -- cleanup
K DA,DFN,EBD,EED,CT,SSN,IEN,E,X,Y,N
Q
;
;
INS ;GET ARIZONA MEDICAID INTERNAL NUMBER FROM THE INSURER FILE-PHX AREA
S DIC="^AUTNINS(",DIC(0)="XZIMO",X="ARIZONA MEDICAID" D ^DIC
I Y'=-1 S INS=$P(Y,"^",1)
E U IO(0) W !!,*7,"ERROR IN INSURER FILE..." G END
Q
;
;
MED ; -- add eligiblity date(s)/data
S IEN=$O(^AUPNMCD("B",DFN,0)) Q:'IEN
Q:$P($G(^AUPNMCD(IEN,11,EBD,0)),U,2)=EED ;Quit if Both Beg/End Match already
S:'$D(^AUPNMCD(IEN,11,0)) $P(^(0),U,2)="9000004.11D"
S LSTEBD=$P($G(^AUPNMCD(IEN,11,0)),U,3) ;Last Beg Date entered
I LSTEBD="" D
. S $P(^AUPNMCD(IEN,11,0),U,3)=EBD
. S $P(^AUPNMCD(IEN,11,0),U,4)=$P(^(0),U,4)+1
. S DR=".01///"_EBD_";.03////"_CT ; Add Beginning DT Only
. S DIE="^AUPNMCD("_IEN_",11,",DA(1)=IEN,DA=EBD D ^DIE K DIE,DR,DA
. I NEWADD=0 D UPDATES^AZAMSTR ;Update Count-Update Master List
I LSTEBD'="" D
. S SENDDT=$P($G(^AUPNMCD(IEN,11,LSTEBD,0)),U,2)
. I SENDDT'="" S DR=".01///"_EBD_";03////"_CT ; Add Beg DT Only
. I SENDDT'="" S DIE="^AUPNMCD("_IEN_",11,",DA(1)=IEN,DA=EBD D ^DIE K DIE,DR,DA I NEWADD=0 D UPDATES^AZAMSTR Q
. D STILLACT^AZAMSTR ;Existing Patient fell through-Still Active Only/no Update
Q
;
NEW ; -- create new entry in medicaid eligible
S NEWADD=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////"_INS_";.03////"_NUM_";.04////3;2101////"_NAME
S DIC("DR")=DIC("DR")_";.07////"_SEX_";.08////"_DT_";.12////"_MRATE_";2102////"_MDOB
;
K DD,DO
D FILE^DICN S IEN=+Y K DIC
D NEW^AZAMSTR
S NEWADD=1
Q
;
UP0 ; -- update 0th node - Patient Demographics Only
S IEN=$O(^AUPNMCD("B",DFN,0)) Q:'IEN
S:'$P(^AUPNMCD(IEN,0),U,2) $P(^AUPNMCD(IEN,0),U,2)=INS
S:'$P(^AUPNMCD(IEN,0),U,3) $P(^AUPNMCD(IEN,0),U,3)=NUM
S:'$P(^AUPNMCD(IEN,0),U,4) $P(^AUPNMCD(IEN,0),U,4)=3
S DIE="^AUPNMCD(",DA=IEN,DR="2101////"_NAME_";.08////"_DT_";.12////"_MRATE_";2102////"_MDOB
D ^DIE K DIE,DR,DA
Q
;
BMEMED4 ; IHS/PHXAO/TMJ - Add Non Auto Eligibles to Medicaid File ; [ 06/11/03 3:29 PM ]
+1 ;
+2 ;This Routine is used to Manually Compare and Automatically
+3 ;update Patient Registration. The compare of Patients residing
+4 ;in the Temporary Monthly No Match File against RPMS Patient
+5 ;Registration allows the User to Update Medicaid Eligibility
+6 ;File upon comparison.
+7 ;
+8 ;
+9 WRITE @IOF
A ; -- driver
+1 DO LOOK
IF IEN<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="^AZAMED("
SET DIC(0)="AEMQZ"
+2 SET DIC("A")="Please enter MEDICAID ROSTER Patient Name: "
+3 DO ^DIC
SET IEN=+Y
KILL DIC
QUIT
+4 ;
DISP ; -- display all information to the user
+1 WRITE @IOF,!,"Medicaid Eligibility Roster Data",!
+2 KILL DIC
SET DIC="^AZAMED("
SET DA=IEN
DO EN^DIQ
KILL DIC,DA,DR
QUIT
+3 ;
DIQ2 ; -- display all information to the user
+1 WRITE !!,"RPMS patient file entry",!
+2 NEW N
SET N=^DPT(DFN,0)
WRITE !,$PIECE(N,U),?32,$PIECE(N,U,2),?34,$PIECE(N,U,9)
+3 ;W ?46,"HRCN: ",$$HRCN^ADGF S Y=$P(N,U,3) X ^DD("DD") W !,"DOB: ",Y
+4 ;IHS/ANMC/LJF 1/21/99 keep calls within namespace
WRITE ?46,"HRCN: ",$$HRCN^AZAMED
SET Y=$PIECE(N,U,3)
XECUTE ^DD("DD")
WRITE !,"DOB: ",Y
+5 SET N=$GET(^DPT(DFN,.11))
WRITE ?20,$PIECE(N,U,4)," ",$$ST
QUIT
+6 ;
ST() ; -- state
+1 QUIT $PIECE($GET(^DIC(5,+$PIECE(N,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 N=^AZAMED(IEN,0)
SET SSN=$PIECE(N,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 EBD=+N
SET EED=$PIECE(N,U,9)
SET CT=$PIECE(N,U,8)
SET NUM=$PIECE(N,U,6)
SET NAME=$PIECE(N,U,2)
+6 ; Medicaid Date of Birth 10/12/02
SET MDOB=$PIECE(N,U,4)
+7 SET SEX=$PIECE(N,U,3)
SET MRATE=$PIECE(N,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,EBD,EED,CT,SSN,IEN,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="ARIZONA MEDICAID"
DO ^DIC
+2 IF Y'=-1
SET INS=$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 IEN=$ORDER(^AUPNMCD("B",DFN,0))
IF 'IEN
QUIT
+2 ;Quit if Both Beg/End Match already
IF $PIECE($GET(^AUPNMCD(IEN,11,EBD,0)),U,2)=EED
QUIT
+3 IF '$DATA(^AUPNMCD(IEN,11,0))
SET $PIECE(^(0),U,2)="9000004.11D"
+4 ;Last Beg Date entered
SET LSTEBD=$PIECE($GET(^AUPNMCD(IEN,11,0)),U,3)
+5 IF LSTEBD=""
Begin DoDot:1
+6 SET $PIECE(^AUPNMCD(IEN,11,0),U,3)=EBD
+7 SET $PIECE(^AUPNMCD(IEN,11,0),U,4)=$PIECE(^(0),U,4)+1
+8 ; Add Beginning DT Only
SET DR=".01///"_EBD_";.03////"_CT
+9 SET DIE="^AUPNMCD("_IEN_",11,"
SET DA(1)=IEN
SET DA=EBD
DO ^DIE
KILL DIE,DR,DA
+10 ;Update Count-Update Master List
IF NEWADD=0
DO UPDATES^AZAMSTR
End DoDot:1
+11 IF LSTEBD'=""
Begin DoDot:1
+12 SET SENDDT=$PIECE($GET(^AUPNMCD(IEN,11,LSTEBD,0)),U,2)
+13 ; Add Beg DT Only
IF SENDDT'=""
SET DR=".01///"_EBD_";03////"_CT
+14 IF SENDDT'=""
SET DIE="^AUPNMCD("_IEN_",11,"
SET DA(1)=IEN
SET DA=EBD
DO ^DIE
KILL DIE,DR,DA
IF NEWADD=0
DO UPDATES^AZAMSTR
QUIT
+15 ;Existing Patient fell through-Still Active Only/no Update
DO STILLACT^AZAMSTR
End DoDot:1
+16 QUIT
+17 ;
NEW ; -- create new entry in medicaid eligible
+1 ;Set Variable for New Record Add
SET NEWADD=0
+2 ;Quit if already in Medicaid Eligibility File
IF $ORDER(^AUPNMCD("B",+DFN,0))
QUIT
+3 NEW X,Y
SET X=DFN
SET DIC="^AUPNMCD("
SET DIC(0)="L"
+4 SET DIC("DR")=".02////"_INS_";.03////"_NUM_";.04////3;2101////"_NAME
+5 SET DIC("DR")=DIC("DR")_";.07////"_SEX_";.08////"_DT_";.12////"_MRATE_";2102////"_MDOB
+6 ;
+7 KILL DD,DO
+8 DO FILE^DICN
SET IEN=+Y
KILL DIC
+9 DO NEW^AZAMSTR
+10 SET NEWADD=1
+11 QUIT
+12 ;
UP0 ; -- update 0th node - Patient Demographics Only
+1 SET IEN=$ORDER(^AUPNMCD("B",DFN,0))
IF 'IEN
QUIT
+2 IF '$PIECE(^AUPNMCD(IEN,0),U,2)
SET $PIECE(^AUPNMCD(IEN,0),U,2)=INS
+3 IF '$PIECE(^AUPNMCD(IEN,0),U,3)
SET $PIECE(^AUPNMCD(IEN,0),U,3)=NUM
+4 IF '$PIECE(^AUPNMCD(IEN,0),U,4)
SET $PIECE(^AUPNMCD(IEN,0),U,4)=3
+5 SET DIE="^AUPNMCD("
SET DA=IEN
SET DR="2101////"_NAME_";.08////"_DT_";.12////"_MRATE_";2102////"_MDOB
+6 DO ^DIE
KILL DIE,DR,DA
+7 QUIT
+8 ;
