YTMCMI2A ;ALB/ASF- MCMI2 REPORT; ;6/26/91  17:58
 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
INP ;
 W !,"Was the MCMI2 taken by ",YSNM," administered as an ",!,"(I)npatient or (O)utpatient? "
 R Y:DTIME S YSTOUT='$T,YSUOUT=Y["^" G:YSTOUT!YSUOUT H^XUS S Y=$TR($E(Y_1),"io","IO") I "IO"'[Y W !,"Answer I for inpatient or O for outpatient",$C(7) G INP
 S YSMCMI2P=Y
EPIS ;
 W !,"Was the duration of the recent Axis I Episode: ",!,"1. Less than one week",!,"2. One to four weeks",!,"3. One to three months",!,"4. Three to twelve months",!,"5. Periodic; one to three years",!,"6. Continuous; one to "
 W "three years",!,"7. Periodic; three to seven years",!,"8. Continuous; three to seven years",!,"9. More than seven years",!,"0. Cannot categorize"
 R !,"Answer: ",Y:DTIME S YSTOUT='$T,YSUOUT=Y["^" G:YSTOUT!YSUOUT H^XUS S Y=$E(Y_"A") I Y'?1N W !,"Enter a number 0-9" G EPIS
 S YSMCMI2L=Y Q
F0 ;
 S R="",J=1
T0 ;
 S L=200,M=0,YSKK=1,YSTL=0 G:J=27 STND D RD
T1 ;
 I '$D(^YTT(601,YSTEST,"S",J,"K",YSKK,0)) S R=R_YSTL_"^",J=J+1 G T0
 S Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0),P=1
T2 ;
 S YSIT=$P(Y,U,P) I YSIT="" S YSKK=YSKK+1 G T1
 S A=$P(Y,U,P+1),P=P+2
 S:$E(X,+YSIT-M)=A YSTL=YSTL+(+$P(YSIT,"(",2)) G T2
RD ;
 S X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200) Q
STND ;
XX ;
 S X=($P(R,U,7)*1.5)+($P(R,U,12)*1.5)+($P(R,U,4)*1.6)+($P(R,U,5)*1.6)+($P(R,U,6)*1.6)+($P(R,U,13)*1.6)+$P(R,U,8)+$P(R,U,9)+$P(R,U,10)+$P(R,U,11),X=$J(X,3,0)
 S Y=^YTT(601,201,"S",1,YSSEX) F I=1:1 I X'>(+$P(Y,U,I)) S S=$P($P(Y,U,I),",",2) Q
 S S=S_"^",$P(R,U)=X F J=2:1:25 S X=^YTT(601,YSTEST,"S",J,YSSX),A=$P(R,U,J),S1=$P(X,U,A+1) S:S1="" S1=$P(X,U,$L(X,U)) S S=S_S1_U
 G ^YTMCMI2B
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTMCMI2A   1662     printed  Sep 23, 2025@19:53:36                                                                                                                                                                                                    Page 2
YTMCMI2A  ;ALB/ASF- MCMI2 REPORT; ;6/26/91  17:58
 +1       ;;5.01;MENTAL HEALTH;;Dec 30, 1994
INP       ;
 +1        WRITE !,"Was the MCMI2 taken by ",YSNM," administered as an ",!,"(I)npatient or (O)utpatient? "
 +2        READ Y:DTIME
           SET YSTOUT='$TEST
           SET YSUOUT=Y["^"
           if YSTOUT!YSUOUT
               GOTO H^XUS
           SET Y=$TRANSLATE($EXTRACT(Y_1),"io","IO")
           IF "IO"'[Y
               WRITE !,"Answer I for inpatient or O for outpatient",$CHAR(7)
               GOTO INP
 +3        SET YSMCMI2P=Y
EPIS      ;
 +1        WRITE !,"Was the duration of the recent Axis I Episode: ",!,"1. Less than one week",!,"2. One to four weeks",!,"3. One to three months",!,"4. Three to twelve months",!,"5. Periodic; one to three years",!,"6. Continuous; one to "
 +2        WRITE "three years",!,"7. Periodic; three to seven years",!,"8. Continuous; three to seven years",!,"9. More than seven years",!,"0. Cannot categorize"
 +3        READ !,"Answer: ",Y:DTIME
           SET YSTOUT='$TEST
           SET YSUOUT=Y["^"
           if YSTOUT!YSUOUT
               GOTO H^XUS
           SET Y=$EXTRACT(Y_"A")
           IF Y'?1N
               WRITE !,"Enter a number 0-9"
               GOTO EPIS
 +4        SET YSMCMI2L=Y
           QUIT 
F0        ;
 +1        SET R=""
           SET J=1
T0        ;
 +1        SET L=200
           SET M=0
           SET YSKK=1
           SET YSTL=0
           if J=27
               GOTO STND
           DO RD
T1        ;
 +1        IF '$DATA(^YTT(601,YSTEST,"S",J,"K",YSKK,0))
               SET R=R_YSTL_"^"
               SET J=J+1
               GOTO T0
 +2        SET Y=^YTT(601,YSTEST,"S",J,"K",YSKK,0)
           SET P=1
T2        ;
 +1        SET YSIT=$PIECE(Y,U,P)
           IF YSIT=""
               SET YSKK=YSKK+1
               GOTO T1
 +2        SET A=$PIECE(Y,U,P+1)
           SET P=P+2
 +3        if $EXTRACT(X,+YSIT-M)=A
               SET YSTL=YSTL+(+$PIECE(YSIT,"(",2))
           GOTO T2
RD        ;
 +1        SET X=^YTD(601.2,YSDFN,1,YSET,1,YSED,L\200)
           QUIT 
STND      ;
XX        ;
 +1        SET X=($PIECE(R,U,7)*1.5)+($PIECE(R,U,12)*1.5)+($PIECE(R,U,4)*1.6)+($PIECE(R,U,5)*1.6)+($PIECE(R,U,6)*1.6)+($PIECE(R,U,13)*1.6)+$PIECE(R,U,8)+$PIECE(R,U,9)+$PIECE(R,U,10)+$PIECE(R,U,11)
           SET X=$JUSTIFY(X,3,0)
 +2        SET Y=^YTT(601,201,"S",1,YSSEX)
           FOR I=1:1
               IF X'>(+$PIECE(Y,U,I))
                   SET S=$PIECE($PIECE(Y,U,I),",",2)
                   QUIT 
 +3        SET S=S_"^"
           SET $PIECE(R,U)=X
           FOR J=2:1:25
               SET X=^YTT(601,YSTEST,"S",J,YSSX)
               SET A=$PIECE(R,U,J)
               SET S1=$PIECE(X,U,A+1)
               if S1=""
                   SET S1=$PIECE(X,U,$LENGTH(X,U))
               SET S=S_S1_U
 +4        GOTO ^YTMCMI2B