- 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 Mar 13, 2025@21:22:52 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
