BPSOSUC ;BHAM ISC/FCS/DRS/FLS - ECME utilities ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10,11,14,20,27**;JUN 2004;Build 15
;;Per VA Directive 6402, this routine should not be modified.
Q
; CATEG returns the status of a Transaction or Log of Transaction
; entry. It is used mainly by STATUS^BPSOSRX but is also
; called by some other routines as well as computed fields of BPS Log
; of Transactions and BPS Tranasctions
CATEG(N,WANTREV) ;
; N - If decimal, IEN from BPS Transaction
; - If integer, IEN from BPS Log of Transactions
; $G(WANTREV) = true if you care about reversals
; (that's the default if lookup is on IEN59)
; $G(WANTREV) = false if you want to ignore reversals
; (that's the default if lookup is on IEN57)
;
; Many routines rely on these exact return values; do not change them:
; Return values:
; For all submissions:
; CORRUPT - Should never happen
;
; For Billing Requests:
; E PAYABLE, E CAPTURED, E DUPLICATE, E REJECTED, E OTHER, and
; E UNSTRANDED
;
; For Reversals:
; E REVERSAL ACCEPTED, E REVERSAL REJECTED, E REVERSAL OTHER, and
; E REVERSAL UNSTRANDED
;
; For Eligibility:
; E ELIGIBILITY ACCEPTED, E ELIGIBILITY REJECTED, E ELIGIBILITY OTHER, and
; E ELIGIBILITY UNSTRANDED
;
; For Non-Billable Entries:
; ""
;
I N<1 Q "" ; Should not happen
N FILENUM,RETVAL,CLAIM,RESP,X,RESP500,TRANTYPE,STAT,DISYS
S FILENUM=$S(N[".":9002313.59,1:9002313.57)
I '$D(WANTREV) S WANTREV=$S(FILENUM=9002313.57:0,FILENUM=9002313.59:1)
I '$$GET1^DIQ(FILENUM,N_",",.01) Q "CORRUPT"
S CLAIM=$$GET1^DIQ(FILENUM,N_",",3,"I")
S RESP=$$GET1^DIQ(FILENUM,N_",",4,"I")
S TRANTYPE=$$GET1^DIQ(FILENUM,N_",",19,"I")
;
I TRANTYPE="N" Q "" ; BPS*1*20. quit with "" for TRI/CVA non-billable entries
;
S STAT=$$GET1^DIQ(FILENUM,N_",",202,"I")
; Stranded statuses
I $P(STAT,";")="E REVERSAL UNSTRANDED" Q "E REVERSAL UNSTRANDED"
I $P(STAT,";")="E UNSTRANDED" Q "E UNSTRANDED"
I $P(STAT,";")="E ELIGIBILITY UNSTRANDED" Q "E ELIGIBILITY UNSTRANDED"
; Eligibility Statuses
I TRANTYPE="E" D Q RETVAL
. I 'CLAIM!'RESP S RETVAL="E ELIGIBILITY OTHER" Q
. S RESP500=$$RESP500^BPSOSQ4(RESP,"I")
. S X=$$RESP1000^BPSOSQ4(RESP,1,"I")
. S RETVAL="E ELIGIBILITY "
. I RESP500="R"!(X="R") S RETVAL=RETVAL_"REJECTED" Q
. I RESP500="A",X="A" S RETVAL=RETVAL_"ACCEPTED" Q
. S RETVAL=RETVAL_"OTHER"
; During a reversal/resubmit, you may get the next line between the reversal and
; and the resubmit
I 'CLAIM S RETVAL="E OTHER" Q RETVAL
I WANTREV,TRANTYPE="U" D Q RETVAL
. S RESP=$$GET1^DIQ(FILENUM,N_",",402,"I")
. S RETVAL="E REVERSAL "
. I 'RESP S RETVAL=RETVAL_"OTHER" Q
. S RESP500=$$RESP500^BPSOSQ4(RESP,"I")
. S X=$$RESP1000^BPSOSQ4(RESP,1,"I")
. I RESP500="R"!(X="R") S RETVAL=RETVAL_"REJECTED" Q
. ; Treat Duplicate of Accepted Reversal ("S") as Accepted
. I RESP500="A",X="A"!(X="S") S RETVAL=RETVAL_"ACCEPTED" Q
. S RETVAL=RETVAL_"OTHER"
; Response not received yet
I 'RESP S RETVAL="E OTHER" Q RETVAL
S RESP500=$$RESP500^BPSOSQ4(RESP,"I")
N POS S POS=$$GET1^DIQ(FILENUM,N_",",14)
;if POS comes back null set equal to 1 - BPS*14 ticket 367742 RRA
S:'POS POS=1
S X=$$RESP1000^BPSOSQ4(RESP,POS,"I")
I X="P"!(X="DP") Q "E PAYABLE"
I X="D"!(X="S")!(X="Q") Q "E DUPLICATE"
I X="R" Q "E REJECTED"
I X="C"!(X="DC") Q "E CAPTURED"
; 1000 indefinite, fall back to 500
I RESP500="R" Q "E REJECTED"
Q "E OTHER" ; corrupt?
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSUC 3570 printed Apr 09, 2024@20:58:07 Page 2
BPSOSUC ;BHAM ISC/FCS/DRS/FLS - ECME utilities ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,7,10,11,14,20,27**;JUN 2004;Build 15
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ; CATEG returns the status of a Transaction or Log of Transaction
+5 ; entry. It is used mainly by STATUS^BPSOSRX but is also
+6 ; called by some other routines as well as computed fields of BPS Log
+7 ; of Transactions and BPS Tranasctions
CATEG(N,WANTREV) ;
+1 ; N - If decimal, IEN from BPS Transaction
+2 ; - If integer, IEN from BPS Log of Transactions
+3 ; $G(WANTREV) = true if you care about reversals
+4 ; (that's the default if lookup is on IEN59)
+5 ; $G(WANTREV) = false if you want to ignore reversals
+6 ; (that's the default if lookup is on IEN57)
+7 ;
+8 ; Many routines rely on these exact return values; do not change them:
+9 ; Return values:
+10 ; For all submissions:
+11 ; CORRUPT - Should never happen
+12 ;
+13 ; For Billing Requests:
+14 ; E PAYABLE, E CAPTURED, E DUPLICATE, E REJECTED, E OTHER, and
+15 ; E UNSTRANDED
+16 ;
+17 ; For Reversals:
+18 ; E REVERSAL ACCEPTED, E REVERSAL REJECTED, E REVERSAL OTHER, and
+19 ; E REVERSAL UNSTRANDED
+20 ;
+21 ; For Eligibility:
+22 ; E ELIGIBILITY ACCEPTED, E ELIGIBILITY REJECTED, E ELIGIBILITY OTHER, and
+23 ; E ELIGIBILITY UNSTRANDED
+24 ;
+25 ; For Non-Billable Entries:
+26 ; ""
+27 ;
+28 ; Should not happen
IF N<1
QUIT ""
+29 NEW FILENUM,RETVAL,CLAIM,RESP,X,RESP500,TRANTYPE,STAT,DISYS
+30 SET FILENUM=$SELECT(N[".":9002313.59,1:9002313.57)
+31 IF '$DATA(WANTREV)
SET WANTREV=$SELECT(FILENUM=9002313.57:0,FILENUM=9002313.59:1)
+32 IF '$$GET1^DIQ(FILENUM,N_",",.01)
QUIT "CORRUPT"
+33 SET CLAIM=$$GET1^DIQ(FILENUM,N_",",3,"I")
+34 SET RESP=$$GET1^DIQ(FILENUM,N_",",4,"I")
+35 SET TRANTYPE=$$GET1^DIQ(FILENUM,N_",",19,"I")
+36 ;
+37 ; BPS*1*20. quit with "" for TRI/CVA non-billable entries
IF TRANTYPE="N"
QUIT ""
+38 ;
+39 SET STAT=$$GET1^DIQ(FILENUM,N_",",202,"I")
+40 ; Stranded statuses
+41 IF $PIECE(STAT,";")="E REVERSAL UNSTRANDED"
QUIT "E REVERSAL UNSTRANDED"
+42 IF $PIECE(STAT,";")="E UNSTRANDED"
QUIT "E UNSTRANDED"
+43 IF $PIECE(STAT,";")="E ELIGIBILITY UNSTRANDED"
QUIT "E ELIGIBILITY UNSTRANDED"
+44 ; Eligibility Statuses
+45 IF TRANTYPE="E"
Begin DoDot:1
+46 IF 'CLAIM!'RESP
SET RETVAL="E ELIGIBILITY OTHER"
QUIT
+47 SET RESP500=$$RESP500^BPSOSQ4(RESP,"I")
+48 SET X=$$RESP1000^BPSOSQ4(RESP,1,"I")
+49 SET RETVAL="E ELIGIBILITY "
+50 IF RESP500="R"!(X="R")
SET RETVAL=RETVAL_"REJECTED"
QUIT
+51 IF RESP500="A"
IF X="A"
SET RETVAL=RETVAL_"ACCEPTED"
QUIT
+52 SET RETVAL=RETVAL_"OTHER"
End DoDot:1
QUIT RETVAL
+53 ; During a reversal/resubmit, you may get the next line between the reversal and
+54 ; and the resubmit
+55 IF 'CLAIM
SET RETVAL="E OTHER"
QUIT RETVAL
+56 IF WANTREV
IF TRANTYPE="U"
Begin DoDot:1
+57 SET RESP=$$GET1^DIQ(FILENUM,N_",",402,"I")
+58 SET RETVAL="E REVERSAL "
+59 IF 'RESP
SET RETVAL=RETVAL_"OTHER"
QUIT
+60 SET RESP500=$$RESP500^BPSOSQ4(RESP,"I")
+61 SET X=$$RESP1000^BPSOSQ4(RESP,1,"I")
+62 IF RESP500="R"!(X="R")
SET RETVAL=RETVAL_"REJECTED"
QUIT
+63 ; Treat Duplicate of Accepted Reversal ("S") as Accepted
+64 IF RESP500="A"
IF X="A"!(X="S")
SET RETVAL=RETVAL_"ACCEPTED"
QUIT
+65 SET RETVAL=RETVAL_"OTHER"
End DoDot:1
QUIT RETVAL
+66 ; Response not received yet
+67 IF 'RESP
SET RETVAL="E OTHER"
QUIT RETVAL
+68 SET RESP500=$$RESP500^BPSOSQ4(RESP,"I")
+69 NEW POS
SET POS=$$GET1^DIQ(FILENUM,N_",",14)
+70 ;if POS comes back null set equal to 1 - BPS*14 ticket 367742 RRA
+71 if 'POS
SET POS=1
+72 SET X=$$RESP1000^BPSOSQ4(RESP,POS,"I")
+73 IF X="P"!(X="DP")
QUIT "E PAYABLE"
+74 IF X="D"!(X="S")!(X="Q")
QUIT "E DUPLICATE"
+75 IF X="R"
QUIT "E REJECTED"
+76 IF X="C"!(X="DC")
QUIT "E CAPTURED"
+77 ; 1000 indefinite, fall back to 500
+78 IF RESP500="R"
QUIT "E REJECTED"
+79 ; corrupt?
QUIT "E OTHER"
