YTPIT ;SLC/TGA-Print test/interview items ;11/15/90 17:06 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
; Called from the top by MENU option YSPIT
;
W @IOF,!!,"Print Test/Interview Items"
PIT ;
R !!,"Instrument: ",YSTS:DTIME
S YSTOUT='$T,YSUOUT=YSTS["^"
G:YSTOUT!YSUOUT!(YSTS']"") FIN
I YSTS["?" S YSTESTN="?",YSXT="",YSORD=DUZ D ^YTLIST K YSTESTN,YSXT G PIT
S YSTEST=$O(^YTT(601,"B",YSTS,0))
I 'YSTEST W $C(7)," [Not found]" G PIT
;
; Don't print batteries!!!
I $P($G(^YTT(601,+YSTEST,0)),U,9)="B" W " Battery selection not allowed..." G PIT ;->
;
S %ZIS="Q" D ^%ZIS G:POP FIN I $D(IO("Q")) S ZTRTN="ENP^YTPIT",(ZTSAVE("YSTS"),ZTSAVE("YSTEST"))="",ZTDESC="YS INST ITEM PRINT" D ^%ZTLOAD G FIN
ENP ;
K Y D ENDTM^YSUTL S YSLFT=0,YSTNM=$P($P(^YTT(601,YSTEST,"P"),U),"---",2),P0=$S(IOST?1"P".E:1,1:0),P1=$S(P0:8,1:3)
U IO W @IOF W !!?4,YSTNM," (",YSTS,")"," ",YSDT(1),! F I=1:1 Q:'$D(^YTT(601,YSTEST,"Q",I,"T")) D
.D CK:$Y+1+P1>IOSL Q:YSLFT W !!,$J(I,4,0),?7,^YTT(601,YSTEST,"Q",I,"T",1,0)
.F J=2:1 Q:'$D(^YTT(601,YSTEST,"Q",I,"T",J,0)) D CK:$Y+P1>IOSL Q:YSLFT W !?7,^(0)
W ! D KILL^%ZTLOAD,^%ZISC G FIN
CK ;
D:'P0 WAIT^YSUTL Q:YSLFT W @IOF W:P0 !!?4,YSTNM," (",YSTS,")"," ",YSDT(1),! Q
FIN ;
K %ZIS,I,I0,IO("Q"),J,P0,P1,YSDTM,YSLFT,YSORD,YSTM,YSTNM,YSTEST,YSTS,ZTSK Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTPIT 1327 printed Nov 22, 2024@17:28:03 Page 2
YTPIT ;SLC/TGA-Print test/interview items ;11/15/90 17:06 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 ; Called from the top by MENU option YSPIT
+4 ;
+5 WRITE @IOF,!!,"Print Test/Interview Items"
PIT ;
+1 READ !!,"Instrument: ",YSTS:DTIME
+2 SET YSTOUT='$TEST
SET YSUOUT=YSTS["^"
+3 if YSTOUT!YSUOUT!(YSTS']"")
GOTO FIN
+4 IF YSTS["?"
SET YSTESTN="?"
SET YSXT=""
SET YSORD=DUZ
DO ^YTLIST
KILL YSTESTN,YSXT
GOTO PIT
+5 SET YSTEST=$ORDER(^YTT(601,"B",YSTS,0))
+6 IF 'YSTEST
WRITE $CHAR(7)," [Not found]"
GOTO PIT
+7 ;
+8 ; Don't print batteries!!!
+9 ;->
IF $PIECE($GET(^YTT(601,+YSTEST,0)),U,9)="B"
WRITE " Battery selection not allowed..."
GOTO PIT
+10 ;
+11 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO FIN
IF $DATA(IO("Q"))
SET ZTRTN="ENP^YTPIT"
SET (ZTSAVE("YSTS"),ZTSAVE("YSTEST"))=""
SET ZTDESC="YS INST ITEM PRINT"
DO ^%ZTLOAD
GOTO FIN
ENP ;
+1 KILL Y
DO ENDTM^YSUTL
SET YSLFT=0
SET YSTNM=$PIECE($PIECE(^YTT(601,YSTEST,"P"),U),"---",2)
SET P0=$SELECT(IOST?1"P".E:1,1:0)
SET P1=$SELECT(P0:8,1:3)
+2 USE IO
WRITE @IOF
WRITE !!?4,YSTNM," (",YSTS,")"," ",YSDT(1),!
FOR I=1:1
if '$DATA(^YTT(601,YSTEST,"Q",I,"T"))
QUIT
Begin DoDot:1
+3 if $Y+1+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !!,$JUSTIFY(I,4,0),?7,^YTT(601,YSTEST,"Q",I,"T",1,0)
+4 FOR J=2:1
if '$DATA(^YTT(601,YSTEST,"Q",I,"T",J,0))
QUIT
if $Y+P1>IOSL
DO CK
if YSLFT
QUIT
WRITE !?7,^(0)
End DoDot:1
+5 WRITE !
DO KILL^%ZTLOAD
DO ^%ZISC
GOTO FIN
CK ;
+1 if 'P0
DO WAIT^YSUTL
if YSLFT
QUIT
WRITE @IOF
if P0
WRITE !!?4,YSTNM," (",YSTS,")"," ",YSDT(1),!
QUIT
FIN ;
+1 KILL %ZIS,I,I0,IO("Q"),J,P0,P1,YSDTM,YSLFT,YSORD,YSTM,YSTNM,YSTEST,YSTS,ZTSK
QUIT
