- IBCEST1 ;ALB/ESG - IB 837 EDI Status Message Processing Cont ;18-JUL-2005
- ;;2.0;INTEGRATED BILLING;**320,397,552**;21-MAR-94;Build 1
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- CHKSUM(IBARRAY) ; Incoming 277STAT status message checksum calculation
- ; This function calculates the checksum of the raw 277stat data from
- ; the data in array IBARRAY. This is done to prevent duplicates.
- ; Input parameter IBARRAY is the array reference where the data exists
- ; at @IBARRAY@(n,0) where n is a sequential #
- ; For file 364.2, IBARRAY = "^IBA(364.2,IBTDA,2)" where IBTDA = the ien
- ; of the entry in file 364.2 being evaluated
- ;
- NEW Y,LN,DATA,IBREC,POS,STSFLG
- S Y=0,STSFLG=0
- S LN=0
- F S LN=$O(@IBARRAY@(LN)) Q:'LN D
- . S DATA=$$EXT($G(@IBARRAY@(LN,0))) Q:DATA=""
- . S IBREC=$P(DATA,U,1)
- . I IBREC="277STAT" S STSFLG=1 Q ; set the STS flag
- . ;IB*552 - ticket 1120403 only evaluate 2 digit numbers <MAXNUMBER> error
- . I $L(IBREC)>2 Q
- . I IBREC<1 Q ; rec# too low
- . I IBREC'<99 Q ; rec# too high
- . F POS=1:1:$L(DATA) S Y=Y+($A(DATA,POS)*POS)
- . Q
- ;
- I 'STSFLG S Y=0 ; if this array is not a 277stat message
- Q Y
- ;
- EXT(DATA) ; Extracts from the text in DATA if the text contains
- ; "##RAW DATA: "
- Q $S(DATA["##RAW DATA: ":$P(DATA,"##RAW DATA: ",2,99),1:DATA)
- ;
- SCODE(Z0) ; status code for message
- N IBFD,IBI,IBRD S IBFD=0
- F IBI=1:1 S IBRD=$P($T(CODE+IBI),";;",2,999) Q:IBRD=""!IBFD D
- . I IBRD[Z0 S IBFD=1
- Q IBFD
- ;
- CODE ; *397
- ;;A3^AC^A7^A8^AA^2P^10^11
- ;;19^20^21^30^40^221^960^1AE^1AF^1AG^1AI^1AJ^1AK^1AL^1AS^1BS^1BV^1BY
- ;;2B^2D^2H^2M^2U^3A^3C^3E^3F^3G^3I^3K^3L^3N^3P^3S
- ;;4B^4C^4D^4E^4H^4I^4J^4P^4S^4T^4U^4X^4Y^7A^7D^7I^7U^7V
- ;;A0^A9^ACCEPT^ACCEPTED^AE^AP^APPROVE^C01^CI^CP^CTRL!99001^INQUIRY
- ;;OA7^OAH^OAI^OAK^OAT^OAV^OAY^OAZ^OB9^OBX^OCU^PG^PN5
- ;;TE^W!00000117^Z3^ZAI^ZAN
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEST1 1914 printed Feb 18, 2025@23:38:54 Page 2
- IBCEST1 ;ALB/ESG - IB 837 EDI Status Message Processing Cont ;18-JUL-2005
- +1 ;;2.0;INTEGRATED BILLING;**320,397,552**;21-MAR-94;Build 1
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- CHKSUM(IBARRAY) ; Incoming 277STAT status message checksum calculation
- +1 ; This function calculates the checksum of the raw 277stat data from
- +2 ; the data in array IBARRAY. This is done to prevent duplicates.
- +3 ; Input parameter IBARRAY is the array reference where the data exists
- +4 ; at @IBARRAY@(n,0) where n is a sequential #
- +5 ; For file 364.2, IBARRAY = "^IBA(364.2,IBTDA,2)" where IBTDA = the ien
- +6 ; of the entry in file 364.2 being evaluated
- +7 ;
- +8 NEW Y,LN,DATA,IBREC,POS,STSFLG
- +9 SET Y=0
- SET STSFLG=0
- +10 SET LN=0
- +11 FOR
- SET LN=$ORDER(@IBARRAY@(LN))
- if 'LN
- QUIT
- Begin DoDot:1
- +12 SET DATA=$$EXT($GET(@IBARRAY@(LN,0)))
- if DATA=""
- QUIT
- +13 SET IBREC=$PIECE(DATA,U,1)
- +14 ; set the STS flag
- IF IBREC="277STAT"
- SET STSFLG=1
- QUIT
- +15 ;IB*552 - ticket 1120403 only evaluate 2 digit numbers <MAXNUMBER> error
- +16 IF $LENGTH(IBREC)>2
- QUIT
- +17 ; rec# too low
- IF IBREC<1
- QUIT
- +18 ; rec# too high
- IF IBREC'<99
- QUIT
- +19 FOR POS=1:1:$LENGTH(DATA)
- SET Y=Y+($ASCII(DATA,POS)*POS)
- +20 QUIT
- End DoDot:1
- +21 ;
- +22 ; if this array is not a 277stat message
- IF 'STSFLG
- SET Y=0
- +23 QUIT Y
- +24 ;
- EXT(DATA) ; Extracts from the text in DATA if the text contains
- +1 ; "##RAW DATA: "
- +2 QUIT $SELECT(DATA["##RAW DATA: ":$PIECE(DATA,"##RAW DATA: ",2,99),1:DATA)
- +3 ;
- SCODE(Z0) ; status code for message
- +1 NEW IBFD,IBI,IBRD
- SET IBFD=0
- +2 FOR IBI=1:1
- SET IBRD=$PIECE($TEXT(CODE+IBI),";;",2,999)
- if IBRD=""!IBFD
- QUIT
- Begin DoDot:1
- +3 IF IBRD[Z0
- SET IBFD=1
- End DoDot:1
- +4 QUIT IBFD
- +5 ;
- CODE ; *397
- +1 ;;A3^AC^A7^A8^AA^2P^10^11
- +2 ;;19^20^21^30^40^221^960^1AE^1AF^1AG^1AI^1AJ^1AK^1AL^1AS^1BS^1BV^1BY
- +3 ;;2B^2D^2H^2M^2U^3A^3C^3E^3F^3G^3I^3K^3L^3N^3P^3S
- +4 ;;4B^4C^4D^4E^4H^4I^4J^4P^4S^4T^4U^4X^4Y^7A^7D^7I^7U^7V
- +5 ;;A0^A9^ACCEPT^ACCEPTED^AE^AP^APPROVE^C01^CI^CP^CTRL!99001^INQUIRY
- +6 ;;OA7^OAH^OAI^OAK^OAT^OAV^OAY^OAZ^OB9^OBX^OCU^PG^PN5
- +7 ;;TE^W!00000117^Z3^ZAI^ZAN
- +8 ;