source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLMA2.m@ 800

Last change on this file since 800 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1HLMA2 ;AISC/SAW-Message Administration Module ;09/23/2005 17:45
2 ;;1.6;HEALTH LEVEL SEVEN;**19,43,57,58,64,65,76,82,91,94,109,120**;Oct 13, 1995;Build 12
3 ; References to ^ORD(101) supported by IA# 1373.
4 ;
5SEND(EIDS,MTIEN,CLIENT,PRIORITY,MTIENS,LOGLINK) ;
6 ;Entry point to create
7 ;an entry in the Message Administrator and Message Text
8 ;files for a message that is about to be sent to a recipient
9 ;
10 ;This is a subroutine call with parameter passing. It returns a value
11 ;in the variable MTIENS with 1 to 3 pieces separated by uparrows
12 ;as follows: MTIENS^error code^error description
13 ;If no error occurs, only the first piece is returned equal to the IEN
14 ;the entry created in the Message Text or Administration file.
15 ;Otherwise, three pieces are returned with the first piece equal to 0
16 ;
17 ;All the following input parameters are required
18 ; EIDS = The IEN from the Protocol file of the subscriber event
19 ; MTIEN = The IEN from the Message Text file created when the
20 ; GENERATE^HLMA or GENACK^HLMA1 entry points were invoked
21 ; CLIENT = The IEN of the client (subscriber) application from
22 ; the Application Parameter file
23 ;PRIORITY = I for immediate or D for deferred
24 ; MTIENS = The variable that will be returned to the calling
25 ; application as described above
26 ;Optional parameter
27 ; LOGLINK = The IEN of the logical link from the Logical Link file
28 ;
29 ; ACK = 1 or 0 to indicate if original message or response-passed
30 ; by ^HLCS
31 ;
32 ; Save passed parameters for restore... HL*1.6*94
33 N HL94P
34 ;
35 ; patch HL*1.6*120 start
36 ; save the receiving facility from HLSUP("S") variable in routine ADD^HLCS2
37 I $G(MTIENS("REC-FACILITY"))]"" D
38 . S HLP("REC-FACILITY")=MTIENS("REC-FACILITY")
39 ; F HL94P="CONTPTR","NAMESPACE","SECURITY","SUBSCRIBER" D
40 F HL94P="CONTPTR","NAMESPACE","SECURITY","SUBSCRIBER","PMOD","REC-FACILITY" D
41 . QUIT:'$D(HLP(HL94P)) ;->
42 . MERGE HL94P(HL94P)=HLP(HL94P)
43 ; patch HL*1.6*120 end
44 ;
45 ;Check for required parameters
46 S MTIENS=""
47 I '$G(EIDS)!('$G(MTIEN))!('$G(CLIENT))!("ID"'[$E($G(PRIORITY))) S MTIENS="0^7^"_$G(^HL(771.7,7,0))_" at SEND^HLMA entry point" G EXIT
48 ;Get message ID and Message Text IEN
49 N HLJ,HLHDRBLD,HLMIDS,HLDTS,HLDT1S,HLP,REPLYTO,SERVER,X
50 ;
51 ; Restore parameters if needed... HL*1.6*94
52 S HL94P=""
53 F S HL94P=$O(HL94P(HL94P)) Q:HL94P']"" D
54 . MERGE HLP(HL94P)=HL94P(HL94P)
55 ;
56 ;check if LL is TCP
57 I $G(LOGLINK) D Q:MTIENS!($G(HLERROR)]"")
58 . ;quit if it is not TCP
59 . Q:$P(^HLCS(870,LOGLINK,0),U,3)'=4
60 . ;create client in 773, MTIENS=ien in 773
61 . S (MTIENS,HLTCP)=$$MA^HLTF(MTIEN,.HLMIDS)
62 .;
63 .;**109
64 .; F L +^HLMA(MTIENS):1 Q:$T H 1
65 .;
66 . D MIDAR(HLMIDS)
67 . ;get info from parent (772)
68 . S X=^HL(772,MTIEN,0),HLTYPE=$P(X,U,14),SERVER=$P(X,U,2),REPLYTO=$P(X,U,7)
69 . ;get ack timeout override
70 . S:$P($G(^HL(772,MTIEN,"P")),U,7) HLP("ACKTIME")=+$P(^("P"),U,7)
71 . ;get message type and event type from protocol
72 . S X=$G(^ORD(101,EIDS,770)),HLP("MTYPE")=$P(X,U,11),HLP("EVENT")=$P(X,U,4),HLP("HLTCPI")=MTIENS
73 . S:$P(X,U,5) HLP("MTYPE_EVENT")=$P(X,U,5)
74 . ;update date in client (773)
75 . D UPDATE^HLTF0(MTIENS,"","O",EIDS,CLIENT,SERVER,"D",REPLYTO,"",.HLP)
76 . ;create header for message in 773
77 . I (HLTYPE="M") D HEADER^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
78 . I (HLTYPE'="M") D BHSHDR^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
79 . ;if error set status to ERROR DURING TRANSMISSION
80 . I ($G(HLERROR)'="") D Q
81 ..;**109**
82 ..; D STATUS^HLTF0(MTIENS,4,12,HLERROR) L -^HLMA(MTIENS)
83 .. D STATUS^HLTF0(MTIENS,4,12,HLERROR)
84 ..;
85 .. S MTIENS="0^12^"_$G(^HL(771.7,12,0))_" in HLCSHDR1"
86 .. Q
87 . ;do we still need MTIEN=ien of file 772
88 . S MTIEN=""
89 . ;update status of 773 to PENDING TRANSMISSION
90 . D STATUS^HLTF0(MTIENS,1)
91 . ;set header, HLHDR and Logical Link in 773
92 . K HLJ
93 . S X=MTIENS_",",HLJ(773,X,7)=LOGLINK,HLJ(773,X,200)="HLHDR"
94 . D FILE^HLDIE("","HLJ","","SEND","HLMA2") ;HL*1.6*109
95 .D ENQUE^HLCSREP(LOGLINK,"O",MTIENS)
96 .;
97 .;**109
98 .; L -^HLMA(MTIENS)
99 ;
100 ;if not TCP get msg. ID
101 S HLMIDS=$P($G(^HL(772,MTIEN,0)),"^",6)
102 ;create child message
103 D CREATE^HLTF(.HLMIDS,.MTIENS,.HLDTS,.HLDT1S),MIDAR(HLMIDS)
104 ;Link new Message Text file entry to MTIENG entry and update fields
105 ;on zero node
106 D UPDATE^HLTF0(MTIENS,MTIEN,"O",EIDS,CLIENT,"",PRIORITY,"",$S($G(LOGLINK):LOGLINK,1:""))
107EXIT Q
108 ;
109MIDAR(X) ;update HLMIDAR array with X=message id
110 Q:$G(X)=""
111 I 'HLMIDAR S HLMIDAR("N")=1,HLMIDAR=X Q
112 S HLMIDAR(HLMIDAR("N"))=X,HLMIDAR("N")=HLMIDAR("N")+1
113 Q
114 ;
115DC ;direct connect
116 N CLIENT,EIDS,HLMIDS,LOGLINK,MTIEN,MTIENS,POP,HLHDR,HLHDRO,HLMSA,REPLYTO,SERVER,X,HLTCPI
117 N HLCSOUT,HLDBACK,HLDBSIZE,HLDP,HLDREAD,HLDRETR,HLDWAIT,HLMSG,HLOS,HLPORT,HLTCPADD,HLTCPCS,HLTCPLNK,HLTCPO,HLTCPORT,HLRESP,HLTYPE,HLRETRA,HLRETRY,HLTCPRET
118 S (EIDS,LOGLINK)="",MTIEN=HLMTIEN
119 I $D(HLL("LINKS")) D
120 . S EIDS=$P(HLL("LINKS",1),U),LOGLINK=$P(HLL("LINKS",1),U,2)
121 . K HLL("LINKS")
122 . Q:EIDS="" I EIDS<1 S EIDS=$O(^ORD(101,"B",EIDS,0))
123 . Q:LOGLINK="" I LOGLINK<1 S LOGLINK=$O(^HLCS(870,"B",LOGLINK,0))
124 . S CLIENT=+$$PTR^HLUTIL2(EIDS)
125 I 'LOGLINK!'EIDS D
126 . S EIDS=+$O(^ORD(101,HLEID,775,0)) Q:'EIDS S EIDS=$P($G(^(EIDS,0)),U)
127 . S X=$$PTR^HLUTIL2(EIDS),CLIENT=$P(X,U),LOGLINK=$P(X,U,2)
128 I 'EIDS S HLERROR="15^Invalid Subscriber for Immediate connection" Q
129 I 'LOGLINK S HLERROR="15^Invalid Logical Link for Immediate connection" Q
130 I CLIENT<0 S HLERROR="15^Invalid Subscriber Protocol for Immediate connection" Q
131 ;open connection
132 I '$$DCOPEN^HLCSTCP(LOGLINK) S HLERROR="15^Connection Failed" Q
133 ;create client in 773
134 S HLDP=LOGLINK,(MTIENS,HLTCP,HLTCPI,HLMSG)=$$MA^HLTF(MTIEN,.HLMIDS)
135 ;
136 ; patch HL*1.6*120 start
137 S HLMIDAR("HLMID")=$G(HLMIDS)
138 S HLMIDAR("IEN773")=MTIENS
139 ; patch HL*1.6*120 end
140 ;
141 ;**109**
142 ;F L +^HLMA(MTIENS):1 Q:$T H 1
143 ;
144 ;get info from parent (772)
145 S X=^HL(772,MTIEN,0),HLTYPE=$P(X,U,14),SERVER=$P(X,U,2),REPLYTO=$P(X,U,7)
146 ;get ack timeout override
147 S:$P($G(^HL(772,MTIEN,"P")),U,7) HLP("ACKTIME")=+$P(^("P"),U,7)
148 ;get message type and event type from protocol
149 S X=$G(^ORD(101,EIDS,770)),HLP("MTYPE")=$P(X,U,11),HLP("EVENT")=$P(X,U,4),HLP("HLTCPI")=MTIENS
150 S:$P(X,U,5) HLP("MTYPE_EVENT")=$P(X,U,5)
151 ;update date in client (773)
152 D UPDATE^HLTF0(MTIENS,"","O",EIDS,CLIENT,SERVER,"I",REPLYTO,"",.HLP)
153 ;create header for message in 773
154 I (HLTYPE="M") D HEADER^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
155 I (HLTYPE'="M") D BHSHDR^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
156 ;if error set status to ERROR DURING TRANSMISSION
157 I ($G(HLERROR)'="") D Q
158 .;
159 .;**109**
160 .; D STATUS^HLTF0(MTIENS,4,12,HLERROR) L -^HLMA(MTIENS)
161 . D STATUS^HLTF0(MTIENS,4,12,HLERROR)
162 .;
163 . S MTIENS="0^12^"_$G(^HL(771.7,12,0))_" in HLCSHDR1"
164 .;
165 .;**109**
166 .; L -^HLMA(HLMSG) D MON^HLCSTCP("Idle")
167 . D MON^HLCSTCP("Idle")
168 .;
169 . Q
170 ;set header, HLHDR and Logical Link in 773
171 K HLJ S X=MTIENS_",",HLJ(773,X,7)=LOGLINK,HLJ(773,X,200)="HLHDR"
172 ;
173 D FILE^HLDIE("","HLJ","","DC","HLMA2") ; HL*1.6*109
174 ;
175 ;**109**
176 D LLCNT^HLCSTCP(LOGLINK,3)
177 ;
178 D DCSEND^HLCSTCP2
179 G EXIT2:'$G(HLRESP)
180 ;X=ien in 773^ien in 772 for response
181 S X=HLRESP D INIT^HLTP3A ;patch HL*1.6*109 - hltp3 routine split
182 D:'$G(HL) STATUS^HLTF0(HLMTIENS,3,,,1)
183 S HLMTIENR=HLMTIEN
184 D EXIT^HLTP3
185EXIT2 ;
186 ;**109**
187 ;L -^HLMA(HLMSG)
188 Q
Note: See TracBrowser for help on using the repository browser.