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

AGELUP4.m

Go to the documentation of this file. 
  1. AGELUP4 ;IHS/SET/GTH - UPDATE ELIGIBILITY FROM FILE  
  1.  ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
  1.  ;
  1. D(AG) ;EP - process Medicaid
  1.  ;See update matrix, in FILE subroutine.
  1.  KILL AG1,AG2,AGSAME
  1.  ;Check for -exact- match, -or- all Elig dates.
  1.  I $D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) D  Q:$G(AGSAME)
  1.  . S AG("MNBR")=""
  1.  . F  S AG("MNBR")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"))) Q:'$L(AG("MNBR"))  D  Q:$G(AGSAME)
  1.  .. S AG("IEN")=0
  1.  .. F  S AG("IEN")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"),AG("IEN"))) Q:'AG("IEN")  D MCDY I AGSAME S AGACT="S" Q
  1.  ..Q
  1.  .Q
  1.  ;Find most recent entry that matches demographic data (no dates).
  1.  ;If found AG("IEN") will be it.
  1.  I $D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) D
  1.  . S AG("MNBR")=""
  1.  . F  S AG("MNBR")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR")),-1) Q:'$L(AG("MNBR"))  D  Q:$G(AGSAME)
  1.  .. S AG("IEN")=""
  1.  .. F  S AG("IEN")=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,AG("MNBR"),AG("IEN")),-1) Q:'AG("IEN")  D  Q:$G(AGSAME)
  1.  ... ;MediCaid name.
  1.  ... Q:'(AG("FNM")=$P($G(^AUPNMCD(AG("IEN"),21)),U,1))
  1.  ... ;MediCaid DOB.
  1.  ... Q:'(AG("FDOB")=$P($G(^AUPNMCD(AG("IEN"),21)),U,2))
  1.  ... ;MediCaid Number.
  1.  ... I '(AG("FNBR")=$P(^AUPNMCD(AG("IEN"),0),U,3)),'((+AG("FNBR"))=(+$P(^AUPNMCD(AG("IEN"),0),U,3))) Q
  1.  ... S AGSAME=1
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;If demographic data does not match, but Pt has MCD entry,
  1.  ;get highest IEN.
  1.  I '$G(AG("IEN")),$D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) NEW I D  I I S AG("IEN")=I
  1.  . NEW N,T
  1.  . S N="",I=0
  1.  . F  S N=$O(^AUPNMCD("AB",AG("DFN"),AGMCDST,N)) Q:'$L(N)  S T=$O(^(N,0)) I T>I S I=T
  1.  .Q
  1.  I $G(AG("IEN")) D MCDY ;Make sure Dif flags are set.
  1.  I AGAUTO'="A" D  Q
  1.  . D HEAD^AGELUPUT("MEDICAID")
  1.  . I '$D(^AUPNMCD("AB",AG("DFN"),AGMCDST)) D MCDN
  1.  . D MDISP^AGELUP2(5),PEND^AGELUPUT
  1.  .Q
  1.  U IO(0)
  1.  W "."
  1.  W:'(AGRCNT#100) $J(AGRCNT,8)
  1.  Q
  1. MCDY ;if medicaid coverage
  1.  S AGSAME=0
  1.  ;MediCaid name.
  1.  S (AGMNM,AG1(1))=$P($G(^AUPNMCD(AG("IEN"),21)),U)
  1.  ;MediCaid DOB.
  1.  S AGMDOB=$P($G(^AUPNMCD(AG("IEN"),21)),U,2)
  1.  S AG1(2)=AGMDOB
  1.  ;MediCaid Number.
  1.  S (AGMNBR,AG1(3))=$P(^AUPNMCD(AG("IEN"),0),U,3)
  1.  S AG1(4)=""
  1.  ;AG1("DT",EligDt,CovType)=EligDt^ELigEndDt^CovType
  1.  S DA=0
  1.  F  S DA=$O(^AUPNMCD(AG("IEN"),11,DA)) Q:'DA  S %=^(DA,0) S:$P(%,U,3)="" $P(%,U,3)=" " S AG1("DT",$P(%,U,1),$P(%,U,3))=%
  1.  KILL AGFL
  1.  D DFL
  1.  S:'$D(AGFL) AGSAME=1
  1.  Q
  1. MCDN ;EP - No MCD coverage in rpms.
  1.  S AG1(1)="NO ELIGIBILITY ON FILE"
  1.  F I=2:1:4 S AG1(I)=""
  1.  D DFL
  1.  Q
  1. DFL ;EP - Set descrepency flags.
  1.  KILL AGFL
  1.  ;M/M Name.
  1.  S AG2(1)=$G(AG("FNM"))
  1.  S:AG2(1)'=$G(AGMNM) AGFL(1)=1
  1.  ;DOB.
  1.  S AG2(2)=$G(AG("FDOB"))
  1.  S:AG2(2)'=$G(AGMDOB) AGFL(2)=1
  1.  ;Number. Check for leading 0's.
  1.  S AG2(3)=$G(AG("FNBR"))
  1.  I '(AG2(3)=$G(AGMNBR)),'((+AG2(3))=(+$G(AGMNBR))) S AGFL(3)=1
  1.  S AG2(4)="" ;Prevent UNDEF.
  1.  ;Compare file eligibilities with existing eligibilities.
  1.  ;AG1("DT",EligDt,CovType)=EligDt^ELigEndDt^CovType
  1.  ;Make the comparison based on the update matrix in FILE(), below.
  1.  ;AG("DT",,) contains the State data.
  1.  NEW I,J
  1.  S I=0
  1.  F  S I=$O(AG("DT",I)) Q:'I  D
  1.  . S J=0
  1.  . F  S J=$O(AG("DT",I,J)) Q:J=""  D
  1.  .. I '$G(AG1("DT",I,J)) S AGFL(5)=1 Q
  1.  .. I AG1("DT",I,J)=AG("DT",I,J) Q
  1.  .. I $P(AG("DT",I,J),U,2)="" Q  ;State EndDate is blank.
  1.  .. I $P(AG1("DT",I,J),U,2)>$P(AG("DT",I,J),U,2) Q
  1.  .. S AGFL(5)=1
  1.  ..Q
  1.  .Q
  1.  ;AG1("DT",,) contains RPMS data.
  1.  S I=0
  1.  F  S I=$O(AG1("DT",I)) Q:'I  D
  1.  . S J=0
  1.  . F  S J=$O(AG1("DT",I,J)) Q:J=""  D
  1.  .. Q:'$D(AG("DT",I,U))  ;Exists in RPMS but not in STATE.
  1.  .. I $P(AG("DT",I,J),U,2)="" Q  ;State EndDate is blank.
  1.  .. I $P(AG1("DT",I,J),U,2)>$P(AG("DT",I,J),U,2) Q
  1.  .. S AGFL(5)=1
  1.  ..Q
  1.  .Q
  1.  Q
  1. FILE(AG) ;EP - File Medicaid
  1.  NEW AGADD,AGUPDATE
  1.  I '$G(AG("IEN")) D  Q:+Y<0  S AGADD=1 I 1
  1.  . NEW DIC,DLAYGO,DD,DO
  1.  . I '("MF"[AG("FSEX")) S AG("FSEX")=""
  1.  . S DIC="^AUPNMCD(",DIC(0)="F",DLAYGO=9000004,X=AG("DFN")
  1.  . S DIC("DR")=".02////"_AGINSPT_";.03///"_AG("FNBR")_";.04////"_AGMCDST_$S($L(AG("FSEX")):";.07///"_AG("FSEX"),1:"")_";.08////"_DT_";2101///"_AG("FNM")_";2102///"_AG("FDOB")
  1.  . D FILE^DICN
  1.  . I +Y>0 S AG("IEN")=+Y D PTACT^AGELUP2(1,AG("DFN"))
  1.  .Q
  1.  E  D  S AGADD=0
  1.  . NEW DA,DIE,DR
  1.  . S DIE="^AUPNMCD(",DA=AG("IEN"),DR=""
  1.  . I $P(^AUPNMCD(DA,0),U,2)'=AGINSPT S DR=".02////"_AGINSPT
  1.  . I AG("FNBR")'="",AG("FNBR")'=$P(^AUPNMCD(DA,0),U,3) S DR=DR_$S($L(DR):";",1:"")_".03///"_AG("FNBR")
  1.  . I AG("FSEX")'="",AG("FSEX")'=$P(^AUPNMCD(DA,0),U,7) S DR=DR_$S($L(DR):";",1:"")_".07///"_AG("FSEX")
  1.  . I AG("FNM")'="",AG("FNM")'=$P($G(^AUPNMCD(DA,21)),U) S DR=DR_$S($L(DR):";",1:"")_"2101///"_AG("FNM")
  1.  . I AG("FDOB")'="",AG("FDOB")'=$P($G(^AUPNMCD(DA,21)),U,2) S DR=DR_$S($L(DR):";",1:"")_"2102////"_AG("FDOB")
  1.  . I $L(DR) NEW DITC S DITC="",DR=DR_";.08////"_DT D ^DIE,PTACT^AGELUP2(2,AG("DFN")):'$D(Y) KILL DITC
  1.  .Q
  1.  ;Here's the matrix what to do with EndDate when StartDate/CovType
  1.  ;agree, but EndDate does not:
  1.  ;
  1.  ;     RPMS             State           Action
  1.  ;     -------------    -------------   ------
  1.  ;(1)  Value            Blank           None
  1.  ;(2)  Blank            Value           Update
  1.  ;(3)  Earlier          Later           Update
  1.  ;(4)  Later            Earlier         None
  1.  ;
  1.  ;Case (3) is when the RPMS EndDate is earlier than the State EndDate.
  1.  ;EndDate will be updated to the later State EndDate.  If the actual DOS
  1.  ;falls between the EndDates, we'd miss the claim.  This is somewhat
  1.  ;inconsistent with (1).
  1.  ;
  1.  ;Case (4) is when the RPMS EndDate is later than the State EndDate.
  1.  ;This is the conservative approach to process the claim, if the actual
  1.  ;DOS is between the EndDates, with the assumption (hope) that the
  1.  ;State's data is....lagging, or wrong, or something.
  1.  ;
  1.  S AGBD=0
  1.  F  S AGBD=$O(AG("DT",AGBD)) Q:'AGBD  D  I AGADD S AGUPDATE=0
  1.  . S AGCT=0
  1.  . F  S AGCT=$O(AG("DT",AGBD,AGCT)) Q:AGCT=""  D
  1.  .. I '$G(AG1("DT",AGBD,AGCT)) D ADD(AGBD,$P(AG("DT",AGBD,AGCT),U,2),AGCT) Q
  1.  .. ;Update EndDate if State has value, RPMS is blank.
  1.  .. I $P(AG("DT",AGBD,AGCT),U,2),'$P(AG1("DT",AGBD,AGCT),U,2) D EDIT(AG("DT",AGBD,AGCT)) Q
  1.  .. ;Update EndDate if State is LATER than RPMS.
  1.  .. I $P(AG("DT",AGBD,AGCT),U,2),$P(AG1("DT",AGBD,AGCT),U,2),$P(AG("DT",AGBD,AGCT),U,2)>$P(AG1("DT",AGBD,AGCT),U,2) D EDIT(AG("DT",AGBD,AGCT))
  1.  ..Q
  1.  .Q
  1.  KILL AGBD,AGCT
  1.  I $G(AGUPDATE) D PTACT^AGELUP2(2,AG("DFN"))
  1.  D UPDATE(AG("DFN"),AG("IEN"))
  1.  Q
  1. UPDATE(DFN,AGIEN)      ;
  1.  NEW AG
  1.  S AG("MCD")=AGIEN
  1.  D UPDATE^AGED5
  1.  Q
  1. ADD(X,AG2,AG3) ;
  1.  NEW DA,DIC,DR
  1.  S DA(1)=AG("IEN"),DIC="^AUPNMCD("_DA(1)_",11,",DIC(0)="F",DIC("P")=$P(^DD(9000004,1101,0),U,2)
  1.  KILL DD,DO
  1.  S DIC("DR")=$S(AG2:".02///"_AG2_";",1:"")_".03///"_AG3
  1.  D FILE^DICN
  1.  I +Y>0 S AGUPDATE=1
  1.  Q
  1. EDIT(AGDATES)  ;
  1.  NEW DA,DIE,DR
  1.  S DA=0
  1.  F  S DA=$O(^AUPNMCD(AG("IEN"),11,DA)) Q:'DA  I $P(AGDATES,U,1)=$P(^(DA,0),U,1),$P(AGDATES,U,3)=$P(^(0),U,3) Q
  1.  Q:'DA  ;Something wrong happended, somewhere.
  1.  S DA(1)=AG("IEN"),DIE="^AUPNMCD("_DA(1)_",11,",DR=".02///"_$P(AGDATES,U,2)
  1.  D ^DIE
  1.  S AGUPDATE=1
  1.  Q