- VAFHLZAV ;ALB/KUM - Create HL7 ZAV segment ;11/26/17 3:34PM
- ;;5.3;Registration;**941**;Aug 13, 1993;Build 73
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; This generic extrinsic function is designed to return the
- ; HL7 ZAV segment(s).
- ;
- EN(DFN,VAFSTR,VAFHLQ,VAFHLFS,IVMZAV,IVMZAVA) ; --
- ; Entry point for creating HL7 ZAV segment.
- ;
- ;Variables Required to use this routine:
- ; HL - array that contains the necessary HL variables (init^hlsub)
- ;
- ; Input(s):
- ; DFN - internal entry number of Patient (#2) file
- ; VAFSTR - (optional) string of fields requested, separated by
- ; commas. If not passed, return all data fields.
- ; VAFHLQ - (optional) HL7 null variable.
- ; VAFHLFS - (optional) HL7 field separator.
- ;
- ; Output(s):
- ; IVMZAV() - array containing the HL7 ZAV segment(s)
- ;
- N VAFY,VAFHLSC,SUB,SUB1,SID,VAFHLC
- ;
- I VAFHLFS="" S VAFHLFS="^"
- S:($L(VAFHLFS)'=1) VAFHLFS="^"
- S VAFHLC=$G(VAFHLC) I VAFHLC="" S VAFHLC="~|\&"
- S:($L(VAFHLC)'=4) VAFHLC="~|\&"
- S:('$D(VAFHLQ)) VAFHLQ=$C(34,34)
- S VAFHLSC=$E(VAFHLC,1)
- ;
- ; if DFN not passed, exit
- I '$G(DFN) S VAFY=1 G ENQ
- ;
- ; if VAFSTR not passed, return all data fields
- ; Address Types - Permanent (P), Residential (R), Temporary (C), Confidential (CNF)
- I $G(VAFSTR)']"" S VAFSTR="1,2,3"
- ;
- ; initialize output string and requested data fields
- S $P(VAFY,VAFHLFS,2)="",VAFSTR=","_VAFSTR_","
- ;
- ; get Address Types from Patient (#2) file
- ; .1159 RESIDENTIAL ADDR CASS IND (S), [.115;19]
- ; .12115 TEMPORARY ADDR CASS IND (S), [.121;15]
- ; .123 STREET ADDRESS CASS IND (S), [.11;18]
- ; .14117 CONFIDENTIAL ADDR CASS IND (S), [.141;17]
- K ADT
- S SUB1=""
- F S SUB1=$O(IVMZAVA(SUB1)) Q:SUB1="" D
- .I SUB1="R" S ADT("R")=$$GET1^DIQ(2,DFN,".1159","I")
- .I SUB1="C" S ADT("C")=$$GET1^DIQ(2,DFN,".12115","I")
- .I SUB1="P" S ADT("P")=$$GET1^DIQ(2,DFN,".123","I")
- .I SUB1="CNF" S ADT("CNF")=$$GET1^DIQ(2,DFN,".14117","I")
- I $D(ADT) D
- .S SID=0
- .S SUB=""
- .F S SUB=$O(ADT(SUB)) Q:SUB="" D
- ..I $D(ADT(SUB)) D
- ...I VAFSTR[",1," S SID=SID+1,$P(VAFY,VAFHLFS)=SID ;Set ID
- ...I VAFSTR[",2," S $P(VAFY,VAFHLFS,2)=SUB ; Address Type
- ...I ADT(SUB)="" S ADT(SUB)="NC"
- ...I VAFSTR[",3," S $P(VAFY,VAFHLFS,3)=ADT(SUB) ;Address Validation Indicator
- ...S IVMZAV("HL7",SID)="ZAV"_VAFHLFS_VAFY
- ;
- ENQ Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFHLZAV 2360 printed Mar 13, 2025@22:07:57 Page 2
- VAFHLZAV ;ALB/KUM - Create HL7 ZAV segment ;11/26/17 3:34PM
- +1 ;;5.3;Registration;**941**;Aug 13, 1993;Build 73
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; This generic extrinsic function is designed to return the
- +5 ; HL7 ZAV segment(s).
- +6 ;
- EN(DFN,VAFSTR,VAFHLQ,VAFHLFS,IVMZAV,IVMZAVA) ; --
- +1 ; Entry point for creating HL7 ZAV segment.
- +2 ;
- +3 ;Variables Required to use this routine:
- +4 ; HL - array that contains the necessary HL variables (init^hlsub)
- +5 ;
- +6 ; Input(s):
- +7 ; DFN - internal entry number of Patient (#2) file
- +8 ; VAFSTR - (optional) string of fields requested, separated by
- +9 ; commas. If not passed, return all data fields.
- +10 ; VAFHLQ - (optional) HL7 null variable.
- +11 ; VAFHLFS - (optional) HL7 field separator.
- +12 ;
- +13 ; Output(s):
- +14 ; IVMZAV() - array containing the HL7 ZAV segment(s)
- +15 ;
- +16 NEW VAFY,VAFHLSC,SUB,SUB1,SID,VAFHLC
- +17 ;
- +18 IF VAFHLFS=""
- SET VAFHLFS="^"
- +19 if ($LENGTH(VAFHLFS)'=1)
- SET VAFHLFS="^"
- +20 SET VAFHLC=$GET(VAFHLC)
- IF VAFHLC=""
- SET VAFHLC="~|\&"
- +21 if ($LENGTH(VAFHLC)'=4)
- SET VAFHLC="~|\&"
- +22 if ('$DATA(VAFHLQ))
- SET VAFHLQ=$CHAR(34,34)
- +23 SET VAFHLSC=$EXTRACT(VAFHLC,1)
- +24 ;
- +25 ; if DFN not passed, exit
- +26 IF '$GET(DFN)
- SET VAFY=1
- GOTO ENQ
- +27 ;
- +28 ; if VAFSTR not passed, return all data fields
- +29 ; Address Types - Permanent (P), Residential (R), Temporary (C), Confidential (CNF)
- +30 IF $GET(VAFSTR)']""
- SET VAFSTR="1,2,3"
- +31 ;
- +32 ; initialize output string and requested data fields
- +33 SET $PIECE(VAFY,VAFHLFS,2)=""
- SET VAFSTR=","_VAFSTR_","
- +34 ;
- +35 ; get Address Types from Patient (#2) file
- +36 ; .1159 RESIDENTIAL ADDR CASS IND (S), [.115;19]
- +37 ; .12115 TEMPORARY ADDR CASS IND (S), [.121;15]
- +38 ; .123 STREET ADDRESS CASS IND (S), [.11;18]
- +39 ; .14117 CONFIDENTIAL ADDR CASS IND (S), [.141;17]
- +40 KILL ADT
- +41 SET SUB1=""
- +42 FOR
- SET SUB1=$ORDER(IVMZAVA(SUB1))
- if SUB1=""
- QUIT
- Begin DoDot:1
- +43 IF SUB1="R"
- SET ADT("R")=$$GET1^DIQ(2,DFN,".1159","I")
- +44 IF SUB1="C"
- SET ADT("C")=$$GET1^DIQ(2,DFN,".12115","I")
- +45 IF SUB1="P"
- SET ADT("P")=$$GET1^DIQ(2,DFN,".123","I")
- +46 IF SUB1="CNF"
- SET ADT("CNF")=$$GET1^DIQ(2,DFN,".14117","I")
- End DoDot:1
- +47 IF $DATA(ADT)
- Begin DoDot:1
- +48 SET SID=0
- +49 SET SUB=""
- +50 FOR
- SET SUB=$ORDER(ADT(SUB))
- if SUB=""
- QUIT
- Begin DoDot:2
- +51 IF $DATA(ADT(SUB))
- Begin DoDot:3
- +52 ;Set ID
- IF VAFSTR[",1,"
- SET SID=SID+1
- SET $PIECE(VAFY,VAFHLFS)=SID
- +53 ; Address Type
- IF VAFSTR[",2,"
- SET $PIECE(VAFY,VAFHLFS,2)=SUB
- +54 IF ADT(SUB)=""
- SET ADT(SUB)="NC"
- +55 ;Address Validation Indicator
- IF VAFSTR[",3,"
- SET $PIECE(VAFY,VAFHLFS,3)=ADT(SUB)
- +56 SET IVMZAV("HL7",SID)="ZAV"_VAFHLFS_VAFY
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +57 ;
- ENQ QUIT
