206 lines
7.2 KiB
Mathematica
206 lines
7.2 KiB
Mathematica
HLFNC ;AISC/SAW-Routine of Functions and Other Calls Used for HL7 Messages ;08/03/2000 15:45
|
|
;;1.6;HEALTH LEVEL SEVEN;**38,42,51,66**;Oct 13, 1995
|
|
HLNAME(X,HLECDE) ;Convert a name in DHCP format to HL7 format
|
|
; INPUT: X - Name in DHCP format
|
|
; Optional - HLECDE - HL7 encoding chars
|
|
;**** NOTE: ****
|
|
;If this function is called without HLECDE as parameter than HLECH
|
|
;must be define.
|
|
;
|
|
Q:'$D(X) "" Q:X="" ""
|
|
I '$D(HLECH),'$D(HLECDE) Q ""
|
|
I $D(HLECDE) N HLECH S HLECH=HLECDE
|
|
I '$D(HLECH) Q ""
|
|
N %,X1,X2,Y
|
|
S X1=$P(X,",",2),X2=$L(X1," "),Y=$P(X,",")_$E(HLECH)_$P(X1," ") I X2 F %=2:1:X2 Q:$P(X1," ",%)']"" S Y=Y_$E(HLECH)_$P(X1," ",%)
|
|
Q Y
|
|
;
|
|
FMNAME(X,HLECDE) ;Convert a name in HL7 format to DHCP format
|
|
; INPUT: X - Name in HL7 format
|
|
; Optional - HLECDE - HL7 encoding chars
|
|
;**** NOTE: ****
|
|
;If this function is called without HLECDE as parameter than HLECH
|
|
;must be define.
|
|
;
|
|
Q:'$D(X) "" Q:X="" ""
|
|
I '$D(HLECH),'$D(HLECDE) Q ""
|
|
I $D(HLECDE) N HLECH S HLECH=HLECDE
|
|
I '$D(HLECH) Q ""
|
|
N %,X1 S X1=$L(X,$E(HLECH)),Y="" F %=1:1:X1 D
|
|
.I $P(X,$E(HLECH),%)]"",$P(X,$E(HLECH),%)'="""""" D
|
|
..;Only last name,first name.
|
|
..I %<3 S Y=Y_$P(X,$E(HLECH),%)_$S(%=1:",",1:"") Q
|
|
..S Y=Y_" "_$P(X,$E(HLECH),%)
|
|
Q Y
|
|
;
|
|
HLDATE(X,Y) ;Convert date, date/time or time only in FM format to HL7 format
|
|
;Optional Variables:
|
|
;Y = The type of format to be returned if you want to force return of a
|
|
; specific format. Y must be equal to one of the following:
|
|
; DT - Date only
|
|
; TM - Time only
|
|
; TS - Date and time
|
|
I X="" Q ""
|
|
S Y=$G(Y)
|
|
N %,Z
|
|
I $L(X)<7 D Q % ;Time input
|
|
. S %=$S(X=2400:"0000",$L(X)<4:$E(X_"000",1,4),1:X) S:$L(%)=5 %=%_0
|
|
. Q
|
|
I Y="TM" D Q % ;Only time
|
|
. S %=$P(X,".",2),%=$S(%="":"",$E(%,1,2)=24:"0000",$L(%)<4:$E(%_"000",1,4),1:%) S:$L(%)=5 %=%_0
|
|
. Q
|
|
S %=$$FMTHL7^XLFDT(X)
|
|
Q $S(Y="DT":$E(%,1,8),1:%)
|
|
;
|
|
FMDATE(X) ;Convert a date, date/time or time only in HL7 format to FM format
|
|
I X="" Q ""
|
|
N %
|
|
S %=$P($TR(X,"+-","^"),"^")
|
|
I $L(X)<7 Q %
|
|
Q $$HL7TFM^XLFDT(X)
|
|
;
|
|
M10(X,HLECDE) ; M10 check digit scheme
|
|
; INPUT : X - ID number
|
|
; Optional HLECDE - Encoding chars
|
|
;**** NOTE: ****
|
|
;If this function is called without HLECDE as parameter then HLECH
|
|
;must be defined.
|
|
;Return X if encoding character is not defined
|
|
;Return X with encoding characters concatenated if X is alphanumeric
|
|
;
|
|
N HLCNT,HLODD,HLEVEN,HLX1,HLDIGIT
|
|
Q:'$D(X) ""
|
|
I $D(HLECDE) N HLECH S HLECH=HLECDE
|
|
;Return X if encoding character is not defined
|
|
I '$D(HLECH) Q X
|
|
;Return X with encoding characters concatenated if X is alphanumeric
|
|
I '(X?1.N) Q X_$E(HLECH)_$E(HLECH)
|
|
;
|
|
S HLX1=+X
|
|
S HLODD=""
|
|
F HLCNT=$L(HLX1):-2:1 S HLODD=HLODD_$E(HLX1,HLCNT)
|
|
S HLODD=HLODD*2
|
|
S HLEVEN=""
|
|
F HLCNT=($L(HLX1)-1):-2:1 S HLEVEN=HLEVEN_$E(HLX1,HLCNT)
|
|
S HLX1=HLEVEN_HLODD
|
|
S HLDIGIT=0
|
|
F HLCNT=1:1:$L(HLX1) S HLDIGIT=HLDIGIT+$E(HLX1,HLCNT)
|
|
S HLDIGIT=((HLDIGIT\10+1)*10-HLDIGIT)#10
|
|
Q X_$E(HLECH)_HLDIGIT_$E(HLECH)_"M10"
|
|
;
|
|
M11(X,HLECDE) ; M11 check digit scheme
|
|
; INPUT : X - ID number
|
|
; Optional HLECDE - Encoding chars
|
|
;**** NOTE: ****
|
|
;If this function is called without HLECDE as parameter then HLECH
|
|
;must be defined.
|
|
;Return X if encoding character is not defined
|
|
;Return X with encoding characters concatenated if X is alphanumeric
|
|
;
|
|
N HLX1,HLCNT,HLWT,HLDIGIT
|
|
Q:'$D(X) ""
|
|
I $D(HLECDE) N HLECH S HLECH=HLECDE
|
|
;Return X if encoding character is not defined
|
|
I '$D(HLECH) Q X
|
|
;Return X with encoding characters concatenated if X is alphanumeric
|
|
I '(X?1N.N) Q X_$E(HLECH)_$E(HLECH)
|
|
;
|
|
S HLX1=+X
|
|
S HLDIGIT=0,HLWT=2
|
|
F HLCNT=$L(HLX1):-1:1 D
|
|
. I HLWT>7 S HLWT=2
|
|
. S HLDIGIT=HLDIGIT+($E(HLX1,HLCNT)*HLWT)
|
|
. S HLWT=HLWT+1
|
|
S HLDIGIT=HLDIGIT#11
|
|
I HLDIGIT=0 S HLDIGIT=1
|
|
S HLDIGIT=(11-HLDIGIT)#10
|
|
Q X_$E(HLECH)_HLDIGIT_$E(HLECH)_"M11"
|
|
;
|
|
OLDM10(X,HLECDE) ;Calculate M10 checksum
|
|
; INPUT : X - String to calc checksum
|
|
; Optional HLECDE - Encoding chars
|
|
;**** NOTE: ****
|
|
;If this function is called without HLECDE as parameter than HLECH
|
|
;must be define.
|
|
;
|
|
Q:'$D(X) ""
|
|
I '$D(HLECH),'$D(HLECDE) Q ""
|
|
I $D(HLECDE) N HLECH S HLECH=HLECDE
|
|
I '$D(HLECH) Q ""
|
|
N %,Y
|
|
S Y=0 F %=1:1:$L(X) S Y=Y+$E(X,%)
|
|
Q X_$E(HLECH)_(Y#10)_$E(HLECH)_"M10"
|
|
;
|
|
OLDM11(X,HLECDE) ;Calculate M11 checksum
|
|
; INPUT : X - String to calc checksum
|
|
; Optional HLECDE - Encoding chars
|
|
;**** NOTE: ****
|
|
;If this function is called without HLECDE as parameter than HLECH
|
|
;must be define.
|
|
;
|
|
Q:'$D(X) ""
|
|
I '$D(HLECH),'$D(HLECDE) Q ""
|
|
I $D(HLECDE) N HLECH S HLECH=HLECDE
|
|
I '$D(HLECH) Q ""
|
|
N %,Y S Y=0 F %=1:1:$L(X) S Y=Y+$E(X,%)
|
|
Q X_$E(HLECH)_(Y#11)_$E(HLECH)_"M11"
|
|
UPPER(X) ;Convert lowercase letters to uppercase
|
|
Q:'$D(X) ""
|
|
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
HLPHONE(X,B,C) ;Convert DHCP Phone Number to HL7 Format
|
|
;Required parameters:
|
|
;X = Seven digit phone number at a minimum. Optionally, in addition,
|
|
; a three digit area code, two digit country code and other
|
|
; formatting characters (e.g., dashes)
|
|
;Optional Variables:
|
|
;B = Beeper number
|
|
;C = Comments
|
|
Q:'$D(X) "" Q:$L(X)<7 ""
|
|
N I,Y,Y1,Z S B=$S('$D(B):"",1:"B"_B),C=$S('$D(C):"",1:"C"_C)
|
|
S Y="" F I=1:1:$L(X) S Y=Y_$S($E(X,I)?1N:$E(X,I),"X,x"[$E(X,I)&('$D(Z)):"X",1:"") I "X,x"[$E(X,I) S Z=""
|
|
I $L(Y)<7 Q ""
|
|
S Y1=$S(Y["X":"X"_$P(Y,"X",2),1:""),Y=$P(Y,"X") I $L(Y)<7 Q ""
|
|
I $L(Y)=8,189[$E(Y) S Y=$E(Y,2,8)
|
|
I $L(Y)=11,189[$E(Y) S Y=$E(Y,2,11)
|
|
I $L(Y)=7 Q $E($E(Y,1,3)_"-"_$E(Y,4,7)_Y1_B_C,1,40)
|
|
I $L(Y)=10 Q $E("("_$E(Y,1,3)_")"_$E(Y,4,6)_"-"_$E(Y,7,10)_Y1_B_C,1,40)
|
|
I $L(Y)=12 Q $E($E(Y,1,2)_" ("_$E(Y,3,5)_")"_$E(Y,6,8)_"-"_$E(Y,9,12)_Y1_B_C,1,40)
|
|
Q ""
|
|
HLADDR(AD,GL,HLECDE) ;Convert DHCP address fields to HL7 address format
|
|
;Required parameters:
|
|
;AD = One to four street address lines separated by uparrows (^).
|
|
;GL = Three to four geographic location components separated by
|
|
; uparrows (^). City^State or Province^Zip Code^Country Code.
|
|
; If the fourth component is not defined, it will be set to 'USA'.
|
|
; The second component must be null or an IEN in the
|
|
; State file (#5). The third component must be null or pattern
|
|
; match 5N, 9N or 5N1"-"4N.
|
|
;
|
|
; Optional HLECDE - Encoding chars
|
|
;**** NOTE: ****
|
|
;If this function is called without HLECDE as parameter than HLECH
|
|
;must be define.
|
|
;
|
|
;
|
|
;A string will be returned with six components separated by the HL7
|
|
;component separator. The length of the string (including separators)
|
|
;may exceed 106 characters.
|
|
;
|
|
Q:'$D(AD) "" Q:'$D(GL) ""
|
|
I '$D(HLECH),'$D(HLECDE) Q ""
|
|
I $D(HLECDE) N HLECH S HLECH=HLECDE
|
|
I '$D(HLECH) Q ""
|
|
I $D(XRTL) D T0^%ZOSV
|
|
N I,X,Y
|
|
I $P(GL,"^",4)="" S $P(GL,"^",4)="USA"
|
|
I $P(GL,"^",4)="USA" S X=$P(GL,"^",3) S:X?9N X=$E(X,1,5)_"-"_$E(X,6,9) S $P(GL,"^",3)=$S(X?5N!(X?5N1"-"4N):X,1:"")
|
|
S X=+$P(GL,"^",2) S $P(GL,"^",2)=$S('X:"",$P($G(^DIC(5,X,0)),"^",2)]"":$E($P(^(0),"^",2),1,2),1:"")
|
|
S Y=$E(HLECH)_$P(GL,"^")_$E(HLECH)_$P(GL,"^",2)_$E(HLECH)_$P(GL,"^",3)_$E(HLECH)_$P(GL,"^",4)
|
|
S X=$P(AD,"^",1,4) F I=1,2 I X["^^" S X=$P(X,"^^")_"^"_$P(X,"^^",2,3)
|
|
I $E(X,$L(X))="^" S X=$E(X,1,($L(X)-1))
|
|
I $D(XRT0) S XRTN="HLFNC" D T1^%ZOSV
|
|
I $L(X,"^")=1 Q $P(X,"^")_$E(HLECH)_Y
|
|
I $L(X,"^")=2 Q $P(X,"^")_$E(HLECH)_$P(X,"^",2)_Y
|
|
I $L(X,"^")=3 Q $P(X,"^")_", "_$P(X,"^",2)_$E(HLECH)_$P(X,"^",3)_Y
|
|
I $L(X,"^")=4 Q $P(X,"^")_", "_$P(X,"^",2)_$E(HLECH)_$P(X,"^",3)_", "_$P(X,"^",4)_Y
|