source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLFNC2.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1HLFNC2 ;AISC/SAW-Continuation of HLFNC, Additional Functions/Calls Used for HL7 Messages ;12/17/2002 16:40
2 ;;1.6;HEALTH LEVEL SEVEN;**2,26,57,59,101**;Oct 13, 1995
3INIT(EID,HL,INT) ;Initialize Variables in HL array for Building a Message
4 ;
5 ;This is a subroutine call with parameter passing that returns an
6 ;array of values in the variable specified by the parameter HL. If no
7 ;error occurs, the array of values is returned. Otherwise, the single
8 ;value HL is returned equal to the following: error code^error message
9 ;
10 ;Required Input Parameters
11 ; EID = Name or IEN of the event driver or subscriber protocol in
12 ; Protocol file for which the initialization variables are
13 ; to be returned
14 ; HL = The variable in which the array of values will be returned
15 ; This parameter must be passed by reference
16 ;Optional Input Parameter
17 ; INT = 1 indicates that only array values for internal DHCP
18 ; to DHCP message exchange should be initialized
19 ;
20 ;Check for required input parameter
21 I $G(EID)="" S HL="7^Missing EID Input Parameter" Q
22 I '$D(INT) S INT=0
23 ;Convert EID to IEN if necessary
24 I 'EID S EID=$O(^ORD(101,"B",EID,0)) I 'EID S HL="1^"_$G(^HL(771.7,1,0)) Q
25 N X0,X,X1,X2
26 ;Get node 770 from file 101 and node 0 from file 771
27 S X0=$G(^ORD(101,EID,0))
28 ;if server application is disabled quit
29 I $P(X0,U,3)]"" S HL="16^"_$G(^HL(771.7,16,0)) Q
30 ;if no known clients, set error but allow app to continue
31 I '$D(^ORD(101,EID,775,"B")) S HL="15^"_$G(^HL(771.7,15,0))
32 S X=$G(^ORD(101,EID,770)),X1=$G(^HL(771,+X,0))
33 I X1']"" S HL="14^"_$G(^HL(771.7,14,0)) Q
34 ;Set HL array variables
35 S HL("Q")="""""",HL("FS")=$G(^HL(771,+X,"FS")),HL("ECH")=$G(^("EC")) S:HL("FS")']"" HL("FS")="^" S:HL("ECH")']"" HL("ECH")="~|\&"
36 S HL("SAN")=$P(X1,"^"),HL("SAF")=$P(X1,"^",3) S:$P(X1,"^",7) HL("CC")=$P($G(^HL(779.004,$P(X1,"^",7),0)),"^")
37 S HL("MTN")=$P($G(^HL(771.2,+$P(X,"^",3),0)),"^"),HL("ETN")=$P($G(^HL(779.001,+$P(X,"^",4),0)),"^")
38 S:$P(X,"^",5) HL("MTN_ETN")=$P($G(^HL(779.005,+$P(X,"^",5),0)),"^")
39 S HL("PID")=$S($P(X,"^",6)="D":"D",1:$P($$PARAM^HLCS2,"^",3)),HL("VER")=$P($G(^HL(771.5,+$P(X,"^",10),0)),"^")
40 S:$P(X,"^",9) HL("APAT")=$P($G(^HL(779.003,$P(X,"^",9),0)),"^")
41 I 'INT S:$P(X,"^",8) HL("ACAT")=$P($G(^HL(779.003,$P(X,"^",8),0)),"^")
42 ;-- Set variables for backwards compatablity
43 S HLQ=HL("Q"),HLFS=HL("FS"),HLECH=HL("ECH")
44 Q
45MSH(HL,MID,RESULT,SECURITY) ;Create an MSH Segment for an Outgoing HL7
46 ;Message
47 ;
48 ;This is a subroutine call with parameter passing that returns an HL7
49 ;Message Header (MSH) segment in the variable RESULT (and possibly
50 ;RESULT(1) if the MSH segment is longer than 245 characters). If the
51 ;required input parameters HL or MID are missing, RESULT is returned
52 ;equal to null
53 ;
54 ;Required Input Parameters
55 ; HL = The array of values returned by the call to INIT^HLFNC2
56 ; MID = The Message Control ID to be included in the MSH segment.
57 ; The Batch Control ID for the batch is returned by the
58 ; call to CREATE^HLTF. The application concatenates a
59 ; sequential number to the batch ID to create the MID
60 ; RESULT = The variable that will be returned to the calling
61 ; application as described above
62 ;Optional Input Parameter
63 ;SECURITY = Security to be included in field #8 of the MSH segment
64 ;
65 ;Check for required parameters
66 I '$D(HL)#2!('$D(MID)) Q ""
67 N X,X1,X2
68 ;Build MSH segment from HL array variables and other input parameters
69 S X="MSH"_HL("FS")_HL("ECH")_HL("FS")_HL("SAN")_HL("FS")_HL("SAF")_HL("FS")_$S($D(HL("RAN")):HL("RAN"),1:"")_HL("FS")_$S($D(HL("RAF")):HL("RAF"),1:"")_HL("FS")_$S($D(HL("DTM")):HL("DTM"),1:"")_HL("FS")
70 S X=X_$S($G(SECURITY)]"":SECURITY,1:"")_HL("FS")_HL("MTN")_$E(HL("ECH"))_HL("ETN")
71 ;Message structure component for HL7 v 2.3.1 and beyond
72 S:$D(HL("MTN_ETN")) X=X_$E(HL("ECH"))_HL("MTN_ETN")
73 S X=X_HL("FS")_MID_HL("FS")_HL("PID")_HL("FS")_HL("VER")
74 S:$D(HL("SN")) $P(X,HL("FS"),13)=HL("SN") S:$D(HL("ACAT")) $P(X,HL("FS"),15)=HL("ACAT") S:$D(HL("APAT")) $P(X,HL("FS"),16)=HL("APAT") S:$D(HL("CC")) $P(X,HL("FS"),17)=HL("CC")
75 ;If continuation pointer variable exists, insert it in piece 14 and
76 ;create new variable X1 if length of X will be greater than 245
77 I $D(HL("CP")) D
78 .I $L(X)+$L(HL("CP"))+2'>245 S $P(X,HL("FS"),14)=HL("CP") Q
79 .S $P(X,HL("FS"),14)="",X1=HL("FS")_$P(X,HL("FS"),15,17),X=$P(X,HL("FS"),1,14)
80 .S X2=$L(X),X=X_$E(HL("CP"),1,(245-X2)),X1=$E(HL("CP"),(246-X2),245)_X1
81 .S X2=$L(X) I $L(X2)<245 S X=X_$E(X1,1,(245-X2)),X1=$E(X1,(246-X2),245)
82 S RESULT=X S:$L($G(X1)) RESULT(1)=X1
83 Q
84RSPINIT(EIDS,HL) ;Initialize Variables in HL array for Building a Response Message
85 ;
86 ;This is a subroutine call with parameter passing that returns an
87 ;array of values in the variable specified by the parameter HL. If no
88 ;error occurs, the array of values is returned. Otherwise, the single
89 ;value HL is returned equal to the following: error code^error message
90 ;
91 ;Required Input Parameters
92 ; EIDS = Name or IEN of the subscriber protocol in
93 ; Protocol file for which the initialization variables are
94 ; to be returned
95 ; HL = The variable in which the array of values will be returned
96 ; This parameter must be passed by reference
97 ;
98 ;Check for required input parameter
99 I $G(EIDS)="" S HL="7^Missing EIDS Input Parameter" Q
100 ;Convert EIDS to IEN if necessary
101 I 'EIDS S EIDS=$O(^ORD(101,"B",EIDS,0)) I 'EIDS S HL="15^"_"Invalid Subscriber Protocol" Q
102 N X0,X,X1,X2
103 ;Get node 770 from file 101 and node 0 from file 771
104 S X0=$G(^ORD(101,EIDS,0))
105 S X=$G(^ORD(101,EIDS,770)),X1=$G(^HL(771,+$P(X,"^",2),0))
106 I X1']"" S HL="15^"_"Subscriber Application Missing in Protocol File" Q
107 ;Set HL array variables
108 S HL("RFS")=$G(^HL(771,+$P(X,"^",2),"FS")),HL("RECH")=$G(^("EC")) S:HL("RFS")']"" HL("RFS")="^" S:HL("RECH")']"" HL("RECH")="~|\&"
109 S HL("RAN")=$P(X1,"^")
110 S HL("RMTN")=$P($G(^HL(771.2,+$P(X,"^",11),0)),"^"),HL("RETN")=$P($G(^HL(779.001,+$P(X,"^",4),0)),"^")
111 Q
Note: See TracBrowser for help on using the repository browser.