- 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)),"^")
