EASUM1 ;ALB/SEK,GN,MNH - IVM MEANS/COPAY TEST UPLOAD DRIVER ;7/6/04 1:23pm
;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,30,35,42,86,113**;21-OCT-94;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
;EAS*1*42 add RX Copay to Z06 Upload/Delete
;
EN ; this routine will call routines to upload means tests sent by the IVM
; Center in HL7 segments. the required sequence of these segments were
; validated in the calling routine IVMPREC7. this routine will call
; IVMUCHK to ensure that the data is consistent with DHCP means test
; file and software requirements.
;
; entries will be added/modified in the following means test and
; patient files:
;
; PATIENT RELATION (#408.12)
; INCOME PERSON (#408.13)
; INDIVIDUAL ANNUAL INCOME (#408.21)
; INCOME RELATION (#408.22)
; ANNUAL MEANS TEST (#408.31)
; MEANS TEST CHANGES (#408.41)
; PATIENT (#2)
;
; current year is date of means test.
; income year is calendar year before date of means test.
; meant test status is based on income year data.
;
; IVMDAP is pointer to the PID HL7 segment in file #772
; IVMDAZ is pointer to the ZMT segment
;
S:'$D(DUZ) DUZ=.5 ; if no DUZ set to postmaster
;
; get copay exemption status (IVMCEB) and means test status (IVMMTB)
; before upload
S IVMCEB=$P($$RXST^IBARXEU(DFN),"^",2)
S IVMMTB=$P($$LST^DGMTU(DFN),"^",3)
;
; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center
; or created by upload.
;K IVMAR
;S IVMX=$$EN^IVMUCHK() I IVMX]"" S HLERR=IVMX K IVMX Q ; error found in MT data
;
ADD ; add new annual means test file (408.31) stub
; input DGMTDT (.01) dt of test
; DFN (.02) Patient IEN
; DGMTYPT (.19) type of test (1-means test, 2-Rx Copay test)
; output DGMTI annual means test IEN
S DGMTDT=IVMMTDT
D ADD^DGMTA
I $G(IVMMTIEN)="" S IVMMTIEN=$G(DGMTI) ;Set IEN if only MT on file is Z06 MT
;
;Create new Z06 IVM Means Test
; Make STUB MT primary, add comment that it was created by Edb
S DGCOM="Z06 MT via Edb"
D PARSEZMT^EASPREC7(ZMTSEG) ;Parse ZMT Segment for MT Data
I $$EXPIRED^EASPTRN1(DFN,$G(IVM2)) S DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS" ;If MT expired then do not update Enrollment record
S DA=DGMTI,DIE="^DGMT(408.31,"
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;.23////^S X=IVM18;.25////^S X=IVM20;2////1;2.02////^S X=IVMDATE;2.03////^S X=IVM26;50///^S X=DGCOM"
;
; Linking logic for MT & CT, conditionally set link field 2.06
; Link the CT to MT (if MT found), or MT to CT (if CT found)
; don't link tests older than Oct. 1999 or not same Year
N LNKDAT,LNKMT,LNKDTE,LNKCAT,CURIEN
S CURIEN=DGMTI,LNKMT=""
S LNKDAT=$$LST^DGMTU(DFN,DGMTDT,$S(DGMTYPT=1:2,1:1)),DGMTI=CURIEN
S:LNKDAT LNKMT=+LNKDAT,LNKDTE=$P(LNKDAT,"^",2),LNKCAT=$P(LNKDAT,"^",4)
; set LNKMT off if either of two scenarios below
I LNKMT D
. I $E(LNKDTE,1,3)'=$E(DGMTDT,1,3) S LNKMT="@" Q
. I DGMTDT<2991001 S LNKMT="" Q
S:LNKMT'="" DR=DR_";2.06////^S X=LNKMT"
;
D ^DIE K DA,DIE,DR ;update new 408.31 test
;
; Update other 408.31 related Test, Link field, if link scenario true
I LNKMT S DA=LNKMT,DIE="^DGMT(408.31,",DR="2.06////^S X=CURIEN" D ^DIE K DA,DIE,DR
;
;Variables needed for Bulletins
;
S DGCAT=$P($G(^DG(408.32,IVM3,0)),"^",1)
I '$D(IVM5) S IVM5=""
;
D GETREL^DGMTU11(DFN,"V",DGLY,IVMMTIEN)
I EASZ06 S (IVMMT31,DGMTP)=$G(^DGMT(408.31,IVMMTIEN,0)) ;dgmtp is event driver variable
D COMPLETE
Q
;
; add dependent(s) to income person file (408.13)
;
; add spouse if not in 408.13
S IVMSPCHV="S" ; spouse/child/vet indicator
S IVMDA1=IVMDAP+3 D GET ; spouse ZDP segment
D INPIEN^IVMUM2
Q:$D(IVMFERR)
;
I IVMFLG5 G ADDCHILD ; entry not added - goto add children
;
; add entry to patient relation file (408.12)
D EN^IVMUM3
Q:$D(IVMFERR)
;
ADDS21 ; add spouse entry to individual annual income file (408.21)
S IVMDA1=IVMDAP+4 D GET ; spouse ZIC segment
D EN^IVMUM4
Q:$D(IVMFERR)
;
; add spouse entry to income relation file (408.22)
S IVMDA1=IVMDAP+5 D GET ; spouse ZIR segment
D EN^EASUM5 ;EAS*1*113
Q:$D(IVMFERR)
;
ADDCHILD ; add children if not in 408.13
S IVMSPCHV="C" ; spouse/child/vet indicator
I 'IVMFLGC G ADDV21 ; no dependent children
S IVMCTR2=5
F IVMCTR3=1:1:IVMFLGC D Q:$D(IVMFERR)
.S IVMCTR2=IVMCTR2+1
.S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZDP segment
.D INPIEN^IVMUM2
.Q:$D(IVMFERR)
.;
.; add child entry to patient relation file (408.12)
.D EN^IVMUM3
.Q:$D(IVMFERR)
.;
ADDC21 .; add child entry to individual annual income file (408.21)
.S IVMCTR2=IVMCTR2+1
.S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIC segment
.D EN^IVMUM4
.Q:$D(IVMFERR)
.;
.; add entry to income relation file (408.22)
.S IVMCTR2=IVMCTR2+1
.S IVMDA1=IVMDAP+IVMCTR2 D GET ; child ZIR segment
.D EN^EASUM5 ;EAS*1*113
.Q:$D(IVMFERR)
.Q
Q:$D(IVMFERR)
;
ADDV21 ; add vet entry to individual annual income file (408.21)
; get vet patient relation ien
S DGPRI=+$G(DGREL("V"))
S IVMDA1=IVMDAP+1 D GET ; vet ZIC segment
S IVMSPCHV="V" ; spouse/child/vet indicator
D EN^IVMUM4
Q:$D(IVMFERR)
S DGVINI=DGINI ; vet individual annual income ien
;
; add vet entry to income relation file (408.22)
S IVMDA1=IVMDAP+2 D GET ; vet ZIR segment
D EN^EASUM5 ;EAS*1*113
Q:$D(IVMFERR)
S DGVIRI=DGIRI ; vet income relation ien
;
COMPLETE ; complete means test
;
;D EN^IVMUM6
;Call Means Test Event Driver to complete processing
;
S DGMTACT="UPL"
D AFTER^DGMTEVT
S DGMTINF=1 ;Non-Interactive Flag
D EN^DGMTEVT
D MTBULL^EASUM7,MAIL^IVMUFNC() ;Build Mail Message
;
; cleanup ;EAS*1*42 remove Dgmtypt
K DGINI,DGIRI,DGLY,DGMTDT,DGPRI,DGREL,DGVINI,DGVIRI,DGENUPLD
K DGCAT,IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
K IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMPRN
K IVMRELN,IVMRELO,IVMSEG,IVMSPCHV,IVMX
Q
;
GET ; get HL7 segment from ^HL
S IVMSEG=$P($G(^TMP($J,IVMRTN,IVMDA1,0)),"^",2,999)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASUM1 6273 printed Nov 22, 2024@17:05:54 Page 2
EASUM1 ;ALB/SEK,GN,MNH - IVM MEANS/COPAY TEST UPLOAD DRIVER ;7/6/04 1:23pm
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**23,30,35,42,86,113**;21-OCT-94;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;EAS*1*42 add RX Copay to Z06 Upload/Delete
+5 ;
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
+2 ; validated in the calling routine IVMPREC7. this routine will call
+3 ; IVMUCHK to ensure that the data is consistent with DHCP means test
+4 ; file and software requirements.
+5 ;
+6 ; entries will be added/modified in the following means test and
+7 ; patient files:
+8 ;
+9 ; PATIENT RELATION (#408.12)
+10 ; INCOME PERSON (#408.13)
+11 ; INDIVIDUAL ANNUAL INCOME (#408.21)
+12 ; INCOME RELATION (#408.22)
+13 ; ANNUAL MEANS TEST (#408.31)
+14 ; MEANS TEST CHANGES (#408.41)
+15 ; PATIENT (#2)
+16 ;
+17 ; current year is date of means test.
+18 ; income year is calendar year before date of means test.
+19 ; meant test status is based on income year data.
+20 ;
+21 ; IVMDAP is pointer to the PID HL7 segment in file #772
+22 ; IVMDAZ is pointer to the ZMT segment
+23 ;
+24 ; if no DUZ set to postmaster
if '$DATA(DUZ)
SET DUZ=.5
+25 ;
+26 ; get copay exemption status (IVMCEB) and means test status (IVMMTB)
+27 ; before upload
+28 SET IVMCEB=$PIECE($$RXST^IBARXEU(DFN),"^",2)
+29 SET IVMMTB=$PIECE($$LST^DGMTU(DFN),"^",3)
+30 ;
+31 ; subscript of array IVMAR is ien of 408.12 transmitted by IVM Center
+32 ; or created by upload.
+33 ;K IVMAR
+34 ;S IVMX=$$EN^IVMUCHK() I IVMX]"" S HLERR=IVMX K IVMX Q ; error found in MT data
+35 ;
ADD ; add new annual means test file (408.31) stub
+1 ; input DGMTDT (.01) dt of test
+2 ; DFN (.02) Patient IEN
+3 ; DGMTYPT (.19) type of test (1-means test, 2-Rx Copay test)
+4 ; output DGMTI annual means test IEN
+5 SET DGMTDT=IVMMTDT
+6 DO ADD^DGMTA
+7 ;Set IEN if only MT on file is Z06 MT
IF $GET(IVMMTIEN)=""
SET IVMMTIEN=$GET(DGMTI)
+8 ;
+9 ;Create new Z06 IVM Means Test
+10 ; Make STUB MT primary, add comment that it was created by Edb
+11 SET DGCOM="Z06 MT via Edb"
+12 ;Parse ZMT Segment for MT Data
DO PARSEZMT^EASPREC7(ZMTSEG)
+13 ;If MT expired then do not update Enrollment record
IF $$EXPIRED^EASPTRN1(DFN,$GET(IVM2))
SET DGENUPLD="ENROLLMENT/ELIGIBILITY UPLOAD IN PROGRESS"
+14 SET DA=DGMTI
SET DIE="^DGMT(408.31,"
+15 SET 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;.23////^S X=IVM18;.25////^S X=IVM20;2////1;2.02////^S X=IVMDATE;2.03////^S X=IVM26;50///^S X=DGCOM"
+16 ;
+17 ; Linking logic for MT & CT, conditionally set link field 2.06
+18 ; Link the CT to MT (if MT found), or MT to CT (if CT found)
+19 ; don't link tests older than Oct. 1999 or not same Year
+20 NEW LNKDAT,LNKMT,LNKDTE,LNKCAT,CURIEN
+21 SET CURIEN=DGMTI
SET LNKMT=""
+22 SET LNKDAT=$$LST^DGMTU(DFN,DGMTDT,$SELECT(DGMTYPT=1:2,1:1))
SET DGMTI=CURIEN
+23 if LNKDAT
SET LNKMT=+LNKDAT
SET LNKDTE=$PIECE(LNKDAT,"^",2)
SET LNKCAT=$PIECE(LNKDAT,"^",4)
+24 ; set LNKMT off if either of two scenarios below
+25 IF LNKMT
Begin DoDot:1
+26 IF $EXTRACT(LNKDTE,1,3)'=$EXTRACT(DGMTDT,1,3)
SET LNKMT="@"
QUIT
+27 IF DGMTDT<2991001
SET LNKMT=""
QUIT
End DoDot:1
+28 if LNKMT'=""
SET DR=DR_";2.06////^S X=LNKMT"
+29 ;
+30 ;update new 408.31 test
DO ^DIE
KILL DA,DIE,DR
+31 ;
+32 ; Update other 408.31 related Test, Link field, if link scenario true
+33 IF LNKMT
SET DA=LNKMT
SET DIE="^DGMT(408.31,"
SET DR="2.06////^S X=CURIEN"
DO ^DIE
KILL DA,DIE,DR
+34 ;
+35 ;Variables needed for Bulletins
+36 ;
+37 SET DGCAT=$PIECE($GET(^DG(408.32,IVM3,0)),"^",1)
+38 IF '$DATA(IVM5)
SET IVM5=""
+39 ;
+40 DO GETREL^DGMTU11(DFN,"V",DGLY,IVMMTIEN)
+41 ;dgmtp is event driver variable
IF EASZ06
SET (IVMMT31,DGMTP)=$GET(^DGMT(408.31,IVMMTIEN,0))
+42 DO COMPLETE
+43 QUIT
+44 ;
+45 ; add dependent(s) to income person file (408.13)
+46 ;
+47 ; add spouse if not in 408.13
+48 ; spouse/child/vet indicator
SET IVMSPCHV="S"
+49 ; spouse ZDP segment
SET IVMDA1=IVMDAP+3
DO GET
+50 DO INPIEN^IVMUM2
+51 if $DATA(IVMFERR)
QUIT
+52 ;
+53 ; entry not added - goto add children
IF IVMFLG5
GOTO ADDCHILD
+54 ;
+55 ; add entry to patient relation file (408.12)
+56 DO EN^IVMUM3
+57 if $DATA(IVMFERR)
QUIT
+58 ;
ADDS21 ; add spouse entry to individual annual income file (408.21)
+1 ; spouse ZIC segment
SET IVMDA1=IVMDAP+4
DO GET
+2 DO EN^IVMUM4
+3 if $DATA(IVMFERR)
QUIT
+4 ;
+5 ; add spouse entry to income relation file (408.22)
+6 ; spouse ZIR segment
SET IVMDA1=IVMDAP+5
DO GET
+7 ;EAS*1*113
DO EN^EASUM5
+8 if $DATA(IVMFERR)
QUIT
+9 ;
ADDCHILD ; add children if not in 408.13
+1 ; spouse/child/vet indicator
SET IVMSPCHV="C"
+2 ; no dependent children
IF 'IVMFLGC
GOTO ADDV21
+3 SET IVMCTR2=5
+4 FOR IVMCTR3=1:1:IVMFLGC
Begin DoDot:1
+5 SET IVMCTR2=IVMCTR2+1
+6 ; child ZDP segment
SET IVMDA1=IVMDAP+IVMCTR2
DO GET
+7 DO INPIEN^IVMUM2
+8 if $DATA(IVMFERR)
QUIT
+9 ;
+10 ; add child entry to patient relation file (408.12)
+11 DO EN^IVMUM3
+12 if $DATA(IVMFERR)
QUIT
+13 ;
ADDC21 ; add child entry to individual annual income file (408.21)
+1 SET IVMCTR2=IVMCTR2+1
+2 ; child ZIC segment
SET IVMDA1=IVMDAP+IVMCTR2
DO GET
+3 DO EN^IVMUM4
+4 if $DATA(IVMFERR)
QUIT
+5 ;
+6 ; add entry to income relation file (408.22)
+7 SET IVMCTR2=IVMCTR2+1
+8 ; child ZIR segment
SET IVMDA1=IVMDAP+IVMCTR2
DO GET
+9 ;EAS*1*113
DO EN^EASUM5
+10 if $DATA(IVMFERR)
QUIT
+11 QUIT
End DoDot:1
if $DATA(IVMFERR)
QUIT
+12 if $DATA(IVMFERR)
QUIT
+13 ;
ADDV21 ; add vet entry to individual annual income file (408.21)
+1 ; get vet patient relation ien
+2 SET DGPRI=+$GET(DGREL("V"))
+3 ; vet ZIC segment
SET IVMDA1=IVMDAP+1
DO GET
+4 ; spouse/child/vet indicator
SET IVMSPCHV="V"
+5 DO EN^IVMUM4
+6 if $DATA(IVMFERR)
QUIT
+7 ; vet individual annual income ien
SET DGVINI=DGINI
+8 ;
+9 ; add vet entry to income relation file (408.22)
+10 ; vet ZIR segment
SET IVMDA1=IVMDAP+2
DO GET
+11 ;EAS*1*113
DO EN^EASUM5
+12 if $DATA(IVMFERR)
QUIT
+13 ; vet income relation ien
SET DGVIRI=DGIRI
+14 ;
COMPLETE ; complete means test
+1 ;
+2 ;D EN^IVMUM6
+3 ;Call Means Test Event Driver to complete processing
+4 ;
+5 SET DGMTACT="UPL"
+6 DO AFTER^DGMTEVT
+7 ;Non-Interactive Flag
SET DGMTINF=1
+8 DO EN^DGMTEVT
+9 ;Build Mail Message
DO MTBULL^EASUM7
DO MAIL^IVMUFNC()
+10 ;
+11 ; cleanup ;EAS*1*42 remove Dgmtypt
+12 KILL DGINI,DGIRI,DGLY,DGMTDT,DGPRI,DGREL,DGVINI,DGVIRI,DGENUPLD
+13 KILL DGCAT,IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
+14 KILL IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMPRN
+15 KILL IVMRELN,IVMRELO,IVMSEG,IVMSPCHV,IVMX
+16 QUIT
+17 ;
GET ; get HL7 segment from ^HL
+1 SET IVMSEG=$PIECE($GET(^TMP($JOB,IVMRTN,IVMDA1,0)),"^",2,999)
+2 QUIT
