source: FOIAVistA/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOF778A.m@ 870

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1HLOF778A ;ALB/CJM-HL7 - Saving messages to file 778 (continued) ;07/10/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,134,137**;Oct 13, 1995;Build 21
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;
6NEW(HLMSTATE) ;
7 ;This function creates a new entry in file 778.
8 ;Input:
9 ; HLMSTATE (required, pass by reference) These subscripts are expected:
10 ;
11 ;Output - the function returns the ien of the newly created record
12 ;
13 N IEN,NODE,ID,STAT
14 S STAT="HLMSTATE(""STATUS"")"
15 S IEN=$$NEWIEN(HLMSTATE("DIRECTION"),$$TCP)
16 Q:'IEN 0
17 S HLMSTATE("IEN")=IEN
18 ;
19 D ;build the message header
20 .N HDR
21 .;for incoming messages the header segment should already exist
22 .;for outgoing messages must build the header segment
23 .I HLMSTATE("DIRECTION")="OUT" D Q
24 ..I HLMSTATE("BATCH"),$G(HLMSTATE("ACK TO"))]"" S HLMSTATE("HDR","REFERENCE BATCH CONTROL ID")=HLMSTATE("ACK TO")
25 ..D BUILDHDR^HLOPBLD1(.HLMSTATE,$S(HLMSTATE("BATCH"):"BHS",1:"MSH"),.HDR)
26 ..S HLMSTATE("HDR",1)=HDR(1),HLMSTATE("HDR",2)=HDR(2)
27 ;
28 K ^HLB(IEN)
29 S ID=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
30 S NODE=ID_"^"_HLMSTATE("BODY")_"^"_$G(HLMSTATE("ACK TO"))_"^"_$S(HLMSTATE("DIRECTION")="IN":"I",1:"O")_"^"
31 S $P(NODE,"^",5)=$G(@STAT@("LINK NAME"))
32 S $P(NODE,"^",6)=$G(@STAT@("QUEUE"))
33 S $P(NODE,"^",8)=$G(@STAT@("PORT"))
34 S $P(NODE,"^",20)=$G(@STAT)
35 S $P(NODE,"^",21)=$G(@STAT@("ERROR TEXT"))
36 S $P(NODE,"^",16)=HLMSTATE("DT/TM")
37 ;
38 I HLMSTATE("DIRECTION")="OUT" D
39 .S $P(NODE,"^",10)=$P($G(@STAT@("APP ACK RESPONSE")),"^")
40 .S $P(NODE,"^",11)=$P($G(@STAT@("APP ACK RESPONSE")),"^",2)
41 .S $P(NODE,"^",12)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^")
42 .S $P(NODE,"^",13)=$P($G(@STAT@("ACCEPT ACK RESPONSE")),"^",2)
43 .S $P(NODE,"^",14)=$P($G(@STAT@("FAILURE RESPONSE")),"^")
44 .S $P(NODE,"^",15)=$P($G(@STAT@("FAILURE RESPONSE")),"^",2)
45 .;
46 .;for outgoing set these x-refs now, for incoming msgs set them later
47 .S ^HLB("B",ID,IEN)=""
48 .S ^HLB("C",HLMSTATE("BODY"),IEN)=""
49 .I ($G(@STAT)="ER") D
50 ..S ^HLB("ERRORS",$S($L($G(HLMSTATE("HDR","RECEIVING APPLICATION"))):HLMSTATE("HDR","RECEIVING APPLICATION"),1:"UNKNOWN"),HLMSTATE("DT/TM CREATED"),IEN)=""
51 ..D COUNT^HLOESTAT("OUT",$G(HLMSTATE("HDR","RECEIVING APPLICATION")),$G(HLMSTATE("HDR","SENDING APPLICATION")),$S(HLMSTATE("BATCH"):"BATCH",1:$G(HLMSTATE("HDR","MESSAGE TYPE"))),$G(HLMSTATE("HDR","EVENT")))
52 .;
53 .;save some space for the ack
54 .S:($G(HLMSTATE("HDR","ACCEPT ACK TYPE"))="AL") ^HLB(IEN,4)="^^^ "
55 I $G(HLMSTATE("STATUS","PURGE")) S $P(NODE,"^",9)=HLMSTATE("STATUS","PURGE"),^HLB("AD","OUT",HLMSTATE("STATUS","PURGE"),HLMSTATE("IEN"))=""
56 S ^HLB(IEN,0)=NODE
57 ;
58 ;store the message header
59 S ^HLB(IEN,1)=HLMSTATE("HDR",1)
60 S ^HLB(IEN,2)=HLMSTATE("HDR",2)
61 ;
62 ;if the msg is an app ack, update the original msg
63 I $G(HLMSTATE("ACK TO","IEN"))]"" D
64 .N ACKTO
65 .M ACKTO=HLMSTATE("ACK TO")
66 .S ACKTO("ACK BY")=$S(HLMSTATE("BATCH"):HLMSTATE("HDR","BATCH CONTROL ID"),1:HLMSTATE("HDR","MESSAGE CONTROL ID"))
67 .D ACKTO^HLOF778(.HLMSTATE,.ACKTO)
68 .S HLMSTATE("ACK TO","DONE")=1 ;because the update was already done, otherwise it might be done again
69 ;
70 ;The "SEARCH" x-ref will be created asynchronously
71 S ^HLTMP("PENDING SEARCH X-REF",$J,HLMSTATE("DT/TM CREATED"),IEN)=""
72 ;
73 ;sequence q?
74 I HLMSTATE("DIRECTION")="OUT",$G(@STAT@("SEQUENCE QUEUE"))'="" S ^HLB(IEN,5)=@STAT@("SEQUENCE QUEUE")
75 ;
76 Q IEN
77 ;
78NEWIEN(DIR,TCP) ;
79 ;This function uses a counter to get the next available ien for file 778. There are 4 different counters, each assigned as range of numbers, selected via the input parameters. It does not create a record.
80 ;Inputs:
81 ; DIR = "IN" or "OUT" (required)
82 ; TCP = 1,0 (optional)
83 ;Output - the function returns the next available ien. Several counters are used:
84 ;
85 ; <"OUT","TCP">
86 ; <"OUT","NOT TCP">
87 ; <"IN","TCP">
88 ; <"IN","NOT TCP">
89 ;
90 N IEN,COUNTER,INC
91 I DIR="OUT" S INC=$S(+$G(TCP):0,1:100000000000)
92 I DIR="IN" S INC=$S(+$G(TCP):200000000000,1:300000000000)
93 S COUNTER=$NA(^HLC("FILE778",DIR,$S(+$G(TCP):"TCP",1:"NOT TCP")))
94AGAIN ;
95 S IEN=$$INC^HLOSITE(COUNTER,1)
96 I IEN>100000000000 D
97 .L +@COUNTER:200
98 .I $T,@COUNTER>100000000000 S @COUNTER=1,IEN=1
99 .L -@COUNTER
100 I IEN>100000000000 G AGAIN
101 Q (IEN+INC)
102 ;
103TCP() ;checks the link to see if its TCP, return 1 if yes, 0 if no or not defined
104 N IEN,TCP
105 S TCP=1
106 S IEN=$G(HLMSTATE("STATUS","LINK IEN"))
107 I IEN,$P($G(^HLCS(869.1,+$P($G(^HLCS(870,IEN,0)),"^",3),0)),"^")'="TCP" S TCP=0
108 Q TCP
109 ;
110GETWORK(WORK) ; Used by the Process Manager.
111 ;Are there any messages that need the "SEARCH" x-ref set?
112 ;Inputs:
113 ; WORK (required, pass-by-reference)
114 ; ("DOLLARJ")
115 ; ("NOW") (required by the process manager, pass-by-reference)
116 ;
117 L +^HLTMP("PENDING SEARCH X-REF"):0
118 Q:'$T 0
119 N OLD,DOLLARJ,SUCCESS,NOW
120 S SUCCESS=0
121 S NOW=$$SEC^XLFDT($H)
122 S (OLD,DOLLARJ)=$G(WORK("DOLLARJ"))
123 F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS
124 .N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,""))
125 .S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1
126 ;
127 I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS
128 .N TIME S TIME=$O(^HLTMP("PENDING SEARCH X-REF",DOLLARJ,""))
129 .S:(NOW-$$SEC^XLFDT(TIME)>100) SUCCESS=1
130 S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW
131 Q:WORK("DOLLARJ")]"" 1
132 L -^HLTMP("PENDING SEARCH X-REF")
133 Q 0
134 ;
135DOWORK(WORK) ;Used by the Process Manager
136 ;Sets the "SEARCH" x-ref, running 100 seconds behind when the message record was created.
137 ;
138 N MSGIEN,TIME
139 S TIME=0
140 F S TIME=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME)) Q:'TIME Q:((WORK("NOW")-$$SEC^XLFDT(TIME))<100) D
141 .S MSGIEN=0
142 .F S MSGIEN=$O(^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN)) Q:'MSGIEN D
143 ..N MSG
144 ..I $$GETMSG^HLOMSG(MSGIEN,.MSG) D
145 ...Q:'MSG("DT/TM CREATED")
146 ...I MSG("BATCH") D
147 ....N HDR
148 ....F Q:'$$NEXTMSG^HLOMSG(.MSG,.HDR) S MSG("HDR",1)=HDR(1),MSG("HDR",2)=HDR(2) D SET(.MSG)
149 ...E D
150 ....D SET(.MSG)
151 ..K ^HLTMP("PENDING SEARCH X-REF",WORK("DOLLARJ"),TIME,MSGIEN)
152 L -^HLTMP("PENDING SEARCH X-REF")
153 Q
154 ;
155SET(MSG) ;
156 ;sets the ^HLB("SEARCH") x-ref
157 ;
158 N APP,FS,CS,IEN
159 I MSG("DIRECTION")'="IN",MSG("DIRECTION")'="OUT" Q
160 S FS=$E(MSG("HDR",1),4)
161 Q:FS=""
162 S CS=$E(MSG("HDR",1),5)
163 S APP=$S(MSG("DIRECTION")="IN":$P($P(MSG("HDR",1),FS,5),CS),1:$P($P(MSG("HDR",1),FS,3),CS))
164 I APP="" S APP="UNKNOWN"
165 I MSG("BATCH") D
166 .N VALUE
167 .S VALUE=$P(MSG("HDR",2),FS,4)
168 .S MSG("MESSAGE TYPE")=$P(VALUE,CS)
169 .S MSG("EVENT")=$P(VALUE,CS,2)
170 S:MSG("MESSAGE TYPE")="" MSG("MESSAGE TYPE")="<none>"
171 S:MSG("EVENT")="" MSG("EVENT")="<none>"
172 S IEN=MSG("IEN")
173 I MSG("BATCH") S IEN=IEN_"^"_MSG("BATCH","CURRENT MESSAGE")
174 S ^HLB("SEARCH",MSG("DIRECTION"),MSG("DT/TM CREATED"),APP,MSG("MESSAGE TYPE"),MSG("EVENT"),IEN)=""
175 Q
Note: See TracBrowser for help on using the repository browser.