YTTLS ;SLC/DKG,SLC/TGA-LIST CODES & TITLES OF TESTS/INTERVIEWS ;3/14/91 13:27 ;
;;5.01;MENTAL HEALTH;**17**;Dec 30, 1994
;
S (YSLFT,T)=0 K Y D ENDTM^YSUTL S A=10,YSN="",B="TESTS" W @IOF D HD
F ;
S (F,F1)=0,YSN=$O(^YTT(601,"ATN","T",YSN)) G:YSN="" H S T=$O(^(YSN,0))
S X=^YTT(601,T,0) G:$P(X,U,13)="N" F S T1=$P(X,U) S:$P(X,U,14)="N" F=1 S:$P(X,U,3)["Y" F1=1 D TITLE
I $Y+$S(IOST["P-":8,1:3)>IOSL D CK G:YSLFT FIN
W !?5,T1 W ?12 W:F "*" W:F1 "+"
I T1="NEOPI"!(T1="PAI") W ?16,N G F
E W ?15,N G F
H ;
S T=0,A=5,YSN="",B="INTERVIEWS" I $Y+8>IOSL D CK G:YSLFT FIN G G
W !! D HD
G ;
S YSN=$O(^YTT(601,"ATN","I",YSN)) G:YSN="" FIN S T=$O(^(YSN,0)),X=^YTT(601,T,0) G:$P(X,U,13)="N" G S T1=$P(X,U) D TITLE
I $Y+$S(IOST["P-":8,1:3)>IOSL D CK G:YSLFT FIN
W !?5,T1,?15,N G G
FIN ;
K A,B,F,J,I0,N,P,T,T1,X,YSN Q
CK ;
D:IOST?1"C-".E WAIT^YSUTL Q:YSLFT W @IOF
HD ;
W !!?A,"LIST OF CURRENT ",B,", ",YSDT(1),!!
Q
;
TITLE ;
S N=$P($G(^YTT(601,T,"P")),U)
I N["*" S N=$TR(N,"*","-")
S N=$S(N["---":$P(N,"---",2),$D(N):N,1:" TITLE MISSING")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTTLS 1081 printed Nov 22, 2024@17:31:57 Page 2
YTTLS ;SLC/DKG,SLC/TGA-LIST CODES & TITLES OF TESTS/INTERVIEWS ;3/14/91 13:27 ;
+1 ;;5.01;MENTAL HEALTH;**17**;Dec 30, 1994
+2 ;
+3 SET (YSLFT,T)=0
KILL Y
DO ENDTM^YSUTL
SET A=10
SET YSN=""
SET B="TESTS"
WRITE @IOF
DO HD
F ;
+1 SET (F,F1)=0
SET YSN=$ORDER(^YTT(601,"ATN","T",YSN))
if YSN=""
GOTO H
SET T=$ORDER(^(YSN,0))
+2 SET X=^YTT(601,T,0)
if $PIECE(X,U,13)="N"
GOTO F
SET T1=$PIECE(X,U)
if $PIECE(X,U,14)="N"
SET F=1
if $PIECE(X,U,3)["Y"
SET F1=1
DO TITLE
+3 IF $Y+$SELECT(IOST["P-":8,1:3)>IOSL
DO CK
if YSLFT
GOTO FIN
+4 WRITE !?5,T1
WRITE ?12
if F
WRITE "*"
if F1
WRITE "+"
+5 IF T1="NEOPI"!(T1="PAI")
WRITE ?16,N
GOTO F
+6 IF '$TEST
WRITE ?15,N
GOTO F
H ;
+1 SET T=0
SET A=5
SET YSN=""
SET B="INTERVIEWS"
IF $Y+8>IOSL
DO CK
if YSLFT
GOTO FIN
GOTO G
+2 WRITE !!
DO HD
G ;
+1 SET YSN=$ORDER(^YTT(601,"ATN","I",YSN))
if YSN=""
GOTO FIN
SET T=$ORDER(^(YSN,0))
SET X=^YTT(601,T,0)
if $PIECE(X,U,13)="N"
GOTO G
SET T1=$PIECE(X,U)
DO TITLE
+2 IF $Y+$SELECT(IOST["P-":8,1:3)>IOSL
DO CK
if YSLFT
GOTO FIN
+3 WRITE !?5,T1,?15,N
GOTO G
FIN ;
+1 KILL A,B,F,J,I0,N,P,T,T1,X,YSN
QUIT
CK ;
+1 if IOST?1"C-".E
DO WAIT^YSUTL
if YSLFT
QUIT
WRITE @IOF
HD ;
+1 WRITE !!?A,"LIST OF CURRENT ",B,", ",YSDT(1),!!
+2 QUIT
+3 ;
TITLE ;
+1 SET N=$PIECE($GET(^YTT(601,T,"P")),U)
+2 IF N["*"
SET N=$TRANSLATE(N,"*","-")
+3 SET N=$SELECT(N["---":$PIECE(N,"---",2),$DATA(N):N,1:" TITLE MISSING")
+4 QUIT
