YTDESC ;SLC/TGA-LIST TEST/INTERVIEW DESCRIPTIONS ; 7/14/89 12:36 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
1 ;
W @IOF S P0=$S(IOST?1"P".E:1,1:0),P1=$S(P0:8,1:3)
S YSINS="TEST",YSN="" F S YSN=$O(^YTT(601,"ATN","T",YSN)) Q:YSN=""!YSLFT S T=$O(^YTT(601,"ATN","T",YSN,0)) D TC,TL
G:YSLFT END S YSINS="INTERVIEW",YSN="" F S YSN=$O(^YTT(601,"ATN","I",YSN)) Q:YSN=""!YSLFT S T=$O(^YTT(601,"ATN","I",YSN,0)) D TC,IL
END ;
K K,P0,P1,T,X,Y,YSINS,YSN Q
TC ;
D:$Y+P1+5>IOSL CK Q:YSLFT W:P0 !! S X=$P(^YTT(601,T,"P"),U) W ?(80-$L(X)\2),X S X=^YTT(601,T,0) W !! W YSINS," CODE = ",$P(X,U),! Q
TL ;
W !,"AUTHOR : " W:$D(^YTT(601,T,1)) ^(1)
W !,"PUBLISHER : " W:$D(^YTT(601,T,2)) ^(2)
W !,"FORM : " W:$D(^YTT(601,T,3)) ^(3)
W !,"NO. ITEMS : " W $P(X,U,11)
D:$Y+P1+3>IOSL CK Q:YSLFT W !!,"--- S C A L E S ---",! F K=1:1 Q:'$D(^YTT(601,T,"S",K,0)) S X=$P(^(0),U,2) Q:X="" D:$Y+P1>IOSL CK Q:YSLFT W !,X
D:$Y+P1+3>IOSL CK Q:YSLFT W !!,"NORMATIVE DATA:",! F K=1:1 Q:'$D(^YTT(601,T,6,K,0)) D:$Y+P1>IOSL CK Q:YSLFT W !?5,^(0)
D:$Y+P1+3>IOSL CK Q:YSLFT W !!,"TEST USES:",! F K=1:1 Q:'$D(^YTT(601,T,7,K,0)) D:$Y+P1>IOSL CK Q:YSLFT W !?5,^(0)
G:'$D(^YTT(601,T,8)) T1 D:$Y+P1+3>IOSL CK Q:YSLFT W !!,"INTERPRETIVE REPORT: ",! F K=1:1 Q:'$D(^YTT(601,T,8,K,0)) D:$Y+P1>IOSL CK Q:YSLFT W !,^(0)
T1 ;
D:'P0 CK Q
IL ;
W !,"NUMBER OF ITEMS: ",$P(X,U,11)
W !,"SOURCE:",! F K=1:1 Q:'$D(^YTT(601,T,4,K,0)) D:$Y+P1>IOSL CK Q:YSLFT W !?5,^(0)
W !!,"DESCRIPTION:" F K=1:1 Q:'$D(^YTT(601,T,5,K,0)) D:$Y+P1>IOSL CK Q:YSLFT W !?5,^(0)
D:'P0 CK Q
CK ;
D:'P0 WAIT^YSUTL Q:YSLFT W @IOF Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTDESC 1625 printed Sep 23, 2025@19:53:17 Page 2
YTDESC ;SLC/TGA-LIST TEST/INTERVIEW DESCRIPTIONS ; 7/14/89 12:36 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
1 ;
+1 WRITE @IOF
SET P0=$SELECT(IOST?1"P".E:1,1:0)
SET P1=$SELECT(P0:8,1:3)
+2 SET YSINS="TEST"
SET YSN=""
FOR
SET YSN=$ORDER(^YTT(601,"ATN","T",YSN))
if YSN=""!YSLFT
QUIT
SET T=$ORDER(^YTT(601,"ATN","T",YSN,0))
DO TC
DO TL
+3 if YSLFT
GOTO END
SET YSINS="INTERVIEW"
SET YSN=""
FOR
SET YSN=$ORDER(^YTT(601,"ATN","I",YSN))
if YSN=""!YSLFT
QUIT
SET T=$ORDER(^YTT(601,"ATN","I",YSN,0))
DO TC
DO IL
END ;
+1 KILL K,P0,P1,T,X,Y,YSINS,YSN
QUIT
TC ;
+1 if $Y+P1+5>IOSL
DO CK
if YSLFT
QUIT
if P0
WRITE !!
SET X=$PIECE(^YTT(601,T,"P"),U)
WRITE ?(80-$LENGTH(X)\2),X
SET X=^YTT(601,T,0)
WRITE !!
WRITE YSINS," CODE = ",$PIECE(X,U),!
QUIT
TL ;
+1 WRITE !,"AUTHOR : "
if $DATA(^YTT(601,T,1))
WRITE ^(1)
+2 WRITE !,"PUBLISHER : "
if $DATA(^YTT(601,T,2))
WRITE ^(2)
+3 WRITE !,"FORM : "
if $DATA(^YTT(601,T,3))
WRITE ^(3)
+4 WRITE !,"NO. ITEMS : "
WRITE $PIECE(X,U,11)
+5 if $Y+P1+3>IOSL
DO CK
if YSLFT
QUIT
WRITE !!,"--- S C A L E S ---",!
FOR K=1:1
if '$DATA(^YTT(601,T,"S",K,0))
QUIT
SET X=$PIECE(^(0),U,2)
if X=""
QUIT
if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !,X
+6 if $Y+P1+3>IOSL
DO CK
if YSLFT
QUIT
WRITE !!,"NORMATIVE DATA:",!
FOR K=1:1
if '$DATA(^YTT(601,T,6,K,0))
QUIT
if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !?5,^(0)
+7 if $Y+P1+3>IOSL
DO CK
if YSLFT
QUIT
WRITE !!,"TEST USES:",!
FOR K=1:1
if '$DATA(^YTT(601,T,7,K,0))
QUIT
if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !?5,^(0)
+8 if '$DATA(^YTT(601,T,8))
GOTO T1
if $Y+P1+3>IOSL
DO CK
if YSLFT
QUIT
WRITE !!,"INTERPRETIVE REPORT: ",!
FOR K=1:1
if '$DATA(^YTT(601,T,8,K,0))
QUIT
if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !,^(0)
T1 ;
+1 if 'P0
DO CK
QUIT
IL ;
+1 WRITE !,"NUMBER OF ITEMS: ",$PIECE(X,U,11)
+2 WRITE !,"SOURCE:",!
FOR K=1:1
if '$DATA(^YTT(601,T,4,K,0))
QUIT
if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !?5,^(0)
+3 WRITE !!,"DESCRIPTION:"
FOR K=1:1
if '$DATA(^YTT(601,T,5,K,0))
QUIT
if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !?5,^(0)
+4 if 'P0
DO CK
QUIT
CK ;
+1 if 'P0
DO WAIT^YSUTL
if YSLFT
QUIT
WRITE @IOF
QUIT
