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

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1IB20POST ;ALB/MAF - Post-Init to correct EABD for entries in "ATOBIL" x-ref. - Aug 7, 1997
2 ;;2.0; INTEGRATED BILLING ;**81**; 21-MAR-94
3 ; -- Post init to correct the Earliest Auto Biller Date (EABD).
4 ; The 17th piece ^ibt(356,ifn,0) gets reset to the date the entry
5 ; was entered into Claims Tracking plus the Days Delay.
6 ; This is only done for PRESCRIPTION REFILLS.
7 D BMES^XPDUTL("*** Correcting the Earliest Auto Billing Date (EABD) for entries in the 'ATOBIL' cross reference in Claims Tracking - Only for Prescription Refills.")
8 N IBDFN,IBTYPE,IBEABD,IBDT,IBDTCT,IBDFNODE,DIC,X,IBCTDA
9 S (IBDFN,IBTYPE,IBDT,IBEABD,IBCTDA)=0
10 F S IBDFN=$O(^IBT(356,"ATOBIL",IBDFN)) Q:'IBDFN S IBTYPE=$O(^IBE(356.6,"B","PRESCRIPTION REFILL",0)) D
11 .F S IBDT=$O(^IBT(356,"ATOBIL",IBDFN,IBTYPE,IBDT)) Q:'IBDT F S IBCTDA=$O(^IBT(356,"ATOBIL",IBDFN,IBTYPE,IBDT,IBCTDA)) Q:'IBCTDA D
12 ..S IBDFNODE=$G(^IBT(356,IBCTDA,0)),IBDTCT=$S(+$G(^IBT(356,IBCTDA,1))]"":+^IBT(356,IBCTDA,1),1:$P(IBDFNODE,"^",6))
13 ..S IBEABD=$$EABD(IBTYPE,IBDTCT)
14 ..S DIE="^IBT(356,",DA=IBCTDA,DR=".17////"_IBEABD
15 ..D ^DIE K DA,DIE,DR
16 ..Q
17 I '$D(^IBT(356,"ATOBIL")) D BMES^XPDUTL("*** There are no EABD cross references to correct ***")
18 D BMES^XPDUTL("DONE")
19 Q
20EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
21 ;the difference betwieen this and EABD^IBTUTL is that the autobill of the event type may be turned off
22 ;and this procedure will still return a date
23 ; -- input IBETYPE = pointer to type of entry file
24 ; IBTDT = episode date, if not passed in uses DT
25 ;
26 N X,X1,X2,Y,IBETYPD S Y="" I '$G(IBETYP) G EABDQ
27 S IBETYPD=$G(^IBE(356.6,+IBETYP,0)) I '$G(IBTDT) S IBTDT=DT
28 S X2=+$P(IBETYPD,"^",6) ;set earliest autobill date to entered date plus days delay
29 S X1=IBTDT D C^%DTC S Y=X\1
30EABDQ Q Y
Note: See TracBrowser for help on using the repository browser.