source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOHCT.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.7 KB
Line 
1IBOHCT ;ALB/EMG - CHECK FOR IB CHARGES ON HOLD ; MAY 2 1997
2 ;;2.0; INTEGRATED BILLING ;**70,95,347**; 21-MAR-94;Build 24
3 ;
4FIND(DFN,IBTRN) ; find all related IB charges on hold for episodes of care
5 ; for this Claims Tracking entry with Reason Not Billable
6 ; once IB Charge is found, release Charge On Hold to AR
7 ; so patient can be billed.
8 ;
9 ; Input: DFN -- pointer to the patient in file #2
10 ; IBTRN -- ien of Claims Tracking entry
11 ;
12 I '$G(DFN)!('$G(IBTRN)) G ALLQ
13 D HOME^%ZIS
14 ;
15 N X,Y,Y1,IBA,IBX,IBCTR,IBEDT,IBEND,IBNOS,IBSEQNO,IBDUZ,DP,DL
16 ;
17 S IBCT=$G(^IBT(356,IBTRN,0)),IBEDT=$P($P(IBCT,"^",6),"."),IBI=0
18 I $P(IBCT,"^",18)=4 D RXCHG,REL G ALLQ
19 ;
20 ;
21 ; - find related inpatient/outpatient patient charges on hold
22 S (IBNUM,Y)=0 F S Y=$O(^IB("AFDT",DFN,-IBEDT,Y)) Q:'Y D
23 .S Y1=0 F S Y1=$O(^IB("AF",Y,Y1)) Q:'Y1 D
24 ..Q:'$D(^IB(Y1,0)) S IBX=^(0)
25 ..I $P(IBX,"^",5)'=8 Q
26 ..S IBNUM=IBNUM+1,IBA(IBNUM)=Y1
27 ..Q
28 .Q
29 ;
30REL ; allow user to select IB charges to pass to Accounts Receivable
31 ;
32 I '$G(IBNUM) G ALLQ
33 W !!,"The following IB Action"_$S(IBNUM>2:"s",1:"")_", related to this CT entry, ",$S(IBNUM>2:"are",1:"is")," ON HOLD:" D HDR
34 S IBQ=0 F IBNUM=1:1 Q:'$D(IBA(IBNUM)) D:'(IBNUM#15) Q:IBQ S IBN=IBA(IBNUM) D LST
35 . R !,"Enter RETURN to continue or '^' to stop: ",X:DTIME S:X["^"!('$T) IBQ=1 Q
36 ;
37 ; prompt user to select IB Actions
38 S DIR(0)="LA^1:"_(IBNUM-1)_"^",DIR("A")="Select IB Action"_$E("s",IBNUM>2)_" (REF #) to release to Accounts Receivable (or '^' to exit): ",DIR("?")="^D HELP^IBRREL"
39 W ! D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) Q
40 ;
41 S IBRANGE=Y,IBSEQNO=1,IBDUZ=DUZ
42 S DIR(0)="Y",DIR("A")="OK to pass "_$S($P(Y,",",2):"these charges",1:"this charge")_" to Accounts Receivable"
43 D ^DIR K DIR I 'Y!($D(DIRUT))!($D(DUOUT)) G ALLQ
44 ;
45 ; pass charges to Accounts Receivable
46 W !!,"Passing charges to Accounts Receivable...",! D HDR
47 F IBCTR=1:1 S IBNUM=$P(IBRANGE,",",IBCTR) Q:'IBNUM I $D(IBA(IBNUM)) S IBNOS=IBA(IBNUM) D ^IBR,ERR:Y<1 I Y>0 S IBN=IBA(IBNUM) D LST
48 W !!,"The charge"_$E("s",$P(IBRANGE,",",2)>0)_" listed above "_$S($P(IBRANGE,",",2):"have",1:"has")_" been passed to Accounts Receivable.",!
49 ;
50 W ! S DIR(0)="E" D ^DIR K DIR G ALLQ
51 ;
52ALLQ K IBC,IBCRG,IBCT,IBCTR,IBEDT,IBEND,IBI,IBLINE,IBN,IBND
53 K IBNOS,IBNUM,IBOHD,IBQ,IBRANGE,IBRXN,IBRXDT,IBRXEND,IBSEQNO
54 K DIRUT,DUOUT
55 Q
56 ;
57 ;
58HDR ; Display charge header.
59 N IBLINE S $P(IBLINE,"=",81)=""
60 W !,IBLINE,!," REF Action ID Bill Type",?42,"Bill #",?51,"Fr/Fl Dt",?61,"To/Rls Dt",?73,"Charge"
61 W !,IBLINE Q
62 ;
63LST ; Display individual IB Action.
64 N IBND,IBND1,IBRXN,IBRX,IBRF,IBRDT,IENS
65 S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1)),(IBRXN,IBRX,IBRF,IBRDT)=0
66 I $P(IBND,"^",4)["52:" S IBRXN=$P($P(IBND,"^",4),":",2),IBRX=$P($P(IBND,"^",8),"-"),IBRF=$P($P(IBND,"^",4),":",3)
67 I $P(IBND,"^",4)["52:" D
68 .I IBRF>0 S IENS=+IBRF,IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,+IENS,52,.01)
69 .E S IENS=+IBRXN,IBRDT=$$FILE^IBRXUTL(+IENS,22)
70 W !?1,$J(IBNUM,2),?7,$J(+IBND,9)
71 W ?18,$S(IBRXN>0:"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),1:$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",8))
72 W ?42,$P($P(IBND,"^",11),"-",2)
73 W ?51,$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,"^",14)))
74 W ?61,$$DAT1^IBOUTL($S($P(IBND,"^",15)'="":($P(IBND,"^",15)),1:$P(IBND1,"^",2)))
75 W ?70,$J(+$P(IBND,"^",7),9,2)
76 Q
77 ;
78RXCHG ; - find related rx copay's on hold in file 350
79 N IBRXN,IBRXBN,IBRXEND,IBRXDT,IBCRG,IBC
80 S IBNUM=0
81 S IBRXEND=+IBEDT+.999999 F S IBEDT=$O(^IB("APTDT",DFN,IBEDT)) Q:'IBEDT!(IBEDT>IBRXEND) S Y1=0 F S Y1=$O(^IB("APTDT",DFN,IBEDT,Y1)) Q:'Y1 S IBX=^IB(Y1,0),IBOHD=$P($G(^IB(Y1,1)),"^",6) D
82 .I $P(IBX,"^",5)'=8 Q
83 .S IBNUM=IBNUM+1,IBA(IBNUM)=Y1 Q
84 Q
85 ;
86ERR ; display error message
87 W !,?5,"Error encountered - a separate bulletin has been posted"
88 Q
Note: See TracBrowser for help on using the repository browser.