IBFBUTIL ;ALB/RED - API for EDI-CPAC (IB*2.0*554) ;10/01/15
;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
;Per VA Directive 6402, this routine should not be modified.
;
Q ; Routine cannot be called directly
;
;Special note: We are creating and using a few new global nodes in file #360 that are not defined in FM.
; If they are defined in FM we lose control over them, and a re-index could cause them to get reset causing possible data corruption.
; They only exist as temporary flags for our work list functionality.
;
; ^IBFB(360,"DFN",DFN,DT,IEN,IBLOG)="" Log cross reference by Patient
; ^IBFB(360,"DT",DT,DFN,IEN,IBLOG)="" Log cross reference by Date
;
EVENT(DFN) ; IB*2.0*554
;Input: DFN
;Output: none
Q ; DO NOT LOG AUTHS FOR THE TIME BEING - WORKLIST HAS BEEN DISABLED
N DIKIEN,AUTH,IENS,IBFBDT,FDA,IBIENS,IBEVENT,IBLOG,IBMOD,DELFLG,IENROOT,IEN,LOGIEN
S (IEN,DIKIEN,IENS)=0
S DELFLG=$G(D) ;Kill entry flag
I $G(DA)'="",DA'=DFN S AUTH=DA
I $G(AUTH)="",$G(D1)'="" S AUTH=D1
S DK=$G(DK)
I 'DK,$G(DIVAL)="" S:$G(DIVALUE)'="" DIVAL=DIVALUE ;(From Date verification)
Q:'$G(DFN)
Q:'$G(AUTH)
S IBFBDT=$$NOW^XLFDT() ;Used for date/time
;Add entry into IBFB TRACKING file (#360)
S IBIENS="+1,",IENS=$P(^IBFB(360,0),U,3)+1
;For deleted Auth's remove a few entries and set a delete date
I DELFLG D
. K FDA
. S DIKIEN=$O(^IBFB(360,"D",DFN,AUTH,0)) Q:DIKIEN=""
. S FDA(360,DIKIEN_",",.03)="@",FDA(360,DIKIEN_",",.04)=IBFBDT ;If Auth is deleted only delete the entry in that field, leaving the other entries
. K ^IBFB(360,"IV",DIKIEN)
;Add/edit
I 'DELFLG D
. K FDA
. S FDA(360,IBIENS,.01)=IENS,FDA(360,IBIENS,.02)=DFN,FDA(360,IBIENS,.03)=AUTH ;,FDA(360,IBIENS,.09)=IBFBDT
. S IENROOT="" ; Adding new entry)
I 'DELFLG D UPDATE^DIE("","FDA","IENROOT")
I DELFLG D UPDATE^DIE("","FDA")
S IEN=+$G(IENROOT(1))
I 'IEN,$G(DIKIEN)'="" S IEN=$G(DIKIEN)
Q:'IEN
D ;SET LOG FILE ENTRIES
. K FDA N IENROOT S IENROOT=""
. S FDA(360.04,"+1,"_IEN_",",.01)=IBFBDT,FDA(360.04,"+1,"_IEN_",",.03)=DUZ
. S IBMOD=0,IBLOG=$P($G(^IBFB(360,IENS,4,0)),U,3)
. I IBLOG'="" S IBMOD=1
. S IBEVENT=$S(DELFLG:"Auth deleted",IBMOD=0:"Auth log-IV queue",1:"Auth mod-IV queue")
. S FDA(360.04,"+1,"_IEN_",",.02)=IBEVENT
. D UPDATE^DIE("","FDA","IENROOT")
;LOG ENTRY AND CROSS REFERENCES
I 'DELFLG S IEN=IENROOT(1) D
. ;Set IEN in IV field/cross-reference
. K FDA
. S FDA(360,IEN_",",2.01)="IV"
. D UPDATE^DIE("","FDA")
; These cannot easily be set in FM, we don't have a date and we can't easily get the IBLOG IEN
S LOGIEN=0,LOGIEN=$P(^IBFB(360,IEN,4,0),U,3)
S ^IBFB(360,"DFN",DFN,IBFBDT,IEN,LOGIEN)="",^IBFB(360,"DT",IBFBDT,DFN,IEN,LOGIEN)=""
Q
;
GETAUTH(IENS,AUTHARR) ; API to call Authorization Data
D GETS^DIQ(161.01,IENS,".01;.02;.021;.03;.04;.055;.06;.065;.07;.08;.085;.086;.087;.095;.096;.097;101;104;105","IEN",AUTHARR)
Q
;
GETST(IEN) ; Get Start Date using Invoice
N IBFLDS,IBINIEN,IBINLN1,IBFBLN2,IBFPNO1
S IBINV=$$GET1^DIQ(360,IEN_",",1.03,"I") ; Invoice #
S IBFPNO=$$GET1^DIQ(161.01,IBIEN_",",.03,"I") ; NVC IEN (Type) on FEE BASIS PROGRAM File (#161.8)
; For Billing Worklist Only, NVC may have changed -- Check Fee Basis Payment File (#162)
I IBINV'="" D
. S IBINIEN=$O(^FBAAC("C",IBINV,DFN,""))
. S IBINLN1=$O(^FBAAC("C",IBINV,DFN,IBINIEN,""))
. S IBINLN2=$O(^FBAAC("C",IBINV,DFN,IBINIEN,IBINLN1,""))
. S IBFPNO1=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",23,"I")
. S IBFPNOT=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",23,"E")
. S IBFPNUM=IBFPNO1
. I $G(IBFPNOT)'="" S IBFP=IBFPNOT
. S IBST=$$GET1^DIQ(162.02,IBINLN1_","_IBINIEN_","_DFN_",",".01","I") ; Initial Treatment Date
Q
;
GETPAY(IEN) ; Get NVC Payment Data using Invoice
N IBFLDS,IBINIEN,IBINLN1,IBINLN2,IBFPNO1,IBFBVP
S IBINV=$$GET1^DIQ(360,IEN_",",1.03,"I") ; Invoice #
S IBFPNO=$$GET1^DIQ(161.01,IBIEN_",",.03,"I") ; NVC IEN (Type) on FEE BASIS PROGRAM File (#161.8)
; For Billing Worklist Only, NVC may have changed -- Check Fee Basis Payment File (#162)
I IBINV'="" D
. S IBINIEN=""
. F S IBINIEN=$O(^FBAAC("C",IBINV,DFN,IBINIEN)) Q:IBINIEN="" D
.. S IBINLN1=""
.. F S IBINLN1=$O(^FBAAC("C",IBINV,DFN,IBINIEN,IBINLN1)) Q:IBINLN1="" D
... S IBINLN2=""
... F S IBINLN2=$O(^FBAAC("C",IBINV,DFN,IBINIEN,IBINLN1,IBINLN2)) Q:IBINLN2="" D
.... S IBFPNO1=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",23,"I")
.... I $G(IBFPNO1)'="" S IBFPNO=IBFPNO1
.... S IBFBVP=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",24,"I")
.... I IBFBVP="VP" Q
.... S IBFLDS=".01;2;26;28;63;64;65"
.... D GETS^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",IBFLDS,"I","IBRET") ; Get Payment Data
Q
;
CHKBILL(IBIN) ;Check for prior bill
N IBINV,IBFBDT,IBCLM,IBFBAU
S IBINV=$TR(IBIN," ","")
S IBFBDT=""
F S IBFBDT=$O(^IBFB(360,"DFN",DFN,IBFBDT)) Q:IBFBDT="" D
. S IBFBAU=""
. F S IBFBAU=$O(^IBFB(360,"DFN",DFN,IBFBDT,IBFBAU)) Q:IBFBAU="" D
.. I $P($G(^IBFB(360,IBFBAU,1)),U,3)=IBINV D
... S IBCLM=$$GET1^DIQ(360,IBFBAU_",",1.01,"I")
... I IBCLM'="" S FBINAU=$$PRECRT^IBTRC1(IBCLM,18)
... S FBBILL=$$GET1^DIQ(360,IBFBAU_",",1.02,"I")
... I FBBILL'="" S FBSKIP=1
Q
;
GETDTS(IBIEN) ;Get Begin and End Dates from Authorization
S IBST=$$GET1^DIQ(161.01,IBIEN_",",.01,"I")
S IBEND=$$GET1^DIQ(161.01,IBIEN_",",.02,"I")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBFBUTIL 5477 printed Oct 16, 2024@18:23 Page 2
IBFBUTIL ;ALB/RED - API for EDI-CPAC (IB*2.0*554) ;10/01/15
+1 ;;2.0;INTEGRATED BILLING;**554**;21-MAR-94;Build 81
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Routine cannot be called directly
QUIT
+5 ;
+6 ;Special note: We are creating and using a few new global nodes in file #360 that are not defined in FM.
+7 ; If they are defined in FM we lose control over them, and a re-index could cause them to get reset causing possible data corruption.
+8 ; They only exist as temporary flags for our work list functionality.
+9 ;
+10 ; ^IBFB(360,"DFN",DFN,DT,IEN,IBLOG)="" Log cross reference by Patient
+11 ; ^IBFB(360,"DT",DT,DFN,IEN,IBLOG)="" Log cross reference by Date
+12 ;
EVENT(DFN) ; IB*2.0*554
+1 ;Input: DFN
+2 ;Output: none
+3 ; DO NOT LOG AUTHS FOR THE TIME BEING - WORKLIST HAS BEEN DISABLED
QUIT
+4 NEW DIKIEN,AUTH,IENS,IBFBDT,FDA,IBIENS,IBEVENT,IBLOG,IBMOD,DELFLG,IENROOT,IEN,LOGIEN
+5 SET (IEN,DIKIEN,IENS)=0
+6 ;Kill entry flag
SET DELFLG=$GET(D)
+7 IF $GET(DA)'=""
IF DA'=DFN
SET AUTH=DA
+8 IF $GET(AUTH)=""
IF $GET(D1)'=""
SET AUTH=D1
+9 SET DK=$GET(DK)
+10 ;(From Date verification)
IF 'DK
IF $GET(DIVAL)=""
if $GET(DIVALUE)'=""
SET DIVAL=DIVALUE
+11 if '$GET(DFN)
QUIT
+12 if '$GET(AUTH)
QUIT
+13 ;Used for date/time
SET IBFBDT=$$NOW^XLFDT()
+14 ;Add entry into IBFB TRACKING file (#360)
+15 SET IBIENS="+1,"
SET IENS=$PIECE(^IBFB(360,0),U,3)+1
+16 ;For deleted Auth's remove a few entries and set a delete date
+17 IF DELFLG
Begin DoDot:1
+18 KILL FDA
+19 SET DIKIEN=$ORDER(^IBFB(360,"D",DFN,AUTH,0))
if DIKIEN=""
QUIT
+20 ;If Auth is deleted only delete the entry in that field, leaving the other entries
SET FDA(360,DIKIEN_",",.03)="@"
SET FDA(360,DIKIEN_",",.04)=IBFBDT
+21 KILL ^IBFB(360,"IV",DIKIEN)
End DoDot:1
+22 ;Add/edit
+23 IF 'DELFLG
Begin DoDot:1
+24 KILL FDA
+25 ;,FDA(360,IBIENS,.09)=IBFBDT
SET FDA(360,IBIENS,.01)=IENS
SET FDA(360,IBIENS,.02)=DFN
SET FDA(360,IBIENS,.03)=AUTH
+26 ; Adding new entry)
SET IENROOT=""
End DoDot:1
+27 IF 'DELFLG
DO UPDATE^DIE("","FDA","IENROOT")
+28 IF DELFLG
DO UPDATE^DIE("","FDA")
+29 SET IEN=+$GET(IENROOT(1))
+30 IF 'IEN
IF $GET(DIKIEN)'=""
SET IEN=$GET(DIKIEN)
+31 if 'IEN
QUIT
+32 ;SET LOG FILE ENTRIES
Begin DoDot:1
+33 KILL FDA
NEW IENROOT
SET IENROOT=""
+34 SET FDA(360.04,"+1,"_IEN_",",.01)=IBFBDT
SET FDA(360.04,"+1,"_IEN_",",.03)=DUZ
+35 SET IBMOD=0
SET IBLOG=$PIECE($GET(^IBFB(360,IENS,4,0)),U,3)
+36 IF IBLOG'=""
SET IBMOD=1
+37 SET IBEVENT=$SELECT(DELFLG:"Auth deleted",IBMOD=0:"Auth log-IV queue",1:"Auth mod-IV queue")
+38 SET FDA(360.04,"+1,"_IEN_",",.02)=IBEVENT
+39 DO UPDATE^DIE("","FDA","IENROOT")
End DoDot:1
+40 ;LOG ENTRY AND CROSS REFERENCES
+41 IF 'DELFLG
SET IEN=IENROOT(1)
Begin DoDot:1
+42 ;Set IEN in IV field/cross-reference
+43 KILL FDA
+44 SET FDA(360,IEN_",",2.01)="IV"
+45 DO UPDATE^DIE("","FDA")
End DoDot:1
+46 ; These cannot easily be set in FM, we don't have a date and we can't easily get the IBLOG IEN
+47 SET LOGIEN=0
SET LOGIEN=$PIECE(^IBFB(360,IEN,4,0),U,3)
+48 SET ^IBFB(360,"DFN",DFN,IBFBDT,IEN,LOGIEN)=""
SET ^IBFB(360,"DT",IBFBDT,DFN,IEN,LOGIEN)=""
+49 QUIT
+50 ;
GETAUTH(IENS,AUTHARR) ; API to call Authorization Data
+1 DO GETS^DIQ(161.01,IENS,".01;.02;.021;.03;.04;.055;.06;.065;.07;.08;.085;.086;.087;.095;.096;.097;101;104;105","IEN",AUTHARR)
+2 QUIT
+3 ;
GETST(IEN) ; Get Start Date using Invoice
+1 NEW IBFLDS,IBINIEN,IBINLN1,IBFBLN2,IBFPNO1
+2 ; Invoice #
SET IBINV=$$GET1^DIQ(360,IEN_",",1.03,"I")
+3 ; NVC IEN (Type) on FEE BASIS PROGRAM File (#161.8)
SET IBFPNO=$$GET1^DIQ(161.01,IBIEN_",",.03,"I")
+4 ; For Billing Worklist Only, NVC may have changed -- Check Fee Basis Payment File (#162)
+5 IF IBINV'=""
Begin DoDot:1
+6 SET IBINIEN=$ORDER(^FBAAC("C",IBINV,DFN,""))
+7 SET IBINLN1=$ORDER(^FBAAC("C",IBINV,DFN,IBINIEN,""))
+8 SET IBINLN2=$ORDER(^FBAAC("C",IBINV,DFN,IBINIEN,IBINLN1,""))
+9 SET IBFPNO1=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",23,"I")
+10 SET IBFPNOT=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",23,"E")
+11 SET IBFPNUM=IBFPNO1
+12 IF $GET(IBFPNOT)'=""
SET IBFP=IBFPNOT
+13 ; Initial Treatment Date
SET IBST=$$GET1^DIQ(162.02,IBINLN1_","_IBINIEN_","_DFN_",",".01","I")
End DoDot:1
+14 QUIT
+15 ;
GETPAY(IEN) ; Get NVC Payment Data using Invoice
+1 NEW IBFLDS,IBINIEN,IBINLN1,IBINLN2,IBFPNO1,IBFBVP
+2 ; Invoice #
SET IBINV=$$GET1^DIQ(360,IEN_",",1.03,"I")
+3 ; NVC IEN (Type) on FEE BASIS PROGRAM File (#161.8)
SET IBFPNO=$$GET1^DIQ(161.01,IBIEN_",",.03,"I")
+4 ; For Billing Worklist Only, NVC may have changed -- Check Fee Basis Payment File (#162)
+5 IF IBINV'=""
Begin DoDot:1
+6 SET IBINIEN=""
+7 FOR
SET IBINIEN=$ORDER(^FBAAC("C",IBINV,DFN,IBINIEN))
if IBINIEN=""
QUIT
Begin DoDot:2
+8 SET IBINLN1=""
+9 FOR
SET IBINLN1=$ORDER(^FBAAC("C",IBINV,DFN,IBINIEN,IBINLN1))
if IBINLN1=""
QUIT
Begin DoDot:3
+10 SET IBINLN2=""
+11 FOR
SET IBINLN2=$ORDER(^FBAAC("C",IBINV,DFN,IBINIEN,IBINLN1,IBINLN2))
if IBINLN2=""
QUIT
Begin DoDot:4
+12 SET IBFPNO1=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",23,"I")
+13 IF $GET(IBFPNO1)'=""
SET IBFPNO=IBFPNO1
+14 SET IBFBVP=$$GET1^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",24,"I")
+15 IF IBFBVP="VP"
QUIT
+16 SET IBFLDS=".01;2;26;28;63;64;65"
+17 ; Get Payment Data
DO GETS^DIQ(162.03,IBINLN2_","_IBINLN1_","_IBINIEN_","_DFN_",",IBFLDS,"I","IBRET")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
CHKBILL(IBIN) ;Check for prior bill
+1 NEW IBINV,IBFBDT,IBCLM,IBFBAU
+2 SET IBINV=$TRANSLATE(IBIN," ","")
+3 SET IBFBDT=""
+4 FOR
SET IBFBDT=$ORDER(^IBFB(360,"DFN",DFN,IBFBDT))
if IBFBDT=""
QUIT
Begin DoDot:1
+5 SET IBFBAU=""
+6 FOR
SET IBFBAU=$ORDER(^IBFB(360,"DFN",DFN,IBFBDT,IBFBAU))
if IBFBAU=""
QUIT
Begin DoDot:2
+7 IF $PIECE($GET(^IBFB(360,IBFBAU,1)),U,3)=IBINV
Begin DoDot:3
+8 SET IBCLM=$$GET1^DIQ(360,IBFBAU_",",1.01,"I")
+9 IF IBCLM'=""
SET FBINAU=$$PRECRT^IBTRC1(IBCLM,18)
+10 SET FBBILL=$$GET1^DIQ(360,IBFBAU_",",1.02,"I")
+11 IF FBBILL'=""
SET FBSKIP=1
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
GETDTS(IBIEN) ;Get Begin and End Dates from Authorization
+1 SET IBST=$$GET1^DIQ(161.01,IBIEN_",",.01,"I")
+2 SET IBEND=$$GET1^DIQ(161.01,IBIEN_",",.02,"I")
+3 QUIT
+4 ;
