source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSCF.m@ 1742

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

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1BPSOSCF ;BHAM ISC/FCS/DRS/DLF - Low-level format of .02 ;06/01/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 ; XLOOP - Build claim record
6 ; Inputs:
7 ; BPS - This is shared among the BPSOSC* routines
8 ; FORMAT - Pointer to 9002313.92
9 ; NODE - Segment Node
10 ; 100 (5.1 Transaction Header Segment)
11 ; 110 (5.1 Patient Segment)
12 ; 120 (5.1 Insurance Segment)
13 ; 130 (5.1 Claim Segment)
14 ; 140 (5.1 Pharmacy Provider Segment)
15 ; 150 (5.1 Prescriber Segment)
16 ; 160 (5.1 COB/Other Payments Segment)
17 ; 170 (5.1 Worker's Compensation Segment)
18 ; 180 (5.1 DUR/PPS Segment)
19 ; 190 (5.1 Pricing Segment)
20 ; 200 (5.1 Coupon Segment)
21 ; 210 (5.1 Compound Segment)
22 ; 220 (5.1 Prior Authorization Segment)
23 ; 230 (5.1 Clinical Segment)
24 ; MEDN - Prescription multiple in BPS Claims
25 ;
26XLOOP(FORMAT,NODE,MEDN) ;EP
27 N ORDER,RECMIEN,MDATA,FLDIEN,PMODE,FLAG,OVERRIDE
28 ;
29 ; Check parameters
30 I $G(FORMAT)="" Q
31 I $G(NODE)="" Q
32 ;
33 ; If the payer sheet does have a particular segment quit
34 I '$D(^BPSF(9002313.92,FORMAT,NODE,0)) Q
35 ;
36 ; VA does not currently do these segments
37 I ",230,220,210,200,170,160,"[(","_NODE_",") Q
38 ;
39 ; DUR is handled differently since it is repeating
40 I NODE=180 D DURPPS^BPSOSHF(FORMAT,NODE,MEDN) Q
41 ;
42 ; Loop through the fields in the segment
43 S ORDER=0
44 F S ORDER=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER)) Q:'ORDER D
45 . ;
46 . ; Get the pointer to the BPS NCPDP FIELD DEFS table
47 . S RECMIEN=$O(^BPSF(9002313.92,FORMAT,NODE,"B",ORDER,0))
48 . I 'RECMIEN D IMPOSS^BPSOSUE("DB","TI","NODE="_NODE,"ORDER="_ORDER,2,$T(+0))
49 . S MDATA=^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)
50 . S FLDIEN=$P(MDATA,U,2)
51 . ;
52 . ; Quit for 111-AM (Segment ID), 478-H7 (Other Amt Claimed Sub Count), and
53 . ; 479-H8 (Other Amt Claimed Sub Qual)
54 . ; 478 and 479 are handled by 480 and 111 is standard field for each segment
55 . Q:FLDIEN=241!(FLDIEN=240)!(FLDIEN=93)
56 . ;
57 . ; Corrupt or erroneous format file
58 . I 'FLDIEN Q
59 . ;
60 . ; Set override value (may not be defined so override will be null)
61 . I $D(MEDN) S OVERRIDE=$G(BPS("OVERRIDE","RX",MEDN,FLDIEN))
62 . E S OVERRIDE=$G(BPS("OVERRIDE",FLDIEN))
63 . ;
64 . ; Get processing mode (S-Standard (default), X-Special Code)
65 . S PMODE=$P(MDATA,U,3)
66 . I PMODE="" S PMODE="S" ;default it
67 . ;
68 . ; Default FLAG and value being computed
69 . S FLAG="GFS"
70 . S BPS("X")=""
71 . ;
72 . ; If there is an override, set BPS("X") to it and
73 . ; only do Format and Set code
74 . I OVERRIDE]"" S FLAG="FS",BPS("X")=OVERRIDE
75 . ;
76 . ; If Special Code mode is set, execute special code instead
77 . ; of field's Get code and change Flag to FS so Format and
78 . ; Set code is still done but not GET code
79 . I PMODE="X",OVERRIDE="" D
80 .. S FLAG="FS"
81 .. D XSPCCODE(FORMAT,NODE,RECMIEN)
82 . ;
83 . ; Call XFLDCODE to do processing based on FLAG setting
84 . D XFLDCODE(NODE,FLDIEN,FLAG)
85 Q
86 ;
87 ; Execute Get, Format and/or Set MUMPS code for a NCPDP Field
88 ;
89 ; Parameters: NODE - Segment Node
90 ; FLDIEN - NCPDP Field Definitions IEN
91 ; FLAG - If variable contains:
92 ; "G" - Execute Get Code
93 ; "F" - Execute Format Code
94 ; "S" - Execute S Code
95 ;---------------------------------------------------------------------
96XFLDCODE(NODE,FLDIEN,FLAG) ;EP
97 ; 5.1 loops through the 10, 25, 30 nodes
98 ;
99 N FNODE,INDEX,MCODE
100 ;
101 ; Check if record exists and FLAG variable is set correctly
102 ; Changed from Q: to give fatal error - 10/18/2000
103 I 'FLDIEN D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XFLDCODE",$T(+0))
104 I '$D(^BPSF(9002313.91,FLDIEN,0)) D IMPOSS^BPSOSUE("DB,P","TI","FLDIEN="_FLDIEN,,"XFLDCODE",$T(+0))
105 I FLAG="" D IMPOSS^BPSOSUE("DB,P","TI","FLAG null",,"XFLDCODE",$T(+0))
106 ;
107 ; Loop through Get, Format and Set Code fields and execute code
108 F FNODE=10,25,30 D
109 . I FLAG'[$S(FNODE=10:"G",FNODE=25:"F",FNODE=30:"S",1:"") Q
110 . ;
111 . ; Quit for 111-AM (Segment ID), 478-H7 (Other Amt Claimed Sub Count), and
112 . ; 479-H8 (Other Amt Claimed Sub Qual)
113 . ; 478 and 479 are handled by 480 and 111 is standard field for each segment
114 . I FLDIEN=241!(FLDIEN=240)!(FLDIEN=93) Q
115 . I '$D(^BPSF(9002313.91,FLDIEN,FNODE,0)) D IMPOSS^BPSOSUE("DB","TI","FLDIEN="_FLDIEN,"FNODE="_FNODE,"XFLDCODE",$T(+0))
116 . ;
117 . ; Loop through the multiple and execute each line
118 . S INDEX=0
119 . F S INDEX=$O(^BPSF(9002313.91,FLDIEN,FNODE,INDEX)) Q:'+INDEX D
120 .. ;
121 .. ; If doing SET code and if this is not the header segment, add the ID prefix
122 .. I FNODE=30,NODE'=100 S BPS("X")=$P($G(^BPSF(9002313.91,FLDIEN,5)),U,1)_BPS("X")
123 .. ;
124 .. ; Get the code and xecute
125 .. S MCODE=$G(^BPSF(9002313.91,FLDIEN,FNODE,INDEX,0))
126 .. Q:MCODE=""
127 .. Q:$E(MCODE,1)=";"
128 .. X MCODE
129 Q
130 ;----------------------------------------------------------------------
131 ;Execute Special Code (for a NCPDP Field within a NCPDP Record)
132 ;
133 ;Parameters: FORMAT - NCPDP Record Format IEN (9002313.92)
134 ; NODE - Global node value (100,110,120,130,140)
135 ; RECMIEN - Field Multiple IEN
136 ;---------------------------------------------------------------------
137XSPCCODE(FORMAT,NODE,RECMIEN) ;EP - Above and BPSOSHR
138 ;
139 N INDEX,MCODE
140 I '$D(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,0)) D IMPOSS^BPSOSUE("DB,P","TI","no special code there to XECUTE","FORMAT="_FORMAT,"XSPCCODE",$T(+0))
141 ;
142 S INDEX=0
143 F S INDEX=$O(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX)) Q:'+INDEX D
144 . S MCODE=$G(^BPSF(9002313.92,FORMAT,NODE,RECMIEN,1,INDEX,0))
145 . Q:MCODE=""
146 . Q:$E(MCODE,1)=";"
147 . X MCODE
148 Q
Note: See TracBrowser for help on using the repository browser.