source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBNCPLOG.m@ 1610

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

initial load of WorldVistAEHR
File size: 9.1 KB
Line 
1IBNCPLOG ;BHAM ISC/SS - IB ECME EVNT REPORT ;22-MAR-2006
2 ;;2.0;INTEGRATED BILLING;**342,339,363**;21-MAR-94;Build 35
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;store data related to the IB calls made by ECME package in the file #366.14
6 ;input:
7 ;.IBIBD - (by referrence) IBD array with parameter sent to IB by ECME
8 ;DFN patient's ien
9 ;IBPROC - type of event. i.e. content of CALL such as BILL, REJECT and so on
10 ;IBRESULT - (optional) result of the event processing, format: return_code^message
11 ;IBJOB - (optional) job, default = $J
12 ;IBDTTM - (optional) datetime, default = "NOW"
13 ;IBUSR - (optional) user ID, default = DUZ
14 ;output:
15 ;none
16LOG(IBIBD,DFN,IBPROC,IBRESULT,IBJOB,IBDTTM,IBUSR) ;Store the data
17 N NDX,Z,REF,IBDATE,IBDTIEN,IBEVNIEN,IBIBDTYP,IBRETV
18 S IBRESULT=$G(IBRESULT)
19 ;
20 I '$G(IBJOB) S IBJOB=$J
21 I '$G(IBDTTM) S IBDTTM=$$NOW^XLFDT()
22 I '$G(IBUSR) S IBUSR=+DUZ
23 ;
24 S IBDATE=DT
25 S IBDTIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
26 L +^IBCNR(366.14):30 E Q
27 I IBDTIEN=0 S IBDTIEN=+$$ADDDATE(IBDATE)
28 ;create an event
29 S IBEVNIEN=$$NEWEVENT(IBDTIEN,IBPROC)
30 L -^IBCNR(366.14)
31 I IBEVNIEN=0 W !,"New event creation Error : LOG^IBNCPLOG",! Q
32 ;
33 I +$$FILLFLDS^IBNCPUT1(366.141,".03",IBEVNIEN_","_IBDTIEN,DFN) ;DFN
34 I +$$FILLFLDS^IBNCPUT1(366.141,".04",IBEVNIEN_","_IBDTIEN,IBJOB) ;JOB
35 I +$$FILLFLDS^IBNCPUT1(366.141,".05",IBEVNIEN_","_IBDTIEN,IBDTTM) ;DATETIME
36 I +$$FILLFLDS^IBNCPUT1(366.141,".06",IBEVNIEN_","_IBDTIEN,DUZ) ;USER
37 I IBRESULT'="" D
38 . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".07",IBEVNIEN_","_IBDTIEN,+IBRESULT) ;RESULT
39 . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".08",IBEVNIEN_","_IBDTIEN,$P(IBRESULT,U,2)) ;RESULT MESSAGE
40 ;store IBIBD array
41 S IBIBDTYP=""
42 F S IBIBDTYP=$O(IBIBD(IBIBDTYP)) Q:IBIBDTYP="" D
43 . D IBD(IBDTIEN,IBEVNIEN,IBIBDTYP,$G(IBIBD(IBIBDTYP)),.IBIBD)
44 ;store "INS" node of IBIBD array
45 I $D(IBIBD("INS")) I $$INS(.IBIBD,IBDTIEN,IBEVNIEN)
46 Q
47 ;
48 ;store IBD array data
49 ;IBDTIEN - ien on top [DATE] level
50 ;IBRECNO - ien in [EVENTS] multiple
51 ;IBIBDTYP - type subscript in IBD array (BILL, PAID, RESPONSE, etc)
52 ;IBVAL - value to store
53 ;IBIBD - array with data passed by reference (for efficiency)
54IBD(IBDTIEN,IBRECNO,IBIBDTYP,IBVAL,IBIBD) ;
55 N IBFLDNO
56 ;W !," - ",IBRECNO," ",IBIBDTYP," = ",IBVAL
57 ;free text like "WEBMD: PAID"
58 I IBIBDTYP="AUTH #" S IBFLDNO=".11",IBVAL=$E(IBVAL,1,30) G EDITIBD
59 ;free text like "0504597;3051229"
60 I IBIBDTYP="BCID" S IBFLDNO=".12" G EDITIBD
61 ;7 digits ECME number - identifier (stored as a text - might have leading zeroes)
62 I IBIBDTYP="CLAIMID" S IBFLDNO=".13" G EDITIBD
63 ;pointer to file #2
64 I IBIBDTYP="DFN" S IBFLDNO=".14" G EDITIBD
65 ;pointer to file #40.8
66 I IBIBDTYP="DIVISION" S IBFLDNO=".15" G EDITIBD
67 ;free text
68 I IBIBDTYP="RESPONSE" S IBFLDNO=".16",IBVAL=$E(IBVAL,1,20) G EDITIBD
69 ;free text
70 I IBIBDTYP="REVERSAL REASON" S IBFLDNO=".17",IBVAL=$E(IBVAL,1,40) G EDITIBD
71 ;1 digit number
72 I IBIBDTYP="RTS-DEL" S IBFLDNO=".18" G EDITIBD
73 ;free text
74 I IBIBDTYP="STATUS" S IBFLDNO=".19",IBVAL=$E(IBVAL,1,20) G EDITIBD
75 ;Prescription number as a text, might have alpha characters (external value, this is not IEN)
76 I IBIBDTYP="RX NO" S IBFLDNO=".202",IBVAL=$E(IBVAL,1,20) G EDITIBD
77 ;0 - original, 1,2,3,... - refill number
78 I IBIBDTYP="FILL NUMBER" S IBFLDNO=".203" G EDITIBD
79 ;internal identifier number for a DRUG
80 I IBIBDTYP="DRUG" S IBFLDNO=".204" G EDITIBD
81 I IBIBDTYP="NDC" S IBFLDNO=".205" G EDITIBD
82 I IBIBDTYP="FILL DATE" S IBFLDNO=".206" G EDITIBD
83 I IBIBDTYP="RELEASE DATE" S IBFLDNO=".207" G EDITIBD
84 I IBIBDTYP="QTY" S IBFLDNO=".208" G EDITIBD
85 I IBIBDTYP="DAYS SUPPLY" S IBFLDNO=".209" G EDITIBD
86 I IBIBDTYP="DEA" S IBFLDNO=".21" G EDITIBD
87 I IBIBDTYP="FILLED BY" S IBFLDNO=".211" G EDITIBD
88 ; for environmental indicators:
89 ; if IBIBD("SC/EI OVR")=1 - the user overrides any answers (3)
90 ; if $G(IBIBD("SC/EI NO ANSW")) contains the IBIBDTYP - this question was not answered (2)
91 ; otherwise - use whatever in the IBVAL (0 - NO, 1 -YES)
92 I IBIBDTYP="AO" S IBFLDNO=".401",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
93 I IBIBDTYP="CV" S IBFLDNO=".402",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
94 I IBIBDTYP="SWA" S IBFLDNO=".403",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
95 I IBIBDTYP="IR" S IBFLDNO=".404",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
96 I IBIBDTYP="MST" S IBFLDNO=".405",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
97 I IBIBDTYP="HNC" S IBFLDNO=".406",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
98 I IBIBDTYP="SC" S IBFLDNO=".407",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
99 I IBIBDTYP="SHAD" S IBFLDNO=".408",IBVAL=$S($G(IBIBD("SC/EI OVR"))=1:3,(","_$G(IBIBD("SC/EI NO ANSW"))_",")[(","_IBIBDTYP_","):2,1:IBVAL) G EDITIBD
100 I IBIBDTYP="BILL" S IBFLDNO=".301" G EDITIBD
101 I IBIBDTYP="BILLED" S IBFLDNO=".302" G EDITIBD
102 I IBIBDTYP="PLAN" S IBFLDNO=".303" G EDITIBD
103 I IBIBDTYP="COST" S IBFLDNO=".304" G EDITIBD
104 I IBIBDTYP="PAID" S IBFLDNO=".305" G EDITIBD
105 I IBIBDTYP="CLOSE COMMENT" S IBFLDNO=".306" G EDITIBD
106 I IBIBDTYP="REOPEN COMMENT" S IBFLDNO=".306" G EDITIBD
107 I IBIBDTYP="CLOSE REASON" S IBFLDNO=".307" G EDITIBD
108 I IBIBDTYP="DROP TO PAPER" S IBFLDNO=".308" G EDITIBD
109 I IBIBDTYP="RELEASE COPAY" S IBFLDNO=".309" G EDITIBD
110 I IBIBDTYP="USER" S IBFLDNO=".31" G EDITIBD
111 I IBIBDTYP="PRESCRIPTION" S IBFLDNO=".201" G EDITIBD
112 I IBIBDTYP="IEN" S IBFLDNO=".212" G EDITIBD
113 I IBIBDTYP="EPHARM" S IBFLDNO=".09" G EDITIBD
114 Q 0
115EDITIBD ;
116 Q +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
117 ;------
118 ;to store IBD("INS") array data
119 ;input:
120 ;IBDARR - IBD array by reference
121 ;IBDTIEN - ien on top [DATE] level
122 ;IBRECNO - ien in [EVENTS] multiple
123 ;output:
124 ; record number if success
125 ; 0 if failure
126INS(IBDARR,IBDTIEN,IBRECNO) ;
127 N IBSET1,IBSET2,IBSET3,IBFLDNO,IBINSNO,RECNO,IBVAL
128 S IBINSNO=0
129 F S IBINSNO=$O(IBDARR("INS",IBINSNO)) Q:+IBINSNO=0 D
130 . S IBSET1=$G(IBDARR("INS",IBINSNO,1))
131 . S IBSET2=$G(IBDARR("INS",IBINSNO,2))
132 . S IBSET3=$G(IBDARR("INS",IBINSNO,3))
133 . S RECNO=$$ADDINS(IBDTIEN,IBRECNO)
134 . I +$$FILLFLDS^IBNCPUT1(366.1412,.02,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,1))
135 . I +$$FILLFLDS^IBNCPUT1(366.1412,.03,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,2))
136 . I +$$FILLFLDS^IBNCPUT1(366.1412,.04,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,3))
137 . I +$$FILLFLDS^IBNCPUT1(366.1412,.05,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,4))
138 . I +$$FILLFLDS^IBNCPUT1(366.1412,.06,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,5))
139 . I +$$FILLFLDS^IBNCPUT1(366.1412,.07,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,6))
140 . I +$$FILLFLDS^IBNCPUT1(366.1412,.08,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,7))
141 . ;
142 . I +$$FILLFLDS^IBNCPUT1(366.1412,.101,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,8))
143 . I +$$FILLFLDS^IBNCPUT1(366.1412,.102,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,9))
144 . I +$$FILLFLDS^IBNCPUT1(366.1412,.103,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,10))
145 . I +$$FILLFLDS^IBNCPUT1(366.1412,.104,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,11))
146 . I +$$FILLFLDS^IBNCPUT1(366.1412,.105,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,12))
147 . I +$$FILLFLDS^IBNCPUT1(366.1412,.106,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,13))
148 . I +$$FILLFLDS^IBNCPUT1(366.1412,.107,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,14))
149 . ;
150 . I +$$FILLFLDS^IBNCPUT1(366.1412,.201,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,1))
151 . I +$$FILLFLDS^IBNCPUT1(366.1412,.202,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,2))
152 . I +$$FILLFLDS^IBNCPUT1(366.1412,.203,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,3))
153 . I +$$FILLFLDS^IBNCPUT1(366.1412,.204,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,4))
154 . I +$$FILLFLDS^IBNCPUT1(366.1412,.205,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,5))
155 . ;
156 . I +$$FILLFLDS^IBNCPUT1(366.1412,.301,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,1))
157 . I +$$FILLFLDS^IBNCPUT1(366.1412,.302,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,2))
158 . I +$$FILLFLDS^IBNCPUT1(366.1412,.303,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,3))
159 Q RECNO
160 ;create top level entry in #366.14
161 ;input:
162 ; IBDATE - date in FileMan format
163 ;output
164 ; returns ien created
165ADDDATE(IBDATE) ;
166 N IBIEN
167 S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
168 I IBIEN>0 Q IBIEN
169 I $$INSITEM^IBNCPUT1(366.14,"",IBDATE,"")
170 Q +$O(^IBCNR(366.14,"B",IBDATE,0))
171 ;
172 ;create EVENT entry in #366.14
173 ;input:
174 ;IBIEN - ien on top [DATE] level
175 ;EVNTTYPE event type (value for .01)
176 ;returns ien for the event
177 ;or 0 if failed
178NEWEVENT(IBIEN,EVNTTYPE) ;
179 N EVNTRECN
180 S EVNTRECN=$$INSITEM^IBNCPUT1(366.141,IBIEN,$$EXT2INT^IBNCPUT1(EVNTTYPE),"","")
181 I EVNTRECN>0 Q EVNTRECN
182 Q 0
183 ;
184 ;add insurance node
185 ;IBDTIEN - ien on top [DATE] level
186 ;IBEVIEN - ien in [EVENTS] multiple
187 ;returns :
188 ; new ien in INSURANCE multiple
189ADDINS(IBDTIEN,IBEVIEN) ;
190 N IBX,IBX2
191 F IBX=1:1:99999 I '$D(^IBCNR(366.14,IBDTIEN,1,IBEVIEN,5,IBX)) D Q
192 . S IBX2=$$INSITEM^IBNCPUT1(366.1412,IBEVIEN_","_IBDTIEN,IBX,IBX)
193 Q +$O(^IBCNR(366.14,IBDTIEN,1,IBEVIEN,5,"B",IBX,0))
194 ;
Note: See TracBrowser for help on using the repository browser.