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

VAFHLZTA.m

Go to the documentation of this file.
  1. VAFHLZTA ;ALB/ESD,TDM,KUM - Creation of ZTA segment ;7/18/24 4:29PM
  1. ;;5.3;Registration;**68,653,688,806,1121**;Aug 13, 1993;Build 14
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; This generic extrinsic function returns the HL7 VA-Specific Temporary Address (ZTA) segment.
  1. ;
  1. ;
  1. EN(DFN,VAFSTR,VAFNUM,HL) ; Returns HL7 ZTA segment containing temporary address
  1. ; data.
  1. ;
  1. ; Input - DFN as internal entry number of the PATIENT file
  1. ; VAFSTR as string of fields requested separated by commas.
  1. ; VAFNUM as SetId - set to 1.
  1. ; HL *** NOT USED, WILL BE REMOVED AT A LATER TIME ***
  1. ;
  1. ; Output - string of components forming the ZTA segment.
  1. ;
  1. N VAFNODE,VAFY,X,X1
  1. N COMP,HLES,VAFNODE1,HL7STRG,SQ5,CNTRY
  1. I '$G(DFN)!($G(VAFSTR)']"") G QUIT
  1. I $G(HLFS)="" N HLFS S HLFS="^"
  1. I $G(HL("FS"))="" S HL("FS")=HLFS
  1. I $G(HLQ)="" N HLQ S HLQ=""""""
  1. I $G(HLECH)="" N HLECH S HLECH="~|\&"
  1. I $G(HL("ECH"))="" S HL("ECH")=HLECH
  1. S COMP=$E(HLECH,1),HLES=$E(HLECH,3)
  1. S VAFNODE=$G(^DPT(DFN,.121)),VAFNODE1=$G(^DPT(DFN,.122))
  1. S $P(VAFY,HLFS,9)="",VAFSTR=","_VAFSTR_","
  1. S $P(VAFY,HLFS,1)=1 ; SetId equal to 1
  1. I VAFSTR[",2," S X=$P(VAFNODE,"^",9),$P(VAFY,HLFS,2)=$$YN^VAFHLFNC(X) ; Temporary Address Enter/Edit?
  1. I VAFSTR[",3," S X=$$HLDATE^HLFNC($P(VAFNODE,"^",7)),$P(VAFY,HLFS,3)=$S(X]"":X,1:HLQ) ; Temporary Address Start Date
  1. I VAFSTR[",4," S X=$$HLDATE^HLFNC($P(VAFNODE,"^",8)),$P(VAFY,HLFS,4)=$S(X]"":X,1:HLQ) ; Temporary Address End Date
  1. I VAFSTR[",5," D
  1. . K HL7STRG S HL7STRG=$P(VAFNODE,"^",1) D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S SQ5=$S(HL7STRG="":HLQ,1:HL7STRG)
  1. . K HL7STRG S HL7STRG=$P(VAFNODE,"^",2) D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S $P(SQ5,COMP,2)=$S(HL7STRG="":HLQ,1:HL7STRG)
  1. . K HL7STRG S HL7STRG=$P(VAFNODE,"^",3) D HL7TXT^VAFCQRY1(.HL7STRG,.HL,HLES) S $P(SQ5,COMP,8)=$S(HL7STRG="":HLQ,1:HL7STRG)
  1. . S CNTRY=$$GET1^DIQ(2,DFN_",",.1223) ;RETURN EXTERNAL VALUE
  1. . I CNTRY="US" S CNTRY="USA"
  1. . K HL7STRG S HL7STRG=$P(VAFNODE,"^",4),$P(SQ5,COMP,3)=$S(HL7STRG="":HLQ,1:HL7STRG)
  1. . I CNTRY=""!(CNTRY="USA") D ;have USA address
  1. . . S X=$$GET1^DIQ(5,+$P(VAFNODE,"^",5)_",",1),$P(SQ5,COMP,4)=$S(X="":HLQ,1:X)
  1. . . S X=$P(VAFNODE,"^",12),$P(SQ5,COMP,5)=$S(X="":HLQ,1:X)
  1. . I CNTRY'="",(CNTRY'="USA") D ;Check for foreign address fields
  1. . . S X=$P(VAFNODE1,"^",1),$P(SQ5,COMP,4)=$S(X="":HLQ,1:X)
  1. . . S X=$P(VAFNODE1,"^",2),$P(SQ5,COMP,5)=$S(X="":HLQ,1:X)
  1. . S $P(SQ5,COMP,6)=$S(CNTRY="":HLQ,1:CNTRY)
  1. . S X=$$GET1^DIQ(2,DFN_",",.12111),$P(SQ5,COMP,9)=$S(X="":HLQ,1:X)
  1. . S $P(VAFY,HLFS,5)=SQ5
  1. I VAFSTR[",6," S X=$$GET1^DIQ(2,DFN_",",.12111),$P(VAFY,HLFS,6)=$S(X="":HLQ,1:X)
  1. I VAFSTR[",7," S X=$$HLPHONE^HLFNC($P(VAFNODE,"^",10)),$P(VAFY,HLFS,7)=$S(X]"":X,1:HLQ) ; Temporary Address Phone
  1. I VAFSTR[",8," S X=$$HLDATE^HLFNC($P(VAFNODE,"^",13)),$P(VAFY,HLFS,8)=$S(X]"":X,1:HLQ) ; Temp Addr Last Updated
  1. I VAFSTR[",9," D ; Temp Addr Site of Change
  1. . S X=$P(VAFNODE,"^",14),X=$$GET1^DIQ(4,(+X)_",",99)
  1. . S $P(VAFY,HLFS,9)=$S(X]"":X,1:HLQ)
  1. ;DG*5.3*1121 - Accommodate country code, area code, phone number and extension in Sequence number 10
  1. I VAFSTR[",10," D
  1. . S X=$P(VAFNODE,"^",10)
  1. . I X]"" D
  1. . . N DGINTPH,DGEXT,DGEXT2,DGCNTRY,DGAREA,DGPH
  1. . . S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. . . S COMP="~" S DGEXT="" S DGEXT2="" S DGAREA="" S DGPH=""
  1. . . S DGEXT=$P(X,"X",2)
  1. . . S DGEXT=$$CONVPHAN^VAFCQRY3(DGEXT)
  1. . . S DGEXT2=$$GET1^DIQ(2,DFN_",",.12117)
  1. . . S DGEXT2=$$CONVPHAN^VAFCQRY3(DGEXT2)
  1. . . I DGEXT2'="" S DGEXT=DGEXT2
  1. . . S DGEXT=$E(DGEXT,1,6)
  1. . . S DGCNTRY=$$GET1^DIQ(2,DFN_",",.12116,"I")
  1. . . S DGCNTRY=$$CONVPHAN^VAFCQRY3(DGCNTRY)
  1. . . I $G(DGCNTRY)="" S DGCNTRY=1
  1. . . S DGPH=$P(X,"X",1)
  1. . . S DGPH=$$CONVPHAN^VAFCQRY3(DGPH)
  1. . . S DGAREA=$E(DGPH,1,3)
  1. . . S DGPH=$E(DGPH,4,10)
  1. . . I DGPH="" S DGEXT="" S DGCNTRY="" S DGAREA=""
  1. . . S DGINTPH=DGCNTRY_COMP_DGAREA_COMP_DGPH_COMP_DGEXT
  1. . . S $P(VAFY,HLFS,10)=$S(DGINTPH]"":DGINTPH,1:HLQ)
  1. QUIT Q "ZTA"_HLFS_$G(VAFY)
  1. ;
  1. NUM(DGNUMBER,DGDIGIT,DGDEC) ; DG*5.3*1121 - Added new function NUM to determine if valid numeric value
  1. ;
  1. ; Input: DGNUMBER as data element to evaluate
  1. ; DGDIGIT as number of digits allowed
  1. ; DGDEC as number of decimal places
  1. ;
  1. N DGERROR
  1. S DGERROR=0
  1. I DGNUMBER'?.N.1".".2N S DGERROR=1 G NUMQ
  1. I $L($P(DGNUMBER,".",1))>DGDIGIT S DGERROR=1 G NUMQ
  1. I DGNUMBER<0 S DGERROR=1
  1. NUMQ Q DGERROR
  1. ;