IVMPTRN8 ;ALB/RKS,PDJ,BRM,TDM,PJH,TDM,PWC,LBD,DRP,DJS,KUM - HL7 FULL DATA TRANSMISSION (Z07) BUILDER ;27 Nov 2017 8:56 AM
;;2.0;INCOME VERIFICATION MATCH;**9,11,19,12,21,17,24,36,37,47,48,42,34,77,76,75,79,85,89,98,56,97,104,113,109,114,105,115,121,151,141,150,160,161,168,167,164,184,194,204,203,208,210**;21-OCT-94;Build 13
;Per VHA Directive 2004-038, this routine should not be modified.
;
; *164* #858271 - Sending ZAV Segment with CASS field value for all Address types
;
; Reference to $$EN^VAFHLZCE in ICR #7185
;
BUILD(DFN,IVMMTDT,IVMCT,IVMQUERY) ; --
; Description: This entry point will be used to create an HL7
; "Full Data Transmission" message for a patient.
;
; Input:
; DFN - Patient IEN
; IVMMTDT - date of the patient's Means Test or Copay Test
; IVMCT - count of hl7 segments transmitted, pass by reference
; IVMQUERY - array passed in by reference where
; IVMQUERY("LTD") -- # of the QUERY that is currently open or
; undefined, zero, or null if no QUERY opened for
; last treatment date
; IVMQUERY("OVIS") -- # of the QUERY that is currently open or
; undefined, zero, or null if no QUERY opened for
; finding outpatient visits
;
; HL7 variables as defined by call to INIT^IVMUFNC:
; HLEVN - HL7 message event counter
; HLSDT - a flag that indicates that the data to be sent is
; stored in the ^TMP("HLS") global array.
;
; The following variables returned by the INIT^HLTRANS entry point:
; HLNDAP - Non-DHCP Application Pointer from file 770
; HLNDAP0 - Zero node from file 770 corresponding to HLNDAP
; HLDAP - DHCP Application Pointer from file 771
; HLDAN - The DHCP Application Name (.01 field, file 771) for HLDAP
; HLPID - HL7 processing ID from file 770
; HLVER - HL7 version number from file 770
; HLFS - HL7 Field Separator from the 'FS' node of file 771
; HLECH - HL7 Encoding Characters from the 'EC' node of file 771
; HLQ - Double quotes ("") for use in building HL7 segments
; HLERR - if an error is encountered, an error message is returned
; in the HLERR variable.
; HLDA - the internal entry number for the entry created in
; file #772.
; HLDT - transmission date/time (associated with the entry in file
; #772 identified by HLDA) in internal VA FileMan format.
; HLDT1 - the same transmission date/time as the HLDT variable,
; only in HL7 format.
;
; Output:
; ^TMP("HLS",$J,IVMCT) - global array containing all segments of the HL7 message that the VistA application wishes to send. The HLSDT variable is defined above and the IVMCT variable is a sequential number incremented by 1.
;
;
N DGINC,DGINR,DGREL,I,IVMNTE,IVMPID,IVMSUB,IVMSUB1,IVMZRD,IVMZAV,VAFPID,VAFZEL,FBZFE,IVMZCD,DELETE,NODE,IVMPIEN,TEST,IVMPNODE,TESTTYPE,SEQS,TESTCODE
N HARDSHIP,ACTVIEN,IVMZMH,IVMSEQ,EDBMTZ06,ZMHSQ,SETID,OBXCNT,OBXTMP,DGSEC,SEGOCC,ZIOSEG,N101015,RF1SEG,ZCTTYP,ZCTARY,ZCTSQ,VAFPID,CAFLG,IVMZAVA,VAFZTE
N ERROR,VAFZCE
S IVMZAVA=""
;
; create (PID) Patient Identification segment
; **** Add ICN to 2nd piece PID segment for MPI@HEC.
S IVMCMOR="1,2",IVMSEQ=1
; check to see if site is a legacy site. If not add ICN to PID segment.
I '$D(^PPP(1020.128,"AC",$P($$SITE^VASITE,"^",3))) D
. I +$$GETICN^MPIF001(DFN)>0,($$IFLOCAL^MPIF001(DFN)=0) S IVMSEQ=IVMSEQ_",2",IVMCMOR="1,2,3" ;add SEQ 1 and 2 for PID
;
; send SSN indicating pseudo
; I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1 ; strip 'P' from pseudo SSNs
S IVMSEQ=IVMSEQ_",3,5,6,7,8,10,11,12,13,14,16,17,19,22,24"
K IVMPID D BLDPID^VAFCQRY1(DFN,1,IVMSEQ,.IVMPID,.HL,.ERROR)
K VAFPID D STRIP11
S SEGOCC="" F S SEGOCC=$O(VAFPID(SEGOCC)) Q:SEGOCC="" D
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=VAFPID(SEGOCC)
;
; **** create (PD1) Patient CMOR segment for MPI@HEC.
S:'$D(HL("FS")) HL("FS")=HLFS
S:'$D(HL("ECH")) HL("ECH")=HLECH
S:'$D(HL("Q")) HL("Q")=HLQ
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLPD1(DFN,IVMCMOR)
;
; create (ZPD) Patient Dependent Info. segment
; IVM*2.0*210 - Add sequence 46, 47 for Preferred Language and Preferred Language Date/Time
; IVM*2.0*203 - Add Sequence 42 to 45 for Indian attestation information
; Sequence 41 is added to fill in gap of unused field
;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN1^VAFHLZPD(DFN,"1,6,7,8,9,11,12,13,17,19,30,31,32,33,34,35,40"),IVMINS=$P(^(IVMCT),HLFS,12)
;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN1^VAFHLZPD(DFN,"1,6,7,8,9,11,12,13,17,19,30,31,32,33,34,35,40,41,42,43,44,45"),IVMINS=$P(^(IVMCT),HLFS,12)
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN1^VAFHLZPD(DFN,"1,6,7,8,9,11,12,13,17,19,30,31,32,33,34,35,40,41,42,43,44,45,46,47"),IVMINS=$P(^(IVMCT),HLFS,12)
;
I $D(VAFZPD(1)) S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=VAFZPD(1) K VAFZPD(1)
;
; create (ZTA) Temporary Address segment
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZTA(DFN,"1,2,3,4,5,6,7,8,9",,.HL)
; KUM IVM*2.0*164 - Set Flag to determine if Temporary address is in Message
I $TR($P(^TMP("HLS",$J,IVMCT),HLFS,6),"~""""^","")'="" S IVMZAVA("C")=""
;
; KUM - IVM*2.0*164 - Send CASS field value for all Address Types
; create (ZAV) Rated Disabilities segment(s)
D EN^VAFHLZAV(DFN,"1,2,3,",HLQ,HLFS,.IVMZAV,.IVMZAVA)
F IVMSUB=0:0 S IVMSUB=+$O(IVMZAV("HL7",IVMSUB)) Q:'IVMSUB D
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZAV("HL7",+IVMSUB))
;
; create (ZIE) Ineligible segment
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIE(DFN,"1,2,3",1)
;
; create (ZEL) Eligibility segment(s)
; **** Add 5th piece to ZEL to correct consistency check
; added 41-44 for CLV IVM*2.0*161
D EN1^VAFHLZEL(DFN,"1,2,5,6,7,8,10,11,13,14,15,16,17,18,19,20,21,22,23,24,25,29,34,35,37,38,39,40,41,42,43,44,45,46,47",2,.VAFZEL)
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(1)) ; Primary Eligibility
I $D(VAFZEL(1,1)) S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(1,1))
; - other entitled eligibilities
F IVMSUB=1:0 S IVMSUB=+$O(VAFZEL(IVMSUB)) Q:'IVMSUB D
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(+IVMSUB))
;
; create ZE2 segment (Optional)
I $P($G(^DPT(DFN,.385)),U)'="" S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZE2(DFN,"1,2")
;
; IVM*2.0*208 - Create ZHF segment (Optional)
I $$GET1^DIQ(2,DFN_",",.5601)'="" S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZHF(DFN,"1,2,3,4,5",HLQ,HLFS)
;
; create ZTE segments (optional)
D EN^VAFHLZTE(DFN,"1,2,3,4,5,6,7,8,9,10,11,12,13",0,.VAFZTE)
S IVMSUB=0 F S IVMSUB=$O(VAFZTE(IVMSUB)) Q:'IVMSUB D
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZTE(IVMSUB))
.S IVMSUB1=0 F S IVMSUB1=$O(VAFZTE(IVMSUB,IVMSUB1)) Q:'IVMSUB1 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZTE(IVMSUB,IVMSUB1))
.Q
;
; KUM - IVM*2.0*194
; create ZCE segments (optional)
D EN^VAFHLZCE(DFN,"1,2,3,4,5",,HLQ,HLFS,.VAFZCE)
S IVMSUB=0 F S IVMSUB=$O(VAFZCE(IVMSUB)) Q:'IVMSUB D
.S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZCE(IVMSUB))
.S IVMSUB1=0 F S IVMSUB1=$O(VAFZCE(IVMSUB,IVMSUB1)) Q:'IVMSUB1 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZCE(IVMSUB,IVMSUB1))
.Q
;
; create (ZEN) Enrollment segment
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEN(DFN)
;
; create (ZCD) Catastrophic Disability segment(s)
D BUILD^VAFHLZCD(.IVMZCD,DFN,,HLQ,HLFS)
F IVMSUB=0:0 S IVMSUB=+$O(IVMZCD(IVMSUB)) Q:'IVMSUB D
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZCD(+IVMSUB))
;
; Optionally create (ZMH) Military History segments
; Pass "*" as parameter to send unlimited MSEs in Z07 (IVM*2*141)
D ENTER^VAFHLZMH(DFN,"IVMZMH","*")
;DJS, Don't create ZMH segment if array entry is an FDD MSE; IVM*2.0*167
N ZMHED,MSESUB,DONEMSE
S (ZMHSQ,SETID,DONEMSE)=0
I $D(IVMZMH) F S ZMHSQ=$O(IVMZMH(ZMHSQ)) Q:ZMHSQ="" D
. Q:$TR($P(IVMZMH(ZMHSQ,0),HLFS,4,5),"""^~")=""
. ;If no Service Entry Date, QUIT
. S ZMHED=$P(IVMZMH(ZMHSQ,0),U,5),ZMHED=$P(ZMHED,"~",1) Q:ZMHED=""
. S ZMHED=$$HL7TFM^XLFDT(ZMHED)
. ;Get MSE, if no more MSEs, process Conflict Information, if present
. I 'DONEMSE S MSESUB="",MSESUB=$O(^DPT(DFN,.3216,"B",ZMHED,MSESUB)) S:MSESUB="" DONEMSE=1
. ;Do not create ZMH segment if FDD MSE
. I 'DONEMSE,$P(^DPT(DFN,.3216,MSESUB,0),U,8)'="" Q ;Only check for FDD if MSE entry
. S SETID=SETID+1,IVMCT=IVMCT+1
. S ^TMP("HLS",$J,IVMCT)="ZMH"_HLFS_SETID_HLFS_$P(IVMZMH(ZMHSQ,0),HLFS,3,6)
;
; create (ZRD) Rated Disabilities segment(s)
D EN^VAFHLZRD(DFN,"1,2,3,4,12,13,14,",HLQ,HLFS,"IVMZRD")
F IVMSUB=0:0 S IVMSUB=+$O(IVMZRD(IVMSUB)) Q:'IVMSUB D
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZRD(+IVMSUB,0))
;
; create (ZCT) Emergency Contact segment
;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10","",1,1)
K ZCTARY F ZCTTYP=1:1:5 D ;Create Optional ZCT Segments
. ; IVM*2.0*204 - Add Sequence 11 for Relationship
. S ZCTARY(ZCTTYP)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10","",ZCTTYP,1)
. I $$NOW^XLFDT()>=$$GET^XPAR("PKG","DG PATCH DG*5.3*1067 ACTIVE",1) D
. . S ZCTARY(ZCTTYP)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10,11","",ZCTTYP,1)
S (ZCTTYP,ZCTSQ)=0
I $D(ZCTARY) F S ZCTTYP=$O(ZCTARY(ZCTTYP)) Q:ZCTTYP="" D
. Q:$P(ZCTARY(ZCTTYP),HLFS,11)=HLQ
. S ZCTSQ=ZCTSQ+1,$P(ZCTARY(ZCTTYP),HLFS,2)=ZCTSQ
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=ZCTARY(ZCTTYP)
I ZCTSQ=0 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=ZCTARY(1)
;
; create (ZEM) Employment Info. segment for (1) Patient & (2) Spouse
;*168 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7")
;*168 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7",2,2)
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,9") ;re-enable imprecise date.
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,9",2,2)
;
; create (ZGD) Guardian segment for (1) VA & (2) Civil
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",1)
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",2)
;
; Income Year requiring transmission from IVM Patient File (301.5)
S IVMIY=$S($D(IVMIY):IVMIY,1:(IVMMTDT-10000))
N MTINFO S MTINFO=$$FUT^DGMTU(DFN)
I ($E(IVMIY,1,3)+1)=$E($P(MTINFO,U,2),1,3) S IVMMTDT=$P(MTINFO,U,2)
;get the primary test for the income year
S TESTTYPE=$$GETTYPE^IVMPTRN9(DFN,IVMMTDT,.TESTCODE,.HARDSHIP,.ACTVIEN)
;
; The following function call returns:
; - Patient Relation IEN array in DGREL
; - Individual Annual Income IEN array in DGINC
; - Income Relation IEN array in DGINR
D ALL^DGMTU21(DFN,"VSC",IVMMTDT,"IPR",ACTVIEN)
;
S EDBMTZ06=0 I $$VERZ06^EASPTRN1(DFN) S EDBMTZ06=1
; create (ZIC) Income segment for veteran
S IVMCT=IVMCT+1
;IVM*2.0*115 -- Check for Means Test Version Indicator
N MTVERS S MTVERS=$S(+$G(ACTVIEN):+$P($G(^DGMT(408.31,ACTVIEN,2)),"^",11),1:0)
I MTVERS=0 D I 1
. S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("V")),"1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20")
E D
. S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("V")),"1,2,3,9,12,13,14,15,16,18,19")
I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
;use IVMIY not IVMMTDT. For LTC copay exemption, IVMMTDT is not correct
S $P(^TMP("HLS",$J,IVMCT),"^",3)=$$HLDATE^HLFNC(IVMIY)
;
; create (ZIR) Income Relation segment for veteran
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("V")),"1,2,3,4,5,10,15") ;IVM * 2.0 *160
I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^1"
;
; create (ZDP) Patient Dependent Info. segment for spouse
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZDP(+$G(DGREL("S")),"1,2,3,4,5,6,7,8,9,10,13,14")
;I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
;. ; - pass non-existent SSNs as 0s
;. S $P(X,HLFS,6)="000000000"
;
; create (ZIC) Income segment for spouse
S IVMCT=IVMCT+1
;IVM*2.0*115
I MTVERS=0 D I 1
. S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("S")),"1,2,3,4,5,6,7,8,9,10,11,12,16,17,18,19,20")
E D
. S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("S")),"1,2,3,9,12,16,18,19")
I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
;
; create (ZIR) Income Relation segment for spouse
S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("S")),"1,2,3")
I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^"_$P(^TMP("HLS",$J,IVMCT),"^",2)
;
;
; create ZDP, ZIC, and ZIR segments for all Means Test dependents
F IVMSUB=0:0 S IVMSUB=$O(DGREL("C",IVMSUB)) Q:'IVMSUB D
. ;
. ; - create (ZDP) Dependent Info. segment for dependent child
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZDP(+$G(DGREL("C",IVMSUB)),"1,2,3,4,5,6,7,9,10")
.; I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
.; . ; - pass non-existent SSNs as 0s
.; . S $P(X,HLFS,6)="000000000"
. ;
. ; - create (ZIC) Income segment for dependent child
. S IVMCT=IVMCT+1
. ;IVM*2.0*115
. I MTVERS=0 D I 1
. . S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("C",IVMSUB)),"1,2,3,4,5,6,7,8,9,10,11,12,15")
. E D
. . S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("C",IVMSUB)),"1,2,3,9,12,15,16,18,19")
. I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
. ;
. ; - create (ZIR) Income Relation segment for dependent child
. S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("C",IVMSUB)),"1,2,3,4,6,7,8,9,14,15") ;IVM * 2.0 *160
. I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^"_$P(^TMP("HLS",$J,IVMCT),"^",2)
. ;
; Send INACTIVE spouse/dependents.
D GETINACD^DGMTU11(DFN,.DGREL)
F I="S","C" D
. F IVMSUB=0:0 S IVMSUB=$O(DGIREL(I,IVMSUB)) Q:'IVMSUB D
. . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZDP(+$G(DGIREL(I,IVMSUB)),"1,2,3,4,5,6,7,9,10,11",,,$P(DGIREL(I,IVMSUB),U,3))
;
D GOTO^IVMPTRN9
Q
;
STRIP11 N APID,ZPID,ASQ,ATYP,SSQ
;Extract PID segment
S IVMPID(1)=$E(IVMPID(1),5,$L(IVMPID(1)))
D BLDPID^IVMPREC6(.IVMPID,.APID)
;
S CAFLG=0
I $D(APID(11)) D
.I $O(APID(11,"")) D Q
..M ZPID(11)=APID(11) K APID(11)
..S (ASQ,SSQ)=0 F S ASQ=$O(ZPID(11,ASQ)) Q:ASQ="" D
...S ATYP=$P($G(ZPID(11,ASQ)),$E(HLECH),7) Q:ATYP=""
...;KUM - IVM*2.0*164 - Comment below 2 lines and Add line to enable all categories of Confidential Address
...;I (ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") Q
...;I ATYP="VACAE" S CAFLG=1
...I (ATYP="VACAE")!(ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") S CAFLG=1
...I (CAFLG=1) S IVMZAVA("CNF")=""
...I (ATYP="P") S IVMZAVA("P")=""
...I (ATYP="R") S IVMZAVA("R")=""
...S SSQ=SSQ+1,APID(11,SSQ)=ZPID(11,ASQ)
.Q:$G(APID(11))=""
.S ATYP=$P($G(APID(11)),$E(HLECH),7) Q:ATYP=""
.;KUM - IVM*2.0*164 - Comment below 2 lines and Add line to enable all categories of Confidential Address
.;I ATYP="VACAE" S CAFLG=1 Q
.;I (ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") K APID(11)
.I (ATYP="VACAE")!(ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") S CAFLG=1 Q
;
I 'CAFLG,$D(APID(13)) D
.I $O(APID(13,"")) D Q
..S ASQ=0 F S ASQ=$O(APID(13,ASQ)) Q:ASQ="" D
...Q:$G(APID(13,ASQ))=""
...S ATYP=$P($G(APID(13,ASQ)),$E(HLECH),2) Q:ATYP=""
...I ATYP="VACPN" K APID(13,ASQ) Q
.Q:$G(APID(13))=""
.S ATYP=$P($G(APID(13)),$E(HLECH),2) Q:ATYP=""
.I ATYP="VACPN" K APID(13) Q
;
;Rebuild PID
D KVA^VADPT
D MAKEIT^VAFHLU("PID",.APID,.VAFPID,.VAFPID)
S VAFPID(0)=VAFPID
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMPTRN8 15548 printed Apr 09, 2024@21:03:11 Page 2
IVMPTRN8 ;ALB/RKS,PDJ,BRM,TDM,PJH,TDM,PWC,LBD,DRP,DJS,KUM - HL7 FULL DATA TRANSMISSION (Z07) BUILDER ;27 Nov 2017 8:56 AM
+1 ;;2.0;INCOME VERIFICATION MATCH;**9,11,19,12,21,17,24,36,37,47,48,42,34,77,76,75,79,85,89,98,56,97,104,113,109,114,105,115,121,151,141,150,160,161,168,167,164,184,194,204,203,208,210**;21-OCT-94;Build 13
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; *164* #858271 - Sending ZAV Segment with CASS field value for all Address types
+5 ;
+6 ; Reference to $$EN^VAFHLZCE in ICR #7185
+7 ;
BUILD(DFN,IVMMTDT,IVMCT,IVMQUERY) ; --
+1 ; Description: This entry point will be used to create an HL7
+2 ; "Full Data Transmission" message for a patient.
+3 ;
+4 ; Input:
+5 ; DFN - Patient IEN
+6 ; IVMMTDT - date of the patient's Means Test or Copay Test
+7 ; IVMCT - count of hl7 segments transmitted, pass by reference
+8 ; IVMQUERY - array passed in by reference where
+9 ; IVMQUERY("LTD") -- # of the QUERY that is currently open or
+10 ; undefined, zero, or null if no QUERY opened for
+11 ; last treatment date
+12 ; IVMQUERY("OVIS") -- # of the QUERY that is currently open or
+13 ; undefined, zero, or null if no QUERY opened for
+14 ; finding outpatient visits
+15 ;
+16 ; HL7 variables as defined by call to INIT^IVMUFNC:
+17 ; HLEVN - HL7 message event counter
+18 ; HLSDT - a flag that indicates that the data to be sent is
+19 ; stored in the ^TMP("HLS") global array.
+20 ;
+21 ; The following variables returned by the INIT^HLTRANS entry point:
+22 ; HLNDAP - Non-DHCP Application Pointer from file 770
+23 ; HLNDAP0 - Zero node from file 770 corresponding to HLNDAP
+24 ; HLDAP - DHCP Application Pointer from file 771
+25 ; HLDAN - The DHCP Application Name (.01 field, file 771) for HLDAP
+26 ; HLPID - HL7 processing ID from file 770
+27 ; HLVER - HL7 version number from file 770
+28 ; HLFS - HL7 Field Separator from the 'FS' node of file 771
+29 ; HLECH - HL7 Encoding Characters from the 'EC' node of file 771
+30 ; HLQ - Double quotes ("") for use in building HL7 segments
+31 ; HLERR - if an error is encountered, an error message is returned
+32 ; in the HLERR variable.
+33 ; HLDA - the internal entry number for the entry created in
+34 ; file #772.
+35 ; HLDT - transmission date/time (associated with the entry in file
+36 ; #772 identified by HLDA) in internal VA FileMan format.
+37 ; HLDT1 - the same transmission date/time as the HLDT variable,
+38 ; only in HL7 format.
+39 ;
+40 ; Output:
+41 ; ^TMP("HLS",$J,IVMCT) - global array containing all segments of the HL7 message that the VistA application wishes to send. The HLSDT variable is defined above and the IVMCT variable is a sequential number incremented by 1.
+42 ;
+43 ;
+44 NEW DGINC,DGINR,DGREL,I,IVMNTE,IVMPID,IVMSUB,IVMSUB1,IVMZRD,IVMZAV,VAFPID,VAFZEL,FBZFE,IVMZCD,DELETE,NODE,IVMPIEN,TEST,IVMPNODE,TESTTYPE,SEQS,TESTCODE
+45 NEW HARDSHIP,ACTVIEN,IVMZMH,IVMSEQ,EDBMTZ06,ZMHSQ,SETID,OBXCNT,OBXTMP,DGSEC,SEGOCC,ZIOSEG,N101015,RF1SEG,ZCTTYP,ZCTARY,ZCTSQ,VAFPID,CAFLG,IVMZAVA,VAFZTE
+46 NEW ERROR,VAFZCE
+47 SET IVMZAVA=""
+48 ;
+49 ; create (PID) Patient Identification segment
+50 ; **** Add ICN to 2nd piece PID segment for MPI@HEC.
+51 SET IVMCMOR="1,2"
SET IVMSEQ=1
+52 ; check to see if site is a legacy site. If not add ICN to PID segment.
+53 IF '$DATA(^PPP(1020.128,"AC",$PIECE($$SITE^VASITE,"^",3)))
Begin DoDot:1
+54 ;add SEQ 1 and 2 for PID
IF +$$GETICN^MPIF001(DFN)>0
IF ($$IFLOCAL^MPIF001(DFN)=0)
SET IVMSEQ=IVMSEQ_",2"
SET IVMCMOR="1,2,3"
End DoDot:1
+55 ;
+56 ; send SSN indicating pseudo
+57 ; I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1 ; strip 'P' from pseudo SSNs
+58 SET IVMSEQ=IVMSEQ_",3,5,6,7,8,10,11,12,13,14,16,17,19,22,24"
+59 KILL IVMPID
DO BLDPID^VAFCQRY1(DFN,1,IVMSEQ,.IVMPID,.HL,.ERROR)
+60 KILL VAFPID
DO STRIP11
+61 SET SEGOCC=""
FOR
SET SEGOCC=$ORDER(VAFPID(SEGOCC))
if SEGOCC=""
QUIT
Begin DoDot:1
+62 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=VAFPID(SEGOCC)
End DoDot:1
+63 ;
+64 ; **** create (PD1) Patient CMOR segment for MPI@HEC.
+65 if '$DATA(HL("FS"))
SET HL("FS")=HLFS
+66 if '$DATA(HL("ECH"))
SET HL("ECH")=HLECH
+67 if '$DATA(HL("Q"))
SET HL("Q")=HLQ
+68 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLPD1(DFN,IVMCMOR)
+69 ;
+70 ; create (ZPD) Patient Dependent Info. segment
+71 ; IVM*2.0*210 - Add sequence 46, 47 for Preferred Language and Preferred Language Date/Time
+72 ; IVM*2.0*203 - Add Sequence 42 to 45 for Indian attestation information
+73 ; Sequence 41 is added to fill in gap of unused field
+74 ;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN1^VAFHLZPD(DFN,"1,6,7,8,9,11,12,13,17,19,30,31,32,33,34,35,40"),IVMINS=$P(^(IVMCT),HLFS,12)
+75 ;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN1^VAFHLZPD(DFN,"1,6,7,8,9,11,12,13,17,19,30,31,32,33,34,35,40,41,42,43,44,45"),IVMINS=$P(^(IVMCT),HLFS,12)
+76 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN1^VAFHLZPD(DFN,"1,6,7,8,9,11,12,13,17,19,30,31,32,33,34,35,40,41,42,43,44,45,46,47")
SET IVMINS=$PIECE(^(IVMCT),HLFS,12)
+77 ;
+78 IF $DATA(VAFZPD(1))
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=VAFZPD(1)
KILL VAFZPD(1)
+79 ;
+80 ; create (ZTA) Temporary Address segment
+81 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZTA(DFN,"1,2,3,4,5,6,7,8,9",,.HL)
+82 ; KUM IVM*2.0*164 - Set Flag to determine if Temporary address is in Message
+83 IF $TRANSLATE($PIECE(^TMP("HLS",$JOB,IVMCT),HLFS,6),"~""""^","")'=""
SET IVMZAVA("C")=""
+84 ;
+85 ; KUM - IVM*2.0*164 - Send CASS field value for all Address Types
+86 ; create (ZAV) Rated Disabilities segment(s)
+87 DO EN^VAFHLZAV(DFN,"1,2,3,",HLQ,HLFS,.IVMZAV,.IVMZAVA)
+88 FOR IVMSUB=0:0
SET IVMSUB=+$ORDER(IVMZAV("HL7",IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:1
+89 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(IVMZAV("HL7",+IVMSUB))
End DoDot:1
+90 ;
+91 ; create (ZIE) Ineligible segment
+92 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIE(DFN,"1,2,3",1)
+93 ;
+94 ; create (ZEL) Eligibility segment(s)
+95 ; **** Add 5th piece to ZEL to correct consistency check
+96 ; added 41-44 for CLV IVM*2.0*161
+97 DO EN1^VAFHLZEL(DFN,"1,2,5,6,7,8,10,11,13,14,15,16,17,18,19,20,21,22,23,24,25,29,34,35,37,38,39,40,41,42,43,44,45,46,47",2,.VAFZEL)
+98 ; Primary Eligibility
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(VAFZEL(1))
+99 IF $DATA(VAFZEL(1,1))
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(VAFZEL(1,1))
+100 ; - other entitled eligibilities
+101 FOR IVMSUB=1:0
SET IVMSUB=+$ORDER(VAFZEL(IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:1
+102 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(VAFZEL(+IVMSUB))
End DoDot:1
+103 ;
+104 ; create ZE2 segment (Optional)
+105 IF $PIECE($GET(^DPT(DFN,.385)),U)'=""
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZE2(DFN,"1,2")
+106 ;
+107 ; IVM*2.0*208 - Create ZHF segment (Optional)
+108 IF $$GET1^DIQ(2,DFN_",",.5601)'=""
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZHF(DFN,"1,2,3,4,5",HLQ,HLFS)
+109 ;
+110 ; create ZTE segments (optional)
+111 DO EN^VAFHLZTE(DFN,"1,2,3,4,5,6,7,8,9,10,11,12,13",0,.VAFZTE)
+112 SET IVMSUB=0
FOR
SET IVMSUB=$ORDER(VAFZTE(IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:1
+113 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(VAFZTE(IVMSUB))
+114 SET IVMSUB1=0
FOR
SET IVMSUB1=$ORDER(VAFZTE(IVMSUB,IVMSUB1))
if 'IVMSUB1
QUIT
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(VAFZTE(IVMSUB,IVMSUB1))
+115 QUIT
End DoDot:1
+116 ;
+117 ; KUM - IVM*2.0*194
+118 ; create ZCE segments (optional)
+119 DO EN^VAFHLZCE(DFN,"1,2,3,4,5",,HLQ,HLFS,.VAFZCE)
+120 SET IVMSUB=0
FOR
SET IVMSUB=$ORDER(VAFZCE(IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:1
+121 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(VAFZCE(IVMSUB))
+122 SET IVMSUB1=0
FOR
SET IVMSUB1=$ORDER(VAFZCE(IVMSUB,IVMSUB1))
if 'IVMSUB1
QUIT
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(VAFZCE(IVMSUB,IVMSUB1))
+123 QUIT
End DoDot:1
+124 ;
+125 ; create (ZEN) Enrollment segment
+126 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZEN(DFN)
+127 ;
+128 ; create (ZCD) Catastrophic Disability segment(s)
+129 DO BUILD^VAFHLZCD(.IVMZCD,DFN,,HLQ,HLFS)
+130 FOR IVMSUB=0:0
SET IVMSUB=+$ORDER(IVMZCD(IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:1
+131 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(IVMZCD(+IVMSUB))
End DoDot:1
+132 ;
+133 ; Optionally create (ZMH) Military History segments
+134 ; Pass "*" as parameter to send unlimited MSEs in Z07 (IVM*2*141)
+135 DO ENTER^VAFHLZMH(DFN,"IVMZMH","*")
+136 ;DJS, Don't create ZMH segment if array entry is an FDD MSE; IVM*2.0*167
+137 NEW ZMHED,MSESUB,DONEMSE
+138 SET (ZMHSQ,SETID,DONEMSE)=0
+139 IF $DATA(IVMZMH)
FOR
SET ZMHSQ=$ORDER(IVMZMH(ZMHSQ))
if ZMHSQ=""
QUIT
Begin DoDot:1
+140 if $TRANSLATE($PIECE(IVMZMH(ZMHSQ,0),HLFS,4,5),"""^~")=""
QUIT
+141 ;If no Service Entry Date, QUIT
+142 SET ZMHED=$PIECE(IVMZMH(ZMHSQ,0),U,5)
SET ZMHED=$PIECE(ZMHED,"~",1)
if ZMHED=""
QUIT
+143 SET ZMHED=$$HL7TFM^XLFDT(ZMHED)
+144 ;Get MSE, if no more MSEs, process Conflict Information, if present
+145 IF 'DONEMSE
SET MSESUB=""
SET MSESUB=$ORDER(^DPT(DFN,.3216,"B",ZMHED,MSESUB))
if MSESUB=""
SET DONEMSE=1
+146 ;Do not create ZMH segment if FDD MSE
+147 ;Only check for FDD if MSE entry
IF 'DONEMSE
IF $PIECE(^DPT(DFN,.3216,MSESUB,0),U,8)'=""
QUIT
+148 SET SETID=SETID+1
SET IVMCT=IVMCT+1
+149 SET ^TMP("HLS",$JOB,IVMCT)="ZMH"_HLFS_SETID_HLFS_$PIECE(IVMZMH(ZMHSQ,0),HLFS,3,6)
End DoDot:1
+150 ;
+151 ; create (ZRD) Rated Disabilities segment(s)
+152 DO EN^VAFHLZRD(DFN,"1,2,3,4,12,13,14,",HLQ,HLFS,"IVMZRD")
+153 FOR IVMSUB=0:0
SET IVMSUB=+$ORDER(IVMZRD(IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:1
+154 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$GET(IVMZRD(+IVMSUB,0))
End DoDot:1
+155 ;
+156 ; create (ZCT) Emergency Contact segment
+157 ;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10","",1,1)
+158 ;Create Optional ZCT Segments
KILL ZCTARY
FOR ZCTTYP=1:1:5
Begin DoDot:1
+159 ; IVM*2.0*204 - Add Sequence 11 for Relationship
+160 SET ZCTARY(ZCTTYP)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10","",ZCTTYP,1)
+161 IF $$NOW^XLFDT()>=$$GET^XPAR("PKG","DG PATCH DG*5.3*1067 ACTIVE",1)
Begin DoDot:2
+162 SET ZCTARY(ZCTTYP)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10,11","",ZCTTYP,1)
End DoDot:2
End DoDot:1
+163 SET (ZCTTYP,ZCTSQ)=0
+164 IF $DATA(ZCTARY)
FOR
SET ZCTTYP=$ORDER(ZCTARY(ZCTTYP))
if ZCTTYP=""
QUIT
Begin DoDot:1
+165 if $PIECE(ZCTARY(ZCTTYP),HLFS,11)=HLQ
QUIT
+166 SET ZCTSQ=ZCTSQ+1
SET $PIECE(ZCTARY(ZCTTYP),HLFS,2)=ZCTSQ
+167 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=ZCTARY(ZCTTYP)
End DoDot:1
+168 IF ZCTSQ=0
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=ZCTARY(1)
+169 ;
+170 ; create (ZEM) Employment Info. segment for (1) Patient & (2) Spouse
+171 ;*168 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7")
+172 ;*168 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7",2,2)
+173 ;re-enable imprecise date.
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,9")
+174 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,9",2,2)
+175 ;
+176 ; create (ZGD) Guardian segment for (1) VA & (2) Civil
+177 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",1)
+178 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",2)
+179 ;
+180 ; Income Year requiring transmission from IVM Patient File (301.5)
+181 SET IVMIY=$SELECT($DATA(IVMIY):IVMIY,1:(IVMMTDT-10000))
+182 NEW MTINFO
SET MTINFO=$$FUT^DGMTU(DFN)
+183 IF ($EXTRACT(IVMIY,1,3)+1)=$EXTRACT($PIECE(MTINFO,U,2),1,3)
SET IVMMTDT=$PIECE(MTINFO,U,2)
+184 ;get the primary test for the income year
+185 SET TESTTYPE=$$GETTYPE^IVMPTRN9(DFN,IVMMTDT,.TESTCODE,.HARDSHIP,.ACTVIEN)
+186 ;
+187 ; The following function call returns:
+188 ; - Patient Relation IEN array in DGREL
+189 ; - Individual Annual Income IEN array in DGINC
+190 ; - Income Relation IEN array in DGINR
+191 DO ALL^DGMTU21(DFN,"VSC",IVMMTDT,"IPR",ACTVIEN)
+192 ;
+193 SET EDBMTZ06=0
IF $$VERZ06^EASPTRN1(DFN)
SET EDBMTZ06=1
+194 ; create (ZIC) Income segment for veteran
+195 SET IVMCT=IVMCT+1
+196 ;IVM*2.0*115 -- Check for Means Test Version Indicator
+197 NEW MTVERS
SET MTVERS=$SELECT(+$GET(ACTVIEN):+$PIECE($GET(^DGMT(408.31,ACTVIEN,2)),"^",11),1:0)
+198 IF MTVERS=0
Begin DoDot:1
+199 SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIC(+$GET(DGINC("V")),"1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20")
End DoDot:1
IF 1
+200 IF '$TEST
Begin DoDot:1
+201 SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIC(+$GET(DGINC("V")),"1,2,3,9,12,13,14,15,16,18,19")
End DoDot:1
+202 IF EDBMTZ06
SET ^TMP("HLS",$JOB,IVMCT)="ZIC^"_$PIECE(^TMP("HLS",$JOB,IVMCT),"^",2,3)
+203 ;use IVMIY not IVMMTDT. For LTC copay exemption, IVMMTDT is not correct
+204 SET $PIECE(^TMP("HLS",$JOB,IVMCT),"^",3)=$$HLDATE^HLFNC(IVMIY)
+205 ;
+206 ; create (ZIR) Income Relation segment for veteran
+207 ;IVM * 2.0 *160
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIR(+$GET(DGINR("V")),"1,2,3,4,5,10,15")
+208 IF EDBMTZ06
SET ^TMP("HLS",$JOB,IVMCT)="ZIR^1"
+209 ;
+210 ; create (ZDP) Patient Dependent Info. segment for spouse
+211 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZDP(+$GET(DGREL("S")),"1,2,3,4,5,6,7,8,9,10,13,14")
+212 ;I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
+213 ;. ; - pass non-existent SSNs as 0s
+214 ;. S $P(X,HLFS,6)="000000000"
+215 ;
+216 ; create (ZIC) Income segment for spouse
+217 SET IVMCT=IVMCT+1
+218 ;IVM*2.0*115
+219 IF MTVERS=0
Begin DoDot:1
+220 SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIC(+$GET(DGINC("S")),"1,2,3,4,5,6,7,8,9,10,11,12,16,17,18,19,20")
End DoDot:1
IF 1
+221 IF '$TEST
Begin DoDot:1
+222 SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIC(+$GET(DGINC("S")),"1,2,3,9,12,16,18,19")
End DoDot:1
+223 IF EDBMTZ06
SET ^TMP("HLS",$JOB,IVMCT)="ZIC^"_$PIECE(^TMP("HLS",$JOB,IVMCT),"^",2,3)
+224 ;
+225 ; create (ZIR) Income Relation segment for spouse
+226 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIR(+$GET(DGINR("S")),"1,2,3")
+227 IF EDBMTZ06
SET ^TMP("HLS",$JOB,IVMCT)="ZIR^"_$PIECE(^TMP("HLS",$JOB,IVMCT),"^",2)
+228 ;
+229 ;
+230 ; create ZDP, ZIC, and ZIR segments for all Means Test dependents
+231 FOR IVMSUB=0:0
SET IVMSUB=$ORDER(DGREL("C",IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:1
+232 ;
+233 ; - create (ZDP) Dependent Info. segment for dependent child
+234 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZDP(+$GET(DGREL("C",IVMSUB)),"1,2,3,4,5,6,7,9,10")
+235 ; I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
+236 ; . ; - pass non-existent SSNs as 0s
+237 ; . S $P(X,HLFS,6)="000000000"
+238 ;
+239 ; - create (ZIC) Income segment for dependent child
+240 SET IVMCT=IVMCT+1
+241 ;IVM*2.0*115
+242 IF MTVERS=0
Begin DoDot:2
+243 SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIC(+$GET(DGINC("C",IVMSUB)),"1,2,3,4,5,6,7,8,9,10,11,12,15")
End DoDot:2
IF 1
+244 IF '$TEST
Begin DoDot:2
+245 SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIC(+$GET(DGINC("C",IVMSUB)),"1,2,3,9,12,15,16,18,19")
End DoDot:2
+246 IF EDBMTZ06
SET ^TMP("HLS",$JOB,IVMCT)="ZIC^"_$PIECE(^TMP("HLS",$JOB,IVMCT),"^",2,3)
+247 ;
+248 ; - create (ZIR) Income Relation segment for dependent child
+249 ;IVM * 2.0 *160
SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZIR(+$GET(DGINR("C",IVMSUB)),"1,2,3,4,6,7,8,9,14,15")
+250 IF EDBMTZ06
SET ^TMP("HLS",$JOB,IVMCT)="ZIR^"_$PIECE(^TMP("HLS",$JOB,IVMCT),"^",2)
+251 ;
End DoDot:1
+252 ; Send INACTIVE spouse/dependents.
+253 DO GETINACD^DGMTU11(DFN,.DGREL)
+254 FOR I="S","C"
Begin DoDot:1
+255 FOR IVMSUB=0:0
SET IVMSUB=$ORDER(DGIREL(I,IVMSUB))
if 'IVMSUB
QUIT
Begin DoDot:2
+256 SET IVMCT=IVMCT+1
SET ^TMP("HLS",$JOB,IVMCT)=$$EN^VAFHLZDP(+$GET(DGIREL(I,IVMSUB)),"1,2,3,4,5,6,7,9,10,11",,,$PIECE(DGIREL(I,IVMSUB),U,3))
End DoDot:2
End DoDot:1
+257 ;
+258 DO GOTO^IVMPTRN9
+259 QUIT
+260 ;
STRIP11 NEW APID,ZPID,ASQ,ATYP,SSQ
+1 ;Extract PID segment
+2 SET IVMPID(1)=$EXTRACT(IVMPID(1),5,$LENGTH(IVMPID(1)))
+3 DO BLDPID^IVMPREC6(.IVMPID,.APID)
+4 ;
+5 SET CAFLG=0
+6 IF $DATA(APID(11))
Begin DoDot:1
+7 IF $ORDER(APID(11,""))
Begin DoDot:2
+8 MERGE ZPID(11)=APID(11)
KILL APID(11)
+9 SET (ASQ,SSQ)=0
FOR
SET ASQ=$ORDER(ZPID(11,ASQ))
if ASQ=""
QUIT
Begin DoDot:3
+10 SET ATYP=$PIECE($GET(ZPID(11,ASQ)),$EXTRACT(HLECH),7)
if ATYP=""
QUIT
+11 ;KUM - IVM*2.0*164 - Comment below 2 lines and Add line to enable all categories of Confidential Address
+12 ;I (ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") Q
+13 ;I ATYP="VACAE" S CAFLG=1
+14 IF (ATYP="VACAE")!(ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO")
SET CAFLG=1
+15 IF (CAFLG=1)
SET IVMZAVA("CNF")=""
+16 IF (ATYP="P")
SET IVMZAVA("P")=""
+17 IF (ATYP="R")
SET IVMZAVA("R")=""
+18 SET SSQ=SSQ+1
SET APID(11,SSQ)=ZPID(11,ASQ)
End DoDot:3
End DoDot:2
QUIT
+19 if $GET(APID(11))=""
QUIT
+20 SET ATYP=$PIECE($GET(APID(11)),$EXTRACT(HLECH),7)
if ATYP=""
QUIT
+21 ;KUM - IVM*2.0*164 - Comment below 2 lines and Add line to enable all categories of Confidential Address
+22 ;I ATYP="VACAE" S CAFLG=1 Q
+23 ;I (ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") K APID(11)
+24 IF (ATYP="VACAE")!(ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO")
SET CAFLG=1
QUIT
End DoDot:1
+25 ;
+26 IF 'CAFLG
IF $DATA(APID(13))
Begin DoDot:1
+27 IF $ORDER(APID(13,""))
Begin DoDot:2
+28 SET ASQ=0
FOR
SET ASQ=$ORDER(APID(13,ASQ))
if ASQ=""
QUIT
Begin DoDot:3
+29 if $GET(APID(13,ASQ))=""
QUIT
+30 SET ATYP=$PIECE($GET(APID(13,ASQ)),$EXTRACT(HLECH),2)
if ATYP=""
QUIT
+31 IF ATYP="VACPN"
KILL APID(13,ASQ)
QUIT
End DoDot:3
End DoDot:2
QUIT
+32 if $GET(APID(13))=""
QUIT
+33 SET ATYP=$PIECE($GET(APID(13)),$EXTRACT(HLECH),2)
if ATYP=""
QUIT
+34 IF ATYP="VACPN"
KILL APID(13)
QUIT
End DoDot:1
+35 ;
+36 ;Rebuild PID
+37 DO KVA^VADPT
+38 DO MAKEIT^VAFHLU("PID",.APID,.VAFPID,.VAFPID)
+39 SET VAFPID(0)=VAFPID
+40 QUIT
