IBTOPW ;ALB/AAS - CLAIMS TRACKING PENDING REVIEWS REPORT ; 27-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
% I '$D(DT) D DT^DICRW
W !!,"Pending Reviews Report",!!!
;
SORT D SORT^IBTRPR0
;
REVS ; -- ask if hospital review, insurance reviews or both
N DIR W !
S DIR(0)="SOBA^H:HOSPITAL REVIEWS;I:INSURANCE REVIEWS;B:BOTH;"
S DIR("A")="Print [H]ospital Reviews [I]Insurance Reviews [B]oth: "
S DIR("B")="B"
S DIR("?",1)="Select if you would like to print pending Hospital Reviews, Insurance"
S DIR("?",2)="Reviews or both."
S DIR("?",3)=" ",DIR("?")="The default is both. This will print first the hospital reviews, then the insurance reviews."
D ^DIR K DIR
I "HIB"'[Y!($D(DIRUT)) G END
S IBTRPRF=$S(Y="B":12,Y="I":2,1:1)
;
S IBTWHO="A" I IBSORT="A" D WHOSE^IBTRPR0 G:$D(VALMQUIT) END
S IBTPRT="B",VAUTD=1 I IBSORT="T" D TYPE^IBTRPR0 G:$D(VALMQUIT) END
I IBSORT="T"!(IBSORT="W") W ! D PSDR^IBODIV G:Y<0 END
;
DATE ; -- select date
W !! D DATE^IBOUTL
I IBBDT=""!(IBEDT="") G END
S IBTPBDT=IBBDT,IBTPEDT=IBEDT
;
DEV ; -- select device, run option
W !!,"You will need a 132 column printer for this report!",!
S %ZIS="QM" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="DQ^IBTOPW",ZTSAVE("IB*")="",ZTSAVE("VAUTD")="",ZTSAVE("VAUTD(")="",ZTDESC="IB - Pending Reviews Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
;
D DQ G END
Q
;
END ; -- Clean up
W !
K ^TMP("IBSRT",$J),^TMP("IBSRT1",$J) W !
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K I,J,X,Y,DFN,DUOUT,DIRUT,%ZIS,VA,VAERR,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBTRPRF,IBTSORT,IBTOPW,IBTWHO,IBTPRT,IBDIV
K ENTRY,FILE,IBDATE,IBJ,IBNEXT,IBREV,IBSTATUS,IBTPEDT,IBTPBDT,IBTRC,IBTRV,TYPE,IBASSIGN,IBCNT,IBDATA,IBFLAG,IBK,IBL,IBSORT,IBWARD,IBEDT,IBBDT,IBDV,VAUTD
Q
;
DQ ; -- print one billing report from ct
; -- run the scheduled admissions list
;
S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
;
; -- put division in array by name
I '$D(VAUTD) S VAUTD=1
I VAUTD'=1 S I="" F S I=$O(VAUTD(I)) Q:'I S IBDIV(VAUTD(I))=I
;
; -- run the scheduled admissions list
D ^IBTRKR2 ;W:'$D(ZTQUEUED) !!,"Building your work list..."
U IO
D BLD
I IBCNT<1 D HDR W !!,"No Pending Reviews found."
I $D(ZTQUEUED) G END
Q
;
HDR ; -- Print header for billing report
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 W !!,"....task stoped at user request"
Q:IBQUIT
I $E(IOST,1,2)="C-",IBPAG D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
I $E(IOST,1,2)="C-"!(IBPAG) W @IOF
S IBPAG=IBPAG+1
W !,"Pending Reviews Report for Division ",$G(IBDV),?(IOM-33),"Page ",IBPAG," ",IBHDT
W !,"For Period ",$$FMTE^XLFDT(IBBDT)," to ",$$FMTE^XLFDT(IBEDT)
W !,"Patient",?23,"Pt. ID",?30,"Ward",?42,"Review Type",?65,"Due Date",?75,"Status",?85,"Assigned to",?105,"Visit",?115,"Date"
W !,$TR($J(" ",IOM)," ","-")
Q
;
BLD ; -- build list
; 1. build pending hospital reviews
; 2. build pending insurance reviews
;
K ^TMP("IBSRT",$J),^TMP("IBSRT1",$J)
N IBI,IBJ
S IBCNT=0,IBI="",IBTOPW=1
I '$G(IBTRPRF) S IBTRPRF=12
;
D STOP G BLDQ:IBQUIT D:IBTRPRF[1 1^IBTRPR01 S IBQUIT=0
;
D STOP G BLDQ:IBQUIT D:IBTRPRF[2 2^IBTRPR01 S IBQUIT=0
;
; -- go through sorted list
S IBDV="" F S IBDV=$O(^TMP("IBSRT",$J,IBDV)) Q:IBDV=""!(IBQUIT) D
.I 'VAUTD,'$D(IBDIV(IBDV)) Q
.D HDR
.S TYPE="" F S TYPE=$O(^TMP("IBSRT",$J,IBDV,TYPE)) Q:TYPE=""!(IBQUIT) D
..S IBI="" F S IBI=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI)) Q:IBI=""!(IBQUIT) S IBJ="" F S IBJ=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ)) Q:IBJ=""!(IBQUIT) D
...S IBK="" F S IBK=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK)) Q:IBK=""!(IBQUIT) S IBL="" F S IBL=$O(^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK,IBL)) Q:IBL=""!(IBQUIT) D ONE
;
BLDQ Q
;
ONE ; -- print one patients data
I ($Y+5)>IOSL D HDR Q:IBQUIT
S IBDATA=^TMP("IBSRT",$J,IBDV,TYPE,IBI,IBJ,IBK,IBL)
S IBTRN=+IBDATA,ENTRY=$P(IBDATA,"^",2)
S DFN=$P(IBDATA,"^",4)
S IBSTATUS=$P(IBDATA,"^",6),IBREV=$P(IBDATA,"^",7)
S IBASSIGN=$P(IBDATA,"^",9)
S IBFLAG=$O(^TMP("IBSRT1",$J,DFN,"")),IBFLAG=$O(^TMP("IBSRT1",$J,DFN,IBFLAG)) I IBFLAG'="" S IBFLAG="+"
S FILE=$P(IBDATA,"^",8)
D PID^VADPT
S IBCNT=IBCNT+1
W !,IBFLAG,$E($P(^DPT(DFN,0),"^"),1,20),?23,VA("BID"),?30,$E($G(^DPT(DFN,.1)),1,11)
W ?42,$E(TYPE,1,11),"-",$P($G(^IBE(356.11,+IBREV,0)),"^",3)
W ?65,$$DAT1^IBOUTL($P(IBDATA,"^",3)),?75,IBSTATUS,?85,$E(IBASSIGN,1,18)
W ?105,$P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),U,18),0)),U,2)
W ?115,$$DAT1^IBOUTL($P(^IBT(356,+IBTRN,0),U,6),"2P")
Q
;
STOP ; -- see if should stop
I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1,IBQUIT=1 D HDR W !!,"....task stoped at user request"
Q
IBTOPW ;ALB/AAS - CLAIMS TRACKING PENDING REVIEWS REPORT ; 27-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
+1 WRITE !!,"Pending Reviews Report",!!!
+2 ;
SORT DO SORT^IBTRPR0
+1 ;
REVS ; -- ask if hospital review, insurance reviews or both
+1 NEW DIR
WRITE !
+2 SET DIR(0)="SOBA^H:HOSPITAL REVIEWS;I:INSURANCE REVIEWS;B:BOTH;"
+3 SET DIR("A")="Print [H]ospital Reviews [I]Insurance Reviews [B]oth: "
+4 SET DIR("B")="B"
+5 SET DIR("?",1)="Select if you would like to print pending Hospital Reviews, Insurance"
+6 SET DIR("?",2)="Reviews or both."
+7 SET DIR("?",3)=" "
SET DIR("?")="The default is both. This will print first the hospital reviews, then the insurance reviews."
+8 DO ^DIR
KILL DIR
+9 IF "HIB"'[Y!($DATA(DIRUT))
GOTO END
+10 SET IBTRPRF=$SELECT(Y="B":12,Y="I":2,1:1)
+11 ;
+12 SET IBTWHO="A"
IF IBSORT="A"
DO WHOSE^IBTRPR0
IF $DATA(VALMQUIT)
GOTO END
+13 SET IBTPRT="B"
SET VAUTD=1
IF IBSORT="T"
DO TYPE^IBTRPR0
IF $DATA(VALMQUIT)
GOTO END
+14 IF IBSORT="T"!(IBSORT="W")
WRITE !
DO PSDR^IBODIV
IF Y<0
GOTO END
+15 ;
DATE ; -- select date
+1 WRITE !!
DO DATE^IBOUTL
+2 IF IBBDT=""!(IBEDT="")
GOTO END
+3 SET IBTPBDT=IBBDT
SET IBTPEDT=IBEDT
+4 ;
DEV ; -- select device, run option
+1 WRITE !!,"You will need a 132 column printer for this report!",!
+2 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO END
+3 IF $DATA(IO("Q"))
SET ZTRTN="DQ^IBTOPW"
SET ZTSAVE("IB*")=""
SET ZTSAVE("VAUTD")=""
SET ZTSAVE("VAUTD(")=""
SET ZTDESC="IB - Pending Reviews Report"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO END
+4 ;
+5 DO DQ
GOTO END
+6 QUIT
+7 ;
END ; -- Clean up
+1 WRITE !
+2 KILL ^TMP("IBSRT",$JOB),^TMP("IBSRT1",$JOB)
WRITE !
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+4 DO ^%ZISC
+5 KILL I,J,X,Y,DFN,DUOUT,DIRUT,%ZIS,VA,VAERR,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBTRPRF,IBTSORT,IBTOPW,IBTWHO,IBTPRT,IBDIV
+6 KILL ENTRY,FILE,IBDATE,IBJ,IBNEXT,IBREV,IBSTATUS,IBTPEDT,IBTPBDT,IBTRC,IBTRV,TYPE,IBASSIGN,IBCNT,IBDATA,IBFLAG,IBK,IBL,IBSORT,IBWARD,IBEDT,IBBDT,IBDV,VAUTD
+7 QUIT
+8 ;
DQ ; -- print one billing report from ct
+1 ; -- run the scheduled admissions list
+2 ;
+3 SET IBPAG=0
SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
SET IBQUIT=0
+4 ;
+5 ; -- put division in array by name
+6 IF '$DATA(VAUTD)
SET VAUTD=1
+7 IF VAUTD'=1
SET I=""
FOR
SET I=$ORDER(VAUTD(I))
IF 'I
QUIT
SET IBDIV(VAUTD(I))=I
+8 ;
+9 ; -- run the scheduled admissions list
+10 ;W:'$D(ZTQUEUED) !!,"Building your work list..."
DO ^IBTRKR2
+11 USE IO
+12 DO BLD
+13 IF IBCNT<1
DO HDR
WRITE !!,"No Pending Reviews found."
+14 IF $DATA(ZTQUEUED)
GOTO END
+15 QUIT
+16 ;
HDR ; -- Print header for billing report
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
WRITE !!,"....task stoped at user request"
+2 IF IBQUIT
QUIT
+3 IF $EXTRACT(IOST,1,2)="C-"
IF IBPAG
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
QUIT
+4 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
WRITE @IOF
+5 SET IBPAG=IBPAG+1
+6 WRITE !,"Pending Reviews Report for Division ",$GET(IBDV),?(IOM-33),"Page ",IBPAG," ",IBHDT
+7 WRITE !,"For Period ",$$FMTE^XLFDT(IBBDT)," to ",$$FMTE^XLFDT(IBEDT)
+8 WRITE !,"Patient",?23,"Pt. ID",?30,"Ward",?42,"Review Type",?65,"Due Date",?75,"Status",?85,"Assigned to",?105,"Visit",?115,"Date"
+9 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+10 QUIT
+11 ;
BLD ; -- build list
+1 ; 1. build pending hospital reviews
+2 ; 2. build pending insurance reviews
+3 ;
+4 KILL ^TMP("IBSRT",$JOB),^TMP("IBSRT1",$JOB)
+5 NEW IBI,IBJ
+6 SET IBCNT=0
SET IBI=""
SET IBTOPW=1
+7 IF '$GET(IBTRPRF)
SET IBTRPRF=12
+8 ;
+9 DO STOP
IF IBQUIT
GOTO BLDQ
IF IBTRPRF[1
DO 1^IBTRPR01
SET IBQUIT=0
+10 ;
+11 DO STOP
IF IBQUIT
GOTO BLDQ
IF IBTRPRF[2
DO 2^IBTRPR01
SET IBQUIT=0
+12 ;
+13 ; -- go through sorted list
+14 SET IBDV=""
FOR
SET IBDV=$ORDER(^TMP("IBSRT",$JOB,IBDV))
IF IBDV=""!(IBQUIT)
QUIT
Begin DoDot:1
+15 IF 'VAUTD
IF '$DATA(IBDIV(IBDV))
QUIT
+16 DO HDR
+17 SET TYPE=""
FOR
SET TYPE=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE))
IF TYPE=""!(IBQUIT)
QUIT
Begin DoDot:2
+18 SET IBI=""
FOR
SET IBI=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI))
IF IBI=""!(IBQUIT)
QUIT
SET IBJ=""
FOR
SET IBJ=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ))
IF IBJ=""!(IBQUIT)
QUIT
Begin DoDot:3
+19 SET IBK=""
FOR
SET IBK=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ,IBK))
IF IBK=""!(IBQUIT)
QUIT
SET IBL=""
FOR
SET IBL=$ORDER(^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ,IBK,IBL))
IF IBL=""!(IBQUIT)
QUIT
DO ONE
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
BLDQ QUIT
+1 ;
ONE ; -- print one patients data
+1 IF ($Y+5)>IOSL
DO HDR
IF IBQUIT
QUIT
+2 SET IBDATA=^TMP("IBSRT",$JOB,IBDV,TYPE,IBI,IBJ,IBK,IBL)
+3 SET IBTRN=+IBDATA
SET ENTRY=$PIECE(IBDATA,"^",2)
+4 SET DFN=$PIECE(IBDATA,"^",4)
+5 SET IBSTATUS=$PIECE(IBDATA,"^",6)
SET IBREV=$PIECE(IBDATA,"^",7)
+6 SET IBASSIGN=$PIECE(IBDATA,"^",9)
+7 SET IBFLAG=$ORDER(^TMP("IBSRT1",$JOB,DFN,""))
SET IBFLAG=$ORDER(^TMP("IBSRT1",$JOB,DFN,IBFLAG))
IF IBFLAG'=""
SET IBFLAG="+"
+8 SET FILE=$PIECE(IBDATA,"^",8)
+9 DO PID^VADPT
+10 SET IBCNT=IBCNT+1
+11 WRITE !,IBFLAG,$EXTRACT($PIECE(^DPT(DFN,0),"^"),1,20),?23,VA("BID"),?30,$EXTRACT($GET(^DPT(DFN,.1)),1,11)
+12 WRITE ?42,$EXTRACT(TYPE,1,11),"-",$PIECE($GET(^IBE(356.11,+IBREV,0)),"^",3)
+13 WRITE ?65,$$DAT1^IBOUTL($PIECE(IBDATA,"^",3)),?75,IBSTATUS,?85,$EXTRACT(IBASSIGN,1,18)
+14 WRITE ?105,$PIECE($GET(^IBE(356.6,+$PIECE(^IBT(356,+IBTRN,0),U,18),0)),U,2)
+15 WRITE ?115,$$DAT1^IBOUTL($PIECE(^IBT(356,+IBTRN,0),U,6),"2P")
+16 QUIT
+17 ;
STOP ; -- see if should stop
+1 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET ZTSTOP=1
SET IBQUIT=1
DO HDR
WRITE !!,"....task stoped at user request"
+2 QUIT
