Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BMEMED4

BMEMED4.m

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