source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLUTIL.m@ 1464

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

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1HLUTIL ;SFISC/RJH- Utilities for HL7 TCP ;08/24/2000 16:55
2 ;;1.6;HEALTH LEVEL SEVEN;**36,19,57,64,66,109**;Oct 13, 1995
3 Q
4 ;For TCP only
5MSGSTAT(X) ;message status
6 ;input value: X = message id
7 ;return value: status^status updated^error msg.^error type pointer^
8 ;queue position or # of retries^# open failed^ack timeout
9 ; status:
10 ; 0 = message doesn't exist
11 ; 1 = waiting in queue
12 ; 1.5 = opening connection
13 ; 1.7 = awaiting response, # of retries
14 ; 2 = awaiting application ack
15 ; 3 = successfully completed
16 ; 4 = error
17 ; 8 = being generated
18 ; 9 = awaiting processing
19 Q:$G(X)']"" 0
20 N C,I,L,Y,Z
21 S Y=$O(^HLMA("C",X,0)) Q:'Y 0
22 ;lock node to flush disk buffers
23 L +^HLMA(Y,"P"):3 S Z=$G(^HLMA(Y,"P"))
24 S:'Z Z=0
25 ;if pending, get queue position
26 I +Z=1 D
27 . ;get Logical Link, if msg. not in x-ref, then it is being sent
28 . S L=+$P(^HLMA(Y,0),U,7) Q:'$D(^HLMA("AC","O",L,Y))
29 . ;find position in queue, if greater than 2 - use 2
30 . S I=Y F C=1:1:2 S I=$O(^HLMA("AC","O",L,I),-1) Q:'I
31 . S $P(Z,U,5)=C
32 L -^HLMA(Y,"P")
33 Q Z
34 ;
35MSGACT(X,HLIENACT) ;outgoing message action
36 ;input value: X = message id
37 ; HLIENACT = 1-cancel; 2-requeue
38 ;return value: 1 = action sucessful
39 ; 0 = action failed
40 Q:$G(X)']"" 0
41 N HLIEN,HLIEN0,HLSTAT,HLTCP,Y,LINK
42 S HLIEN=+$O(^HLMA("C",X,0)) Q:'HLIEN 0
43 S HLIEN0=$G(^HLMA(HLIEN,0)) Q:'HLIEN0 0
44 ;must be outgoing
45 Q:$P(HLIEN0,U,3)'="O" 0
46 F Y=1:1:3 L +^HLMA(HLIEN,"P"):1 Q:$T H 1
47 E Q 0
48 ;
49 ;**109**
50 S LINK=$P($G(^HLMA(HLIEN,0)),"^",7)
51 ;
52 S HLSTAT=1
53 ;cancel
54 I HLIENACT=1 D
55 . ;HLTCP is set so that file 773 is updated
56 . S HLTCP=""
57 . D STATUS^HLTF0(HLIEN,3,,"Cancelled by application",1)
58 .;
59 .;**109**
60 . D DEQUE^HLCSREP(LINK,"O",HLIEN)
61 .;
62 ;requeue
63 I HLIENACT=2 D
64 . N DA,DIK,HLJ
65 . ;check for type=outgoing and logical link, need for "AC" x-ref
66 . I $P(HLIEN0,U,3)'="O"!('$P(HLIEN0,U,7)) S HLSTAT=0 Q
67 . ;set status=pend transmission
68 . S Y=$NA(HLJ(773,HLIEN_",")),@Y@(20)=1
69 . ;delete status update, error msg, error type, date processed
70 . S (@Y@(21),@Y@(22),@Y@(23),@Y@(100))="@"
71 . D FILE^HLDIE("","HLJ","","MSGACT","HLUTIL") ; HL*1.6*109
72 . ;**109**
73 . ;need to set "AC" x-ref
74 .; S DA=HLIEN,DIK="^HLMA(",DIK(1)="7^AC"
75 .; D EN1^DIK
76 .;
77 .;**109**
78 . D ENQUE^HLCSREP(LINK,"O",HLIEN)
79 ;
80 L -^HLMA(HLIEN,"P")
81 Q HLSTAT
82 ;
83CHKLL(X) ;check setup of Logical Link
84 ;input value: X = institution number or name
85 ;return value: 1 = setup OK
86 ; 0 = LL setup incorrect
87 N HLF,HLRESLT
88 S HLF=$S(X:"I",1:"")
89 D LINK^HLUTIL3(X,.HLRESLT,HLF)
90 S X=+$O(HLRESLT(0)) Q:'X 0
91 Q $$LLOK^HLCSLM(X)
92 ;
93DONTPURG() ; set the DONT PURGE field to 1 in order to prevent the message
94 ; from purging.
95 ; return value : 1 for successfully set the field
96 ; -1 for failure
97 Q $$SETPURG(1)
98 ;
99TOPURG() ; clear the DONT PURGE field to allow the message to be purged.
100 ; return value : 0 for successfully clear the field
101 ; -1 for failure
102 Q $$SETPURG(0)
103 ;
104SETPURG(STATUS) ; to set or to clear the DONT PURGE field
105 ; HLMTIENS = ien in file 773 for this message
106 ; input: 1 to set the DONT PURGE field
107 ; 0 to clear the DONT PURGE field.
108 ; return value: 1 means successfully set the DONT PURGE field
109 ; 0 means successfully clear the DONT PURGE field
110 ; -1 means fail to set or to clear the field
111 I (STATUS'=1),(STATUS'=0) Q -1
112 I '$D(^HLMA(+$G(HLMTIENS),0)) Q -1
113 ;
114 L +^HLMA(HLMTIENS):30
115 E Q -1
116 S $P(^HLMA(HLMTIENS,2),U)=STATUS
117 L -^HLMA(HLMTIENS)
118 Q STATUS
119 ;
120REPROC(IEN,RTN) ; reprocessing message
121 ; IEN- the message IEN in file 773
122 ; RTN- the routine, to be Xecuted for processing the message
123 ; return value: 0 for success, -1 for failure
124 N HLMTIEN,HLMTIENS,HLNEXT,HLNODE,HLQUIT,HLERR,HLRESLT,HLTCP
125 N HL,HDR,FS,ECH,HLMSA,X,X1,X2
126 S HLQUIT=0,HLNODE="",HLNEXT="D HLNEXT^HLCSUTL"
127 I '$D(^HLMA(+$G(IEN),0)) Q -1
128 I $G(RTN)'["" Q -1
129 S (HLMTIENS,HLTCP)=+IEN,HLMTIEN=+^HLMA(HLMTIENS,0),HLMSA=$$MSA^HLTP3(HLMTIEN)
130 M HDR=^HLMA(HLMTIENS,"MSH")
131 D CHK^HLTPCK2(.HDR,.HL,.HLMSA)
132 Q:HL'="" -1
133 ;
134 I RTN["D " X RTN
135 I RTN'["D " D
136 . I RTN["^" X "D "_RTN
137 . I RTN'["^" X "D ^"_RTN
138 S HLRESLT=0 S:($D(HLERR)) HLRESLT="9^"_$G(^HL(771.7,9,0))
139 ; update the status
140 D STATUS^HLTF0(HLMTIENS,$S(HLRESLT:4,1:3),$S(HLRESLT:+HLRESLT,1:""),$S($D(HLERR):HLERR,HLRESLT:$P(HLRESLT,"^",2),1:""),1)
141 Q 0
Note: See TracBrowser for help on using the repository browser.