source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPROB1.m@ 1474

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1YSPROB1 ;SLC/DKG-PROB LIST EXTENSION ;11/15/90 16:42 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 ; Called by routine YSPROB
5AA ;
6 G:YSA["^" FIN
7 I $D(^YS(615,YSDFN,P4,8)) S YSA="N" W !!?3,"There is already an 'Alcohol abuse' problem",!?3,"on file. Do you want to edit this problem? N// "
8 I $D(^YS(615,YSDFN,P4,8)) R YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G FIN:YSTOUT,A11^YSPROB:YSUOUT S:YSA="" YSA="N" S YSA=$E(YSA) I "YyNn"'[YSA D HELP3^YSPROB2 G AA
9 I $D(^YS(615,YSDFN,P4,8)) G:"Nn"[YSA DA S (Y,E2)=8,Y(0)="^H" D AP^YSPROB2 G:YSTOUT FIN G DA
10 S YSA="N" R !!?3,"Does patient have an alcohol abuse problem? (Y/N/U) N// ",YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G FIN:YSTOUT,A2^YSPROB:YSUOUT S YSA=$E(YSA) I "YyNnUu"'[YSA D HELP4^YSPROB2 G AA
11 G:"Nn"[YSA DA
12 I "Uu"[YSA S X="Incomplete data base",Z="Uncertain about alcohol abuse" D UN^YSPROB2 G:YSTOUT FIN G DA
13AD ;
14 W !!?3,"Do you want an (A)lcohol misuse problem or a (D)SM diagnosis?",!
15 R !?3,"ANSWER (A or D): ",YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G:YSTOUT!YSUOUT FIN S:YSA="" YSA="Q" I "AaDd"'[YSA D HELP5^YSPROB2 G AD
16 I "Dd"[YSA S PH1=YSDFN,PH2=P4 D ENPLDX^YSDX3 S YSDFN=PH1,P4=PH2 S:$D(YSQT) YSA="^" G DA
17 S E2=1,X=$P(^DIC(620,8,0),U) D EP^YSPROB2 G:YSTOUT FIN
18DA ;
19 G:YSA["^" FIN
20 I $D(^YS(615,YSDFN,P4,9)) S YSA="N" W !!?3,"There is already a 'Substance (non-alcohol) abuse' problem",!?3,"on file. Do you want to edit this problem? N// " R YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G FIN:YSTOUT,A11^YSPROB:YSUOUT S YSA=$E(YSA)
21 I $D(^YS(615,YSDFN,P4,9)),"YyNn"'[YSA D HELP3^YSPROB2 G DA
22 I $D(^YS(615,YSDFN,P4,9)) G:"Nn"[YSA PH S (Y,E2)=9,Y(0)="^I" D AP^YSPROB2 G:YSTOUT FIN G PH
23 R !!?3,"Does patient abuse drugs/other non-alcohol substances? (Y/N/U) N// ",YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G FIN:YSTOUT,A2^YSPROB:YSUOUT S:YSA="" YSA="N" I "YyNnUu"'[YSA D HELP4^YSPROB2 G DA
24 G:"Nn"[YSA PH
25 I "Uu"[YSA S X="Incomplete data base",Z="Uncertain about drug/non-alcohol substance abuse" D UN^YSPROB2 G:YSTOUT FIN G PH
26DD ;
27 W !!?3,"Do you want (S)ubstance (non-alcohol) problem",!?3,"or (D)SM diagnosis?",!
28 R !?3,"ANSWER (S or D): ",YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G:YSTOUT!YSUOUT FIN S:YSA="" YSA="Q" I "SsDd"'[YSA D HELP5^YSPROB2 G DD
29 I "Dd"[YSA S PH1=YSDFN,PH2=P4 D ENPLDX^YSDX3 S YSDFN=PH1,P4=PH2 S:$D(YSQT) YSA="^" G PH
30 S E2=1,X=$P(^DIC(620,9,0),U) D EP^YSPROB2 G:YSTOUT FIN
31PH ;
32 G:YSA["^" FIN
33 I $D(^YS(615,YSDFN,P4,25)) S YSA="N" W !!?3,"There is already a 'General physical' problem",!?3,"on file. Do you want to edit this problem: N// "
34 I $D(^YS(615,YSDFN,P4,25)) R YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G FIN:YSTOUT,A11^YSPROB:YSUOUT S YSA=$E(YSA) I "YyNn"'[YSA D HELP3^YSPROB2 G PH
35 I $D(^YS(615,YSDFN,P4,25)) G:"Nn"[YSA A11^YSPROB S (Y,E2)=25,Y(0)="^Y" D AP^YSPROB2 G:YSTOUT FIN G A11^YSPROB
36 R !!?3,"Does patient have significant physical problems? (Y/N/U) N// ",YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G FIN:YSTOUT,A2^YSPROB:YSUOUT S:YSA="" YSA="N" I "YyNnUu"'[YSA D HELP4^YSPROB2 G PH
37 G:"Nn"[YSA A11^YSPROB
38 I "Uu"[YSA S X="Incomplete data base",Z="Uncertain about general physical problem" D UN^YSPROB2 G:YSTOUT FIN G A11^YSPROB
39PHD ;
40 W !!?3,"Do you want a (P)hysical problem or an ICD-9 (D)iagnosis?",!
41 R !?3,"ANSWER (P or D): ",YSA:DTIME S YSTOUT='$T,YSUOUT=YSA["^" G:YSTOUT!YSUOUT FIN S:YSA="" YSA="Q" I "PpDd"'[YSA D HELP6^YSPROB2 G PHD
42 I "Dd"[YSA S PH1=YSDFN,PH2=P4 D ENPLIC^YSDX3 S YSDFN=PH1,P4=PH2 Q:$D(YSQT) G A11^YSPROB
43 S E2=1,X=$P(^DIC(620,25,0),U) D EP^YSPROB2 G:YSTOUT FIN G A11^YSPROB
44FIN ; Called by routine YSPROB, YSPROB4
45 I $G(YSTOUT) W:IOF]"" @IOF
46 K %,%DT,%ZIS,%Y,A,A2,B4,C,D,D0,D1,D2,D3,DA,DIC,DIE,DIU,DIV,DLAYGO,DO,DQ,DR,YSDT(0),YSDT(1),E2,E3,ER,H,I,I1,I2,I3,K,L1,L2,L3,M1,N1,N2,N3,N4,N5,N6,N7,P,P1,P2,P4,P5,R,R1,R2,S,S2,S3,S4,S5,S6,SCR,T,T2,T3,T4,V,X,X1,Y,Y1
47 K YSA,YSAGE,YSBL,YSDFN,YSDOB,YSDTM,YSEND,YSFIN,YSLFT,YSMOR,YSNM,YSNO,YSOP,YSPF,YSPTD,YSSEX,YSSSN,YSTM,YSTOUT,YSZZ,Z,Z2,YSQT,PH1,PH2 Q
Note: See TracBrowser for help on using the repository browser.