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 Apr 09, 2024@21:17:32 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
