- 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 Jan 18, 2025@03:14:41 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 ;