- 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 Jan 18, 2025@02:59:20 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