Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FBCSV1

FBCSV1.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; References to API $$ICDOP^ICDEX supported by ICR 5747
  1. ; References to API $$ICDDX^ICDEX supported by ICR 5747
  1. ;
  1. ;wrapper for DRG^ICDGTDRG
  1. ;to use instead of direct read of ^ICD(
  1. ;FBIEN - ien of #80.2
  1. ;FBDATE - date of service (optional)
  1. ;returns (#.01) NAME of #80.2 or "" if invalid/error
  1. ICD(FBIEN,FBDATE) ;
  1. N FBRET
  1. S FBRET=$$DRG^ICDGTDRG($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE))
  1. Q:+FBRET<0 ""
  1. Q $P(FBRET,"^",1)
  1. ;
  1. ;wrapper for ICDOP^ICDCODE
  1. ;to use instead of direct read of ^ICD0(
  1. ;FBIEN - ien of #80.1
  1. ;FBDATE - date of service (optional)
  1. ;returns (#.01) NAME of #80.1 or "" if invalid/error
  1. ICD0(FBIEN,FBDATE) ;
  1. N FBRET
  1. ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
  1. S FBRET=$$ICDOP^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. Q:+FBRET<0 ""
  1. Q $P(FBRET,"^",2)
  1. ;
  1. ;wrapper for ICDDX^ICDCODE
  1. ;to use instead of direct read of ^ICD9(
  1. ;FBIEN - ien of #80
  1. ;FBDATE - date of service (optional)
  1. ;returns (#.01) NAME of #80 or "" if invalid/error
  1. ICD9(FBIEN,FBDATE) ;
  1. N FBRET
  1. ; DEM;139 ICD-10 Project - Replaced call to $$ICDDX^ICDCODE with
  1. ; call to $$ICDDX^ICDEX.
  1. S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. Q:+FBRET<0 ""
  1. Q $P(FBRET,"^",2)
  1. ;
  1. ;wrapper for ICDDX^ICDCODE with piece #
  1. ;to use instead of direct read of ^ICD9(
  1. ;FBIEN - ien of #80
  1. ;FBPC - piece #
  1. ;FBDATE (optional) - date of service
  1. ;returns piece # FBPC of #80 or "" if invalid/error
  1. 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. N FBRET
  1. ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
  1. S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. Q:+FBRET<0 ""
  1. Q $P(FBRET,"^",FBPC+1)
  1. ;
  1. ;extended wrapper for ICDDX^ICDCODE
  1. ;to use instead of direct read of ^ICD9(
  1. ;FBIEN - ien of #80
  1. ;FBPC - piece #
  1. ;FBEXTR - $E parameter
  1. ;FBDATE (optional) - date of service
  1. ;returns piece #FBPC and (#.01) NAME of #80 and or "" if invalid/error
  1. 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. N FBRET
  1. ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
  1. S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. Q:+FBRET<0 ""
  1. Q $E($P(FBRET,"^",FBPC+1),1,FBEXTR)_" ("_$P(FBRET,"^",2)_")"
  1. ;
  1. ;get FROM date from INVOICE file
  1. FRDTINV(FBDA) ;
  1. N FBRETDT
  1. S FBRETDT=$P($$B9DISCHG^FBAAV5(FBDA),"^",1) ; Discharge Date
  1. I FBRETDT="" S FBRETDT=$P($G(^FBAAI(FBDA,0)),"^",7) ; Treatment To DT
  1. I FBRETDT="" S FBRETDT=$P($G(^FBAAI(FBDA,0)),"^",6) ; Treatment Fr DT
  1. Q FBRETDT
  1. ;
  1. ;FB*3.5*139-ICD10 REMEDIATION-jlg- obtain FROM date from Unclaimed funds file (162.7)
  1. FRDTUC(FBDA) ;
  1. N FBRETDT
  1. S FBRETDT=$P($G(^FB583(FBDA,0)),"^",6) ; Treatment To DT/Discharge Date
  1. S:FBRETDT="" FBRETDT=$P($G(^FB583(FBDA,0)),"^",5) ; Treatment Fr DT
  1. Q FBRETDT
  1. ;
  1. ;if FBCODE="" returns FBNUM spaces
  1. ;otherwise returns FBCODE
  1. SPACES(FBCODE,FBNUM) ;
  1. I $L(FBCODE)=0 S $P(FBCODE," ",FBNUM)=" "
  1. Q FBCODE
  1. ;
  1. ;EVALUATE (sometimes can be used instead of "$S")
  1. ;if FBCODE="" returns FBRETV
  1. ;otherwise returns FBCODE
  1. EV(FBCODE,FBRETV) ;
  1. Q:$L(FBCODE)=0 FBRETV
  1. Q FBCODE
  1. ;
  1. ;converts a date to fileman format
  1. DT2FMDT(FBDAT) ;
  1. N X,Y
  1. S X=$$TRIM^XLFSTR(FBDAT)
  1. D ^%DT
  1. Q +Y
  1. ;
  1. ;wrapper for ICDDX^ICDCODE
  1. ;to use in prompts (and input templates)of file #162.5 to screen out
  1. ; inactive/invalid codes
  1. ;FBICD9 - ien of #80
  1. ;FBINV - ien of the current #162.5 record
  1. ;FBDATE - (optional) date of service
  1. ;returns 0 if code is active, otherwise - nonzero value
  1. INPICD9(FBICD9,FBINV,FBDATE) ;
  1. N FBRET
  1. ; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
  1. I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
  1. ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
  1. S FBRET=$$ICDDX^ICDEX($G(FBICD9),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. I +FBRET<0 W " Invalid Code " Q 2
  1. I $P(FBRET,"^",10)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
  1. Q 0
  1. ;
  1. ;wrapper for ICDOP^ICDCODE
  1. ;checks if code is active on the date of service and
  1. ;if active returns CODE NUMBER
  1. ;is inactive returns "" and prints message "ICD O/P Code inactive ..."
  1. ;is invalid/local returns "" and prints message "Invalid ICD O/P Code"
  1. CHKICD0(FBIEN,FBDATE) ;
  1. N FBRET
  1. ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
  1. S FBRET=$$ICDOP^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. I +FBRET<0 W " Invalid ICD O/P Code " Q ""
  1. I $P(FBRET,"^",10)=0 D Q ""
  1. . W !," ICD O/P Code "_$P(FBRET,"^",2)_" inactive"
  1. . W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
  1. Q $P(FBRET,"^",2)
  1. ;
  1. ;wrapper for ICDOP^ICDCODE
  1. ;to use in prompts (and input templates)of file #162.5 to screen out
  1. ; inactive/invalid codes
  1. ;FBICD0 - ien of #80.1
  1. ;FBINV - ien of the current #162.5 record
  1. ;FBDATE - (optional) date of service
  1. ;returns 0 if code is active, otherwise - nonzero value
  1. INPICD0(FBICD0,FBINV,FBDATE) ;
  1. N FBRET
  1. ; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
  1. I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
  1. ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
  1. S FBRET=$$ICDOP^ICDEX($G(FBICD0),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. I +FBRET<0 W " Invalid Code " Q 2
  1. I $P(FBRET,"^",10)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
  1. Q 0
  1. ;
  1. ;wrapper for DRG^ICDGTDRG
  1. ;to use in prompts (and input templates)of file #162.5 to screen out
  1. ; inactive/invalid codes
  1. ;FBICD - ien of #80.2
  1. ;FBINV - ien of the current #162.5 record
  1. ;FBDATE - (optional) date of service
  1. ;returns 0 if code is active, otherwise - nonzero value
  1. INPICD(FBICD,FBINV,FBDATE) ;
  1. N FBRET
  1. ; FB*3.5*139 Restored original line of code that was incorrectly modified in FB*3.5*94
  1. I '$G(FBDATE) S FBDATE=$$FRDTINV(+$G(FBINV))
  1. S FBRET=$$DRG^ICDGTDRG($G(FBICD),$S(+$G(FBDATE)=0:"",1:FBDATE))
  1. I +FBRET<0 W " Invalid Code " Q 2
  1. I $P(FBRET,"^",14)=0 W !," Code is inactive" W:$G(FBDATE)>0 " on "_$$FMTE^XLFDT(FBDATE) Q 1
  1. Q 0
  1. ;
  1. ;wrapper for ICDDX^ICDCODE
  1. ;checks if code is inactive on the date of service and
  1. ;if active returns CODE NUMBER
  1. ;is inactive returns "" and prints message "ICD Dx Code inactive ..."
  1. ;is invalid/local returns "" and prints message "Invalid ICD Dx Code"
  1. CHKICD9(FBIEN,FBDATE) ;
  1. N FBRET
  1. ;JAS - 4/2/13 - Patch 139 (ICD-10 Project) Modified next line.
  1. S FBRET=$$ICDDX^ICDEX($G(FBIEN),$S(+$G(FBDATE)=0:"",1:FBDATE),"","I")
  1. I +FBRET<0 W " Invalid ICD Dx Code " Q ""
  1. I $P(FBRET,"^",10)=0 D Q ""
  1. . W !," ICD Dx Code "_$P(FBRET,"^",2)_" inactive"
  1. . W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
  1. ;JAS - 7/18/14 - Patch 139 (ICD-10 Project) Added next section for Pending ICD-10 codes.
  1. I $P(FBRET,"^",10)=1,$P(FBRET,"^",17)>FBDATE D Q ""
  1. . W !," ICD Dx Code "_$P(FBRET,"^",2)_" invalid"
  1. . W:$G(FBDATE) " on date of service (",$$FMTE^XLFDT(FBDATE),")"
  1. Q $P(FBRET,"^",2)
  1. ;
  1. ;
  1. ;convert date as a string like "MMDDYYYY" into FM date like "YYYMMDD"
  1. STR2FBDT(FBDTSTR) ;
  1. N X,Y S X=FBDTSTR D ^%DT
  1. Q:Y=-1 ""
  1. Q Y\1
  1. ;
  1. IMPDATE(CSYS) ; Return the implementation date for a coding system
  1. Q $$IMPDATE^LEXU($G(CSYS))
  1. ;
  1. ;FBCSV1