YTMCMI2D ;ALB/ASF- MCMI2 REPORT CONTINUED; ;4/11/91 15:41
;;5.01;MENTAL HEALTH;;Dec 30, 1994
VAR ;
S V1="-------:--:---:---:----:---:---------:---------:----------:--------------------"
S V2="CATEGORY RAW BR 35 60 75 85 100",V3="",$P(V3,"*",41)=""
S V4="^M^O I^D N^I D^F I^I C^E E^R S^^ P^C E^L R P^I S A^N O T^I N T^C A E^A L R^L I N^ T^ Y^ ^^ P P^S E A^E R T^V S H^E N L^R L O^E T G^ Y Y^^C S^L Y^I N^N D^I R^C O^A M^L E^^ S^S Y^E N^V D^E R^R O^E M^ E^^"
S V5="^^1^^2^^3^^^^^4^5^6^7^8^9^10^11^12^13^^^^14^^15^^16^^^^^17^18^19^20^21^22^^^^23^^24^^25"
GRAPH ;
W !?12,"SCORES",?29,"PROFILE OF BR SCORES",?59,"DIAGNOSTIC SCALES",!,V2
F V6=1:1:50 D GRAPH1 D:IOST?1"C-".E&($Y+3>IOSL) SCR Q:YSLFT=1
W:'YSLFT !,V2 Q
GRAPH1 ;
I $P(V4,U,V6)="" W !,V1 Q
W !,$P(V4,U,V6),?7,":"
S X=$P(V5,U,V6) I 'X D CLN Q
S X1=$P(^YTT(601,YSTEST,"S",X,0),U,2),YSSP=$P(X1," "),YSPN=$P(X1," ",2,99) S:X>16&(X<23) YSPN=$P(YSPN," DIS")
S X1=$P(S,U,X),X2=0 S:X1<0 X1=0
W YSSP,?10,":",$J($P(R,U,X),3),":",$J(X1,3),":"
BAR ;
I X1>99 S X2=40 G PLOT
I X1>85 S X2=X1-85*$J(11/15,0,2)+29 G PLOT
I X1>75 S X2=X1-75*$J(10/10,0,2)+19 G PLOT
I X1>60 S X2=X1-60*$J(10/15,0,2)+9 G PLOT
I X1>35 S X2=X1-35*$J(4/25,0,2)+5 G PLOT
S X2=X1*5/35
PLOT ;
S X2=X2\1 S:X2<1&(X1>0) X2=1 I +R'>590,+R'<145,$P(R,U,26)<2 W $E(V3,1,X2)
D CLN W ?60,YSPN
K YSPN
Q
CLN ;
F I=7,10,14,18,23,27,37,47,58 I I'<$X W ?I,":"
Q
SCR ;
; 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 !
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[HYTMCMI2D 1786 printed Sep 23, 2025@19:53:39 Page 2
YTMCMI2D ;ALB/ASF- MCMI2 REPORT CONTINUED; ;4/11/91 15:41
+1 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
VAR ;
+1 SET V1="-------:--:---:---:----:---:---------:---------:----------:--------------------"
+2 SET V2="CATEGORY RAW BR 35 60 75 85 100"
SET V3=""
SET $PIECE(V3,"*",41)=""
+3 SET V4="^M^O I^D N^I D^F I^I C^E E^R S^^ P^C E^L R P^I S A^N O T^I N T^C A E^A L R^L I N^ T^ Y^ ^^ P P^S E A^E R T^V S H^E N L^R L O^E T G^ Y Y^^C S^L Y^I N^N D^I R^C O^A M^L E^^ S^S Y^E N^V D^E R^R O^E M^ E^^"
+4 SET V5="^^1^^2^^3^^^^^4^5^6^7^8^9^10^11^12^13^^^^14^^15^^16^^^^^17^18^19^20^21^22^^^^23^^24^^25"
GRAPH ;
+1 WRITE !?12,"SCORES",?29,"PROFILE OF BR SCORES",?59,"DIAGNOSTIC SCALES",!,V2
+2 FOR V6=1:1:50
DO GRAPH1
if IOST?1"C-".E&($Y+3>IOSL)
DO SCR
if YSLFT=1
QUIT
+3 if 'YSLFT
WRITE !,V2
QUIT
GRAPH1 ;
+1 IF $PIECE(V4,U,V6)=""
WRITE !,V1
QUIT
+2 WRITE !,$PIECE(V4,U,V6),?7,":"
+3 SET X=$PIECE(V5,U,V6)
IF 'X
DO CLN
QUIT
+4 SET X1=$PIECE(^YTT(601,YSTEST,"S",X,0),U,2)
SET YSSP=$PIECE(X1," ")
SET YSPN=$PIECE(X1," ",2,99)
if X>16&(X<23)
SET YSPN=$PIECE(YSPN," DIS")
+5 SET X1=$PIECE(S,U,X)
SET X2=0
if X1<0
SET X1=0
+6 WRITE YSSP,?10,":",$JUSTIFY($PIECE(R,U,X),3),":",$JUSTIFY(X1,3),":"
BAR ;
+1 IF X1>99
SET X2=40
GOTO PLOT
+2 IF X1>85
SET X2=X1-85*$JUSTIFY(11/15,0,2)+29
GOTO PLOT
+3 IF X1>75
SET X2=X1-75*$JUSTIFY(10/10,0,2)+19
GOTO PLOT
+4 IF X1>60
SET X2=X1-60*$JUSTIFY(10/15,0,2)+9
GOTO PLOT
+5 IF X1>35
SET X2=X1-35*$JUSTIFY(4/25,0,2)+5
GOTO PLOT
+6 SET X2=X1*5/35
PLOT ;
+1 SET X2=X2\1
if X2<1&(X1>0)
SET X2=1
IF +R'>590
IF +R'<145
IF $PIECE(R,U,26)<2
WRITE $EXTRACT(V3,1,X2)
+2 DO CLN
WRITE ?60,YSPN
+3 KILL YSPN
+4 QUIT
CLN ;
+1 FOR I=7,10,14,18,23,27,37,47,58
IF I'<$X
WRITE ?I,":"
+2 QUIT
SCR ;
+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 SET DIR(0)="E"
DO ^DIR
KILL DIR
SET YSTOUT=$DATA(DTOUT)
SET YSUOUT=$DATA(DUOUT)
SET YSLFT=$DATA(DIRUT)
+8 WRITE @IOF
QUIT
