| 1 | VDEFEL ;INTEGIC/YG & BPOIFO/JG- VDEF library functions; ; 21 Dec 2004  11:29 AM
 | 
|---|
| 2 |  ;;1.00;VDEF;;Dec 17, 2004
 | 
|---|
| 3 |  ;Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  Q  ; No bozos
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  ; VDEF Library Subroutines.
 | 
|---|
| 8 |  ;
 | 
|---|
| 9 | SETDLMS ; Set HL7 delimiters from HL array if any or to std. HL7 ^~|\&
 | 
|---|
| 10 |  S X=$E($G(HL("FS"))) S:X="" X="^" S SEPF=X
 | 
|---|
| 11 |  S X=$G(HL("ECH")) S:X="" X="~|\&"
 | 
|---|
| 12 |  S SEPC=$E(X),SEPS=$E(X,4),SEPR=$E(X,2),SEPE=$E(X,3)
 | 
|---|
| 13 |  Q
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 |  ; Converts IEN from new person file (200) into HL7 XCN data
 | 
|---|
| 16 | XCN200(VAL,SRC) ;
 | 
|---|
| 17 |  ; Inputs: VAL - IEN from ^VA(200)
 | 
|---|
| 18 |  ;         SRC - Source for person (Optional)
 | 
|---|
| 19 |  ; Return: VAL is converted to HL7 XCN name format
 | 
|---|
| 20 |  I VAL="" Q VAL
 | 
|---|
| 21 |  N NM S NM("FILE")=200,NM("FIELD")=.01,NM("IENS")=VAL_","
 | 
|---|
| 22 |  S VAL=VAL_SEPC_$$HLNAME^XLFNAME(.NM,"S",SEPC)
 | 
|---|
| 23 |  I $G(SRC)'="" S $P(VAL,SEPC,8)=SRC
 | 
|---|
| 24 |  E  S $P(VAL,SEPC,8)="VistA200"
 | 
|---|
| 25 |  Q VAL
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 |  ; Format VAL into HL7 TS date/time
 | 
|---|
| 28 | TS(VAL) ; Format VAL as valid HL7 TS date/time/time zone
 | 
|---|
| 29 |  N OVAL,%DT,%H,% I VAL'?3A.E&(+VAL=0)!(+VAL=-1) S VAL="" G TSEXIT
 | 
|---|
| 30 |  ;
 | 
|---|
| 31 |  ; Already in HL7 TS or DT form?
 | 
|---|
| 32 |  G TSEXIT:VAL?8N.6N1"-"4N!(VAL?8N.6N1"+"4N)!(VAL?8N),TZ:VAL?12N
 | 
|---|
| 33 |  S OVAL=VAL
 | 
|---|
| 34 |  ;
 | 
|---|
| 35 |  ; Convert alpha month if needed
 | 
|---|
| 36 |  I VAL'?5N1","1.5N,VAL'?7N,VAL'?7N1"."0.6N D
 | 
|---|
| 37 |  . N X,Y,%DT S %DT="TS",X=VAL D ^%DT I Y=-1 S VAL="" Q
 | 
|---|
| 38 |  . S VAL=Y,OVAL=VAL
 | 
|---|
| 39 |  G TSEXIT:VAL=""
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 |  ; Date in $H format?
 | 
|---|
| 42 |  I VAL?5N1","1.5N S %H=VAL D YMD^%DTC S VAL=X_%,OVAL=VAL
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 |  ; Convert to HL7 format
 | 
|---|
| 45 |  S VAL=$$HLDATE^HLFNC(VAL,"TS") I VAL=-1 S VAL="" G TSEXIT
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 |  ; Correct the time zone if time present
 | 
|---|
| 48 | TZ I $L(VAL)>8,VAL'["-",VAL'["+" S VAL=$P(VAL,"-")_$$TZ^XLFDT
 | 
|---|
| 49 | TSEXIT Q VAL
 | 
|---|
| 50 |  ;
 | 
|---|
| 51 | RTNVAL ; Validate entry for file #577, field # .3, EXTRACTION PROGRAM
 | 
|---|
| 52 |  ; Entry must be either "INACTIVE" or the name of the M routine
 | 
|---|
| 53 |  ; used to extract the VistA data and create the HL7 message.
 | 
|---|
| 54 |  ; Used by input transform of file #577, field #.3 and by the KID
 | 
|---|
| 55 |  ; post-install API in application domains's packages.
 | 
|---|
| 56 |  ;
 | 
|---|
| 57 |  I X'="INACTIVE",$T(@("^"_X))=""  K X Q  ; Program ain't there
 | 
|---|
| 58 |  I $P($T(@("VALID^"_X)),";",3)'="VDEF HL7 MESSAGE BUILDER" K X Q
 | 
|---|
| 59 |  Q
 | 
|---|