BPSECA8 ;BHAM ISC/FCS/DRS/VA/DLF - construct a claim reversal ;05/17/04
;;1.0;E CLAIMS MGMT ENGINE;**1,5,10,12,11,15,20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
;External reference to $$PLANEPS^IBNCPDPU supported by IA 5572
;
Q
;
REVERSE(IEN59) ;
; Function to build a Reversal claim by copying selected data from the Billing
; Request into the new Reversal Claim record
;
; Input Parameter
; IEN59 - Transaction number
; Returns
; REVIEN (0 if unsuccessful or IEN of the Reversal Claim)
;
Q:$G(IEN59)="" 0 ; required
;
N BPS,BPSFORM,C,CLAIM,CLAIMIEN,DA,DIC,DIE,DIQ,DLAYGO,DR,I,L,POS,REVIEN,RXMULT,TMP,UERETVAL
N VERSION,FLD402,X,Y,COB,REC,FN,FDA,MSG,IENS,PLAN,PLANSHT,TRANSHT,SHEETSRC,IEN5902
;
S CLAIM=9002313.02,RXMULT=9002313.0201
;
; Needed for Turn-Around Stats - Do NOT delete/alter!!
D LOG^BPSOSL(IEN59,$T(+0)_"-Gathering claim information")
;
; Get Claim and multiple POS
S CLAIMIEN=$P(^BPST(IEN59,0),U,4)
I CLAIMIEN="" Q 0
S POS=$O(^BPSC(CLAIMIEN,400,0))
I POS="" Q 0
;
; Get the reversal payer sheets from the Pharmacy Plan and the BPS Transaction
S (BPSFORM,PLANSHT,SHEETSRC)=""
S IEN5902=$$GET1^DIQ(9002313.59,IEN59,901,"I")
I 'IEN5902 S IEN5902=1
S PLAN=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",",".01","I")
I PLAN S PLANSHT=$P($P($$PLANEPS^IBNCPDPU(PLAN),U,2),",",2),BPSFORM=PLANSHT,SHEETSRC="plan" ; IA5572
S TRANSHT=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",","902.19","I")
;
; If the reversal payer sheet is missing from the pharmacy plan or is disabled, use the
; reversal payer sheet from the transaction record
I 'PLANSHT!($$GET1^DIQ(9002313.92,+PLANSHT_",",1.06,"I")=0) S BPSFORM=TRANSHT,SHEETSRC="transaction"
;
; If still no reversal payer sheet, log an error and quit.
I 'BPSFORM D LOG^BPSOSL(IEN59,$T(+0)_"-No Reversal Payer Sheet found") Q 0
;
; Log the payer sheet and the source
D LOG^BPSOSL(IEN59,$T(+0)_"-Reversal payer sheet "_$$GET1^DIQ(9002313.92,BPSFORM_",",.01,"E")_" ("_BPSFORM_") came from the "_SHEETSRC)
;
; If the payer sheet is different than what is currently stored in the BPS Transaction, update the BPS Transaction
I BPSFORM'=TRANSHT D
. N DIE,DA,DR,DTOUT
. S DIE="^BPST("_IEN59_",10,",DA(1)=IEN59,DA=IEN5902,DR="902.19////^S X=BPSFORM"
. D ^DIE
. D LOG^BPSOSL(IEN59,$T(+0)_"-Transaction updated with reversal payer sheet "_BPSFORM)
;
; Get payer sheet version
S VERSION=$P(^BPSF(9002313.92,BPSFORM,1),"^",2)
I VERSION="" S VERSION="D0"
;
; Get data from original claim request
S DR="**",DIQ="TMP",DIQ(0)="I"
D GETS^DIQ(CLAIM,CLAIMIEN,DR,DIQ(0),DIQ)
;
; Update CLAIMIEN to match CLAIMIEN format in TMP
S CLAIMIEN=CLAIMIEN_","
;
; Execute special code in reversal payer sheets
D REFORM^BPSOSHR(BPSFORM,CLAIMIEN,POS)
;
; Create a new claim record and use function to get the Claim ID
R2 S DIC=CLAIM,DIC(0)="LX",DLAYGO=CLAIM
S X=$$CLAIMID^BPSECX1(IEN59)
I X="" Q 0
D ^DIC
S REVIEN=+Y
I REVIEN<1 Q 0
;
; Needed for Turn-Around Stats - Do NOT delete/alter!!
D LOG^BPSOSL(IEN59,$T(+0)_"-Created claim ID "_X_" ("_REVIEN_")")
;
; Create a new transaction multiple for the claim
R4 S DIC="^BPSC("_REVIEN_",400,",DIC(0)="LX"
S DIC("P")=$P(^DD(CLAIM,400,0),U,2)
S DA(1)=REVIEN,DLAYGO=RXMULT,X=1
D ^DIC
I +Y'=1 D G:UERETVAL R4
. S UERETVAL=$$IMPOSS^BPSOSUE("FM,P",,"call to ^DIC","for multiple",,$T(+0))
;
; Update claim with new values
S DIE=CLAIM,DA=REVIEN,DR="",C=0
F I=.03,.04,1.01,1.04,101,104,110,201,202,301,302,304,305,310,311,331,332,359,401 D
.S C=C+1,$P(DR,";",C)=I_"////"_$G(TMP(CLAIM,CLAIMIEN,I,"I"))
;
; Update claim with new A22, A43 and A45 values but only if these fields were on original B1 Payer Sheet- BPS*1*15
F I=1022,1043,1045 D
.I $G(TMP(CLAIM,CLAIMIEN,I,"I"))]"" S C=C+1,$P(DR,";",C)=I_"////"_TMP(CLAIM,CLAIMIEN,I,"I")
;
; Add fields that do not come from the claim
; Payer sheet is the reversal sheet, Created On is current date/time
; Transaction Code is B2 and Transaction Count is 1
S DR=DR_";.02////"_BPSFORM_";.06////"_$$NOWFM^BPSOSU1_";102////"_VERSION_";103////B2;109////1"
D ^DIE
;
; Convert the 402-D2 (Prescription/Service Ref Number) to the proper length
S FLD402=$G(TMP(RXMULT,POS_","_CLAIMIEN,402,"I")),L=11
S TMP(RXMULT,POS_","_CLAIMIEN,402,"I")=$E(FLD402,1,2)_$E($E(FLD402,3,99)+1000000000000,13-L,13)
;
; Update transaction multiple with values
S DIE="^BPSC("_REVIEN_",400,",DA(1)=REVIEN,DA=1,DR="",C=0
F I=.04,.05,147,308,337,402,403,407,418,430,436,438,455 D
.S C=C+1,$P(DR,";",C)=I_"////"_$G(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))
D ^DIE
;
; Update transaction multiple with new D.1 through D.9 values but only if these fields were on the original B1 Payer Sheet- BPS*1*15
S DIE="^BPSC("_REVIEN_",400,",DA(1)=REVIEN,DA=1,DR="",C=0
F I=579:1:681,1023:1:1027,1029:1:1032 D
.I $G(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))]"" S C=C+1,$P(DR,";",C)=I_"////"_TMP(RXMULT,POS_","_CLAIMIEN,I,"I")
D ^DIE
;
; Create COB multiple if it exists in the claim record
S COB=0
F S COB=$O(^BPSC(+CLAIMIEN,400,POS,337,COB)) Q:'COB D
. S REC=$G(^BPSC(+CLAIMIEN,400,POS,337,COB,0))
. I $P(REC,U,1)=""!($P(REC,U,2)="") Q
. K FDA,MSG,IENS
. S FN=9002313.0401,IENS="+1,"_POS_","_REVIEN_",",IENS(1)=COB
. S FDA(FN,IENS,.01)=$P(REC,U,1)
. S FDA(FN,IENS,338)=$P(REC,U,2)
. D UPDATE^DIE("","FDA","IENS","MSG")
. I $D(MSG) D
.. D LOG^BPSOSL(IEN59,$T(+0)_"-COB fields did not file, COB="_COB)
.. D LOG^BPSOSL(IEN59,"REC="_REC)
.. D LOG^BPSOSL(IEN59,"MSG Array:")
.. D LOGARRAY^BPSOSL(IEN59,"MSG")
.. D LOG^BPSOSL(IEN59,"IENS Array:")
.. D LOGARRAY^BPSOSL(IEN59,"IENS")
.. D LOG^BPSOSL(IEN59,"FDA Array:")
.. D LOGARRAY^BPSOSL(IEN59,"FDA")
;
Q REVIEN
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSECA8 5842 printed Apr 09, 2024@20:55:34 Page 2
BPSECA8 ;BHAM ISC/FCS/DRS/VA/DLF - construct a claim reversal ;05/17/04
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10,12,11,15,20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;External reference to $$PLANEPS^IBNCPDPU supported by IA 5572
+5 ;
+6 QUIT
+7 ;
REVERSE(IEN59) ;
+1 ; Function to build a Reversal claim by copying selected data from the Billing
+2 ; Request into the new Reversal Claim record
+3 ;
+4 ; Input Parameter
+5 ; IEN59 - Transaction number
+6 ; Returns
+7 ; REVIEN (0 if unsuccessful or IEN of the Reversal Claim)
+8 ;
+9 ; required
if $GET(IEN59)=""
QUIT 0
+10 ;
+11 NEW BPS,BPSFORM,C,CLAIM,CLAIMIEN,DA,DIC,DIE,DIQ,DLAYGO,DR,I,L,POS,REVIEN,RXMULT,TMP,UERETVAL
+12 NEW VERSION,FLD402,X,Y,COB,REC,FN,FDA,MSG,IENS,PLAN,PLANSHT,TRANSHT,SHEETSRC,IEN5902
+13 ;
+14 SET CLAIM=9002313.02
SET RXMULT=9002313.0201
+15 ;
+16 ; Needed for Turn-Around Stats - Do NOT delete/alter!!
+17 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Gathering claim information")
+18 ;
+19 ; Get Claim and multiple POS
+20 SET CLAIMIEN=$PIECE(^BPST(IEN59,0),U,4)
+21 IF CLAIMIEN=""
QUIT 0
+22 SET POS=$ORDER(^BPSC(CLAIMIEN,400,0))
+23 IF POS=""
QUIT 0
+24 ;
+25 ; Get the reversal payer sheets from the Pharmacy Plan and the BPS Transaction
+26 SET (BPSFORM,PLANSHT,SHEETSRC)=""
+27 SET IEN5902=$$GET1^DIQ(9002313.59,IEN59,901,"I")
+28 IF 'IEN5902
SET IEN5902=1
+29 SET PLAN=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",",".01","I")
+30 ; IA5572
IF PLAN
SET PLANSHT=$PIECE($PIECE($$PLANEPS^IBNCPDPU(PLAN),U,2),",",2)
SET BPSFORM=PLANSHT
SET SHEETSRC="plan"
+31 SET TRANSHT=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",","902.19","I")
+32 ;
+33 ; If the reversal payer sheet is missing from the pharmacy plan or is disabled, use the
+34 ; reversal payer sheet from the transaction record
+35 IF 'PLANSHT!($$GET1^DIQ(9002313.92,+PLANSHT_",",1.06,"I")=0)
SET BPSFORM=TRANSHT
SET SHEETSRC="transaction"
+36 ;
+37 ; If still no reversal payer sheet, log an error and quit.
+38 IF 'BPSFORM
DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-No Reversal Payer Sheet found")
QUIT 0
+39 ;
+40 ; Log the payer sheet and the source
+41 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Reversal payer sheet "_$$GET1^DIQ(9002313.92,BPSFORM_",",.01,"E")_" ("_BPSFORM_") came from the "_SHEETSRC)
+42 ;
+43 ; If the payer sheet is different than what is currently stored in the BPS Transaction, update the BPS Transaction
+44 IF BPSFORM'=TRANSHT
Begin DoDot:1
+45 NEW DIE,DA,DR,DTOUT
+46 SET DIE="^BPST("_IEN59_",10,"
SET DA(1)=IEN59
SET DA=IEN5902
SET DR="902.19////^S X=BPSFORM"
+47 DO ^DIE
+48 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Transaction updated with reversal payer sheet "_BPSFORM)
End DoDot:1
+49 ;
+50 ; Get payer sheet version
+51 SET VERSION=$PIECE(^BPSF(9002313.92,BPSFORM,1),"^",2)
+52 IF VERSION=""
SET VERSION="D0"
+53 ;
+54 ; Get data from original claim request
+55 SET DR="**"
SET DIQ="TMP"
SET DIQ(0)="I"
+56 DO GETS^DIQ(CLAIM,CLAIMIEN,DR,DIQ(0),DIQ)
+57 ;
+58 ; Update CLAIMIEN to match CLAIMIEN format in TMP
+59 SET CLAIMIEN=CLAIMIEN_","
+60 ;
+61 ; Execute special code in reversal payer sheets
+62 DO REFORM^BPSOSHR(BPSFORM,CLAIMIEN,POS)
+63 ;
+64 ; Create a new claim record and use function to get the Claim ID
R2 SET DIC=CLAIM
SET DIC(0)="LX"
SET DLAYGO=CLAIM
+1 SET X=$$CLAIMID^BPSECX1(IEN59)
+2 IF X=""
QUIT 0
+3 DO ^DIC
+4 SET REVIEN=+Y
+5 IF REVIEN<1
QUIT 0
+6 ;
+7 ; Needed for Turn-Around Stats - Do NOT delete/alter!!
+8 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-Created claim ID "_X_" ("_REVIEN_")")
+9 ;
+10 ; Create a new transaction multiple for the claim
R4 SET DIC="^BPSC("_REVIEN_",400,"
SET DIC(0)="LX"
+1 SET DIC("P")=$PIECE(^DD(CLAIM,400,0),U,2)
+2 SET DA(1)=REVIEN
SET DLAYGO=RXMULT
SET X=1
+3 DO ^DIC
+4 IF +Y'=1
Begin DoDot:1
+5 SET UERETVAL=$$IMPOSS^BPSOSUE("FM,P",,"call to ^DIC","for multiple",,$TEXT(+0))
End DoDot:1
if UERETVAL
GOTO R4
+6 ;
+7 ; Update claim with new values
+8 SET DIE=CLAIM
SET DA=REVIEN
SET DR=""
SET C=0
+9 FOR I=.03,.04,1.01,1.04,101,104,110,201,202,301,302,304,305,310,311,331,332,359,401
Begin DoDot:1
+10 SET C=C+1
SET $PIECE(DR,";",C)=I_"////"_$GET(TMP(CLAIM,CLAIMIEN,I,"I"))
End DoDot:1
+11 ;
+12 ; Update claim with new A22, A43 and A45 values but only if these fields were on original B1 Payer Sheet- BPS*1*15
+13 FOR I=1022,1043,1045
Begin DoDot:1
+14 IF $GET(TMP(CLAIM,CLAIMIEN,I,"I"))]""
SET C=C+1
SET $PIECE(DR,";",C)=I_"////"_TMP(CLAIM,CLAIMIEN,I,"I")
End DoDot:1
+15 ;
+16 ; Add fields that do not come from the claim
+17 ; Payer sheet is the reversal sheet, Created On is current date/time
+18 ; Transaction Code is B2 and Transaction Count is 1
+19 SET DR=DR_";.02////"_BPSFORM_";.06////"_$$NOWFM^BPSOSU1_";102////"_VERSION_";103////B2;109////1"
+20 DO ^DIE
+21 ;
+22 ; Convert the 402-D2 (Prescription/Service Ref Number) to the proper length
+23 SET FLD402=$GET(TMP(RXMULT,POS_","_CLAIMIEN,402,"I"))
SET L=11
+24 SET TMP(RXMULT,POS_","_CLAIMIEN,402,"I")=$EXTRACT(FLD402,1,2)_$EXTRACT($EXTRACT(FLD402,3,99)+1000000000000,13-L,13)
+25 ;
+26 ; Update transaction multiple with values
+27 SET DIE="^BPSC("_REVIEN_",400,"
SET DA(1)=REVIEN
SET DA=1
SET DR=""
SET C=0
+28 FOR I=.04,.05,147,308,337,402,403,407,418,430,436,438,455
Begin DoDot:1
+29 SET C=C+1
SET $PIECE(DR,";",C)=I_"////"_$GET(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))
End DoDot:1
+30 DO ^DIE
+31 ;
+32 ; Update transaction multiple with new D.1 through D.9 values but only if these fields were on the original B1 Payer Sheet- BPS*1*15
+33 SET DIE="^BPSC("_REVIEN_",400,"
SET DA(1)=REVIEN
SET DA=1
SET DR=""
SET C=0
+34 FOR I=579:1:681,1023:1:1027,1029:1:1032
Begin DoDot:1
+35 IF $GET(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))]""
SET C=C+1
SET $PIECE(DR,";",C)=I_"////"_TMP(RXMULT,POS_","_CLAIMIEN,I,"I")
End DoDot:1
+36 DO ^DIE
+37 ;
+38 ; Create COB multiple if it exists in the claim record
+39 SET COB=0
+40 FOR
SET COB=$ORDER(^BPSC(+CLAIMIEN,400,POS,337,COB))
if 'COB
QUIT
Begin DoDot:1
+41 SET REC=$GET(^BPSC(+CLAIMIEN,400,POS,337,COB,0))
+42 IF $PIECE(REC,U,1)=""!($PIECE(REC,U,2)="")
QUIT
+43 KILL FDA,MSG,IENS
+44 SET FN=9002313.0401
SET IENS="+1,"_POS_","_REVIEN_","
SET IENS(1)=COB
+45 SET FDA(FN,IENS,.01)=$PIECE(REC,U,1)
+46 SET FDA(FN,IENS,338)=$PIECE(REC,U,2)
+47 DO UPDATE^DIE("","FDA","IENS","MSG")
+48 IF $DATA(MSG)
Begin DoDot:2
+49 DO LOG^BPSOSL(IEN59,$TEXT(+0)_"-COB fields did not file, COB="_COB)
+50 DO LOG^BPSOSL(IEN59,"REC="_REC)
+51 DO LOG^BPSOSL(IEN59,"MSG Array:")
+52 DO LOGARRAY^BPSOSL(IEN59,"MSG")
+53 DO LOG^BPSOSL(IEN59,"IENS Array:")
+54 DO LOGARRAY^BPSOSL(IEN59,"IENS")
+55 DO LOG^BPSOSL(IEN59,"FDA Array:")
+56 DO LOGARRAY^BPSOSL(IEN59,"FDA")
End DoDot:2
End DoDot:1
+57 ;
+58 QUIT REVIEN
+59 ;
