YTMMPP.m

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 ---YTMMPP   2931     printed  Feb 18, 2025@23:44:09                                                                                                                                                                                                      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