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 Dec 13, 2024@03:03:16 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
