source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSECA8.m@ 847

Last change on this file since 847 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 2.9 KB
Line 
1BPSECA8 ;BHAM ISC/FCS/DRS/VA/DLF - construct a claim reversal ;05/17/04
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ; REVERSE - The way we build the claim reversal is to take the
6 ; source data from the original claim (CLAIMIEN) and position therein (POS).
7 ;
8 ; Remember, you have two 401 fields - one in header, one in prescription.
9 ;
10 ; 5.1 Updates
11 ; There are new fields to consider in the 5.1 reversal process, in
12 ; addition to a new value for the transaction code (B2)
13 ;
14 ; Input
15 ; IEN59 - Transaction number
16 ; Returns REVIEN of the reversal claim created
17 ;
18REVERSE(IEN59) ;EP - from BPSOSRB
19 ;
20 ; Variable initialization
21 N CLAIM,RXMULT,BPSFORM,BPS,I,TMP
22 N DIC,DR,DIQ,DIE,DA,X,DLAYGO,REVIEN,Y,UERETVAL
23 S CLAIM=9002313.02,RXMULT=9002313.0201
24 ;
25 ; Check IEN59
26 I $G(IEN59)="" Q 0
27 ;
28 ; Needed for Turn-Around Stats - Do NOT delete/alter!!
29 D LOG^BPSOSL(IEN59,$T(+0)_"-Gathering claim information")
30 ;
31 ; Get Claim and multiple POS
32 N CLAIMIEN,POS
33 S CLAIMIEN=$P(^BPST(IEN59,0),U,4)
34 I CLAIMIEN="" Q 0
35 S POS=$O(^BPSC(CLAIMIEN,400,0))
36 I POS="" Q 0
37 ;
38 ; Get reversal payer sheet. If missing, quit
39 S BPSFORM=$$GET1^DIQ(9002313.59902,"1,"_IEN59_",","902.19","I")
40 I BPSFORM="" Q 0
41 ;
42 ; Get data from original claim request
43 S DR="**",DIQ="TMP",DIQ(0)="I"
44 D GETS^DIQ(CLAIM,CLAIMIEN,DR,DIQ(0),DIQ)
45 ;
46 ; Update CLAIMIEN to match CLAIMIEN format in TMP
47 S CLAIMIEN=CLAIMIEN_","
48 ;
49 ; Execute special code in reversal payer sheets
50 D REFORM^BPSOSHR(BPSFORM,CLAIMIEN,POS)
51 ;
52 ; Create a new claim record and use function to get the Claim ID
53R2 S DIC=CLAIM,DIC(0)="LX",DLAYGO=CLAIM
54 S X=$$CLAIMID^BPSECX1(IEN59)
55 I X="" Q 0
56 D ^DIC
57 S REVIEN=+Y
58 I REVIEN<1 Q 0
59 ;
60 ; Needed for Turn-Around Stats - Do NOT delete/alter!!
61 D LOG^BPSOSL(IEN59,$T(+0)_"-Created claim ID "_X_" ("_REVIEN_")")
62 ;
63 ; Create a new prescription multiple for the claim
64R4 S DIC="^BPSC("_REVIEN_",400,",DIC(0)="LX"
65 S DIC("P")=$P(^DD(CLAIM,400,0),U,2)
66 S DA(1)=REVIEN,DLAYGO=RXMULT,X=1
67 D ^DIC
68 I +Y'=1 D G:UERETVAL R4
69 . S UERETVAL=$$IMPOSS^BPSOSUE("FM,P",,"call to ^DIC","for multiple",,$T(+0))
70 ;
71 ; Update claim with new values
72 S DIE=CLAIM,DA=REVIEN,DR=""
73 F I=.03,.04,1.01,1.04,101,102,104,110,201,202,302,304,305,310,311,331,332,401 D
74 . S DR=DR_I_"////"_$G(TMP(CLAIM,CLAIMIEN,I,"I"))_";"
75 ; Add fields that do not come from the claim
76 ; Payer sheet is the reversal sheet, Created On is current date/time
77 ; Transaction Code is B2 and Transaction Count is 1
78 S DR=DR_".02////"_BPSFORM_";.06////"_$$NOWFM^BPSOSU1()
79 S DR=DR_";103////B2;109////1"
80 D ^DIE
81 ;
82 ; Update multiple with new values
83 S DIE="^BPSC("_REVIEN_",400,"
84 S DA(1)=REVIEN,DA=1,DR=""
85 F I=.03,.04,.05,308,401,402,403,407,418,420,436,438,455 D
86 . S DR=DR_I_"////"_$G(TMP(RXMULT,POS_","_CLAIMIEN,I,"I"))_";"
87 S DR=$E(DR,1,$L(DR)-1) ; get rid of extra trailing ";"
88 D ^DIE
89 ;
90 Q REVIEN
Note: See TracBrowser for help on using the repository browser.