- 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 Mar 13, 2025@21:23:27 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)),"^")
