YSDX3 ;SLC/DJP,HIOFO/FT - Entry of Axis 1 & 2 Diagnoses for the Mental Health Medical Record ;9/20/11 16:58
;;5.01;MENTAL HEALTH;**33,60,107**;Dec 30, 1994;Build 23
;
; Called from the top by MENU option YSDIAGE
;
DRIVER ;Controls flow of routine
;D RECORD^YSDX0001("DRIVER^YSDX3") ;Used for testing. Inactivated in YSDX0001...
D ENTRY I $D(YSQT) D END^YSDX3U Q
D ^YSDX3A I $D(YSQT) D END^YSDX3U Q
D AXIS4^YSDX3B I $D(YSQT) D END^YSDX3U Q
D AXIS5^YSDX3B D END^YSDX3U Q
ENTRY ;Initial entry of DSM diagnosis
;D RECORD^YSDX0001("ENTRY^YSDX3") ;Used for testing. Inactivated in YSDX0001...
S:'$D(YSDUZ) YSDUZ=$P(^VA(200,DUZ,0),U) W @IOF,!!?IOM-$L("ENTRY OF DIAGNOSIS")\2,"ENTRY OF DIAGNOSIS",!! K YSQT D ^YSLRP Q:$D(YSPLIC) I YSTOUT!YSUOUT!(YSDFN'>0) Q
;
DXDATE S %DT="AER",%DT("A")="DATE/TIME OF DIAGNOSIS: ",%DT("B")="NOW" D ^%DT I Y=-1 S YSQT=1 Q
S YSDXDAT=Y K %DT
;OLD ; Called by routine YSCEN1
;Check for diagnosis formulated under DSM-III (File ^MR)
;D RECORD^YSDX0001("OLD^YSDX3") ;Used for testing. Inactivated in YSDX0001
;I $D(^MR(YSDFN,"DX")) D OLDP
AGAIN ; called from routine YSDX3UA
;D RECORD^YSDX0001("AGAIN^YSDX3") ;Used for testing. Inactivated in YSDX0001...
S P1=0,YSAX=1,YSDTY="A" W !!,"ACTIVE DSM (Axes 1 and 2): ",! D LIST^YSDX3U G:$D(YSNO) QUES1 I '$D(YSDXN) W !!?5,"No active DSM diagnoses on file for ",YSNM,".",!
K % D INQ^YSDX3U Q:$D(YSQT)
;
QUES1 ;Subroutine presents questions for Axes 1&2
;D RECORD^YSDX0001("QUES1^YSDX3") ;Used for testing. Inactivated in YSDX0001...
I '$D(^XUSEC("YSQ",DUZ)) W !!,"You must hold the YSQ security key to enter a DSM diagnosis." H 3 Q
K YSQT W !!,"Enter DSM DIAGNOSIS: " R X1:DTIME S YSTOUT='$T,YSUOUT=X1["^" I YSTOUT!YSUOUT S YSQT=1 Q
Q:X1="" I X1?.N I X1<(P1+1) G:X1<1 QUES1 W ! D DSMP^YSDX3UA G:'$D(YSY) QUES1 S:$D(S2) YSDXDA=+S2
I '$D(YSY) S X=$$UP^XLFSTR(X1) D DSMLK^YSDX3UA G:Y<0 QUES1
;
DUPLCK ;Checks for and displays possible duplicate entries
;D RECORD^YSDX0001("DUPLCK^YSDX3") ;Used for testing. Inactivated in YSDX0001...
S:'$D(YSDXDA) YSDXDA=+Y S:'$D(S2) S2=+Y
N YSACSREC,YSICDVSN S YSACSREC=$$ACTDT^YSDXUTL(YSDXDAT),YSICDVSN=$P(^YSD(627.7,S2,0),U,8)
S:YSICDVSN="" YSICDVSN="9"
I YSICDVSN="9",$P(YSACSREC,U,1)'="ICD" D G QUES1
. W !!,"DSM DIAGNOSIS is associated with ICD-9 ICD VERSION but should be associated"
. W !,"with the ICD-10 ICD VERSION for the entered DATE/TIME OF DIAGNOSIS."
I YSICDVSN="10",$P(YSACSREC,U,1)="ICD" D G QUES1
. W !!,"DSM DIAGNOSIS is associated with ICD-10 ICD VERSION but should be associated"
. W !,"with the ICD-9 ICD VERSION for the entered DATE/TIME OF DIAGNOSIS."
S W2="",W1=S2_";"_"YSD(627.7," F S W2=$O(^YSD(627.8,"AG","D",YSDFN,W1,W2)) Q:W2="" S YSDUPDA=W2 D DUPL^YSDX3UA
CORR ;
;D RECORD^YSDX0001("CORR^YSDX3") ;Used for testing. Inactivated in YSDX0001...
S YSWN=$P(^YSD(627.7,+YSDXDA,0),U),YSW=$G(^YSD(627.7,+YSDXDA,"D"))
S %=0 F Q:$G(%) W !!?10,YSWN_" "_YSW,!!,"Is this the DSM Dx you wish to select" S %=2 D
.D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT Q
.I '% W !!,"""YES"" indicates the diagnosis entered applies to ",YSNM,"."
I %=2 K YSDXDA,X1,YSDXST,YSLC,YSLCN,YSW,YSWN,YSY,S1,S2,S3,YSDXD,YSDXDA1,YSDXDT,YSDXND,YSDTY,W1,W2,W3,W4,W5 G QUES1
I %=-1 Q
FILE ;
;D RECORD^YSDX0001("FILE^YSDX3") ;Used for testing. Inactivated in YSDX0001...
;S DIC="^YSD(627.8,",DIC(0)="L",X="""N""",DLAYGO=627 D ^DIC D:Y<0 END^YSDX3U S YSDA=+Y,YSDXDA=YSDXDA_";YSD(627.7,"
K DD,DO,DA,DINUM
S X="NOW",%DT="TR" D ^%DT S X=Y
S DIC="^YSD(627.8,",DIC(0)="L",DLAYGO=627.8 D FILE^DICN D:Y<0 END^YSDX3U S YSDA=+Y,YSDXDA=YSDXDA_";YSD(627.7,"
S YSDXDA1=$P(YSDXDA,";") D MODIF^YSDX3UB G:$D(YSQT) QUES1
D FILE^YSDX3UA
K YSDXDA,YSDA,YSDTY,YSDXDA1,YSDXDT,YSDXN,YSDXNN,YSDXST,YSMOD,YSW,YSWN,YSY,F1,F2,F3,K1,K2,K3,K4,K5,K6,L2,L3,L4,L5,L7,P2,P3,P4,P5,S2,W1,W2,W3,W4,W5,W6,X,X1 G QUES1
;OLDP ;
;D RECORD^YSDX0001("OLDP^YSDX3") ;Used for testing. Inactivated in YSDX0001...
;S %=0 F Q:$G(%) W !!,"This patient has diagnoses formulated under DSM-III criteria.",!,"Do you wish to review" S %=2 D
;.D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
;.I '% W !!,"""YES"" provides a list of diagnoses which you may want to reformulate under",!," DSM criteria. ""NO"" will permit the option to continue.",!
;Q:YSTOUT!YSUOUT I %'=1 Q
;W !!,"The following may require reformulation under DSM criteria.",! D ^YSDXR
;Q
;
;EN ;The following are entry points used for accessing the DSM routines from options other than YSDIAG.
;
;ENPLDX ; Called by MENU option YSPLDX
; Called by routines YSPROB, YSPROB1, YSPROB3
;D RECORD^YSDX0001("ENPLDX^YSDX3") ;Used for testing. Inactivated in YSDX0001...
;S YSPLDX=1,N1=0 D @$S($D(YSDFN):"OLD",1:"ENTRY") I $G(YSQT)!YSTOUT!YSUOUT!(YSDFN'>0) D END^YSDX3U Q
;D AXIS4^YSDX3B I $D(YSQT) D END^YSDX3U Q
;D AXIS5^YSDX3B I $D(YSQT) D END^YSDX3U
;Q
;
;ENPLIC ; Called by MENU option YSPLPDX
; Called by routines YSPROB1, YSPROB3
;
;D RECORD^YSDX0001("ENPLIC^YSDX3") ;Used for testing. Inactivated in YSDX0001...
;S YSPLIC=1,N1=0 S:'$D(YSDUZ) YSDUZ=$P(^VA(200,DUZ,0),U) D:$G(YSDFN)'>0 ^YSLRP I YSTOUT!YSUOUT!(YSDFN'>0) D END^YSDX3U Q
;D ^YSDX3A D END^YSDX3U Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSDX3 5263 printed Apr 09, 2024@21:16:48 Page 2
YSDX3 ;SLC/DJP,HIOFO/FT - Entry of Axis 1 & 2 Diagnoses for the Mental Health Medical Record ;9/20/11 16:58
+1 ;;5.01;MENTAL HEALTH;**33,60,107**;Dec 30, 1994;Build 23
+2 ;
+3 ; Called from the top by MENU option YSDIAGE
+4 ;
DRIVER ;Controls flow of routine
+1 ;D RECORD^YSDX0001("DRIVER^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+2 DO ENTRY
IF $DATA(YSQT)
DO END^YSDX3U
QUIT
+3 DO ^YSDX3A
IF $DATA(YSQT)
DO END^YSDX3U
QUIT
+4 DO AXIS4^YSDX3B
IF $DATA(YSQT)
DO END^YSDX3U
QUIT
+5 DO AXIS5^YSDX3B
DO END^YSDX3U
QUIT
ENTRY ;Initial entry of DSM diagnosis
+1 ;D RECORD^YSDX0001("ENTRY^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+2 if '$DATA(YSDUZ)
SET YSDUZ=$PIECE(^VA(200,DUZ,0),U)
WRITE @IOF,!!?IOM-$LENGTH("ENTRY OF DIAGNOSIS")\2,"ENTRY OF DIAGNOSIS",!!
KILL YSQT
DO ^YSLRP
if $DATA(YSPLIC)
QUIT
IF YSTOUT!YSUOUT!(YSDFN'>0)
QUIT
+3 ;
DXDATE SET %DT="AER"
SET %DT("A")="DATE/TIME OF DIAGNOSIS: "
SET %DT("B")="NOW"
DO ^%DT
IF Y=-1
SET YSQT=1
QUIT
+1 SET YSDXDAT=Y
KILL %DT
+2 ;OLD ; Called by routine YSCEN1
+3 ;Check for diagnosis formulated under DSM-III (File ^MR)
+4 ;D RECORD^YSDX0001("OLD^YSDX3") ;Used for testing. Inactivated in YSDX0001
+5 ;I $D(^MR(YSDFN,"DX")) D OLDP
AGAIN ; called from routine YSDX3UA
+1 ;D RECORD^YSDX0001("AGAIN^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+2 SET P1=0
SET YSAX=1
SET YSDTY="A"
WRITE !!,"ACTIVE DSM (Axes 1 and 2): ",!
DO LIST^YSDX3U
if $DATA(YSNO)
GOTO QUES1
IF '$DATA(YSDXN)
WRITE !!?5,"No active DSM diagnoses on file for ",YSNM,".",!
+3 KILL %
DO INQ^YSDX3U
if $DATA(YSQT)
QUIT
+4 ;
QUES1 ;Subroutine presents questions for Axes 1&2
+1 ;D RECORD^YSDX0001("QUES1^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+2 IF '$DATA(^XUSEC("YSQ",DUZ))
WRITE !!,"You must hold the YSQ security key to enter a DSM diagnosis."
HANG 3
QUIT
+3 KILL YSQT
WRITE !!,"Enter DSM DIAGNOSIS: "
READ X1:DTIME
SET YSTOUT='$TEST
SET YSUOUT=X1["^"
IF YSTOUT!YSUOUT
SET YSQT=1
QUIT
+4 if X1=""
QUIT
IF X1?.N
IF X1<(P1+1)
if X1<1
GOTO QUES1
WRITE !
DO DSMP^YSDX3UA
if '$DATA(YSY)
GOTO QUES1
if $DATA(S2)
SET YSDXDA=+S2
+5 IF '$DATA(YSY)
SET X=$$UP^XLFSTR(X1)
DO DSMLK^YSDX3UA
if Y<0
GOTO QUES1
+6 ;
DUPLCK ;Checks for and displays possible duplicate entries
+1 ;D RECORD^YSDX0001("DUPLCK^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+2 if '$DATA(YSDXDA)
SET YSDXDA=+Y
if '$DATA(S2)
SET S2=+Y
+3 NEW YSACSREC,YSICDVSN
SET YSACSREC=$$ACTDT^YSDXUTL(YSDXDAT)
SET YSICDVSN=$PIECE(^YSD(627.7,S2,0),U,8)
+4 if YSICDVSN=""
SET YSICDVSN="9"
+5 IF YSICDVSN="9"
IF $PIECE(YSACSREC,U,1)'="ICD"
Begin DoDot:1
+6 WRITE !!,"DSM DIAGNOSIS is associated with ICD-9 ICD VERSION but should be associated"
+7 WRITE !,"with the ICD-10 ICD VERSION for the entered DATE/TIME OF DIAGNOSIS."
End DoDot:1
GOTO QUES1
+8 IF YSICDVSN="10"
IF $PIECE(YSACSREC,U,1)="ICD"
Begin DoDot:1
+9 WRITE !!,"DSM DIAGNOSIS is associated with ICD-10 ICD VERSION but should be associated"
+10 WRITE !,"with the ICD-9 ICD VERSION for the entered DATE/TIME OF DIAGNOSIS."
End DoDot:1
GOTO QUES1
+11 SET W2=""
SET W1=S2_";"_"YSD(627.7,"
FOR
SET W2=$ORDER(^YSD(627.8,"AG","D",YSDFN,W1,W2))
if W2=""
QUIT
SET YSDUPDA=W2
DO DUPL^YSDX3UA
CORR ;
+1 ;D RECORD^YSDX0001("CORR^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+2 SET YSWN=$PIECE(^YSD(627.7,+YSDXDA,0),U)
SET YSW=$GET(^YSD(627.7,+YSDXDA,"D"))
+3 SET %=0
FOR
if $GET(%)
QUIT
WRITE !!?10,YSWN_" "_YSW,!!,"Is this the DSM Dx you wish to select"
SET %=2
Begin DoDot:1
+4 DO YN^DICN
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
IF YSTOUT!YSUOUT
QUIT
+5 IF '%
WRITE !!,"""YES"" indicates the diagnosis entered applies to ",YSNM,"."
End DoDot:1
+6 IF %=2
KILL YSDXDA,X1,YSDXST,YSLC,YSLCN,YSW,YSWN,YSY,S1,S2,S3,YSDXD,YSDXDA1,YSDXDT,YSDXND,YSDTY,W1,W2,W3,W4,W5
GOTO QUES1
+7 IF %=-1
QUIT
FILE ;
+1 ;D RECORD^YSDX0001("FILE^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+2 ;S DIC="^YSD(627.8,",DIC(0)="L",X="""N""",DLAYGO=627 D ^DIC D:Y<0 END^YSDX3U S YSDA=+Y,YSDXDA=YSDXDA_";YSD(627.7,"
+3 KILL DD,DO,DA,DINUM
+4 SET X="NOW"
SET %DT="TR"
DO ^%DT
SET X=Y
+5 SET DIC="^YSD(627.8,"
SET DIC(0)="L"
SET DLAYGO=627.8
DO FILE^DICN
if Y<0
DO END^YSDX3U
SET YSDA=+Y
SET YSDXDA=YSDXDA_";YSD(627.7,"
+6 SET YSDXDA1=$PIECE(YSDXDA,";")
DO MODIF^YSDX3UB
if $DATA(YSQT)
GOTO QUES1
+7 DO FILE^YSDX3UA
+8 KILL YSDXDA,YSDA,YSDTY,YSDXDA1,YSDXDT,YSDXN,YSDXNN,YSDXST,YSMOD,YSW,YSWN,YSY,F1,F2,F3,K1,K2,K3,K4,K5,K6,L2,L3,L4,L5,L7,P2,P3,P4,P5,S2,W1,W2,W3,W4,W5,W6,X,X1
GOTO QUES1
+9 ;OLDP ;
+10 ;D RECORD^YSDX0001("OLDP^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+11 ;S %=0 F Q:$G(%) W !!,"This patient has diagnoses formulated under DSM-III criteria.",!,"Do you wish to review" S %=2 D
+12 ;.D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
+13 ;.I '% W !!,"""YES"" provides a list of diagnoses which you may want to reformulate under",!," DSM criteria. ""NO"" will permit the option to continue.",!
+14 ;Q:YSTOUT!YSUOUT I %'=1 Q
+15 ;W !!,"The following may require reformulation under DSM criteria.",! D ^YSDXR
+16 ;Q
+17 ;
+18 ;EN ;The following are entry points used for accessing the DSM routines from options other than YSDIAG.
+19 ;
+20 ;ENPLDX ; Called by MENU option YSPLDX
+21 ; Called by routines YSPROB, YSPROB1, YSPROB3
+22 ;D RECORD^YSDX0001("ENPLDX^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+23 ;S YSPLDX=1,N1=0 D @$S($D(YSDFN):"OLD",1:"ENTRY") I $G(YSQT)!YSTOUT!YSUOUT!(YSDFN'>0) D END^YSDX3U Q
+24 ;D AXIS4^YSDX3B I $D(YSQT) D END^YSDX3U Q
+25 ;D AXIS5^YSDX3B I $D(YSQT) D END^YSDX3U
+26 ;Q
+27 ;
+28 ;ENPLIC ; Called by MENU option YSPLPDX
+29 ; Called by routines YSPROB1, YSPROB3
+30 ;
+31 ;D RECORD^YSDX0001("ENPLIC^YSDX3") ;Used for testing. Inactivated in YSDX0001...
+32 ;S YSPLIC=1,N1=0 S:'$D(YSDUZ) YSDUZ=$P(^VA(200,DUZ,0),U) D:$G(YSDFN)'>0 ^YSLRP I YSTOUT!YSUOUT!(YSDFN'>0) D END^YSDX3U Q
+33 ;D ^YSDX3A D END^YSDX3U Q
