source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSHR.m@ 789

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1BPSOSHR ;BHAM ISC/SD/lwj/DLF - Format conversion for reversals ;06/01/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,2,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ; This routine was originally used by IHS to reformat reversal claims
6 ; into version 5.1 if the original billing request was version 3x.
7 ; For that purpose, this routine is no longer needed. However,
8 ; it also executes the special code fields so for that reason, it
9 ; has not been removed. We also may need to do this if we change
10 ; from version 5.1 to some other version, such as version 8, in the
11 ; future.
12 ;
13 ; NOTE: There is a problem with special code if it relies on BPS array
14 ; values, such as BPS("Site","NCPDP") since those variables will not
15 ; be defined at this point. So, the only special code that will
16 ; work are hard-coded values or executes of a procedure. If executing
17 ; a procedure, it also needs to not rely on BPS array elements or needs
18 ; to distinquish between billing requests and reversals.
19 Q
20 ;
21 ; Input
22 ; BPSFORM - Reversal payer sheet IEN
23 ; CLAIMIEN - Original claim IEN
24 ; POS - Multiple from original claim
25 ;
26 ; Input/Output
27 ; TMP is the array originally created in BPSECA8. Since it is quite
28 ; large, we are not passing it into here. It will be modified by
29 ; this routine.
30 ;
31REFORM(BPSFORM,CLAIMIEN,POS) ;
32 ;
33 ; Validate parameters
34 I $G(BPSFORM)="" Q
35 I $G(CLAIMIEN)="" Q
36 I $G(POS)="" Q
37 ;
38 ; Initialize variables
39 N FLDIEN,PMODE,ORDER,RECMIEN,FIELD,NODE
40 ;
41 ; First go through the header fields. The original IHS logic was only
42 ; checking four specific fields. Of these, I removed:
43 ; 109 (Transaction Count) - Always 1 for reversals and it does
44 ; not make sense for this to be determined by special code.
45 ; 201 (Service Provider ID) - The logic currently implemented
46 ; relies on BPS array elements that are not defined here so this
47 ; was getting set to NULL when it needed to be set. In addition
48 ; I compared reversal and request (11/30/2006) and this value is
49 ; always the same for both so reversals will get the right value
50 ; from the request.
51 ; 202 (Service Provider ID Qualifier) - It does not make sense
52 ; to do this field if we are not doing field 201.
53 ;
54 ; So that leaves 110 (Software Vendor/Certification ID), which is needed
55 ; by the WEBMD reversal test payer sheet.
56 ;
57 ; Kept looping structure in case other fields are added later
58 ;
59 S NODE=100,ORDER=0
60 F S ORDER=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER)) Q:'ORDER D
61 . S RECMIEN=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER,0))
62 . I 'RECMIEN Q
63 . S FLDIEN=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,2)
64 . S FIELD=$P($G(^BPSF(9002313.91,FLDIEN,0)),U)
65 . I FIELD'=110 Q
66 . ;
67 . ; Check to see if the format has special code. If not, quit
68 . ; If we change versions (5x to ??), we made need to execute FORMAT
69 . ; code no matter what, but for now, only do if there is special
70 . ; code.
71 . S PMODE=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,3)
72 . I PMODE'="X" Q
73 . ;
74 . ; If special code, get the value, format it and store it in TMP
75 . D XSPCCODE^BPSOSCF(BPSFORM,NODE,RECMIEN)
76 . D FORMAT(NODE,FLDIEN)
77 . S TMP(9002313.02,CLAIMIEN,FIELD,"I")=BPS("X")
78 ;
79 ; Now reformat the "detail" portion of the claim. For now, the only
80 ; segment we are going to look at is 130, which is the claim segment
81 ; If other reversal formats become available, and they require other
82 ; segments - this section will have to change. Since the claim
83 ; segment full of optional fields, we wil read through the format
84 ; and take it a field at a time.
85 S NODE=130,ORDER=0
86 F S ORDER=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER)) Q:'ORDER D
87 . S RECMIEN=$O(^BPSF(9002313.92,BPSFORM,NODE,"B",ORDER,0))
88 . I 'RECMIEN Q
89 . S FLDIEN=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,2)
90 . S FIELD=$P($G(^BPSF(9002313.91,FLDIEN,0)),U)
91 . I FIELD=111 Q ; Never do Segment Indentifier
92 . ;
93 . ; Check to see if the format has special code. If not, quit
94 . ; If we change versions (5x to ??), we made need to execute FORMAT
95 . ; code no matter what, but for now, only do if there is special
96 . ; code.
97 . S PMODE=$P($G(^BPSF(9002313.92,BPSFORM,NODE,RECMIEN,0)),U,3)
98 . I PMODE'="X" Q
99 . ;
100 . ; If special code, get the value, format it and store it in TMP
101 . D XSPCCODE^BPSOSCF(BPSFORM,NODE,RECMIEN)
102 . D FORMAT(NODE,FLDIEN)
103 . S TMP(9002313.0201,POS_","_CLAIMIEN,FIELD,"I")=BPS("X")
104 Q
105 ;
106 ; FORMAT will format the data based on the FORMAT code in BPS NCPDP
107 ; FIELD DEFS
108FORMAT(NODE,FLDIEN) ;
109 N INDEX,MCODE,QUAL
110 ;
111 ; Loop through format code and format the data
112 S INDEX=0
113 F S INDEX=$O(^BPSF(9002313.91,FLDIEN,25,INDEX)) Q:'+INDEX D
114 . S MCODE=$G(^BPSF(9002313.91,FLDIEN,25,INDEX,0))
115 . I MCODE="" Q
116 . I $E(MCODE,1)=";" Q
117 . X MCODE
118 ;
119 ; If node not equal to 100, append qualifier
120 I NODE'=100 D
121 . S QUAL=$P(^BPSF(9002313.91,FLDIEN,5),"^",1)
122 . S BPS("X")=QUAL_BPS("X")
123 Q
Note: See TracBrowser for help on using the repository browser.