YTNEOPI1 ;ALB/ASF-NEO PI-R TEST PROFILE ;7/28/95 12:56 ;
;;5.01;MENTAL HEALTH;**10**;Dec 30, 1994
A ;setup
K YSAST S YSTV=75,YSBV=25,YSINC=1,YSLE=5 F J=31,32,33,34,35,1:1:30 S A(J)=$P(S,U,J) S:A(J)>YSTV A(J)=YSTV S:A(J)<YSBV A(J)=YSBV
S YSVS=1,YSHS="75,65,55,45,35,25^"
S Z1="123456123456123456123456123456NEOAC"
S Z2=" VERY HIGH HIGH AVERAGE LOW VERY LOW"
S Z3="N N N N N N E E E E E E O O O O O O A A A A A A C C C C C C"
S Z4="1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6"
F I=1:1 S J=$P(YSHS,",",I) Q:J="" S H(I)=+J
S YSLC1=9999,YSLV=YSTV,YSIN2=YSINC/2
S YSHS=$O(H(-1)),H(-1)=-999
TOP ;
D DTA^YTREPT
W !!?30,"NEO PI-R Profile",!?5,"Factors"
W ?16,Z3,!?5,"N E O A C",?16,Z4
L ;loop thru graph
F I=31:1:35,1:1:30 S B(I)=(A(I)'<(YSLV-YSIN2))&(A(I)<(YSLV+YSIN2)) I $D(C(I)) S:(C(I)'<(YSLV-YSIN2))&(C(I)<(YSLV+YSIN2)) B(I)=2
S YSLL=$S(YSLV=75:">74",YSLV=25:"<26",YSLV#10=0:YSLV,1:" ")
W ;
S YSWS=(H(YSHS)>(YSLV-YSIN2))&(H(YSHS)<(YSLV+YSIN2)) I YSWS D WS G:YSLFT END S YSHS=$O(H(YSHS))
I 'YSWS D WL G:YSLFT END
S YSLC1=YSLC1+1 S:YSLC1>YSLE YSLC1=1
I YSLV>YSBV S YSLV=YSLV-YSINC GOTO L
D BOTTOM
END ;
K A,B,YSA,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS Q
WL ;
D:IOST?1"C-".E SCR^YTREPT:$Y>(IOSL-4) Q:YSUOUT!YSTOUT
W !,$J($E(Z2,(76-YSLV))_YSLL,4),"|"
F I=31:1:35,1:1:30 W $S(B(I):$E(Z1,I)_" ",1:" ") W:I=35 "|"
W "|",YSLL Q
WS ;
D:IOST?1"C-".E SCR^YTREPT:$Y>(IOSL-4) Q:YSUOUT!YSTOUT
W !,$J(YSLL,4),"|"
F I=31:1:35,1:1:30 W $S(B(I):$E(Z1,I)_"-",1:"--") W:I=35 "|"
W "|",YSLL Q
Q
BOTTOM ;
Q:YSUOUT!YSTOUT
W !?5,"N E O A C",?16,Z3,!?16,Z4
W !!,"Copyright (c) 1985, 1988, 1992, 1994 by Psychological Assessment Resources Inc.",!,"Reproduced by permission."
Q
IR ;responses
D RD^YTNEOPI
W !?30,"NEO PI-R Item Responses",!
F K=1:1:30 Q:YSLFT D:IOST?1"C-".E SCR^YTREPT:$Y+4>IOSL W ! F J=0,30,60,90,120,150,180,210 S I=J+K D IR1
W !," Validity A. " S I=241 D IR2
S X=$E(X,1,240)
W !!?30,"Summary of Responses",!?3
F J=1,2,3,4,5,"X" S J1=$L(X,J)-1/240*100 W $S(J=1:"SD",J=2:"D",J=3:"N",J=4:"A",J=5:"SA",1:"X"),": ",$J(J1,5,2),"% "
Q
IR1 W $J(I,4),". "
IR2 W $S($E(X,I)=1:"SD",$E(X,I)=2:" D",$E(X,I)=3:" N",$E(X,I)=4:" A",$E(X,I)=5:"SA",1:" X")," "
Q
VALD ;validity index
D DTA^YTREPT W !!?30,"Validity Indices",!
D RD^YTNEOPI
I $L($E(X,1,240),"X")>42 W !,"Profile not scored as respondant has skipped more",!,"than 41 items.",! Q
S YSVFLAG=0
D SS,241,YN,RAND,VTXT
Q
VTXT I YSVFLAG=0 W !,"Validity indices are within normal limits and the obtained",!,"test data appear to be valid.",! Q
Q:YSVFLAG=1
W !,"TEST RESULTS ARE NOT CONSIDERED VALID. The profile will",!,"be printed but it should only be used if the administrator has reason to"
W !,"believe that the profile is valid despite these indications of inaccurate",!,"or random responding."
Q
241 S Y=$E(X,241) I (Y<3)!(Y="X") S YSVFLAG=2 W !,"The respondant has denied answering the questions honestly and accurately."
Q
RAND ;randon resp
S Y=$E(X,1,240) I (Y?.E7"1".E)!(Y?.E10"2".E)!(Y?.E11"3".E)!(Y?.E15"4".E)!(Y?.E10"5".E) S YSVFLAG=2 W !,"The rater has used the same response option repeatedly in a manner",!,"that suggests random responding."
Q
YN ;yea_nea
S Y=$E(X,1,240),Y=($L(Y,5)-1)+($L(Y,4)-1)
I Y>149 S YSVFLAG=1 W !,"This profile should be interpreted with CAUTION because a strong acquiescence",!,"bias may have influnced the results."
I Y<51 S YSVFLAG=1 W !,"This profile should be interpreted with CAUTION because a strong nay-saying",!,"bias may have influnced the results."
Q
SS ;scale skips
F I=1:1:30 D SS1:$P(YSXK,U,I)>3
Q
SS1 I 'YSVFLAG S YSVFLAG=1 W !,"The following facet scale(s) have more than 3 skipped items:"
W !?3,$P(^YTT(601,YSTEST,"S",I,0),U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTNEOPI1 3824 printed Oct 16, 2024@18:18:37 Page 2
YTNEOPI1 ;ALB/ASF-NEO PI-R TEST PROFILE ;7/28/95 12:56 ;
+1 ;;5.01;MENTAL HEALTH;**10**;Dec 30, 1994
A ;setup
+1 KILL YSAST
SET YSTV=75
SET YSBV=25
SET YSINC=1
SET YSLE=5
FOR J=31,32,33,34,35,1:1:30
SET A(J)=$PIECE(S,U,J)
if A(J)>YSTV
SET A(J)=YSTV
if A(J)<YSBV
SET A(J)=YSBV
+2 SET YSVS=1
SET YSHS="75,65,55,45,35,25^"
+3 SET Z1="123456123456123456123456123456NEOAC"
+4 SET Z2=" VERY HIGH HIGH AVERAGE LOW VERY LOW"
+5 SET Z3="N N N N N N E E E E E E O O O O O O A A A A A A C C C C C C"
+6 SET Z4="1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6 1 2 3 4 5 6"
+7 FOR I=1:1
SET J=$PIECE(YSHS,",",I)
if J=""
QUIT
SET H(I)=+J
+8 SET YSLC1=9999
SET YSLV=YSTV
SET YSIN2=YSINC/2
+9 SET YSHS=$ORDER(H(-1))
SET H(-1)=-999
TOP ;
+1 DO DTA^YTREPT
+2 WRITE !!?30,"NEO PI-R Profile",!?5,"Factors"
+3 WRITE ?16,Z3,!?5,"N E O A C",?16,Z4
L ;loop thru graph
+1 FOR I=31:1:35,1:1:30
SET B(I)=(A(I)'<(YSLV-YSIN2))&(A(I)<(YSLV+YSIN2))
IF $DATA(C(I))
if (C(I)'<(YSLV-YSIN2))&(C(I)<(YSLV+YSIN2))
SET B(I)=2
+2 SET YSLL=$SELECT(YSLV=75:">74",YSLV=25:"<26",YSLV#10=0:YSLV,1:" ")
W ;
+1 SET YSWS=(H(YSHS)>(YSLV-YSIN2))&(H(YSHS)<(YSLV+YSIN2))
IF YSWS
DO WS
if YSLFT
GOTO END
SET YSHS=$ORDER(H(YSHS))
+2 IF 'YSWS
DO WL
if YSLFT
GOTO END
+3 SET YSLC1=YSLC1+1
if YSLC1>YSLE
SET YSLC1=1
+4 IF YSLV>YSBV
SET YSLV=YSLV-YSINC
GOTO L
+5 DO BOTTOM
END ;
+1 KILL A,B,YSA,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS
QUIT
WL ;
+1 if IOST?1"C-".E
if $Y>(IOSL-4)
DO SCR^YTREPT
if YSUOUT!YSTOUT
QUIT
+2 WRITE !,$JUSTIFY($EXTRACT(Z2,(76-YSLV))_YSLL,4),"|"
+3 FOR I=31:1:35,1:1:30
WRITE $SELECT(B(I):$EXTRACT(Z1,I)_" ",1:" ")
if I=35
WRITE "|"
+4 WRITE "|",YSLL
QUIT
WS ;
+1 if IOST?1"C-".E
if $Y>(IOSL-4)
DO SCR^YTREPT
if YSUOUT!YSTOUT
QUIT
+2 WRITE !,$JUSTIFY(YSLL,4),"|"
+3 FOR I=31:1:35,1:1:30
WRITE $SELECT(B(I):$EXTRACT(Z1,I)_"-",1:"--")
if I=35
WRITE "|"
+4 WRITE "|",YSLL
QUIT
+5 QUIT
BOTTOM ;
+1 if YSUOUT!YSTOUT
QUIT
+2 WRITE !?5,"N E O A C",?16,Z3,!?16,Z4
+3 WRITE !!,"Copyright (c) 1985, 1988, 1992, 1994 by Psychological Assessment Resources Inc.",!,"Reproduced by permission."
+4 QUIT
IR ;responses
+1 DO RD^YTNEOPI
+2 WRITE !?30,"NEO PI-R Item Responses",!
+3 FOR K=1:1:30
if YSLFT
QUIT
if IOST?1"C-".E
if $Y+4>IOSL
DO SCR^YTREPT
WRITE !
FOR J=0,30,60,90,120,150,180,210
SET I=J+K
DO IR1
+4 WRITE !," Validity A. "
SET I=241
DO IR2
+5 SET X=$EXTRACT(X,1,240)
+6 WRITE !!?30,"Summary of Responses",!?3
+7 FOR J=1,2,3,4,5,"X"
SET J1=$LENGTH(X,J)-1/240*100
WRITE $SELECT(J=1:"SD",J=2:"D",J=3:"N",J=4:"A",J=5:"SA",1:"X"),": ",$JUSTIFY(J1,5,2),"% "
+8 QUIT
IR1 WRITE $JUSTIFY(I,4),". "
IR2 WRITE $SELECT($EXTRACT(X,I)=1:"SD",$EXTRACT(X,I)=2:" D",$EXTRACT(X,I)=3:" N",$EXTRACT(X,I)=4:" A",$EXTRACT(X,I)=5:"SA",1:" X")," "
+1 QUIT
VALD ;validity index
+1 DO DTA^YTREPT
WRITE !!?30,"Validity Indices",!
+2 DO RD^YTNEOPI
+3 IF $LENGTH($EXTRACT(X,1,240),"X")>42
WRITE !,"Profile not scored as respondant has skipped more",!,"than 41 items.",!
QUIT
+4 SET YSVFLAG=0
+5 DO SS
DO 241
DO YN
DO RAND
DO VTXT
+6 QUIT
VTXT IF YSVFLAG=0
WRITE !,"Validity indices are within normal limits and the obtained",!,"test data appear to be valid.",!
QUIT
+1 if YSVFLAG=1
QUIT
+2 WRITE !,"TEST RESULTS ARE NOT CONSIDERED VALID. The profile will",!,"be printed but it should only be used if the administrator has reason to"
+3 WRITE !,"believe that the profile is valid despite these indications of inaccurate",!,"or random responding."
+4 QUIT
241 SET Y=$EXTRACT(X,241)
IF (Y<3)!(Y="X")
SET YSVFLAG=2
WRITE !,"The respondant has denied answering the questions honestly and accurately."
+1 QUIT
RAND ;randon resp
+1 SET Y=$EXTRACT(X,1,240)
IF (Y?.E7"1".E)!(Y?.E10"2".E)!(Y?.E11"3".E)!(Y?.E15"4".E)!(Y?.E10"5".E)
SET YSVFLAG=2
WRITE !,"The rater has used the same response option repeatedly in a manner",!,"that suggests random responding."
+2 QUIT
YN ;yea_nea
+1 SET Y=$EXTRACT(X,1,240)
SET Y=($LENGTH(Y,5)-1)+($LENGTH(Y,4)-1)
+2 IF Y>149
SET YSVFLAG=1
WRITE !,"This profile should be interpreted with CAUTION because a strong acquiescence",!,"bias may have influnced the results."
+3 IF Y<51
SET YSVFLAG=1
WRITE !,"This profile should be interpreted with CAUTION because a strong nay-saying",!,"bias may have influnced the results."
+4 QUIT
SS ;scale skips
+1 FOR I=1:1:30
if $PIECE(YSXK,U,I)>3
DO SS1
+2 QUIT
SS1 IF 'YSVFLAG
SET YSVFLAG=1
WRITE !,"The following facet scale(s) have more than 3 skipped items:"
+1 WRITE !?3,$PIECE(^YTT(601,YSTEST,"S",I,0),U,2)
+2 QUIT
