| [613] | 1 | IBOLK ;ALB/AAS - INTEGRATED BILLING - DISPLAY BY BILL NUMBER ; 6-MAR-91
|
|---|
| 2 | ;;2.0; INTEGRATED BILLING ;**199**; 21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | % ;
|
|---|
| 5 | ;***
|
|---|
| 6 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOLK" D T1^%ZOSV ;stop rt clock
|
|---|
| 7 | ;S XRTL=$ZU(0),XRTN="IBOLK-1" D T0^%ZOSV ;start rt clock
|
|---|
| 8 | N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
|
|---|
| 9 | S DIC("A")="Select CHARGE ID or PATIENT NAME: ",DIC="^PRCA(430,",DIC(0)="AEQM" D ^DIC K DIC G END1:+Y<1 S IBIL=$P(Y,"^",2)
|
|---|
| 10 | S IBIFN=$O(^DGCR(399,"B",$P(IBIL,"-",2),0))
|
|---|
| 11 | I '$D(^IB("ABIL",IBIL)),'IBIFN W !!,"Billing has no Record of this Charge ID.",! G %
|
|---|
| 12 | ;
|
|---|
| 13 | BRIEF R !,"(B)rief or (F)ull Inquiry: B// ",X:DTIME G:X="^"!('$T) END1 S:X="" X="B" S X=$E(X)
|
|---|
| 14 | I "BFbf"'[X D G BRIEF
|
|---|
| 15 | . W !!?5,"Enter: '<CR>' - To select the Brief Inquiry."
|
|---|
| 16 | . W !?12,"'F' - To select the Full Inquiry. This option will"
|
|---|
| 17 | . W !?23,"include the Address Inquiry, and more detailed"
|
|---|
| 18 | . W !?23,"information for Pharmacy Co-Pay bills."
|
|---|
| 19 | . W !?12,"'^' - To quit this option.",!
|
|---|
| 20 | W $S("Bb"[X:" BRIEF",1:" FULL") S IBFULL="Ff"[X
|
|---|
| 21 | I IBIFN S IBAC=8,IBQUIT=0
|
|---|
| 22 | ;
|
|---|
| 23 | DEV W ! S %ZIS="QM",%ZIS("A")="Output Device: " D ^%ZIS G:POP END
|
|---|
| 24 | I $D(IO("Q")) D D ^%ZTLOAD K IO("Q") D HOME^%ZIS W ! G %
|
|---|
| 25 | . S ZTDESC="IB Print Actions by Bill Number"
|
|---|
| 26 | . S ZTRTN=$S(IBIFN:"VIEW^IBCNQ",1:"EN^IBOLK")
|
|---|
| 27 | . S ZTSAVE("IBFULL")="",ZTSAVE("IBIL")="",ZTSAVE("IBIFN")=""
|
|---|
| 28 | . I IBIFN F I="IBAC","IBQUIT" S ZTSAVE(I)=""
|
|---|
| 29 | ;
|
|---|
| 30 | U IO
|
|---|
| 31 | ;***
|
|---|
| 32 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOLK" D T1^%ZOSV ;stop rt clock
|
|---|
| 33 | I 'IBIFN D EN G %
|
|---|
| 34 | D VIEW^IBCNQ,Q^IBCNQ,END1 G %
|
|---|
| 35 | ;
|
|---|
| 36 | EN ; -Entry to display IB Action data for an AR Bill number
|
|---|
| 37 | ; -Input IBIL = external form of bill number, ie 500-K10001
|
|---|
| 38 | ; IBFULL = 1 for full profile logic, 0 for brief description
|
|---|
| 39 | ;***
|
|---|
| 40 | ;S XRTL=$ZU(0),XRTN="IBOLK-2" D T0^%ZOSV ;start rt clock
|
|---|
| 41 | S IBN=$O(^IB("ABIL",IBIL,"")) G:'$D(^IB(IBN,0)) ENQ
|
|---|
| 42 | S IBTOTL=0,IBQUIT="",IBPAG=0 D NOW^%DTC S IBHDT=$$DAT2^IBOUTL($E(%,1,12)) D HDR
|
|---|
| 43 | ;
|
|---|
| 44 | S IBN="" F IBI=0:0 S IBN=$O(^IB("ABIL",IBIL,IBN)) Q:'IBN I $D(^IB(IBN,0)) D LINE Q:IBQUIT
|
|---|
| 45 | I 'IBQUIT D TOTAL,PAUSE,^IBOLK1:IBFULL&('IBQUIT)
|
|---|
| 46 | ENQ D END Q
|
|---|
| 47 | ;
|
|---|
| 48 | LINE ; -find data for one line, write line, accumulate totals
|
|---|
| 49 | I '$D(IBTRAN),$Y>(IOSL-5) D PAUSE Q:IBQUIT D HDR1
|
|---|
| 50 | S IBND=^IB(IBN,0),IBND1=$G(^(1))
|
|---|
| 51 | I IBFULL,$D(^IBE(350.1,+$P(IBND,"^",3),30)) W ! S X1=$P($P($P(IBND,"^",4),";",1),":",2),X2=$P($P($P(IBND,"^",4),";",2),":",2),X=X1_"^"_$S(X2:X2,1:0) X ^(30)
|
|---|
| 52 | S IBTYP=$G(^IBE(350.1,+$P(IBND,"^",3),0)),IBSEQNO=$P(IBTYP,"^",5)
|
|---|
| 53 | W ! S Y=$P($P(IBND1,"^",2),".",1) D DT^DIQ
|
|---|
| 54 | W ?15,$E($P($P(IBTYP,"^")," ",2,99),1,20),?37,$E($P(IBND,"^",8),1,20),?60,$J($P(IBND,"^",6),5)
|
|---|
| 55 | S IBCHRG=$P(IBND,"^",7) I IBSEQNO=2 S IBCHRG=(-IBCHRG) ;cancel types are decrease adjustments
|
|---|
| 56 | S X=IBCHRG,X2="2$",X3=10 D COMMA^%DTC W ?69,X
|
|---|
| 57 | S IBTOTL=IBTOTL+IBCHRG
|
|---|
| 58 | I $P(IBND,"^",10),IBSEQNO=2 W !,?5,"Charge Removal Reason: ",$S($D(^IBE(350.3,$P(IBND,"^",10),0)):$P(^(0),"^"),1:"UNKNOWN")
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | HDR S IBND=^IB(IBN,0),DFN=+$P(IBND,"^",2),IBNAME=$$PT^IBEFUNC(DFN)
|
|---|
| 62 | HDR1 S IBPAG=IBPAG+1 I $E(IOST,1,2)["C-"!(IBPAG>1) W @IOF,*13
|
|---|
| 63 | W $E($P(IBNAME,"^"),1,20)," ",$P(IBNAME,"^",2),?38,IBIL,?51,IBHDT,?72,"PAGE: ",IBPAG
|
|---|
| 64 | D DISP^IBARXEU(DFN,DT,2) W !
|
|---|
| 65 | W:'IBFULL !,"DATE",?15,"CHARGE TYPE",?37,"BRIEF DESCRIPTION",?62,"UNITS",?73,"CHARGE"
|
|---|
| 66 | S IBLINE="",$P(IBLINE,"=",IOM)="" W !,IBLINE K IBLINE
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | TOTAL W !?67,"------------" S X=IBTOTL,X2="2$",X3=12 D COMMA^%DTC
|
|---|
| 70 | W !,?67,X
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | PAUSE Q:$E(IOST,1,2)'["C-"
|
|---|
| 74 | F IBJ=$Y:1:(IOSL-4) W !
|
|---|
| 75 | S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1 K DIRUT,DTOUT,DUOUT
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | END1 K IBFULL
|
|---|
| 79 | END W !
|
|---|
| 80 | ;***
|
|---|
| 81 | ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOLK" D T1^%ZOSV ;stop rt clock
|
|---|
| 82 | I $D(ZTQUEUED) S ZTREQ="@" Q
|
|---|
| 83 | K X,X2,X3,Y,DFN,IBIFN,IBAC,I,IB,IBIL,IBI,IBJ,IBNAME,IBLINE,IBN,IBND,IBND1,IBCHRG,IBSEQNO,IBTYP,IBTOTL,ZTSK,IBHDT,IBPAG,IBQUIT,DN,D0,DUOUT,DTOUT,VA,VADM,VAERR
|
|---|
| 84 | D ^%ZISC
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | ENF ; -entry point for AR to print full profile for IB actions for
|
|---|
| 88 | ; an ar transaction number.
|
|---|
| 89 | ; -input x = ar transaction number ($p(^ib(ibn,0),u,12)
|
|---|
| 90 | ;
|
|---|
| 91 | S IBFULL=1
|
|---|
| 92 | ;
|
|---|
| 93 | ENB ; -entry point for AR to print brief profile for IB actions for
|
|---|
| 94 | ; an ar transaction number.
|
|---|
| 95 | ; -input x = ar transaction number
|
|---|
| 96 | ;
|
|---|
| 97 | S IBTOTL=0,IBPAG=0,IBQUIT="" S:'$D(IBFULL) IBFULL=0
|
|---|
| 98 | S IBTRAN=X
|
|---|
| 99 | S IBN="" F S IBN=$O(^IB("AT",IBTRAN,IBN)) Q:IBN="" D LINE
|
|---|
| 100 | K D0,DN,X,X2,X3,Y,IBFULL,IBTOTL,IBPAG,IBQUIT,IBTRAN,IBN,IBND,IBND1,IBSEQNO,IBTYP,IBCHRG
|
|---|
| 101 | Q
|
|---|
