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

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1IBRUTL ;ALB/CPM-INTEGRATED BILLING - A/R INTERFACE UTILITIES ;03-MAR-92
2 ;;2.0;INTEGRATED BILLING;**70,82,132,142,176,179,202,223,363**;21-MAR-94;Build 35
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5IB(IEN,RETN) ; Are there any IB Actions on hold for this bill?
6 ; Input: IEN -- ien of Bill(#399), A/R(#430)
7 ; RETN (opt) -- Want array of IB Actions? (1-Yes,0-No)
8 ; if yes, returns IBA(num)=ibn
9 ; Returns: 1 -- Yes, 0 -- No
10 ;
11 N ATYPE,BTYPE,BILLS,DFN,IBFR,IB0,IBTO,IBU,IBN,IBND,IBNUM,IBOK
12 S:'$D(RETN) RETN=0 S BILLS=0
13 ;
14 ; - determine patient, bill type and billing dates
15 S IB0=$G(^DGCR(399,IEN,0)),IBU=$G(^("U")),DFN=+$P(IB0,"^",2)
16 S BTYPE=$S(+$P(IB0,"^",5)<3:"I",1:"O"),IBFR=+IBU,IBTO=$P(IBU,"^",2)
17 ;
18 ; - loop through all bills on hold, and set flag if there is an
19 ; - IB Action of the same type as the UB-82 which has been billed
20 ; - within the statement dates of the UB-82. Store all actions
21 ; - in the array IBA if required.
22 S (IBN,IBNUM)=0 F S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN D I IBOK Q:'RETN S IBNUM=IBNUM+1,IBA(IBNUM)=IBN
23 . S IBOK=0,IBND=$G(^IB(IBN,0)) Q:'IBND
24 . S ATYPE=$S($P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^")["OPT":"O",1:"I") Q:ATYPE'=BTYPE
25 . Q:$P(IBND,"^",15)<IBFR!($P(IBND,"^",14)>IBTO) S (IBOK,BILLS)=1
26 ;
27 Q BILLS
28 ;
29 ;
30HOLD(X,IBN,IBDUZ,IBSEQNO) ; Place IB Action on hold?
31 ; Input: X -- Zeroth node of IB Action
32 ; IBN -- ien of IB Action
33 ; IBDUZ -- User ID
34 ; IBSEQNO -- 1 (New Action), 3 (Update Action)
35 ; Returns: 1 -- Yes, 0 -- No
36 ;
37 N DFN,IBCOV,IBINDT,IBOUTP,HOLD,IBHOLDP,IBDUZ,I
38 N IBVDT,IBAT,IBCAT,IBALTC
39 ;
40 S HOLD=0
41 S IBHOLDP=$P($G(^IBE(350.9,1,1)),"^",20) ; Site parameter - HOLD MT BILLS W/INSURANCE
42 S DFN=+$P(X,"^",2)
43 ;
44 ;check if ECME RX copay needs to be placed on HOLD
45 I $$HOLDECME^IBNCPUT1(X)=0 G HOLDQ
46 ;
47 I $P(X,"^",5)=8 G HOLDQ ; action is already on hold
48 I '$P($G(^IBE(350.1,+$P(X,"^",3),0)),"^",10) G HOLDQ ; action can't be placed on hold
49 ;
50 ; - see if patient has insurance on Charge 'To' Date (otherwise Event date)
51 ; - includes check of plan coverage limitation
52 S IBINDT=+$P($G(^IB(+$G(IBN),0)),U,15)
53 I 'IBINDT S IBINDT=+$P($G(^IB(+$P(X,"^",16),0)),"^",17) I 'IBINDT S IBINDT=DT
54 S IBOUTP=1
55 D ^IBCNS
56 S IBVDT=$S(IBINDT'="":IBINDT,1:DT),IBAT=$P(^IBE(350.1,(+$P(X,U,3)),0),U,11)
57 S IBCAT=$S(IBAT<4:"INPATIENT",IBAT=4:"OUTPATIENT",IBAT=5:"PHARMACY",IBAT=8:"OUTPATIENT",IBAT=9:"INPATIENT",1:"")
58 S IBCOV="" I IBCAT'="" S IBCOV=$$PTCOV^IBCNSU3(DFN,IBVDT,IBCAT),HOLD=IBCOV
59 I 'IBCOV,+$$BUFFER^IBCNBU1(DFN) S (IBCOV,HOLD)=1 ; if patient has a buffer entry place charge on hold
60 ;
61 ;
62 ; - generate bulletin if patient has insurance, bulletin not suppressed
63 I IBCOV,'$P($G(^IBE(350.9,1,0)),"^",15),'$$ECME(IBN) D ^IBRBUL
64 ;
65 ; - update action to 'Hold' if parameter is set and vet has insurance
66 I IBHOLDP,IBCOV S DIE="^IB(",DA=IBN,DR=".05////8" D ^DIE,UP3^IBR:IBSEQNO=3 K DA,DIE,DR
67 ;
68HOLDQ Q +$G(HOLD)
69 ;
70ECME(IBN) ; return 1 if ECME billed already and bulleting should not go
71 N IBX,IBR,IBZ
72 S (IBR,IBX)=0,IBZ=^IB(IBN,0)
73 F S IBX=$O(^IBA(362.4,"B",$P($P(IBZ,"^",8),"-"),IBX)) Q:'IBX!(IBR) I $P($G(^DGCR(399,+$P(^IBA(362.4,IBX,0),"^",2),0)),"^",13)=4,$$FMDIFF^XLFDT($P(IBZ,"^",17),$P(^(0),"^",3),1)<6 S IBR=1
74 Q IBR
Note: See TracBrowser for help on using the repository browser.