YTMMP3 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:09 ;
;;5.01;MENTAL HEALTH;;Dec 30, 1994
;
I IOST?1"C-".E,($Y>1) D WAIT G:YSLFT DONE
S YSLFT=0 S:'$D(YSMMPI) YSMMPI=$O(^YTT(601,"B","MMPI",0)) D DTA^YTREPT W !!?25,"--- CRITICAL ITEMS ---",! F I=1:1:3 W !,^YTT(601,YSMMPI,"G",1,1,I,0)
S YSFC="5^T^27^T^86^T^142^T^152^F^158^T^168^T^178^F^182^T^259^T^337^T^88^F^139^T^202^T^209^T^339^T^35,131^T^110^T^121^T^123^T^151^T^200^T^275^T^284^T^293^T^347^F^364^T^33,123^T^48^T^66^T^184^T^291^T^334^T^345^T"
S X1=^YTD(601.2,YSDFN,1,YSET,1,YSED,1),X2="" I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,2)) S X2=^YTD(601.2,YSDFN,1,YSET,1,YSED,2)
S Y="" F I=1:2:67 D CRIT
S YSFC="349^T^350^T^20,110^F^37,102^F^69^T^133^F^179^T^297^T^38,111^T^59^T^118^T^205^T^294^F^156^T^215^T^251^T^21,108^T^96^F^137^F^212^T^216^T^237^F^245^T^2^F^9^F^23,88^T^55^F^114^T^125^T^153^F^175^F^189^T^243^F"
F I=1:2:65 D CRIT
S YSFC="11^5^11^9^6^5^3^7^10"
S YSLE=0,YSLN=2
F I=1:1:10 S YSLB=YSLE+1,YSLE=YSLE+$P(YSFC,U,I) D PRT Q:YSLFT
K X1,X2,YSFC,Y
G DONE ;SLC; W !#,YSHDR,!!!?25,"--- ITEM RESPONSES ---",!! S L=200,M=0,YSIT=1
R2 ;
D RD S A=$L(X),B=A\10 G:'B R31
R3 ;
S K=10 F I=1:1:B D RLN
R31 ;
S K=-10*B+A I K D RLN G DONE
G:A<200 DONE S L=L+200,M=M+200 I $D(^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200))#2 G R2
DONE ;
K X G DONE^YTMMP4:$P(^YTT(601,YSTEST,0),U)'="MMPI" W ! G ^YTMMP4
RLN ;
W ?1 F YSKK=1:1:K W $J(YSIT,3,0)," ",$E(X,YSIT-M)," " S YSIT=YSIT+1
W ! Q
RD ;
S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
CRIT ;
S YSIT1=$P(YSFC,U,I),YSIT2=$P(YSIT1,",",2),YSIT1=+YSIT1,A=$P(YSFC,U,I+1)
I YSIT1>200 S C=$E(X2,YSIT1-200)
E S C=$E(X1,YSIT1)
I YSIT2'="" S C=C_$E(X2,YSIT2)
S Y=Y_(C[A) Q
PRT ;
I $E(Y,YSLB,YSLE)'[1 S YSLN=YSLN+YSLE-YSLB+2 Q
I $Y>52&(IOST?1"P".E) D DTA^YTREPT W !!
S A=^YTT(601,YSMMPI,"G",YSLN,1,1,0),B=72-$L(A)\2,YSLN=YSLN+1,YSJJ=YSLB D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W !!?B,A,!
PRT3 ;
I $Y>52&(IOST?1"C-".E) D DTA^YTREPT W !!
I $E(Y,YSJJ)=1 D:IOST?1"C-".E WAIT:$Y>(IOSL-4) Q:YSLFT W !,^YTT(601,YSMMPI,"G",YSLN,1,1,0) I $D(^YTT(601,YSMMPI,"G",YSLN,1,2,0)) W !,^(0)
S YSLN=YSLN+1,YSJJ=YSJJ+1 G:YSJJ'>YSLE PRT3 Q
WAIT ;
F I0=1:1:(IOSL-$Y-2) W !
;%%%% YSLFT TO YSTOUT ! YSUOUT
W !,"Press return to continue or ""^"" to omit Critical Item display " R YSLFT:DTIME S YSTOUT='$T,YSUOUT=YSLFT["^"
S:YSLFT["^"!'$T YSLFT=1
W @IOF K I0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMMP3 2400 printed Apr 09, 2024@21:20:40 Page 2
YTMMP3 ;SLC/DKG-TEST PKG: MMPI SCALES (CONT.) ; 10/20/88 09:09 ;
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
+2 ;
+3 IF IOST?1"C-".E
IF ($Y>1)
DO WAIT
if YSLFT
GOTO DONE
+4 SET YSLFT=0
if '$DATA(YSMMPI)
SET YSMMPI=$ORDER(^YTT(601,"B","MMPI",0))
DO DTA^YTREPT
WRITE !!?25,"--- CRITICAL ITEMS ---",!
FOR I=1:1:3
WRITE !,^YTT(601,YSMMPI,"G",1,1,I,0)
+5 SET YSFC="5^T^27^T^86^T^142^T^152^F^158^T^168^T^178^F^182^T^259^T^337^T^88^F^139^T^202^T^209^T^339^T^35,131^T^110^T^121^T^123^T^151^T^200^T^275^T^284^T^293^T^347^F^364^T^33,123^T^48^T^66^T^184^T^291^T^334^T^345^T"
+6 SET X1=^YTD(601.2,YSDFN,1,YSET,1,YSED,1)
SET X2=""
IF $DATA(^YTD(601.2,YSDFN,1,YSET,1,YSED,2))
SET X2=^YTD(601.2,YSDFN,1,YSET,1,YSED,2)
+7 SET Y=""
FOR I=1:2:67
DO CRIT
+8 SET YSFC="349^T^350^T^20,110^F^37,102^F^69^T^133^F^179^T^297^T^38,111^T^59^T^118^T^205^T^294^F^156^T^215^T^251^T^21,108^T^96^F^137^F^212^T^216^T^237^F^245^T^2^F^9^F^23,88^T^55^F^114^T^125^T^153^F^175^F^189^T^243^F"
+9 FOR I=1:2:65
DO CRIT
+10 SET YSFC="11^5^11^9^6^5^3^7^10"
+11 SET YSLE=0
SET YSLN=2
+12 FOR I=1:1:10
SET YSLB=YSLE+1
SET YSLE=YSLE+$PIECE(YSFC,U,I)
DO PRT
if YSLFT
QUIT
+13 KILL X1,X2,YSFC,Y
+14 ;SLC; W !#,YSHDR,!!!?25,"--- ITEM RESPONSES ---",!! S L=200,M=0,YSIT=1
GOTO DONE
R2 ;
+1 DO RD
SET A=$LENGTH(X)
SET B=A\10
if 'B
GOTO R31
R3 ;
+1 SET K=10
FOR I=1:1:B
DO RLN
R31 ;
+1 SET K=-10*B+A
IF K
DO RLN
GOTO DONE
+2 if A<200
GOTO DONE
SET L=L+200
SET M=M+200
IF $DATA(^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200))#2
GOTO R2
DONE ;
+1 KILL X
if $PIECE(^YTT(601,YSTEST,0),U)'="MMPI"
GOTO DONE^YTMMP4
WRITE !
GOTO ^YTMMP4
RLN ;
+1 WRITE ?1
FOR YSKK=1:1:K
WRITE $JUSTIFY(YSIT,3,0)," ",$EXTRACT(X,YSIT-M)," "
SET YSIT=YSIT+1
+2 WRITE !
QUIT
RD ;
+1 SET X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200)
QUIT
CRIT ;
+1 SET YSIT1=$PIECE(YSFC,U,I)
SET YSIT2=$PIECE(YSIT1,",",2)
SET YSIT1=+YSIT1
SET A=$PIECE(YSFC,U,I+1)
+2 IF YSIT1>200
SET C=$EXTRACT(X2,YSIT1-200)
+3 IF '$TEST
SET C=$EXTRACT(X1,YSIT1)
+4 IF YSIT2'=""
SET C=C_$EXTRACT(X2,YSIT2)
+5 SET Y=Y_(C[A)
QUIT
PRT ;
+1 IF $EXTRACT(Y,YSLB,YSLE)'[1
SET YSLN=YSLN+YSLE-YSLB+2
QUIT
+2 IF $Y>52&(IOST?1"P".E)
DO DTA^YTREPT
WRITE !!
+3 SET A=^YTT(601,YSMMPI,"G",YSLN,1,1,0)
SET B=72-$LENGTH(A)\2
SET YSLN=YSLN+1
SET YSJJ=YSLB
if IOST?1"C-".E
if $Y>(IOSL-4)
DO WAIT
if YSLFT
QUIT
WRITE !!?B,A,!
PRT3 ;
+1 IF $Y>52&(IOST?1"C-".E)
DO DTA^YTREPT
WRITE !!
+2 IF $EXTRACT(Y,YSJJ)=1
if IOST?1"C-".E
if $Y>(IOSL-4)
DO WAIT
if YSLFT
QUIT
WRITE !,^YTT(601,YSMMPI,"G",YSLN,1,1,0)
IF $DATA(^YTT(601,YSMMPI,"G",YSLN,1,2,0))
WRITE !,^(0)
+3 SET YSLN=YSLN+1
SET YSJJ=YSJJ+1
if YSJJ'>YSLE
GOTO PRT3
QUIT
WAIT ;
+1 FOR I0=1:1:(IOSL-$Y-2)
WRITE !
+2 ;%%%% YSLFT TO YSTOUT ! YSUOUT
+3 WRITE !,"Press return to continue or ""^"" to omit Critical Item display "
READ YSLFT:DTIME
SET YSTOUT='$TEST
SET YSUOUT=YSLFT["^"
+4 if YSLFT["^"!'$TEST
SET YSLFT=1
+5 WRITE @IOF
KILL I0
QUIT
