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

YSDXUTL.m

Go to the documentation of this file. 
  1. YSDXUTL ;ALB/RBD - DX CODE SET UTILITIES FOR MENTAL HEALTH ;04/02/2012
  1.  ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
  1.  ;
  1.  Q  ; Library utilities, do not enter from top.
  1.  ;
  1. ACTIVE(YSCS) ; Return start date for requested coding system
  1.  ;  Input:  Coding system abbreviation from #80.4 or #757.3
  1.  ;          ICD, ICP, 10D, 10P
  1.  ;
  1.  ;  Output:  n^FM date  where
  1.  ;           n = 0 ; requested coding system is not active
  1.  ;           n = 1 ; requested coding system is active
  1.  ;           FM date = starting date of requested code type
  1.  ;      or
  1.  ;           -1^error message ; coding system not valid
  1.  ;
  1.  N YSICDD,YSOUT,X,Y
  1.  S X=YSCS,DIC=80.4,DIC(0)="",D="C" D IX^DIC
  1.  I Y<0 Q "-1^Invalid Coding System"
  1.  S YSICDD=$$IMPDATE^LEXU(YSCS)
  1.  S YSOUT=$S(YSICDD'<DT:0,1:1)_U_YSICDD
  1.  K D,DIC
  1.  Q YSOUT
  1.  ;
  1. AVDX ; Build array of available Diagnosis Sets (Dx only, not Procedure Sets) in YSDXA("DX SET",fm-date)
  1.  ; [1] = IEN in #80.4
  1.  ; [2] = Code Set name
  1.  ; [3] = Code Set abbreviation
  1.  ; [4] = File number holding code set values (always 80 in this function)
  1.  ; [5] = Date that code set becomes active (FM format)
  1.  N YSMSG,YSI,YSD,YSR
  1.  K YSDXA
  1.  D LIST^DIC(80.4,"",".02;.03I;.04I","P","","","","","I $P(^(0),U,3)=80","","YSDXA","YSMSG")
  1.  Q:'$D(YSDXA("DILIST",0))
  1.  F YSI=1:1:$P(YSDXA("DILIST",0),U,1) D
  1.  . S YSR=YSDXA("DILIST",YSI,0),YSD=$P(YSR,U,5)
  1.  . S YSDXA("DX SET",YSD)=YSR
  1.  K YSDXA("DILIST")
  1.  Q
  1.  ;
  1. ACTDT(YSTRXD) ; Active Dx Code Set for date supplied
  1.  ; Input - a FileMan date
  1.  ; Returns 4 piece value:
  1.  ; [1] = Code Set abbreviation
  1.  ; [2] = IEN into file #80.4
  1.  ; [3] = Long name
  1.  ; [4] = Activation Date (FM)
  1.  ; or
  1.  ; 0 if no active Dx code set is found for the date supplied
  1.  ;
  1.  N YSDT,YSOUT,YSREC
  1.  D AVDX
  1.  I '$D(YSDXA("DX SET")) Q 0
  1.  S YSDT=0,YSOUT=0
  1.  F  S YSDT=$O(YSDXA("DX SET",YSDT)) Q:YSDT=""  D
  1.  . S YSREC=YSDXA("DX SET",YSDT)
  1.  . I YSTRXD'<YSDT S YSOUT=$P(YSREC,U,3)_U_$P(YSREC,U,1)_U_$P(YSREC,U,2)_U_$P(YSREC,U,5)
  1.  K YSDXA
  1.  Q YSOUT
  1.  ;
  1. DXVALID ;
  1.  N A,YSCODSET,YSDATA,YSDXDA,YSDXDATE,YSFILE,YSTYPE S YSDXDATE=$P(^YSD(627.8,DA,0),U,3)
  1.  I YSDXDATE="" S YSDXDATE=$G(DG("0;3"))
  1.  S A(1,"F")="!!",A(2)=" ",A(2,"F")="!!"
  1.  I YSDXDATE="" S A(1)="MISSING DIAGNOSIS DATE/TIME" D EN^DDIOL(.A) K X Q
  1.  S YSCODSET=$$ACTDT(YSDXDATE)
  1.  I YSCODSET=0 S A(1)="NO ICD CODE SET FOUND FOR DIAGNOSIS DATE/TIME SUPPLIED" D EN^DDIOL(.A) K X Q
  1.  S YSFILE=$P(X,";",2),YSDXDA=$P(X,";",1)
  1.  I YSFILE["YSD" D  Q
  1.  . S YSTYPE=$P(^YSD(627.7,YSDXDA,0),U,8) S:YSTYPE="" YSTYPE="9"
  1.  . I YSTYPE="9",$P(YSCODSET,U,1)'="ICD" D  Q
  1.  .. S A(1)="DIAGNOSIS DATE/TIME DOES NOT CORRELATE WITH DSM DIAGNOSIS CODE" D EN^DDIOL(.A) K X
  1.  . I YSTYPE="10",$P(YSCODSET,U,1)'="10D" D
  1.  .. S A(1)="DIAGNOSIS DATE/TIME DOES NOT CORRELATE WITH DSM DIAGNOSIS CODE" D EN^DDIOL(.A) K X
  1.  I YSFILE["ICD9" D
  1.  . S YSDATA=$$ICDDATA^ICDXCODE("DIAG",YSDXDA,YSDXDATE,"I")
  1.  . I $P(YSDATA,U,1)=-1 D
  1.  .. S A(1)="DIAGNOSIS DATE/TIME DOES NOT CORRELATE WITH ICD DIAGNOSIS CODE" D EN^DDIOL(.A) K X
  1.  Q
  1.  ;