source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTMCMI2B.m@ 724

Last change on this file since 724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1YTMCMI2B ;ALB/ASF-MCMI2 REPORT CONT; ;4/21/92 08:52
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4DC ;DISCLOUSURE CORRECTION
5 S X=+R I X<145!(X>590)!((X>249)&(X<401)) G HDAA
6 I X>144,X<250 S YSCF=250-X\10 S:250-X/10#1 YSCF=YSCF+1 F I=4:1:25 S YSCF1=$S(I=14:.5,I=15:.5,I=16:.5,I=23:.5,I=24:.5,I=25:.5,1:1),$P(S,U,I)=$P(S,U,I)+(YSCF*YSCF1\1) K YSCF1
7 I X>400,X<591 S YSCF=X-400\16 S:X-400/16#1 YSCF=YSCF+1 F I=4:1:25 S YSCF1=$S(I=14:.5,I=15:.5,I=16:.5,I=23:.5,I=24:.5,I=25:.5,1:1),$P(S,U,I)=$P(S,U,I)-(YSCF1*YSCF\1)
8HDAA ;DEPRESSION/ANXIETY ADJUSTMENT
9 D RD^YTMCMI2A S YSIO=$E(X,176),YSEP=$E(X,177) S:YSIO'="I" YSIO="O" S:YSEP'?1N YSEP=2
10 S YSAS=$P(S,U,17),YSDS=$P(S,U,20),Y=(YSAS-85)+(YSDS-85)
11 I YSEP=2,YSIO="I",YSAS>84,YSDS>84 S Y1=Y*.5\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.75\1 S:Y1>15 Y1=15 S $P(S,U,15)=$P(S,U,15)-Y1
12 I YSIO="I",YSEP=1,YSAS>84,YSDS>84 S Y1=Y S:Y>25 Y1=25 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S:Y1>20 Y1=20 S $P(S,U,15)=$P(S,U,15)-Y1
13 I YSIO="I",YSEP>2,YSAS>84,YSDS>84 S Y1=Y*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
14 I YSIO="O",YSAS>84,YSDS>84 S Y1=((YSAS-85)+(YSDS-85))\4 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=Y*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
15 I YSIO="I",YSEP=2,YSDS>84,YSAS<85 S Y1=YSDS-85*.5\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.75\1 S:Y1>15 Y1=15 S $P(S,U,15)=$P(S,U,15)-Y1
16 I YSIO="I",YSEP=1,YSDS>84,YSAS<85 S Y1=YSDS-85 S:Y1>25 Y1=25 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S:Y1>20 Y1=20 S $P(S,U,15)=$P(S,U,15)-Y1
17 I YSIO="I",YSEP>2,YSDS>84,YSAS<85 S Y1=YSDS-85*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
18 I YSIO="O",YSDS>84,YSAS<85 S Y1=YSDS-85*.25\1 S:Y1>15 Y1=15 S $P(S,U,5)=$P(S,U,5)-Y1,$P(S,U,13)=$P(S,U,13)-Y1 S Y1=YSDS-85*.5\1 S:Y1>10 Y1=10 S $P(S,U,15)=$P(S,U,15)-Y1
19XYZ ;Y-Z CORRECTION
20 S Y1=$P(S,U,2)-$P(S,U,3)/10,Y1=$J(Y1,0,0) S:Y1>10 Y1=10 S:Y1<-10 Y1=-10 F I=14,15,17,18,20 S $P(S,U,I)=$P(S,U,I)+Y1
21DCA ;DENIAL-COMPLAINT ADJUSTMENT
22 K YSS,YSS1,YSS2,^UTILITY("YT1",$J) F I=4:1:13 S ^UTILITY("YT1",$J,999-$P(S,U,I),I)=""
23 S Y1=$O(^UTILITY("YT1",$J,0)),Y2=0 F I=0:1 S Y2=$O(^UTILITY("YT1",$J,Y1,Y2)) Q:'Y2 S YSS1(Y2)=""
24 I I<2 S Y1=$O(^UTILITY("YT1",$J,Y1)),Y2=0 F I=0:1 S Y2=$O(^UTILITY("YT1",$J,Y1,Y2)) Q:'Y2 S YSS2(Y2)=""
25TIES ;
26 S YSS1="",YSS2="" I YSSEX="M" F I=13,4,7,9,10,6,8,11,12,5 S:$D(YSS1(I)) YSS1=YSS1_I_U S:$D(YSS2(I)) YSS2=YSS2_I_U
27 I YSSEX="F" F I=9,4,10,8,5,12,13,11,7,6 S:$D(YSS1(I)) YSS1=YSS1_I_U S:$D(YSS2(I)) YSS2=YSS2_I_U
28 S YSS=YSS1_YSS2
29 I +YSS=7!(+YSS=8)!(+YSS=11)!($P(YSS,U,2)=11) F I=14,15,16,17,20,18 S Y1=$S(I<16:4,I=16:2,I=18:13,1:15) S $P(S,U,I)=$P(S,U,I)+Y1
30 I +YSS=13!(+YSS=5)!($P(YSS,U,2)=5) F I=15,16,14,17,18,20 S Y1=$S(I=14:2,I<17:6,I=17:7,1:5) S $P(S,U,I)=$P(S,U,I)-Y1
31SCP ; LAST CORRECTION
32 I YSIO="I",YSEP=1 F I="23,8","24,10","25,4" S $P(S,U,+I)=$P(S,U,+I)+$P(I,",",2)
33 I YSIO="I",(YSEP=2!(YSEP=0)) F I="23,5","24,7","25,2" S $P(S,U,+I)=$P(S,U,+I)+$P(I,",",2)
34 K Y,Y1,^UTILITY("YT1",$J) G ^YTMCMI2C
Note: See TracBrowser for help on using the repository browser.