VAFHLZCE ;ALB/KUM - Create generic HL7 Community Care Program (ZCE) segments ;06/16/20 3:34PM
;;5.3;Registration;**1014**;Aug 13, 1993;Build 42
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
;Supported ICRs
; #2056 - $$GET1^DIQ(}
;
; This generic extrinsic function is designed to return the
; HL7 Community Care Program (ZCE) segment. This segment contains VA-specific
; Community Care Eligibility data for a patient.
;
EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS,VAFZCE) ; build HL7 ZCE segments.
; ZCE segments will be returned in the array VAFZCE.
;
; Input: DFN - Pointer to PATIENT file (#2)
; VAFSTR - String of fields requested separated by commas
; VAFNUM - (optional) sequential number for SET ID (default=1)
; VAFHLQ - (optional) HL7 null variable.
; VAFHLFS - (optional) HL7 field separator.
; .VAFZCE - Array to return segments in
;
;
; Output: VAFZCE(X) = ZCE segment (first 245 characters)
; VAFZCE(X,Y) = Remaining portion of ZCE segment in 245 character chunks
;
; Notes: VAFZCE is initialized (KILLed) on input.
;
N VAFHLZCE,VAFNUM,VAFMAXL,VAFIE1,DGFIDX,DGUPDT,DGREC
K VAFZCE
;
; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
S VAFHLQ=$S($D(VAFHLQ):VAFHLQ,1:$G(HLQ)),VAFHLFS=$S($D(VAFHLFS):VAFHLFS,1:$G(HLFS))
;
; if set id not passed, use default
S VAFNUM=$S($G(VAFNUM):VAFNUM,1:1)
;
S VAFMAXL=245
S VAFSTR=","_VAFSTR_","
; Do not create ZCE segment if Archive flag is 1
K DGTMP
M DGTMP(DFN,5)=^DPT(DFN,5)
S DGFIDX=0
F S DGFIDX=$O(DGTMP(DFN,5,DGFIDX)) Q:'DGFIDX S DGREC=$G(DGTMP(DFN,5,DGFIDX,0)) D ;
.I $P(DGREC,U,5)'=1 D
..S DGUPDT=$P(DGREC,U)
..S DGTMP("UPDT",DGUPDT,DGFIDX)=DGREC
; ZCE for approved requests
S DGUPDT=""
F S DGUPDT=$O(DGTMP("UPDT",DGUPDT)) Q:DGUPDT="" D
.S DGFIDX="" F S DGFIDX=$O(DGTMP("UPDT",DGUPDT,DGFIDX)) Q:DGFIDX="" D
..D GETDATA(DGFIDX),MAKESEG S VAFNUM=VAFNUM+1
..Q
.Q
Q
;
GETDATA(DGFIDX) ; Get information needed to build ZCE segment
; Input:
; DGFIDX = IEN of Subfile #2.191 Community Care Program
;
; Existence of the following variables is assumed
; DFN - Pointer to Patient (#2) file
; VAFSTR - Fields to extract (padded with commas)
; VAFNUM - Value to use for Set ID (optional)
; HL7 encoding characters (HLFS, HLENC, HLQ)
;
; Output: VAFHLZCE(SeqNum) = Value
;
; Notes: VAFHLZCE is initialized (KILLed) on entry
;
N VAFIEN,VAFPGM,VAFEFD,VAFEND,VAFCCD
K VAFHLZCE
S VAFIEN=DGFIDX_","_DFN_","
S VAFPGM=$$GET1^DIQ(2.191,VAFIEN,1,"I")
S VAFEFD=$$GET1^DIQ(2.191,VAFIEN,2,"I")
S VAFEND=$$GET1^DIQ(2.191,VAFIEN,3,"I")
S VAFCCD=$$GET1^DIQ(2.191,VAFIEN,.01,"I")
;
; set-up segment data fields
I VAFSTR[",1," S VAFHLZCE(1)=+$G(VAFNUM) ; Sequential ID
I VAFSTR[",2," S VAFHLZCE(2)=$S($G(VAFPGM)]"":$G(VAFPGM),1:VAFHLQ) ; Community Care Progarm Code
I VAFSTR[",3," S VAFHLZCE(3)=$S($G(VAFEFD)]"":$$HLDATE^HLFNC($G(VAFEFD),"DT"),1:VAFHLQ) ; Effective Date
I VAFSTR[",4," S VAFHLZCE(4)=$S($G(VAFEND)]"":$$HLDATE^HLFNC($G(VAFEND),"DT"),1:VAFHLQ) ; End Date
I VAFSTR[",5," S VAFHLZCE(5)=$S($G(VAFCCD)]"":$$HLDATE^HLFNC($G(VAFCCD),"TS"),1:VAFHLQ) ; Last Updated Date
;
Q
;
MAKESEG ; Create segment using obtained data
; Input: Existence of the following variables is assumed
; VAFNUM = Number denoting Xth repetition of the ZCE segment
; VAFMAXL = Maximum length of each node (defaults to 245)
; VAFHLZCE(SeqNum) = Value
; HL7 encoding characters (HLFS, HLECH)
;
; Output: VAFZCE(VAFNUM) = ZCE segment (first VAFMAXL characters)
; VAFZCE(VAFNUM,x) = Remaining portion of ZCE segment in VAFMAXL character chunks (if needed), beginning with a field separator
;
; Notes: VAFZCE(VAFNUM) is initialized (KILLed) on input. Fields will not be split across nodes in VAFZCE()
;
N VAFSEQ,VAFSPIL,VAFSPON,VAFSPOT,VAFLSEQ,VAFY
K VAFZCE(VAFNUM)
S VAFZCE(VAFNUM)="ZCE"
S:'+$G(VAFMAXL) VAFMAXL=245
S VAFY=$NA(VAFZCE(VAFNUM))
S (VAFSPIL,VAFSPON)=0
S VAFLSEQ=+$O(VAFHLZCE(""),-1)
F VAFSEQ=1:1:VAFLSEQ D
.; Make sure maximum length won't be exceeded
.I ($L(@VAFY)+$L($G(VAFHLZCE(VAFSEQ)))+1)>VAFMAXL D
..; Max length exceeded - start putting data on next node
..S VAFSPIL=VAFSPIL+1
..S VAFSPON=VAFSEQ-1
..S VAFY=$NA(VAFZCE(VAFNUM,VAFSPIL))
.; Add to string
.S VAFSPOT=(VAFSEQ+1)-VAFSPON
.S $P(@VAFY,VAFHLFS,VAFSPOT)=$G(VAFHLZCE(VAFSEQ))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZCE 4498 printed Sep 23, 2025@20:39:13 Page 2
VAFHLZCE ;ALB/KUM - Create generic HL7 Community Care Program (ZCE) segments ;06/16/20 3:34PM
+1 ;;5.3;Registration;**1014**;Aug 13, 1993;Build 42
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
+5 ;Supported ICRs
+6 ; #2056 - $$GET1^DIQ(}
+7 ;
+8 ; This generic extrinsic function is designed to return the
+9 ; HL7 Community Care Program (ZCE) segment. This segment contains VA-specific
+10 ; Community Care Eligibility data for a patient.
+11 ;
EN(DFN,VAFSTR,VAFNUM,VAFHLQ,VAFHLFS,VAFZCE) ; build HL7 ZCE segments.
+1 ; ZCE segments will be returned in the array VAFZCE.
+2 ;
+3 ; Input: DFN - Pointer to PATIENT file (#2)
+4 ; VAFSTR - String of fields requested separated by commas
+5 ; VAFNUM - (optional) sequential number for SET ID (default=1)
+6 ; VAFHLQ - (optional) HL7 null variable.
+7 ; VAFHLFS - (optional) HL7 field separator.
+8 ; .VAFZCE - Array to return segments in
+9 ;
+10 ;
+11 ; Output: VAFZCE(X) = ZCE segment (first 245 characters)
+12 ; VAFZCE(X,Y) = Remaining portion of ZCE segment in 245 character chunks
+13 ;
+14 ; Notes: VAFZCE is initialized (KILLed) on input.
+15 ;
+16 NEW VAFHLZCE,VAFNUM,VAFMAXL,VAFIE1,DGFIDX,DGUPDT,DGREC
+17 KILL VAFZCE
+18 ;
+19 ; if VAFHLQ or VAFHLFS not passed, use default HL7 variables
+20 SET VAFHLQ=$SELECT($DATA(VAFHLQ):VAFHLQ,1:$GET(HLQ))
SET VAFHLFS=$SELECT($DATA(VAFHLFS):VAFHLFS,1:$GET(HLFS))
+21 ;
+22 ; if set id not passed, use default
+23 SET VAFNUM=$SELECT($GET(VAFNUM):VAFNUM,1:1)
+24 ;
+25 SET VAFMAXL=245
+26 SET VAFSTR=","_VAFSTR_","
+27 ; Do not create ZCE segment if Archive flag is 1
+28 KILL DGTMP
+29 MERGE DGTMP(DFN,5)=^DPT(DFN,5)
+30 SET DGFIDX=0
+31 ;
FOR
SET DGFIDX=$ORDER(DGTMP(DFN,5,DGFIDX))
if 'DGFIDX
QUIT
SET DGREC=$GET(DGTMP(DFN,5,DGFIDX,0))
Begin DoDot:1
+32 IF $PIECE(DGREC,U,5)'=1
Begin DoDot:2
+33 SET DGUPDT=$PIECE(DGREC,U)
+34 SET DGTMP("UPDT",DGUPDT,DGFIDX)=DGREC
End DoDot:2
End DoDot:1
+35 ; ZCE for approved requests
+36 SET DGUPDT=""
+37 FOR
SET DGUPDT=$ORDER(DGTMP("UPDT",DGUPDT))
if DGUPDT=""
QUIT
Begin DoDot:1
+38 SET DGFIDX=""
FOR
SET DGFIDX=$ORDER(DGTMP("UPDT",DGUPDT,DGFIDX))
if DGFIDX=""
QUIT
Begin DoDot:2
+39 DO GETDATA(DGFIDX)
DO MAKESEG
SET VAFNUM=VAFNUM+1
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 QUIT
+43 ;
GETDATA(DGFIDX) ; Get information needed to build ZCE segment
+1 ; Input:
+2 ; DGFIDX = IEN of Subfile #2.191 Community Care Program
+3 ;
+4 ; Existence of the following variables is assumed
+5 ; DFN - Pointer to Patient (#2) file
+6 ; VAFSTR - Fields to extract (padded with commas)
+7 ; VAFNUM - Value to use for Set ID (optional)
+8 ; HL7 encoding characters (HLFS, HLENC, HLQ)
+9 ;
+10 ; Output: VAFHLZCE(SeqNum) = Value
+11 ;
+12 ; Notes: VAFHLZCE is initialized (KILLed) on entry
+13 ;
+14 NEW VAFIEN,VAFPGM,VAFEFD,VAFEND,VAFCCD
+15 KILL VAFHLZCE
+16 SET VAFIEN=DGFIDX_","_DFN_","
+17 SET VAFPGM=$$GET1^DIQ(2.191,VAFIEN,1,"I")
+18 SET VAFEFD=$$GET1^DIQ(2.191,VAFIEN,2,"I")
+19 SET VAFEND=$$GET1^DIQ(2.191,VAFIEN,3,"I")
+20 SET VAFCCD=$$GET1^DIQ(2.191,VAFIEN,.01,"I")
+21 ;
+22 ; set-up segment data fields
+23 ; Sequential ID
IF VAFSTR[",1,"
SET VAFHLZCE(1)=+$GET(VAFNUM)
+24 ; Community Care Progarm Code
IF VAFSTR[",2,"
SET VAFHLZCE(2)=$SELECT($GET(VAFPGM)]"":$GET(VAFPGM),1:VAFHLQ)
+25 ; Effective Date
IF VAFSTR[",3,"
SET VAFHLZCE(3)=$SELECT($GET(VAFEFD)]"":$$HLDATE^HLFNC($GET(VAFEFD),"DT"),1:VAFHLQ)
+26 ; End Date
IF VAFSTR[",4,"
SET VAFHLZCE(4)=$SELECT($GET(VAFEND)]"":$$HLDATE^HLFNC($GET(VAFEND),"DT"),1:VAFHLQ)
+27 ; Last Updated Date
IF VAFSTR[",5,"
SET VAFHLZCE(5)=$SELECT($GET(VAFCCD)]"":$$HLDATE^HLFNC($GET(VAFCCD),"TS"),1:VAFHLQ)
+28 ;
+29 QUIT
+30 ;
MAKESEG ; Create segment using obtained data
+1 ; Input: Existence of the following variables is assumed
+2 ; VAFNUM = Number denoting Xth repetition of the ZCE segment
+3 ; VAFMAXL = Maximum length of each node (defaults to 245)
+4 ; VAFHLZCE(SeqNum) = Value
+5 ; HL7 encoding characters (HLFS, HLECH)
+6 ;
+7 ; Output: VAFZCE(VAFNUM) = ZCE segment (first VAFMAXL characters)
+8 ; VAFZCE(VAFNUM,x) = Remaining portion of ZCE segment in VAFMAXL character chunks (if needed), beginning with a field separator
+9 ;
+10 ; Notes: VAFZCE(VAFNUM) is initialized (KILLed) on input. Fields will not be split across nodes in VAFZCE()
+11 ;
+12 NEW VAFSEQ,VAFSPIL,VAFSPON,VAFSPOT,VAFLSEQ,VAFY
+13 KILL VAFZCE(VAFNUM)
+14 SET VAFZCE(VAFNUM)="ZCE"
+15 if '+$GET(VAFMAXL)
SET VAFMAXL=245
+16 SET VAFY=$NAME(VAFZCE(VAFNUM))
+17 SET (VAFSPIL,VAFSPON)=0
+18 SET VAFLSEQ=+$ORDER(VAFHLZCE(""),-1)
+19 FOR VAFSEQ=1:1:VAFLSEQ
Begin DoDot:1
+20 ; Make sure maximum length won't be exceeded
+21 IF ($LENGTH(@VAFY)+$LENGTH($GET(VAFHLZCE(VAFSEQ)))+1)>VAFMAXL
Begin DoDot:2
+22 ; Max length exceeded - start putting data on next node
+23 SET VAFSPIL=VAFSPIL+1
+24 SET VAFSPON=VAFSEQ-1
+25 SET VAFY=$NAME(VAFZCE(VAFNUM,VAFSPIL))
End DoDot:2
+26 ; Add to string
+27 SET VAFSPOT=(VAFSEQ+1)-VAFSPON
+28 SET $PIECE(@VAFY,VAFHLFS,VAFSPOT)=$GET(VAFHLZCE(VAFSEQ))
End DoDot:1
+29 QUIT
