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

EASUM6.m

Go to the documentation of this file. 
  1. EASUM6 ;ALB/BDB,MNH - IVM MEANS/COPAY TEST UPLOAD DRIVER ;7/6/04 1:23pm
  1.  ;;1.0;ENROLLMENT APPLICATION SYSTEM;**111,113**;21-OCT-94;Build 53
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;Cloned from EASUM1
  1.  ;
  1. EN ; this routine will call routines to upload means tests sent by the IVM
  1.  ; Center in HL7 segments. the required sequence of these segments were
  1.  ; validated in the calling routine IVMPREC7. this routine will call
  1.  ; IVMUCHK to ensure that the data is consistent with DHCP means test
  1.  ; file and software requirements.
  1.  ;
  1.  ; entries will be added/modified in the following means test and
  1.  ; patient files:
  1.  ;
  1.  ; PATIENT RELATION (#408.12)
  1.  ; INCOME PERSON (#408.13)
  1.  ; INDIVIDUAL ANNUAL INCOME (#408.21)
  1.  ; INCOME RELATION (#408.22)
  1.  ; ANNUAL MEANS TEST (#408.31)
  1.  ; MEANS TEST CHANGES (#408.41)
  1.  ; PATIENT (#2)
  1.  ;
  1.  ; current year is date of means test.
  1.  ; income year is calendar year before date of means test.
  1.  ; meant test status is based on income year data.
  1.  ;
  1.  ; IVMDAP is pointer to the PID HL7 segment in file #772
  1.  ; IVMDAZ is pointer to the ZMT segment
  1.  ;
  1.  S:'$D(DUZ) DUZ=.5 ; if no DUZ set to postmaster
  1.  ;
  1.  ; get copay exemption status (IVMCEB) and means test status (IVMMTB)
  1.  ; before upload
  1.  S IVMCEB=$P($$RXST^IBARXEU(DFN),"^",2)
  1.  S IVMMTB=$P($$LST^DGMTU(DFN),"^",3)
  1.  ;
  1.  ; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center
  1.  ; or created by upload.
  1.  ;K IVMAR
  1.  ;S IVMX=$$EN^IVMUCHK() I IVMX]"" S HLERR=IVMX K IVMX Q ; error found in MT data
  1.  ;
  1. ADD ; add new annual means test file (408.31) stub
  1.  ; input DGMTDT (.01) dt of test
  1.  ; DFN (.02) Patient IEN
  1.  ; DGMTYPT (.19) type of test (1-means test, 2-Rx Copay test)
  1.  ; output DGMTI annual means test IEN
  1.  S DGMTDT=IVMMTDT
  1.  D ADD^DGMTA
  1.  I $G(IVMMTIEN)="" S IVMMTIEN=$G(DGMTI) ;Set IEN if only MT on file is Z06 MT
  1.  ;
  1.  ;Create new Z06 IVM Means Test
  1.  ; Make STUB MT primary, add comment that it was created by Edb
  1.  S DGCOM="Z06 MT via Edb"
  1.  D PARSEZMT^EASPREC6(ZMTSEG) ;Parse ZMT Segment for MT Data
  1.  I $$EXPIRED^EASPTRN1(DFN,$G(IVM2)) S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS"    ;If MT expired then do not update Enrollment record
  1.  S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS" ;EAS*1.0*111 Do not update Enrollment record.
  1.  S DA=DGMTI,DIE="^DGMT(408.31,"
  1.  S DR=".03////^S X=IVM3;.12////^S X=IVM8;.07////^S X=IVM10;.09////^S X=IVM25;.11////^S X=IVM7;.18////^S X=IVM12;"
  1.  S DR=DR_".23////^S X=IVM18;.25////^S X=IVM20;2////1;2.02////^S X=IVMDATE;2.03////^S X=IVM26;2////1;4////^S X=IVM32;50///^S X=DGCOM;" ;BT Financial Indicator EAS*1*113
  1.  ;
  1.  ; Linking logic for MT & CT, conditionally set link field 2.06 
  1.  ; Link the CT to MT (if MT found), or MT to CT (if CT found)
  1.  ; don't link tests older than Oct. 1999 or not same Year
  1.  N LNKDAT,LNKMT,LNKDTE,LNKCAT,CURIEN
  1.  S CURIEN=DGMTI,LNKMT=""
  1.  S LNKDAT=$$LST^DGMTU(DFN,DGMTDT,$S(DGMTYPT=1:2,1:1)),DGMTI=CURIEN
  1.  S:LNKDAT LNKMT=+LNKDAT,LNKDTE=$P(LNKDAT,"^",2),LNKCAT=$P(LNKDAT,"^",4)
  1.  ; set LNKMT off if either of two scenarios below
  1.  I LNKMT D
  1.  . I $E(LNKDTE,1,3)'=$E(DGMTDT,1,3) S LNKMT="@" Q
  1.  . I DGMTDT<2991001 S LNKMT="" Q
  1.  S:LNKMT'="" DR=DR_";2.06////^S X=LNKMT"
  1.  ;
  1.  D ^DIE K DA,DIE,DR                            ;update new 408.31 test
  1.  ;
  1.  ; Update other 408.31 related Test, Link field, if link scenario true
  1.  I LNKMT S DA=LNKMT,DIE="^DGMT(408.31,",DR="2.06////^S X=CURIEN" D ^DIE K DA,DIE,DR
  1.  ;
  1.  ;Variables needed for Bulletins
  1.  ;
  1.  S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1)
  1.  I '$D(IVM5) S IVM5=""
  1.  ;
  1.  D GETREL^DGMTU11(DFN,"V",DGLY,IVMMTIEN)
  1.  I EASZ06 S (IVMMT31,DGMTP)=$G(^DGMT(408.31,IVMMTIEN,0)) ;dgmtp is event driver variable
  1.  D COMPLETE
  1.  Q
  1.  ;
  1.  ; add dependent(s) to income person file (408.13)
  1.  ;
  1.  ; add spouse if not in 408.13
  1.  S IVMSPCHV="S" ; spouse/child/vet indicator
  1.  S IVMDA1=IVMDAP+3 D GET ; spouse ZDP segment
  1.  D INPIEN^IVMUM2
  1.  Q:$D(IVMFERR)
  1.  ;
  1.  I IVMFLG5 G ADDCHILD ; entry not added - goto add children
  1.  ;
  1.  ; add entry to patient relation file (408.12)
  1.  D EN^IVMUM3
  1.  ;
  1.  Q:$D(IVMFERR)
  1.  ;
  1. ADDS21 ; add spouse entry to individual annual income file (408.21)
  1.  S IVMDA1=IVMDAP+4 D GET ; spouse ZIC segment
  1.  D EN^IVMUM4
  1.  Q:$D(IVMFERR)
  1.  ;
  1.  ; add spouse entry to income relation file (408.22)
  1.  S IVMDA1=IVMDAP+5 D GET ; spouse ZIR segment
  1.  ;D EN^IVMUM5
  1.  D EN^EASUM5  ;EAS*1*113
  1.  Q:$D(IVMFERR)
  1.  ;
  1. ADDCHILD ; add children if not in 408.13
  1.  S IVMSPCHV="C" ; spouse/child/vet indicator
  1.  I 'IVMFLGC G ADDV21 ; no dependent children 
  1.  S IVMCTR2=5
  1.  F IVMCTR3=1:1:IVMFLGC D  Q:$D(IVMFERR)
  1.  .S IVMCTR2=IVMCTR2+1
  1.  .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZDP segment
  1.  .D INPIEN^IVMUM2
  1.  .Q:$D(IVMFERR)
  1.  .;
  1.  .; add child entry to patient relation file (408.12)
  1.  .D EN^IVMUM3
  1.  .Q:$D(IVMFERR)
  1.  .;
  1. ADDC21 .; add child entry to individual annual income file (408.21)
  1.  .S IVMCTR2=IVMCTR2+1
  1.  .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIC segment
  1.  .D EN^IVMUM4
  1.  .Q:$D(IVMFERR)
  1.  .;
  1.  .; add entry to income relation file (408.22)
  1.  .S IVMCTR2=IVMCTR2+1
  1.  .S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIR segment
  1.  .;D EN^IVMUM5
  1.  .D EN^EASUM5   ;EAS*1*113
  1.  .Q:$D(IVMFERR)
  1.  .Q
  1.  Q:$D(IVMFERR)
  1.  ;
  1. ADDV21 ; add vet entry to individual annual income file (408.21)
  1.  ; get vet patient relation ien
  1.  S DGPRI=+$G(DGREL("V"))
  1.  S IVMDA1=IVMDAP+1 D GET ; vet ZIC segment
  1.  S IVMSPCHV="V" ; spouse/child/vet indicator
  1.  D EN^IVMUM4
  1.  Q:$D(IVMFERR)
  1.  S DGVINI=DGINI ; vet individual annual income ien
  1.  ;
  1.  ; add vet entry to income relation file (408.22)
  1.  S IVMDA1=IVMDAP+2 D GET ; vet ZIR segment
  1.  ;D EN^IVMUM5
  1.  D EN^EASUM5  ;EAS*1*113
  1.  Q:$D(IVMFERR)
  1.  S DGVIRI=DGIRI ; vet income relation ien
  1.  ;
  1. COMPLETE ; complete means test
  1.  ;
  1.  ;D EN^IVMUM6
  1.  ;Call Means Test Event Driver to complete processing
  1.  ;
  1.  S DGMTACT="UPL"
  1.  D AFTER^DGMTEVT
  1.  S DGMTINF=1 ;Non-Interactive Flag
  1.  D EN^DGMTEVT
  1.  D MTBULL^EASUM7,MAIL^IVMUFNC() ;Build Mail Message
  1.  ;
  1.  ; cleanup ;EAS*1*42 remove Dgmtypt
  1.  K DGINI,DGIRI,DGLY,DGMTDT,DGPRI,DGREL,DGVINI,DGVIRI,DGENUPLD
  1.  K DGCAT,IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
  1.  K IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMPRN
  1.  K IVMRELN,IVMRELO,IVMSEG,IVMSPCHV,IVMX
  1.  Q
  1.  ; 
  1. GET ; get HL7 segment from ^HL
  1.  S IVMSEG=$P($G(^TMP($J,IVMRTN,IVMDA1,0)),"^",2,999)
  1.  Q