- IBTOTR ;ALB/AAS - CLAIMS TRACKING INQUIRY ; 27-OCT-93
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;
- % I '$D(DT) D DT^DICRW
- W !!,"Claims Tracking Inquiry"
- ;
- PAT ; -- Select patient
- W !! D END
- S DIC="^DPT(",DIC(0)="AEQM"
- D ^DIC K DIC I +Y<1 G END
- S DFN=+Y
- ;
- VSIT ;
- ; -- get claims tracking visit entry
- D TRAC^IBTRV K IBY
- I '$G(IBTRN) G END
- ;
- DEV ; -- select device, run option
- W !
- S %ZIS="QM" D ^%ZIS G:POP END
- I $D(IO("Q")) S ZTRTN="DQ^IBTOTR",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB - Inquire to Claims Tracking" D ^%ZTLOAD K IO("Q"),ZTSK D HOME^%ZIS G PAT
- ;
- U IO
- D ONE,END G PAT
- Q
- ;
- END ; -- Clean up
- 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,IBI,IBJ,IBII,IBTRTP,IBNAR,IBCNT
- D KVAR^VADPT
- Q
- ;
- DQ ; -- entry print from task man
- D ONE G END
- Q
- ;
- ONE ; -- print one billing report from ct
- I $D(ZTQUEUED) S ZTREQ="@"
- S IBPAG=0,IBHDT=$$HTE^XLFDT($H,1),IBQUIT=0
- D PID^VADPT
- S IBTRND=$G(^IBT(356,+IBTRN,0)),IBTRND1=$G(^(1))
- S IBETYP=$G(^IBE(356.6,+$P(IBTRND,"^",18),0))
- D HDR,SECT1^IBTOBI
- W ! D BI1^IBTOBI1,CLIN
- ;
- I ($Y+11)>IOSL D HDR Q:IBQUIT
- W !!," Insurance Review Information "
- N I,J,IBTRC,IBTRCD,IBD,IBACTION,TCODE
- S IBCNT=0
- S IBII="" F S IBII=$O(^IBT(356.2,"ATIDT",IBTRN,IBII)) Q:'IBII!(IBQUIT) S IBTRC=0 F S IBTRC=$O(^IBT(356.2,"ATIDT",IBTRN,IBII,IBTRC)) Q:'IBTRC!(IBQUIT) D
- .N IBD
- .S IBCNT=IBCNT+1
- .D IR1^IBTOBI2
- .D IR2^IBTOBI2
- .S IBJ=0 F S IBJ=$O(IBD(IBJ)) Q:'IBJ W !,$E($G(IBD(IBJ,1)),1,39),?40,$E($G(IBD(IBJ,2)),1,39)
- .W !
- .I ($Y+9)>IOSL D HDR Q:IBQUIT
- I IBCNT<1 W !,"None on file.",!
- ;
- I ($Y+11)>IOSL D HDR Q:IBQUIT
- W !," Hospital Review Information "
- N I,J,IBTRV,IBTRVD,IBD
- S IBCNT=0
- S IBII="" F S IBII=$O(^IBT(356.1,"ATIDT",IBTRN,IBII)) Q:'IBII!(IBQUIT) S IBTRV=0 F S IBTRV=$O(^IBT(356.1,"ATIDT",IBTRN,IBII,IBTRV)) Q:'IBTRV!(IBQUIT) D
- .N IBD
- .S IBCNT=IBCNT+1
- .D HR1^IBTOBI3
- .D HR2^IBTOBI3
- .S IBJ=0 F S IBJ=$O(IBD(IBJ)) Q:'IBJ W !,$E($G(IBD(IBJ,1)),1,40),?40,$E($G(IBD(IBJ,2)),1,39)
- .W !
- .I ($Y+9)>IOSL D HDR Q:IBQUIT
- I IBCNT<1 W !,"None on file.",!
- Q
- ;
- HDR ; -- Print header for billing report
- 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 !,"Claim Tracking Inquiry",?(IOM-33),"Page ",IBPAG," ",IBHDT
- W !,$E($P($G(^DPT(DFN,0)),"^"),1,25),?28,VA("PID"),?50,"DOB: ",$$FMTE^XLFDT($P($G(^DPT(DFN,0)),"^",3),1)
- W !,$$EXPAND^IBTRE(356,.18,$P(IBTRND,"^",18))," on ",$$FMTE^XLFDT($P(IBTRND,"^",6),1)
- W !,$TR($J(" ",IOM)," ","-")
- Q
- ;
- CLIN ; -- output clinical information
- N IBOE,DGPM
- ;
- I $P(IBETYP,"^",3)=1 S DGPM=$P(^IBT(356,+IBTRN,0),"^",5) I 'DGPM Q
- I $P(IBETYP,"^",3)=2 S IBOE=$P(^IBT(356,+IBTRN,0),"^",4)
- F IBTAG="DIAG","PROC","PROV" D @IBTAG Q:IBQUIT
- Q
- ;
- DIAG ; -- print diagnosis information
- I '$G(DGPM),('$G(IBOE)) Q
- Q:$P(IBETYP,"^",3)>2
- I ($Y+9)>IOSL D HDR Q:IBQUIT
- D DIAG1^IBTOBI4
- Q
- ;
- PROC ; -- print procedure information
- Q:$P(IBETYP,"^",3)>2
- I ($Y+9)>IOSL D HDR Q:IBQUIT
- D PROC1^IBTOBI4
- Q
- ;
- PROV ; -- print provider information
- I '$G(DGPM),('$G(IBOE)) Q
- Q:$P(IBETYP,"^",3)>2
- I ($Y+9)>IOSL D HDR Q:IBQUIT
- D PROV1^IBTOBI4
- Q
- IBTOTR ;ALB/AAS - CLAIMS TRACKING INQUIRY ; 27-OCT-93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;
- % IF '$DATA(DT)
- DO DT^DICRW
- +1 WRITE !!,"Claims Tracking Inquiry"
- +2 ;
- PAT ; -- Select patient
- +1 WRITE !!
- DO END
- +2 SET DIC="^DPT("
- SET DIC(0)="AEQM"
- +3 DO ^DIC
- KILL DIC
- IF +Y<1
- GOTO END
- +4 SET DFN=+Y
- +5 ;
- VSIT ;
- +1 ; -- get claims tracking visit entry
- +2 DO TRAC^IBTRV
- KILL IBY
- +3 IF '$GET(IBTRN)
- GOTO END
- +4 ;
- DEV ; -- select device, run option
- +1 WRITE !
- +2 SET %ZIS="QM"
- DO ^%ZIS
- IF POP
- GOTO END
- +3 IF $DATA(IO("Q"))
- SET ZTRTN="DQ^IBTOTR"
- SET ZTSAVE("IB*")=""
- SET ZTSAVE("DFN")=""
- SET ZTDESC="IB - Inquire to Claims Tracking"
- DO ^%ZTLOAD
- KILL IO("Q"),ZTSK
- DO HOME^%ZIS
- GOTO PAT
- +4 ;
- +5 USE IO
- +6 DO ONE
- DO END
- GOTO PAT
- +7 QUIT
- +8 ;
- END ; -- Clean up
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +2 DO ^%ZISC
- +3 KILL I,J,X,Y,DFN,%ZIS,VA,IBTRN,IBTRND,IBTRND1,IBPAG,IBHDT,IBDISDT,IBETYP,IBQUIT,IBTAG,IBI,IBJ,IBII,IBTRTP,IBNAR,IBCNT
- +4 DO KVAR^VADPT
- +5 QUIT
- +6 ;
- DQ ; -- entry print from task man
- +1 DO ONE
- GOTO END
- +2 QUIT
- +3 ;
- ONE ; -- print one billing report from ct
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 SET IBPAG=0
- SET IBHDT=$$HTE^XLFDT($HOROLOG,1)
- SET IBQUIT=0
- +3 DO PID^VADPT
- +4 SET IBTRND=$GET(^IBT(356,+IBTRN,0))
- SET IBTRND1=$GET(^(1))
- +5 SET IBETYP=$GET(^IBE(356.6,+$PIECE(IBTRND,"^",18),0))
- +6 DO HDR
- DO SECT1^IBTOBI
- +7 WRITE !
- DO BI1^IBTOBI1
- DO CLIN
- +8 ;
- +9 IF ($Y+11)>IOSL
- DO HDR
- IF IBQUIT
- QUIT
- +10 WRITE !!," Insurance Review Information "
- +11 NEW I,J,IBTRC,IBTRCD,IBD,IBACTION,TCODE
- +12 SET IBCNT=0
- +13 SET IBII=""
- FOR
- SET IBII=$ORDER(^IBT(356.2,"ATIDT",IBTRN,IBII))
- IF 'IBII!(IBQUIT)
- QUIT
- SET IBTRC=0
- FOR
- SET IBTRC=$ORDER(^IBT(356.2,"ATIDT",IBTRN,IBII,IBTRC))
- IF 'IBTRC!(IBQUIT)
- QUIT
- Begin DoDot:1
- +14 NEW IBD
- +15 SET IBCNT=IBCNT+1
- +16 DO IR1^IBTOBI2
- +17 DO IR2^IBTOBI2
- +18 SET IBJ=0
- FOR
- SET IBJ=$ORDER(IBD(IBJ))
- IF 'IBJ
- QUIT
- WRITE !,$EXTRACT($GET(IBD(IBJ,1)),1,39),?40,$EXTRACT($GET(IBD(IBJ,2)),1,39)
- +19 WRITE !
- +20 IF ($Y+9)>IOSL
- DO HDR
- IF IBQUIT
- QUIT
- End DoDot:1
- +21 IF IBCNT<1
- WRITE !,"None on file.",!
- +22 ;
- +23 IF ($Y+11)>IOSL
- DO HDR
- IF IBQUIT
- QUIT
- +24 WRITE !," Hospital Review Information "
- +25 NEW I,J,IBTRV,IBTRVD,IBD
- +26 SET IBCNT=0
- +27 SET IBII=""
- FOR
- SET IBII=$ORDER(^IBT(356.1,"ATIDT",IBTRN,IBII))
- IF 'IBII!(IBQUIT)
- QUIT
- SET IBTRV=0
- FOR
- SET IBTRV=$ORDER(^IBT(356.1,"ATIDT",IBTRN,IBII,IBTRV))
- IF 'IBTRV!(IBQUIT)
- QUIT
- Begin DoDot:1
- +28 NEW IBD
- +29 SET IBCNT=IBCNT+1
- +30 DO HR1^IBTOBI3
- +31 DO HR2^IBTOBI3
- +32 SET IBJ=0
- FOR
- SET IBJ=$ORDER(IBD(IBJ))
- IF 'IBJ
- QUIT
- WRITE !,$EXTRACT($GET(IBD(IBJ,1)),1,40),?40,$EXTRACT($GET(IBD(IBJ,2)),1,39)
- +33 WRITE !
- +34 IF ($Y+9)>IOSL
- DO HDR
- IF IBQUIT
- QUIT
- End DoDot:1
- +35 IF IBCNT<1
- WRITE !,"None on file.",!
- +36 QUIT
- +37 ;
- HDR ; -- Print header for billing report
- +1 IF IBQUIT
- QUIT
- +2 IF $EXTRACT(IOST,1,2)="C-"
- IF IBPAG
- DO PAUSE^VALM1
- IF $DATA(DIRUT)
- SET IBQUIT=1
- QUIT
- +3 IF $EXTRACT(IOST,1,2)="C-"!(IBPAG)
- WRITE @IOF
- +4 SET IBPAG=IBPAG+1
- +5 WRITE !,"Claim Tracking Inquiry",?(IOM-33),"Page ",IBPAG," ",IBHDT
- +6 WRITE !,$EXTRACT($PIECE($GET(^DPT(DFN,0)),"^"),1,25),?28,VA("PID"),?50,"DOB: ",$$FMTE^XLFDT($PIECE($GET(^DPT(DFN,0)),"^",3),1)
- +7 WRITE !,$$EXPAND^IBTRE(356,.18,$PIECE(IBTRND,"^",18))," on ",$$FMTE^XLFDT($PIECE(IBTRND,"^",6),1)
- +8 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-")
- +9 QUIT
- +10 ;
- CLIN ; -- output clinical information
- +1 NEW IBOE,DGPM
- +2 ;
- +3 IF $PIECE(IBETYP,"^",3)=1
- SET DGPM=$PIECE(^IBT(356,+IBTRN,0),"^",5)
- IF 'DGPM
- QUIT
- +4 IF $PIECE(IBETYP,"^",3)=2
- SET IBOE=$PIECE(^IBT(356,+IBTRN,0),"^",4)
- +5 FOR IBTAG="DIAG","PROC","PROV"
- DO @IBTAG
- IF IBQUIT
- QUIT
- +6 QUIT
- +7 ;
- DIAG ; -- print diagnosis information
- +1 IF '$GET(DGPM)
- IF ('$GET(IBOE))
- QUIT
- +2 IF $PIECE(IBETYP,"^",3)>2
- QUIT
- +3 IF ($Y+9)>IOSL
- DO HDR
- IF IBQUIT
- QUIT
- +4 DO DIAG1^IBTOBI4
- +5 QUIT
- +6 ;
- PROC ; -- print procedure information
- +1 IF $PIECE(IBETYP,"^",3)>2
- QUIT
- +2 IF ($Y+9)>IOSL
- DO HDR
- IF IBQUIT
- QUIT
- +3 DO PROC1^IBTOBI4
- +4 QUIT
- +5 ;
- PROV ; -- print provider information
- +1 IF '$GET(DGPM)
- IF ('$GET(IBOE))
- QUIT
- +2 IF $PIECE(IBETYP,"^",3)>2
- QUIT
- +3 IF ($Y+9)>IOSL
- DO HDR
- IF IBQUIT
- QUIT
- +4 DO PROV1^IBTOBI4
- +5 QUIT
