| [613] | 1 | YTACL ; 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)
|
|---|
| 5 | T0 ;
|
|---|
| 6 | S YSKK=1,YSTL=0
|
|---|
| 7 | T1 ;
|
|---|
| 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
|
|---|
| 10 | T2 ;
|
|---|
| 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
|
|---|
| 15 | TD ;
|
|---|
| 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
|
|---|
| 23 | S1 ;
|
|---|
| 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
|
|---|
| 26 | REPT ;
|
|---|
| 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",!
|
|---|
| 28 | R1 ;
|
|---|
| 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
|
|---|
