- 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 Mar 13, 2025@21:19 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
