source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOA31.m@ 677

Last change on this file since 677 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.4 KB
Line 
1IBOA31 ;ALB/AAS - PRINT ALL BILLS FOR A PATIENT ; 04/18/90
2 ;;2.0; INTEGRATED BILLING ;**95,199**; 21-MAR-94
3 ;
4 ;MAP TO DGCRA31
5EN ;
6 ;***
7 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
8 ;S XRTL=$ZU(0),XRTN="IBOA31-1" D T0^%ZOSV ;start rt clock
9 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
10 S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC Q:Y<1 S DFN=+Y
11 S DIR(0)="Y",DIR("A")="Include Pharmacy Co-Pay charges on this report",DIR("B")="NO"
12 S DIR("?",1)=" Enter: 'Y' - To include Pharmacy Co-pay charges on this report"
13 S DIR("?",2)=" 'N' - To exclude Pharmacy Co-pay charges on this report"
14 S DIR("?")=" '^' - To select a new patient"
15 D ^DIR K DIR G:$D(DIRUT) END S IBIBRX=Y
16 W !,"You will need a 132 column printer for this report."
17 S %ZIS="QM" D ^%ZIS G:POP ENQ
18 I $D(IO("Q")) K IO("Q") D G ENQ
19 .S ZTDESC="IB - PRINT ALL BILLS FOR A PATIENT",ZTRTN="DQ^IBOA31",ZTSAVE("DFN")="",ZTSAVE("IB*")=""
20 .D ^%ZTLOAD K ZTSK D HOME^%ZIS
21 ;
22 ;***
23 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
24DQ ;
25 ;***
26 ;S XRTL=$ZU(0),XRTN="IBOA31-2" D T0^%ZOSV ;start rt clock
27 U IO S IBPAG=0 D NOW^%DTC S Y=% X ^DD("DD") S IBNOW=Y,$P(IBLINE,"-",IOM+1)=""
28 S IBQUIT=0,IBN=$$PT^IBEFUNC(DFN) D UTIL^IBCA3,UTIL^IBOA32
29 I '$D(^UTILITY($J)) W !,"No Bills On File for ",$P(IBN,"^")," SSN: ",$P(IBN,"^",2),"." G ENQ
30 D HDR1 S (IBDT,IBIFN)=""
31 ; - loop through all bills
32 F S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT) D
33 . F S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT) D @($S($E(IBIFN,$L(IBIFN))="X":"^IBOA32",1:"ONE"))
34 D:'IBQUIT PAUSE
35ENQ W ! G END
36 ;
37ONE D GVAR^IBCBB
38 D:($Y>(IOSL-5)) HDR Q:IBQUIT
39 W !,IBBNO,?8,$$DAT1^IBOUTL($P(IBNDS,"^",12)),?18,$P($G(^DGCR(399.3,+IBAT,0)),"^")
40 W ?37,$S(IBCL=1:"INPATIENT",IBCL=2:"HUMANIT. (INPT)",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANIT. (OPT)",1:""),?54
41 F I=$S(IBCL<3!('$O(^DGCR(399,IBIFN,"OP",0))):IBEVDT,1:$O(^DGCR(399,IBIFN,"OP",0))),IBFDT,IBTDT W $S(I]"":$$DAT1^IBOUTL(I)_" ",1:" ")
42 S X=+$$TPR^PRCAFN(IBIFN) W $J($S(X<0:0,1:X),8,2)
43 W ?94,$S(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
44 W ?112,$P("NON-PAYMENT/ZERO^ADMIT - DISCHARGE^INTERIM - FIRST^INTERIM - CONTINUING^INTERIM - LAST^LATE CHARGE(S) ONLY^ADJUSTMENT OF PRIOR^REPLACEMENT OF PRIOR","^",(IBTF+1))
45 ; - print remaining outpatient visit dates
46 S IBOPD=$O(^DGCR(399,IBIFN,"OP",0)) Q:'IBOPD
47 F S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD D Q:IBQUIT
48 . D:($Y>(IOSL-5)) HDR Q:IBQUIT W !?54,$$DAT1^IBOUTL(IBOPD)
49 Q
50 ;
51HDR I $E(IOST,1,2)["C-" D PAUSE Q:IBQUIT
52HDR1 S IBPAG=IBPAG+1 W:$E(IOST,1,2)["C-"!(IBPAG>1) @IOF
53 W "List of all Bills for ",$P(IBN,"^")," SSN: ",$P(IBN,"^",2)," ",?(IOM-31),IBNOW," PAGE ",IBPAG
54 W !,"BILL",?10,"DATE",?54,"DATE OF",?63,"STATEMENT STATEMENT AMOUNT"
55 W !,"NO. PRINTED ACTION/RATE TYPE CLASSIFICATION CARE "
56 W $S(IBIBRX=1:"FR/FL DT TO/RL DT",1:"FROM DATE TO DATE")
57 W " COLLECTED STATUS TIMEFRAME OF BILL"
58 W !,IBLINE
59 W:IBIBRX !,?52,"'*' = outpt visit on same day as Rx fill date",!,IBLINE
60 Q
61 ;
62PAUSE S IBX1="" R:$E(IOST,1,2)["C-" !!!,"Enter ""^"" to quit, or return to continue",IBX1:DTIME S IBQUIT=$S(IBX1["^":1,1:0) Q
63 ;
64END K ^UTILITY($J)
65 ;***
66 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
67 I $D(ZTQUEUED) S ZTREQ="@" Q
68 D END^IBCBB1
69 K IBIFN1,IBQUIT,IBX1,IBDT,IBCNT,IBN,DFN,IBIFN,IBLINE,IBNOW,IBPAG,IBOPD,IBIBRX,DIRUT,DUOUT,DTOUT,X,Y
70 K IBRDT,IBRF,IBRX
71 D ^%ZISC G EN
Note: See TracBrowser for help on using the repository browser.