IBOHRAR ;ALB/EMG-RELEASED CHARGES REPORT;APR 11 1997
;;2.0;INTEGRATED BILLING;**70,95,215,347**;21-MAR-94;Build 24
;
EN ; - Option entry point.
N X,Y,ZTIO
S (IBCRT,IBQUIT)=0,IBLINE="",$P(IBLINE,"-",IOM)=""
D NOW^%DTC S Y=X X ^DD("DD") S IBNOW=Y D HOME^%ZIS
W @IOF,!,"List of On Hold/Hold-Review Charges Released to AR"
W !!?5,"This report will list all charges that were previously on"
W !?5,"ON HOLD or HOLD-REVIEW status and currently have a status"
W !?5,"of BILLED and the DATE LAST UPDATED is within the date range"
W !?5,"you specify."
;
SELECT W !!,"Print former (O)N HOLD charges,"
R !?13,"(H)OLD-REVIEW charges, or (B)OTH: BOTH// ",X:DTIME
G:'$T!(X["^") END S:X="" X="B" S X=$E(X)
I "BHObho"'[X D HELP G SELECT
W " ",$S("Hh"[X:"HOLD-REVIEW","Oo"[X:"ON HOLD",1:"BOTH")
S IBSEL=$S("Hh"[X:"H","Oo"[X:"O",1:"HO")
;
RANGE S DIR(0)="DA^:NOW:EX",DIR("A")="Start with DATE: "
S DIR("?")="Enter the starting date for this report."
W ! D ^DIR K DIR G:$D(DIRUT) END S IBSDT=+Y
S DIR(0)="DA^+Y:NOW:EX",DIR("A")=" Go to DATE: "
S DIR("?")="Enter the ending date for this report."
D ^DIR K DIR G:$D(DIRUT) END S IBEDT=+Y
;
QUEUED ; - Entry point if queued.
K ^TMP($J)
I '$G(IBQUIT) D DEVICE
I '$G(IBQUIT) D CHRGS,PRINT
;
END D ^%ZISC
K DFN,DIRUT,DUOUT,I,IBACT,IBATYPE,IBBILL,IBCHG,IBCNT,IBCRT,IBDT,IBFR
K IBGBL,IBHDR,IBHR,IBLINE,IBN,IBNAME,IBND,IBND1,IBNOW,IBOH,IBPAGE,IBQUIT
K IBRDT,IBRF,IBRX,IBRXN,IBSEL,IBSDT,IBSSN,IBTO,IBTYPE,POP,VA,X,^TMP($J)
Q
;
DEVICE I $D(ZTQUEUED) Q
W !!,"*** This output should be queued ***"
S %ZIS="QM" D ^%ZIS I POP S IBQUIT=1 Q
I $D(IO("Q")) D Q
.S ZTRTN="QUEUED^IBOHRAR",ZTIO=ION,ZTDESC="CHARGES RELEASED TO AR"
.S ZTSAVE("IB*")="" D ^%ZTLOAD
.W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
.D HOME^%ZIS K ZTSK S IBQUIT=1
;
U IO
Q
;
CHRGS ; - Indexes charges released to AR within date range.
S IBSDT=IBSDT+.000001,IBEDT=IBEDT+.24 Q:IBQUIT
I $E(IOST,1,2)="C-" S IBCRT=1
S IBN=0 F S IBN=$O(^IB("AC",3,IBN)) Q:'IBN D
.S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1)) Q:'IBND!('IBND1)
.S IBOH=$P(IBND1,U,6),IBHR=$P(IBND1,U,7)
.I IBOH,IBSEL["O" S IBGBL="IBOH" D CHRGS1 Q
.I IBHR,IBSEL["H" S IBGBL="IBHR" D CHRGS1
;
Q
;
CHRGS1 ; - Set global for report.
S IBDT=$P(IBND1,U,4) Q:'IBDT!(IBDT<IBSDT)!(IBDT>IBEDT)
S DFN=$P(IBND,U,2) Q:'DFN
D PAT S ^TMP($J,IBGBL,IBNAME,DFN,IBN)=""
Q
;
PRINT ; - Print charges released to AR.
N IENS Q:IBQUIT
I IBCRT=1 W @IOF
S IBGBL="" F S IBGBL=$O(^TMP($J,IBGBL)) Q:IBGBL="" D Q:IBQUIT
.S (IBCNT,IBPAGE)=0 D HEADER Q:IBQUIT
.S IBNAME="" F S IBNAME=$O(^TMP($J,IBGBL,IBNAME)) Q:IBNAME="" S (DFN,IBFL)=0 F S DFN=$O(^TMP($J,IBGBL,IBNAME,DFN)) Q:'DFN D Q:IBQUIT
..D PRNTPAT Q:IBQUIT
..S IBN=0 F S IBN=$O(^TMP($J,IBGBL,IBNAME,DFN,IBN)) Q:IBN="" D
...S IBND=$G(^IB(IBN,0)),IBND1=$G(^IB(IBN,1))
...S (IBRX,IBRXN,IBRF,IBRDT)=0,IBACT=+IBND
...S IBTYPE=$P(IBND,U,3),IBTYPE=$P($G(^IBE(350.1,IBTYPE,0)),U)
...S IBTYPE=$S(IBTYPE["PSO NSC":"RXNSC",IBTYPE["PSO SC":"RX SC",1:$E(IBTYPE,4,7))
...S IBBILL=$P($P(IBND,U,11),"-",2)
...I $P(IBND,U,4)["52:" S IBRXN=$P($P(IBND,U,4),":",2),IBRX=$P($P(IBND,U,8),"-"),IBRF=$P($P(IBND,U,4),":",3)
...I IBRF>0 S IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
...E S IBRDT=$$FILE^IBRXUTL(IBRXN,22)
...S IBFR=$$DAT1^IBOUTL($S(IBRXN>0:IBRDT,1:$P(IBND,U,14)))
...S IBTO=$$DAT1^IBOUTL($S($P(IBND,U,15)'="":$P(IBND,U,15),1:$P(IBND1,U,2)))
...S IBCHG=$J(+$P(IBND,U,7),9,2)
...I IBQUIT Q
...W ?27,IBACT,?37,IBBILL,?46,IBTYPE W:IBRX>0 ?52,"Rx #: "_IBRX_$S(IBRF>0:"("_IBRF_")",1:""),!
...W ?52,IBFR,?62,IBTO,?70,IBCHG,!
...S IBCNT=IBCNT+1
...I ($Y+4)>IOSL,$O(^TMP($J,IBGBL,IBNAME,DFN,IBN)) D PRNTPAT
.;
.I IBCNT=0 W !?10,"No charges were released in this time period.",!!
;
Q
;
PAT ; - Print patient data during processing.
N VADM,VAERR D DEM^VADPT K:VAERR VADM
S IBNAME=$G(VADM(1)) S:IBNAME="" IBNAME=""
Q
;
PRNTPAT ; - Print patient data on report.
N VADM,VAERR
D DEM^VADPT S IBSSN=$S('VAERR:VA("BID"),1:"")
I ($Y+4)>IOSL D HEADER Q:IBQUIT
W $E(IBNAME,1,20),?21,IBSSN
Q
;
I IBQUIT Q
I IBCRT,$Y>1 D PAUSE Q:IBQUIT
S IBHDR=$S(IBGBL="IBHR":"HOLD-REVIEW",1:"ON HOLD"),IBPAGE=IBPAGE+1
W !,@IOF
W "List of ",IBHDR," charges released to AR from ",$P($$DAT2^IBOUTL(IBSDT),"@")," to ",$P($$DAT2^IBOUTL(IBEDT),"@")
W !,"Date Printed: ",IBNOW,?72,"Page ",IBPAGE,!,IBLINE
W !,"Name",?20,"Pt.ID",?27,"Act.ID",?37,"Bill #",?46,"Type",?52,"Fr/Fl Dt",?62,"To/Rls Dt",?73,"Charge"
W !,IBLINE,!
Q
;
PAUSE ; - Pause for screen output.
I $E(IOST,1,2)'="C-" Q
F I=$Y:1:(IOSL-5) W !
S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBQUIT=1
Q
;
HELP ; - 'Print former (O)N HOLD...' prompt help text.
W !!?5,"Enter: '<CR>' - To select both On Hold and Hold-Review charges"
W !?15,"'O' - To select only On Hold charges"
W !?15,"'H' - To select only Hold-Review charges"
W !?15,"'^' - To quit this option",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHRAR 5056 printed Dec 13, 2024@02:25:44 Page 2
IBOHRAR ;ALB/EMG-RELEASED CHARGES REPORT;APR 11 1997
+1 ;;2.0;INTEGRATED BILLING;**70,95,215,347**;21-MAR-94;Build 24
+2 ;
EN ; - Option entry point.
+1 NEW X,Y,ZTIO
+2 SET (IBCRT,IBQUIT)=0
SET IBLINE=""
SET $PIECE(IBLINE,"-",IOM)=""
+3 DO NOW^%DTC
SET Y=X
XECUTE ^DD("DD")
SET IBNOW=Y
DO HOME^%ZIS
+4 WRITE @IOF,!,"List of On Hold/Hold-Review Charges Released to AR"
+5 WRITE !!?5,"This report will list all charges that were previously on"
+6 WRITE !?5,"ON HOLD or HOLD-REVIEW status and currently have a status"
+7 WRITE !?5,"of BILLED and the DATE LAST UPDATED is within the date range"
+8 WRITE !?5,"you specify."
+9 ;
SELECT WRITE !!,"Print former (O)N HOLD charges,"
+1 READ !?13,"(H)OLD-REVIEW charges, or (B)OTH: BOTH// ",X:DTIME
+2 if '$TEST!(X["^")
GOTO END
if X=""
SET X="B"
SET X=$EXTRACT(X)
+3 IF "BHObho"'[X
DO HELP
GOTO SELECT
+4 WRITE " ",$SELECT("Hh"[X:"HOLD-REVIEW","Oo"[X:"ON HOLD",1:"BOTH")
+5 SET IBSEL=$SELECT("Hh"[X:"H","Oo"[X:"O",1:"HO")
+6 ;
RANGE SET DIR(0)="DA^:NOW:EX"
SET DIR("A")="Start with DATE: "
+1 SET DIR("?")="Enter the starting date for this report."
+2 WRITE !
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET IBSDT=+Y
+3 SET DIR(0)="DA^+Y:NOW:EX"
SET DIR("A")=" Go to DATE: "
+4 SET DIR("?")="Enter the ending date for this report."
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO END
SET IBEDT=+Y
+6 ;
QUEUED ; - Entry point if queued.
+1 KILL ^TMP($JOB)
+2 IF '$GET(IBQUIT)
DO DEVICE
+3 IF '$GET(IBQUIT)
DO CHRGS
DO PRINT
+4 ;
END DO ^%ZISC
+1 KILL DFN,DIRUT,DUOUT,I,IBACT,IBATYPE,IBBILL,IBCHG,IBCNT,IBCRT,IBDT,IBFR
+2 KILL IBGBL,IBHDR,IBHR,IBLINE,IBN,IBNAME,IBND,IBND1,IBNOW,IBOH,IBPAGE,IBQUIT
+3 KILL IBRDT,IBRF,IBRX,IBRXN,IBSEL,IBSDT,IBSSN,IBTO,IBTYPE,POP,VA,X,^TMP($JOB)
+4 QUIT
+5 ;
DEVICE IF $DATA(ZTQUEUED)
QUIT
+1 WRITE !!,"*** This output should be queued ***"
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
SET IBQUIT=1
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="QUEUED^IBOHRAR"
SET ZTIO=ION
SET ZTDESC="CHARGES RELEASED TO AR"
+5 SET ZTSAVE("IB*")=""
DO ^%ZTLOAD
+6 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+7 DO HOME^%ZIS
KILL ZTSK
SET IBQUIT=1
End DoDot:1
QUIT
+8 ;
+9 USE IO
+10 QUIT
+11 ;
CHRGS ; - Indexes charges released to AR within date range.
+1 SET IBSDT=IBSDT+.000001
SET IBEDT=IBEDT+.24
if IBQUIT
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"
SET IBCRT=1
+3 SET IBN=0
FOR
SET IBN=$ORDER(^IB("AC",3,IBN))
if 'IBN
QUIT
Begin DoDot:1
+4 SET IBND=$GET(^IB(IBN,0))
SET IBND1=$GET(^IB(IBN,1))
if 'IBND!('IBND1)
QUIT
+5 SET IBOH=$PIECE(IBND1,U,6)
SET IBHR=$PIECE(IBND1,U,7)
+6 IF IBOH
IF IBSEL["O"
SET IBGBL="IBOH"
DO CHRGS1
QUIT
+7 IF IBHR
IF IBSEL["H"
SET IBGBL="IBHR"
DO CHRGS1
End DoDot:1
+8 ;
+9 QUIT
+10 ;
CHRGS1 ; - Set global for report.
+1 SET IBDT=$PIECE(IBND1,U,4)
if 'IBDT!(IBDT<IBSDT)!(IBDT>IBEDT)
QUIT
+2 SET DFN=$PIECE(IBND,U,2)
if 'DFN
QUIT
+3 DO PAT
SET ^TMP($JOB,IBGBL,IBNAME,DFN,IBN)=""
+4 QUIT
+5 ;
PRINT ; - Print charges released to AR.
+1 NEW IENS
if IBQUIT
QUIT
+2 IF IBCRT=1
WRITE @IOF
+3 SET IBGBL=""
FOR
SET IBGBL=$ORDER(^TMP($JOB,IBGBL))
if IBGBL=""
QUIT
Begin DoDot:1
+4 SET (IBCNT,IBPAGE)=0
DO HEADER
if IBQUIT
QUIT
+5 SET IBNAME=""
FOR
SET IBNAME=$ORDER(^TMP($JOB,IBGBL,IBNAME))
if IBNAME=""
QUIT
SET (DFN,IBFL)=0
FOR
SET DFN=$ORDER(^TMP($JOB,IBGBL,IBNAME,DFN))
if 'DFN
QUIT
Begin DoDot:2
+6 DO PRNTPAT
if IBQUIT
QUIT
+7 SET IBN=0
FOR
SET IBN=$ORDER(^TMP($JOB,IBGBL,IBNAME,DFN,IBN))
if IBN=""
QUIT
Begin DoDot:3
+8 SET IBND=$GET(^IB(IBN,0))
SET IBND1=$GET(^IB(IBN,1))
+9 SET (IBRX,IBRXN,IBRF,IBRDT)=0
SET IBACT=+IBND
+10 SET IBTYPE=$PIECE(IBND,U,3)
SET IBTYPE=$PIECE($GET(^IBE(350.1,IBTYPE,0)),U)
+11 SET IBTYPE=$SELECT(IBTYPE["PSO NSC":"RXNSC",IBTYPE["PSO SC":"RX SC",1:$EXTRACT(IBTYPE,4,7))
+12 SET IBBILL=$PIECE($PIECE(IBND,U,11),"-",2)
+13 IF $PIECE(IBND,U,4)["52:"
SET IBRXN=$PIECE($PIECE(IBND,U,4),":",2)
SET IBRX=$PIECE($PIECE(IBND,U,8),"-")
SET IBRF=$PIECE($PIECE(IBND,U,4),":",3)
+14 IF IBRF>0
SET IBRDT=$$SUBFILE^IBRXUTL(+IBRXN,IBRF,52,.01)
+15 IF '$TEST
SET IBRDT=$$FILE^IBRXUTL(IBRXN,22)
+16 SET IBFR=$$DAT1^IBOUTL($SELECT(IBRXN>0:IBRDT,1:$PIECE(IBND,U,14)))
+17 SET IBTO=$$DAT1^IBOUTL($SELECT($PIECE(IBND,U,15)'="":$PIECE(IBND,U,15),1:$PIECE(IBND1,U,2)))
+18 SET IBCHG=$JUSTIFY(+$PIECE(IBND,U,7),9,2)
+19 IF IBQUIT
QUIT
+20 WRITE ?27,IBACT,?37,IBBILL,?46,IBTYPE
if IBRX>0
WRITE ?52,"Rx #: "_IBRX_$SELECT(IBRF>0:"("_IBRF_")",1:""),!
+21 WRITE ?52,IBFR,?62,IBTO,?70,IBCHG,!
+22 SET IBCNT=IBCNT+1
+23 IF ($Y+4)>IOSL
IF $ORDER(^TMP($JOB,IBGBL,IBNAME,DFN,IBN))
DO PRNTPAT
End DoDot:3
End DoDot:2
if IBQUIT
QUIT
+24 ;
+25 IF IBCNT=0
WRITE !?10,"No charges were released in this time period.",!!
End DoDot:1
if IBQUIT
QUIT
+26 ;
+27 QUIT
+28 ;
PAT ; - Print patient data during processing.
+1 NEW VADM,VAERR
DO DEM^VADPT
if VAERR
KILL VADM
+2 SET IBNAME=$GET(VADM(1))
if IBNAME=""
SET IBNAME=""
+3 QUIT
+4 ;
PRNTPAT ; - Print patient data on report.
+1 NEW VADM,VAERR
+2 DO DEM^VADPT
SET IBSSN=$SELECT('VAERR:VA("BID"),1:"")
+3 IF ($Y+4)>IOSL
DO HEADER
if IBQUIT
QUIT
+4 WRITE $EXTRACT(IBNAME,1,20),?21,IBSSN
+5 QUIT
+6 ;
+1 IF IBQUIT
QUIT
+2 IF IBCRT
IF $Y>1
DO PAUSE
if IBQUIT
QUIT
+3 SET IBHDR=$SELECT(IBGBL="IBHR":"HOLD-REVIEW",1:"ON HOLD")
SET IBPAGE=IBPAGE+1
+4 WRITE !,@IOF
+5 WRITE "List of ",IBHDR," charges released to AR from ",$PIECE($$DAT2^IBOUTL(IBSDT),"@")," to ",$PIECE($$DAT2^IBOUTL(IBEDT),"@")
+6 WRITE !,"Date Printed: ",IBNOW,?72,"Page ",IBPAGE,!,IBLINE
+7 WRITE !,"Name",?20,"Pt.ID",?27,"Act.ID",?37,"Bill #",?46,"Type",?52,"Fr/Fl Dt",?62,"To/Rls Dt",?73,"Charge"
+8 WRITE !,IBLINE,!
+9 QUIT
+10 ;
PAUSE ; - Pause for screen output.
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 FOR I=$Y:1:(IOSL-5)
WRITE !
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBQUIT=1
+4 QUIT
+5 ;
HELP ; - 'Print former (O)N HOLD...' prompt help text.
+1 WRITE !!?5,"Enter: '<CR>' - To select both On Hold and Hold-Review charges"
+2 WRITE !?15,"'O' - To select only On Hold charges"
+3 WRITE !?15,"'H' - To select only Hold-Review charges"
+4 WRITE !?15,"'^' - To quit this option",!
+5 QUIT
