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

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1IBCD ;ALB/ARH - AUTOMATED BILLER ;8/6/93
2 ;;2.0;INTEGRATED BILLING;**312**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;This routine is the begining of the auto biller. No variables are required on entry. It is be called by the
6 ;IB nightly job routine IBAMTC. It first checks to see if it should run based on the auto biller frequency
7 ;site parameter. It then gathers the Claims Tracking events with an EABD into a temporary file by patient,
8 ;event type, and episode date. This temporary file ("IBACAB") is then used to sort the events into groups
9 ;that should be added to individual bills based on the individual event type billing cycle parameters. This
10 ;second temporary file is then used to create the actual bills in IBCD1-2.
11 ;
12EN ;begin process of finding and creating bills
13 ;determine if auto biller should run, check site parameters (350.9,7.01-7.02)
14 N IBSWINFO,IBPFSS S IBSWINFO=$$SWSTAT^IBBAPI() ;IB*2.0*312
15 S IBPAR7=$G(^IBE(350.9,1,7)) G:'$P(IBPAR7,U,1) EXIT
16 I +IBPAR7,+$P(IBPAR7,U,2),$$FMADD^XLFDT(+$P(IBPAR7,U,2),+IBPAR7)>DT G EXIT
17 S IBAUTO=1
18 ;
19 ;begin search for events to bill, create array of events by patient
20 ;^TMP("IBCAB",$J, PATIENT, EVENT TYPE, EPISODE DATE, EVENT IFN)=""
21 ;adds all events in Claims Tracking that have an EABD not after today
22 S IBDFN=0 F S IBDFN=$O(^IBT(356,"ATOBIL",IBDFN)) Q:'IBDFN D
23 . S IBTYP=0 F S IBTYP=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP)) Q:'IBTYP D
24 .. S IBEABD=0 F S IBEABD=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD)) Q:'IBEABD!(IBEABD>DT) D
25 ... S IBTRN=0 F S IBTRN=$O(^IBT(356,"ATOBIL",IBDFN,IBTYP,IBEABD,IBTRN)) Q:'IBTRN D
26 .... S IBX=$$EVBILL^IBCU81(IBTRN) I 'IBX!(IBX>DT) D TEABD(IBTRN,+IBX) D:$P(IBX,U,2)'="" TERR(IBTRN,0,$P(IBX,U,2)) Q
27 .... S IBX=$$EVNTCHK^IBCU82(IBTRN) I +IBX D TEABD(IBTRN,0) D TERR(IBTRN,0,$P(IBX,U,2)) Q
28 .... S IBTRND=$G(^IBT(356,IBTRN,0))
29 .... I +IBSWINFO D Q:IBPFSS ;IB*2.0*312
30 ..... S IBPFSS=1 ;IB*2.0*312
31 ..... ; Do NOT PROCESS on VistA if DT>=Switch Eff Date ;CCR-930
32 ..... I ($P(IBTRND,"^",6)+1)>$P(IBSWINFO,"^",2) Q ;IB*2.0*312
33 ..... I $P($G(^DPT(IBDFN,.1)),"^")'="" Q ;IB*2.0*312
34 ..... Q:$$CHKDIS() ;CCR-1081
35 ..... S IBPFSS=0 ;Before EffDt & Discharged ;IB*2.0*312
36 .... ;
37 .... S ^TMP("IBCAB",$J,IBDFN,IBTYP,+$P(IBTRND,U,6),IBTRN)=""
38 K IBDFN,IBTYP,IBEABD,IBTRN,IBTRND,IBX
39 ;
40 I $D(^TMP("IBCAB",$J)) D ^IBCD1 ; consolidate events into bills, create bills
41 D ^IBCDC ; set comments into file
42 S DIE="^IBE(350.9,",DA=1,DR="7.02////"_DT D ^DIE ;reset last date auto biller run
43 K ^TMP("IBCAB",$J),^TMP("IBEABD",$J),^TMP("IBCE",$J),^TMP("IBILL",$J)
44 F IBX=1:1:10 K ^TMP(("IBC"_IBX),$J)
45EXIT K IBX,IBPAR7,DIE,DA,DR,IBAUTO,IBBS,IBSC,IBT
46 Q
47CHKDIS() ; Returns 1 if discharge was on or after effective date ;CCR-1081
48 N IBADMLNK,IBDISLNK
49 S IBADMLNK=$P(IBTRND,"^",5) G:'IBADMLNK CHKDISQ
50 S IBDISLNK=$P($G(^DGPM(IBADMLNK,0)),"^",17) G:'IBDISLNK CHKDISQ
51 ;
52 I (^DGPM(IBDISLNK,0)+1)>$P(IBSWINFO,"^",2) Q 1
53CHKDISQ Q 0
54 ;
55TEABD(TRN,IBDT) ;array contains the list of claims tracking events that need EABD updated, and the new date
56 S IBDT=+$G(IBDT),^TMP("IBEABD",$J,TRN,+IBDT)=""
57 Q
58TERR(TRN,IFN,ER) ;array contains events or bills that need entries created in the comments file, and the comment
59 N X S TRN=+$G(TRN),IFN=+$G(IFN),X=+$G(^TMP("IBCE",$J,DT,TRN,IFN))+1
60 S ^TMP("IBCE",$J,DT,TRN,IFN,X)=$G(ER),^TMP("IBCE",$J,DT,TRN,IFN)=X
61 Q
62TBILL(TRN,IFN) ;array contains list of events and bills to be inserted into 356.399
63 I '$D(^IBT(356,+$G(TRN),0))!('$D(^DGCR(399,+$G(IFN),0))) Q
64 S ^TMP("IBILL",$J,TRN,IFN)=""
65 Q
Note: See TracBrowser for help on using the repository browser.