YTLCTD ;SLC/TGA-LIST INSTRUMENTS ; 7/10/89 11:30 ;
;;5.01;MENTAL HEALTH;**70**;Dec 30, 1994
;
; Called from the top by MENU option YSMLST
1 ;
W @IOF,!!!?27,"List Tests and Interviews"
W !!,"Tests and interviews can be listed by CODES only, CODES and TITLES,",!,"or by DESCRIPTION, including author, number of items, etc.",!
OP ;
W !!,"(C)ode, (T)itle, (D)escription, or (Q)uit: Q// " R A:DTIME S YSTOUT='$T,YSUOUT=A["^" S A=$TR($E(A_"Q"),"ctdq","CTDQ") G:YSTOUT!YSUOUT!("Q"[A) END
I A["?" S XQH="YS-LIST-OF-TESTS" D EN^XQH K A G OP
I "CTD?"'[A W "??",$C(7) G OP
S %ZIS="QM"
D ^%ZIS
G:$G(POP) END
I $D(IO("Q")) D Q
.S ZTRTN="ENP^YTLCTD",ZTSAVE("A")="",ZTDESC="YS MH INST LIST"
.D ^%ZTLOAD
.D HOME^%ZIS
.Q
U IO
ENP ;
S:$D(ZTQUEUED) ZTREQ="@"
S YSLFT=0
D @A
W !
;D KILL^%ZTLOAD G:$D(ZTSK) END D:'YSLFT WAIT^YSUTL:IOST?1"C-".E G:YSLFT END D ^%ZISC G OP
D ^%ZISC
W @IOF
END ;
K A,J,Y,YSLFT,YSORD,YSTESTN,YSTOUT,YSUOUT,YSXT,Z Q
C ;
S YSTESTN="?",YSORD=DUZ,YSXT="" W @IOF D ^YTLIST Q
T ;
D ^YTTLS Q
D ;
D ^YTDESC Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTLCTD 1074 printed Dec 13, 2024@02:17:24 Page 2
YTLCTD ;SLC/TGA-LIST INSTRUMENTS ; 7/10/89 11:30 ;
+1 ;;5.01;MENTAL HEALTH;**70**;Dec 30, 1994
+2 ;
+3 ; Called from the top by MENU option YSMLST
1 ;
+1 WRITE @IOF,!!!?27,"List Tests and Interviews"
+2 WRITE !!,"Tests and interviews can be listed by CODES only, CODES and TITLES,",!,"or by DESCRIPTION, including author, number of items, etc.",!
OP ;
+1 WRITE !!,"(C)ode, (T)itle, (D)escription, or (Q)uit: Q// "
READ A:DTIME
SET YSTOUT='$TEST
SET YSUOUT=A["^"
SET A=$TRANSLATE($EXTRACT(A_"Q"),"ctdq","CTDQ")
if YSTOUT!YSUOUT!("Q"[A)
GOTO END
+2 IF A["?"
SET XQH="YS-LIST-OF-TESTS"
DO EN^XQH
KILL A
GOTO OP
+3 IF "CTD?"'[A
WRITE "??",$CHAR(7)
GOTO OP
+4 SET %ZIS="QM"
+5 DO ^%ZIS
+6 if $GET(POP)
GOTO END
+7 IF $DATA(IO("Q"))
Begin DoDot:1
+8 SET ZTRTN="ENP^YTLCTD"
SET ZTSAVE("A")=""
SET ZTDESC="YS MH INST LIST"
+9 DO ^%ZTLOAD
+10 DO HOME^%ZIS
+11 QUIT
End DoDot:1
QUIT
+12 USE IO
ENP ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 SET YSLFT=0
+3 DO @A
+4 WRITE !
+5 ;D KILL^%ZTLOAD G:$D(ZTSK) END D:'YSLFT WAIT^YSUTL:IOST?1"C-".E G:YSLFT END D ^%ZISC G OP
+6 DO ^%ZISC
+7 WRITE @IOF
END ;
+1 KILL A,J,Y,YSLFT,YSORD,YSTESTN,YSTOUT,YSUOUT,YSXT,Z
QUIT
C ;
+1 SET YSTESTN="?"
SET YSORD=DUZ
SET YSXT=""
WRITE @IOF
DO ^YTLIST
QUIT
T ;
+1 DO ^YTTLS
QUIT
D ;
+1 DO ^YTDESC
QUIT
