IBTUTL ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ;21-JUN-93
;;2.0;INTEGRATED BILLING;**23,62,517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
ADM(DGPMCA,VAINDT,RANDOM,IBVSIT) ; -- set up info for adding a current admission
; -- Input DGPMCA = pointer for an admission to patient movement file
; VAINDT = optional date for admission (default is dt)
; RANDOM = whether or not this is a random sample
; IBVSIT = Pointer to visit file (optional)
;
N DA,DIC,DIE,DR,X,VAIN,VA,IBSCHED,IBSCH,HCSRIEN
I '$G(VAINDT) K VAINDT
I '$G(DGPMCA) S VA200="" D INP^VADPT S DGPMCA=VAIN(1)
Q:DGPMCA=""
S RANDOM=$S($G(RANDOM):1,1:0)
S X=$O(^IBT(356,"ADM",DFN,DGPMCA,0)) I X S IBTRN=X G ADMQ
S IBADMDT=$P(^DGPM(DGPMCA,0),"^")
;S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
S IBETYP=+$O(^IBE(356.6,"AC",1,0))
S (IBSCH,IBTRN)=$O(^IBT(356,"ASCH",+$$SCH^IBTRKR2(DGPMCA),0))
D:'IBTRN ADDT
I IBTRN<1 G ADMQ
S DA=IBTRN,DIE="^IBT(356,"
L +^IBT(356,+IBTRN):10 I '$T G ADMQ
S DR=$$ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM)
D ^DIE K DA,DR,DIE
I $P($G(^IBT(356,IBTRN,0)),"^",32) S DA=IBTRN,DR=".32///@",DIE="^IBT(356," D ^DIE K DA,DR,DIE
L -^IBT(356,+IBTRN)
I "^1^5^"[(U_IBETYP_U) S HCSRIEN=+$$FNDHCSR(DFN,IBADMDT) D:HCSRIEN HCSRCPY(HCSRIEN,IBTRN,DFN,IBADMDT)
;
S IBSCHED=$S($P(^DGPM(DGPMCA,0),U,25):10,1:20)
;
; -- if random sample add hospital review
I $P(^IBT(356,IBTRN,0),U,25) D PRE^IBTUTL2(DT,IBTRN,IBSCHED)
;
; -- if scheduled admission entry converted to admission, don't add
; second insurance review
I $G(IBSCH) G ADMQ
;
; -- if insured add ins review
I $P(^IBT(356,IBTRN,0),U,24) D COM^IBTUTL3(DT,IBTRN,IBSCHED,$G(IBTRV))
;
ADMQ Q
;
ADDT ; -- add new entry to tracking, ibt(356
;
N %DT,DD,DO,DIC,DR,DIE,DLAYGO,IBTR1,DINUM
L +^IBT(356,0):0 ;I '$T S Y="-1^IB085" G ADDTQ
;I $G(^IBT(356,0))="" S Y="-1^IB086" G ADDTQ
S X=$P($G(^IBT(356,0)),"^",3)+1 L -^IBT(356,0)
S DIC="^IBT(356,",DIC(0)="L",DLAYGO=356
F X=X:1 L:$D(IBTR1) -^IBT(356,IBTR1) I X>0,'$D(^IBT(356,X)) S IBTR1=X L +^IBT(356,IBTR1):1 I $T,'$D(^IBT(356,X)) S DINUM=X,X=($$IBSITE())_X D FILE^DICN I +Y>0 Q
L -^IBT(356,IBTR1)
I +Y<1 S Y="-1^IB087"
ADDTQ ;I +Y<0 D ^IBTERR
S IBTRN=+Y,IBNEW=1
Q
;
OTH(DFN,IBETYP,IBTDT) ; -- add miscellaneous entries, care may not be in data base
; -- input dfn := patient pointer to 2
; ibetyp := pointer to type entry in 356.6
; ibtdt := episode date
;
N X,Y,DA,DR,DIE,DIC
S X=$O(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0)) I X S IBTRN=X G OTHQ
D ADDT
I IBTRN<1 G OTHQ
S DA=IBTRN,DIE="^IBT(356,"
S DR=".02////"_$G(DFN)_";.06////"_+$G(IBTDT)_";.18////"_IBETYP_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,IBTDT)
L +^IBT(356,+IBTRN):10 I '$T G OTHQ
D ^DIE K DA,DR,DIE
L -^IBT(356,+IBTRN)
OTHQ Q
;
IBSITE() ; -- calculate site from site parameters
; -- output ibsite = station number
;
N IBFAC,IBSITE
D SITE^IBAUTL
Q IBSITE
;
ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM) ; -- set up dr string for admissions
S DR=""
I '$G(IBETYP)!'$G(IBADMDT) G ADMDRQ
S DR=".02////"_$G(DFN)_";.03////"_$G(IBVSIT)_";.05////"_$G(DGPMCA)_";.06////"_+$G(IBADMDT)_";.18////"_$G(IBETYP)_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,$G(IBADMDT)) D
.I $G(DGPMCA),$G(RANDOM) S DR=DR_";.25////1" Q
ADMDRQ Q DR
;
EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
; -- input IBETYPE = pointer to type of entry file
; IBTDT = episode date, if not passed in uses DT
;
N X,X1,X2,Y,IBETYPD S Y="" I '$G(IBETYP) G EABDQ
S IBETYPD=$G(^IBE(356.6,+IBETYP,0)) I '$G(IBTDT) S IBTDT=DT
I '$P(IBETYPD,"^",4) G EABDQ ; automated billing turned off
S X2=+$P(IBETYPD,"^",6) ;set earliest autobill date to entered date plus days delay
S X1=IBTDT D C^%DTC S Y=X\1
EABDQ Q Y
;
BILL(IBTRN) ;check if event is billable, return EABD if it is
N X,Y,Z,IBTRND S (X,Y)="" S IBTRND=$G(^IBT(356,+$G(IBTRN),0)) I IBTRND="" G BILLQ
;
; -- billed and bill not cancelled and not inpt interim first or continuous
I +$P(IBTRND,U,11) S Z=$$BILLED^IBCU8(IBTRN),Y=$P(Z,U,2) I +Z,'Y G BILLQ
;
; -- special type (not riem. ins), not billable, inactive
I +$P(IBTRND,U,12)!(+$P(IBTRND,U,19))!('$P(IBTRND,U,20)) G BILLQ
I 'Y S Y=+$G(^IBT(356,+$G(IBTRN),1)) I 'Y S Y=DT
S X=$$EABD(+$P(IBTRND,U,18),Y)
BILLQ Q X
;
STOBIL Q
KTOBIL Q
;
FNDHCSR(DFN,IBADMDT) ; find matching HCSR response in file 356.22
; DFN - file 2 ien
; IBADMDT - event date
;
; returns file 356.22 ien of matching response or null if no match found
;
N EVDT,HCSRIEN,RES,STOPFLG
S RES=""
I +$G(DFN)>0,+$G(IBADMDT)>0 D
.; loop through D-xref (by patient and event date)
.S STOPFLG=0,EVDT="" F S EVDT=$O(^IBT(356.22,"D",DFN,EVDT)) Q:EVDT=""!STOPFLG D
..; if match found, loop through entries for that patient and event date
..I $P(EVDT,"-")=IBADMDT S HCSRIEN=0 F S HCSRIEN=$O(^IBT(356.22,"D",DFN,EVDT,HCSRIEN)) Q:'HCSRIEN!STOPFLG D
...; check if this entry is a response
...I $$GET1^DIQ(356.22,HCSRIEN_",",.13,"I") S RES=HCSRIEN,STOPFLG=1
...Q
..Q
.Q
Q RES
;
HCSRCPY(HCSRIEN,IBTRN,DFN,EVNTDT) ; copy ref. # and auth. # from file 356.22 into file 356.2
; HCSRIEN - file 356.22 ien
; IBTRN - file 356 ien
; DFN - file 2 ien
; EVNTDT - event date from 356.22/.07
;
N CERT,FDA,FLD,HCSRIENS,IENS,IIEN,IMIEN,IRIEN,IRIENS,NUM
I +$G(HCSRIEN)>0,+$G(IBTRN)>0 D
.S HCSRIENS=HCSRIEN_","
.S CERT=$$GET1^DIQ(356.22,HCSRIENS,103.01)
.S NUM=$$GET1^DIQ(356.22,HCSRIENS,103.02,"I")
.S IMIEN=$$GET1^DIQ(356.22,HCSRIENS,.03) ;Insurance Multiple IEN
.S IENS=IMIEN_","_DFN_"," ;
.S IIEN=$$GET1^DIQ(2.312,IENS,.01,"I") ; Insurance Company IEN
.S FLD=2.01 ; default to ref. #, goes into 356.2/2.01
.I "^A1^A2^A6^"[(U_CERT_U) S FLD=2.02 ; it's an auth. #, goes into 356.2/2.02
.;
.;If there are no entries in 356.2 and it's outpatient, add an entry to 356.2
.I '$D(^IBT(356.2,"C",IBTRN)),$P($G(^IBT(356.22,RESIEN,0)),U,4)'="I" D ADD(EVNTDT,IBTRN,DFN,NUM,FLD,IIEN) Q
.;
.; find appropriate entries in file 356.2
.S IRIEN=0 F S IRIEN=$O(^IBT(356.2,"C",IBTRN,IRIEN)) Q:'IRIEN D
..S IRIENS=IRIEN_","
..Q:IIEN'=$$GET1^DIQ(356.2,IRIENS,.08,"I") ; don't set if it's not the correct insurance company
..S:$P($G(^IBT(356.2,IRIEN,2)),U,$S(FLD=2.02:2,1:1))="" FDA(356.2,IRIENS,FLD)=NUM
..D FILE^DIE(,"FDA") K FDA
..Q
.Q
Q
;
; add an entry to 365.2
; for outpatient if there isn't one already
ADD(EVNTDT,IBTRN,DFN,NUM,FLD,IIEN) ; -- add initial entry
; EVNTDT - EVNTDT (in internal fileman format)
; IBTRN - file 356 ien
; DFN - file 2 ien
; NUM - authorization or referral number
; FLD - field to file it it.
; IIEN - Insurance Company IEN
;
N FDA,HIP,IBDD,IBNXRV,IBTOC,ORDER,STOP
I $G(NUM)]"",$G(FLD)]"",+$G(IIEN) D
.;
.D ALL^IBCNS1(DFN,"IBDD",1,EVNTDT,1) ; return active insurances in COB order
.Q:'$G(IBDD(0)) ; no active insurance on that date
.;
.; get first insurance company that matches
.S ORDER=0 F S ORDER=$O(IBDD("S",ORDER)) Q:'ORDER D Q:HIP
..S HIP=0 F S HIP=$O(IBDD("S",ORDER,HIP)) Q:'HIP Q:+$G(IBDD(HIP,0))=IIEN
.Q:'$G(HIP) ; stop if none match
.;
.S FDA(356.2,"+1,",.01)=EVNTDT
.;
.;Pointer to claims tracking
.S FDA(356.2,"+1,",.02)=IBTRN
.S FDA(356.2,"+1,",.19)=1
.;
.;Type of Contact
.S IBTOC=$$FIND1^DIC(356.11,,"C","OUTPATIENT TREATMENT")
.S FDA(356.2,"+1,",.04)=IBTOC
.;
.;Patient
.S FDA(356.2,"+1,",.05)=DFN
.;
.; Health Insurance Policy
.S FDA(356.2,"+1,",1.05)=HIP
.;
.;File referal or authorization
.S FDA(356.2,"+1,",FLD)=NUM
.;
.; Next Review
.S IBNXRV=DT
.I EVNTDT>$$FMADD^XLFDT(DT,7) S IBNXRV=$$FMADD^XLFDT(EVNTDT,-7)
.S FDA(356.2,"+1,",.24)=IBNXRV
.;
.;Last Edit Date/By
.D NOW^%DTC
.S FDA(356.2,"+1,",1.01)=%
.S FDA(356.2,"+1,",1.02)=DUZ
.;
.D UPDATE^DIE(,"FDA") K FDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTUTL 8112 printed Oct 16, 2024@18:29:50 Page 2
IBTUTL ;ALB/AAS - CLAIMS TRACKING UTILITY ROUTINE ;21-JUN-93
+1 ;;2.0;INTEGRATED BILLING;**23,62,517**;21-MAR-94;Build 240
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
ADM(DGPMCA,VAINDT,RANDOM,IBVSIT) ; -- set up info for adding a current admission
+1 ; -- Input DGPMCA = pointer for an admission to patient movement file
+2 ; VAINDT = optional date for admission (default is dt)
+3 ; RANDOM = whether or not this is a random sample
+4 ; IBVSIT = Pointer to visit file (optional)
+5 ;
+6 NEW DA,DIC,DIE,DR,X,VAIN,VA,IBSCHED,IBSCH,HCSRIEN
+7 IF '$GET(VAINDT)
KILL VAINDT
+8 IF '$GET(DGPMCA)
SET VA200=""
DO INP^VADPT
SET DGPMCA=VAIN(1)
+9 if DGPMCA=""
QUIT
+10 SET RANDOM=$SELECT($GET(RANDOM):1,1:0)
+11 SET X=$ORDER(^IBT(356,"ADM",DFN,DGPMCA,0))
IF X
SET IBTRN=X
GOTO ADMQ
+12 SET IBADMDT=$PIECE(^DGPM(DGPMCA,0),"^")
+13 ;S IBETYP=+$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
+14 SET IBETYP=+$ORDER(^IBE(356.6,"AC",1,0))
+15 SET (IBSCH,IBTRN)=$ORDER(^IBT(356,"ASCH",+$$SCH^IBTRKR2(DGPMCA),0))
+16 if 'IBTRN
DO ADDT
+17 IF IBTRN<1
GOTO ADMQ
+18 SET DA=IBTRN
SET DIE="^IBT(356,"
+19 LOCK +^IBT(356,+IBTRN):10
IF '$TEST
GOTO ADMQ
+20 SET DR=$$ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM)
+21 DO ^DIE
KILL DA,DR,DIE
+22 IF $PIECE($GET(^IBT(356,IBTRN,0)),"^",32)
SET DA=IBTRN
SET DR=".32///@"
SET DIE="^IBT(356,"
DO ^DIE
KILL DA,DR,DIE
+23 LOCK -^IBT(356,+IBTRN)
+24 IF "^1^5^"[(U_IBETYP_U)
SET HCSRIEN=+$$FNDHCSR(DFN,IBADMDT)
if HCSRIEN
DO HCSRCPY(HCSRIEN,IBTRN,DFN,IBADMDT)
+25 ;
+26 SET IBSCHED=$SELECT($PIECE(^DGPM(DGPMCA,0),U,25):10,1:20)
+27 ;
+28 ; -- if random sample add hospital review
+29 IF $PIECE(^IBT(356,IBTRN,0),U,25)
DO PRE^IBTUTL2(DT,IBTRN,IBSCHED)
+30 ;
+31 ; -- if scheduled admission entry converted to admission, don't add
+32 ; second insurance review
+33 IF $GET(IBSCH)
GOTO ADMQ
+34 ;
+35 ; -- if insured add ins review
+36 IF $PIECE(^IBT(356,IBTRN,0),U,24)
DO COM^IBTUTL3(DT,IBTRN,IBSCHED,$GET(IBTRV))
+37 ;
ADMQ QUIT
+1 ;
ADDT ; -- add new entry to tracking, ibt(356
+1 ;
+2 NEW %DT,DD,DO,DIC,DR,DIE,DLAYGO,IBTR1,DINUM
+3 ;I '$T S Y="-1^IB085" G ADDTQ
LOCK +^IBT(356,0):0
+4 ;I $G(^IBT(356,0))="" S Y="-1^IB086" G ADDTQ
+5 SET X=$PIECE($GET(^IBT(356,0)),"^",3)+1
LOCK -^IBT(356,0)
+6 SET DIC="^IBT(356,"
SET DIC(0)="L"
SET DLAYGO=356
+7 FOR X=X:1
if $DATA(IBTR1)
LOCK -^IBT(356,IBTR1)
IF X>0
IF '$DATA(^IBT(356,X))
SET IBTR1=X
LOCK +^IBT(356,IBTR1):1
IF $TEST
IF '$DATA(^IBT(356,X))
SET DINUM=X
SET X=($$IBSITE())_X
DO FILE^DICN
IF +Y>0
QUIT
+8 LOCK -^IBT(356,IBTR1)
+9 IF +Y<1
SET Y="-1^IB087"
ADDTQ ;I +Y<0 D ^IBTERR
+1 SET IBTRN=+Y
SET IBNEW=1
+2 QUIT
+3 ;
OTH(DFN,IBETYP,IBTDT) ; -- add miscellaneous entries, care may not be in data base
+1 ; -- input dfn := patient pointer to 2
+2 ; ibetyp := pointer to type entry in 356.6
+3 ; ibtdt := episode date
+4 ;
+5 NEW X,Y,DA,DR,DIE,DIC
+6 SET X=$ORDER(^IBT(356,"APTY",DFN,IBETYP,IBTDT,0))
IF X
SET IBTRN=X
GOTO OTHQ
+7 DO ADDT
+8 IF IBTRN<1
GOTO OTHQ
+9 SET DA=IBTRN
SET DIE="^IBT(356,"
+10 SET DR=".02////"_$GET(DFN)_";.06////"_+$GET(IBTDT)_";.18////"_IBETYP_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,IBTDT)
+11 LOCK +^IBT(356,+IBTRN):10
IF '$TEST
GOTO OTHQ
+12 DO ^DIE
KILL DA,DR,DIE
+13 LOCK -^IBT(356,+IBTRN)
OTHQ QUIT
+1 ;
IBSITE() ; -- calculate site from site parameters
+1 ; -- output ibsite = station number
+2 ;
+3 NEW IBFAC,IBSITE
+4 DO SITE^IBAUTL
+5 QUIT IBSITE
+6 ;
ADMDR(IBADMDT,IBETYP,DGPMCA,RANDOM) ; -- set up dr string for admissions
+1 SET DR=""
+2 IF '$GET(IBETYP)!'$GET(IBADMDT)
GOTO ADMDRQ
+3 SET DR=".02////"_$GET(DFN)_";.03////"_$GET(IBVSIT)_";.05////"_$GET(DGPMCA)_";.06////"_+$GET(IBADMDT)_";.18////"_$GET(IBETYP)_";.2////1;.24////"_$$INSURED^IBCNS1(DFN)_";1.01///NOW;1.02////"_DUZ_";.17////"_$$EABD(IBETYP,$GET(IBADMDT))
Begin DoDot:1
+4 IF $GET(DGPMCA)
IF $GET(RANDOM)
SET DR=DR_";.25////1"
QUIT
End DoDot:1
ADMDRQ QUIT DR
+1 ;
EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
+1 ; -- input IBETYPE = pointer to type of entry file
+2 ; IBTDT = episode date, if not passed in uses DT
+3 ;
+4 NEW X,X1,X2,Y,IBETYPD
SET Y=""
IF '$GET(IBETYP)
GOTO EABDQ
+5 SET IBETYPD=$GET(^IBE(356.6,+IBETYP,0))
IF '$GET(IBTDT)
SET IBTDT=DT
+6 ; automated billing turned off
IF '$PIECE(IBETYPD,"^",4)
GOTO EABDQ
+7 ;set earliest autobill date to entered date plus days delay
SET X2=+$PIECE(IBETYPD,"^",6)
+8 SET X1=IBTDT
DO C^%DTC
SET Y=X\1
EABDQ QUIT Y
+1 ;
BILL(IBTRN) ;check if event is billable, return EABD if it is
+1 NEW X,Y,Z,IBTRND
SET (X,Y)=""
SET IBTRND=$GET(^IBT(356,+$GET(IBTRN),0))
IF IBTRND=""
GOTO BILLQ
+2 ;
+3 ; -- billed and bill not cancelled and not inpt interim first or continuous
+4 IF +$PIECE(IBTRND,U,11)
SET Z=$$BILLED^IBCU8(IBTRN)
SET Y=$PIECE(Z,U,2)
IF +Z
IF 'Y
GOTO BILLQ
+5 ;
+6 ; -- special type (not riem. ins), not billable, inactive
+7 IF +$PIECE(IBTRND,U,12)!(+$PIECE(IBTRND,U,19))!('$PIECE(IBTRND,U,20))
GOTO BILLQ
+8 IF 'Y
SET Y=+$GET(^IBT(356,+$GET(IBTRN),1))
IF 'Y
SET Y=DT
+9 SET X=$$EABD(+$PIECE(IBTRND,U,18),Y)
BILLQ QUIT X
+1 ;
STOBIL QUIT
KTOBIL QUIT
+1 ;
FNDHCSR(DFN,IBADMDT) ; find matching HCSR response in file 356.22
+1 ; DFN - file 2 ien
+2 ; IBADMDT - event date
+3 ;
+4 ; returns file 356.22 ien of matching response or null if no match found
+5 ;
+6 NEW EVDT,HCSRIEN,RES,STOPFLG
+7 SET RES=""
+8 IF +$GET(DFN)>0
IF +$GET(IBADMDT)>0
Begin DoDot:1
+9 ; loop through D-xref (by patient and event date)
+10 SET STOPFLG=0
SET EVDT=""
FOR
SET EVDT=$ORDER(^IBT(356.22,"D",DFN,EVDT))
if EVDT=""!STOPFLG
QUIT
Begin DoDot:2
+11 ; if match found, loop through entries for that patient and event date
+12 IF $PIECE(EVDT,"-")=IBADMDT
SET HCSRIEN=0
FOR
SET HCSRIEN=$ORDER(^IBT(356.22,"D",DFN,EVDT,HCSRIEN))
if 'HCSRIEN!STOPFLG
QUIT
Begin DoDot:3
+13 ; check if this entry is a response
+14 IF $$GET1^DIQ(356.22,HCSRIEN_",",.13,"I")
SET RES=HCSRIEN
SET STOPFLG=1
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 QUIT RES
+19 ;
HCSRCPY(HCSRIEN,IBTRN,DFN,EVNTDT) ; copy ref. # and auth. # from file 356.22 into file 356.2
+1 ; HCSRIEN - file 356.22 ien
+2 ; IBTRN - file 356 ien
+3 ; DFN - file 2 ien
+4 ; EVNTDT - event date from 356.22/.07
+5 ;
+6 NEW CERT,FDA,FLD,HCSRIENS,IENS,IIEN,IMIEN,IRIEN,IRIENS,NUM
+7 IF +$GET(HCSRIEN)>0
IF +$GET(IBTRN)>0
Begin DoDot:1
+8 SET HCSRIENS=HCSRIEN_","
+9 SET CERT=$$GET1^DIQ(356.22,HCSRIENS,103.01)
+10 SET NUM=$$GET1^DIQ(356.22,HCSRIENS,103.02,"I")
+11 ;Insurance Multiple IEN
SET IMIEN=$$GET1^DIQ(356.22,HCSRIENS,.03)
+12 ;
SET IENS=IMIEN_","_DFN_","
+13 ; Insurance Company IEN
SET IIEN=$$GET1^DIQ(2.312,IENS,.01,"I")
+14 ; default to ref. #, goes into 356.2/2.01
SET FLD=2.01
+15 ; it's an auth. #, goes into 356.2/2.02
IF "^A1^A2^A6^"[(U_CERT_U)
SET FLD=2.02
+16 ;
+17 ;If there are no entries in 356.2 and it's outpatient, add an entry to 356.2
+18 IF '$DATA(^IBT(356.2,"C",IBTRN))
IF $PIECE($GET(^IBT(356.22,RESIEN,0)),U,4)'="I"
DO ADD(EVNTDT,IBTRN,DFN,NUM,FLD,IIEN)
QUIT
+19 ;
+20 ; find appropriate entries in file 356.2
+21 SET IRIEN=0
FOR
SET IRIEN=$ORDER(^IBT(356.2,"C",IBTRN,IRIEN))
if 'IRIEN
QUIT
Begin DoDot:2
+22 SET IRIENS=IRIEN_","
+23 ; don't set if it's not the correct insurance company
if IIEN'=$$GET1^DIQ(356.2,IRIENS,.08,"I")
QUIT
+24 if $PIECE($GET(^IBT(356.2,IRIEN,2)),U,$SELECT(FLD=2.02
SET FDA(356.2,IRIENS,FLD)=NUM
+25 DO FILE^DIE(,"FDA")
KILL FDA
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 QUIT
+29 ;
+30 ; add an entry to 365.2
+31 ; for outpatient if there isn't one already
ADD(EVNTDT,IBTRN,DFN,NUM,FLD,IIEN) ; -- add initial entry
+1 ; EVNTDT - EVNTDT (in internal fileman format)
+2 ; IBTRN - file 356 ien
+3 ; DFN - file 2 ien
+4 ; NUM - authorization or referral number
+5 ; FLD - field to file it it.
+6 ; IIEN - Insurance Company IEN
+7 ;
+8 NEW FDA,HIP,IBDD,IBNXRV,IBTOC,ORDER,STOP
+9 IF $GET(NUM)]""
IF $GET(FLD)]""
IF +$GET(IIEN)
Begin DoDot:1
+10 ;
+11 ; return active insurances in COB order
DO ALL^IBCNS1(DFN,"IBDD",1,EVNTDT,1)
+12 ; no active insurance on that date
if '$GET(IBDD(0))
QUIT
+13 ;
+14 ; get first insurance company that matches
+15 SET ORDER=0
FOR
SET ORDER=$ORDER(IBDD("S",ORDER))
if 'ORDER
QUIT
Begin DoDot:2
+16 SET HIP=0
FOR
SET HIP=$ORDER(IBDD("S",ORDER,HIP))
if 'HIP
QUIT
if +$GET(IBDD(HIP,0))=IIEN
QUIT
End DoDot:2
if HIP
QUIT
+17 ; stop if none match
if '$GET(HIP)
QUIT
+18 ;
+19 SET FDA(356.2,"+1,",.01)=EVNTDT
+20 ;
+21 ;Pointer to claims tracking
+22 SET FDA(356.2,"+1,",.02)=IBTRN
+23 SET FDA(356.2,"+1,",.19)=1
+24 ;
+25 ;Type of Contact
+26 SET IBTOC=$$FIND1^DIC(356.11,,"C","OUTPATIENT TREATMENT")
+27 SET FDA(356.2,"+1,",.04)=IBTOC
+28 ;
+29 ;Patient
+30 SET FDA(356.2,"+1,",.05)=DFN
+31 ;
+32 ; Health Insurance Policy
+33 SET FDA(356.2,"+1,",1.05)=HIP
+34 ;
+35 ;File referal or authorization
+36 SET FDA(356.2,"+1,",FLD)=NUM
+37 ;
+38 ; Next Review
+39 SET IBNXRV=DT
+40 IF EVNTDT>$$FMADD^XLFDT(DT,7)
SET IBNXRV=$$FMADD^XLFDT(EVNTDT,-7)
+41 SET FDA(356.2,"+1,",.24)=IBNXRV
+42 ;
+43 ;Last Edit Date/By
+44 DO NOW^%DTC
+45 SET FDA(356.2,"+1,",1.01)=%
+46 SET FDA(356.2,"+1,",1.02)=DUZ
+47 ;
+48 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+49 QUIT
