IBCIUT3 ;DSI/ESG - TCP/IP UTILITIES FOR CLAIMSMANAGER INTERFACE ;4-JAN-2001
;;2.0;INTEGRATED BILLING;**161,226**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Can't call from the top
Q
;
READ(Z,PROBLEM,IBCISOCK) ; ClaimsManager read message/close port/unlock port utility
;
; A utility to read the ACK/NAK, read the ClaimsManager response,
; write the ACK, close the port, and unlock the port.
;
; Data will get returned in the Z array and if there's a problem
; of any kind, it will get returned in variable PROBLEM which is just
; a number.
;
; IBCISOCK is the current tcp/ip port number that is being passed in
; here so this port can be unlocked after reading is complete.
;
NEW ACK,CH,CHAR,CNT,DATA,ERRLN,ERRTXT,INGTO,J,K,MAXSIZE,MINSTORE,NAK
NEW POP,RESP,SEGMENT,SEGNUM,SEQ,SGT,SGTNUM,STOP,STORERR,SUB2,Z0
NEW $ESTACK,$ETRAP S $ETRAP="D ERRTRP^IBCIUT3" ; ib*226 TJH/EG
;
; Initialize variables
; INGTO - Ingenix ClaimsManager read time-out
; MINSTORE - minimum local symbol table size
; ACK/NAK - Ingenix ClaimsManager positive/negative acknowledgement
; STORERR - local storage error flag
; PROBLEM - parameter which stores the problem#
;
S INGTO=300,MINSTORE=11000,ACK=$C(1,6,3),NAK=$C(15),STORERR=0,PROBLEM=0
KILL Z,^TMP($J,"CMRESP2")
;
; Read #1
; Quit if we encounter a time-out, an ascii-3, or storage problems
S RESP(1)=""
F CNT=1:1:100 R CH#1:INGTO S RESP(1)=RESP(1)_CH Q:'$T Q:$A(CH)=3 Q:$S<MINSTORE
;
; If time-out situation or storage error, get out
I '$T S PROBLEM=1,Z="INCOMPLETE RESPONSE",Z(1,1)=RESP(1) G DONE
I $S<MINSTORE S STORERR=1,PROBLEM=2 G DONE
;
; If we receive something other than an ACK, then it must be a NAK
; and we should get out.
I RESP(1)'=ACK D G DONE
. S Z="TCP/IP READ ERROR: DIDN'T RECEIVE AN ACK MESSAGE FIRST"
. I $E(RESP(1),2)=NAK S Z="RECEIVED A NAK",RESP(1)=$TR(RESP(1),$C(1,3,15))
. S Z(1,1)=RESP(1)
. S PROBLEM=3
. Q
;
; Read #2
; Quit if we encounter a time-out, an ascii-3, or storage problems
S RESP(2)="",SUB2=0
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)=""
;
; We're done reading so file in the scratch global any additional
; characters read in. Be very careful not to modify the value of $T.
S:RESP(2)'="" SUB2=SUB2+1,^TMP($J,"CMRESP2",SUB2)=RESP(2)
;
; If time-out situation or storage error, get out
I '$T S PROBLEM=4,Z="INCOMPLETE RESPONSE",Z(1,1)=$G(^TMP($J,"CMRESP2",1)) G DONE
I $S<MINSTORE S STORERR=1,PROBLEM=5 G DONE
;
; This should be the RESULTREC message. If it's something else, then
; log an error and get out.
I $E(^TMP($J,"CMRESP2",1),1,17)'=($C(1,28,29,30)_"^'%RESULTREC"_$C(28)) D G DONE
. S Z="TCP/IP READ ERROR: DIDN'T RECEIVE A RESULTREC MESSAGE 2ND"
. S Z(1,1)=^TMP($J,"CMRESP2",1)
. S PROBLEM=6
. Q
;
DONE ; We're done with reading stuff.....Finish up with tcp/ip
;
; Write the final ACK only if no problems with the first read
I '$F(".1.2.3.","."_PROBLEM_".") W ACK,!
;
DO CLOSE^%ZISTCP ; close the tcp/ip port
L -^IBCITCP(IBCISOCK) ; unlock the port
;
; If there's some problem, then get out now
I PROBLEM G READX
;
; Process the results and build the "Z" array
;
; We should see the following segments in this order:
; RT - Route Segment (single occurrence)
; HD - Header Segment (single occurrence)
; RL - Result Line Segment (repeating)
; LN - Line Segment (repeating)
; We will not process the Line Segments because these are the
; same data that we sent to ClaimsManager. We will stop processing
; when we get into the Line Segments.
;
; Variables SEGMENT and SEGNUM indicate what we're currently processing.
;
; MAXSIZE is the number of characters of error text per line,
; although we won't break the line in the middle of a word.
;
S SGT="RT^HD^RL^LN",SEGMENT="RT",SEGNUM=1,SGTNUM=1,Z("RT",1)=""
S MAXSIZE=62,^TMP($J,"CMRESP2",1)=$E(^TMP($J,"CMRESP2",1),18,999),J="",STOP=0
;
; Loop through and process every character received by the read loop
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
. ; new segment type coming up. Initialize and begin to process the next segment. Stop if we're into the Line segments.
. I CHAR=$C(28) D Q
.. S SGTNUM=SGTNUM+1
.. I SGTNUM>3 S STOP=1 Q
.. S SEGMENT=$P(SGT,U,SGTNUM),SEGNUM=1,Z(SEGMENT,SEGNUM)=""
.. I SEGMENT="RL" S SEQ=1,Z(SEGMENT,SEGNUM,SEQ)=""
.. Q
. ; 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.
. I CHAR=$C(29) D Q
.. S SEGNUM=SEGNUM+1,Z(SEGMENT,SEGNUM)=""
.. I SEGMENT="RL" S SEQ=1,Z(SEGMENT,SEGNUM,SEQ)=""
.. Q
. ; If we're processing the route or the header segments, then just add the character and quit. No maxstring problems with these segments.
. I SEGMENT'="RL" S Z(SEGMENT,SEGNUM)=Z(SEGMENT,SEGNUM)_CHAR Q
. ; At this point, we're processing a Result Line segment.
. ; Here is the field delimiter character. Increment the SEQuence id# and initialize the array entry and quit.
. I CHAR=$C(30) S SEQ=SEQ+1,Z(SEGMENT,SEGNUM,SEQ)="" Q
. ; 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.
. I SEQ<4 S Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR Q
. ; 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.
. I $L(Z(SEGMENT,SEGNUM,SEQ))<MAXSIZE!(" -,"'[CHAR) S Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR Q
. ; 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.
. S Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR,SEQ=SEQ+.01,Z(SEGMENT,SEGNUM,SEQ)="" Q
. Q
;
; Do some more processing to the Result Line segment data and
; clean it up a bit.
;
S SEGMENT="RL",SEGNUM=""
F S SEGNUM=$O(Z(SEGMENT,SEGNUM)) Q:SEGNUM="" D
. S DATA=$G(Z(SEGMENT,SEGNUM,1))
. 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))
. S Z0=Z(SEGMENT,SEGNUM,0)
. ;
. ; now loop thru the SEQ #4 data (EditDescription) and build
. ; the "E" area of the array. This replaces the 4* nodes so we
. ; can kill this area as we go.
. S SEQ=3
. F S SEQ=$O(Z(SEGMENT,SEGNUM,SEQ)) Q:$E(SEQ)'=4 D
.. S ERRTXT=Z(SEGMENT,SEGNUM,SEQ)
.. S ERRTXT=$TR(ERRTXT,$C(10))
.. KILL Z(SEGMENT,SEGNUM,SEQ)
.. I $TR(ERRTXT," ")="" Q
.. S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
.. S Z(SEGMENT,SEGNUM,"E",ERRLN)=ERRTXT
.. Q
. ;
. ; Now append the AutoFix data if it exists
. I $P(Z0,U,4)="Y",$P(Z0,U,6)'="" D AUTOFIX
. Q
;
READX ;
KILL ^TMP($J,"CMRESP2")
Q
;
; For speed reasons, code taken from TRIM^XLFSTR
TRIM(X,SIDE,CHAR) ;Trim chars from left/right of string
NEW LEFT,RIGHT
I X="" Q X
S SIDE=$G(SIDE,"LR"),CHAR=$G(CHAR," "),LEFT=1,RIGHT=$L(X)
I X=CHAR Q ""
I SIDE["R" F RIGHT=$L(X):-1:1 Q:$E(X,RIGHT)'=CHAR
I SIDE["L" F LEFT=1:1:$L(X) Q:$E(X,LEFT)'=CHAR
Q $E(X,LEFT,RIGHT)
;
;
AUTOFIX ; Append the AutoFix data to the rest of the error message
NEW AFMSG,AFT,AFW,AFV,AF,AFLN
; first two autofix lines here
S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
S Z(SEGMENT,SEGNUM,"E",ERRLN)=" " ; blank line here
S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
S Z(SEGMENT,SEGNUM,"E",ERRLN)="*** ClaimsManager AutoFix Indicated ***"
; construct the actual message
S AFMSG="A possible fix for Line Item "_$P(Z0,U,1)_" is to "
S AFT=$E($P(Z0,U,5),1,3),AFW=$E($P(Z0,U,5),4,99),AFV=$P(Z0,U,6)
S AFMSG=AFMSG_$S(AFT="ADD":"add",AFT="DEL":"delete",AFT="CHG":"change",1:$P(Z0,U,5))_" the "
S AFMSG=AFMSG_$S(AFW="PROC":"procedure code",AFW="MOD":"modifier",1:$P(Z0,U,5))_" "
I AFT="CHG" S AFMSG=AFMSG_"to be "_AFV_" instead."
E S AFMSG=AFMSG_AFV_"."
;
; call an IB utility to parse AFMSG into lines of acceptable length
D FSTRNG(AFMSG,MAXSIZE,.AF)
;
; put the data into the Z array
F AFLN=1:1:AF D
. S (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$G(Z(SEGMENT,SEGNUM,"E",0))+1
. S Z(SEGMENT,SEGNUM,"E",ERRLN)=AF(AFLN)
. Q
AFX ;
Q
;
FSTRNG(STR,WD,ARRAY) ; please see IBJU1 for documentation
NEW %,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I,Z
D FSTRNG^IBJU1(STR,WD,.ARRAY)
Q
;
ERRTRP ; Error trap processing ; ib*226 TJH/EG
S Z(1,1)=$$EC^%ZOSV ; mumps error location and description
S Z="A SYSTEM ERROR HAS BEEN DETECTED AT THE FOLLOWING LOCATION"
S PROBLEM=7
D CLOSE^%ZISTCP ; close the tcp/ip port
L -^IBCITCP(IBCISOCK) ; unlock the current port
K ^TMP($J,"CMRESP2") ; kill scratch global
D ^%ZTER ; record the error in the trap
G UNWIND^%ZTER ; unwind stack levels
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCIUT3 9312 printed Dec 13, 2024@02:13:28 Page 2
IBCIUT3 ;DSI/ESG - TCP/IP UTILITIES FOR CLAIMSMANAGER INTERFACE ;4-JAN-2001
+1 ;;2.0;INTEGRATED BILLING;**161,226**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Can't call from the top
+5 QUIT
+6 ;
READ(Z,PROBLEM,IBCISOCK) ; ClaimsManager read message/close port/unlock port utility
+1 ;
+2 ; A utility to read the ACK/NAK, read the ClaimsManager response,
+3 ; write the ACK, close the port, and unlock the port.
+4 ;
+5 ; Data will get returned in the Z array and if there's a problem
+6 ; of any kind, it will get returned in variable PROBLEM which is just
+7 ; a number.
+8 ;
+9 ; IBCISOCK is the current tcp/ip port number that is being passed in
+10 ; here so this port can be unlocked after reading is complete.
+11 ;
+12 NEW ACK,CH,CHAR,CNT,DATA,ERRLN,ERRTXT,INGTO,J,K,MAXSIZE,MINSTORE,NAK
+13 NEW POP,RESP,SEGMENT,SEGNUM,SEQ,SGT,SGTNUM,STOP,STORERR,SUB2,Z0
+14 ; ib*226 TJH/EG
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERRTRP^IBCIUT3"
+15 ;
+16 ; Initialize variables
+17 ; INGTO - Ingenix ClaimsManager read time-out
+18 ; MINSTORE - minimum local symbol table size
+19 ; ACK/NAK - Ingenix ClaimsManager positive/negative acknowledgement
+20 ; STORERR - local storage error flag
+21 ; PROBLEM - parameter which stores the problem#
+22 ;
+23 SET INGTO=300
SET MINSTORE=11000
SET ACK=$CHAR(1,6,3)
SET NAK=$CHAR(15)
SET STORERR=0
SET PROBLEM=0
+24 KILL Z,^TMP($JOB,"CMRESP2")
+25 ;
+26 ; Read #1
+27 ; Quit if we encounter a time-out, an ascii-3, or storage problems
+28 SET RESP(1)=""
+29 FOR CNT=1:1:100
READ CH#1:INGTO
SET RESP(1)=RESP(1)_CH
if '$TEST
QUIT
if $ASCII(CH)=3
QUIT
if $STORAGE<MINSTORE
QUIT
+30 ;
+31 ; If time-out situation or storage error, get out
+32 IF '$TEST
SET PROBLEM=1
SET Z="INCOMPLETE RESPONSE"
SET Z(1,1)=RESP(1)
GOTO DONE
+33 IF $STORAGE<MINSTORE
SET STORERR=1
SET PROBLEM=2
GOTO DONE
+34 ;
+35 ; If we receive something other than an ACK, then it must be a NAK
+36 ; and we should get out.
+37 IF RESP(1)'=ACK
Begin DoDot:1
+38 SET Z="TCP/IP READ ERROR: DIDN'T RECEIVE AN ACK MESSAGE FIRST"
+39 IF $EXTRACT(RESP(1),2)=NAK
SET Z="RECEIVED A NAK"
SET RESP(1)=$TRANSLATE(RESP(1),$CHAR(1,3,15))
+40 SET Z(1,1)=RESP(1)
+41 SET PROBLEM=3
+42 QUIT
End DoDot:1
GOTO DONE
+43 ;
+44 ; Read #2
+45 ; Quit if we encounter a time-out, an ascii-3, or storage problems
+46 SET RESP(2)=""
SET SUB2=0
+47 FOR CNT=1:1
READ CH#1:INGTO
SET RESP(2)=RESP(2)_CH
if '$TEST
QUIT
if $ASCII(CH)=3
QUIT
if $STORAGE<MINSTORE
QUIT
IF CNT#200=0
SET SUB2=SUB2+1
SET ^TMP($JOB,"CMRESP2",SUB2)=RESP(2)
SET RESP(2)=""
+48 ;
+49 ; We're done reading so file in the scratch global any additional
+50 ; characters read in. Be very careful not to modify the value of $T.
+51 if RESP(2)'=""
SET SUB2=SUB2+1
SET ^TMP($JOB,"CMRESP2",SUB2)=RESP(2)
+52 ;
+53 ; If time-out situation or storage error, get out
+54 IF '$TEST
SET PROBLEM=4
SET Z="INCOMPLETE RESPONSE"
SET Z(1,1)=$GET(^TMP($JOB,"CMRESP2",1))
GOTO DONE
+55 IF $STORAGE<MINSTORE
SET STORERR=1
SET PROBLEM=5
GOTO DONE
+56 ;
+57 ; This should be the RESULTREC message. If it's something else, then
+58 ; log an error and get out.
+59 IF $EXTRACT(^TMP($JOB,"CMRESP2",1),1,17)'=($CHAR(1,28,29,30)_"^'%RESULTREC"_$CHAR(28))
Begin DoDot:1
+60 SET Z="TCP/IP READ ERROR: DIDN'T RECEIVE A RESULTREC MESSAGE 2ND"
+61 SET Z(1,1)=^TMP($JOB,"CMRESP2",1)
+62 SET PROBLEM=6
+63 QUIT
End DoDot:1
GOTO DONE
+64 ;
DONE ; We're done with reading stuff.....Finish up with tcp/ip
+1 ;
+2 ; Write the final ACK only if no problems with the first read
+3 IF '$FIND(".1.2.3.","."_PROBLEM_".")
WRITE ACK,!
+4 ;
+5 ; close the tcp/ip port
DO CLOSE^%ZISTCP
+6 ; unlock the port
LOCK -^IBCITCP(IBCISOCK)
+7 ;
+8 ; If there's some problem, then get out now
+9 IF PROBLEM
GOTO READX
+10 ;
+11 ; Process the results and build the "Z" array
+12 ;
+13 ; We should see the following segments in this order:
+14 ; RT - Route Segment (single occurrence)
+15 ; HD - Header Segment (single occurrence)
+16 ; RL - Result Line Segment (repeating)
+17 ; LN - Line Segment (repeating)
+18 ; We will not process the Line Segments because these are the
+19 ; same data that we sent to ClaimsManager. We will stop processing
+20 ; when we get into the Line Segments.
+21 ;
+22 ; Variables SEGMENT and SEGNUM indicate what we're currently processing.
+23 ;
+24 ; MAXSIZE is the number of characters of error text per line,
+25 ; although we won't break the line in the middle of a word.
+26 ;
+27 SET SGT="RT^HD^RL^LN"
SET SEGMENT="RT"
SET SEGNUM=1
SET SGTNUM=1
SET Z("RT",1)=""
+28 SET MAXSIZE=62
SET ^TMP($JOB,"CMRESP2",1)=$EXTRACT(^TMP($JOB,"CMRESP2",1),18,999)
SET J=""
SET STOP=0
+29 ;
+30 ; Loop through and process every character received by the read loop
+31 FOR
SET J=$ORDER(^TMP($JOB,"CMRESP2",J))
if J=""!STOP
QUIT
FOR K=1:1:$LENGTH(^TMP($JOB,"CMRESP2",J))
SET CHAR=$EXTRACT(^TMP($JOB,"CMRESP2",J),K)
Begin DoDot:1
+32 ; new segment type coming up. Initialize and begin to process the next segment. Stop if we're into the Line segments.
+33 IF CHAR=$CHAR(28)
Begin DoDot:2
+34 SET SGTNUM=SGTNUM+1
+35 IF SGTNUM>3
SET STOP=1
QUIT
+36 SET SEGMENT=$PIECE(SGT,U,SGTNUM)
SET SEGNUM=1
SET Z(SEGMENT,SEGNUM)=""
+37 IF SEGMENT="RL"
SET SEQ=1
SET Z(SEGMENT,SEGNUM,SEQ)=""
+38 QUIT
End DoDot:2
QUIT
+39 ; 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.
+40 IF CHAR=$CHAR(29)
Begin DoDot:2
+41 SET SEGNUM=SEGNUM+1
SET Z(SEGMENT,SEGNUM)=""
+42 IF SEGMENT="RL"
SET SEQ=1
SET Z(SEGMENT,SEGNUM,SEQ)=""
+43 QUIT
End DoDot:2
QUIT
+44 ; If we're processing the route or the header segments, then just add the character and quit. No maxstring problems with these segments.
+45 IF SEGMENT'="RL"
SET Z(SEGMENT,SEGNUM)=Z(SEGMENT,SEGNUM)_CHAR
QUIT
+46 ; At this point, we're processing a Result Line segment.
+47 ; Here is the field delimiter character. Increment the SEQuence id# and initialize the array entry and quit.
+48 IF CHAR=$CHAR(30)
SET SEQ=SEQ+1
SET Z(SEGMENT,SEGNUM,SEQ)=""
QUIT
+49 ; 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.
+50 IF SEQ<4
SET Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR
QUIT
+51 ; 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.
+52 IF $LENGTH(Z(SEGMENT,SEGNUM,SEQ))<MAXSIZE!(" -,"'[CHAR)
SET Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR
QUIT
+53 ; 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.
+54 SET Z(SEGMENT,SEGNUM,SEQ)=Z(SEGMENT,SEGNUM,SEQ)_CHAR
SET SEQ=SEQ+.01
SET Z(SEGMENT,SEGNUM,SEQ)=""
QUIT
+55 QUIT
End DoDot:1
if STOP
QUIT
+56 ;
+57 ; Do some more processing to the Result Line segment data and
+58 ; clean it up a bit.
+59 ;
+60 SET SEGMENT="RL"
SET SEGNUM=""
+61 FOR
SET SEGNUM=$ORDER(Z(SEGMENT,SEGNUM))
if SEGNUM=""
QUIT
Begin DoDot:1
+62 SET DATA=$GET(Z(SEGMENT,SEGNUM,1))
+63 SET Z(SEGMENT,SEGNUM,0)=$$TRIM($EXTRACT(DATA,1,25))_U_$$TRIM($EXTRACT(DATA,26,45))_U_$$TRIM($EXTRACT(DATA,46,50))_U_$$TRIM($EXTRACT(DATA,131))_U_$$TRIM($EXTRACT(DATA,132,141))_U_$$TRIM(Z(SEGMENT,SEGNUM,2))
+64 SET Z0=Z(SEGMENT,SEGNUM,0)
+65 ;
+66 ; now loop thru the SEQ #4 data (EditDescription) and build
+67 ; the "E" area of the array. This replaces the 4* nodes so we
+68 ; can kill this area as we go.
+69 SET SEQ=3
+70 FOR
SET SEQ=$ORDER(Z(SEGMENT,SEGNUM,SEQ))
if $EXTRACT(SEQ)'=4
QUIT
Begin DoDot:2
+71 SET ERRTXT=Z(SEGMENT,SEGNUM,SEQ)
+72 SET ERRTXT=$TRANSLATE(ERRTXT,$CHAR(10))
+73 KILL Z(SEGMENT,SEGNUM,SEQ)
+74 IF $TRANSLATE(ERRTXT," ")=""
QUIT
+75 SET (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$GET(Z(SEGMENT,SEGNUM,"E",0))+1
+76 SET Z(SEGMENT,SEGNUM,"E",ERRLN)=ERRTXT
+77 QUIT
End DoDot:2
+78 ;
+79 ; Now append the AutoFix data if it exists
+80 IF $PIECE(Z0,U,4)="Y"
IF $PIECE(Z0,U,6)'=""
DO AUTOFIX
+81 QUIT
End DoDot:1
+82 ;
READX ;
+1 KILL ^TMP($JOB,"CMRESP2")
+2 QUIT
+3 ;
+4 ; For speed reasons, code taken from TRIM^XLFSTR
TRIM(X,SIDE,CHAR) ;Trim chars from left/right of string
+1 NEW LEFT,RIGHT
+2 IF X=""
QUIT X
+3 SET SIDE=$GET(SIDE,"LR")
SET CHAR=$GET(CHAR," ")
SET LEFT=1
SET RIGHT=$LENGTH(X)
+4 IF X=CHAR
QUIT ""
+5 IF SIDE["R"
FOR RIGHT=$LENGTH(X):-1:1
if $EXTRACT(X,RIGHT)'=CHAR
QUIT
+6 IF SIDE["L"
FOR LEFT=1:1:$LENGTH(X)
if $EXTRACT(X,LEFT)'=CHAR
QUIT
+7 QUIT $EXTRACT(X,LEFT,RIGHT)
+8 ;
+9 ;
AUTOFIX ; Append the AutoFix data to the rest of the error message
+1 NEW AFMSG,AFT,AFW,AFV,AF,AFLN
+2 ; first two autofix lines here
+3 SET (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$GET(Z(SEGMENT,SEGNUM,"E",0))+1
+4 ; blank line here
SET Z(SEGMENT,SEGNUM,"E",ERRLN)=" "
+5 SET (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$GET(Z(SEGMENT,SEGNUM,"E",0))+1
+6 SET Z(SEGMENT,SEGNUM,"E",ERRLN)="*** ClaimsManager AutoFix Indicated ***"
+7 ; construct the actual message
+8 SET AFMSG="A possible fix for Line Item "_$PIECE(Z0,U,1)_" is to "
+9 SET AFT=$EXTRACT($PIECE(Z0,U,5),1,3)
SET AFW=$EXTRACT($PIECE(Z0,U,5),4,99)
SET AFV=$PIECE(Z0,U,6)
+10 SET AFMSG=AFMSG_$SELECT(AFT="ADD":"add",AFT="DEL":"delete",AFT="CHG":"change",1:$PIECE(Z0,U,5))_" the "
+11 SET AFMSG=AFMSG_$SELECT(AFW="PROC":"procedure code",AFW="MOD":"modifier",1:$PIECE(Z0,U,5))_" "
+12 IF AFT="CHG"
SET AFMSG=AFMSG_"to be "_AFV_" instead."
+13 IF '$TEST
SET AFMSG=AFMSG_AFV_"."
+14 ;
+15 ; call an IB utility to parse AFMSG into lines of acceptable length
+16 DO FSTRNG(AFMSG,MAXSIZE,.AF)
+17 ;
+18 ; put the data into the Z array
+19 FOR AFLN=1:1:AF
Begin DoDot:1
+20 SET (ERRLN,Z(SEGMENT,SEGNUM,"E",0))=$GET(Z(SEGMENT,SEGNUM,"E",0))+1
+21 SET Z(SEGMENT,SEGNUM,"E",ERRLN)=AF(AFLN)
+22 QUIT
End DoDot:1
AFX ;
+1 QUIT
+2 ;
FSTRNG(STR,WD,ARRAY) ; please see IBJU1 for documentation
+1 NEW %,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I,Z
+2 DO FSTRNG^IBJU1(STR,WD,.ARRAY)
+3 QUIT
+4 ;
ERRTRP ; Error trap processing ; ib*226 TJH/EG
+1 ; mumps error location and description
SET Z(1,1)=$$EC^%ZOSV
+2 SET Z="A SYSTEM ERROR HAS BEEN DETECTED AT THE FOLLOWING LOCATION"
+3 SET PROBLEM=7
+4 ; close the tcp/ip port
DO CLOSE^%ZISTCP
+5 ; unlock the current port
LOCK -^IBCITCP(IBCISOCK)
+6 ; kill scratch global
KILL ^TMP($JOB,"CMRESP2")
+7 ; record the error in the trap
DO ^%ZTER
+8 ; unwind stack levels
GOTO UNWIND^%ZTER
+9 ;
