- 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 Feb 18, 2025@23:17:11 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 ;