source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCD1.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: 4.0 KB
Line 
1IBCD1 ;ALB/ARH - AUTOMATED BILLER ; 8/6/93
2 ;;2.0; INTEGRATED BILLING ;**55,81**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5SETB ;set up bills (sort by event date required by types where multiple events can be on one bill)
6 S IBDFN=0 F S IBDFN=$O(^TMP("IBCAB",$J,IBDFN)) Q:'IBDFN D
7 . S IBTYP=0 F S IBTYP=$O(^TMP("IBCAB",$J,IBDFN,IBTYP)) Q:'IBTYP S IBS="IBC"_IBTYP D
8 .. S IBEVDT=0 F S IBEVDT=$O(^TMP("IBCAB",$J,IBDFN,IBTYP,IBEVDT)) Q:'IBEVDT D
9 ... S IBTRN=0 F S IBTRN=$O(^TMP("IBCAB",$J,IBDFN,IBTYP,IBEVDT,IBTRN)) Q:'IBTRN D
10 .... S IBX=$P($G(^IBE(356.6,+IBTYP,0)),U,1)
11 .... I IBX="INPATIENT ADMISSION" D INP^IBCD5 Q
12 .... I IBX="PRESCRIPTION REFILL" D RXRF Q
13 .... I IBX="OUTPATIENT VISIT" D OUTP Q
14 .... D TEABD(IBTRN,0),TERR(IBTRN,0,"Event type can not be auto billed.")
15 K IBDFN,IBTYP,IBEVDT,IBTRN,IBS,IBX,IBSTDT,IBTF
16 D NABOUTP
17 D ^IBCD2
18 Q
19 ;
20OUTP ;Outpatient Bills (IBTRN,IBTYP,IBDFN,IBEVDT)
21 ;get statement from and to dates, based on event date and billing cycle of event type then try to match event to an existing bill cycle, check that event is not already billed and that BC+DD is greater than current date
22 ;^TMP("IBC2",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
23 S IBSTDT=(IBEVDT\1)_"^"_$$BCDT^IBCU8(IBEVDT,IBTYP)
24 S IBX=0 F S IBX=$O(^TMP(IBS,$J,IBDFN,IBX)) Q:IBX=""!(+IBSTDT<+IBX) I +IBSTDT'>$P(IBX,U,2) S IBSTDT=IBX Q
25 S IBX=$$DUPCHK^IBCU41(IBEVDT,0,0,IBDFN,0) I +IBX D TEABD(IBTRN,0),TERR(IBTRN,0,$P(IBX,U,2)) G OUTPQ
26 S IBX=$$EABD^IBCU81(IBTYP,$P(IBSTDT,U,2)) I +IBX>DT N IBXX S IBXX=$S(+$P($G(^IBT(356,IBTRN,1)),U,1)]"":+$P(^IBT(356,IBTRN,1),U,1)\1,1:$P(IBSTDT,U,1)),IBXX=$$EABD^IBCU81(IBTYP,IBXX) D TEABD(IBTRN,+IBXX) G OUTPQ
27 I $$NABSCT^IBCU81(IBTRN) S ^TMP("IBNAB",$J,IBS,IBDFN,(IBEVDT\1),IBTRN)="" G OUTPQ
28 S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1,^TMP("IBNAB1",$J,IBS,IBDFN,(IBEVDT\1))=IBSTDT
29OUTPQ K IBSTDT,IBX
30 Q
31RXRF ;RX Refill (Outpatient) Bills (IBTRN,IBTYP,IBDFN,IBEVDT)
32 ;get statement from and to dates, based on event date and billing cycle of event type then try to match event to an existing bill cycle, check that event is not already billed and that BC+DD is greater than current date
33 ;^TMP("IBC4",$J, PATIENT , START DT ^ TO DT , EVENT IFN)= TIMEFRAME
34 S IBRXRF=$$RXRF^IBCU81(IBTRN) I IBRXRF="" D TEABD(IBTRN,0),TERR(IBTRN,0,"Can not find rx refill in Pharmacy.") G RXRFQ
35 S IBSTDT=($P(IBRXRF,U,2)\1)_"^"_$$BCDT^IBCU8(+$P(IBRXRF,U,2),IBTYP)
36 S IBX=0 F S IBX=$O(^TMP(IBS,$J,IBDFN,IBX)) Q:IBX=""!(+IBSTDT<+IBX) I +IBSTDT'>$P(IBX,U,2) S IBSTDT=IBX Q
37 S IBX=$$RXDUP^IBCU3($P(IBRXRF,U,1),+$P(IBRXRF,U,2),0,0,IBDFN,0) I +IBX D TEABD(IBTRN,0),TERR(IBTRN,0,$P(IBX,U,2)) G RXRFQ
38 S IBX=$$EABD^IBCU81(IBTYP,$P(IBSTDT,U,2)) I +IBX>DT N IBXX S IBXX=$S(+$P($G(^IBT(356,IBTRN,1)),U,1)]"":+$P(^IBT(356,IBTRN,1),U,1)\1,1:$P(IBSTDT,U,1)),IBXX=$$EABD^IBCU81(IBTYP,IBXX) D TEABD(IBTRN,+IBXX) G RXRFQ
39 S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1
40RXRFQ K IBSTDT,IBX,IBRXRF
41 Q
42 ;
43NABOUTP ; add opt visits that should not be auto billed but date has been billed
44 N IBDFN,IBS,IBEVDT,IBSTDT,IBTRN S IBS=$O(^TMP("IBNAB",$J,0))
45 I IBS'="" S IBDFN=0 F S IBDFN=$O(^TMP("IBNAB",$J,IBS,IBDFN)) Q:'IBDFN D
46 . S IBEVDT=0 F S IBEVDT=$O(^TMP("IBNAB",$J,IBS,IBDFN,IBEVDT)) Q:'IBEVDT D
47 .. S IBSTDT=$G(^TMP("IBNAB1",$J,IBS,IBDFN,IBEVDT))
48 .. S IBTRN=0 F S IBTRN=$O(^TMP("IBNAB",$J,IBS,IBDFN,IBEVDT,IBTRN)) Q:'IBTRN D
49 ... I IBSTDT'?7N1"^"7N D TEABD(IBTRN,0) Q
50 ... S ^TMP(IBS,$J,IBDFN,IBSTDT,IBTRN)=1
51 K ^TMP("IBNAB",$J),^TMP("IBNAB1",$J)
52 Q
53 ;
54TEABD(TRN,IBDT) ;array contains the list of claims tracking events that need EABD updated, and the new date
55 S IBDT=+$G(IBDT),^TMP("IBEABD",$J,TRN,+IBDT)=""
56 Q
57TERR(TRN,IFN,ER) ;array contains events or bills that need entries created in the comments file, and the comment
58 N X S TRN=+$G(TRN),IFN=+$G(IFN),X=+$G(^TMP("IBCE",$J,DT,TRN,IFN))+1
59 S ^TMP("IBCE",$J,DT,TRN,IFN,X)=$G(ER),^TMP("IBCE",$J,DT,TRN,IFN)=X
60 Q
61TBILL(TRN,IFN) ;array contains list of events and bills to be inserted into 356.399
62 I '$D(^IBT(356,+$G(TRN),0))!('$D(^DGCR(399,+$G(IFN),0))) Q
63 S ^TMP("IBILL",$J,TRN,IFN)=""
64 Q
Note: See TracBrowser for help on using the repository browser.