1 | IBOMTP1 ;ALB/CPM-MEANS TEST BILLING PROFILE (CON'T);10-DEC-91
|
---|
2 | ;;2.0;INTEGRATED BILLING;**15,153,176,183**;21-MAR-94
|
---|
3 | ;; Per VHA Directive 10-93-142, this routine should not be modified
|
---|
4 | ;
|
---|
5 | N IBLEG
|
---|
6 | ;***
|
---|
7 | ;S XRTL=$ZU(0),XRTN="IBOMTP1-2" D T0^%ZOSV ;start rt clock
|
---|
8 | ; Begin compilation. Start with billing clocks.
|
---|
9 | S Y=-(IBEDT+.1),X=0 F Q:-Y<IBBDT S Y=$O(^IBE(351,"AIVDT",IBDFN,Y)) Q:'Y F S X=$O(^IBE(351,"AIVDT",IBDFN,Y,X)) Q:'X S:$P($G(^IBE(351,X,0)),U,4)'=3 ^TMP($J,"IBOMTP",-Y,"C")=""
|
---|
10 | ;
|
---|
11 | ; Get O/P visits from file #399.
|
---|
12 | S X1=IBBDT,X2=-1 D C^%DTC S Y=X
|
---|
13 | F S Y=$O(^DGCR(399,"AOPV",IBDFN,Y)) Q:'Y!(Y>IBEDT) D
|
---|
14 | . S IBDA=0 F S IBDA=$O(^DGCR(399,"AOPV",IBDFN,Y,IBDA)) Q:'IBDA D
|
---|
15 | .. I $D(^DGCR(399,+IBDA,0)),'$P($G(^("S")),U,16),$P($G(^DGCR(399.3,+$P(^(0),U,7),0)),U)["MEANS" S ^TMP($J,"IBOMTP",Y,"M"_IBDA)=""
|
---|
16 | ;
|
---|
17 | ; Get the rest of the charges from file #350.
|
---|
18 | S Y="" F S Y=$O(^IB("AFDT",IBDFN,Y)) Q:'Y I -Y'>IBEDT S Y1=0 F S Y1=$O(^IB("AFDT",IBDFN,Y,Y1)) Q:'Y1 D
|
---|
19 | . S IBDA=0 F S IBDA=$O(^IB("AF",Y1,IBDA)) Q:'IBDA D
|
---|
20 | .. Q:'$D(^IB(IBDA,0)) S IBX=^(0)
|
---|
21 | .. Q:$P(IBX,U,8)["ADMISSION"
|
---|
22 | .. I $P(IBX,U,15)<IBBDT!($P(IBX,U,14)>IBEDT) Q
|
---|
23 | .. N Y,Y1
|
---|
24 | .. ; Action type. We don't include LTC actions to the report
|
---|
25 | .. I $P(IBX,U,3) I $$ACTNM^IBOUTL(+$P(IBX,U,3))["LTC " Q ; Exclude LTC action type
|
---|
26 | .. S ^TMP($J,"IBOMTP",+$P(IBX,U,14),"I"_IBDA)=""
|
---|
27 | ;
|
---|
28 | ; Print report.
|
---|
29 | S IBLEG=0 ; Legend not required
|
---|
30 | D NOW^%DTC S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
|
---|
31 | S IBLINE="",$P(IBLINE,"-",IOM+1)="",(IBPAG,IBCHGT,IBQUIT)=0
|
---|
32 | S IBPT=$$PT^IBEFUNC(IBDFN)
|
---|
33 | S IBH="Means Test Billing Profile for "_$P(IBPT,U)_" "_$P(IBPT,U,2) D HDR
|
---|
34 | I '$D(^TMP($J,"IBOMTP")) W !,"This patient has no Means Test bills." D PAUSE^IBOUTL G END
|
---|
35 | ; - first, print detail lines
|
---|
36 | S IBD="" F S IBD=$O(^TMP($J,"IBOMTP",IBD)) Q:'IBD D G:IBQUIT END
|
---|
37 | . S IBTY="" F S IBTY=$O(^TMP($J,"IBOMTP",IBD,IBTY)) Q:IBTY="" D Q:IBQUIT
|
---|
38 | .. I $Y>(IOSL-5) D PAUSE^IBOUTL Q:IBQUIT D HDR
|
---|
39 | .. W !,$$DAT1^IBOUTL(IBD)
|
---|
40 | .. I IBTY="C" W ?12,"Begin Means Test Billing Clock" Q
|
---|
41 | .. S IBDA=+$E(IBTY,2,99),IBD0=$S($E(IBTY)="M":$G(^DGCR(399,IBDA,0)),1:$G(^IB(IBDA,0))),IBSEQ=0
|
---|
42 | .. I $E(IBTY)="I" S IBSEQ=$P($G(^IBE(350.1,+$P(IBD0,U,3),0)),U,5)
|
---|
43 | .. W ?14,$S($E(IBTY)="M":"OPT COPAYMENT (UB-82)",1:$$ACTNM^IBOUTL(+$P(IBD0,U,3)))
|
---|
44 | .. W ?44,$S($E(IBTY)="M":$P(IBD0,U),1:$$STAT())
|
---|
45 | .. I $E(IBTY)="I",$P(IBD0,U,14)'=$P(IBD0,U,15) W ?54,$$DAT1^IBOUTL($P(IBD0,U,15))
|
---|
46 | .. I $E(IBTY)="M" S X=+$O(^DGCR(399,IBDA,"RC","B",500,0)),IBCHG=+$P($G(^DGCR(399,IBDA,"RC",X,0)),U,2)
|
---|
47 | .. E S IBCHG=+$P(IBD0,U,7)
|
---|
48 | .. I IBSEQ=2 S IBCHG=-IBCHG
|
---|
49 | .. I $E(IBTY)="I",$P(IBD0,U,11)="",$P($G(^IBE(350.21,+$P(IBD0,U,5),0)),U,5) S IBCHG=0
|
---|
50 | .. S X=IBCHG,X2="2$",X3=10 D COMMA^%DTC W ?65,X
|
---|
51 | .. I $P(IBD0,U,21) W " *" S IBLEG=1 ;Print legend at the bottom
|
---|
52 | .. S IBCHGT=IBCHGT+IBCHG
|
---|
53 | .. I IBSEQ=2!($P(IBD0,U,11)=""&($P($G(^IBE(350.21,+$P(IBD0,U,5),0)),U,5))) W !?5,"Charge Removal Reason: ",$S($D(^IBE(350.3,+$P(IBD0,U,10),0)):$P(^(0),U),1:"UNKNOWN")
|
---|
54 | ; - print totals line
|
---|
55 | I ($Y-IBLEG)>(IOSL-5) D LEGEND,PAUSE^IBOUTL G:IBQUIT END D HDR
|
---|
56 | W !?63,"-----------" S X=IBCHGT,X2="2$",X3=12 D COMMA^%DTC W !?63,X
|
---|
57 | D LEGEND,PAUSE^IBOUTL
|
---|
58 | ; - close device and quit
|
---|
59 | END K ^TMP($J)
|
---|
60 | ;***
|
---|
61 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOMTP1" D T1^%ZOSV ;stop rt clock
|
---|
62 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
---|
63 | K IBJ,IBD,IBH,IBHDT,IBTY,IBDA,IBD0,IBSEQ,IBQUIT,IBCHG,IBCHGT,IBPAG,IBLINE,IBX,IBPT,X,X2,X3,Y,Y1
|
---|
64 | D ^%ZISC Q
|
---|
65 | ;
|
---|
66 | ;
|
---|
67 | HDR ; Print header.
|
---|
68 | S IBLEG=0
|
---|
69 | I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
|
---|
70 | S IBPAG=IBPAG+1 W ?(80-$L(IBH)\2),IBH
|
---|
71 | W !,"From ",$$DAT1^IBOUTL(IBBDT)," through ",$$DAT1^IBOUTL(IBEDT)
|
---|
72 | W ?IOM-36,IBHDT,?IOM-9,"Page: ",IBPAG
|
---|
73 | W !,"BILL DATE BILL TYPE",?44,"BILL # BILL TO TOT CHARGE"
|
---|
74 | W !,IBLINE,! Q
|
---|
75 | ;
|
---|
76 | STAT() ; Display bill number or status
|
---|
77 | N IBSTAT S IBSTAT=$G(^IBE(350.21,+$P(IBD0,U,5),0))
|
---|
78 | Q $S($P(IBSTAT,U,6):$$HLD(+$P(IBD0,U,5)),$P(IBD0,U,5)=99:"Converted",$P(IBD0,U,11)]"":$P($P(IBD0,U,11),"-",2),$P(IBSTAT,U,5):"Cancelled",1:"Pending")
|
---|
79 | ;
|
---|
80 | HLD(STAT) ; Return an 'on hold' status string
|
---|
81 | Q "Hold "_$S(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
|
---|
82 | ;
|
---|
83 | LEGEND I $G(IBLEG) W !," '*' - Geographic Means Test rates"
|
---|
84 | Q
|
---|