source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTACL.m@ 789

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1YTACL ; REL - ADJECTIVE CHECK LIST ; 4/1/86 12:29 PM ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 S R="",J=1,X(1)=^YTD(601.2,YSDFN,1,YSET,1,YSED,1),X(2)=^(2)
5T0 ;
6 S YSKK=1,YSTL=0
7T1 ;
8 I $D(^YTT(601,YSTEST,"S",J,"K",YSKK,0))#2=0 S R=R_YSTL_"^",J=J+1 G T0:J<26,TD
9 S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1
10T2 ;
11 S YSIT=$P(Y,"^",P) I YSIT="" S YSKK=YSKK+1 G T1
12 S A=$P(Y,"^",P+1),P=P+2
13 S M=$S(YSIT<201:$E(X(1),YSIT),1:$E(X(2),YSIT-200))
14 S:M="T" YSTL=YSTL+$S(A="T":1,1:-1) G T2
15TD ;
16 S YSTL=0 F I=1:1:200 S:$E(X(1),I)="T" YSTL=YSTL+1
17 F I=1:1:100 S:$E(X(2),I)="T" YSTL=YSTL+1
18 I YSSX="M" S R=YSTL_"^"_$P(R,"^",1)_"^"_$P(R,"^",3,24),A=$S(YSTL<76:1,YSTL<96:3,YSTL<122:5,1:7)
19 E S R=YSTL_"^"_$P(R,"^",2,23)_"^"_$P(R,"^",25),A=$S(YSTL<79:1,YSTL<99:3,YSTL<120:5,1:7)
20 S S="",J=1 I '$D(YSSX) W !?5,"Patient's sex unknown",!,$C(7) H 3 Q
21 I YSSX="M"!(YSSX="F") S P=YSSX
22 E W !!?5,"Patient's sex NOT defined correctly",!,$C(7) H 3 Q
23S1 ;
24 S M=$P(R,"^",J) G:M="" REPT
25 S X=^YTT(601,YSTEST,"S",J,P),S=S_$J((M-$P(X,"^",A)/$P(X,"^",A+1)*10+50),0,0)_"^",J=J+1 G S1
26REPT ;
27 S ^YTD(601.2,YSDFN,1,YSET,1,YSED,100)=S,J=1 W @IOF,YSHDR,!!?22,$P(^YTT(601,YSTEST,"P"),"^",1),!!!?24,"S C A L E",?43,"RAW",?51,"T",!
28R1 ;
29 S YSRS=$P(R,"^",J) I YSRS="" W ! K A,I,YSIT,J,YSKK,M,P,R,YSRS,S,YSSS,YSTL,X,Y Q
30 S YSSS=$P(S,"^",J) W !?19,$P(^YTT(601,YSTEST,"S",J,0),"^",2),?43,$J(YSRS,4,0),?49,$J(YSSS,4,0)
31 S J=J+1 G R1
Note: See TracBrowser for help on using the repository browser.