BPSOSQL ;BHAM ISC/FCS/DRS/FLS - Process responses ;12/7/07 15:28
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10,15**;JUN 2004;Build 13
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
; ONE(CLAIMIEN,RESPIEN)
; Process the Response for the claim. Loop through the
; transaction associated with the claim and call RESP1
; RESP1
; The real work of response handling for one IEN59 is in here
; RESPBAD
; Branch from RESP1 if there is no response value in the transaction
;
; ONE - Both the claim and response record are correct and complete
; Now update all of the transaction records affected by them.
ONE(CLAIMIEN,RESPIEN) ;
N TRANTYPE,INDEX,IEN59
S TRANTYPE=$P($G(^BPSC(CLAIMIEN,100)),"^",3)
S INDEX=$S(TRANTYPE="B2":"AER",1:"AE")
S IEN59=0
F S IEN59=$O(^BPST(INDEX,CLAIMIEN,IEN59)) Q:IEN59="" D
. D RESP1(IEN59,TRANTYPE,CLAIMIEN,RESPIEN)
Q
;
; RESP1 - Process each transaction associated with the transmission
RESP1(IEN59,TRANTYPE,CLAIMIEN,RESPIEN) ; called from ONE
N ERROR,ERRTXT,X,MSG
;
; Store pointer to response
N DIE,DA,DR
S DIE=9002313.59,DA=IEN59
S DR=$S(TRANTYPE="B2":402,1:4)_"////"_RESPIEN
D ^DIE
;
; Update the status
D SETSTAT^BPSOSU(IEN59,90) ; "Processing response"
;
; Get Position and log it
N POSITION S POSITION=$P(^BPST(IEN59,0),U,9)
I TRANTYPE'="B1" S POSITION=1 ; Reversals and eligibility have only 1 transaction
;
;
S MSG=$T(+0)_"-Processing "_$S(TRANTYPE="B2":"Reversal ",TRANTYPE="E1":"Eligibility ",1:"")
S MSG=MSG_"Response #"_RESPIEN_" for Claim #"_CLAIMIEN_" and position "_POSITION
D LOG^BPSOSL(IEN59,MSG)
;
; If the Response Status is missing for the transaction, quit with error
I '$D(^BPSR(RESPIEN,1000,POSITION,500)) D G RESPBAD
. S ERROR=901,ERRTXT="Corrupted response `"_RESPIEN
;
; Get the Respose Status for the transaction and update the statistics
N RESP,PIECE S RESP=$P(^BPSR(RESPIEN,1000,POSITION,500),U)
S PIECE=$S(RESP="R"&TRANTYPE="B2":7,RESP="R"&(TRANTYPE="E1"):10,RESP="R":2,RESP="P":3,RESP="D":4,RESP="C":5,RESP="A"&(TRANTYPE="B2"):6,RESP="A":9,1:19)
D INCSTAT^BPSOSUD("R",PIECE)
;
; Log Response and if Payable, Amount Paid
S MSG=$T(+0)_"-Response = "_RESP
I RESP="P" S MSG=MSG_"-$"_$$INSPAID1^BPSOS03(RESPIEN,POSITION)
D LOG^BPSOSL(IEN59,MSG)
;
; If the claims was rejected, log the reject reason
I RESP="R" D ; rejected, give rejection reasons
. N J S J=0 F S J=$O(^BPSR(RESPIEN,1000,POSITION,511,J)) Q:'J D
.. N R,X S R=$P($G(^BPSR(RESPIEN,1000,POSITION,511,J,0)),U) ; R = external reject code
.. I R]"" D
... S X=$O(^BPSF(9002313.93,"B",R,0)) ; X = reject code ien
... I X]"" S X=$P($G(^BPSF(9002313.93,X,0)),U,2) ; X = reject code description
.. E S X=""
.. D LOG^BPSOSL(IEN59,"Reject Code: "_R_" - "_X)
. ;
. ; If there are reject codes and the claim is a billing request, synch reject codes
. ; with Outpatient Pharmacy
. I TRANTYPE="B1" D DURSYNC^BPSECMP2(IEN59)
;
; Get response messages and log them.
S X=$G(^BPSR(RESPIEN,504))
I X]"" D LOG^BPSOSL(IEN59,"Response Message: "_X)
N ADDMESS
D ADDMESS^BPSSCRLG(RESPIEN,POSITION,.ADDMESS)
I $D(ADDMESS) D LOG^BPSOSL(IEN59,"Additional Text Message (array):"),LOGARRAY^BPSOSL(IEN59,"ADDMESS")
;
; Check if the payer should go to sleep based on the reject codes
I $$REJSLEEP^BPSOSQ4(RESPIEN,POSITION,IEN59),$$INCSLEEP^BPSOSQ4(IEN59) Q
;
; If we are here, we are not asleep so we need to clear sleep and log completion
; Get the GROUP INSURANCE PLAN
N GRPLAN
S GRPLAN=$$GETPLN59^BPSUTIL2(IEN59)
;
; Clear any insurer asleep flags
D CLRSLEEP^BPSOSQ4(GRPLAN,IEN59)
;
; Set Result and final status (99%-Done)
N RESULT
S RESULT=$S(TRANTYPE="B2":"Reversal ",TRANTYPE="E1":"Eligibility ",1:"")
S RESULT=RESULT_$S(RESP="R":"Rejected",RESP="P":"Payable",RESP="D"!(RESP="S"):"Duplicate",RESP="C":"Captured",RESP="A":"Accepted",1:"Completed")
D SETRESU^BPSOSU(IEN59,0,RESULT)
D SETSTAT^BPSOSU(IEN59,99)
Q
;
RESPBAD ; corrupted response escape from RESP1 - reached by a GOTO from RESP1
; Log the error
D ERROR^BPSOSU($T(+0),IEN59,$G(ERROR),$G(ERRTXT))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSQL 4216 printed Dec 13, 2024@01:51:57 Page 2
BPSOSQL ;BHAM ISC/FCS/DRS/FLS - Process responses ;12/7/07 15:28
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10,15**;JUN 2004;Build 13
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ; ONE(CLAIMIEN,RESPIEN)
+7 ; Process the Response for the claim. Loop through the
+8 ; transaction associated with the claim and call RESP1
+9 ; RESP1
+10 ; The real work of response handling for one IEN59 is in here
+11 ; RESPBAD
+12 ; Branch from RESP1 if there is no response value in the transaction
+13 ;
+14 ; ONE - Both the claim and response record are correct and complete
+15 ; Now update all of the transaction records affected by them.
ONE(CLAIMIEN,RESPIEN) ;
+1 NEW TRANTYPE,INDEX,IEN59
+2 SET TRANTYPE=$PIECE($GET(^BPSC(CLAIMIEN,100)),"^",3)
+3 SET INDEX=$SELECT(TRANTYPE="B2":"AER",1:"AE")
+4 SET IEN59=0
+5 FOR
SET IEN59=$ORDER(^BPST(INDEX,CLAIMIEN,IEN59))
if IEN59=""
QUIT
Begin DoDot:1
+6 DO RESP1(IEN59,TRANTYPE,CLAIMIEN,RESPIEN)
End DoDot:1
+7 QUIT
+8 ;
+9 ; RESP1 - Process each transaction associated with the transmission
RESP1(IEN59,TRANTYPE,CLAIMIEN,RESPIEN) ; called from ONE
+1 NEW ERROR,ERRTXT,X,MSG
+2 ;
+3 ; Store pointer to response
+4 NEW DIE,DA,DR
+5 SET DIE=9002313.59
SET DA=IEN59
+6 SET DR=$SELECT(TRANTYPE="B2":402,1:4)_"////"_RESPIEN
+7 DO ^DIE
+8 ;
+9 ; Update the status
+10 ; "Processing response"
DO SETSTAT^BPSOSU(IEN59,90)
+11 ;
+12 ; Get Position and log it
+13 NEW POSITION
SET POSITION=$PIECE(^BPST(IEN59,0),U,9)
+14 ; Reversals and eligibility have only 1 transaction
IF TRANTYPE'="B1"
SET POSITION=1
+15 ;
+16 ;
+17 SET MSG=$TEXT(+0)_"-Processing "_$SELECT(TRANTYPE="B2":"Reversal ",TRANTYPE="E1":"Eligibility ",1:"")
+18 SET MSG=MSG_"Response #"_RESPIEN_" for Claim #"_CLAIMIEN_" and position "_POSITION
+19 DO LOG^BPSOSL(IEN59,MSG)
+20 ;
+21 ; If the Response Status is missing for the transaction, quit with error
+22 IF '$DATA(^BPSR(RESPIEN,1000,POSITION,500))
Begin DoDot:1
+23 SET ERROR=901
SET ERRTXT="Corrupted response `"_RESPIEN
End DoDot:1
GOTO RESPBAD
+24 ;
+25 ; Get the Respose Status for the transaction and update the statistics
+26 NEW RESP,PIECE
SET RESP=$PIECE(^BPSR(RESPIEN,1000,POSITION,500),U)
+27 SET PIECE=$SELECT(RESP="R"&TRANTYPE="B2":7,RESP="R"&(TRANTYPE="E1"):10,RESP="R":2,RESP="P":3,RESP="D":4,RESP="C":5,RESP="A"&(TRANTYPE="B2"):6,RESP="A":9,1:19)
+28 DO INCSTAT^BPSOSUD("R",PIECE)
+29 ;
+30 ; Log Response and if Payable, Amount Paid
+31 SET MSG=$TEXT(+0)_"-Response = "_RESP
+32 IF RESP="P"
SET MSG=MSG_"-$"_$$INSPAID1^BPSOS03(RESPIEN,POSITION)
+33 DO LOG^BPSOSL(IEN59,MSG)
+34 ;
+35 ; If the claims was rejected, log the reject reason
+36 ; rejected, give rejection reasons
IF RESP="R"
Begin DoDot:1
+37 NEW J
SET J=0
FOR
SET J=$ORDER(^BPSR(RESPIEN,1000,POSITION,511,J))
if 'J
QUIT
Begin DoDot:2
+38 ; R = external reject code
NEW R,X
SET R=$PIECE($GET(^BPSR(RESPIEN,1000,POSITION,511,J,0)),U)
+39 IF R]""
Begin DoDot:3
+40 ; X = reject code ien
SET X=$ORDER(^BPSF(9002313.93,"B",R,0))
+41 ; X = reject code description
IF X]""
SET X=$PIECE($GET(^BPSF(9002313.93,X,0)),U,2)
End DoDot:3
+42 IF '$TEST
SET X=""
+43 DO LOG^BPSOSL(IEN59,"Reject Code: "_R_" - "_X)
End DoDot:2
+44 ;
+45 ; If there are reject codes and the claim is a billing request, synch reject codes
+46 ; with Outpatient Pharmacy
+47 IF TRANTYPE="B1"
DO DURSYNC^BPSECMP2(IEN59)
End DoDot:1
+48 ;
+49 ; Get response messages and log them.
+50 SET X=$GET(^BPSR(RESPIEN,504))
+51 IF X]""
DO LOG^BPSOSL(IEN59,"Response Message: "_X)
+52 NEW ADDMESS
+53 DO ADDMESS^BPSSCRLG(RESPIEN,POSITION,.ADDMESS)
+54 IF $DATA(ADDMESS)
DO LOG^BPSOSL(IEN59,"Additional Text Message (array):")
DO LOGARRAY^BPSOSL(IEN59,"ADDMESS")
+55 ;
+56 ; Check if the payer should go to sleep based on the reject codes
+57 IF $$REJSLEEP^BPSOSQ4(RESPIEN,POSITION,IEN59)
IF $$INCSLEEP^BPSOSQ4(IEN59)
QUIT
+58 ;
+59 ; If we are here, we are not asleep so we need to clear sleep and log completion
+60 ; Get the GROUP INSURANCE PLAN
+61 NEW GRPLAN
+62 SET GRPLAN=$$GETPLN59^BPSUTIL2(IEN59)
+63 ;
+64 ; Clear any insurer asleep flags
+65 DO CLRSLEEP^BPSOSQ4(GRPLAN,IEN59)
+66 ;
+67 ; Set Result and final status (99%-Done)
+68 NEW RESULT
+69 SET RESULT=$SELECT(TRANTYPE="B2":"Reversal ",TRANTYPE="E1":"Eligibility ",1:"")
+70 SET RESULT=RESULT_$SELECT(RESP="R":"Rejected",RESP="P":"Payable",RESP="D"!(RESP="S"):"Duplicate",RESP="C":"Captured",RESP="A":"Accepted",1:"Completed")
+71 DO SETRESU^BPSOSU(IEN59,0,RESULT)
+72 DO SETSTAT^BPSOSU(IEN59,99)
+73 QUIT
+74 ;
RESPBAD ; corrupted response escape from RESP1 - reached by a GOTO from RESP1
+1 ; Log the error
+2 DO ERROR^BPSOSU($TEXT(+0),IEN59,$GET(ERROR),$GET(ERRTXT))
+3 QUIT
