source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSECA8.m@ 1464

BPSECA8 ;BHAM ISC/FCS/DRS/VA/DLF - construct a claim reversal ;05/17/04

 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45

 ;;Per VHA Directive 2004-038, this routine should not be modified.

 Q

 ; REVERSE - The way we build the claim reversal is to take the

 ; source data from the original claim (CLAIMIEN) and position therein (POS).

 ;

 ; Remember, you have two 401 fields - one in header, one in prescription.

 ;

 ; 5.1 Updates

 ; There are new fields to consider in the 5.1 reversal process, in

 ; addition to a new value for the transaction code (B2)

 ;

 ; Input

 ;   IEN59  - Transaction number

 ; Returns REVIEN of the reversal claim created

 ;

REVERSE(IEN59) ;EP - from BPSOSRB

 ;

 ; Variable initialization

 N CLAIM,RXMULT,BPSFORM,BPS,I,TMP

 N DIC,DR,DIQ,DIE,DA,X,DLAYGO,REVIEN,Y,UERETVAL

 S CLAIM=9002313.02,RXMULT=9002313.0201

 ;

 ; Check IEN59

 I $G(IEN59)="" Q 0

 ;

 ; Needed for Turn-Around Stats - Do NOT delete/alter!!

 D LOG^BPSOSL(IEN59,$T(+0)_"-Gathering claim information")

 ;

 ; Get Claim and multiple POS

 N CLAIMIEN,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 reversal payer sheet.  If missing, quit

 S BPSFORM=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",","902.19","I")

 I BPSFORM="" Q 0

 ;

 ; 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 prescription 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=""

 F I=.03,.04,1.01,1.04,101,102,104,110,201,202,302,304,305,310,311,331,332,401 D

 . S DR=DR_I_"////"_$G(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()

 S DR=DR_";103////B2;109////1"

 D ^DIE

 ;

 ; Update multiple with new values

 S DIE="^BPSC("_REVIEN_",400,"

 S DA(1)=REVIEN,DA=1,DR=""

 F I=.03,.04,.05,308,401,402,403,407,418,420,436,438,455 D

 . S DR=DR_I_"////"_$G(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))_";"

 S DR=$E(DR,1,$L(DR)-1) ; get rid of extra trailing ";"

 D ^DIE

 ;

 Q REVIEN