source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTS.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1YTS ;SLC/DKG,TGA-START TESTS, QUESTIONNAIRES & REPORTS ;12/12/90 16:34
2 ;;5.01;MENTAL HEALTH;**37,54**;Dec 30, 1994
3 ;
4ADM ; Called by MENU option YSADMTEST
5 ;
6 D ^YSLRP G:YSDFN<1 END S:'$D(^YTD(601.2,"B",YSDFN,YSDFN)) ^(YSDFN)=""
7C ;
8 I $P(^DPT(YSDFN,0),U,2)']"" W !!,"Patient's SEX required to administer instruments!" Q
9 D ENPT^YSUTL,NX G ^YTAR
10 ;
11RPT ; Called by MENU option YSPRINT
12 D ^YSLRP G:YSDFN<1 END S YSNO=1 D NX G ^YTDP
13NX ;
14 S %=$H>21549+$H-.1,%Y=%\365.25+141,%=%#365.25\1,YSPTD=%+306#(%Y#4=0+365)#153#61#31+1,YSPTM=%-YSPTD\29+1,Y=%Y_"00"+YSPTM_"00"+YSPTD,YSDT(0)=$$FMTE^XLFDT(Y,"5ZD")
15 S YSSX=YSSEX,YSBL=" ",YSHDR=YSSSN_" "_YSNM_YSBL_YSBL_YSBL,YSHDR=$E(YSHDR,1,44)_YSSX_" AGE "_YSAGE_" "_YSDT(0),YSHD=DT
16 S YSRSLMT=$P($G(^YSA(602,1,0)),U,3)
17 I $G(A9)="A" G NX1
18 W @IOF,!!?2,YSHDR
19NX1 ;
20 S YSHDT="" Q:$D(YSXT)
21 S T2=$S($D(^XUSEC("YSP",DUZ)):0,1:2)
22 S N=0 F S N=$O(^YTD(601.2,YSDFN,1,N)) Q:'N I $D(^YTT(601,N)) S N2=0 F S N2=$O(^YTD(601.2,YSDFN,1,N,1,N2)) Q:'N2 D CK
23 S YSNT=0,N1="" F S N1=$O(A(N1)) Q:N1="" S N2="" F S N2=$O(A(N1,N2)) Q:N2="" S YSNT=YSNT+1,A1(YSNT)=N1_"^"_N2_"^"_A(N1,N2) I N1="MMPI",$D(^YTD(601.2,YSDFN,1,A(N1,N2),1,N2,99)),^(99)="MMPIR" S A1(YSNT,"R")="R"
24 Q
25CK ;
26 S X=^YTT(601,N,0),N4=$P(X,U),X9=$P(X,U,9) G:$P(X,U,10)="Y" CK1
27 I X9="T",T2>1,$D(YSNO) Q
28 I X9="T",$P(X,U,8)'="V",T2>0,$D(YSNO) Q
29CK1 ;
30 S A(N4,N2)=N Q
31KAR ;
32 I $D(YSTXTED),$G(YSLFT) S YSTXTED=1
33 K %ZIS,%Y,A,A1,B,B1,C,D0,DA,DIC,DIE,DQ,DR,DTOUT,DUOUT,H,I,I0,J,K,L,M,N,N1,N2,N3,N4,P0,P1,P3,R1,T,T1,T2,X0,X1,X3,X4,X7,X8,X9,XMB,XMDUZ,Y1,Y2,YS4D,YSAGE,YSBAT,YSBEGIN,YSBL,YSCD,YSCH,YSCHN,YSCL,YSCLN,YSCON
34 K YSDEMO,YSDTA,YSDTM,YSDOB,YSED,YSEN,YSENT,YSET,YSFHDR,YSFTR,YSHD,YSHDR,YSHDT,YSJT,YSLFT,YSLN,YSNM,YSNO,YSNQ,YSNT
35 K YSNX,YSOK,YSORD,YSORDD,YSORDP,YSPTM,YSRESTRT,YSRP,YSSEX,YSQ,YSSSN,YSSX,YSTEST,YSTESTN,YSTF,YSTIN,YSTM,YSTX,YSTY,YSXTP,YSYI,YSYTX,YSZZ,Z,Z1,Z3
36END ;
37 K %,%DT,A9,X,Y,YSCLERK,YSD,YSDFN,YSPTD,YSRSLMT,YSXT,ZTSK D ^%ZISC
38 Q
39 ;
40HX2F ;
41 S YSNT=0,N1=$O(^YTT(601,"B",YSXT,0)) Q:N1'>0 I $D(^YTD(601.2,+YSDFN,1,"B",N1)) S N=$O(^(N1,0)) F N3=0:0 S N3=$O(^YTD(601.2,+YSDFN,1,N,1,N3)) Q:'N3 D HX2FS
42 Q
43HX2FS ;
44 S YSNT=YSNT+1,A1(YSNT)=YSXT_"^"_N3_"^"_N Q
45 ;
46ENT ; Called by MENU option YSCLERK
47 S YSCLERK=$O(^YTT(601,"B","CLERK",0)) G ADM ;CLERK ENTRY
48 ;
49ENSTAF ; Called by MENU option YSDIRTEST
50 S YSM=1 G ADM
51INT ;
52 D ^YSLRP G:YSDFN<1 END D C:$P(YSDFN(0),U,2)="" G:YSDFN<1 END S YSXTP=1 D NX,HX2F S T1=1,YSXT=$O(^YTT(601,"B",YSXT,0)),T1(0)=$P(^YTT(601,YSXT,"P"),U,4) G ^YTAR:A9="A",^YTDP
53 ;
54HX2A ; Called by MENU option YSHXPAST
55 S YSXT="HX2",A9="A" G INT
56 ;
57HX2R ; Called by MENU option YSHXPASTR
58 S YSXT="HX2",A9="R" G INT
59 ;
60MROSA ; Called by MENU option YSREVSYS
61 S YSXT="MROS",A9="A" G INT
62 ;
63MROSR ; Called by MENU option YSREVSYSR
64 S YSXT="MROS",A9="R" G INT
65 ;
66PSOCA ; Called by MENU option YSPERSHX
67 S YSXT="PSOC",A9="A" G INT
68 ;
69PSOCR ; Called by MENU option YSPERSHXR
70 S YSXT="PSOC",A9="R" G INT
71 ;
72BECK ; Called by YTAR -> BECK msg.
73 I YSTESTN="BECK" D ; modification made 11/2/94 mjd
74 . W !!,"You have selected the ""BECK"" instrument, the ""BDI"" "
75 . W !,"instrument will be administered in its place.",!
76 . S YSTESTN="BDI"
77 Q
78 ;
79MMPI ; Called by YTAR -> MMPI msg.
80 I YSTESTN="MMPI" D ; modification made 08/08/99 mjd
81 . W !!,"You have selected the ""MMPI"" instrument, the ""MMPI2"" "
82 . W !,"instrument will be administered in its place.",!
83 . S YSTESTN="MMPI2"
84 Q
Note: See TracBrowser for help on using the repository browser.