VDEFEL ;INTEGIC/YG & BPOIFO/JG- VDEF library functions; ; 21 Dec 2004 11:29 AM
;;1.00;VDEF;;Dec 17, 2004
;Per VHA Directive 2004-038, this routine should not be modified.
;
Q ; No bozos
;
; VDEF Library Subroutines.
;
SETDLMS ; Set HL7 delimiters from HL array if any or to std. HL7 ^~|\&
S X=$E($G(HL("FS"))) S:X="" X="^" S SEPF=X
S X=$G(HL("ECH")) S:X="" X="~|\&"
S SEPC=$E(X),SEPS=$E(X,4),SEPR=$E(X,2),SEPE=$E(X,3)
Q
;
; Converts IEN from new person file (200) into HL7 XCN data
XCN200(VAL,SRC) ;
; Inputs: VAL - IEN from ^VA(200)
; SRC - Source for person (Optional)
; Return: VAL is converted to HL7 XCN name format
I VAL="" Q VAL
N NM S NM("FILE")=200,NM("FIELD")=.01,NM("IENS")=VAL_","
S VAL=VAL_SEPC_$$HLNAME^XLFNAME(.NM,"S",SEPC)
I $G(SRC)'="" S $P(VAL,SEPC,8)=SRC
E S $P(VAL,SEPC,8)="VistA200"
Q VAL
;
; Format VAL into HL7 TS date/time
TS(VAL) ; Format VAL as valid HL7 TS date/time/time zone
N OVAL,%DT,%H,% I VAL'?3A.E&(+VAL=0)!(+VAL=-1) S VAL="" G TSEXIT
;
; Already in HL7 TS or DT form?
G TSEXIT:VAL?8N.6N1"-"4N!(VAL?8N.6N1"+"4N)!(VAL?8N),TZ:VAL?12N
S OVAL=VAL
;
; Convert alpha month if needed
I VAL'?5N1","1.5N,VAL'?7N,VAL'?7N1"."0.6N D
. N X,Y,%DT S %DT="TS",X=VAL D ^%DT I Y=-1 S VAL="" Q
. S VAL=Y,OVAL=VAL
G TSEXIT:VAL=""
;
; Date in $H format?
I VAL?5N1","1.5N S %H=VAL D YMD^%DTC S VAL=X_%,OVAL=VAL
;
; Convert to HL7 format
S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL=-1 S VAL="" G TSEXIT
;
; Correct the time zone if time present
TZ I $L(VAL)>8,VAL'["-",VAL'["+" S VAL=$P(VAL,"-")_$$TZ^XLFDT
TSEXIT Q VAL
;
RTNVAL ; Validate entry for file #577, field # .3, EXTRACTION PROGRAM
; Entry must be either "INACTIVE" or the name of the M routine
; used to extract the VistA data and create the HL7 message.
; Used by input transform of file #577, field #.3 and by the KID
; post-install API in application domains's packages.
;
I X'="INACTIVE",$T(@("^"_X))="" K X Q ; Program ain't there
I $P($T(@("VALID^"_X)),";",3)'="VDEF HL7 MESSAGE BUILDER" K X Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVDEFEL 2091 printed Dec 13, 2024@02:43:50 Page 2
VDEFEL ;INTEGIC/YG & BPOIFO/JG- VDEF library functions; ; 21 Dec 2004 11:29 AM
+1 ;;1.00;VDEF;;Dec 17, 2004
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; No bozos
QUIT
+5 ;
+6 ; VDEF Library Subroutines.
+7 ;
SETDLMS ; Set HL7 delimiters from HL array if any or to std. HL7 ^~|\&
+1 SET X=$EXTRACT($GET(HL("FS")))
if X=""
SET X="^"
SET SEPF=X
+2 SET X=$GET(HL("ECH"))
if X=""
SET X="~|\&"
+3 SET SEPC=$EXTRACT(X)
SET SEPS=$EXTRACT(X,4)
SET SEPR=$EXTRACT(X,2)
SET SEPE=$EXTRACT(X,3)
+4 QUIT
+5 ;
+6 ; Converts IEN from new person file (200) into HL7 XCN data
XCN200(VAL,SRC) ;
+1 ; Inputs: VAL - IEN from ^VA(200)
+2 ; SRC - Source for person (Optional)
+3 ; Return: VAL is converted to HL7 XCN name format
+4 IF VAL=""
QUIT VAL
+5 NEW NM
SET NM("FILE")=200
SET NM("FIELD")=.01
SET NM("IENS")=VAL_","
+6 SET VAL=VAL_SEPC_$$HLNAME^XLFNAME(.NM,"S",SEPC)
+7 IF $GET(SRC)'=""
SET $PIECE(VAL,SEPC,8)=SRC
+8 IF '$TEST
SET $PIECE(VAL,SEPC,8)="VistA200"
+9 QUIT VAL
+10 ;
+11 ; Format VAL into HL7 TS date/time
TS(VAL) ; Format VAL as valid HL7 TS date/time/time zone
+1 NEW OVAL,%DT,%H,%
IF VAL'?3A.E&(+VAL=0)!(+VAL=-1)
SET VAL=""
GOTO TSEXIT
+2 ;
+3 ; Already in HL7 TS or DT form?
+4 if VAL?8N.6N1"-"4N!(VAL?8N.6N1"+"4N)!(VAL?8N)
GOTO TSEXIT
if VAL?12N
GOTO TZ
+5 SET OVAL=VAL
+6 ;
+7 ; Convert alpha month if needed
+8 IF VAL'?5N1","1.5N
IF VAL'?7N
IF VAL'?7N1"."0.6N
Begin DoDot:1
+9 NEW X,Y,%DT
SET %DT="TS"
SET X=VAL
DO ^%DT
IF Y=-1
SET VAL=""
QUIT
+10 SET VAL=Y
SET OVAL=VAL
End DoDot:1
+11 if VAL=""
GOTO TSEXIT
+12 ;
+13 ; Date in $H format?
+14 IF VAL?5N1","1.5N
SET %H=VAL
DO YMD^%DTC
SET VAL=X_%
SET OVAL=VAL
+15 ;
+16 ; Convert to HL7 format
+17 SET VAL=$$HLDATE^HLFNC(VAL,"TS")
IF VAL=-1
SET VAL=""
GOTO TSEXIT
+18 ;
+19 ; Correct the time zone if time present
TZ IF $LENGTH(VAL)>8
IF VAL'["-"
IF VAL'["+"
SET VAL=$PIECE(VAL,"-")_$$TZ^XLFDT
TSEXIT QUIT VAL
+1 ;
RTNVAL ; Validate entry for file #577, field # .3, EXTRACTION PROGRAM
+1 ; Entry must be either "INACTIVE" or the name of the M routine
+2 ; used to extract the VistA data and create the HL7 message.
+3 ; Used by input transform of file #577, field #.3 and by the KID
+4 ; post-install API in application domains's packages.
+5 ;
+6 ; Program ain't there
IF X'="INACTIVE"
IF $TEXT(@("^"_X))=""
KILL X
QUIT
+7 IF $PIECE($TEXT(@("VALID^"_X)),";",3)'="VDEF HL7 MESSAGE BUILDER"
KILL X
QUIT
+8 QUIT
