- 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 23, 2025@18:31:56 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
