- 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 Feb 19, 2025@00:29:21 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