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

IVMUFNC5.m

Go to the documentation of this file. 
  1. IVMUFNC5 ;ALB/AEG,HM - IVM UTILITIES CONTINUED ;8/10/05 1:39pm
  1.  ;;2.0;INCOME VERIFICATION MATCH;**55,109,149,183**;5-10-2002;Build 30
  1.  ;
  1. AGE(DT) ;
  1.  N Y
  1.  S Y=$E(DT,1,3)-1_"0000",Y=Y-10000
  1.  Q Y
  1.  ;
  1. INCY(IVMMTDT) ;
  1.  N Y
  1.  S Y=$E(IVMMTDT,1,3)_"0000",Y=Y-10000
  1.  Q Y
  1.  ;
  1. CATC(DATA) ;
  1.  ; Extrinsic function to determine is incoming ZMT1 segment meets 
  1.  ; one of the following groups:
  1.  ;     1.  Cat C or Pending Adj. / Provided income info / test date
  1.  ;         is 10/6/99 or later and Agreed to Pay is YES.
  1.  ;     OR
  1.  ;
  1.  ;     2.  Category C based upon declination to provide income info
  1.  ;         but agreed to pay deductible.
  1.  ;
  1.  ;
  1.  ; Input(s):  $G(^TMP($J,"IVMCM","ZMT1")) global node - Incoming ZMT
  1.  ;            segment.
  1.  ;
  1.  ; Output(s):  Function Value. 1 = Yes patient meets one of the criteria
  1.  ;                             0 = NO test does not meet criteria.
  1.  ;                            99 = initialize value and default criteria outside of criteria being checked.
  1.  N MTDAT,RETV
  1.  S RETV=99
  1.  Q:'$D(DATA) 0
  1.  S MTDAT("DT")=$$FMDATE^HLFNC($P($G(DATA),U,2)),MTDAT("MTS")=$P($G(DATA),U,3)
  1.  S MTDAT("APD")=$P($G(DATA),U,7),MTDAT("DCLI")=$P($G(DATA),U,16)
  1.  ; Patient Provided income information.
  1.  I '+$G(MTDAT("DCLI")) D
  1.  .; If Cat C or Pending Adjudication test date on or after 10/6/99
  1.  .; Provided Income info and Agreed to Pay.
  1.  .;
  1.  .I $G(MTDAT("MTS"))="C",$G(MTDAT("DT"))'<2991006,$G(MTDAT("APD"))=1 S RETV=1 Q
  1.  .I $G(MTDAT("MTS"))="P",$G(MTDAT("DT"))'<2991006,$G(MTDAT("APD"))=1 S RETV=1 Q
  1.  .;check CATC status MT for date less than 10/6/1999 and set the RETV  = 0 for error IVM*2.0*183
  1.  .I $G(MTDAT("MTS"))="C",$G(MTDAT("DT"))<2991006,$G(MTDAT("APD"))=1 S RETV=0 Q  ;IVM*2.0*183 HM
  1.  .;Pending Adjudication status MT and if date less than 10/6/1999 and set RETV = 0 for error IVM*2.0*183
  1.  .I $G(MTDAT("MTS"))="P",$G(MTDAT("DT"))<2991006,$G(MTDAT("APD"))=1 S RETV=0 Q  ;IVM*2.0*183 HM
  1.  ; Patient Declined to provide income information.
  1.  I +$G(MTDAT("DCLI")) D
  1.  .; Cat C and Agreed to Pay - No date restriction
  1.  .I $G(MTDAT("MTS"))="C",+$G(MTDAT("APD")) S RETV=1 Q
  1.  ;
  1.  Q RETV
  1.  ;
  1. ACCMT(DATA) ;
  1.  ; Added for IVM*2.0*183 HM
  1.  ; Extrinsic function to determine is incoming ZMT1 segment meets 
  1.  ; one of the following groups:
  1.  ;     1.  Based upon patient's income information, these patients are 
  1.  ;         subject to MT and their status is MT Copay Exempt.  ;IVM*2.0*183 HM
  1.  ;
  1.  ;     OR
  1.  ;
  1.  ;     2.  Patient is Geographic Means Test (GMT) based upon patients who provide
  1.  ;         income information and agreement to pay the deductible(s).  The patient 
  1.  ;         Means Test status is GMT Copay Required.  ;IVM*2.0*183 HM
  1.  ;
  1.  ; Input(s):  $G(^TMP($J,"IVMCM","ZMT1")) global node - Incoming ZMT
  1.  ;            segment.
  1.  ;
  1.  ; Output(s):  Function Value. 1 = Yes patient meets one of the criteria
  1.  ;                             0 = NO test does not meet criteria.
  1.  ;                            99 = initialize value and default criteria outside of criteria being checked.
  1.  ;
  1.  ;Controlled Subscription ICR #7088; Supports use of OLDMTPF^DGMTU4(TESTDATE)
  1.  ;Checks if the date is more than 1 year old of the VFA Start Date
  1.  ;
  1.  N MTDAT,RETV,IVML
  1.  S RETV=99
  1.  Q:'$D(DATA) 0
  1.  S MTDAT("APD")=$P($G(DATA),U,7) ;agree to pay deductible information
  1.  S MTDAT("DT")=$$FMDATE^HLFNC($P($G(DATA),U,2)),MTDAT("MTS")=$P($G(DATA),U,3)
  1.  ;check for MT Copay Exempt status and MT less than 1 year old as of "VFA Start Date"
  1.  I MTDAT("MTS")="A",'$$OLDMTPF^DGMTU4(MTDAT("DT")) S RETV=1 ;Logic for #1 comment above
  1.  I MTDAT("MTS")="A",+$$OLDMTPF^DGMTU4(MTDAT("DT")) S RETV=0
  1.  ;check for GMT Copay Required status and agreed to pay and MT less than 1 year old as of "VFA Start Date" and does require patient income
  1.  I MTDAT("MTS")="G",'$$OLDMTPF^DGMTU4(MTDAT("DT")),$G(MTDAT("APD"))=1 S RETV=1 ;Logic for #2 comment above
  1.  I MTDAT("MTS")="G",+$$OLDMTPF^DGMTU4(MTDAT("DT")),$G(MTDAT("APD"))=1 S RETV=0
  1.  ;
  1.  Q RETV
  1.  ;
  1. ELIG(DFN) ; Eligibility Check for Cat C uploads older than previous
  1.  ;         income year data.
  1.  ;
  1.  ; Input: DFN - Patient IEN
  1.  ; Output: Function Value 0 if Z10 upload not appropriate
  1.  ;
  1.  N IVMELI
  1.  S IVMELI=0
  1.  ; Check primary eligibility
  1.  I $D(^DPT(DFN,.36)) S X=^(.36) D
  1.  .; If NSC or SC < 50 0% appropriate to upload old test.
  1.  .I $P($G(^DIC(8,+X,0)),U,9)=5!($$SC(DFN)) S IVMELI=1
  1.  .I $P(X,U,12)=1 S IVMELI=0
  1.  .I $P(X,U,13)=1 S IVMELI=0
  1.  .K X
  1.  ; If deceased patient --- don't upload.
  1.  I +$$GET1^DIQ(2,DFN_",",.351,"I") S IVMELI=0
  1.  ; If eligible for medicaid, don't upload.
  1.  I +$$GET1^DIQ(2,DFN_",",.381,"I") S IVMELI=0
  1.  ; Check PH status.
  1.  I $P($G(^DPT(DFN,.53)),U)="Y" S IVMELI=0
  1.  ; Catastrophically disabled
  1.  I $P($G(^DPT(DFN,.39)),U,6)="Y" S IVMELI=0 ;IVM*2.0*149
  1.  ; Medal of Honor, don't upload
  1.  I $P($G(^DPT(DFN,.54)),U)="Y" S IVMELI=0 ;IVM*2.0*183 HM
  1.  Q IVMELI
  1.  ;
  1. SC(DFN) ; Check to see if patient is SC 0% non-compensable.
  1.  ; Input -- DFN Patient IEN
  1.  ; Output -- Function value 1=Yes or 0=No
  1.  ;
  1.  N IVMG,IVME,IVMF,IVMY
  1.  S IVMY=0
  1.  ; Primary Eligibility is SC < 50 %
  1.  I $D(^DPT(DFN,.36)),$P($G(^DIC(8,+X,0)),U,9)=3 S IVMY=1
  1.  G:'IVMY SCQ
  1.  ; Service Connected percentage = 0
  1.  I $P($G(^DPT(DFN,.3)),U,2)'=0 S IVMY=0 G SCQ
  1.  ; No Total annual VA Check amount
  1.  I $P($G(^DPT(DFN,.362)),U,20) S IVMY=0 G SCQ
  1.  ; POW Status indicated.
  1.  I $P($G(^DPT(DFN,.52)),U,5)="Y" S IVMY=0 G SCQ
  1.  ; Purple Heart Indicated.
  1.  I $P($G(^DPT(DFN,.53)),U)="Y" S IVMY=0 G SCQ
  1.  ; Check Secondary Eligibilities.
  1.  F IVMG=2,4,15:1:18 S IVME(IVMG)=""
  1.  S IVMG=0 F  S IVMG=$O(^DPT(DFN,"E","B",IVMG)) Q:'IVMG  D SEL I IVMF,$D(IVME(+IVMF)) S IVMY=0 Q
  1. SCQ Q +$G(IVMY)
  1.  ;
  1. SEL ;
  1.  S IVMF=$G(^DIC(8,+IVMG,0)) I IVMF="" Q
  1.  S IVMF=$P(IVMF,U,9)
  1.  I IVMF=""!('$D(^DIC(8.1,+IVMF,0))) D
  1.  .S IVMF=""
  1.  .Q
  1.  Q