- IBTOUR ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 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
- 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 !,?25,"Admissions",?42,"Admissions",?58,"Days",?74,"Days"
- W !,"Specialty",?25,"Met Criteria",?42,"Not Met Crit.",?58,"Met Criteria",?74,"Not 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(" ",80)," ","-")
- 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(" ",80)," ","-")
- 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
- IBTOUR ;ALB/AAS - CLAIMS TRACKING UR/ACTIVITY REPORT ; 27-OCT-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 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
- +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 !,?25,"Admissions",?42,"Admissions",?58,"Days",?74,"Days"
- +7 WRITE !,"Specialty",?25,"Met Criteria",?42,"Not Met Crit.",?58,"Met Criteria",?74,"Not 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(" ",80)," ","-")
- +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(" ",80)," ","-")
- +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
