IBOA31 ;ALB/AAS - PRINT ALL BILLS FOR A PATIENT ; 04/18/90
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
;MAP TO DGCRA31
EN ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="IBOA31-1" D T0^%ZOSV ;start rt clock
S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC Q:Y<1 S DFN=+Y
S DIR(0)="Y",DIR("A")="Include Pharmacy Co-Pay charges on this report",DIR("B")="NO"
S DIR("?",1)=" Enter: 'Y' - To include Pharmacy Co-pay charges on this report"
S DIR("?",2)=" 'N' - To exclude Pharmacy Co-pay charges on this report"
S DIR("?")=" '^' - To select a new patient"
D ^DIR K DIR G:$D(DIRUT) END S IBIBRX=Y
W !,"You will need a 132 column printer for this report."
S %ZIS="QM" D ^%ZIS G:POP ENQ
I $D(IO("Q")) K IO("Q") D G ENQ
.S ZTDESC="IB - PRINT ALL BILLS FOR A PATIENT",ZTRTN="DQ^IBOA31",ZTSAVE("DFN")="",ZTSAVE("IB*")=""
.D ^%ZTLOAD K ZTSK D HOME^%ZIS
;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
DQ ;
;***
;S XRTL=$ZU(0),XRTN="IBOA31-2" D T0^%ZOSV ;start rt clock
U IO S IBPAG=0 D NOW^%DTC S Y=% X ^DD("DD") S IBNOW=Y,$P(IBLINE,"-",IOM+1)=""
S IBQUIT=0,IBN=$$PT^IBEFUNC(DFN) D UTIL^IBCA3,UTIL^IBOA32
I '$D(^UTILITY($J)) W !,"No Bills On File for ",$P(IBN,"^")," SSN: ",$P(IBN,"^",2),"." G ENQ
D HDR1 S (IBDT,IBIFN)=""
; - loop through all bills
F S IBDT=$O(^UTILITY($J,IBDT)) Q:IBDT=""!(IBQUIT) D
. F S IBIFN=$O(^UTILITY($J,IBDT,IBIFN)) Q:IBIFN=""!(IBQUIT) D @($S($E(IBIFN,$L(IBIFN))="X":"^IBOA32",1:"ONE"))
D:'IBQUIT PAUSE
ENQ W ! G END
;
ONE D GVAR^IBCBB
D:($Y>(IOSL-5)) HDR Q:IBQUIT
W !,IBBNO,?8,$$DAT1^IBOUTL($P(IBNDS,"^",12)),?18,$P($G(^DGCR(399.3,+IBAT,0)),"^")
W ?37,$S(IBCL=1:"INPATIENT",IBCL=2:"HUMANIT. (INPT)",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANIT. (OPT)",1:""),?54
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:" ")
S X=+$$TPR^PRCAFN(IBIFN) W $J($S(X<0:0,1:X),8,2)
W ?94,$S(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
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))
; - print remaining outpatient visit dates
S IBOPD=$O(^DGCR(399,IBIFN,"OP",0)) Q:'IBOPD
F S IBOPD=$O(^DGCR(399,IBIFN,"OP",IBOPD)) Q:'IBOPD D Q:IBQUIT
. D:($Y>(IOSL-5)) HDR Q:IBQUIT W !?54,$$DAT1^IBOUTL(IBOPD)
Q
;
HDR I $E(IOST,1,2)["C-" D PAUSE Q:IBQUIT
HDR1 S IBPAG=IBPAG+1 W:$E(IOST,1,2)["C-"!(IBPAG>1) @IOF
W "List of all Bills for ",$P(IBN,"^")," SSN: ",$P(IBN,"^",2)," ",?(IOM-31),IBNOW," PAGE ",IBPAG
W !,"BILL",?10,"DATE",?54,"DATE OF",?63,"STATEMENT STATEMENT AMOUNT"
W !,"NO. PRINTED ACTION/RATE TYPE CLASSIFICATION CARE FROM DATE TO DATE COLLECTED STATUS TIMEFRAME OF BILL"
W !,IBLINE
Q
;
PAUSE 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
;
END K ^UTILITY($J)
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
I $D(ZTQUEUED) S ZTREQ="@" Q
D END^IBCBB1
K IBIFN1,IBQUIT,IBX1,IBDT,IBCNT,IBN,DFN,IBIFN,IBLINE,IBNOW,IBPAG,IBOPD,IBIBRX,DIRUT,DUOUT,DTOUT,X,Y
D ^%ZISC G EN
IBOA31 ;ALB/AAS - PRINT ALL BILLS FOR A PATIENT ; 04/18/90
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ;MAP TO DGCRA31
EN ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="IBOA31-1" D T0^%ZOSV ;start rt clock
+4 SET DIC="^DPT("
SET DIC(0)="AEQMN"
DO ^DIC
KILL DIC
IF Y<1
QUIT
SET DFN=+Y
+5 SET DIR(0)="Y"
SET DIR("A")="Include Pharmacy Co-Pay charges on this report"
SET DIR("B")="NO"
+6 SET DIR("?",1)=" Enter: 'Y' - To include Pharmacy Co-pay charges on this report"
+7 SET DIR("?",2)=" 'N' - To exclude Pharmacy Co-pay charges on this report"
+8 SET DIR("?")=" '^' - To select a new patient"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
GOTO END
SET IBIBRX=Y
+10 WRITE !,"You will need a 132 column printer for this report."
+11 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO ENQ
+12 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+13 SET ZTDESC="IB - PRINT ALL BILLS FOR A PATIENT"
SET ZTRTN="DQ^IBOA31"
SET ZTSAVE("DFN")=""
SET ZTSAVE("IB*")=""
+14 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+15 ;
+16 ;***
+17 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
DQ ;
+1 ;***
+2 ;S XRTL=$ZU(0),XRTN="IBOA31-2" D T0^%ZOSV ;start rt clock
+3 USE IO
SET IBPAG=0
DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET IBNOW=Y
SET $PIECE(IBLINE,"-",IOM+1)=""
+4 SET IBQUIT=0
SET IBN=$$PT^IBEFUNC(DFN)
DO UTIL^IBCA3
DO UTIL^IBOA32
+5 IF '$DATA(^UTILITY($JOB))
WRITE !,"No Bills On File for ",$PIECE(IBN,"^")," SSN: ",$PIECE(IBN,"^",2),"."
GOTO ENQ
+6 DO HDR1
SET (IBDT,IBIFN)=""
+7 ; - loop through all bills
+8 FOR
SET IBDT=$ORDER(^UTILITY($JOB,IBDT))
IF IBDT=""!(IBQUIT)
QUIT
Begin DoDot:1
+9 FOR
SET IBIFN=$ORDER(^UTILITY($JOB,IBDT,IBIFN))
IF IBIFN=""!(IBQUIT)
QUIT
DO @($SELECT($EXTRACT(IBIFN,$LENGTH(IBIFN))="X":"^IBOA32",1:"ONE"))
End DoDot:1
+10 IF 'IBQUIT
DO PAUSE
ENQ WRITE !
GOTO END
+1 ;
ONE DO GVAR^IBCBB
+1 IF ($Y>(IOSL-5))
DO HDR
IF IBQUIT
QUIT
+2 WRITE !,IBBNO,?8,$$DAT1^IBOUTL($PIECE(IBNDS,"^",12)),?18,$PIECE($GET(^DGCR(399.3,+IBAT,0)),"^")
+3 WRITE ?37,$SELECT(IBCL=1:"INPATIENT",IBCL=2:"HUMANIT. (INPT)",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANIT. (OPT)",1:""),?54
+4 FOR I=$SELECT(IBCL<3!('$ORDER(^DGCR(399,IBIFN,"OP",0))):IBEVDT,1:$ORDER(^DGCR(399,IBIFN,"OP",0))),IBFDT,IBTDT
WRITE $SELECT(I]"":$$DAT1^IBOUTL(I)_" ",1:" ")
+5 SET X=+$$TPR^PRCAFN(IBIFN)
WRITE $JUSTIFY($SELECT(X<0:0,1:X),8,2)
+6 WRITE ?94,$SELECT(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
+7 WRITE ?112,$PIECE("NON-PAYMENT/ZERO^ADMIT - DISCHARGE^INTERIM - FIRST^INTERIM - CONTINUING^INTERIM - LAST^LATE CHARGE(S) ONLY^ADJUSTMENT OF PRIOR^REPLACEMENT OF PRIOR","^",(IBTF+1))
+8 ; - print remaining outpatient visit dates
+9 SET IBOPD=$ORDER(^DGCR(399,IBIFN,"OP",0))
IF 'IBOPD
QUIT
+10 FOR
SET IBOPD=$ORDER(^DGCR(399,IBIFN,"OP",IBOPD))
IF 'IBOPD
QUIT
Begin DoDot:1
+11 IF ($Y>(IOSL-5))
DO HDR
IF IBQUIT
QUIT
WRITE !?54,$$DAT1^IBOUTL(IBOPD)
End DoDot:1
IF IBQUIT
QUIT
+12 QUIT
+13 ;
HDR IF $EXTRACT(IOST,1,2)["C-"
DO PAUSE
IF IBQUIT
QUIT
HDR1 SET IBPAG=IBPAG+1
IF $EXTRACT(IOST,1,2)["C-"!(IBPAG>1)
WRITE @IOF
+1 WRITE "List of all Bills for ",$PIECE(IBN,"^")," SSN: ",$PIECE(IBN,"^",2)," ",?(IOM-31),IBNOW," PAGE ",IBPAG
+2 WRITE !,"BILL",?10,"DATE",?54,"DATE OF",?63,"STATEMENT STATEMENT AMOUNT"
+3 WRITE !,"NO. PRINTED ACTION/RATE TYPE CLASSIFICATION CARE FROM DATE TO DATE COLLECTED STATUS TIMEFRAME OF BILL"
+4 WRITE !,IBLINE
+5 QUIT
+6 ;
PAUSE SET IBX1=""
IF $EXTRACT(IOST,1,2)["C-"
READ !!!,"Enter ""^"" to quit, or return to continue",IBX1:DTIME
SET IBQUIT=$SELECT(IBX1["^":1,1:0)
QUIT
+1 ;
END KILL ^UTILITY($JOB)
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOA31" D T1^%ZOSV ;stop rt clock
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+4 DO END^IBCBB1
+5 KILL IBIFN1,IBQUIT,IBX1,IBDT,IBCNT,IBN,DFN,IBIFN,IBLINE,IBNOW,IBPAG,IBOPD,IBIBRX,DIRUT,DUOUT,DTOUT,X,Y
+6 DO ^%ZISC
GOTO EN
