source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSOSO2.m@ 1006

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

initial load of WorldVistAEHR

File size: 6.6 KB
Line 
1BPSOSO2 ;BHAM ISC/FCS/DRS/DLF - NCPDP Override-Fman utils ;06/01/2004
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ; EDIT,EDITGEN are called from the menus in BPSOSO1,
6 ; typically reached from the pharmacy package's call
7 ; to OVERRIDE^BPSOSO
8 ; GET511 is called from BPSOSCD during claim construction
9 ;
10 ;IHS/SD/lwj 8/01/02 NCPDP 5.1 changes to GET511 subroutine
11 ; Routine was changed to look at an exceptions list, if the
12 ; field being processed is in the exceptions list it will
13 ; create a "claim header" and "claim rx" entry. The reason
14 ; for this is that several 300 range fields were moved to the
15 ; claim rx area within the 5.1 segments creating duplicate flds.
16 ; (i.e. the <402 and >402 rule is no longer valid)
17 ;
18 ; New routine (PRIORA) added to handle the input of the prior
19 ; authorization information at prescription creation time.
20 ;
21EDIT(IEN,FIELDNUM) ;
22 I '$D(FIELDNUM) D EDITGEN(IEN) Q
23 ; Editing one field
24 N DIE,DA,DR,DIDEL,DTOUT,FIELDNAM
25 S DA=$$HASVALUE(IEN,FIELDNUM)
26 ; Make sure the entry exists in the subfile.
27 ; Create an empty one if necessary.
28 I 'DA S DA=$$SETVALUE(IEN,FIELDNUM,"")
29 ; edit the value field in the subfile
30 S DIE="^BPS(9002313.511,"_IEN_",1,",DA(1)=IEN
31 S DR=.02_$TR($$FIELDNAM(FIELDNUM),""";~","")
32 D ^DIE
33 ; If the value is null, then delete the entire FIELDNUM entry
34 I $$GETVALUE(IEN,FIELDNUM)="" D DELVALUE(IEN,FIELDNUM)
35 Q
36EDITGEN(IEN) ; general edit
37 ; First pass: quick & dirty Fileman ^DIE call
38 ; Future: Screenman interface
39 N DIE,DA,DR,DIDEL,DTOUT
40 S DA=IEN,DIE=$$FILENUM,DR=1 D ^DIE
41 ; And we need to delete any entries with null values
42 N A S A=0 F S A=$O(^BPS(9002313.511,IEN,1,A)) Q:'A D
43 . N X S X=^BPS(9002313.511,IEN,1,A,0)
44 . I $P(X,U,2)="" D
45 . . N FIELDNUM S FIELDNUM=$P(^BPSF(9002313.91,$P(X,U),0),U)
46 . . D DELVALUE(IEN,FIELDNUM)
47 Q
48GET511(IEN,ARR101,ARR402) ;EP - from BPSOSCD - load arrays with data from IEN
49 ;
50 N A,C S A=0,C=0
51 N X,F,HDRLST,MULTLST,TFLD,BPFLDNUM
52 ;
53 ; Build the exception lists
54 S HDRLST=",524,",MULTLST=",308,315,316,317,318,319,320,327,"
55 ;
56 F S A=$O(^BPS(9002313.511,IEN,1,A)) Q:'A D
57 . S X=^BPS(9002313.511,IEN,1,A,0)
58 . S F=$P(X,U) ; Field IEN, points to 9002313.91
59 . ; Store in either claim header or claim detail, based on field #
60 . ; Note that logic below will put 401 field in both header and detail
61 . S BPFLDNUM=+$$FIELDNUM(F)
62 . S TFLD=","_BPFLDNUM_","
63 . I BPFLDNUM<402!(HDRLST[TFLD) S @ARR101@(F)=$P(X,U,2)
64 . I BPFLDNUM>400!(MULTLST[TFLD) S @ARR402@(F)=$P(X,U,2)
65 . ;
66 . S C=C+1
67 Q C
68 ;
69 ; Generalized utilities - good for everything, not just auth #
70LOCK() L +^BPS(9002313.511,IEN):300 Q $T
71UNLOCK L -^BPS(9002313.511,IEN) Q
72FILENUM() Q 9002313.511
73SUBFNUM() Q 9002313.5111
74FLOCK() L +^BPS(9002313.511):300 Q $T
75FUNLOCK L -^BPS(9002313.511) Q
76FIELDIEN(FIELDNUM) ; ien of a 9002313.91 NCPDP Data Dictionary field
77 Q $$FIND1^DIC(9002313.91,,,FIELDNUM)
78FIELDNAM(FIELDNUM) ; name of a 9002313.91 NCPDP Data Dictionary field
79 Q $$GET1^DIQ(9002313.91,$$FIELDIEN(FIELDNUM),.03)
80 ; given pointer to NCPDP Data Dictionary fields, return external #
81FIELDNUM(IEN91) Q $P($G(^BPSF(9002313.91,IEN91,0)),U)
82NEW() ;EP - create new entry in 9002313.511
83 F Q:$$FLOCK Q:'$$IMPOSS^BPSOSUE("L","RTI","interlock on new Override record creation",,"NEW",$T(+0))
84 N FLAGS,FDA,IEN,MSG,FN,X,NEWREC S FN=$$FILENUM
85 D NEW1
86 D FUNLOCK
87 Q NEWREC
88NEW1 ;
89 S FDA(FN,"+1,",.01)=$O(^BPS(FN,"B",999999999999),-1)+1
90 D UPDATE^DIE(,"FDA","IEN","MSG")
91 I $D(MSG) D G NEW1:$$IMPOSS^BPSOSUE("FM","TRI","UPDATE^DIE failed",,"NEW1",$T(+0))
92 . D ZWRITE^BPSOS("FDA","IEN","MSG")
93 . K MSG
94 S NEWREC=IEN(1)
95NEW2 ;
96 S FDA(FN,NEWREC_",",.02)="NOW"
97 D FILE^DIE("E","FDA","MSG")
98 Q:'$D(MSG) ; success
99 G NEW2:$$IMPOSS^BPSOSUE("FM","TRI","FILE^DIE failed",,"NEW2",$T(+0))
100 Q
101HASVALUE(IEN,FIELDNUM) ; does the FIELDNUM have an override value?
102 ; returns IEN into the subfile
103 Q $$FIND1^DIC($$SUBFNUM,","_IEN_",",,FIELDNUM)
104GETVALUE(IEN,FIELDNUM) ; return currently-set override value for given FIELDNUM
105 N X S X=$$HASVALUE(IEN,FIELDNUM) I 'X Q ""
106 Q $$GET1^DIQ($$SUBFNUM,X_","_IEN_",",.02)
107SETVALUE(IEN,FIELDNUM,VALUE) ;
108 ; can DO or $$; $$ = ien in subfile for this FIELDNUM
109 ; Special case for the override file: if you're trying to set the
110 ; field's value to "@", don't just delete the field value,
111 ; which would leave the field defined with a null value.
112 ; Instead, delete the entire override for the field.
113 ; This prevents accidentally overriding a genuine value with null.
114 I "@"=VALUE D DELVALUE(IEN,FIELDNUM) Q ""
115 ; But the usual case is just storing a value:
116 N FDA,MSG,IENS,IENARRAY
117 ; Note: I tried the "+?1,ien," method but it always created a new
118 ; entry, even when it meant creating duplicates. So now we test to
119 ; see if there's already an entry for the fieldnum, and if not,
120 ; then we put in a "+1,"
121 N ENTRY S ENTRY=$$HASVALUE(IEN,FIELDNUM) ; do we already have FIELDNUM
122 I 'ENTRY S ENTRY="+1" ; if not, then create a new entry
123 S IENS=ENTRY_","_IEN_","
124 S FDA($$SUBFNUM,IENS,.01)=FIELDNUM
125 S FDA($$SUBFNUM,IENS,.02)=VALUE
126 D SETV1
127 I ENTRY="+1" S ENTRY=$G(IENARRAY(1))
128 Q ENTRY
129SETV1 ;
130 D UPDATE^DIE("E","FDA","IENARRAY","MSG")
131 Q:'$D(MSG) ; success
132 K ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE")
133 S ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE")=$$ERRHDR
134 M ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE","MSG")=MSG
135 I $D(IENARRAY) M ^TMP("BPS",$J,"BPSOSO2",$J,"SETVALUE","IENARRAY")=IENARRAY
136 D ZWRITE^BPSOS("FDA","IENARRAY","MSG")
137 G SETV1:$$IMPOSS^BPSOSUE("FM","TRI",,,"SETVALUE",$T(+0))
138 Q
139DELVALUE(IEN,FIELDNUM) ;
140 N ENTRY S ENTRY=$$HASVALUE(IEN,FIELDNUM) Q:'ENTRY ; wasn't defined
141 N FDA,MSG
142 S FDA($$SUBFNUM,ENTRY_","_IEN_",",.01)="@"
143DE5 D FILE^DIE("E","FDA","MSG")
144 Q:'$D(MSG) ; success
145 K ^TMP("BPS",$J,"BPSOSO2",$J,"DELVALUE")
146 S ^TMP("BPS",$J,"BPSOSO2",$J,"DELVALUE")=$$ERRHDR
147 D ZWRITE^BPSOS("IEN","FDA","MSG")
148 G DE5:$$IMPOSS^BPSOSUE("FM","TRI",,,"DELVALUE",$T(+0))
149 Q
150ERRHDR() Q "ERROR AT $H="_$H_" FOR $J="_$J
151SEE(IEN) N TMP M TMP=^BPS($$FILENUM,IEN) D ZWRITE^BPSOS("TMP") Q ; debugging
152 ;
153PRIORA(IEN) ;IHS/SD/lwj 9/3/02 NCPDP 5.1 Changes - Prior Authorization
154 ; We are still processing 5.1 and 3.2 claims, so we have to be able
155 ; to populate fields 461, 462 and 416. 416 will be created based
156 ; on the input into fields 461, and 462.
157 ;
158 N FIELDNUM
159 ;
160 S FIELDNUM=461 ;Prior authorization type code
161 D EDIT(IEN,FIELDNUM)
162 ;
163 S FIELDNUM=462 ;Prior authorization number submitted
164 D EDIT(IEN,FIELDNUM)
165 ;
166 ;now we combine field 461 and 462 to creat field 416
167 ;
168 N VAL461,VAL462,VAL416,DA
169 S (VAL461,VAL462,VAL416)=""
170 ;
171 S VAL461=$$GETVALUE(IEN,461)
172 S VAL462=$$GETVALUE(IEN,462)
173 S VAL416=VAL461_VAL462
174 Q:VAL416=""
175 ;
176 S DA=$$SETVALUE(IEN,416,"")
177 S:$G(DA)'="" DA=$$SETVALUE(IEN,416,VAL416)
178 ;
179 ;
180 Q
Note: See TracBrowser for help on using the repository browser.