85 lines
3.3 KiB
Mathematica
85 lines
3.3 KiB
Mathematica
YTS ;SLC/DKG,TGA-START TESTS, QUESTIONNAIRES & REPORTS ;12/12/90 16:34
|
|
;;5.01;MENTAL HEALTH;**37,54**;Dec 30, 1994
|
|
;
|
|
ADM ; Called by MENU option YSADMTEST
|
|
;
|
|
D ^YSLRP G:YSDFN<1 END S:'$D(^YTD(601.2,"B",YSDFN,YSDFN)) ^(YSDFN)=""
|
|
C ;
|
|
I $P(^DPT(YSDFN,0),U,2)']"" W !!,"Patient's SEX required to administer instruments!" Q
|
|
D ENPT^YSUTL,NX G ^YTAR
|
|
;
|
|
RPT ; Called by MENU option YSPRINT
|
|
D ^YSLRP G:YSDFN<1 END S YSNO=1 D NX G ^YTDP
|
|
NX ;
|
|
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")
|
|
S YSSX=YSSEX,YSBL=" ",YSHDR=YSSSN_" "_YSNM_YSBL_YSBL_YSBL,YSHDR=$E(YSHDR,1,44)_YSSX_" AGE "_YSAGE_" "_YSDT(0),YSHD=DT
|
|
S YSRSLMT=$P($G(^YSA(602,1,0)),U,3)
|
|
I $G(A9)="A" G NX1
|
|
W @IOF,!!?2,YSHDR
|
|
NX1 ;
|
|
S YSHDT="" Q:$D(YSXT)
|
|
S T2=$S($D(^XUSEC("YSP",DUZ)):0,1:2)
|
|
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
|
|
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"
|
|
Q
|
|
CK ;
|
|
S X=^YTT(601,N,0),N4=$P(X,U),X9=$P(X,U,9) G:$P(X,U,10)="Y" CK1
|
|
I X9="T",T2>1,$D(YSNO) Q
|
|
I X9="T",$P(X,U,8)'="V",T2>0,$D(YSNO) Q
|
|
CK1 ;
|
|
S A(N4,N2)=N Q
|
|
KAR ;
|
|
I $D(YSTXTED),$G(YSLFT) S YSTXTED=1
|
|
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
|
|
K YSDEMO,YSDTA,YSDTM,YSDOB,YSED,YSEN,YSENT,YSET,YSFHDR,YSFTR,YSHD,YSHDR,YSHDT,YSJT,YSLFT,YSLN,YSNM,YSNO,YSNQ,YSNT
|
|
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
|
|
END ;
|
|
K %,%DT,A9,X,Y,YSCLERK,YSD,YSDFN,YSPTD,YSRSLMT,YSXT,ZTSK D ^%ZISC
|
|
Q
|
|
;
|
|
HX2F ;
|
|
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
|
|
Q
|
|
HX2FS ;
|
|
S YSNT=YSNT+1,A1(YSNT)=YSXT_"^"_N3_"^"_N Q
|
|
;
|
|
ENT ; Called by MENU option YSCLERK
|
|
S YSCLERK=$O(^YTT(601,"B","CLERK",0)) G ADM ;CLERK ENTRY
|
|
;
|
|
ENSTAF ; Called by MENU option YSDIRTEST
|
|
S YSM=1 G ADM
|
|
INT ;
|
|
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
|
|
;
|
|
HX2A ; Called by MENU option YSHXPAST
|
|
S YSXT="HX2",A9="A" G INT
|
|
;
|
|
HX2R ; Called by MENU option YSHXPASTR
|
|
S YSXT="HX2",A9="R" G INT
|
|
;
|
|
MROSA ; Called by MENU option YSREVSYS
|
|
S YSXT="MROS",A9="A" G INT
|
|
;
|
|
MROSR ; Called by MENU option YSREVSYSR
|
|
S YSXT="MROS",A9="R" G INT
|
|
;
|
|
PSOCA ; Called by MENU option YSPERSHX
|
|
S YSXT="PSOC",A9="A" G INT
|
|
;
|
|
PSOCR ; Called by MENU option YSPERSHXR
|
|
S YSXT="PSOC",A9="R" G INT
|
|
;
|
|
BECK ; Called by YTAR -> BECK msg.
|
|
I YSTESTN="BECK" D ; modification made 11/2/94 mjd
|
|
. W !!,"You have selected the ""BECK"" instrument, the ""BDI"" "
|
|
. W !,"instrument will be administered in its place.",!
|
|
. S YSTESTN="BDI"
|
|
Q
|
|
;
|
|
MMPI ; Called by YTAR -> MMPI msg.
|
|
I YSTESTN="MMPI" D ; modification made 08/08/99 mjd
|
|
. W !!,"You have selected the ""MMPI"" instrument, the ""MMPI2"" "
|
|
. W !,"instrument will be administered in its place.",!
|
|
. S YSTESTN="MMPI2"
|
|
Q
|