source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20P342.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1IB20P342 ;DALOI/SS - IB ECME EVNT REPORT ;01/03/2006
2 ;;2.0;INTEGRATED BILLING;**342**;21-MAR-94;Build 18
3 ;; Per VHA Directive 10-93-142, this routine should not be modified.
4 ;;
5 Q
6 ;
7 ;move data from ^XTMP("IBNCPDP-..." to file #366.14
8EN ;
9 N IBDT,IBRECNO,IBDATE,IBIBDTYP,IBRET,IBTYPE,IBDTIEN,IBCALVAL
10 N IBMSG1,IBMSG2
11 I +$O(^IBCNR(366.14,0)) D Q
12 . D ERRMSG("Conversion of IB ECME EVNT REPORT data will not be done in this site")
13 . D ERRMSG("since data have been already converted in the past.")
14 . ;send e-mail about post-install completion
15 . S IBMSG1="The conversion of data from the ^XTMP global array into the IB NCPDP"
16 . S IBMSG2="EVENT LOG file has been skipped as the data has already been converted."
17 . D SNDMAIL("IB*2.0*342 installation has been completed",IBMSG1,IBMSG2)
18 S IBDT="IBNCPDP-"
19 F S IBDT=$O(^XTMP(IBDT)) Q:IBDT'["IBNCPDP-" D
20 . S IBRECNO=0
21 . S IBDATE=+$P(IBDT,"-",2)
22 . D BMES^XPDUTL("Add date: "_IBDATE)
23 . S IBDTIEN=$$ADDDATE^IBNCPLOG(IBDATE)
24 . I +IBDTIEN=0 D ERRMSG("Cannot create a DATE entry for "_IBDATE)
25 . F S IBRECNO=$O(^XTMP(IBDT,IBRECNO)) Q:+IBRECNO=0 D
26 . . ;create node and .01 for events multiple
27 . . I '$D(^XTMP(IBDT,IBRECNO,"CALL")) D ERRMSG(" there is no CALL node in ^XTMP") Q
28 . . ;Add event (CALL) = ^XTMP(IBDT,IBRECNO,"CALL")
29 . . S IBCALVAL=$G(^XTMP(IBDT,IBRECNO,"CALL"))
30 . . I $$ADDEVENT(IBDATE,IBRECNO,IBCALVAL)<0 D ERRMSG(" EVENT entry wasn't created for "_IBCALVAL) Q
31 . . ;quit if was not created
32 . . S IBTYPE=""
33 . . ;Loop through fields...
34 . . F S IBTYPE=$O(^XTMP(IBDT,IBRECNO,IBTYPE)) Q:IBTYPE="" D
35 . . . I IBTYPE="CALL" Q ;was already created
36 . . . ;fields general fields (other than IBD)
37 . . . I IBTYPE="DEVICE" Q ;we do not use DEVICE in new file
38 . . . I IBTYPE'="IBD" S IBRET=$$GENFLDS(IBDT,IBRECNO,IBTYPE,IBDATE) D:+IBRET=0 Q
39 . . . . D ERRMSG(" >"_IBTYPE_":"_$P(IBRET,U,2))
40 . . . ;if IBD fields
41 . . . S IBIBDTYP=""
42 . . . F S IBIBDTYP=$O(^XTMP(IBDT,IBRECNO,IBTYPE,IBIBDTYP)) Q:IBIBDTYP="" D
43 . . . . ; if Insurance
44 . . . . I IBIBDTYP="INS" S IBRET=$$INS(IBDT,IBRECNO,IBDATE) D:+IBRET=0 Q
45 . . . . . D ERRMSG(" >>INSURANCE node was not populated")
46 . . . . ; other IBD fields
47 . . . . S IBRET=$$IBD(IBDT,IBRECNO,IBIBDTYP,IBDATE)
48 . . . . D:+IBRET=0 ERRMSG(" >>IBD field "_IBIBDTYP_" was not populated")
49 ;send e-mail about conversion completion
50 S IBMSG1="The conversion of data from the ^XTMP global array into the IB NCPDP"
51 S IBMSG2="EVENT LOG file has successfully completed."
52 D SNDMAIL("IB*2.0*342 installation has been completed",IBMSG1,IBMSG2)
53 Q
54 ;process the fields common for all messages
55GENFLDS(IBDT,IBRECNO,IBTYPE,IBDATE) ;
56 N IBVAL,IBFLDNO,IBDTIEN,IBRETV
57 S IBRETV=0
58 S IBVAL=$G(^XTMP(IBDT,IBRECNO,IBTYPE))
59 S IBDTIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
60 Q:+IBDTIEN=0 0
61 I IBTYPE="CALL" S IBFLDNO=".01" G EDITFLD
62 I IBTYPE="DFN" S IBFLDNO=".03" G EDITFLD
63 I IBTYPE="JOB" S IBFLDNO=".04" G EDITFLD
64 I IBTYPE="TIME" S IBFLDNO=".05" G EDITFLD
65 I IBTYPE="USER" S IBFLDNO=".06" G EDITFLD
66 I IBTYPE="RESULT" D
67 . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".07",IBRECNO_","_IBDTIEN,+IBVAL)
68 . S IBRETV=+$$FILLFLDS^IBNCPUT1(366.141,".08",IBRECNO_","_IBDTIEN,$P(IBVAL,U,2))
69 Q IBRETV
70EDITFLD ;
71 Q +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
72 ;---------
73 ;store IBD array data
74 ;input:
75 ;IBDT -date node as it is in ^XTMP global, i.e. "IBNCPDP-3060214"
76 ;IBRECNO -ien in [EVENTS] multiple
77 ;IBIBDTYP -type subscript in IBD array (BILL, PAID, RESPONSE, etc)
78 ;IBDATE -date
79 ;Output:
80 ;0 -failure
81 ;1^record number - success
82 ;
83IBD(IBDT,IBRECNO,IBIBDTYP,IBDATE) ;
84 N IBVAL,IBFLDNO,IBDTIEN
85 S IBVAL=$G(^XTMP(IBDT,IBRECNO,"IBD",IBIBDTYP))
86 S IBDTIEN=$O(^IBCNR(366.14,"B",IBDATE,0))
87 Q:+IBDTIEN=0 0
88 I IBIBDTYP="AUTH #" S IBFLDNO=".11" G EDITIBD
89 I IBIBDTYP="BCID" S IBFLDNO=".12" G EDITIBD
90 I IBIBDTYP="CLAIMID" S IBFLDNO=".13" G EDITIBD
91 I IBIBDTYP="DFN" S IBFLDNO=".14" G EDITIBD
92 I IBIBDTYP="DIVISION" S IBFLDNO=".15" G EDITIBD
93 I IBIBDTYP="RESPONSE" S IBFLDNO=".16" G EDITIBD
94 I IBIBDTYP="REVERSAL REASON" S IBFLDNO=".17" G EDITIBD
95 I IBIBDTYP="RTS-DEL" S IBFLDNO=".18" G EDITIBD
96 I IBIBDTYP="STATUS" S IBFLDNO=".19" G EDITIBD
97 I IBIBDTYP="RX NO" S IBFLDNO=".202" G EDITIBD
98 I IBIBDTYP="FILL NUMBER" S IBFLDNO=".203" G EDITIBD
99 I IBIBDTYP="DRUG" S IBFLDNO=".204" G EDITIBD
100 I IBIBDTYP="NDC" S IBFLDNO=".205" G EDITIBD
101 I IBIBDTYP="FILL DATE" S IBFLDNO=".206" G EDITIBD
102 I IBIBDTYP="RELEASE DATE" S IBFLDNO=".207" G EDITIBD
103 I IBIBDTYP="QTY" S IBFLDNO=".208" G EDITIBD
104 I IBIBDTYP="DAYS SUPPLY" S IBFLDNO=".209" G EDITIBD
105 I IBIBDTYP="DEA" S IBFLDNO=".21" G EDITIBD
106 I IBIBDTYP="FILLED BY" S IBFLDNO=".211" G EDITIBD
107 I IBIBDTYP="AO" S IBFLDNO=".401" G EDITIBD
108 I IBIBDTYP="CV" S IBFLDNO=".402" G EDITIBD
109 I IBIBDTYP="EC" S IBFLDNO=".403" G EDITIBD
110 I IBIBDTYP="IR" S IBFLDNO=".404" G EDITIBD
111 I IBIBDTYP="MST" S IBFLDNO=".405" G EDITIBD
112 I IBIBDTYP="HNC" S IBFLDNO=".406" G EDITIBD
113 I IBIBDTYP="SC" S IBFLDNO=".407" G EDITIBD
114 I IBIBDTYP="BILL" S IBFLDNO=".301" G EDITIBD
115 I IBIBDTYP="BILLED" S IBFLDNO=".302" G EDITIBD
116 I IBIBDTYP="PLAN" S IBFLDNO=".303" G EDITIBD
117 I IBIBDTYP="COST" S IBFLDNO=".304" G EDITIBD
118 I IBIBDTYP="PAID" S IBFLDNO=".305" G EDITIBD
119 I IBIBDTYP="CLOSE COMMENT" S IBFLDNO=".306" G EDITIBD
120 I IBIBDTYP="CLOSE REASON" S IBFLDNO=".307" G EDITIBD
121 I IBIBDTYP="DROP TO PAPER" S IBFLDNO=".308" G EDITIBD
122 I IBIBDTYP="RELEASE COPAY" S IBFLDNO=".309" G EDITIBD
123 I IBIBDTYP="USER" S IBFLDNO=".31" G EDITIBD
124 I IBIBDTYP="PRESCRIPTION" S IBFLDNO=".201" G EDITIBD
125 I IBIBDTYP="IEN" S IBFLDNO=".212" G EDITIBD
126 Q 0
127EDITIBD ;
128 Q +$$FILLFLDS^IBNCPUT1(366.141,IBFLDNO,IBRECNO_","_IBDTIEN,IBVAL)
129 ;------
130 ;
131 ; IBD("INS",n,1) = insurance array to bill in n order
132 ; file 355.3 ien (group)^bin^pcn^payer sheet B1^group id^
133 ; cardholder id^patient relationship code^
134 ; cardholder first name^cardholder last name^
135 ; home plan state^Payer Sheet B2^Payer Sheet B3^
136 ; Software/Vendor Cert ID^Ins Name^
137 ; (see RX^IBNCPDP1 for details)
138 ;
139 ; ("INS",n,2) = dispensing fee^basis of cost determination^
140 ; awp or tort rate or cost^gross amount due^
141 ; administrative fee
142 ;
143 ; ("INS",n,3) = group name^insurance phone number^plan ID ;
144 ;
145INS(IBDT,IBRECNO,IBDATE) ;
146 N IBSET1,IBSET2,IBSET3,IBFLDNO,IBDTIEN,IBINSNO,RECNO,IBVAL
147 S IBDTIEN=$O(^IBCNR(366.14,"B",IBDATE,0))
148 Q:+IBDTIEN=0 0
149 S IBINSNO=0
150 F S IBINSNO=$O(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO)) Q:+IBINSNO=0 D
151 . S IBSET1=$G(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,1))
152 . S IBSET2=$G(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,2))
153 . S IBSET3=$G(^XTMP(IBDT,IBRECNO,"IBD","INS",IBINSNO,3))
154 . ;INS IBINSNO
155 . ; 1 IBSET1
156 . ; 2 IBSET2
157 . ; 3 IBSET3
158 . S RECNO=$$ADDINS^IBNCPLOG(IBDTIEN,IBRECNO)
159 . I +RECNO=0 D ERRMSG(" >INSURANCE node was not created") Q
160 . I +$$FILLFLDS^IBNCPUT1(366.1412,.02,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,1))
161 . I +$$FILLFLDS^IBNCPUT1(366.1412,.03,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,2))
162 . I +$$FILLFLDS^IBNCPUT1(366.1412,.04,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,3))
163 . I +$$FILLFLDS^IBNCPUT1(366.1412,.05,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,4))
164 . I +$$FILLFLDS^IBNCPUT1(366.1412,.06,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,5))
165 . I +$$FILLFLDS^IBNCPUT1(366.1412,.07,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,6))
166 . I +$$FILLFLDS^IBNCPUT1(366.1412,.08,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,7))
167 . ;
168 . I +$$FILLFLDS^IBNCPUT1(366.1412,.101,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,8))
169 . I +$$FILLFLDS^IBNCPUT1(366.1412,.102,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,9))
170 . I +$$FILLFLDS^IBNCPUT1(366.1412,.103,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,10))
171 . I +$$FILLFLDS^IBNCPUT1(366.1412,.104,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,11))
172 . I +$$FILLFLDS^IBNCPUT1(366.1412,.105,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,12))
173 . I +$$FILLFLDS^IBNCPUT1(366.1412,.106,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,13))
174 . I +$$FILLFLDS^IBNCPUT1(366.1412,.107,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET1,U,14))
175 . ;
176 . I +$$FILLFLDS^IBNCPUT1(366.1412,.201,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,1))
177 . I +$$FILLFLDS^IBNCPUT1(366.1412,.202,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,2))
178 . I +$$FILLFLDS^IBNCPUT1(366.1412,.203,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,3))
179 . I +$$FILLFLDS^IBNCPUT1(366.1412,.204,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,4))
180 . I +$$FILLFLDS^IBNCPUT1(366.1412,.205,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET2,U,5))
181 . ;
182 . I +$$FILLFLDS^IBNCPUT1(366.1412,.301,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,1))
183 . I +$$FILLFLDS^IBNCPUT1(366.1412,.302,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,2))
184 . I +$$FILLFLDS^IBNCPUT1(366.1412,.303,RECNO_","_IBRECNO_","_IBDTIEN,$P(IBSET3,U,3))
185 Q RECNO
186 ;
187 ;create EVENT entry in #366.14
188 ;IBDATE date in FM format
189 ;EVNTRECN event recno required
190 ;EVNTTYPE event type (value for .01)
191 ;returns ien for the event
192ADDEVENT(IBDATE,EVNTRECN,EVNTTYPE) ;
193 N IBIEN,IBX
194 S IBIEN=+$O(^IBCNR(366.14,"B",IBDATE,0))
195 I IBIEN=0 Q -1
196 Q $$INSITEM^IBNCPUT1(366.141,IBIEN,$$EXT2INT^IBNCPUT1(EVNTTYPE),EVNTRECN)
197 ;
198DELDATE(IBIEN) ;
199 N IBPDA,ERRARR
200 S IBPDA(366.14,IBIEN_",",.01)="@"
201 D FILE^DIE("","IBPDA","ERRARR")
202 I $D(ERRARR) Q "0^"_ERRARR("DIERR",1,"TEXT",1)
203 Q 1
204 ;
205 ;display error message
206 ;IBERRMSG - error message text
207ERRMSG(IBERRMSG) ;
208 D BMES^XPDUTL(IBERRMSG)
209 Q
210 ;
211 ;send mail to the user
212SNDMAIL(IBSUBJ,IBMESS1,IBMESS2) ;
213 N DIFROM ;IMPORTANT - if you send e-mail from post-install !!!
214 N TMPARR,XMDUZ,XMSUB,XMTEXT,XMY
215 S TMPARR(1)=""
216 S TMPARR(2)=IBMESS1
217 S TMPARR(3)=IBMESS2
218 S TMPARR(4)=""
219 S XMSUB=IBSUBJ
220 S XMDUZ="INTEGRATED BILLING PACKAGE"
221 S XMTEXT="TMPARR("
222 S XMY(DUZ)=""
223 D ^XMD
224 Q
225 ;
226 ;IB20P342
Note: See TracBrowser for help on using the repository browser.