IBCONS3 ;ALB/AAS - NSC W/INSURANCE OUTPUT, TRACKING INTEFACE ; 21-OCT-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
TRACK ; -- Claims tracking interface for patients with insurance reports.
;
I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,IBQUIT)=1
;
N IBTRN
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))
.I '$G(IBOE) D
..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.
I '$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
;
; -- if outpatient, not before ct start date, opt tracking on
I 'IBINPT,I'<+IBTRKR,$P(IBTRKR,"^",3),I'>$$FMDIFF^XLFDT(DT,-2) D
.;
.N IBTDT S IBTDT=I
.N I,J,X,Y,DA,DR,DIC,DIE,IBETYP,IBTRN
.S IBETYP=+$O(^IBE(356.6,"B","OUTPATIENT VISIT",0))
.;
.; -- if encounter add encounter
.I +$G(IBOE) D Q
..S X=$P($G(^SCE(+IBOE,0)),"^",6) I X,X'=+IBOE Q
..D OPT^IBTUTL1(DFN,IBETYP,IBTDT,+IBOE) Q
.;
.S IBTDT=$P(IBTDT,".")
.; -- must not be before encounter is created
.Q:IBTDT>($$FMDIFF^XLFDT(DT,-2))
.;
.; -- see if already entry for same day.
.S X=$O(^IBT(356,"APTY",DFN,IBETYP,(IBTDT-.0000001))) I $P(X,".")=IBTDT Q
.D ADDT^IBTUTL
.S DA=IBTRN,DIE="^IBT(356,"
.I IBTRN<1 Q
.L +^IBT(356,+IBTRN):10 I '$T Q
.S DR=".02////"_$G(DFN)_";.06////"_IBTDT_";.18////"_IBETYP_";.2////1;.24////1;1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD^IBTUTL(IBETYP)
.D ^DIE
.L -^IBT(356,+IBTRN)
.Q
ADDQ Q
;
RMARK(IBTRN) ; -- returns external reason not billable
Q $P($G(^IBE(356.8,+$P($G(^IBT(356,+$G(IBTRN),0)),"^",19),0)),"^")
IBCONS3 ;ALB/AAS - NSC W/INSURANCE OUTPUT, TRACKING INTEFACE ; 21-OCT-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 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 IBTRN
+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 IF '$GET(IBOE)
Begin DoDot:2
+17 SET IBETYP=+$ORDER(^IBE(356.6,"B","OUTPATIENT VISIT",0))
+18 SET X=$ORDER(^IBT(356,"APTY",DFN,IBETYP,($PIECE(I,".")-.0000001)))
IF $PIECE(X,".")=$PIECE(I,".")
SET IBTRN=$ORDER(^(X,0))
End DoDot:2
+19 IF '$GET(IBTRN)
QUIT
+20 SET IBRMARK=$$RMARK(IBTRN)
+21 QUIT
End DoDot:1
+22 ;
+23 ; -- if not in ct and parameter set to add, add to ct.
+24 IF '$GET(IBTRN)
IF $PIECE(IBTRKR,"^",23)
DO ADD
+25 ;
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 ; -- if outpatient, not before ct start date, opt tracking on
+19 IF 'IBINPT
IF I'<+IBTRKR
IF $PIECE(IBTRKR,"^",3)
IF I'>$$FMDIFF^XLFDT(DT,-2)
Begin DoDot:1
+20 ;
+21 NEW IBTDT
SET IBTDT=I
+22 NEW I,J,X,Y,DA,DR,DIC,DIE,IBETYP,IBTRN
+23 SET IBETYP=+$ORDER(^IBE(356.6,"B","OUTPATIENT VISIT",0))
+24 ;
+25 ; -- if encounter add encounter
+26 IF +$GET(IBOE)
Begin DoDot:2
+27 SET X=$PIECE($GET(^SCE(+IBOE,0)),"^",6)
IF X
IF X'=+IBOE
QUIT
+28 DO OPT^IBTUTL1(DFN,IBETYP,IBTDT,+IBOE)
QUIT
End DoDot:2
QUIT
+29 ;
+30 SET IBTDT=$PIECE(IBTDT,".")
+31 ; -- must not be before encounter is created
+32 IF IBTDT>($$FMDIFF^XLFDT(DT,-2))
QUIT
+33 ;
+34 ; -- see if already entry for same day.
+35 SET X=$ORDER(^IBT(356,"APTY",DFN,IBETYP,(IBTDT-.0000001)))
IF $PIECE(X,".")=IBTDT
QUIT
+36 DO ADDT^IBTUTL
+37 SET DA=IBTRN
SET DIE="^IBT(356,"
+38 IF IBTRN<1
QUIT
+39 LOCK +^IBT(356,+IBTRN):10
IF '$TEST
QUIT
+40 SET DR=".02////"_$GET(DFN)_";.06////"_IBTDT_";.18////"_IBETYP_";.2////1;.24////1;1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD^IBTUTL(IBETYP)
+41 DO ^DIE
+42 LOCK -^IBT(356,+IBTRN)
+43 QUIT
End DoDot:1
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)),"^")
