| [613] | 1 | YSDX3 ;SLC/DJP-Entry of Axis 1 & 2 Diagnoses for the Mental Health Medical Record ;1/15/91 11:07 ;07/07/93 15:03
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**33**;Dec 30, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ; Called from the top by MENU option YSDIAGE
|
|---|
| 5 | ;
|
|---|
| 6 | DRIVER ;Controls flow of routine
|
|---|
| 7 | ;D RECORD^YSDX0001("DRIVER^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 8 | D ENTRY I $D(YSQT) D END^YSDX3U Q
|
|---|
| 9 | D ^YSDX3A I $D(YSQT) D END^YSDX3U Q
|
|---|
| 10 | D AXIS4^YSDX3B I $D(YSQT) D END^YSDX3U Q
|
|---|
| 11 | D AXIS5^YSDX3B D END^YSDX3U Q
|
|---|
| 12 | ENTRY ;Initial entry of DSM diagnosis
|
|---|
| 13 | ;D RECORD^YSDX0001("ENTRY^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 14 | 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
|
|---|
| 15 | ;
|
|---|
| 16 | OLD ; Called by routine YSCEN1
|
|---|
| 17 | ;Check for diagnosis formulated under DSM-III (File ^MR)
|
|---|
| 18 | ;D RECORD^YSDX0001("OLD^YSDX3") ;Used for testing. Inactivated in YSDX0001
|
|---|
| 19 | I $D(^MR(YSDFN,"DX")) D OLDP
|
|---|
| 20 | AGAIN ; called from routine YSDX3UA
|
|---|
| 21 | ;D RECORD^YSDX0001("AGAIN^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 22 | 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,".",!
|
|---|
| 23 | K % D INQ^YSDX3U Q:$D(YSQT)
|
|---|
| 24 | ;
|
|---|
| 25 | QUES1 ;Subroutine presents questions for Axes 1&2
|
|---|
| 26 | ;D RECORD^YSDX0001("QUES1^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 27 | I '$D(^XUSEC("YSQ",DUZ)) W !!,"You must hold correct security key to enter DSM diagnosis." H 3 Q
|
|---|
| 28 | K YSQT W !!,"Enter DSM DIAGNOSIS: " R X1:DTIME S YSTOUT='$T,YSUOUT=X1["^" I YSTOUT!YSUOUT S YSQT=1 Q
|
|---|
| 29 | 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
|
|---|
| 30 | I '$D(YSY) S X=$$UP^XLFSTR(X1) D DSMLK^YSDX3UA G:Y<0 QUES1
|
|---|
| 31 | ;
|
|---|
| 32 | DUPLCK ;Checks for and displays possible duplicate entries
|
|---|
| 33 | ;D RECORD^YSDX0001("DUPLCK^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 34 | S:'$D(YSDXDA) YSDXDA=+Y S:'$D(S2) S2=+Y 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
|
|---|
| 35 | CORR ;
|
|---|
| 36 | ;D RECORD^YSDX0001("CORR^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 37 | S YSWN=$P(^YSD(627.7,+YSDXDA,0),U),YSW=$G(^YSD(627.7,+YSDXDA,"D"))
|
|---|
| 38 | S %=0 F Q:$G(%) W !!?10,YSWN_" "_YSW,!!,"Is this the DSM Dx you wish to select" S %=2 D
|
|---|
| 39 | .D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT) I YSTOUT!YSUOUT Q
|
|---|
| 40 | .I '% W !!,"""YES"" indicates the diagnosis entered applies to ",YSNM,"."
|
|---|
| 41 | 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
|
|---|
| 42 | I %=-1 Q
|
|---|
| 43 | FILE ;
|
|---|
| 44 | ;D RECORD^YSDX0001("FILE^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 45 | ;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,"
|
|---|
| 46 | K DD,DO,DA,DINUM
|
|---|
| 47 | S X="NOW",%DT="TR" D ^%DT S X=Y
|
|---|
| 48 | 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,"
|
|---|
| 49 | S YSDXDA1=$P(YSDXDA,";") D MODIF^YSDX3UB G:$D(YSQT) QUES1
|
|---|
| 50 | D FILE^YSDX3UA
|
|---|
| 51 | 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
|
|---|
| 52 | OLDP ;
|
|---|
| 53 | ;D RECORD^YSDX0001("OLDP^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 54 | S %=0 F Q:$G(%) W !!,"This patient has diagnoses formulated under DSM-III criteria.",!,"Do you wish to review" S %=2 D
|
|---|
| 55 | .D YN^DICN S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT)
|
|---|
| 56 | .I '% W !!,"""YES"" provides a list of diagnoses which you may want to reformulate under",!," DSM criteria. ""NO"" will permit the option to continue.",!
|
|---|
| 57 | Q:YSTOUT!YSUOUT I %'=1 Q
|
|---|
| 58 | W !!,"The following may require reformulation under DSM criteria.",! D ^YSDXR
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | EN ;The following are entry points used for accessing the DSM routines from options other than YSDIAG.
|
|---|
| 62 | ;
|
|---|
| 63 | ENPLDX ; Called by MENU option YSPLDX
|
|---|
| 64 | ; Called by routines YSPROB, YSPROB1, YSPROB3
|
|---|
| 65 | ;D RECORD^YSDX0001("ENPLDX^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 66 | S YSPLDX=1,N1=0 D @$S($D(YSDFN):"OLD",1:"ENTRY") I $G(YSQT)!YSTOUT!YSUOUT!(YSDFN'>0) D END^YSDX3U Q
|
|---|
| 67 | D AXIS4^YSDX3B I $D(YSQT) D END^YSDX3U Q
|
|---|
| 68 | D AXIS5^YSDX3B I $D(YSQT) D END^YSDX3U
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | ENPLIC ; Called by MENU option YSPLPDX
|
|---|
| 72 | ; Called by routines YSPROB1, YSPROB3
|
|---|
| 73 | ;
|
|---|
| 74 | ;D RECORD^YSDX0001("ENPLIC^YSDX3") ;Used for testing. Inactivated in YSDX0001...
|
|---|
| 75 | 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
|
|---|
| 76 | D ^YSDX3A D END^YSDX3U Q
|
|---|
