- IVMUM1 ;ALB/SEK - MEANS TEST UPLOAD DRIVER ; 3/6/01 5:13pm
- ;;2.0;INCOME VERIFICATION MATCH;**1,8,34**;21-OCT-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- 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)
- ; output DGMTI annual means test IEN
- S DGMTDT=IVMMTDT,DGMTYPT=1
- D ADD^DGMTA
- ;
- ; change primary income test for year? code from 1 to 0 for
- ; IVM means test.
- S DA=DGMTI,DIE="^DGMT(408.31,",DR="2////0"
- D ^DIE K DA,DIE,DR
- ;
- D GETREL^DGMTU11(DFN,"VSC",DGLY,IVMMTIEN)
- ;
- ; 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^IVMUM5
- 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^IVMUM5
- .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^IVMUM5
- Q:$D(IVMFERR)
- S DGVIRI=DGIRI ; vet income relation ien
- ;
- COMPLETE ; complete means test
- ;
- D EN^IVMUM6
- ;
- ; cleanup
- K DGINI,DGIRI,DGLY,DGMTDT,DGMTYPT,DGPRI,DGREL,DGVINI,DGVIRI
- K IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
- K IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMMTDT,IVMMTIEN,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[HIVMUM1 4278 printed Feb 18, 2025@23:28:29 Page 2
- IVMUM1 ;ALB/SEK - MEANS TEST UPLOAD DRIVER ; 3/6/01 5:13pm
- +1 ;;2.0;INCOME VERIFICATION MATCH;**1,8,34**;21-OCT-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- 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 KILL IVMAR
- +34 ; error found in MT data
- SET IVMX=$$EN^IVMUCHK()
- IF IVMX]""
- SET HLERR=IVMX
- KILL IVMX
- QUIT
- +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)
- +4 ; output DGMTI annual means test IEN
- +5 SET DGMTDT=IVMMTDT
- SET DGMTYPT=1
- +6 DO ADD^DGMTA
- +7 ;
- +8 ; change primary income test for year? code from 1 to 0 for
- +9 ; IVM means test.
- +10 SET DA=DGMTI
- SET DIE="^DGMT(408.31,"
- SET DR="2////0"
- +11 DO ^DIE
- KILL DA,DIE,DR
- +12 ;
- +13 DO GETREL^DGMTU11(DFN,"VSC",DGLY,IVMMTIEN)
- +14 ;
- +15 ; add dependent(s) to income person file (408.13)
- +16 ;
- +17 ; add spouse if not in 408.13
- +18 ; spouse/child/vet indicator
- SET IVMSPCHV="S"
- +19 ; spouse ZDP segment
- SET IVMDA1=IVMDAP+3
- DO GET
- +20 DO INPIEN^IVMUM2
- +21 if $DATA(IVMFERR)
- QUIT
- +22 ;
- +23 ; entry not added - goto add children
- IF IVMFLG5
- GOTO ADDCHILD
- +24 ;
- +25 ; add entry to patient relation file (408.12)
- +26 DO EN^IVMUM3
- +27 if $DATA(IVMFERR)
- QUIT
- +28 ;
- 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 DO EN^IVMUM5
- +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 DO EN^IVMUM5
- +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 DO EN^IVMUM5
- +12 if $DATA(IVMFERR)
- QUIT
- +13 ; vet income relation ien
- SET DGVIRI=DGIRI
- +14 ;
- COMPLETE ; complete means test
- +1 ;
- +2 DO EN^IVMUM6
- +3 ;
- +4 ; cleanup
- +5 KILL DGINI,DGIRI,DGLY,DGMTDT,DGMTYPT,DGPRI,DGREL,DGVINI,DGVIRI
- +6 KILL IVMAR,IVMCEB,IVMCTR2,IVMCTR3,IVMDA1,IVMDAP,IVMFERR
- +7 KILL IVMFLG2,IVMFLG5,IVMFLGC,IVMMTB,IVMMTDT,IVMMTIEN,IVMPRN
- +8 KILL IVMRELN,IVMRELO,IVMSEG,IVMSPCHV,IVMX
- +9 QUIT
- +10 ;
- GET ; get HL7 segment from ^HL
- +1 SET IVMSEG=$PIECE($GET(^TMP($JOB,IVMRTN,IVMDA1,0)),"^",2,999)
- +2 QUIT