source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSECA1.m@ 1739

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1BPSECA1 ;BHAM ISC/FCS/DRS/VA/DLF - Assemble formatted claim ;05/14/2004
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 ;----------------------------------------------------------------------
5 ; Assemble ASCII formatted claim submission record
6 ;
7 ; Input Variables:
8 ; CLAIMIEN - pointer into 9002313.02
9 ; MSG - Array passed by reference - This will have the claim packet
10 ;
11 ; NCPDP 5.1 changes
12 ; 5.1 has 14 claim segments (header, patient, insurance, claim
13 ; pharmacy provider, prescriber,
14 ; COB, workers comp, DUR, Pricing,
15 ; coupon, compound, prior auth,
16 ; clinical)
17 ; 5.1 requires field identifiers and separators on all fields
18 ; other than the header
19 ; 5.1 Segment separators are required prior to each segment
20 ; following the header
21 ; 5.1 Group separators appear at the end of each
22 ; transaction (prescription)
23 ;
24 ; Adjustments were also made to the reversal logic as well.
25 ;
26ASCII(CLAIMIEN,MSG) ;EP - from BPSOSQG
27 N IEN,RECORD,BPS,UERETVAL,DET51,WP
28 ;
29 ; Quit if no Claim IEN
30 I '$G(CLAIMIEN) Q
31 I '$D(^BPSC(CLAIMIEN,0)) Q
32 ;
33 ; Setup IEN variables (used when executing format code)
34 S IEN(9002313.02)=CLAIMIEN
35 ;
36 ; Get Payer Sheet pointer
37 S IEN(9002313.92)=$P($G(^BPSC(IEN(9002313.02),0)),U,2)
38 ;
39 ; Quit if the payer sheet pointer is missing
40 I 'IEN(9002313.92) Q
41 ;
42 ; Quit if the payer sheet does not exist
43 I '$D(^BPSF(9002313.92,+IEN(9002313.92),0)) Q
44 ;
45 ; Retrieve claim submission record (used when executing format code)
46 D GETBPS2^BPSECX0(IEN(9002313.02),.BPS)
47 ;
48 ; Assemble required claim header and optional format sections
49 S RECORD=""
50 ;
51 ; Do non-repeating claim segments
52 D XLOOP^BPSOSH2("100^110^120",.IEN,.BPS,.RECORD)
53 ;
54 ; Set list of repeating claim segments
55 S DET51="130^140^150^160^170^180^190^200^210^220^230"
56 ;
57 ; Loop through prescription multiple and get create repeation segments
58 S IEN(9002313.01)=0
59 F S IEN(9002313.01)=$O(^BPSC(IEN(9002313.02),400,IEN(9002313.01))) Q:'IEN(9002313.01) D
60 . ;
61 . ;Retrieve prescription information (used when executing format code)
62 . K BPS(9002313.0201)
63 . D GETBPS3^BPSECX0(IEN(9002313.02),IEN(9002313.01),.BPS)
64 . ;
65 . ; Handle the DUR repeating flds
66 . D DURVALUE
67 . ;
68 . ; Append group separator character
69 . S RECORD=RECORD_$C(29)
70 . ;
71 . ; Assemble claim information required and optional sections
72 . D XLOOP^BPSOSH2(DET51,.IEN,.BPS,.RECORD)
73 ;
74 ; Need to store by segment due to HL7 constraints. Had to change field, group,
75 ; and segment separators to control characters for Vitria/AAC processing as well as
76 ; shortening the length of the xmit.
77 ; DMB 11/27/2006 - If the first NNODES has $C(30), this will bomb since OREC will not
78 ; have a value. Need to look into this.
79 N NNODES,INDEX,ONE,TWO,OREC
80 S NNODES=0 F S NNODES=$O(RECORD(NNODES)) Q:NNODES="" D
81 . I RECORD(NNODES)[$C(30) D
82 .. S ONE=$P(RECORD(NNODES),($C(30)_$C(28)),1),TWO=$P(RECORD(NNODES),($C(30)_$C(28)),2)
83 .. S RECORD(OREC)=RECORD(OREC)_ONE_$C(30)_$C(28),RECORD(NNODES)=TWO
84 . S OREC=NNODES
85 ;
86 ; Put claim packet into local array to be passed back to calling routine
87 S NNODES=""
88 S INDEX=1 F S NNODES=$O(RECORD(NNODES)) Q:NNODES="" D
89 . S MSG("HLS",INDEX)=RECORD(NNODES)
90 . S WP(INDEX/100+1,0)=RECORD(NNODES)
91 . S INDEX=INDEX+1
92 S MSG("HLS",0)=INDEX-1
93 ;
94 ; Store raw data into the BPS Claims record
95 D WP^DIE(9002313.02,CLAIMIEN_",",9999,"","WP")
96 Q
97 ;
98 ; DURVALUE - This subroutine will loop through the DUR/PPS repeating
99 ; fields and load their values into the BPS array for the claim
100 ; generation process
101DURVALUE ;
102 N DURCNT,DUR
103 ;
104 K BPS(9002313.1001)
105 ;
106 ; Get the number of DUR records
107 S DURCNT=$P($G(^BPSC(IEN(9002313.02),400,IEN(9002313.01),473.01,0)),U,4)
108 ;
109 ; Loop through DURS and get the data
110 F DUR=1:1:DURCNT D
111 . D GETBPS4^BPSECX0(IEN(9002313.02),IEN(9002313.01),DUR,.BPS)
112 Q
Note: See TracBrowser for help on using the repository browser.