FBCSV1 ;WOIFO/SS - UTILITIES FOR CODE SET VERSIONING ;4/7/2003
;;3.5;FEE BASIS;**55,77,94,139**;JAN 30, 1995;Build 127
;;Per VA Directive 6402, this routine should not be modified.
;
; References to API $$ICDOP^ICDEX supported by ICR 5747
; References to API $$ICDDX^ICDEX supported by ICR 5747
;
;wrapper for DRG^ICDGTDRG
;to use instead of direct read of ^ICD(
;FBIEN - ien of #80.2
;FBDATE - date of service (optional)
;returns (#.01) NAME of #80.2 or "" if invalid/error
ICD(FBIEN,FBDATE) ;
N FBRET
S FBRET=$$DRG^ICDGTDRG($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE))
Q:+FBRET<0 ""
Q $P(FBRET,"^",1)
;
;wrapper for ICDOP^ICDCODE
;to use instead of direct read of ^ICD0(
;FBIEN - ien of #80.1
;FBDATE - date of service (optional)
;returns (#.01) NAME of #80.1 or "" if invalid/error
ICD0(FBIEN,FBDATE) ;
N FBRET
;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
S FBRET=$$ICDOP^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
Q:+FBRET<0 ""
Q $P(FBRET,"^",2)
;
;wrapper for ICDDX^ICDCODE
;to use instead of direct read of ^ICD9(
;FBIEN - ien of #80
;FBDATE - date of service (optional)
;returns (#.01) NAME of #80 or "" if invalid/error
ICD9(FBIEN,FBDATE) ;
N FBRET
; DEM;139 ICD-10 Project - Replaced call to $$ICDDX^ICDCODE with
; call to $$ICDDX^ICDEX.
S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
Q:+FBRET<0 ""
Q $P(FBRET,"^",2)
;
;wrapper for ICDDX^ICDCODE with piece #
;to use instead of direct read of ^ICD9(
;FBIEN - ien of #80
;FBPC - piece #
;FBDATE (optional) - date of service
;returns piece # FBPC of #80 or "" if invalid/error
ICD9P(FBIEN,FBPC,FBDATE) ; Will need to check calls to this tag for FBPC value as it may need to change - DRP 12/22/2011
N FBRET
;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
Q:+FBRET<0 ""
Q $P(FBRET,"^",FBPC+1)
;
;extended wrapper for ICDDX^ICDCODE
;to use instead of direct read of ^ICD9(
;FBIEN - ien of #80
;FBPC - piece #
;FBEXTR - $E parameter
;FBDATE (optional) - date of service
;returns piece #FBPC and (#.01) NAME of #80 and or "" if invalid/error
ICD9EX(FBIEN,FBPC,FBEXTR,FBDATE) ; Will need to check calls to this tag for FBPC value as it may need to change - DRP 12/22/2011
N FBRET
;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
Q:+FBRET<0 ""
Q $E($P(FBRET,"^",FBPC+1),1,FBEXTR)_" ("_$P(FBRET,"^",2)_")"
;
;get FROM date from INVOICE file
FRDTINV(FBDA) ;
N FBRETDT
S FBRETDT=$P($$B9DISCHG^FBAAV5(FBDA),"^",1) ; Discharge Date
I FBRETDT="" S FBRETDT=$P($G(^FBAAI(FBDA,0)),"^",7) ; Treatment To DT
I FBRETDT="" S FBRETDT=$P($G(^FBAAI(FBDA,0)),"^",6) ; Treatment Fr DT
Q FBRETDT
;
;FB*3.5*139-ICD10 REMEDIATION-jlg- obtain FROM date from Unclaimed funds file (162.7)
FRDTUC(FBDA) ;
N FBRETDT
S FBRETDT=$P($G(^FB583(FBDA,0)),"^",6) ; Treatment To DT/Discharge Date
S:FBRETDT="" FBRETDT=$P($G(^FB583(FBDA,0)),"^",5) ; Treatment Fr DT
Q FBRETDT
;
;if FBCODE="" returns FBNUM spaces
;otherwise returns FBCODE
SPACES(FBCODE,FBNUM) ;
I $L(FBCODE)=0 S $P(FBCODE," ",FBNUM)=" "
Q FBCODE
;
;EVALUATE (sometimes can be used instead of "$S")
;if FBCODE="" returns FBRETV
;otherwise returns FBCODE
EV(FBCODE,FBRETV) ;
Q:$L(FBCODE)=0 FBRETV
Q FBCODE
;
;converts a date to fileman format
DT2FMDT(FBDAT) ;
N X,Y
S X=$$TRIM^XLFSTR(FBDAT)
D ^%DT
Q +Y
;
;wrapper for ICDDX^ICDCODE
;to use in prompts (and input templates)of file #162.5 to screen out
; inactive/invalid codes
;FBICD9 - ien of #80
;FBINV - ien of the current #162.5 record
;FBDATE - (optional) date of service
;returns 0 if code is active, otherwise - nonzero value
INPICD9(FBICD9,FBINV,FBDATE) ;
N FBRET
; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
S FBRET=$$ICDDX^ICDEX($G(FBICD9),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
I +FBRET<0 W " Invalid Code " Q 2
I $P(FBRET,"^",10)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
Q 0
;
;wrapper for ICDOP^ICDCODE
;checks if code is active on the date of service and
;if active returns CODE NUMBER
;is inactive returns "" and prints message "ICD O/P Code inactive ..."
;is invalid/local returns "" and prints message "Invalid ICD O/P Code"
CHKICD0(FBIEN,FBDATE) ;
N FBRET
;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
S FBRET=$$ICDOP^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
I +FBRET<0 W " Invalid ICD O/P Code " Q ""
I $P(FBRET,"^",10)=0 D Q ""
. W !," ICD O/P Code "_$P(FBRET,"^",2)_" inactive"
. W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
Q $P(FBRET,"^",2)
;
;wrapper for ICDOP^ICDCODE
;to use in prompts (and input templates)of file #162.5 to screen out
; inactive/invalid codes
;FBICD0 - ien of #80.1
;FBINV - ien of the current #162.5 record
;FBDATE - (optional) date of service
;returns 0 if code is active, otherwise - nonzero value
INPICD0(FBICD0,FBINV,FBDATE) ;
N FBRET
; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
S FBRET=$$ICDOP^ICDEX($G(FBICD0),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
I +FBRET<0 W " Invalid Code " Q 2
I $P(FBRET,"^",10)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
Q 0
;
;wrapper for DRG^ICDGTDRG
;to use in prompts (and input templates)of file #162.5 to screen out
; inactive/invalid codes
;FBICD - ien of #80.2
;FBINV - ien of the current #162.5 record
;FBDATE - (optional) date of service
;returns 0 if code is active, otherwise - nonzero value
INPICD(FBICD,FBINV,FBDATE) ;
N FBRET
; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
S FBRET=$$DRG^ICDGTDRG($G(FBICD),$S(+$G(FBDATE)=0:"",1:FBDATE))
I +FBRET<0 W " Invalid Code " Q 2
I $P(FBRET,"^",14)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
Q 0
;
;wrapper for ICDDX^ICDCODE
;checks if code is inactive on the date of service and
;if active returns CODE NUMBER
;is inactive returns "" and prints message "ICD Dx Code inactive ..."
;is invalid/local returns "" and prints message "Invalid ICD Dx Code"
CHKICD9(FBIEN,FBDATE) ;
N FBRET
;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
I +FBRET<0 W " Invalid ICD Dx Code " Q ""
I $P(FBRET,"^",10)=0 D Q ""
. W !," ICD Dx Code "_$P(FBRET,"^",2)_" inactive"
. W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
;JAS - 7/18/14 - Patch 139 (ICD-10 Project) Added next section for Pending ICD-10 codes.
I $P(FBRET,"^",10)=1,$P(FBRET,"^",17)>FBDATE D Q ""
. W !," ICD Dx Code "_$P(FBRET,"^",2)_" invalid"
. W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
Q $P(FBRET,"^",2)
;
;
;convert date as a string like "MMDDYYYY" into FM date like "YYYMMDD"
STR2FBDT(FBDTSTR) ;
N X,Y S X=FBDTSTR D ^%DT
Q:Y=-1 ""
Q Y\1
;
IMPDATE(CSYS) ; Return the implementation date for a coding system
Q $$IMPDATE^LEXU($G(CSYS))
;
;FBCSV1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBCSV1 7631 printed Sep 23, 2025@19:34:12 Page 2
FBCSV1 ;WOIFO/SS - UTILITIES FOR CODE SET VERSIONING ;4/7/2003
+1 ;;3.5;FEE BASIS;**55,77,94,139**;JAN 30, 1995;Build 127
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; References to API $$ICDOP^ICDEX supported by ICR 5747
+5 ; References to API $$ICDDX^ICDEX supported by ICR 5747
+6 ;
+7 ;wrapper for DRG^ICDGTDRG
+8 ;to use instead of direct read of ^ICD(
+9 ;FBIEN - ien of #80.2
+10 ;FBDATE - date of service (optional)
+11 ;returns (#.01) NAME of #80.2 or "" if invalid/error
ICD(FBIEN,FBDATE) ;
+1 NEW FBRET
+2 SET FBRET=$$DRG^ICDGTDRG($GET(FBIEN),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE))
+3 if +FBRET<0
QUIT ""
+4 QUIT $PIECE(FBRET,"^",1)
+5 ;
+6 ;wrapper for ICDOP^ICDCODE
+7 ;to use instead of direct read of ^ICD0(
+8 ;FBIEN - ien of #80.1
+9 ;FBDATE - date of service (optional)
+10 ;returns (#.01) NAME of #80.1 or "" if invalid/error
ICD0(FBIEN,FBDATE) ;
+1 NEW FBRET
+2 ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
+3 SET FBRET=$$ICDOP^ICDEX($GET(FBIEN),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+4 if +FBRET<0
QUIT ""
+5 QUIT $PIECE(FBRET,"^",2)
+6 ;
+7 ;wrapper for ICDDX^ICDCODE
+8 ;to use instead of direct read of ^ICD9(
+9 ;FBIEN - ien of #80
+10 ;FBDATE - date of service (optional)
+11 ;returns (#.01) NAME of #80 or "" if invalid/error
ICD9(FBIEN,FBDATE) ;
+1 NEW FBRET
+2 ; DEM;139 ICD-10 Project - Replaced call to $$ICDDX^ICDCODE with
+3 ; call to $$ICDDX^ICDEX.
+4 SET FBRET=$$ICDDX^ICDEX($GET(FBIEN),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+5 if +FBRET<0
QUIT ""
+6 QUIT $PIECE(FBRET,"^",2)
+7 ;
+8 ;wrapper for ICDDX^ICDCODE with piece #
+9 ;to use instead of direct read of ^ICD9(
+10 ;FBIEN - ien of #80
+11 ;FBPC - piece #
+12 ;FBDATE (optional) - date of service
+13 ;returns piece # FBPC of #80 or "" if invalid/error
ICD9P(FBIEN,FBPC,FBDATE) ; Will need to check calls to this tag for FBPC value as it may need to change - DRP 12/22/2011
+1 NEW FBRET
+2 ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
+3 SET FBRET=$$ICDDX^ICDEX($GET(FBIEN),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+4 if +FBRET<0
QUIT ""
+5 QUIT $PIECE(FBRET,"^",FBPC+1)
+6 ;
+7 ;extended wrapper for ICDDX^ICDCODE
+8 ;to use instead of direct read of ^ICD9(
+9 ;FBIEN - ien of #80
+10 ;FBPC - piece #
+11 ;FBEXTR - $E parameter
+12 ;FBDATE (optional) - date of service
+13 ;returns piece #FBPC and (#.01) NAME of #80 and or "" if invalid/error
ICD9EX(FBIEN,FBPC,FBEXTR,FBDATE) ; Will need to check calls to this tag for FBPC value as it may need to change - DRP 12/22/2011
+1 NEW FBRET
+2 ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
+3 SET FBRET=$$ICDDX^ICDEX($GET(FBIEN),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+4 if +FBRET<0
QUIT ""
+5 QUIT $EXTRACT($PIECE(FBRET,"^",FBPC+1),1,FBEXTR)_" ("_$PIECE(FBRET,"^",2)_")"
+6 ;
+7 ;get FROM date from INVOICE file
FRDTINV(FBDA) ;
+1 NEW FBRETDT
+2 ; Discharge Date
SET FBRETDT=$PIECE($$B9DISCHG^FBAAV5(FBDA),"^",1)
+3 ; Treatment To DT
IF FBRETDT=""
SET FBRETDT=$PIECE($GET(^FBAAI(FBDA,0)),"^",7)
+4 ; Treatment Fr DT
IF FBRETDT=""
SET FBRETDT=$PIECE($GET(^FBAAI(FBDA,0)),"^",6)
+5 QUIT FBRETDT
+6 ;
+7 ;FB*3.5*139-ICD10 REMEDIATION-jlg- obtain FROM date from Unclaimed funds file (162.7)
FRDTUC(FBDA) ;
+1 NEW FBRETDT
+2 ; Treatment To DT/Discharge Date
SET FBRETDT=$PIECE($GET(^FB583(FBDA,0)),"^",6)
+3 ; Treatment Fr DT
if FBRETDT=""
SET FBRETDT=$PIECE($GET(^FB583(FBDA,0)),"^",5)
+4 QUIT FBRETDT
+5 ;
+6 ;if FBCODE="" returns FBNUM spaces
+7 ;otherwise returns FBCODE
SPACES(FBCODE,FBNUM) ;
+1 IF $LENGTH(FBCODE)=0
SET $PIECE(FBCODE," ",FBNUM)=" "
+2 QUIT FBCODE
+3 ;
+4 ;EVALUATE (sometimes can be used instead of "$S")
+5 ;if FBCODE="" returns FBRETV
+6 ;otherwise returns FBCODE
EV(FBCODE,FBRETV) ;
+1 if $LENGTH(FBCODE)=0
QUIT FBRETV
+2 QUIT FBCODE
+3 ;
+4 ;converts a date to fileman format
DT2FMDT(FBDAT) ;
+1 NEW X,Y
+2 SET X=$$TRIM^XLFSTR(FBDAT)
+3 DO ^%DT
+4 QUIT +Y
+5 ;
+6 ;wrapper for ICDDX^ICDCODE
+7 ;to use in prompts (and input templates)of file #162.5 to screen out
+8 ; inactive/invalid codes
+9 ;FBICD9 - ien of #80
+10 ;FBINV - ien of the current #162.5 record
+11 ;FBDATE - (optional) date of service
+12 ;returns 0 if code is active, otherwise - nonzero value
INPICD9(FBICD9,FBINV,FBDATE) ;
+1 NEW FBRET
+2 ; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
+3 IF '$GET(FBDATE)
SET FBDATE=$$FRDTINV(+$GET(FBINV))
+4 ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
+5 SET FBRET=$$ICDDX^ICDEX($GET(FBICD9),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+6 IF +FBRET<0
WRITE " Invalid Code "
QUIT 2
+7 IF $PIECE(FBRET,"^",10)=0
WRITE !," Code is inactive"
if $GET(FBDATE)>0
WRITE " on "_$$FMTE^XLFDT(FBDATE)
QUIT 1
+8 QUIT 0
+9 ;
+10 ;wrapper for ICDOP^ICDCODE
+11 ;checks if code is active on the date of service and
+12 ;if active returns CODE NUMBER
+13 ;is inactive returns "" and prints message "ICD O/P Code inactive ..."
+14 ;is invalid/local returns "" and prints message "Invalid ICD O/P Code"
CHKICD0(FBIEN,FBDATE) ;
+1 NEW FBRET
+2 ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
+3 SET FBRET=$$ICDOP^ICDEX($GET(FBIEN),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+4 IF +FBRET<0
WRITE " Invalid ICD O/P Code "
QUIT ""
+5 IF $PIECE(FBRET,"^",10)=0
Begin DoDot:1
+6 WRITE !," ICD O/P Code "_$PIECE(FBRET,"^",2)_" inactive"
+7 if $GET(FBDATE)
WRITE " on date of service (",$$FMTE^XLFDT(FBDATE),")"
End DoDot:1
QUIT ""
+8 QUIT $PIECE(FBRET,"^",2)
+9 ;
+10 ;wrapper for ICDOP^ICDCODE
+11 ;to use in prompts (and input templates)of file #162.5 to screen out
+12 ; inactive/invalid codes
+13 ;FBICD0 - ien of #80.1
+14 ;FBINV - ien of the current #162.5 record
+15 ;FBDATE - (optional) date of service
+16 ;returns 0 if code is active, otherwise - nonzero value
INPICD0(FBICD0,FBINV,FBDATE) ;
+1 NEW FBRET
+2 ; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
+3 IF '$GET(FBDATE)
SET FBDATE=$$FRDTINV(+$GET(FBINV))
+4 ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
+5 SET FBRET=$$ICDOP^ICDEX($GET(FBICD0),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+6 IF +FBRET<0
WRITE " Invalid Code "
QUIT 2
+7 IF $PIECE(FBRET,"^",10)=0
WRITE !," Code is inactive"
if $GET(FBDATE)>0
WRITE " on "_$$FMTE^XLFDT(FBDATE)
QUIT 1
+8 QUIT 0
+9 ;
+10 ;wrapper for DRG^ICDGTDRG
+11 ;to use in prompts (and input templates)of file #162.5 to screen out
+12 ; inactive/invalid codes
+13 ;FBICD - ien of #80.2
+14 ;FBINV - ien of the current #162.5 record
+15 ;FBDATE - (optional) date of service
+16 ;returns 0 if code is active, otherwise - nonzero value
INPICD(FBICD,FBINV,FBDATE) ;
+1 NEW FBRET
+2 ; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
+3 IF '$GET(FBDATE)
SET FBDATE=$$FRDTINV(+$GET(FBINV))
+4 SET FBRET=$$DRG^ICDGTDRG($GET(FBICD),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE))
+5 IF +FBRET<0
WRITE " Invalid Code "
QUIT 2
+6 IF $PIECE(FBRET,"^",14)=0
WRITE !," Code is inactive"
if $GET(FBDATE)>0
WRITE " on "_$$FMTE^XLFDT(FBDATE)
QUIT 1
+7 QUIT 0
+8 ;
+9 ;wrapper for ICDDX^ICDCODE
+10 ;checks if code is inactive on the date of service and
+11 ;if active returns CODE NUMBER
+12 ;is inactive returns "" and prints message "ICD Dx Code inactive ..."
+13 ;is invalid/local returns "" and prints message "Invalid ICD Dx Code"
CHKICD9(FBIEN,FBDATE) ;
+1 NEW FBRET
+2 ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
+3 SET FBRET=$$ICDDX^ICDEX($GET(FBIEN),$SELECT(+$GET(FBDATE)=0:"",1:FBDATE),"","I")
+4 IF +FBRET<0
WRITE " Invalid ICD Dx Code "
QUIT ""
+5 IF $PIECE(FBRET,"^",10)=0
Begin DoDot:1
+6 WRITE !," ICD Dx Code "_$PIECE(FBRET,"^",2)_" inactive"
+7 if $GET(FBDATE)
WRITE " on date of service (",$$FMTE^XLFDT(FBDATE),")"
End DoDot:1
QUIT ""
+8 ;JAS - 7/18/14 - Patch 139 (ICD-10 Project) Added next section for Pending ICD-10 codes.
+9 IF $PIECE(FBRET,"^",10)=1
IF $PIECE(FBRET,"^",17)>FBDATE
Begin DoDot:1
+10 WRITE !," ICD Dx Code "_$PIECE(FBRET,"^",2)_" invalid"
+11 if $GET(FBDATE)
WRITE " on date of service (",$$FMTE^XLFDT(FBDATE),")"
End DoDot:1
QUIT ""
+12 QUIT $PIECE(FBRET,"^",2)
+13 ;
+14 ;
+15 ;convert date as a string like "MMDDYYYY" into FM date like "YYYMMDD"
STR2FBDT(FBDTSTR) ;
+1 NEW X,Y
SET X=FBDTSTR
DO ^%DT
+2 if Y=-1
QUIT ""
+3 QUIT Y\1
+4 ;
IMPDATE(CSYS) ; Return the implementation date for a coding system
+1 QUIT $$IMPDATE^LEXU($GET(CSYS))
+2 ;
+3 ;FBCSV1
