IBTOUR ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;**56**; 21-MAR-94
;
% I '$D(DT) D DT^DICRW
W !!,"UR Activity Report",!!
;
N DIR
S IBQUIT=0
D SORT^IBTOLR G:IBQUIT END
;
SUM S DIR("?")="Answer YES if you only want to print a summary or answer NO if you want a detailed listing plus the summary."
S DIR(0)="Y",DIR("A")="Print Summary Only",DIR("B")="YES" D ^DIR K DIR
I $D(DIRUT) G END
S IBSUM=Y
;
I 'IBSUM W ! D HOW G:IBQUIT END
;
DATE ; -- select date
W ! D DATE^IBOUTL
I IBBDT=""!(IBEDT="") G END
;
DEV ; -- select device, run option
I 'IBSUM 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^IBTOUR",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - UR Activity Report" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G END
;
U IO
D DQ G END
Q
;
END ; -- Clean up
K ^TMP($J)
I $D(ZTQUEUED) S ZTREQ="@" Q
D ^%ZISC
K I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBFOL,IBCNT,IBTRC,IBTRCD,IBSUM,IBDT,IBBDT,IBEDT,IBINS,IBCCODE,IBPCODE,DUOUT,DTOUT,DIRUT,IBC,MET,TYPE
K IBFAC,IBSNM,IBHDRL,IBTRV,IBTRVD,IBHOW,DGPM,IBI,IBJ,IBSORT,IBAPL,IBCDT,IBP1,IBP2,IBP3,IBP4,IBADM,IBDAYS,IBDAYN,IBCLOSE,IBDA,IBDATA,IBH,IBDIF,IBPREV,IBSITE,IBSPEC,IBTNOD,IBBEG,X2
D KVAR^VADPT
Q
;
DQ ; -- print one billing report from ct
K ^TMP($J)
S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
S:$G(IBHOW)="" IBHOW="P"
K IBCNT,^TMP($J)
D BLD^IBTOUR1
Q:$D(ZTSTOP)
;
PRINT ; -- print report
I IBSORT'="H" S IBHDRL="Insurance" D
.I 'IBSUM D INS^IBTOUR4 ; insurance listing
.Q:$D(ZTSTOP)
.D INS^IBTOUR3 ; insurance summary
I IBSORT'="I" S IBHDRL="Hospital" D
.Q:$D(ZTSTOP)
.I 'IBSUM D HOSP^IBTOUR4 ;hosp rev. listing
.Q:$D(ZTSTOP)
.D HOSP^IBTOUR3 ; hosp. rev. summary
I $D(ZTQUEUED) G END
Q
;
HOW ; -- if not summary only ask how list is to be sorted
N DIR
S DIR(0)="SOBA^R:REVIEWER;S:SPECIALTY;P:PATIENT"
S DIR("A")="Sort By [R]eviewer [S]pecialty [P]atient: "
S DIR("B")="P"
S DIR("?",1)="When printing the list of patients reviewed, how should this report be"
S DIR("?",2)="sorted. It can be sorted by Reviewer or by Specialty or by Patient. "
S DIR("?",3)="If sorted by Reviewer it will be sorted within reviewer by type of review."
S DIR("?",4)=" ",DIR("?")="The default is Patient."
D ^DIR K DIR
S IBHOW=Y I "RSP"'[Y!($D(DIRUT)) S IBQUIT=1
Q
;
HDR1 ; -- specialty report header
I $E(IOST,1,2)="C-" W ! D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
W @IOF
S IBPAG=IBPAG+1
W !,"HOSPITAL REVIEW SPECIALTY SUMMARY REPORT",?IOM-32,IBHDT," Page ",IBPAG
W !!,"For Hospital Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
W !,?24,"Admissions",?40,"Admissions",?56,"Days",?71,"Days Not"
W !,"Specialty",?24,"Met Criteria",?40,"Not Met Crit.",?56,"Met Criteria",?71,"Met Crit."
W !,$TR($J(" ",IOM)," ","-")
Q
;
HSPEC ; -- Hospital Review specialty report
D HDR1 Q:IBQUIT
S (IBP1,IBP2,IBP3,IBP4)=0
S IBSPEC="" F S IBSPEC=$O(^TMP($J,"IBTOUR2",IBSPEC)) Q:IBSPEC="" S IBDATA=^(IBSPEC) D
.Q:IBDATA="0^0^0^0"
.W !,$E(IBSPEC,1,20)
.W ?23,$J($P(IBDATA,"^",1),8)
.W ?40,$J($P(IBDATA,"^",2),8),?52,$J($P(IBDATA,"^",3),12)
.W ?68,$J($P(IBDATA,"^",4),12)
.S IBP1=IBP1+$P(IBDATA,"^",1),IBP2=IBP2+$P(IBDATA,"^",2),IBP3=IBP3+$P(IBDATA,"^",3),IBP4=IBP4+$P(IBDATA,"^",4)
;
W !,$TR($J(" ",IOM)," ","-")
W !,?23,$J(IBP1,8),?40,$J(IBP2,8)
W ?52,$J(IBP3,12)
W ?68,$J(IBP4,12)
Q
;
IHDR ; -- specialty report header
I $E(IOST,1,2)="C-" W ! D PAUSE^VALM1 I $D(DIRUT) S IBQUIT=1 Q
W @IOF
S IBPAG=IBPAG+1
W !,"INSURANCE REVIEW SPECIALTY SUMMARY REPORT",?IOM-32,IBHDT," Page ",IBPAG
W !,"For Insurance Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
W !!,?25,"Days",?42,"Days",?56,"Amount",?73,"Amount"
W !,"Specialty",?25,"Approved",?42,"Denied",?56,"Approved",?73,"Denied"
W !,$TR($J(" ",IOM)," ","-")
Q
;
ISPEC ; -- Insurance Review specialty report
D IHDR Q:IBQUIT
S (IBP1,IBP2,IBP3,IBP4)=0
S IBSPEC="" F S IBSPEC=$O(^TMP($J,"IBTOUR1",IBSPEC)) Q:IBSPEC="" S IBDATA=^(IBSPEC) D
.Q:IBDATA="0^0^0^0"
.W !,$E(IBSPEC,1,20)
.W ?23,$J($P(IBDATA,"^",1),8)
.W ?38,$J($P(IBDATA,"^",2),8)
.S X=$P(IBDATA,"^",3),X2="0$" D COMMA^%DTC W ?50,X
.S X=$P(IBDATA,"^",4),X2="0$" D COMMA^%DTC W ?67,X
.S IBP1=IBP1+$P(IBDATA,"^",1),IBP2=IBP2+$P(IBDATA,"^",2),IBP3=IBP3+$P(IBDATA,"^",3),IBP4=IBP4+$P(IBDATA,"^",4)
;
W !,$TR($J(" ",IOM)," ","-")
W !,?23,$J(IBP1,8),?38,$J(IBP2,8)
S X=IBP3,X2="0$" D COMMA^%DTC W ?50,X
S X=IBP4,X2="0$" D COMMA^%DTC W ?67,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOUR 4689 printed Oct 16, 2024@18:28:04 Page 2
IBTOUR ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**56**; 21-MAR-94
+2 ;
% IF '$DATA(DT)
DO DT^DICRW
+1 WRITE !!,"UR Activity Report",!!
+2 ;
+3 NEW DIR
+4 SET IBQUIT=0
+5 DO SORT^IBTOLR
if IBQUIT
GOTO END
+6 ;
SUM SET DIR("?")="Answer YES if you only want to print a summary or answer NO if you want a detailed listing plus the summary."
+1 SET DIR(0)="Y"
SET DIR("A")="Print Summary Only"
SET DIR("B")="YES"
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO END
+3 SET IBSUM=Y
+4 ;
+5 IF 'IBSUM
WRITE !
DO HOW
if IBQUIT
GOTO END
+6 ;
DATE ; -- select date
+1 WRITE !
DO DATE^IBOUTL
+2 IF IBBDT=""!(IBEDT="")
GOTO END
+3 ;
DEV ; -- select device, run option
+1 IF 'IBSUM
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^IBTOUR"
SET ZTSAVE("IB*")=""
SET ZTSAVE("DFN")=""
SET ZTDESC="IB - UR Activity Report"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
DO HOME^%ZIS
GOTO END
+4 ;
+5 USE IO
+6 DO DQ
GOTO END
+7 QUIT
+8 ;
END ; -- Clean up
+1 KILL ^TMP($JOB)
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+3 DO ^%ZISC
+4 KILL I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBFOL,IBCNT,IBTRC,IBTRCD,IBSUM,IBDT,IBBDT,IBEDT,IBINS,IBCCODE,IBPCODE,DUOUT,DTOUT,DIRUT,IBC,MET,TYPE
+5 KILL IBFAC,IBSNM,IBHDRL,IBTRV,IBTRVD,IBHOW,DGPM,IBI,IBJ,IBSORT,IBAPL,IBCDT,IBP1,IBP2,IBP3,IBP4,IBADM,IBDAYS,IBDAYN,IBCLOSE,IBDA,IBDATA,IBH,IBDIF,IBPREV,IBSITE,IBSPEC,IBTNOD,IBBEG,X2
+6 DO KVAR^VADPT
+7 QUIT
+8 ;
DQ ; -- print one billing report from ct
+1 KILL ^TMP($JOB)
+2 SET IBPAG=0
SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
SET IBQUIT=0
+3 if $GET(IBHOW)=""
SET IBHOW="P"
+4 KILL IBCNT,^TMP($JOB)
+5 DO BLD^IBTOUR1
+6 if $DATA(ZTSTOP)
QUIT
+7 ;
PRINT ; -- print report
+1 IF IBSORT'="H"
SET IBHDRL="Insurance"
Begin DoDot:1
+2 ; insurance listing
IF 'IBSUM
DO INS^IBTOUR4
+3 if $DATA(ZTSTOP)
QUIT
+4 ; insurance summary
DO INS^IBTOUR3
End DoDot:1
+5 IF IBSORT'="I"
SET IBHDRL="Hospital"
Begin DoDot:1
+6 if $DATA(ZTSTOP)
QUIT
+7 ;hosp rev. listing
IF 'IBSUM
DO HOSP^IBTOUR4
+8 if $DATA(ZTSTOP)
QUIT
+9 ; hosp. rev. summary
DO HOSP^IBTOUR3
End DoDot:1
+10 IF $DATA(ZTQUEUED)
GOTO END
+11 QUIT
+12 ;
HOW ; -- if not summary only ask how list is to be sorted
+1 NEW DIR
+2 SET DIR(0)="SOBA^R:REVIEWER;S:SPECIALTY;P:PATIENT"
+3 SET DIR("A")="Sort By [R]eviewer [S]pecialty [P]atient: "
+4 SET DIR("B")="P"
+5 SET DIR("?",1)="When printing the list of patients reviewed, how should this report be"
+6 SET DIR("?",2)="sorted. It can be sorted by Reviewer or by Specialty or by Patient. "
+7 SET DIR("?",3)="If sorted by Reviewer it will be sorted within reviewer by type of review."
+8 SET DIR("?",4)=" "
SET DIR("?")="The default is Patient."
+9 DO ^DIR
KILL DIR
+10 SET IBHOW=Y
IF "RSP"'[Y!($DATA(DIRUT))
SET IBQUIT=1
+11 QUIT
+12 ;
HDR1 ; -- specialty report header
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
QUIT
+2 WRITE @IOF
+3 SET IBPAG=IBPAG+1
+4 WRITE !,"HOSPITAL REVIEW SPECIALTY SUMMARY REPORT",?IOM-32,IBHDT," Page ",IBPAG
+5 WRITE !!,"For Hospital Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
+6 WRITE !,?24,"Admissions",?40,"Admissions",?56,"Days",?71,"Days Not"
+7 WRITE !,"Specialty",?24,"Met Criteria",?40,"Not Met Crit.",?56,"Met Criteria",?71,"Met Crit."
+8 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+9 QUIT
+10 ;
HSPEC ; -- Hospital Review specialty report
+1 DO HDR1
if IBQUIT
QUIT
+2 SET (IBP1,IBP2,IBP3,IBP4)=0
+3 SET IBSPEC=""
FOR
SET IBSPEC=$ORDER(^TMP($JOB,"IBTOUR2",IBSPEC))
if IBSPEC=""
QUIT
SET IBDATA=^(IBSPEC)
Begin DoDot:1
+4 if IBDATA="0^0^0^0"
QUIT
+5 WRITE !,$EXTRACT(IBSPEC,1,20)
+6 WRITE ?23,$JUSTIFY($PIECE(IBDATA,"^",1),8)
+7 WRITE ?40,$JUSTIFY($PIECE(IBDATA,"^",2),8),?52,$JUSTIFY($PIECE(IBDATA,"^",3),12)
+8 WRITE ?68,$JUSTIFY($PIECE(IBDATA,"^",4),12)
+9 SET IBP1=IBP1+$PIECE(IBDATA,"^",1)
SET IBP2=IBP2+$PIECE(IBDATA,"^",2)
SET IBP3=IBP3+$PIECE(IBDATA,"^",3)
SET IBP4=IBP4+$PIECE(IBDATA,"^",4)
End DoDot:1
+10 ;
+11 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+12 WRITE !,?23,$JUSTIFY(IBP1,8),?40,$JUSTIFY(IBP2,8)
+13 WRITE ?52,$JUSTIFY(IBP3,12)
+14 WRITE ?68,$JUSTIFY(IBP4,12)
+15 QUIT
+16 ;
IHDR ; -- specialty report header
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
DO PAUSE^VALM1
IF $DATA(DIRUT)
SET IBQUIT=1
QUIT
+2 WRITE @IOF
+3 SET IBPAG=IBPAG+1
+4 WRITE !,"INSURANCE REVIEW SPECIALTY SUMMARY REPORT",?IOM-32,IBHDT," Page ",IBPAG
+5 WRITE !,"For Insurance Reviews Dated ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
+6 WRITE !!,?25,"Days",?42,"Days",?56,"Amount",?73,"Amount"
+7 WRITE !,"Specialty",?25,"Approved",?42,"Denied",?56,"Approved",?73,"Denied"
+8 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+9 QUIT
+10 ;
ISPEC ; -- Insurance Review specialty report
+1 DO IHDR
if IBQUIT
QUIT
+2 SET (IBP1,IBP2,IBP3,IBP4)=0
+3 SET IBSPEC=""
FOR
SET IBSPEC=$ORDER(^TMP($JOB,"IBTOUR1",IBSPEC))
if IBSPEC=""
QUIT
SET IBDATA=^(IBSPEC)
Begin DoDot:1
+4 if IBDATA="0^0^0^0"
QUIT
+5 WRITE !,$EXTRACT(IBSPEC,1,20)
+6 WRITE ?23,$JUSTIFY($PIECE(IBDATA,"^",1),8)
+7 WRITE ?38,$JUSTIFY($PIECE(IBDATA,"^",2),8)
+8 SET X=$PIECE(IBDATA,"^",3)
SET X2="0$"
DO COMMA^%DTC
WRITE ?50,X
+9 SET X=$PIECE(IBDATA,"^",4)
SET X2="0$"
DO COMMA^%DTC
WRITE ?67,X
+10 SET IBP1=IBP1+$PIECE(IBDATA,"^",1)
SET IBP2=IBP2+$PIECE(IBDATA,"^",2)
SET IBP3=IBP3+$PIECE(IBDATA,"^",3)
SET IBP4=IBP4+$PIECE(IBDATA,"^",4)
End DoDot:1
+11 ;
+12 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
+13 WRITE !,?23,$JUSTIFY(IBP1,8),?38,$JUSTIFY(IBP2,8)
+14 SET X=IBP3
SET X2="0$"
DO COMMA^%DTC
WRITE ?50,X
+15 SET X=IBP4
SET X2="0$"
DO COMMA^%DTC
WRITE ?67,X
+16 QUIT
