YTMMPP ;SLC/DKG-TEST PKG: MMPI PROFILE ;1/10/92 15:07 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
A ;
S Z1=0,X=YSSCALE,J=1,YSLFT=0 F I=11,12,13,1,2,3,4,5,6,7,8,9,10 S (A(J),YSA(J))=$P(X,U,I) S:$D(YSTAR(I)) YSAST(J)=YSTAR(I) S J=J+1
S YSNS=13,YSTV=120,YSBV=20,YSINC=2,YSLE=5
S X=" M M P I P R O F I L E ",Y=70-$L(X)\2 W !!?Y,X
; Following 2 lines commented 4/28/94 LJA. See 5*17
;I $D(^YTD(601.2,YSDFN,1,YSTEST,1,DOT,99)),^(99)="MMPIR" W "MMPIR"
;E W $P(^YTT(601,YSTEST,0),U)
S YSVS=3,YSHS="70,50,30^"
S YSSNM="L ,F ,K ,HS,D ,HY,PD,MF,PA,PT,SC,MA,SI" F J=1:1:13 S:$D(YSAST(J)) Z1=$P(YSSNM,",",J),Z1=$P(Z1," "),$P(YSSNM,",",J)=Z1_YSAST(J)
S YSSNM1="" F I=1:1:13 S YSSNM1=YSSNM1_$P($P(YSSNM,",",I)," ")_$S($L($P(YSSNM,",",I))>1:"",1:" ")_","
S V(3)="" F I=1:1 S J=$P(YSHS,",",I) Q:J="" S H(I)=+J
S YSLM=80-(YSNS*4+20)\2
S YSLC1=9999,YSLV=YSTV,YSIN2=YSINC/2
S YSHS=$O(H(-1)),H(-1)=-999
D WE
L ;
F I=1:1:YSNS S B(I)=(A(I)'<(YSLV-YSIN2))&(A(I)<(YSLV+YSIN2))
S YSLL=$S(YSLC1'<YSLE:$J(YSLV,5,0),1:" ")
W ;
S YSWS=(H(YSHS)>(YSLV-YSIN2))&(H(YSHS)<(YSLV+YSIN2)) I YSWS D WS G:YSLFT END S YSHS=$O(H(YSHS)) S:YSHS="" YSHS=-1
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 WE,SL F I=1:1:13 S A(I)=YSA(I)
D SV S X=YSRAW,J=1 F I=11,12,13,1,2,3,4,5,6,7,8,9,10 S A(J)=$P(X,U,I),J=J+1
D SV1
I $D(YSHDR) W !! D DTA W !
END ;
K A,B,YSA,YSNS,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS,YSSNM,YSSNM1,YSAST,YSQ Q
WE ;
W !?YSLM+5,"|" F I=1:1:YSNS-1 W "----"
W "---|" Q
WL ;
D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
F I=1:1:YSNS W $S(B(I):$E($P(YSSNM1,",",I)_" ",1,3),1:" ") I I<YSNS W $S($D(V(I)):"|",1:" ")
W "|",YSLL Q
WS ;
D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W:'Z1 ! W ?YSLM,YSLL,"|" S Z1=0
F I=1:1:YSNS W "-",$S(B(I):$P(YSSNM,",",I),I>3:I-3#10_"-",1:"--") I I<YSNS W $S($D(V(I)):"|",1:" ")
W "|",YSLL Q
SL ;
W !?6,"?",?YSLM+6 F I=1:1:YSNS W $E($P(YSSNM,",",I)_" ",1,4)
Q
SV ;
W !?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
Q
SV1 ;
W !?6,YSQ,?YSLM+6 F I=1:1:YSNS W $E(A(I)_" ",1,4)
Q
MAX ;
F I=1:1:YSNS S:A(I)>YSTV YSTV=A(I)
Q
MIN ;
S YSBV=99999 F I=1:1:YSNS S:A(I)<YSBV YSBV=A(I)
Q
INC ;
S YSINC=$J(YSTV-YSBV/20,1,4)
Q
DTA ;
S YSDTA=$P(^YTD(601.2,YSDFN,1,YSET,1,YSHD,0),U,5) S:YSDTA'="" YSDTA=$E(YSDTA,4,5)_"/"_$E(YSDTA,6,7)_"/"_$E(YSDTA,2,3)
S YSHDR=$E(YSHDR,1,43)_" "_YSSX_" AGE "_$J(YSAGE,2,0)_" "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)_" "_$E(YSHD,4,5)_"/"_$E(YSHD,6,7)_"/"_$E(YSHD,2,3)
W YSHDR," ",YSDTA W ! W:$D(YSAST) "'<' OR '>' indicates 'T' out of table range" W ?53,"PRINTED ENTERED " W:YSDTA'="" "ADMIN" Q
WAIT ;
;%%%% POSSIBLE READER CALL NEED TO LOOK FOR YSLFT TO HCANGE TO YSTOUT%%%
W $C(7) R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^" S:YSLFT["^"!'$T YSLFT=1 Q:YSLFT S Z1=1 W # Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMPP 2931 printed Sep 23, 2025@19:53:57 Page 2
YTMMPP ;SLC/DKG-TEST PKG: MMPI PROFILE ;1/10/92 15:07 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
A ;
+1 SET Z1=0
SET X=YSSCALE
SET J=1
SET YSLFT=0
FOR I=11,12,13,1,2,3,4,5,6,7,8,9,10
SET (A(J),YSA(J))=$PIECE(X,U,I)
if $DATA(YSTAR(I))
SET YSAST(J)=YSTAR(I)
SET J=J+1
+2 SET YSNS=13
SET YSTV=120
SET YSBV=20
SET YSINC=2
SET YSLE=5
+3 SET X=" M M P I P R O F I L E "
SET Y=70-$LENGTH(X)\2
WRITE !!?Y,X
+4 ; Following 2 lines commented 4/28/94 LJA. See 5*17
+5 ;I $D(^YTD(601.2,YSDFN,1,YSTEST,1,DOT,99)),^(99)="MMPIR" W "MMPIR"
+6 ;E W $P(^YTT(601,YSTEST,0),U)
+7 SET YSVS=3
SET YSHS="70,50,30^"
+8 SET YSSNM="L ,F ,K ,HS,D ,HY,PD,MF,PA,PT,SC,MA,SI"
FOR J=1:1:13
if $DATA(YSAST(J))
SET Z1=$PIECE(YSSNM,",",J)
SET Z1=$PIECE(Z1," ")
SET $PIECE(YSSNM,",",J)=Z1_YSAST(J)
+9 SET YSSNM1=""
FOR I=1:1:13
SET YSSNM1=YSSNM1_$PIECE($PIECE(YSSNM,",",I)," ")_$SELECT($LENGTH($PIECE(YSSNM,",",I))>1:"",1:" ")_","
+10 SET V(3)=""
FOR I=1:1
SET J=$PIECE(YSHS,",",I)
if J=""
QUIT
SET H(I)=+J
+11 SET YSLM=80-(YSNS*4+20)\2
+12 SET YSLC1=9999
SET YSLV=YSTV
SET YSIN2=YSINC/2
+13 SET YSHS=$ORDER(H(-1))
SET H(-1)=-999
+14 DO WE
L ;
+1 FOR I=1:1:YSNS
SET B(I)=(A(I)'<(YSLV-YSIN2))&(A(I)<(YSLV+YSIN2))
+2 SET YSLL=$SELECT(YSLC1'<YSLE:$JUSTIFY(YSLV,5,0),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))
if YSHS=""
SET YSHS=-1
+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 WE
DO SL
FOR I=1:1:13
SET A(I)=YSA(I)
+6 DO SV
SET X=YSRAW
SET J=1
FOR I=11,12,13,1,2,3,4,5,6,7,8,9,10
SET A(J)=$PIECE(X,U,I)
SET J=J+1
+7 DO SV1
+8 IF $DATA(YSHDR)
WRITE !!
DO DTA
WRITE !
END ;
+1 KILL A,B,YSA,YSNS,YSTV,YSTVL,YSBV,YSINC,YSIN2,YSLE,YSVS,YSHS,V,H,YSLL,YSLC1,YSWS,YSSNM,YSSNM1,YSAST,YSQ
QUIT
WE ;
+1 WRITE !?YSLM+5,"|"
FOR I=1:1:YSNS-1
WRITE "----"
+2 WRITE "---|"
QUIT
WL ;
+1 if IOST?1"C-".E
if $Y>(IOSL-4)
DO WAIT
if YSLFT
QUIT
if 'Z1
WRITE !
WRITE ?YSLM,YSLL,"|"
SET Z1=0
+2 FOR I=1:1:YSNS
WRITE $SELECT(B(I):$EXTRACT($PIECE(YSSNM1,",",I)_" ",1,3),1:" ")
IF I<YSNS
WRITE $SELECT($DATA(V(I)):"|",1:" ")
+3 WRITE "|",YSLL
QUIT
WS ;
+1 if IOST?1"C-".E
if $Y>(IOSL-4)
DO WAIT
if YSLFT
QUIT
if 'Z1
WRITE !
WRITE ?YSLM,YSLL,"|"
SET Z1=0
+2 FOR I=1:1:YSNS
WRITE "-",$SELECT(B(I):$PIECE(YSSNM,",",I),I>3:I-3#10_"-",1:"--")
IF I<YSNS
WRITE $SELECT($DATA(V(I)):"|",1:" ")
+3 WRITE "|",YSLL
QUIT
SL ;
+1 WRITE !?6,"?",?YSLM+6
FOR I=1:1:YSNS
WRITE $EXTRACT($PIECE(YSSNM,",",I)_" ",1,4)
+2 QUIT
SV ;
+1 WRITE !?YSLM+6
FOR I=1:1:YSNS
WRITE $EXTRACT(A(I)_" ",1,4)
+2 QUIT
SV1 ;
+1 WRITE !?6,YSQ,?YSLM+6
FOR I=1:1:YSNS
WRITE $EXTRACT(A(I)_" ",1,4)
+2 QUIT
MAX ;
+1 FOR I=1:1:YSNS
if A(I)>YSTV
SET YSTV=A(I)
+2 QUIT
MIN ;
+1 SET YSBV=99999
FOR I=1:1:YSNS
if A(I)<YSBV
SET YSBV=A(I)
+2 QUIT
INC ;
+1 SET YSINC=$JUSTIFY(YSTV-YSBV/20,1,4)
+2 QUIT
DTA ;
+1 SET YSDTA=$PIECE(^YTD(601.2,YSDFN,1,YSET,1,YSHD,0),U,5)
if YSDTA'=""
SET YSDTA=$EXTRACT(YSDTA,4,5)_"/"_$EXTRACT(YSDTA,6,7)_"/"_$EXTRACT(YSDTA,2,3)
+2 SET YSHDR=$EXTRACT(YSHDR,1,43)_" "_YSSX_" AGE "_$JUSTIFY(YSAGE,2,0)_" "_$EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)_" "_$EXTRACT(YSHD,4,5)_"/"_$EXTRACT(YSHD,6,7)_"/"_$EXTRACT(YSHD,2,3)
+3 WRITE YSHDR," ",YSDTA
WRITE !
if $DATA(YSAST)
WRITE "'<' OR '>' indicates 'T' out of table range"
WRITE ?53,"PRINTED ENTERED "
if YSDTA'=""
WRITE "ADMIN"
QUIT
WAIT ;
+1 ;%%%% POSSIBLE READER CALL NEED TO LOOK FOR YSLFT TO HCANGE TO YSTOUT%%%
+2 WRITE $CHAR(7)
READ YSLFT:DTIME
SET YSTOUT='$TEST
SET YSUOUT=YSLFT["^"
if YSLFT["^"!'$TEST
SET YSLFT=1
if YSLFT
QUIT
SET Z1=1
WRITE #
QUIT
+3 QUIT
