- YTLIST ;SLC/TGA-LIST OF TESTS ;2/22/91 13:17 ;
- ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- ;
- S YSBAT=0
- I YSTESTN?1"?"1.AN!(YSTESTN?1.AN1"?") S YSBAT=1 S (YSTESTN,X)=$TR(YSTESTN,"?","") S DIC="^YTT(601,",DIC(0)="EQZ" D ^DIC K DIC W:Y'>0 " No match found for ",X Q:Y'>0 S YSTESTN=X G TS
- 1 ;
- S YSLFT=0 I YSTESTN'["?" G TS
- S X3=$D(^XUSEC("YSP",YSORD))
- ; I 'X3 G INT <-- Commented 10/17/94 LJA. Key check built into L1...
- S Z=59,YSNX="",N="" W !!?21,"--- LIST OF TESTS ---"
- L1 ;
- S N="" F S N=$O(^YTT(601,"ATN","T",N)) Q:N="" S I=$O(^(N,0)) I I S X=^YTT(601,I,0) D
- . I $P(X,U,2)="I",YSXT="CLERK^" QUIT ;->
- .
- . ; If doesn't have YSP key, and not VOCATIONAL and not EXEMPT...
- . I X3<1&($P(X,U,8)'["V")&($P(X,U,10)'="Y") QUIT ;->
- .
- . ; Operational?
- . I $P(X,U,13)="N" QUIT ;->
- .
- . S X2=$P(X,U,14),X2=$S(X2="N":"*",1:"") S X2=X2_$S($P(X,U,3)["Y":"+",1:"")
- . S YSNX=$P(X,U)_$S(X2="*"&(YSXT'="CLERK^"):"*",1:"")
- . S:X2["+" YSNX=YSNX_"+" S Z=Z+8#64
- . W:Z=3 ! W ?Z,YSNX
- ;
- INT ;
- Q:YSXT="CLERK^"
- S N="",I=0,Z=59 W !!?19,"--- LIST OF INTERVIEWS ---"
- L2 ;
- S N="" F S N=$O(^YTT(601,"ATN","I",N)) Q:N="" S I=$O(^(N,0)) I I S X=^YTT(601,I,0) I $P(X,U,13)'="N" S Z=Z+8#64 W:Z=3 ! W ?Z,$P(^(0),U)
- ;Q:'YSBAT I '$O(^YTT(601,"AI","B",0)) G LE Commented 4/22/94 LJA
- I '$O(^YTT(601,"AI","B",0)) G LE
- W !!?19,"--- LIST OF BATTERIES ---",!!,?3,"Name",?11,"Instruments in Battery",!?3,"----",?11,"----------------------"
- S N="" F S N=$O(^YTT(601,"ATN","B",N)) Q:N="" S I=$O(^(N,0)) I I W !?3,$P(^YTT(601,I,0),U) S X=$P(^YTT(601,I,"A"),"""",2) F J=1:1 S Y=$P(X,U,J) Q:Y="" W ?(8*J+3),$P(^YTT(601,Y,0),U)
- LE ;
- W ! K YSBAT,YSNX,I,X,X1,X2,X3 Q
- TS ;
- S Z=$F(YSTESTN,"?"),YSTESTN=$E(YSTESTN,1,Z-2)_$E(YSTESTN,Z,9) W !!
- S YSTEST=$O(^YTT(601,"B",YSTESTN,0)) G:'YSTEST TSB
- I $P(^YTT(601,YSTEST,0),U,9)="T",$D(^XUSEC("YSP",DUZ)) G T1
- I $P(^YTT(601,YSTEST,0),U,9)="I" G T2
- I $P(^YTT(601,YSTEST,0),U,9)="B" G T3
- TSB ;
- W ?5,"COMMENTS NOT FOUND FOR : ",YSTESTN Q
- T1 ;
- I $D(^YTT(601,YSTEST,"P")) S YSLN=$L($P(^("P"),U)) W ?(72-YSLN\2),$P(^("P"),U),!
- W !,"AUTHOR : " W:$D(^YTT(601,YSTEST,1)) ^(1)
- W !,"PUBLISHER : " W:$D(^YTT(601,YSTEST,2)) ^(2)
- W !,"FORM : " W:$D(^YTT(601,YSTEST,3)) ^(3)
- W !,"NO. ITEMS : ",$P(^YTT(601,YSTEST,0),U,11)
- W !,"NO. SCALES : ",$P(^YTT(601,YSTEST,0),U,12)
- W !,"NORMATIVE DATA:",! F K=1:1 Q:'$D(^YTT(601,YSTEST,6,K,0)) W ?5,^(0),!
- W "TEST USES:",! F K=1:1 Q:'$D(^YTT(601,YSTEST,7,K,0)) W ?5,^(0),!
- Q:'$D(^YTT(601,YSTEST,8,1,0)) W "INTERPRETIVE REPORT:",!
- F K=1:1 Q:'$D(^YTT(601,YSTEST,8,K,0)) W ?5,^(0),!
- Q
- T2 ;
- I $D(^YTT(601,YSTEST,"P")) S YSLN=$L($P(^("P"),U)) W ?(72-YSLN\2),$P(^("P"),U),!
- W !,"NUMBER OF ITEMS: ",$P(^YTT(601,YSTEST,0),U,11)
- W !,"SOURCE:",! F K=1:1 Q:'$D(^YTT(601,YSTEST,4,K,0)) W ?5,^(0),!
- W "DESCRIPTION:",! F K=1:1 Q:'$D(^YTT(601,YSTEST,5,K,0)) W ?5,^(0),!
- Q
- T3 ;
- W !,"TEST BATTERY CONSISTING OF:",! S X=$P(^YTT(601,YSTEST,"A"),"""",2) F I=1:1:$L(X,U)-1 W $P(^YTT(601,$P(X,U,I),0),U)," "
- W ! Q
- ENTB ;
- S YSORD=DUZ,YSBAT=0,YSTESTN="?" D 1 K I,K,X,X1,X2,X3,YSBAT,YSLN,YSNX,YSORD,YSTESTN,YSXT,Z Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTLIST 3162 printed Feb 18, 2025@23:43:41 Page 2
- YTLIST ;SLC/TGA-LIST OF TESTS ;2/22/91 13:17 ;
- +1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
- +2 ;
- +3 SET YSBAT=0
- +4 IF YSTESTN?1"?"1.AN!(YSTESTN?1.AN1"?")
- SET YSBAT=1
- SET (YSTESTN,X)=$TRANSLATE(YSTESTN,"?","")
- SET DIC="^YTT(601,"
- SET DIC(0)="EQZ"
- DO ^DIC
- KILL DIC
- if Y'>0
- WRITE " No match found for ",X
- if Y'>0
- QUIT
- SET YSTESTN=X
- GOTO TS
- 1 ;
- +1 SET YSLFT=0
- IF YSTESTN'["?"
- GOTO TS
- +2 SET X3=$DATA(^XUSEC("YSP",YSORD))
- +3 ; I 'X3 G INT <-- Commented 10/17/94 LJA. Key check built into L1...
- +4 SET Z=59
- SET YSNX=""
- SET N=""
- WRITE !!?21,"--- LIST OF TESTS ---"
- L1 ;
- +1 SET N=""
- FOR
- SET N=$ORDER(^YTT(601,"ATN","T",N))
- if N=""
- QUIT
- SET I=$ORDER(^(N,0))
- IF I
- SET X=^YTT(601,I,0)
- Begin DoDot:1
- +2 ;->
- IF $PIECE(X,U,2)="I"
- IF YSXT="CLERK^"
- QUIT
- +3 +4 ; If doesn't have YSP key, and not VOCATIONAL and not EXEMPT...
- +5 ;->
- IF X3<1&($PIECE(X,U,8)'["V")&($PIECE(X,U,10)'="Y")
- QUIT
- +6 +7 ; Operational?
- +8 ;->
- IF $PIECE(X,U,13)="N"
- QUIT
- +9 +10 SET X2=$PIECE(X,U,14)
- SET X2=$SELECT(X2="N":"*",1:"")
- SET X2=X2_$SELECT($PIECE(X,U,3)["Y":"+",1:"")
- +11 SET YSNX=$PIECE(X,U)_$SELECT(X2="*"&(YSXT'="CLERK^"):"*",1:"")
- +12 if X2["+"
- SET YSNX=YSNX_"+"
- SET Z=Z+8#64
- +13 if Z=3
- WRITE !
- WRITE ?Z,YSNX
- End DoDot:1
- +14 ;
- INT ;
- +1 if YSXT="CLERK^"
- QUIT
- +2 SET N=""
- SET I=0
- SET Z=59
- WRITE !!?19,"--- LIST OF INTERVIEWS ---"
- L2 ;
- +1 SET N=""
- FOR
- SET N=$ORDER(^YTT(601,"ATN","I",N))
- if N=""
- QUIT
- SET I=$ORDER(^(N,0))
- IF I
- SET X=^YTT(601,I,0)
- IF $PIECE(X,U,13)'="N"
- SET Z=Z+8#64
- if Z=3
- WRITE !
- WRITE ?Z,$PIECE(^(0),U)
- +2 ;Q:'YSBAT I '$O(^YTT(601,"AI","B",0)) G LE Commented 4/22/94 LJA
- +3 IF '$ORDER(^YTT(601,"AI","B",0))
- GOTO LE
- +4 WRITE !!?19,"--- LIST OF BATTERIES ---",!!,?3,"Name",?11,"Instruments in Battery",!?3,"----",?11,"----------------------"
- +5 SET N=""
- FOR
- SET N=$ORDER(^YTT(601,"ATN","B",N))
- if N=""
- QUIT
- SET I=$ORDER(^(N,0))
- IF I
- WRITE !?3,$PIECE(^YTT(601,I,0),U)
- SET X=$PIECE(^YTT(601,I,"A"),"""",2)
- FOR J=1:1
- SET Y=$PIECE(X,U,J)
- if Y=""
- QUIT
- WRITE ?(8*J+3),$PIECE(^YTT(601,Y,0),U)
- LE ;
- +1 WRITE !
- KILL YSBAT,YSNX,I,X,X1,X2,X3
- QUIT
- TS ;
- +1 SET Z=$FIND(YSTESTN,"?")
- SET YSTESTN=$EXTRACT(YSTESTN,1,Z-2)_$EXTRACT(YSTESTN,Z,9)
- WRITE !!
- +2 SET YSTEST=$ORDER(^YTT(601,"B",YSTESTN,0))
- if 'YSTEST
- GOTO TSB
- +3 IF $PIECE(^YTT(601,YSTEST,0),U,9)="T"
- IF $DATA(^XUSEC("YSP",DUZ))
- GOTO T1
- +4 IF $PIECE(^YTT(601,YSTEST,0),U,9)="I"
- GOTO T2
- +5 IF $PIECE(^YTT(601,YSTEST,0),U,9)="B"
- GOTO T3
- TSB ;
- +1 WRITE ?5,"COMMENTS NOT FOUND FOR : ",YSTESTN
- QUIT
- T1 ;
- +1 IF $DATA(^YTT(601,YSTEST,"P"))
- SET YSLN=$LENGTH($PIECE(^("P"),U))
- WRITE ?(72-YSLN\2),$PIECE(^("P"),U),!
- +2 WRITE !,"AUTHOR : "
- if $DATA(^YTT(601,YSTEST,1))
- WRITE ^(1)
- +3 WRITE !,"PUBLISHER : "
- if $DATA(^YTT(601,YSTEST,2))
- WRITE ^(2)
- +4 WRITE !,"FORM : "
- if $DATA(^YTT(601,YSTEST,3))
- WRITE ^(3)
- +5 WRITE !,"NO. ITEMS : ",$PIECE(^YTT(601,YSTEST,0),U,11)
- +6 WRITE !,"NO. SCALES : ",$PIECE(^YTT(601,YSTEST,0),U,12)
- +7 WRITE !,"NORMATIVE DATA:",!
- FOR K=1:1
- if '$DATA(^YTT(601,YSTEST,6,K,0))
- QUIT
- WRITE ?5,^(0),!
- +8 WRITE "TEST USES:",!
- FOR K=1:1
- if '$DATA(^YTT(601,YSTEST,7,K,0))
- QUIT
- WRITE ?5,^(0),!
- +9 if '$DATA(^YTT(601,YSTEST,8,1,0))
- QUIT
- WRITE "INTERPRETIVE REPORT:",!
- +10 FOR K=1:1
- if '$DATA(^YTT(601,YSTEST,8,K,0))
- QUIT
- WRITE ?5,^(0),!
- +11 QUIT
- T2 ;
- +1 IF $DATA(^YTT(601,YSTEST,"P"))
- SET YSLN=$LENGTH($PIECE(^("P"),U))
- WRITE ?(72-YSLN\2),$PIECE(^("P"),U),!
- +2 WRITE !,"NUMBER OF ITEMS: ",$PIECE(^YTT(601,YSTEST,0),U,11)
- +3 WRITE !,"SOURCE:",!
- FOR K=1:1
- if '$DATA(^YTT(601,YSTEST,4,K,0))
- QUIT
- WRITE ?5,^(0),!
- +4 WRITE "DESCRIPTION:",!
- FOR K=1:1
- if '$DATA(^YTT(601,YSTEST,5,K,0))
- QUIT
- WRITE ?5,^(0),!
- +5 QUIT
- T3 ;
- +1 WRITE !,"TEST BATTERY CONSISTING OF:",!
- SET X=$PIECE(^YTT(601,YSTEST,"A"),"""",2)
- FOR I=1:1:$LENGTH(X,U)-1
- WRITE $PIECE(^YTT(601,$PIECE(X,U,I),0),U)," "
- +2 WRITE !
- QUIT
- ENTB ;
- +1 SET YSORD=DUZ
- SET YSBAT=0
- SET YSTESTN="?"
- DO 1
- KILL I,K,X,X1,X2,X3,YSBAT,YSLN,YSNX,YSORD,YSTESTN,YSXT,Z
- QUIT