Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSECA8

BPSECA8.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;External reference to $$PLANEPS^IBNCPDPU supported by IA 5572
  1. ;
  1. Q
  1. ;
  1. REVERSE(IEN59) ;
  1. ; Function to build a Reversal claim by copying selected data from the Billing
  1. ; Request into the new Reversal Claim record
  1. ;
  1. ; Input Parameter
  1. ; IEN59 - Transaction number
  1. ; Returns
  1. ; REVIEN (0 if unsuccessful or IEN of the Reversal Claim)
  1. ;
  1. Q:$G(IEN59)="" 0 ; required
  1. ;
  1. N BPS,BPSFORM,C,CLAIM,CLAIMIEN,DA,DIC,DIE,DIQ,DLAYGO,DR,I,L,POS,REVIEN,RXMULT,TMP,UERETVAL
  1. N VERSION,FLD402,X,Y,COB,REC,FN,FDA,MSG,IENS,PLAN,PLANSHT,TRANSHT,SHEETSRC,IEN5902
  1. ;
  1. S CLAIM=9002313.02,RXMULT=9002313.0201
  1. ;
  1. ; Needed for Turn-Around Stats - Do NOT delete/alter!!
  1. D LOG^BPSOSL(IEN59,$T(+0)_"-Gathering claim information")
  1. ;
  1. ; Get Claim and multiple POS
  1. S CLAIMIEN=$P(^BPST(IEN59,0),U,4)
  1. I CLAIMIEN="" Q 0
  1. S POS=$O(^BPSC(CLAIMIEN,400,0))
  1. I POS="" Q 0
  1. ;
  1. ; Get the reversal payer sheets from the Pharmacy Plan and the BPS Transaction
  1. S (BPSFORM,PLANSHT,SHEETSRC)=""
  1. S IEN5902=$$GET1^DIQ(9002313.59,IEN59,901,"I")
  1. I 'IEN5902 S IEN5902=1
  1. S PLAN=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",",".01","I")
  1. I PLAN S PLANSHT=$P($P($$PLANEPS^IBNCPDPU(PLAN),U,2),",",2),BPSFORM=PLANSHT,SHEETSRC="plan" ; IA5572
  1. S TRANSHT=$$GET1^DIQ(9002313.59902,IEN5902_","_IEN59_",","902.19","I")
  1. ;
  1. ; If the reversal payer sheet is missing from the pharmacy plan or is disabled, use the
  1. ; reversal payer sheet from the transaction record
  1. I 'PLANSHT!($$GET1^DIQ(9002313.92,+PLANSHT_",",1.06,"I")=0) S BPSFORM=TRANSHT,SHEETSRC="transaction"
  1. ;
  1. ; If still no reversal payer sheet, log an error and quit.
  1. I 'BPSFORM D LOG^BPSOSL(IEN59,$T(+0)_"-No Reversal Payer Sheet found") Q 0
  1. ;
  1. ; Log the payer sheet and the source
  1. D LOG^BPSOSL(IEN59,$T(+0)_"-Reversal payer sheet "_$$GET1^DIQ(9002313.92,BPSFORM_",",.01,"E")_" ("_BPSFORM_") came from the "_SHEETSRC)
  1. ;
  1. ; If the payer sheet is different than what is currently stored in the BPS Transaction, update the BPS Transaction
  1. I BPSFORM'=TRANSHT D
  1. . N DIE,DA,DR,DTOUT
  1. . S DIE="^BPST("_IEN59_",10,",DA(1)=IEN59,DA=IEN5902,DR="902.19////^S X=BPSFORM"
  1. . D ^DIE
  1. . D LOG^BPSOSL(IEN59,$T(+0)_"-Transaction updated with reversal payer sheet "_BPSFORM)
  1. ;
  1. ; Get payer sheet version
  1. S VERSION=$P(^BPSF(9002313.92,BPSFORM,1),"^",2)
  1. I VERSION="" S VERSION="D0"
  1. ;
  1. ; Get data from original claim request
  1. S DR="**",DIQ="TMP",DIQ(0)="I"
  1. D GETS^DIQ(CLAIM,CLAIMIEN,DR,DIQ(0),DIQ)
  1. ;
  1. ; Update CLAIMIEN to match CLAIMIEN format in TMP
  1. S CLAIMIEN=CLAIMIEN_","
  1. ;
  1. ; Execute special code in reversal payer sheets
  1. D REFORM^BPSOSHR(BPSFORM,CLAIMIEN,POS)
  1. ;
  1. ; Create a new claim record and use function to get the Claim ID
  1. R2 S DIC=CLAIM,DIC(0)="LX",DLAYGO=CLAIM
  1. S X=$$CLAIMID^BPSECX1(IEN59)
  1. I X="" Q 0
  1. D ^DIC
  1. S REVIEN=+Y
  1. I REVIEN<1 Q 0
  1. ;
  1. ; Needed for Turn-Around Stats - Do NOT delete/alter!!
  1. D LOG^BPSOSL(IEN59,$T(+0)_"-Created claim ID "_X_" ("_REVIEN_")")
  1. ;
  1. ; Create a new transaction multiple for the claim
  1. R4 S DIC="^BPSC("_REVIEN_",400,",DIC(0)="LX"
  1. S DIC("P")=$P(^DD(CLAIM,400,0),U,2)
  1. S DA(1)=REVIEN,DLAYGO=RXMULT,X=1
  1. D ^DIC
  1. I +Y'=1 D G:UERETVAL R4
  1. . S UERETVAL=$$IMPOSS^BPSOSUE("FM,P",,"call to ^DIC","for multiple",,$T(+0))
  1. ;
  1. ; Update claim with new values
  1. S DIE=CLAIM,DA=REVIEN,DR="",C=0
  1. F I=.03,.04,1.01,1.04,101,104,110,201,202,301,302,304,305,310,311,331,332,359,401 D
  1. .S C=C+1,$P(DR,";",C)=I_"////"_$G(TMP(CLAIM,CLAIMIEN,I,"I"))
  1. ;
  1. ; Update claim with new A22, A43 and A45 values but only if these fields were on original B1 Payer Sheet- BPS*1*15
  1. F I=1022,1043,1045 D
  1. .I $G(TMP(CLAIM,CLAIMIEN,I,"I"))]"" S C=C+1,$P(DR,";",C)=I_"////"_TMP(CLAIM,CLAIMIEN,I,"I")
  1. ;
  1. ; Add fields that do not come from the claim
  1. ; Payer sheet is the reversal sheet, Created On is current date/time
  1. ; Transaction Code is B2 and Transaction Count is 1
  1. S DR=DR_";.02////"_BPSFORM_";.06////"_$$NOWFM^BPSOSU1_";102////"_VERSION_";103////B2;109////1"
  1. D ^DIE
  1. ;
  1. ; Convert the 402-D2 (Prescription/Service Ref Number) to the proper length
  1. S FLD402=$G(TMP(RXMULT,POS_","_CLAIMIEN,402,"I")),L=11
  1. S TMP(RXMULT,POS_","_CLAIMIEN,402,"I")=$E(FLD402,1,2)_$E($E(FLD402,3,99)+1000000000000,13-L,13)
  1. ;
  1. ; Update transaction multiple with values
  1. S DIE="^BPSC("_REVIEN_",400,",DA(1)=REVIEN,DA=1,DR="",C=0
  1. F I=.04,.05,147,308,337,402,403,407,418,430,436,438,455 D
  1. .S C=C+1,$P(DR,";",C)=I_"////"_$G(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))
  1. D ^DIE
  1. ;
  1. ; 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
  1. S DIE="^BPSC("_REVIEN_",400,",DA(1)=REVIEN,DA=1,DR="",C=0
  1. F I=579:1:681,1023:1:1027,1029:1:1032 D
  1. .I $G(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))]"" S C=C+1,$P(DR,";",C)=I_"////"_TMP(RXMULT,POS_","_CLAIMIEN,I,"I")
  1. D ^DIE
  1. ;
  1. ; Create COB multiple if it exists in the claim record
  1. S COB=0
  1. F S COB=$O(^BPSC(+CLAIMIEN,400,POS,337,COB)) Q:'COB D
  1. . S REC=$G(^BPSC(+CLAIMIEN,400,POS,337,COB,0))
  1. . I $P(REC,U,1)=""!($P(REC,U,2)="") Q
  1. . K FDA,MSG,IENS
  1. . S FN=9002313.0401,IENS="+1,"_POS_","_REVIEN_",",IENS(1)=COB
  1. . S FDA(FN,IENS,.01)=$P(REC,U,1)
  1. . S FDA(FN,IENS,338)=$P(REC,U,2)
  1. . D UPDATE^DIE("","FDA","IENS","MSG")
  1. . I $D(MSG) D
  1. .. D LOG^BPSOSL(IEN59,$T(+0)_"-COB fields did not file, COB="_COB)
  1. .. D LOG^BPSOSL(IEN59,"REC="_REC)
  1. .. D LOG^BPSOSL(IEN59,"MSG Array:")
  1. .. D LOGARRAY^BPSOSL(IEN59,"MSG")
  1. .. D LOG^BPSOSL(IEN59,"IENS Array:")
  1. .. D LOGARRAY^BPSOSL(IEN59,"IENS")
  1. .. D LOG^BPSOSL(IEN59,"FDA Array:")
  1. .. D LOGARRAY^BPSOSL(IEN59,"FDA")
  1. ;
  1. Q REVIEN
  1. ;