- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOPW 4691 printed Jan 18, 2025@03:28:32 Page 2
- 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