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

AZAMED4.m

Go to the documentation of this file. 
  1. BMEMED4 ; IHS/PHXAO/TMJ - Add Non Auto Eligibles to Medicaid File ; [ 06/11/03  3:29 PM ]
  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 IEN<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="^AZAMED(",DIC(0)="AEMQZ"
  1.  S DIC("A")="Please enter MEDICAID ROSTER Patient Name: "
  1.  D ^DIC S IEN=+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="^AZAMED(",DA=IEN 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 N S N=^DPT(DFN,0) W !,$P(N,U),?32,$P(N,U,2),?34,$P(N,U,9)
  1.  ;W ?46,"HRCN: ",$$HRCN^ADGF S Y=$P(N,U,3) X ^DD("DD") W !,"DOB: ",Y
  1.  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
  1.  S N=$G(^DPT(DFN,.11)) W ?20,$P(N,U,4),"  ",$$ST Q
  1.  ;
  1. ST() ; -- state
  1.  Q $P($G(^DIC(5,+$P(N,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 N=^AZAMED(IEN,0),SSN=$P(N,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 EBD=+N,EED=$P(N,U,9),CT=$P(N,U,8),NUM=$P(N,U,6),NAME=$P(N,U,2)
  1.  S MDOB=$P(N,U,4) ; Medicaid Date of Birth 10/12/02
  1.  S SEX=$P(N,U,3),MRATE=$P(N,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,EBD,EED,CT,SSN,IEN,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="ARIZONA MEDICAID" D ^DIC
  1.  I Y'=-1 S INS=$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 IEN=$O(^AUPNMCD("B",DFN,0)) Q:'IEN
  1.  Q:$P($G(^AUPNMCD(IEN,11,EBD,0)),U,2)=EED  ;Quit if Both Beg/End Match already
  1.  S:'$D(^AUPNMCD(IEN,11,0)) $P(^(0),U,2)="9000004.11D"
  1.  S LSTEBD=$P($G(^AUPNMCD(IEN,11,0)),U,3) ;Last Beg Date entered
  1.  I LSTEBD="" D
  1.  . S $P(^AUPNMCD(IEN,11,0),U,3)=EBD 
  1.  . S $P(^AUPNMCD(IEN,11,0),U,4)=$P(^(0),U,4)+1
  1.  . S DR=".01///"_EBD_";.03////"_CT ; Add Beginning DT Only
  1.  . S DIE="^AUPNMCD("_IEN_",11,",DA(1)=IEN,DA=EBD D ^DIE K DIE,DR,DA
  1.  . I NEWADD=0 D UPDATES^AZAMSTR ;Update Count-Update Master List
  1.  I LSTEBD'="" D
  1.  . S SENDDT=$P($G(^AUPNMCD(IEN,11,LSTEBD,0)),U,2)
  1.  . I SENDDT'="" S DR=".01///"_EBD_";03////"_CT ; Add Beg DT Only
  1.  . 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
  1.  . D STILLACT^AZAMSTR ;Existing Patient fell through-Still Active Only/no Update
  1.  Q
  1.  ;
  1. NEW ; -- create new entry in medicaid eligible
  1.  S NEWADD=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////"_INS_";.03////"_NUM_";.04////3;2101////"_NAME
  1.  S DIC("DR")=DIC("DR")_";.07////"_SEX_";.08////"_DT_";.12////"_MRATE_";2102////"_MDOB
  1.  ;
  1.  K DD,DO
  1.  D FILE^DICN S IEN=+Y K DIC
  1.  D NEW^AZAMSTR
  1.  S NEWADD=1
  1.  Q
  1.  ;
  1. UP0 ; -- update 0th node - Patient Demographics Only
  1.  S IEN=$O(^AUPNMCD("B",DFN,0)) Q:'IEN
  1.  S:'$P(^AUPNMCD(IEN,0),U,2) $P(^AUPNMCD(IEN,0),U,2)=INS
  1.  S:'$P(^AUPNMCD(IEN,0),U,3) $P(^AUPNMCD(IEN,0),U,3)=NUM
  1.  S:'$P(^AUPNMCD(IEN,0),U,4) $P(^AUPNMCD(IEN,0),U,4)=3
  1.  S DIE="^AUPNMCD(",DA=IEN,DR="2101////"_NAME_";.08////"_DT_";.12////"_MRATE_";2102////"_MDOB
  1.  D ^DIE K DIE,DR,DA
  1.  Q
  1.  ;