IBTOTR ;ALB/AAS - CLAIMS TRACKING INQUIRY ; 27-OCT-93
;;2.0; INTEGRATED BILLING ;**40,199**; 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"
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
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
.; Patch #40 pick up Special Unit SI or IS
.D UNIT^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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTOTR 3456 printed Nov 22, 2024@17:37:27 Page 2
IBTOTR ;ALB/AAS - CLAIMS TRACKING INQUIRY ; 27-OCT-93
+1 ;;2.0; INTEGRATED BILLING ;**40,199**; 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 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+4 DO ^DIC
KILL DIC
IF +Y<1
GOTO END
+5 SET DFN=+Y
+6 ;
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 ; Patch #40 pick up Special Unit SI or IS
+33 DO UNIT^IBTOBI3
+34 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)
+35 WRITE !
+36 IF ($Y+9)>IOSL
DO HDR
if IBQUIT
QUIT
End DoDot:1
+37 IF IBCNT<1
WRITE !,"None on file.",!
+38 QUIT
+39 ;
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
