IBCEST1.m

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 ---IBCEST1   1914     printed  Apr 09, 2024@21:38:38                                                                                                                                                                                                     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       ;