Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCIUT3

IBCIUT3.m

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