YSDX3U ;SLC/DJP/LJA - Utilities for Diagnoses Entered in MH Med Record ;13 May 2013 12:43 PM
;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
;D RECORD^YSDX0001("^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
;
END K YSDXDAT D END^YSDX3U00 ;->
QUIT
;
LIST ; Called by routines YSDX3, YSDX3A, YSDX3U
; List diagnoses on file for a specific patient
;D RECORD^YSDX0001("LIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
K YSDXN,YSDXNN,YSDXST,YSMOD,YSDXDT,YSNO S N1=0
I '$O(^YSD(627.8,"AC",YSDFN,0)) D QUIT ;->
. W !?10,"No diagnoses on file for ",YSNM S YSNO=1
;
AXIS1 ; DSM display
;D RECORD^YSDX0001("AXIS1^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
I YSAX=1 D
. S L2=0
. F S L2=$O(^YSD(627.8,"AC",YSDFN,L2)) Q:'L2 D
. . S L3=""
. . F S L3=$O(^YSD(627.8,"AC",YSDFN,L2,L3)) Q:L3="" I $P(L3,";",2)["YSD" D SELECTL
AXIS3 ; ICD9/ICD10 Display
;D RECORD^YSDX0001("AXIS3^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
I YSAX=3 D
. S L2=0
. F S L2=$O(^YSD(627.8,"AC",YSDFN,L2)) Q:'L2 D
. . S L3=""
. . F S L3=$O(^YSD(627.8,"AC",YSDFN,L2,L3)) Q:L3="" I $P(L3,";",2)["ICD" D SELECTL
QUIT
;
SELECTL ;
;D RECORD^YSDX0001("SELECTL^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
S L4=""
F S L4=$O(^YSD(627.8,"AC",YSDFN,L2,L3,L4)) Q:L4="" D
. S L5=0
. F S L5=$O(^YSD(627.8,"AC",YSDFN,L2,L3,L4,L5)) Q:'L5 D STATUS,ALST:YSDTY="A",ILST:YSDTY="I",IRNLST:YSDTY="IRN"
QUIT
STATUS ;
;D RECORD^YSDX0001("STATUS^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
S L9=$P(^YSD(627.8,L5,1),U,2)
S:L9="i" F1=1
S:"rn"[L9!($P(^YSD(627.8,L5,1),U,4)="I") F2=1
QUIT
;
ALST ;
;D RECORD^YSDX0001("ALST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
D:L4="A" PLIST
QUIT
;
ILST ;
;D RECORD^YSDX0001("ILST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
D:L9="i" PLIST
QUIT
;
IRNLST ;
;D RECORD^YSDX0001("IRNLST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
D:L4="I" PLIST
QUIT
;
PLIST ;Sets variables for print of list line
;
; Axis 1
;D RECORD^YSDX0001("PLIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
S YSDXCSTX=""
I YSAX=1 D
. S P3=$P(L3,";",2)
. S P4=$P(L3,";")
. S P5="^"_P3_P4_","_0_")"
. S P50=@P5
. S YSDXN=^YSD(627.7,+P4,"D") ; Diagnosis name
. S YSDXNN=$P(P50,U) ; ICD#
. S YSDXCSTX="(ICD-"_$S($P(P50,U,8)'="":$P(P50,U,8),1:"9")_")"
;
; Axis 3
I YSAX=3 D
. S P3=$P(L3,";",2)
. S P4=$P(L3,";")
. S P5="^"_P3_P4_","_0_")"
. S P50=@P5
. N YSDXDATA S YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",P4,$P(^YSD(627.8,L5,0),U,3),"I")
. S YSDXNN=$P(YSDXDATA,U,2) ; Diagnosis name
. S YSDXCSTX=$P($P($$SINFO^ICDEX($P(YSDXDATA,U,20)),U,2),"-",2)
. S YSDXCSTX="(ICD-"_YSDXCSTX_")"
. S YSDXN=$P(YSDXDATA,U,4) ; ICD#
;
S YSDXST=$S(L9="v":"VERIFIED",L9="p":"PROVISIONAL",L9="i":"INACTIVE",L9="r":"REFORMULATED",L9="n":"NOT FOUND",L9="ru":"RULE OUT",1:"")
S Y=$P(^YSD(627.8,L5,0),U,3) D DD^%DT S YSDXDT=Y
;
; Modifiers
I $D(^YSD(627.8,L5,5)) D
. S L7=$P(^YSD(627.8,L5,5,0),U,3)
. F I=1:1:L7 S YSMOD(I)=$P(^YSD(627.8,L5,5,I,0),U,3)
;
; DXLS?
S L10=$P($G(^YSD(627.8,L5,1)),U,6) I L10]"" D
. S YSDXSTAT="INACTIVATED",Y=$P(^YSD(627.8,L5,1),U,5) D DD^%DT S YSTATDT=Y
;
S N1=N1+1,N2(N1)=$P(L3,";"),N4=0 K YSSTOP
F N3=1:1 S:P4=N2(N3) N4=N4+1 S:N4>1 YSSTOP=1 Q:N3=N1
QUIT:$D(YSSTOP) ;->
S P1=P1+1 S P2(P1)=L5
PRINT ;
;D RECORD^YSDX0001("PRINT^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
Q:YSDTY="IRN"&(L9="i") ;->
W !,P1,?3,YSDXCSTX," ",YSDXNN,!?3,$E(YSDXN,1,75)
I $D(YSMOD) F I=1:1:L7 I $D(YSMOD(I)) W:$TR(YSMOD(I)," ","")]"" !?8," --- "_YSMOD(I)
W !?8," --- "_YSDXST,?35,YSDXDT I $D(YSDXSTAT) W !?8," --- "_YSDXSTAT,?35,YSTATDT
QUIT
;
INQ ; Called by routines YSDX3, YSDX3A
;D RECORD^YSDX0001("INQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
Q:$D(YSNO) ;->
K %
S F3=$S(YSAX=1:" Axes 1 & 2 ",YSAX=3:" Axis 3 ",1:"")
I $D(F1) W !!,"List INACTIVE diagnoses" S %=2 D YN^DICN K:%=2 F1 S:%=1 YSDTY="I" I %=0 W !!,"YES will list all INACTIVE,",F3,"diagnoses for ",$E(YSNM,1,20),".",! G INQ
S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) Q:YSTOUT!YSUOUT
I $D(%) I %=-1 Q
I $D(F2) D RNQ I YSTOUT!YSUOUT Q
I $D(F1)!$D(F2) D LIST^YSDX3U I '$D(YSDXN) W !,"No additional",F3,"dx found."
QUIT
;
RNQ ;
;D RECORD^YSDX0001("RNQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
S %=0
F Q:$G(%) W !!,"List REFORMULATED/NOT FOUND diagnoses" S %=2 D
. D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) W !
. I '% D
. . W !!,"YES will list, in addition to all INACTIVE"
. . W F3,"diagnoses,",!?3," all REFORMULATED/NOT FOUND"
. . W F3,"diagnoses on file",!?3,"for ",$E(YSNM,1,20),".",!
I %=2 K F2 QUIT ;->
S:%=1 YSDTY="IRN"
I %=-1 S YSQT=1
QUIT
;
EOR ;YSDX3U - Utilities for Diagnoses in MH Med Record ;6/30/89 09:49
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDX3U 4998 printed Dec 13, 2024@02:14:20 Page 2
YSDX3U ;SLC/DJP/LJA - Utilities for Diagnoses Entered in MH Med Record ;13 May 2013 12:43 PM
+1 ;;5.01;MENTAL HEALTH;**107**;Dec 30, 1994;Build 23
+2 ;D RECORD^YSDX0001("^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+3 ;
END ;->
KILL YSDXDAT
DO END^YSDX3U00
+1 QUIT
+2 ;
LIST ; Called by routines YSDX3, YSDX3A, YSDX3U
+1 ; List diagnoses on file for a specific patient
+2 ;D RECORD^YSDX0001("LIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+3 KILL YSDXN,YSDXNN,YSDXST,YSMOD,YSDXDT,YSNO
SET N1=0
+4 ;->
IF '$ORDER(^YSD(627.8,"AC",YSDFN,0))
Begin DoDot:1
+5 WRITE !?10,"No diagnoses on file for ",YSNM
SET YSNO=1
End DoDot:1
QUIT
+6 ;
AXIS1 ; DSM display
+1 ;D RECORD^YSDX0001("AXIS1^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 IF YSAX=1
Begin DoDot:1
+3 SET L2=0
+4 FOR
SET L2=$ORDER(^YSD(627.8,"AC",YSDFN,L2))
if 'L2
QUIT
Begin DoDot:2
+5 SET L3=""
+6 FOR
SET L3=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3))
if L3=""
QUIT
IF $PIECE(L3,";",2)["YSD"
DO SELECTL
End DoDot:2
End DoDot:1
AXIS3 ; ICD9/ICD10 Display
+1 ;D RECORD^YSDX0001("AXIS3^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 IF YSAX=3
Begin DoDot:1
+3 SET L2=0
+4 FOR
SET L2=$ORDER(^YSD(627.8,"AC",YSDFN,L2))
if 'L2
QUIT
Begin DoDot:2
+5 SET L3=""
+6 FOR
SET L3=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3))
if L3=""
QUIT
IF $PIECE(L3,";",2)["ICD"
DO SELECTL
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
SELECTL ;
+1 ;D RECORD^YSDX0001("SELECTL^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 SET L4=""
+3 FOR
SET L4=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3,L4))
if L4=""
QUIT
Begin DoDot:1
+4 SET L5=0
+5 FOR
SET L5=$ORDER(^YSD(627.8,"AC",YSDFN,L2,L3,L4,L5))
if 'L5
QUIT
DO STATUS
if YSDTY="A"
DO ALST
if YSDTY="I"
DO ILST
if YSDTY="IRN"
DO IRNLST
End DoDot:1
+6 QUIT
STATUS ;
+1 ;D RECORD^YSDX0001("STATUS^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 SET L9=$PIECE(^YSD(627.8,L5,1),U,2)
+3 if L9="i"
SET F1=1
+4 if "rn"[L9!($PIECE(^YSD(627.8,L5,1),U,4)="I")
SET F2=1
+5 QUIT
+6 ;
ALST ;
+1 ;D RECORD^YSDX0001("ALST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 if L4="A"
DO PLIST
+3 QUIT
+4 ;
ILST ;
+1 ;D RECORD^YSDX0001("ILST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 if L9="i"
DO PLIST
+3 QUIT
+4 ;
IRNLST ;
+1 ;D RECORD^YSDX0001("IRNLST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 if L4="I"
DO PLIST
+3 QUIT
+4 ;
PLIST ;Sets variables for print of list line
+1 ;
+2 ; Axis 1
+3 ;D RECORD^YSDX0001("PLIST^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+4 SET YSDXCSTX=""
+5 IF YSAX=1
Begin DoDot:1
+6 SET P3=$PIECE(L3,";",2)
+7 SET P4=$PIECE(L3,";")
+8 SET P5="^"_P3_P4_","_0_")"
+9 SET P50=@P5
+10 ; Diagnosis name
SET YSDXN=^YSD(627.7,+P4,"D")
+11 ; ICD#
SET YSDXNN=$PIECE(P50,U)
+12 SET YSDXCSTX="(ICD-"_$SELECT($PIECE(P50,U,8)'="":$PIECE(P50,U,8),1:"9")_")"
End DoDot:1
+13 ;
+14 ; Axis 3
+15 IF YSAX=3
Begin DoDot:1
+16 SET P3=$PIECE(L3,";",2)
+17 SET P4=$PIECE(L3,";")
+18 SET P5="^"_P3_P4_","_0_")"
+19 SET P50=@P5
+20 NEW YSDXDATA
SET YSDXDATA=$$ICDDATA^ICDXCODE("DIAG",P4,$PIECE(^YSD(627.8,L5,0),U,3),"I")
+21 ; Diagnosis name
SET YSDXNN=$PIECE(YSDXDATA,U,2)
+22 SET YSDXCSTX=$PIECE($PIECE($$SINFO^ICDEX($PIECE(YSDXDATA,U,20)),U,2),"-",2)
+23 SET YSDXCSTX="(ICD-"_YSDXCSTX_")"
+24 ; ICD#
SET YSDXN=$PIECE(YSDXDATA,U,4)
End DoDot:1
+25 ;
+26 SET YSDXST=$SELECT(L9="v":"VERIFIED",L9="p":"PROVISIONAL",L9="i":"INACTIVE",L9="r":"REFORMULATED",L9="n":"NOT FOUND",L9="ru":"RULE OUT",1:"")
+27 SET Y=$PIECE(^YSD(627.8,L5,0),U,3)
DO DD^%DT
SET YSDXDT=Y
+28 ;
+29 ; Modifiers
+30 IF $DATA(^YSD(627.8,L5,5))
Begin DoDot:1
+31 SET L7=$PIECE(^YSD(627.8,L5,5,0),U,3)
+32 FOR I=1:1:L7
SET YSMOD(I)=$PIECE(^YSD(627.8,L5,5,I,0),U,3)
End DoDot:1
+33 ;
+34 ; DXLS?
+35 SET L10=$PIECE($GET(^YSD(627.8,L5,1)),U,6)
IF L10]""
Begin DoDot:1
+36 SET YSDXSTAT="INACTIVATED"
SET Y=$PIECE(^YSD(627.8,L5,1),U,5)
DO DD^%DT
SET YSTATDT=Y
End DoDot:1
+37 ;
+38 SET N1=N1+1
SET N2(N1)=$PIECE(L3,";")
SET N4=0
KILL YSSTOP
+39 FOR N3=1:1
if P4=N2(N3)
SET N4=N4+1
if N4>1
SET YSSTOP=1
if N3=N1
QUIT
+40 ;->
if $DATA(YSSTOP)
QUIT
+41 SET P1=P1+1
SET P2(P1)=L5
PRINT ;
+1 ;D RECORD^YSDX0001("PRINT^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 ;->
if YSDTY="IRN"&(L9="i")
QUIT
+3 WRITE !,P1,?3,YSDXCSTX," ",YSDXNN,!?3,$EXTRACT(YSDXN,1,75)
+4 IF $DATA(YSMOD)
FOR I=1:1:L7
IF $DATA(YSMOD(I))
if $TRANSLATE(YSMOD(I)," ","")]""
WRITE !?8," --- "_YSMOD(I)
+5 WRITE !?8," --- "_YSDXST,?35,YSDXDT
IF $DATA(YSDXSTAT)
WRITE !?8," --- "_YSDXSTAT,?35,YSTATDT
+6 QUIT
+7 ;
INQ ; Called by routines YSDX3, YSDX3A
+1 ;D RECORD^YSDX0001("INQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 ;->
if $DATA(YSNO)
QUIT
+3 KILL %
+4 SET F3=$SELECT(YSAX=1:" Axes 1 & 2 ",YSAX=3:" Axis 3 ",1:"")
+5 IF $DATA(F1)
WRITE !!,"List INACTIVE diagnoses"
SET %=2
DO YN^DICN
if %=2
KILL F1
if %=1
SET YSDTY="I"
IF %=0
WRITE !!,"YES will list all INACTIVE,",F3,"diagnoses for ",$EXTRACT(YSNM,1,20),".",!
GOTO INQ
+6 SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
if YSTOUT!YSUOUT
QUIT
+7 IF $DATA(%)
IF %=-1
QUIT
+8 IF $DATA(F2)
DO RNQ
IF YSTOUT!YSUOUT
QUIT
+9 IF $DATA(F1)!$DATA(F2)
DO LIST^YSDX3U
IF '$DATA(YSDXN)
WRITE !,"No additional",F3,"dx found."
+10 QUIT
+11 ;
RNQ ;
+1 ;D RECORD^YSDX0001("RNQ^YSDX3U") ;Used for testing. Inactivated in YSDX0001...
+2 SET %=0
+3 FOR
if $GET(%)
QUIT
WRITE !!,"List REFORMULATED/NOT FOUND diagnoses"
SET %=2
Begin DoDot:1
+4 DO YN^DICN
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
WRITE !
+5 IF '%
Begin DoDot:2
+6 WRITE !!,"YES will list, in addition to all INACTIVE"
+7 WRITE F3,"diagnoses,",!?3," all REFORMULATED/NOT FOUND"
+8 WRITE F3,"diagnoses on file",!?3,"for ",$EXTRACT(YSNM,1,20),".",!
End DoDot:2
End DoDot:1
+9 ;->
IF %=2
KILL F2
QUIT
+10 if %=1
SET YSDTY="IRN"
+11 IF %=-1
SET YSQT=1
+12 QUIT
+13 ;
EOR ;YSDX3U - Utilities for Diagnoses in MH Med Record ;6/30/89 09:49
