source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSDX3.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.4 KB
Line 
1YSDX3 ;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 ;
6DRIVER ;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
12ENTRY ;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 ;
16OLD ; 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
20AGAIN ; 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 ;
25QUES1 ;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 ;
32DUPLCK ;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
35CORR ;
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
43FILE ;
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
52OLDP ;
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 ;
61EN ;The following are entry points used for accessing the DSM routines from options other than YSDIAG.
62 ;
63ENPLDX ; 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 ;
71ENPLIC ; 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
Note: See TracBrowser for help on using the repository browser.