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

IVMPTRN8.m

Go to the documentation of this file. 
  1. IVMPTRN8 ;ALB/RKS,PDJ,BRM,TDM,PJH,TDM,PWC,LBD,DRP,DJS,KUM - HL7 FULL DATA TRANSMISSION (Z07) BUILDER ;7/18/24 9:13AM
  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,215**;21-OCT-94;Build 14
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; *164* #858271 - Sending ZAV Segment with CASS field value for all Address types 
  1.  ;
  1.  ; Reference to $$EN^VAFHLZCE in ICR #7185
  1.  ;
  1. BUILD(DFN,IVMMTDT,IVMCT,IVMQUERY) ; --
  1.  ;  Description: This entry point will be used to create an HL7 
  1.  ;  "Full Data Transmission" message for a patient.
  1.  ;
  1.  ;  Input:
  1.  ;        DFN - Patient IEN
  1.  ;    IVMMTDT - date of the patient's Means Test or Copay Test
  1.  ;      IVMCT - count of hl7 segments transmitted, pass by reference
  1.  ;   IVMQUERY - array passed in by reference where
  1.  ;    IVMQUERY("LTD") -- # of the QUERY that is currently open or
  1.  ;                undefined, zero, or null if no QUERY opened for
  1.  ;                last treatment date
  1.  ;    IVMQUERY("OVIS") -- # of the QUERY that is currently open or
  1.  ;                undefined, zero, or null if no QUERY opened for
  1.  ;                finding outpatient visits
  1.  ;
  1.  ;  HL7 variables as defined by call to INIT^IVMUFNC:
  1.  ;      HLEVN - HL7 message event counter 
  1.  ;      HLSDT - a flag that indicates that the data to be sent is
  1.  ;              stored in the ^TMP("HLS") global array.
  1.  ;
  1.  ;  The following variables returned by the INIT^HLTRANS entry point:
  1.  ;    HLNDAP - Non-DHCP Application Pointer from file 770
  1.  ;   HLNDAP0 - Zero node from file 770 corresponding to HLNDAP
  1.  ;     HLDAP - DHCP Application Pointer from file 771
  1.  ;     HLDAN - The DHCP Application Name (.01 field, file 771) for HLDAP
  1.  ;     HLPID - HL7 processing ID from file 770
  1.  ;     HLVER - HL7 version number from file 770
  1.  ;      HLFS - HL7 Field Separator from the 'FS' node of file 771
  1.  ;     HLECH - HL7 Encoding Characters from the 'EC' node of file 771
  1.  ;       HLQ - Double quotes ("") for use in building HL7 segments
  1.  ;     HLERR - if an error is encountered, an error message is returned
  1.  ;             in the HLERR variable.
  1.  ;      HLDA - the internal entry number for the entry created in
  1.  ;             file #772.
  1.  ;      HLDT - transmission date/time (associated with the entry in file
  1.  ;             #772 identified by HLDA) in internal VA FileMan format.
  1.  ;     HLDT1 - the same transmission date/time as the HLDT variable, 
  1.  ;             only in HL7 format.
  1.  ;
  1.  ; Output:
  1.  ;  ^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.
  1.  ;
  1.  ;
  1.  N DGINC,DGINR,DGREL,I,IVMNTE,IVMPID,IVMSUB,IVMSUB1,IVMZRD,IVMZAV,VAFPID,VAFZEL,FBZFE,IVMZCD,DELETE,NODE,IVMPIEN,TEST,IVMPNODE,TESTTYPE,SEQS,TESTCODE
  1.  N HARDSHIP,ACTVIEN,IVMZMH,IVMSEQ,EDBMTZ06,ZMHSQ,SETID,OBXCNT,OBXTMP,DGSEC,SEGOCC,ZIOSEG,N101015,RF1SEG,ZCTTYP,ZCTARY,ZCTSQ,VAFPID,CAFLG,IVMZAVA,VAFZTE
  1.  N ERROR,VAFZCE
  1.  S IVMZAVA=""
  1.  ;
  1.  ; create (PID) Patient Identification segment
  1.  ; **** Add ICN to 2nd piece PID segment for MPI@HEC.
  1.  S IVMCMOR="1,2",IVMSEQ=1
  1.  ; check to see if site is a legacy site.  If not add ICN to PID segment.
  1.  I '$D(^PPP(1020.128,"AC",$P($$SITE^VASITE,"^",3))) D
  1.  . I +$$GETICN^MPIF001(DFN)>0,($$IFLOCAL^MPIF001(DFN)=0) S IVMSEQ=IVMSEQ_",2",IVMCMOR="1,2,3"  ;add SEQ 1 and 2 for PID
  1.  ;
  1.  ; send SSN indicating pseudo
  1.  ; I $P(IVMPID_$G(IVMPID(1)),HLFS,20)["P" D PSEUDO^IVMPTRN1  ; strip 'P' from pseudo SSNs
  1.  S IVMSEQ=IVMSEQ_",3,5,6,7,8,10,11,12,13,14,16,17,19,22,24"
  1.  K IVMPID D BLDPID^VAFCQRY1(DFN,1,IVMSEQ,.IVMPID,.HL,.ERROR)
  1.  K VAFPID D STRIP11
  1.  S SEGOCC="" F  S SEGOCC=$O(VAFPID(SEGOCC)) Q:SEGOCC=""  D
  1.  . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=VAFPID(SEGOCC)
  1.  ;
  1.  ; **** create (PD1) Patient CMOR segment for MPI@HEC.
  1.  S:'$D(HL("FS")) HL("FS")=HLFS
  1.  S:'$D(HL("ECH")) HL("ECH")=HLECH
  1.  S:'$D(HL("Q")) HL("Q")=HLQ
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLPD1(DFN,IVMCMOR)
  1.  ;
  1.  ; create (ZPD) Patient Dependent Info. segment
  1.  ; IVM*2.0*210 - Add sequence 46, 47 for Preferred Language and Preferred Language Date/Time
  1.  ; IVM*2.0*203 - Add Sequence 42 to 45 for Indian attestation information
  1.  ; Sequence 41 is added to fill in gap of unused field
  1.  ;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)
  1.  ;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)
  1.  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)
  1.  ; 
  1.  I $D(VAFZPD(1)) S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=VAFZPD(1) K VAFZPD(1)
  1.  ;
  1.  ; create (ZTA) Temporary Address segment
  1.  ;IVM*2.0*215 - Add Temporary phone components in TEMPORARY ADDRESS INTERNATIONAL PHONE (Sequence 10)
  1.  ;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZTA(DFN,"1,2,3,4,5,6,7,8,9",,.HL)
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZTA(DFN,"1,2,3,4,5,6,7,8,9,10",,.HL)
  1.  ; KUM IVM*2.0*164 - Set Flag to determine if Temporary address is in Message
  1.  I $TR($P(^TMP("HLS",$J,IVMCT),HLFS,6),"~""""^","")'="" S IVMZAVA("C")=""
  1.  ;
  1.  ; KUM - IVM*2.0*164 - Send CASS field value for all Address Types
  1.  ; create (ZAV) Rated Disabilities segment(s)
  1.  D EN^VAFHLZAV(DFN,"1,2,3,",HLQ,HLFS,.IVMZAV,.IVMZAVA)
  1.  F IVMSUB=0:0 S IVMSUB=+$O(IVMZAV("HL7",IVMSUB)) Q:'IVMSUB  D
  1.  . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZAV("HL7",+IVMSUB))
  1.  ;
  1.  ; create (ZIE) Ineligible segment
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIE(DFN,"1,2,3",1)
  1.  ;
  1.  ; create (ZEL) Eligibility segment(s) 
  1.  ; **** Add 5th piece to ZEL to correct consistency check
  1.  ; added 41-44 for CLV IVM*2.0*161
  1.  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)
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(1))  ; Primary Eligibility
  1.  I $D(VAFZEL(1,1)) S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(1,1))
  1.  ; - other entitled eligibilities
  1.  F IVMSUB=1:0 S IVMSUB=+$O(VAFZEL(IVMSUB)) Q:'IVMSUB  D
  1.  . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZEL(+IVMSUB))
  1.  ;
  1.  ; create ZE2 segment (Optional)
  1.  I $P($G(^DPT(DFN,.385)),U)'="" S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZE2(DFN,"1,2")
  1.  ;
  1.  ; IVM*2.0*208 - Create ZHF segment (Optional)
  1.  I $$GET1^DIQ(2,DFN_",",.5601)'="" S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZHF(DFN,"1,2,3,4,5",HLQ,HLFS)
  1.  ;
  1.  ; create ZTE segments (optional)
  1.  D EN^VAFHLZTE(DFN,"1,2,3,4,5,6,7,8,9,10,11,12,13",0,.VAFZTE)
  1.  S IVMSUB=0 F  S IVMSUB=$O(VAFZTE(IVMSUB)) Q:'IVMSUB  D
  1.  .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZTE(IVMSUB))
  1.  .S IVMSUB1=0 F  S IVMSUB1=$O(VAFZTE(IVMSUB,IVMSUB1)) Q:'IVMSUB1  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZTE(IVMSUB,IVMSUB1))
  1.  .Q
  1.  ;
  1.  ; KUM - IVM*2.0*194
  1.  ; create ZCE segments (optional)
  1.  D EN^VAFHLZCE(DFN,"1,2,3,4,5",,HLQ,HLFS,.VAFZCE)
  1.  S IVMSUB=0 F  S IVMSUB=$O(VAFZCE(IVMSUB)) Q:'IVMSUB  D
  1.  .S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZCE(IVMSUB))
  1.  .S IVMSUB1=0 F  S IVMSUB1=$O(VAFZCE(IVMSUB,IVMSUB1)) Q:'IVMSUB1  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(VAFZCE(IVMSUB,IVMSUB1))
  1.  .Q
  1.  ;
  1.  ; create (ZEN) Enrollment segment
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEN(DFN)
  1.  ;
  1.  ; create (ZCD) Catastrophic Disability segment(s)
  1.  D BUILD^VAFHLZCD(.IVMZCD,DFN,,HLQ,HLFS)
  1.  F IVMSUB=0:0 S IVMSUB=+$O(IVMZCD(IVMSUB)) Q:'IVMSUB  D
  1.  . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZCD(+IVMSUB))
  1.  ;
  1.  ; Optionally create (ZMH) Military History segments
  1.  ; Pass "*" as parameter to send unlimited MSEs in Z07 (IVM*2*141)
  1.  D ENTER^VAFHLZMH(DFN,"IVMZMH","*")
  1.  ;DJS, Don't create ZMH segment if array entry is an FDD MSE; IVM*2.0*167
  1.  N ZMHED,MSESUB,DONEMSE
  1.  S (ZMHSQ,SETID,DONEMSE)=0
  1.  I $D(IVMZMH) F  S ZMHSQ=$O(IVMZMH(ZMHSQ)) Q:ZMHSQ=""  D
  1.  . Q:$TR($P(IVMZMH(ZMHSQ,0),HLFS,4,5),"""^~")=""
  1.  . ;If no Service Entry Date, QUIT
  1.  . S ZMHED=$P(IVMZMH(ZMHSQ,0),U,5),ZMHED=$P(ZMHED,"~",1) Q:ZMHED=""
  1.  . S ZMHED=$$HL7TFM^XLFDT(ZMHED)
  1.  . ;Get MSE, if no more MSEs, process Conflict Information, if present
  1.  . I 'DONEMSE S MSESUB="",MSESUB=$O(^DPT(DFN,.3216,"B",ZMHED,MSESUB)) S:MSESUB="" DONEMSE=1
  1.  . ;Do not create ZMH segment if FDD MSE
  1.  . I 'DONEMSE,$P(^DPT(DFN,.3216,MSESUB,0),U,8)'="" Q  ;Only check for FDD if MSE entry
  1.  . S SETID=SETID+1,IVMCT=IVMCT+1
  1.  . S ^TMP("HLS",$J,IVMCT)="ZMH"_HLFS_SETID_HLFS_$P(IVMZMH(ZMHSQ,0),HLFS,3,6)
  1.  ;
  1.  ; create (ZRD) Rated Disabilities segment(s)
  1.  D EN^VAFHLZRD(DFN,"1,2,3,4,12,13,14,",HLQ,HLFS,"IVMZRD")
  1.  F IVMSUB=0:0 S IVMSUB=+$O(IVMZRD(IVMSUB)) Q:'IVMSUB  D
  1.  . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$G(IVMZRD(+IVMSUB,0))
  1.  ;
  1.  ; create (ZCT) Emergency Contact segment
  1.  ;S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10","",1,1)
  1.  K ZCTARY F ZCTTYP=1:1:5 D   ;Create Optional ZCT Segments
  1.  . ; IVM*2.0*204 - Add Sequence 11 for Relationship
  1.  . S ZCTARY(ZCTTYP)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10","",ZCTTYP,1)
  1.  . I $$NOW^XLFDT()>=$$GET^XPAR("PKG","DG PATCH DG*5.3*1067 ACTIVE",1) D
  1.  . . S ZCTARY(ZCTTYP)=$$EN^VAFHLZCT(DFN,"1,2,3,4,5,6,7,10,11","",ZCTTYP,1)
  1.  S (ZCTTYP,ZCTSQ)=0
  1.  I $D(ZCTARY) F  S ZCTTYP=$O(ZCTARY(ZCTTYP)) Q:ZCTTYP=""  D
  1.  . Q:$P(ZCTARY(ZCTTYP),HLFS,11)=HLQ
  1.  . S ZCTSQ=ZCTSQ+1,$P(ZCTARY(ZCTTYP),HLFS,2)=ZCTSQ
  1.  . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=ZCTARY(ZCTTYP)
  1.  I ZCTSQ=0 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=ZCTARY(1)
  1.  ;
  1.  ; create (ZEM) Employment Info. segment for (1) Patient & (2) Spouse
  1.  ;*168 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7")
  1.  ;*168 S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7",2,2)
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,9") ;re-enable imprecise date.
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZEM(DFN,"1,2,3,4,5,6,7,9",2,2)
  1.  ;
  1.  ; create (ZGD) Guardian segment for (1) VA & (2) Civil 
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",1)
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZGD(DFN,"1,2,3,4,5,6,7,8",2)
  1.  ;
  1.  ; Income Year requiring transmission from IVM Patient File (301.5)
  1.  S IVMIY=$S($D(IVMIY):IVMIY,1:(IVMMTDT-10000))
  1.  N MTINFO S MTINFO=$$FUT^DGMTU(DFN)
  1.  I ($E(IVMIY,1,3)+1)=$E($P(MTINFO,U,2),1,3) S IVMMTDT=$P(MTINFO,U,2)
  1.  ;get the primary test for the income year
  1.  S TESTTYPE=$$GETTYPE^IVMPTRN9(DFN,IVMMTDT,.TESTCODE,.HARDSHIP,.ACTVIEN)
  1.  ;
  1.  ; The following function call returns:
  1.  ;   - Patient Relation IEN array in DGREL
  1.  ;   - Individual Annual Income IEN array in DGINC
  1.  ;   - Income Relation IEN array in DGINR
  1.  D ALL^DGMTU21(DFN,"VSC",IVMMTDT,"IPR",ACTVIEN)
  1.  ;
  1.  S EDBMTZ06=0 I $$VERZ06^EASPTRN1(DFN) S EDBMTZ06=1
  1.  ; create (ZIC) Income segment for veteran
  1.  S IVMCT=IVMCT+1
  1.  ;IVM*2.0*115 -- Check for Means Test Version Indicator
  1.  N MTVERS S MTVERS=$S(+$G(ACTVIEN):+$P($G(^DGMT(408.31,ACTVIEN,2)),"^",11),1:0)
  1.  I MTVERS=0 D  I 1
  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")
  1.  E  D
  1.  . S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("V")),"1,2,3,9,12,13,14,15,16,18,19")
  1.  I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
  1.  ;use IVMIY not IVMMTDT. For LTC copay exemption, IVMMTDT is not correct
  1.  S $P(^TMP("HLS",$J,IVMCT),"^",3)=$$HLDATE^HLFNC(IVMIY)
  1.  ;
  1.  ; create (ZIR) Income Relation segment for veteran
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("V")),"1,2,3,4,5,10,15")  ;IVM * 2.0 *160
  1.  I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^1"
  1.  ;
  1.  ; create (ZDP) Patient Dependent Info. segment for spouse
  1.  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")
  1.  ;I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
  1.  ;. ; - pass non-existent SSNs as 0s
  1.  ;. S $P(X,HLFS,6)="000000000"
  1.  ;
  1.  ; create (ZIC) Income segment for spouse
  1.  S IVMCT=IVMCT+1
  1.  ;IVM*2.0*115
  1.  I MTVERS=0 D  I 1
  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")
  1.  E  D
  1.  . S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("S")),"1,2,3,9,12,16,18,19")
  1.  I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
  1.  ;
  1.  ; create (ZIR) Income Relation segment for spouse
  1.  S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIR(+$G(DGINR("S")),"1,2,3")
  1.  I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^"_$P(^TMP("HLS",$J,IVMCT),"^",2)
  1.  ;
  1.  ;
  1.  ; create ZDP, ZIC, and ZIR segments for all Means Test dependents
  1.  F IVMSUB=0:0 S IVMSUB=$O(DGREL("C",IVMSUB)) Q:'IVMSUB  D
  1.  . ;
  1.  . ; - create (ZDP) Dependent Info. segment for dependent child
  1.  . S IVMCT=IVMCT+1,^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZDP(+$G(DGREL("C",IVMSUB)),"1,2,3,4,5,6,7,9,10")
  1.  .; I $P(^TMP("HLS",$J,IVMCT),HLFS,3)'=HLQ,($P($G(^(IVMCT)),HLFS,6)=HLQ) D
  1.  .; . ; - pass non-existent SSNs as 0s
  1.  .; . S $P(X,HLFS,6)="000000000"
  1.  . ;
  1.  . ; - create (ZIC) Income segment for dependent child
  1.  . S IVMCT=IVMCT+1
  1.  . ;IVM*2.0*115
  1.  . I MTVERS=0 D  I 1
  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")
  1.  . E  D
  1.  . . S ^TMP("HLS",$J,IVMCT)=$$EN^VAFHLZIC(+$G(DGINC("C",IVMSUB)),"1,2,3,9,12,15,16,18,19")
  1.  . I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIC^"_$P(^TMP("HLS",$J,IVMCT),"^",2,3)
  1.  . ;
  1.  . ; - create (ZIR) Income Relation segment for dependent child
  1.  . 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
  1.  . I EDBMTZ06 S ^TMP("HLS",$J,IVMCT)="ZIR^"_$P(^TMP("HLS",$J,IVMCT),"^",2)
  1.  . ;
  1.  ; Send INACTIVE spouse/dependents.
  1.  D GETINACD^DGMTU11(DFN,.DGREL)
  1.  F I="S","C" D
  1.  . F IVMSUB=0:0 S IVMSUB=$O(DGIREL(I,IVMSUB)) Q:'IVMSUB  D
  1.  . . 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))
  1.  ;
  1.  D GOTO^IVMPTRN9
  1.  Q
  1.  ;
  1. STRIP11 N APID,ZPID,ASQ,ATYP,SSQ
  1.  ;Extract PID segment
  1.  S IVMPID(1)=$E(IVMPID(1),5,$L(IVMPID(1)))
  1.  D BLDPID^IVMPREC6(.IVMPID,.APID)
  1.  ;
  1.  S CAFLG=0
  1.  I $D(APID(11)) D
  1.  .I $O(APID(11,"")) D  Q
  1.  ..M ZPID(11)=APID(11) K APID(11)
  1.  ..S (ASQ,SSQ)=0 F  S ASQ=$O(ZPID(11,ASQ)) Q:ASQ=""  D
  1.  ...S ATYP=$P($G(ZPID(11,ASQ)),$E(HLECH),7) Q:ATYP=""
  1.  ...;KUM - IVM*2.0*164 - Comment below 2 lines and Add line to enable all categories of Confidential Address
  1.  ...;I (ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") Q
  1.  ...;I ATYP="VACAE" S CAFLG=1
  1.  ...I (ATYP="VACAE")!(ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") S CAFLG=1
  1.  ...I (CAFLG=1) S IVMZAVA("CNF")=""
  1.  ...I (ATYP="P") S IVMZAVA("P")=""
  1.  ...I (ATYP="R") S IVMZAVA("R")=""
  1.  ...S SSQ=SSQ+1,APID(11,SSQ)=ZPID(11,ASQ)
  1.  .Q:$G(APID(11))=""
  1.  .S ATYP=$P($G(APID(11)),$E(HLECH),7) Q:ATYP=""
  1.  .;KUM - IVM*2.0*164 - Comment below 2 lines and Add line to enable all categories of Confidential Address
  1.  .;I ATYP="VACAE" S CAFLG=1 Q
  1.  .;I (ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") K APID(11)
  1.  .I (ATYP="VACAE")!(ATYP="VACAA")!(ATYP="VACAC")!(ATYP="VACAM")!(ATYP="VACAO") S CAFLG=1 Q
  1.  ;
  1.  I 'CAFLG,$D(APID(13)) D
  1.  .I $O(APID(13,"")) D  Q
  1.  ..S ASQ=0 F  S ASQ=$O(APID(13,ASQ)) Q:ASQ=""  D
  1.  ...Q:$G(APID(13,ASQ))=""
  1.  ...S ATYP=$P($G(APID(13,ASQ)),$E(HLECH),2) Q:ATYP=""
  1.  ...I ATYP="VACPN" K APID(13,ASQ) Q
  1.  .Q:$G(APID(13))=""
  1.  .S ATYP=$P($G(APID(13)),$E(HLECH),2) Q:ATYP=""
  1.  .I ATYP="VACPN" K APID(13) Q
  1.  ;
  1.  ;Rebuild PID
  1.  D KVA^VADPT
  1.  D MAKEIT^VAFHLU("PID",.APID,.VAFPID,.VAFPID)
  1.  S VAFPID(0)=VAFPID
  1.  Q