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

FBICD9.m

Go to the documentation of this file. 
  1. FBICD9 ;AISC/JLG - ICD-9 DIAGNOSIS CODE UTILITIES ;3/14/2013
  1.  ;;3.5;FEE BASIS;**139**;JAN 30, 1995;Build 127
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; References to API $$IMPDATE^LEXU supported by ICR #5679
  1.  ; Reference to API $$FILE^ICDEX supported by ICR #5747
  1.  ; Reference to API $$ROOT^ICDEX supported by ICR #5747
  1.  ; Reference to API $$SYS^ICDEX supported by ICR #5747
  1.  ; Reference to API $$ICDDX^ICDEX supported by ICR #5747
  1.  ;
  1.  ; Input - FBIDT= date of interest to check  FBPRMT= user prompt  FBALW= allow user to early exit if set to Y 
  1.  ;         ALDEL= allow deletion of DX field? (optional)  -if this is set to "Y", @ is an acceptable entry
  1.  ;         ALFREQ= allow forcing a field to be required (optional)  -if this is set to "Y", the field will be forced to be required
  1.  ;         FBDFLT= default values for the search string (can be a code by default)
  1.  ; Output- Y = IEN^ICD9 code OR -1^inactive code"    
  1. ENICD9(FBIDT,FBPRMT,FBALW,ALDEL,ALFREQ,FBDFLT) ; prompt user for ICD9 diagnosis code and test if code is inactive
  1.  N X,Y,DIC,DIR
  1.  S:'$D(FBALW) FBALW="N" ; early exit allow flag
  1.  S:'$D(ALDEL) ALDEL="N" ; delete allow flag
  1.  S:'$D(ALFREQ) ALFREQ="N" ; force required allow flag
  1. SRCH1 ;
  1.  S Y=$$SEARCH(FBIDT)
  1.  I (Y>0)&('$$ICD9ACT(+Y,FBIDT)) D
  1.  . W !!,*7,"ICD Dx Code "_"("_$P(Y,U,2)_")"_" inactive on date of service ("_$$FMTE^XLFDT(FBIDT)_").",!
  1.  . S Y="-1^inactive code"
  1.  . Q
  1.  Q Y
  1.  ; 
  1.  ; Input  -FBINDT = ICD versioning date
  1.  ; Output -Y = IEN^ICD9 code    
  1.  I $G(FBDFLT)>0 S DIR("A")=FBPRMT_": "_$P($$ICDDX^ICDEX(FBDFLT,FBIDT,1,"I"),"^",2)_"// "
  1.  E  S DIR("A")=FBPRMT_": "
  1.  S DIR(0)="FAOr^0:245"
  1.  S DIR("?")="Answer with ICD DIAGNOSIS CODE NUMBER, or DESCRIPTION"
  1.  D ^DIR K DIR
  1.  I ((X="@")&(ALFREQ="Y")) W "??  REQUIRED" G SRCH1
  1.  I X="@",ALDEL="Y",$G(FBDFLT)="" S ALDEL="N"
  1.  I X="@",ALDEL="Y" N FBYN D  Q:FBYN=1 "@" G SRCH1
  1.  . S FBYN=$$QUESTION^FBASF(2,"SURE YOU WANT TO DELETE")
  1.  . I FBYN'=1 W "  <NOTHING DELETED>"
  1.  I X="@" W "??" G SRCH1
  1.  I X="^",FBALW="Y" Q -1
  1.  I X="^" W !,?4,"EXIT NOT ALLOWED ??" G SRCH1
  1.  N ROOT,FILE,SYS,ICDVDT,FILEID,SCREEN,DISFIL
  1.  S FILEID=80,SCREEN="I $$CHKVERS^FBICD9(+Y,FBINDT)",DISFIL="EIMQ"
  1.  S FILE=$$FILE^ICDEX($G(FILEID)) Q:+FILE'>0 -1
  1.  S (DIC,ROOT)=$$ROOT^ICDEX(FILE) Q:'$L(ROOT) -1
  1.  S DIC("S")=$S($L($G(SCREEN)):$G(SCREEN),1:"I 1")
  1.  S:$G(FBINDT) ICDVDT=$G(FBINDT)
  1.  S SYS=$$SYS^ICDEX(FILE,$G(ICDVDT)) S:+SYS>0 ICDSYS=+SYS
  1.  S DISFIL=$G(DISFIL,"EMQZ") S DISFIL=$TR(DISFIL,"L","") K DLAYGO
  1.  S DIC(0)=DISFIL D ^DIC K DIC,ICDSYS,ICDFMT
  1.  S:+($G(Y))'>0 Y=-1
  1.  G:((Y=-1)&($L(X)>0)) SRCH1
  1.  Q Y
  1.  ;
  1.  ;Input : Y (ien of file 80), (date of interest)
  1.  ;Output: 1 (true) or 0 (false)
  1. CHKVERS(FBDIRY,FBDT) ; return true (1) if diagnosis code is a current versioned ICD code, otherwise return false (0) 
  1.  N FBICDSYS,FBINF,FBIC9SYS
  1.  S FBICDSYS=$S(FBDT<$$IMPDATE^LEXU(30):1,1:30)            ; 1 = icd-9 version  30 = icd-10 version
  1.  S FBIC9SYS=$P($$ICDDX^ICDEX(FBDIRY,FBDT,"","I"),U,20) ; 1 = icd-9 version  30 = icd-10 version
  1.  Q:FBICDSYS=FBIC9SYS 1 ; returns true
  1.  Q 0 ; returns false
  1.  ;
  1. ICD9ACT(IEN,FBDT) ;Is the given code active for the date? (default-today)
  1.  N FBINF,FBRES
  1.  I '$G(FBDT) S FBDT=DT
  1.  S FBRES=0
  1.  S FBINF=$$ICDDX^ICDEX(IEN,FBDT,"","I")
  1.  I FBINF'<0,$P(FBINF,U,10) S FBRES=1
  1.  Q FBRES
  1.  ;