IBCONS3 ;ALB/AAS - NSC W/INSURANCE OUTPUT, TRACKING INTEFACE ; 21-OCT-93
;;2.0;INTEGRATED BILLING;**19,36,91,120**;21-MAR-94
;
TRACK ; -- Claims tracking interface for patients with insurance reports.
;
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,IBQUIT)=1
;
N IBNO,IBTRN,IBXX
S IBRMARK=""
; -- if there get reason not billable
I IBINPT D ;look for inpatient tracking records
.Q:'$G(IBADMVT)
.S IBTRN=$O(^IBT(356,"AD",+IBADMVT,0))
.Q:'$G(IBTRN)
.S IBRMARK=$$RMARK(IBTRN)
.Q
;
I 'IBINPT D ;look for outpatient tracking records
.I $G(IBOE) S IBTRN=$O(^IBT(356,"ASCE",+IBOE,0))
.;Patch 36 if assoc stop code link to primary encounter IBOE
.I '$G(IBTRN) S IBXX=$$SCE^IBSDU(+IBOE,6) S:IBXX IBTRN=$O(^IBT(356,"ASCE",+IBXX,0))
.I $P($G(IBOE(1)),U,2),'($G(IBTRN)) N X,IBTMP F IBNO=1:1 Q:$G(IBOE(IBNO))="" F X=1:1 Q:($P(IBOE(IBNO),U,X)="")!($G(IBTRN)) D
..S IBTMP=$P(IBOE(IBNO),U,X)
..I $O(^IBT(356,"ASCE",+IBTMP,0)) S IBTRN=$O(^IBT(356,"ASCE",+IBTMP,0)) Q
.I '$G(IBTRN) D
..N IBETYP S IBETYP=+$O(^IBE(356.6,"B","OUTPATIENT VISIT",0))
..S X=$O(^IBT(356,"APTY",DFN,IBETYP,($P(I,".")-.0000001))) S:$P(X,".")=$P(I,".") IBTRN=$O(^(X,0))
.Q:'$G(IBTRN)
.S IBRMARK=$$RMARK(IBTRN)
.Q
;
; -- if not in ct and parameter set to add, add to ct. (INPT ONLY P120)
I IBINPT,'$G(IBTRN),$P(IBTRKR,"^",23) D ADD
;
TRACKQ Q
;
ADD ; -- if not there see if should add
; if inpatient, not before ct start date, inpt tracking on
I IBINPT,I'<+IBTRKR,$P(IBTRKR,"^",2) D
.;
.Q:'$G(IBADMVT)
.N I,J,X,Y,DA,DR,DIE,DIC,IBETYP,IBADMDT,IBTRN
.S IBADMDT=$P(^DGPM(IBADMVT,0),"^")
.S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
.S IBTRN=$O(^IBT(356,"ASCH",+$$SCH^IBTRKR2(IBADMVT),0))
.D:'IBTRN ADDT^IBTUTL
.I IBTRN<1 Q
.S DA=IBTRN,DIE="^IBT(356,"
.L +^IBT(356,+IBTRN):10 I '$T Q
.S DR=$$ADMDR^IBTUTL(IBADMDT,IBETYP,IBADMVT,0)
.D ^DIE
.L -^IBT(356,+IBTRN)
.Q
;
; patch 120, removed add opt to CT from here to call tracker routine to add opt CT entries so will get all the non-billable checks
ADDQ Q
;
RMARK(IBTRN) ; -- returns external reason not billable
Q $P($G(^IBE(356.8,+$P($G(^IBT(356,+$G(IBTRN),0)),"^",19),0)),"^")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCONS3 2198 printed Dec 13, 2024@02:18:28 Page 2
IBCONS3 ;ALB/AAS - NSC W/INSURANCE OUTPUT, TRACKING INTEFACE ; 21-OCT-93
+1 ;;2.0;INTEGRATED BILLING;**19,36,91,120**;21-MAR-94
+2 ;
TRACK ; -- Claims tracking interface for patients with insurance reports.
+1 ;
+2 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET (ZTSTOP,IBQUIT)=1
+3 ;
+4 NEW IBNO,IBTRN,IBXX
+5 SET IBRMARK=""
+6 ; -- if there get reason not billable
+7 ;look for inpatient tracking records
IF IBINPT
Begin DoDot:1
+8 if '$GET(IBADMVT)
QUIT
+9 SET IBTRN=$ORDER(^IBT(356,"AD",+IBADMVT,0))
+10 if '$GET(IBTRN)
QUIT
+11 SET IBRMARK=$$RMARK(IBTRN)
+12 QUIT
End DoDot:1
+13 ;
+14 ;look for outpatient tracking records
IF 'IBINPT
Begin DoDot:1
+15 IF $GET(IBOE)
SET IBTRN=$ORDER(^IBT(356,"ASCE",+IBOE,0))
+16 ;Patch 36 if assoc stop code link to primary encounter IBOE
+17 IF '$GET(IBTRN)
SET IBXX=$$SCE^IBSDU(+IBOE,6)
if IBXX
SET IBTRN=$ORDER(^IBT(356,"ASCE",+IBXX,0))
+18 IF $PIECE($GET(IBOE(1)),U,2)
IF '($GET(IBTRN))
NEW X,IBTMP
FOR IBNO=1:1
if $GET(IBOE(IBNO))=""
QUIT
FOR X=1:1
if ($PIECE(IBOE(IBNO),U,X)="")!($GET(IBTRN))
QUIT
Begin DoDot:2
+19 SET IBTMP=$PIECE(IBOE(IBNO),U,X)
+20 IF $ORDER(^IBT(356,"ASCE",+IBTMP,0))
SET IBTRN=$ORDER(^IBT(356,"ASCE",+IBTMP,0))
QUIT
End DoDot:2
+21 IF '$GET(IBTRN)
Begin DoDot:2
+22 NEW IBETYP
SET IBETYP=+$ORDER(^IBE(356.6,"B","OUTPATIENT VISIT",0))
+23 SET X=$ORDER(^IBT(356,"APTY",DFN,IBETYP,($PIECE(I,".")-.0000001)))
if $PIECE(X,".")=$PIECE(I,".")
SET IBTRN=$ORDER(^(X,0))
End DoDot:2
+24 if '$GET(IBTRN)
QUIT
+25 SET IBRMARK=$$RMARK(IBTRN)
+26 QUIT
End DoDot:1
+27 ;
+28 ; -- if not in ct and parameter set to add, add to ct. (INPT ONLY P120)
+29 IF IBINPT
IF '$GET(IBTRN)
IF $PIECE(IBTRKR,"^",23)
DO ADD
+30 ;
TRACKQ QUIT
+1 ;
ADD ; -- if not there see if should add
+1 ; if inpatient, not before ct start date, inpt tracking on
+2 IF IBINPT
IF I'<+IBTRKR
IF $PIECE(IBTRKR,"^",2)
Begin DoDot:1
+3 ;
+4 if '$GET(IBADMVT)
QUIT
+5 NEW I,J,X,Y,DA,DR,DIE,DIC,IBETYP,IBADMDT,IBTRN
+6 SET IBADMDT=$PIECE(^DGPM(IBADMVT,0),"^")
+7 SET IBETYP=+$ORDER(^IBE(356.6,"B","INPATIENT ADMISSION",0))
+8 SET IBTRN=$ORDER(^IBT(356,"ASCH",+$$SCH^IBTRKR2(IBADMVT),0))
+9 if 'IBTRN
DO ADDT^IBTUTL
+10 IF IBTRN<1
QUIT
+11 SET DA=IBTRN
SET DIE="^IBT(356,"
+12 LOCK +^IBT(356,+IBTRN):10
IF '$TEST
QUIT
+13 SET DR=$$ADMDR^IBTUTL(IBADMDT,IBETYP,IBADMVT,0)
+14 DO ^DIE
+15 LOCK -^IBT(356,+IBTRN)
+16 QUIT
End DoDot:1
+17 ;
+18 ; patch 120, removed add opt to CT from here to call tracker routine to add opt CT entries so will get all the non-billable checks
ADDQ QUIT
+1 ;
RMARK(IBTRN) ; -- returns external reason not billable
+1 QUIT $PIECE($GET(^IBE(356.8,+$PIECE($GET(^IBT(356,+$GET(IBTRN),0)),"^",19),0)),"^")
