source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCIUT3.m@ 1404

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

initial load of WorldVistAEHR
File size: 8.9 KB
RevLine 
[613]1IBCIUT3 ;DSI/ESG - TCP/IP UTILITIES FOR CLAIMSMANAGER INTERFACE ;4-JAN-2001
2 ;;2.0;INTEGRATED BILLING;**161,226**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; Can't call from the top
6 Q
7 ;
8READ(Z,PROBLEM,IBCISOCK) ; ClaimsManager read message/close port/unlock port utility
9 ;
10 ; A utility to read the ACK/NAK, read the ClaimsManager response,
11 ; write the ACK, close the port, and unlock the port.
12 ;
13 ; Data will get returned in the Z array and if there's a problem
14 ; of any kind, it will get returned in variable PROBLEM which is just
15 ; a number.
16 ;
17 ; IBCISOCK is the current tcp/ip port number that is being passed in
18 ; here so this port can be unlocked after reading is complete.
19 ;
20 NEW ACK,CH,CHAR,CNT,DATA,ERRLN,ERRTXT,INGTO,J,K,MAXSIZE,MINSTORE,NAK
21 NEW POP,RESP,SEGMENT,SEGNUM,SEQ,SGT,SGTNUM,STOP,STORERR,SUB2,Z0
22 NEW $ESTACK,$ETRAP S $ETRAP="D ERRTRP^IBCIUT3" ; ib*226 TJH/EG
23 ;
24 ; Initialize variables
25 ; INGTO - Ingenix ClaimsManager read time-out
26 ; MINSTORE - minimum local symbol table size
27 ; ACK/NAK - Ingenix ClaimsManager positive/negative acknowledgement
28 ; STORERR - local storage error flag
29 ; PROBLEM - parameter which stores the problem#
30 ;
31 S INGTO=300,MINSTORE=11000,ACK=$C(1,6,3),NAK=$C(15),STORERR=0,PROBLEM=0
32 KILL Z,^TMP($J,"CMRESP2")
33 ;
34 ; Read #1
35 ; Quit if we encounter a time-out, an ascii-3, or storage problems
36 S RESP(1)=""
37 F CNT=1:1:100 R CH#1:INGTO S RESP(1)=RESP(1)_CH Q:'$T Q:$A(CH)=3 Q:$S<MINSTORE
38 ;
39 ; If time-out situation or storage error, get out
40 I '$T S PROBLEM=1,Z="INCOMPLETE RESPONSE",Z(1,1)=RESP(1) G DONE
41 I $S<MINSTORE S STORERR=1,PROBLEM=2 G DONE
42 ;
43 ; If we receive something other than an ACK, then it must be a NAK
44 ; and we should get out.
45 I RESP(1)'=ACK D G DONE
46 . S Z="TCP/IP READ ERROR: DIDN'T RECEIVE AN ACK MESSAGE FIRST"
47 . I $E(RESP(1),2)=NAK S Z="RECEIVED A NAK",RESP(1)=$TR(RESP(1),$C(1,3,15))
48 . S Z(1,1)=RESP(1)
49 . S PROBLEM=3
50 . Q
51 ;
52 ; Read #2
53 ; Quit if we encounter a time-out, an ascii-3, or storage problems
54 S RESP(2)="",SUB2=0
55 F CNT=1:1 R CH#1:INGTO S RESP(2)=RESP(2)_CH Q:'$T Q:$A(CH)=3 Q:$S<MINSTORE I CNT#200=0 S SUB2=SUB2+1,^TMP($J,"CMRESP2",SUB2)=RESP(2),RESP(2)=""
56 ;
57 ; We're done reading so file in the scratch global any additional
58 ; characters read in. Be very careful not to modify the value of $T.
59 S:RESP(2)'="" SUB2=SUB2+1,^TMP($J,"CMRESP2",SUB2)=RESP(2)
60 ;
61 ; If time-out situation or storage error, get out
62 I '$T S PROBLEM=4,Z="INCOMPLETE RESPONSE",Z(1,1)=$G(^TMP($J,"CMRESP2",1)) G DONE
63 I $S<MINSTORE S STORERR=1,PROBLEM=5 G DONE
64 ;
65 ; This should be the RESULTREC message. If it's something else, then
66 ; log an error and get out.
67 I $E(^TMP($J,"CMRESP2",1),1,17)'=($C(1,28,29,30)_"^'%RESULTREC"_$C(28)) D G DONE
68 . S Z="TCP/IP READ ERROR: DIDN'T RECEIVE A RESULTREC MESSAGE 2ND"
69 . S Z(1,1)=^TMP($J,"CMRESP2",1)
70 . S PROBLEM=6
71 . Q
72 ;
73DONE ; We're done with reading stuff.....Finish up with tcp/ip
74 ;
75 ; Write the final ACK only if no problems with the first read
76 I '$F(".1.2.3.","."_PROBLEM_".") W ACK,!
77 ;
78 DO CLOSE^%ZISTCP ; close the tcp/ip port
79 L -^IBCITCP(IBCISOCK) ; unlock the port
80 ;
81 ; If there's some problem, then get out now
82 I PROBLEM G READX
83 ;
84 ; Process the results and build the "Z" array
85 ;
86 ; We should see the following segments in this order:
87 ; RT - Route Segment (single occurrence)
88 ; HD - Header Segment (single occurrence)
89 ; RL - Result Line Segment (repeating)
90 ; LN - Line Segment (repeating)
91 ; We will not process the Line Segments because these are the
92 ; same data that we sent to ClaimsManager. We will stop processing
93 ; when we get into the Line Segments.
94 ;
95 ; Variables SEGMENT and SEGNUM indicate what we're currently processing.
96 ;
97 ; MAXSIZE is the number of characters of error text per line,
98 ; although we won't break the line in the middle of a word.
99 ;
100 S SGT="RT^HD^RL^LN",SEGMENT="RT",SEGNUM=1,SGTNUM=1,Z("RT",1)=""
101 S MAXSIZE=62,^TMP($J,"CMRESP2",1)=$E(^TMP($J,"CMRESP2",1),18,999),J="",STOP=0
102 ;
103 ; Loop through and process every character received by the read loop
104 F S J=$O(^TMP($J,"CMRESP2",J)) Q:J=""!STOP F K=1:1:$L(^TMP($J,"CMRESP2",J)) S CHAR=$E(^TMP($J,"CMRESP2",J),K) D Q:STOP
105 . ; new segment type coming up. Initialize and begin to process the next segment. Stop if we're into the Line segments.
106 . I CHAR=$C(28) D Q
107 .. S SGTNUM=SGTNUM+1
108 .. I SGTNUM>3 S STOP=1 Q
109 .. S SEGMENT=$P(SGT,U,SGTNUM),SEGNUM=1,Z(SEGMENT,SEGNUM)=""
110 .. I SEGMENT="RL" S SEQ=1,Z(SEGMENT,SEGNUM,SEQ)=""
111 .. Q
112 . ; another segment of the same type coming up. This is the segment repetition character. Just increment the segment number and keep the segment type the same.
113 . I CHAR=$C(29) D Q
114 .. S SEGNUM=SEGNUM+1,Z(SEGMENT,SEGNUM)=""
115 .. I SEGMENT="RL" S SEQ=1,Z(SEGMENT,SEGNUM,SEQ)=""
116 .. Q
117 . ; If we're processing the route or the header segments, then just add the character and quit. No maxstring problems with these segments.
118 . I SEGMENT'="RL" S Z(SEGMENT,SEGNUM)=Z(SEGMENT,SEGNUM)_CHAR Q
119 . ; At this point, we're processing a Result Line segment.
120 . ; Here is the field delimiter character. Increment the SEQuence id# and initialize the array entry and quit.
121 . I CHAR=$C(30) S SEQ=SEQ+1,Z(SEGMENT,SEGNUM,SEQ)="" Q
122 . ; If the sequence number is 1-3, then we don't have a problem with maxstring errors so go ahead and add the character and quit.
123 . I SEQ<4 S Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR Q
124 . ; Now we know we're processing the 2000 character EditDescription field in the Result Line segment. If we're OK length-wise or the character isn't a space or a hyphen or a comma, then just add it like normal and quit.
125 . I $L(Z(SEGMENT,SEGNUM,SEQ))<MAXSIZE!(" -,"'[CHAR) S Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR Q
126 . ; Here, we know the length is >= to the max size & the character is a space/hyphen/comma so it's a perfect time to split the text onto a new node. Add this character to the current string, increment the SEQ by .01 and init and quit.
127 . S Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR,SEQ=SEQ+.01,Z(SEGMENT,SEGNUM,SEQ)="" Q
128 . Q
129 ;
130 ; Do some more processing to the Result Line segment data and
131 ; clean it up a bit.
132 ;
133 S SEGMENT="RL",SEGNUM=""
134 F S SEGNUM=$O(Z(SEGMENT,SEGNUM)) Q:SEGNUM="" D
135 . S DATA=$G(Z(SEGMENT,SEGNUM,1))
136 . S Z(SEGMENT,SEGNUM,0)=$$TRIM($E(DATA,1,25))_U_$$TRIM($E(DATA,26,45))_U_$$TRIM($E(DATA,46,50))_U_$$TRIM($E(DATA,131))_U_$$TRIM($E(DATA,132,141))_U_$$TRIM(Z(SEGMENT,SEGNUM,2))
137 . S Z0=Z(SEGMENT,SEGNUM,0)
138 . ;
139 . ; now loop thru the SEQ #4 data (EditDescription) and build
140 . ; the "E" area of the array. This replaces the 4* nodes so we
141 . ; can kill this area as we go.
142 . S SEQ=3
143 . F S SEQ=$O(Z(SEGMENT,SEGNUM,SEQ)) Q:$E(SEQ)'=4 D
144 .. S ERRTXT=Z(SEGMENT,SEGNUM,SEQ)
145 .. S ERRTXT=$TR(ERRTXT,$C(10))
146 .. KILL Z(SEGMENT,SEGNUM,SEQ)
147 .. I $TR(ERRTXT," ")="" Q
148 .. S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
149 .. S Z(SEGMENT,SEGNUM,"E",ERRLN)=ERRTXT
150 .. Q
151 . ;
152 . ; Now append the AutoFix data if it exists
153 . I $P(Z0,U,4)="Y",$P(Z0,U,6)'="" D AUTOFIX
154 . Q
155 ;
156READX ;
157 KILL ^TMP($J,"CMRESP2")
158 Q
159 ;
160 ; For speed reasons, code taken from TRIM^XLFSTR
161TRIM(X,SIDE,CHAR) ;Trim chars from left/right of string
162 NEW LEFT,RIGHT
163 I X="" Q X
164 S SIDE=$G(SIDE,"LR"),CHAR=$G(CHAR," "),LEFT=1,RIGHT=$L(X)
165 I X=CHAR Q ""
166 I SIDE["R" F RIGHT=$L(X):-1:1 Q:$E(X,RIGHT)'=CHAR
167 I SIDE["L" F LEFT=1:1:$L(X) Q:$E(X,LEFT)'=CHAR
168 Q $E(X,LEFT,RIGHT)
169 ;
170 ;
171AUTOFIX ; Append the AutoFix data to the rest of the error message
172 NEW AFMSG,AFT,AFW,AFV,AF,AFLN
173 ; first two autofix lines here
174 S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
175 S Z(SEGMENT,SEGNUM,"E",ERRLN)=" " ; blank line here
176 S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
177 S Z(SEGMENT,SEGNUM,"E",ERRLN)="*** ClaimsManager AutoFix Indicated ***"
178 ; construct the actual message
179 S AFMSG="A possible fix for Line Item "_$P(Z0,U,1)_" is to "
180 S AFT=$E($P(Z0,U,5),1,3),AFW=$E($P(Z0,U,5),4,99),AFV=$P(Z0,U,6)
181 S AFMSG=AFMSG_$S(AFT="ADD":"add",AFT="DEL":"delete",AFT="CHG":"change",1:$P(Z0,U,5))_" the "
182 S AFMSG=AFMSG_$S(AFW="PROC":"procedure code",AFW="MOD":"modifier",1:$P(Z0,U,5))_" "
183 I AFT="CHG" S AFMSG=AFMSG_"to be "_AFV_" instead."
184 E S AFMSG=AFMSG_AFV_"."
185 ;
186 ; call an IB utility to parse AFMSG into lines of acceptable length
187 D FSTRNG(AFMSG,MAXSIZE,.AF)
188 ;
189 ; put the data into the Z array
190 F AFLN=1:1:AF D
191 . S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
192 . S Z(SEGMENT,SEGNUM,"E",ERRLN)=AF(AFLN)
193 . Q
194AFX ;
195 Q
196 ;
197FSTRNG(STR,WD,ARRAY) ; please see IBJU1 for documentation
198 NEW %,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I,Z
199 D FSTRNG^IBJU1(STR,WD,.ARRAY)
200 Q
201 ;
202ERRTRP ; Error trap processing ; ib*226 TJH/EG
203 S Z(1,1)=$$EC^%ZOSV ; mumps error location and description
204 S Z="A SYSTEM ERROR HAS BEEN DETECTED AT THE FOLLOWING LOCATION"
205 S PROBLEM=7
206 D CLOSE^%ZISTCP ; close the tcp/ip port
207 L -^IBCITCP(IBCISOCK) ; unlock the current port
208 K ^TMP($J,"CMRESP2") ; kill scratch global
209 D ^%ZTER ; record the error in the trap
210 G UNWIND^%ZTER ; unwind stack levels
211 ;
Note: See TracBrowser for help on using the repository browser.