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