- IBOBL ;ALB/AAS - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- ;MAP TO DGCROBL
- ;
- % S U="^"
- ;
- ASK ;
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
- ;S XRTL=$ZU(0),XRTN="IBOBL-1" D T0^%ZOSV ;start rt clock
- ;
- S DIC="^DGCR(399,",DIC(0)="AEMQZ" D ^DIC K DIC Q:Y<1 S DGIFN=+Y,DGIFN1=$P(Y(0),"^",17),DFN=$P(Y(0),"^",2),DGEVDT=$P(Y(0),"^",3) G:+DGIFN1<1 END
- ;
- DEV ; -- ask device
- S %ZIS="QM" D ^%ZIS G:POP END
- I $D(IO("Q")) K IO("Q") D G END
- .S ZTRTN="START^IBOBL",ZTSAVE("DFN")="",ZTSAVE("DG*")="",ZTDESC="IB - List all Bills for an Episode"
- .D ^%ZTLOAD K ZTSK D HOME^%ZIS
- ;
- U IO
- ;
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
- START ;entry from DQing
- ;***
- ;S XRTL=$ZU(0),XRTN="IBOBL-2" D T0^%ZOSV ;start rt clock
- S Y=DGEVDT X ^DD("DD") S DGEVDT=Y,IBQUIT=0,DGLINE="",$P(DGLINE,"-",IOM)="",DGPAG=0 S X="NOW",%DT="T" D ^%DT X ^DD("DD") S DGDATE=Y D HDR1
- ;
- LOOP S IBIFN=""
- F I=0:0 S IBIFN=$O(^DGCR(399,"AC",DGIFN1,IBIFN)) Q:'IBIFN!(IBQUIT) D ONE I $D(^DGCR(399,"AC",IBIFN)),IBIFN'=DGIFN1 D LOOP2
- D PAUSE:'IBQUIT G END
- ;
- ;print bills who's primary bill field point to secondary bill for this episode
- LOOP2 S IBIFN2=IBIFN,IBIFN="",DGIFN2=DGIFN1,DGIFN1=IBIFN2
- F J=0:0 S IBIFN=$O(^DGCR(399,"AC",DGIFN1,IBIFN)) Q:'IBIFN!(IBQUIT) D ONE
- S DGIFN=DGIFN2,IBIFN=IBIFN2
- Q
- ONE D GVAR^IBCBB
- D:($Y>(IOSL-5)) HDR Q:IBQUIT
- W !,IBBNO,?12,$S(IBAT']"":"",$D(^DGCR(399.3,IBAT,0)):$P(^(0),"^"),1:"")
- W ?34,$S(IBCL=1:"INPATIENT",IBCL=2:"HUMANITARIAN (INPT.).",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANITARIAN (OPT.)",1:""),?57
- F I=IBEVDT,IBFDT,IBTDT W $E(I,4,5)_"/"_$E(I,6,7)_"/"_$E(I,2,3)," "
- W $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))
- W !?4,"PAYOR: ",$S(IBWHO="i":"Insurance Co.",IBWHO="p":"Patient",1:"Institution")," - "
- S DGPAYOR="UNKNOWN"
- I IBWHO="i",+IBNDM,$D(^DIC(36,+IBNDM,0)) S DGPAYOR=$P(^(0),"^")
- I IBWHO="o",$P(IBNDM,"^",11),$D(^DIC(11,$P(IBNDM,"^",11),0)) S DGPAYOR=$P(^(0),"^")
- I IBWHO="p",+DFN,$D(^DPT(DFN,0)) S DGPAYOR=$P(^(0),"^")
- W DGPAYOR K DGPAYOR
- Q
- ;
- HDR I $E(IOST,1,2)["C-" D PAUSE Q:IBQUIT
- HDR1 I $E(IOST,1,2)["C-"!(DGPAG) W @IOF
- S DGPAG=DGPAG+1 W "LIST OF ALL BILLS FOR AN EPISODE OF CARE",?(IOM-30),DGDATE," PAGE ",DGPAG
- W !,"FOR PATIENT: ",$P(^DPT(DFN,0),"^")," EVENT DATE: ",DGEVDT
- W !?68,"STATEMENT STATEMENT"
- W !,"BILL NO. RATE TYPE CLASSIFICATION EVENT DATE FROM DATE TO DATE STATUS TIMEFRAME OF BILL"
- W !,DGLINE
- Q
- PAUSE S IBX1="" R:$E(IOST,1,2)["C-" !,"Enter ""^"" to quit display, return to continue",IBX1:DTIME S IBQUIT=$S(IBX1["^":1,1:0) Q
- ;
- END ;
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
- I $D(ZTQUEUED) S ZTREQ="@" Q
- D END^IBCBB1
- K %DT,DGIFN,DGIFN1,IBIFN1,IBQUIT,IBX1,IBCNT,DFN,IBIFN,DGDATE,DGEVDT,DGLINE,DGPAG,^UTILITY($J)
- D ^%ZISC G ASK
- IBOBL ;ALB/AAS - LIST ALL BILLS FOR AN EPISODE OF CARE ; 25-MAY-90
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- +3 ;MAP TO DGCROBL
- +4 ;
- % SET U="^"
- +1 ;
- ASK ;
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
- +3 ;S XRTL=$ZU(0),XRTN="IBOBL-1" D T0^%ZOSV ;start rt clock
- +4 ;
- +5 SET DIC="^DGCR(399,"
- SET DIC(0)="AEMQZ"
- DO ^DIC
- KILL DIC
- IF Y<1
- QUIT
- SET DGIFN=+Y
- SET DGIFN1=$PIECE(Y(0),"^",17)
- SET DFN=$PIECE(Y(0),"^",2)
- SET DGEVDT=$PIECE(Y(0),"^",3)
- IF +DGIFN1<1
- GOTO END
- +6 ;
- DEV ; -- ask device
- +1 SET %ZIS="QM"
- DO ^%ZIS
- IF POP
- GOTO END
- +2 IF $DATA(IO("Q"))
- KILL IO("Q")
- Begin DoDot:1
- +3 SET ZTRTN="START^IBOBL"
- SET ZTSAVE("DFN")=""
- SET ZTSAVE("DG*")=""
- SET ZTDESC="IB - List all Bills for an Episode"
- +4 DO ^%ZTLOAD
- KILL ZTSK
- DO HOME^%ZIS
- End DoDot:1
- GOTO END
- +5 ;
- +6 USE IO
- +7 ;
- +8 ;***
- +9 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
- START ;entry from DQing
- +1 ;***
- +2 ;S XRTL=$ZU(0),XRTN="IBOBL-2" D T0^%ZOSV ;start rt clock
- +3 SET Y=DGEVDT
- XECUTE ^DD("DD")
- SET DGEVDT=Y
- SET IBQUIT=0
- SET DGLINE=""
- SET $PIECE(DGLINE,"-",IOM)=""
- SET DGPAG=0
- SET X="NOW"
- SET %DT="T"
- DO ^%DT
- XECUTE ^DD("DD")
- SET DGDATE=Y
- DO HDR1
- +4 ;
- LOOP SET IBIFN=""
- +1 FOR I=0:0
- SET IBIFN=$ORDER(^DGCR(399,"AC",DGIFN1,IBIFN))
- IF 'IBIFN!(IBQUIT)
- QUIT
- DO ONE
- IF $DATA(^DGCR(399,"AC",IBIFN))
- IF IBIFN'=DGIFN1
- DO LOOP2
- +2 IF 'IBQUIT
- DO PAUSE
- GOTO END
- +3 ;
- +4 ;print bills who's primary bill field point to secondary bill for this episode
- LOOP2 SET IBIFN2=IBIFN
- SET IBIFN=""
- SET DGIFN2=DGIFN1
- SET DGIFN1=IBIFN2
- +1 FOR J=0:0
- SET IBIFN=$ORDER(^DGCR(399,"AC",DGIFN1,IBIFN))
- IF 'IBIFN!(IBQUIT)
- QUIT
- DO ONE
- +2 SET DGIFN=DGIFN2
- SET IBIFN=IBIFN2
- +3 QUIT
- ONE DO GVAR^IBCBB
- +1 IF ($Y>(IOSL-5))
- DO HDR
- IF IBQUIT
- QUIT
- +2 WRITE !,IBBNO,?12,$SELECT(IBAT']"":"",$DATA(^DGCR(399.3,IBAT,0)):$PIECE(^(0),"^"),1:"")
- +3 WRITE ?34,$SELECT(IBCL=1:"INPATIENT",IBCL=2:"HUMANITARIAN (INPT.).",IBCL=3:"OUTPATIENT",IBCL=4:"HUMANITARIAN (OPT.)",1:""),?57
- +4 FOR I=IBEVDT,IBFDT,IBTDT
- WRITE $EXTRACT(I,4,5)_"/"_$EXTRACT(I,6,7)_"/"_$EXTRACT(I,2,3)," "
- +5 WRITE $SELECT(IBST=1:"ENTERED/NOT REV.",IBST=2:"REVIEWED",IBST=3:"AUTHORIZED",IBST=4:"PRINTED",IBST=7:"CANCELLED",1:"")
- +6 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))
- +7 WRITE !?4,"PAYOR: ",$SELECT(IBWHO="i":"Insurance Co.",IBWHO="p":"Patient",1:"Institution")," - "
- +8 SET DGPAYOR="UNKNOWN"
- +9 IF IBWHO="i"
- IF +IBNDM
- IF $DATA(^DIC(36,+IBNDM,0))
- SET DGPAYOR=$PIECE(^(0),"^")
- +10 IF IBWHO="o"
- IF $PIECE(IBNDM,"^",11)
- IF $DATA(^DIC(11,$PIECE(IBNDM,"^",11),0))
- SET DGPAYOR=$PIECE(^(0),"^")
- +11 IF IBWHO="p"
- IF +DFN
- IF $DATA(^DPT(DFN,0))
- SET DGPAYOR=$PIECE(^(0),"^")
- +12 WRITE DGPAYOR
- KILL DGPAYOR
- +13 QUIT
- +14 ;
- HDR IF $EXTRACT(IOST,1,2)["C-"
- DO PAUSE
- IF IBQUIT
- QUIT
- HDR1 IF $EXTRACT(IOST,1,2)["C-"!(DGPAG)
- WRITE @IOF
- +1 SET DGPAG=DGPAG+1
- WRITE "LIST OF ALL BILLS FOR AN EPISODE OF CARE",?(IOM-30),DGDATE," PAGE ",DGPAG
- +2 WRITE !,"FOR PATIENT: ",$PIECE(^DPT(DFN,0),"^")," EVENT DATE: ",DGEVDT
- +3 WRITE !?68,"STATEMENT STATEMENT"
- +4 WRITE !,"BILL NO. RATE TYPE CLASSIFICATION EVENT DATE FROM DATE TO DATE STATUS TIMEFRAME OF BILL"
- +5 WRITE !,DGLINE
- +6 QUIT
- PAUSE SET IBX1=""
- IF $EXTRACT(IOST,1,2)["C-"
- READ !,"Enter ""^"" to quit display, return to continue",IBX1:DTIME
- SET IBQUIT=$SELECT(IBX1["^":1,1:0)
- QUIT
- +1 ;
- END ;
- +1 ;***
- +2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBOBL" D T1^%ZOSV ;stop rt clock
- +3 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +4 DO END^IBCBB1
- +5 KILL %DT,DGIFN,DGIFN1,IBIFN1,IBQUIT,IBX1,IBCNT,DFN,IBIFN,DGDATE,DGEVDT,DGLINE,DGPAG,^UTILITY($JOB)
- +6 DO ^%ZISC
- GOTO ASK
