YTMMP6 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:12 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
S N2=0,L=10,YSLFT=0 S:'$D(YSMMPR) YSMMPR=$O(^YTT(601,"B","MMPR",0))
N5 ;
S L=L-1,N1=YSNT(L) G:T(N1)>44 C0 S N=$S(N1<5:N1+99,N1<9:N1+98,1:0) G:'N N5 D PR G:YSLFT C70 S N2=N2+1 G N5:N2<3,C0
E0 ;
S N2=0,L=0,YSLFT=0
E5 ;
S L=L+1 G C0:L>10 S N1=YSNT(L) G:T(N1)<60 C0
G E10:N1=1,E25:N1=2,E40:N1=3,E55:N1=4,E5:N1=5,E70:N1=6,E85:N1=7,E100:N1=8,E115:N1=9,E5:N1=10
E10 ;
G:YSHP1=1!(T(1)<65) E5 S N=$S(T(1)>84:80,T(1)>74:79,1:78) S:T(1)>84 M=2 G E125
E25 ;
S N=$S(YSNS9:0,T(2)<70:81,YSHP1=2!(YSHP2=2):0,T(2)<85:82,1:83) G:'N E5 S:N>81 M=24 S YSNS39=1 G E125
E40 ;
S N=$S(T(3)<65:0,T(3)<70:84,YSHP1=3!(YSHP2=3):0,T(3)<85:85,1:86) G E125:N,E5
E55 ;
G:YSHP1=4!(YSHP2=4)!(T(4)<65) E5 S N=$S(T(4)<75:87,T(4)<85:88,1:89) G E125
E70 ;
S N=$S(T(6)<70:90,YSHP1=6!(YSHP2=6):0,T(6)<80:91,1:92) G E125:N,E5
E85 ;
G:YSHP1=7!(YSHP2=7) E5 S N=$S(T(7)<75:93,T(7)<85:94,1:95) G E125
E100 ;
G:YSHP1=8!(YSHP2=8)!(T(8)<65) E5 S N=$S(T(8)<75:96,1:97) G E125
E115 ;
G:YSHP1=9!(YSHP2=9)!(T(9)<65) E5 S N=$S(T(9)<75:98,1:99)
E125 ;
D PR G:YSLFT C70 S N2=N2+1 G:N2<3 E5
C0 ;
I 'YSNS9&(T(1)>59)&(T(3)>59)&(T(3)-T(2)>9)&(T(1)-T(2)>9) S N=107 D PR G:YSLFT C70
I T(2)>59&(T(9)<45) S N=108,YSNS39=1 D PR G:YSLFT C70
G:YSSX="M" C25 I T(4)>69&(T(4)-T(5)>29) S N=109 D PR G:YSLFT C70
I 'YSNS26&(T(4)>59)&(T(6)>59)&(T(4)-T(3)>9)&(T(4)-T(5)>9)&(T(6)-T(5)>9)&(T(6)-T(7)>9) S N=110 D PR G:YSLFT C70
S N=$S(T(5)<41:111,T(5)>59:112,1:0) D:N PR G:YSLFT C70 G C40
C25 ;
S N=$S(T(5)<41:113,T(5)<60:0,T(5)<70:114,1:115) D:N PR G:YSLFT C70
C40 ;
S N=$S(YSNTY=3&(T(10)<45):116,YSNTY'=3&(T(10)>59)&(T(10)<70):117,1:0) D:N PR G:YSLFT C70
I YSHP1'=10&(T(10)>69) S N=118 D PR G:YSLFT C70
I T(2)>69&(YSHP1'=2)&(YSHP2'=2)&(YSNS9+YSNS39=0) S YSNSS=YSNSS_15
C60 ;
G:YSNSS="" C70 W ! S N=119 D PR F L=1:1 S N=$P(YSNSS,U,L)+119 Q:N=119 D PR Q:YSLFT
C70 K A,YSHP1,YSHP2,YSIS,YSJJ,YSKC,L,M,N,N1,N2,YSNS26,YSNS39,YSNS9,YSNSS,YSNT,YSNTY,T G ^YTMMP3:YSANLL=2,^YTMMP1
PR ;
I $Y>51 D DTA^YTREPT W !!
F YSJJ=1:1 Q:'$D(^YTT(601,YSMMPR,"G",N,1,YSJJ,0)) D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W !,^(0)
S:M YSNSS=YSNSS_M_"^",M=0 W ! Q
WAIT ;
; Added 5/6/94 LJA
N A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
N N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
N V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
;
F I0=1:1:(IOSL-$Y-2) W !
N DTOUT,DUOUT,DIRUT
S DIR(0)="E" D ^DIR K DIR S YSTOUT=$D(DTOUT),YSUOUT=$D(DUOUT),YSLFT=$D(DIRUT)
W @IOF Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMP6 2593 printed Apr 09, 2024@21:16:20 Page 2
YTMMP6 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:12 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 SET N2=0
SET L=10
SET YSLFT=0
if '$DATA(YSMMPR)
SET YSMMPR=$ORDER(^YTT(601,"B","MMPR",0))
N5 ;
+1 SET L=L-1
SET N1=YSNT(L)
if T(N1)>44
GOTO C0
SET N=$SELECT(N1<5:N1+99,N1<9:N1+98,1:0)
if 'N
GOTO N5
DO PR
if YSLFT
GOTO C70
SET N2=N2+1
if N2<3
GOTO N5
GOTO C0
E0 ;
+1 SET N2=0
SET L=0
SET YSLFT=0
E5 ;
+1 SET L=L+1
if L>10
GOTO C0
SET N1=YSNT(L)
if T(N1)<60
GOTO C0
+2 if N1=1
GOTO E10
if N1=2
GOTO E25
if N1=3
GOTO E40
if N1=4
GOTO E55
if N1=5
GOTO E5
if N1=6
GOTO E70
if N1=7
GOTO E85
if N1=8
GOTO E100
if N1=9
GOTO E115
if N1=10
GOTO E5
E10 ;
+1 if YSHP1=1!(T(1)<65)
GOTO E5
SET N=$SELECT(T(1)>84:80,T(1)>74:79,1:78)
if T(1)>84
SET M=2
GOTO E125
E25 ;
+1 SET N=$SELECT(YSNS9:0,T(2)<70:81,YSHP1=2!(YSHP2=2):0,T(2)<85:82,1:83)
if 'N
GOTO E5
if N>81
SET M=24
SET YSNS39=1
GOTO E125
E40 ;
+1 SET N=$SELECT(T(3)<65:0,T(3)<70:84,YSHP1=3!(YSHP2=3):0,T(3)<85:85,1:86)
if N
GOTO E125
GOTO E5
E55 ;
+1 if YSHP1=4!(YSHP2=4)!(T(4)<65)
GOTO E5
SET N=$SELECT(T(4)<75:87,T(4)<85:88,1:89)
GOTO E125
E70 ;
+1 SET N=$SELECT(T(6)<70:90,YSHP1=6!(YSHP2=6):0,T(6)<80:91,1:92)
if N
GOTO E125
GOTO E5
E85 ;
+1 if YSHP1=7!(YSHP2=7)
GOTO E5
SET N=$SELECT(T(7)<75:93,T(7)<85:94,1:95)
GOTO E125
E100 ;
+1 if YSHP1=8!(YSHP2=8)!(T(8)<65)
GOTO E5
SET N=$SELECT(T(8)<75:96,1:97)
GOTO E125
E115 ;
+1 if YSHP1=9!(YSHP2=9)!(T(9)<65)
GOTO E5
SET N=$SELECT(T(9)<75:98,1:99)
E125 ;
+1 DO PR
if YSLFT
GOTO C70
SET N2=N2+1
if N2<3
GOTO E5
C0 ;
+1 IF 'YSNS9&(T(1)>59)&(T(3)>59)&(T(3)-T(2)>9)&(T(1)-T(2)>9)
SET N=107
DO PR
if YSLFT
GOTO C70
+2 IF T(2)>59&(T(9)<45)
SET N=108
SET YSNS39=1
DO PR
if YSLFT
GOTO C70
+3 if YSSX="M"
GOTO C25
IF T(4)>69&(T(4)-T(5)>29)
SET N=109
DO PR
if YSLFT
GOTO C70
+4 IF 'YSNS26&(T(4)>59)&(T(6)>59)&(T(4)-T(3)>9)&(T(4)-T(5)>9)&(T(6)-T(5)>9)&(T(6)-T(7)>9)
SET N=110
DO PR
if YSLFT
GOTO C70
+5 SET N=$SELECT(T(5)<41:111,T(5)>59:112,1:0)
if N
DO PR
if YSLFT
GOTO C70
GOTO C40
C25 ;
+1 SET N=$SELECT(T(5)<41:113,T(5)<60:0,T(5)<70:114,1:115)
if N
DO PR
if YSLFT
GOTO C70
C40 ;
+1 SET N=$SELECT(YSNTY=3&(T(10)<45):116,YSNTY'=3&(T(10)>59)&(T(10)<70):117,1:0)
if N
DO PR
if YSLFT
GOTO C70
+2 IF YSHP1'=10&(T(10)>69)
SET N=118
DO PR
if YSLFT
GOTO C70
+3 IF T(2)>69&(YSHP1'=2)&(YSHP2'=2)&(YSNS9+YSNS39=0)
SET YSNSS=YSNSS_15
C60 ;
+1 if YSNSS=""
GOTO C70
WRITE !
SET N=119
DO PR
FOR L=1:1
SET N=$PIECE(YSNSS,U,L)+119
if N=119
QUIT
DO PR
if YSLFT
QUIT
C70 KILL A,YSHP1,YSHP2,YSIS,YSJJ,YSKC,L,M,N,N1,N2,YSNS26,YSNS39,YSNS9,YSNSS,YSNT,YSNTY,T
if YSANLL=2
GOTO ^YTMMP3
GOTO ^YTMMP1
PR ;
+1 IF $Y>51
DO DTA^YTREPT
WRITE !!
+2 FOR YSJJ=1:1
if '$DATA(^YTT(601,YSMMPR,"G",N,1,YSJJ,0))
QUIT
if IOST?1"C-".E
if $Y>(IOSL-4)
DO WAIT
if YSLFT
QUIT
WRITE !,^(0)
+3 if M
SET YSNSS=YSNSS_M_"^"
SET M=0
WRITE !
QUIT
WAIT ;
+1 ; Added 5/6/94 LJA
+2 NEW A,B,B1,C,D,E,E1,F,F1,G,G1,H,I,J,J1,J2,J3,J4,K,L,L1,L2,M,N
+3 NEW N1,N2,N3,N4,P,P0,P1,P3,R,R1,S,S1,T,T1,T2,TT,V,V1,V2,V3
+4 NEW V4,V5,V6,W,X,X0,X1,X2,X3,X4,X7,X8,X9,Y,Y1,Y2,Z,Z1,Z3
+5 ;
+6 FOR I0=1:1:(IOSL-$Y-2)
WRITE !
+7 NEW DTOUT,DUOUT,DIRUT
+8 SET DIR(0)="E"
DO ^DIR
KILL DIR
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
SET YSLFT=$DATA(DIRUT)
+9 WRITE @IOF
QUIT
