YSASFS ;ALB/ASF- ASI FACTOR SCORES ;10/24/01 14:55
;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
Q
NUM ;
S N=$$GET1^DIQ(604,YSIEN,X)
S:N="YES" N=1
S:N="NO" N=0
; test I N'?1N.N W !,X
Q
EN(YSDATA,YS) ;
N X,N,YSDA1,YSDA13,YSDA15,YSDA25,YSDA3,YSDA36,YSDA37,YSDA39,YSDA40,YSDA41,YSDA42,YSDA43,YSDA44,YSDA5,YSE17,YSFAM,YSFS10,YSFS12,YSFS14,YSFS16,YSFS18,YSFS20,YSFS22,YSFS30,YSFS32,YSFSAF,YSFSAL,YSFSDR
N YSFSFS,YSFSLG,YSFSPSY,YSIEN,YSL2,YSL22,YSL25,YSL26,YSL27,YSNUM,YSP10,YSP14,YSP18,YSP20,YSP21,YSP22,YSP4,YSP6,YSTALC,YSTDRU,YSTFAM,YSTLG,YSTPSY
S YSIEN=$G(YS("IEN"))
I YSIEN="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO IEN" Q ;--> OUT
I '$D(^YSTX(604,YSIEN)) S YSDATA(1)="[ERROR]",YSDATA(2)="NO SUCH ASI" Q ;--> OUT
S YSDATA(1)="[DATA]"
CHKFILL ;check that All are answered
S YSNUM=0
F X=10.01,10.22,10.25,10.42,10.04,11.09 Q:YSNUM D NUM
F X=11.11,11.14,11.15,11.16,11.17,11.165,11.175 Q:YSNUM D NUM
F X=10.07,9.25,18.23,18.05,18.07,18.25,18.27 Q:YSNUM D NUM
F X=14.02,14.27,14.31,14.32,14.33,19.11,19.16,19.21,19.23,19.24,19.25,19.04,19.06 Q:YSNUM D NUM
I YSNUM S YSDATA(2)=YSNUM_" NOT NUMERIC" Q ;-->OUT
ALCFS ;alcohol factor
S X=10.01 D NUM S YSDA1=N
S X=10.04 D NUM S YSDA3=N
S X=11.09 D NUM S YSDA36=N
S X=11.14 D NUM S YSDA39=N
S X=11.16 D NUM S YSDA41=N
S X=11.165 D NUM S YSDA43=N
;
S YSDA1=(((YSDA1-8.1)/10.4)*3)+10
S YSDA3=(((YSDA3-6.2)/9.8)*3)+10
S YSDA36=(((YSDA36-42.1)/98)*3)+10
S YSDA39=(((YSDA39-4.4)/9.1)*3)+10
S YSDA41=(((YSDA41-0.8)/1.4)*3)+10
S YSDA43=(((YSDA43-1.1)/1.7)*3)+10
S YSFSAL=YSDA1+YSDA3+YSDA36+YSDA39+YSDA41+YSDA43+.0000001
ALCT I (YSFSAL>101) S YSTALC=73
I (YSFSAL>98)&(YSFSAL<101) S YSTALC=70
I (YSFSAL>96)&(YSFSAL<98) S YSTALC=68
I (YSFSAL>94)&(YSFSAL<96) S YSTALC=67
I (YSFSAL>92)&(YSFSAL<94) S YSTALC=66
I (YSFSAL>90)&(YSFSAL<92) S YSTALC=65
I (YSFSAL>88)&(YSFSAL<90) S YSTALC=64
I (YSFSAL>86)&(YSFSAL<88) S YSTALC=63
I (YSFSAL>84)&(YSFSAL<86) S YSTALC=62
I (YSFSAL>81)&(YSFSAL<84) S YSTALC=61
I (YSFSAL>79)&(YSFSAL<81) S YSTALC=60
I (YSFSAL>76)&(YSFSAL<79) S YSTALC=59
I (YSFSAL>72)&(YSFSAL<76) S YSTALC=58
I (YSFSAL>69)&(YSFSAL<72) S YSTALC=57
I (YSFSAL>66)&(YSFSAL<69) S YSTALC=56
I (YSFSAL>63)&(YSFSAL<66) S YSTALC=55
I (YSFSAL>61)&(YSFSAL<63) S YSTALC=54
I (YSFSAL>58)&(YSFSAL<61) S YSTALC=53
I (YSFSAL>56)&(YSFSAL<58) S YSTALC=52
I (YSFSAL>53)&(YSFSAL<56) S YSTALC=51
I (YSFSAL>52)&(YSFSAL<53) S YSTALC=50
I (YSFSAL>51)&(YSFSAL<52) S YSTALC=49
I (YSFSAL>50)&(YSFSAL<51) S YSTALC=46
I (YSFSAL<50) S YSTALC=40
S YSDATA(2)="ALCOHOL^"_$J(YSFSAL-.0000001,6,2)_U_YSTALC
DRUGFS ;drug abuse factor
S X=9.25 D NUM S YSE17=N
S X=10.07 D NUM S YSDA5=N
S X=10.25 D NUM S YSDA15=N
S X=10.42 D NUM S YSDA25=N
S X=11.11 D NUM S YSDA37=N
S X=11.15 D NUM S YSDA40=N
S X=11.17 D NUM S YSDA42=N
S X=11.175 D NUM S YSDA44=N
S X=14.31 D NUM S YSL25=N
;
S YSE17=(((YSE17-303.9)/1076.1)*3)+10
S YSDA5=(((YSDA5-7.2)/11.2)*3)+10
S YSDA15=(((YSDA15-7.4)/10.2)*3)+10
S YSDA25=(((YSDA25-10.9)/11.5)*3)+10
S YSDA37=(((YSDA37-489.8)/863.9)*3)+10
S YSDA40=(((YSDA40-12.5)/12.8)*3)+10
S YSDA42=(((YSDA42-2.2)/1.7)*3)+10
S YSDA44=(((YSDA44-2.7)/1.7)*3)+10
S YSL25=(((YSL25-3.9)/8.8)*3)+10
;
S YSFSDR=YSE17+YSDA5+YSDA15+YSDA25+YSDA37+YSDA40+YSDA42+YSDA44+YSL25+.0000001
DRT I YSFSDR>141 S YSTDRU=73
I (YSFSDR>135)&(YSFSDR<141) S YSTDRU=70
I (YSFSDR>131)&(YSFSDR<135) S YSTDRU=68
I (YSFSDR>127)&(YSFSDR<131) S YSTDRU=67
I (YSFSDR>125)&(YSFSDR<127) S YSTDRU=66
I (YSFSDR>121)&(YSFSDR<125) S YSTDRU=65
I (YSFSDR>117)&(YSFSDR<121) S YSTDRU=64
I (YSFSDR>116)&(YSFSDR<117) S YSTDRU=63
I (YSFSDR>113)&(YSFSDR<116) S YSTDRU=62
I (YSFSDR>111)&(YSFSDR<113) S YSTDRU=61
I (YSFSDR>109)&(YSFSDR<111) S YSTDRU=60
I (YSFSDR>107)&((YSFSDR<109)) S YSTDRU=59
I (YSFSDR>104)&(YSFSDR<107) S YSTDRU=58
I (YSFSDR>102)&(YSFSDR<104) S YSTDRU=57
I (YSFSDR>100)&(YSFSDR<102) S YSTDRU=56
I (YSFSDR>98)&(YSFSDR<100) S YSTDRU=55
I (YSFSDR>96)&(YSFSDR<98) S YSTDRU=54
I (YSFSDR>94)&(YSFSDR<96) S YSTDRU=53
I (YSFSDR>92)&(YSFSDR<94) S YSTDRU=52
I (YSFSDR>90)&(YSFSDR<92) S YSTDRU=51
I (YSFSDR>89)&(YSFSDR<90) S YSTDRU=50
I (YSFSDR>87)&(YSFSDR<89) S YSTDRU=49
I (YSFSDR>86)&(YSFSDR<87) S YSTDRU=48
I (YSFSDR>84)&(YSFSDR<86) S YSTDRU=47
I (YSFSDR>82)&(YSFSDR<84) S YSTDRU=46
I (YSFSDR>80)&(YSFSDR<82) S YSTDRU=45
I (YSFSDR>78)&(YSFSDR<80) S YSTDRU=44
I (YSFSDR>76)&(YSFSDR<78) S YSTDRU=43
I (YSFSDR>75)&(YSFSDR<76) S YSTDRU=42
I (YSFSDR>72)&(YSFSDR<75) S YSTDRU=41
I (YSFSDR>70)&(YSFSDR<72) S YSTDRU=40
I (YSFSDR>69)&(YSFSDR<70) S YSTDRU=39
I YSFSDR<69 S YSTDRU=35
;
S YSDATA(3)="DRUG^"_$J(YSFSDR-.0000001,6,2)_U_YSTDRU
;
D ^YSASFS1 ;NEXT FACTORS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASFS 4755 printed Dec 13, 2024@02:13:06 Page 2
YSASFS ;ALB/ASF- ASI FACTOR SCORES ;10/24/01 14:55
+1 ;;5.01;MENTAL HEALTH;**71**;Dec 30, 1994
+2 QUIT
NUM ;
+1 SET N=$$GET1^DIQ(604,YSIEN,X)
+2 if N="YES"
SET N=1
+3 if N="NO"
SET N=0
+4 ; test I N'?1N.N W !,X
+5 QUIT
EN(YSDATA,YS) ;
+1 NEW X,N,YSDA1,YSDA13,YSDA15,YSDA25,YSDA3,YSDA36,YSDA37,YSDA39,YSDA40,YSDA41,YSDA42,YSDA43,YSDA44,YSDA5,YSE17,YSFAM,YSFS10,YSFS12,YSFS14,YSFS16,YSFS18,YSFS20,YSFS22,YSFS30,YSFS32,YSFSAF,YSFSAL,YSFSDR
+2 NEW YSFSFS,YSFSLG,YSFSPSY,YSIEN,YSL2,YSL22,YSL25,YSL26,YSL27,YSNUM,YSP10,YSP14,YSP18,YSP20,YSP21,YSP22,YSP4,YSP6,YSTALC,YSTDRU,YSTFAM,YSTLG,YSTPSY
+3 SET YSIEN=$GET(YS("IEN"))
+4 ;--> OUT
IF YSIEN=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO IEN"
QUIT
+5 ;--> OUT
IF '$DATA(^YSTX(604,YSIEN))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="NO SUCH ASI"
QUIT
+6 SET YSDATA(1)="[DATA]"
CHKFILL ;check that All are answered
+1 SET YSNUM=0
+2 FOR X=10.01,10.22,10.25,10.42,10.04,11.09
if YSNUM
QUIT
DO NUM
+3 FOR X=11.11,11.14,11.15,11.16,11.17,11.165,11.175
if YSNUM
QUIT
DO NUM
+4 FOR X=10.07,9.25,18.23,18.05,18.07,18.25,18.27
if YSNUM
QUIT
DO NUM
+5 FOR X=14.02,14.27,14.31,14.32,14.33,19.11,19.16,19.21,19.23,19.24,19.25,19.04,19.06
if YSNUM
QUIT
DO NUM
+6 ;-->OUT
IF YSNUM
SET YSDATA(2)=YSNUM_" NOT NUMERIC"
QUIT
ALCFS ;alcohol factor
+1 SET X=10.01
DO NUM
SET YSDA1=N
+2 SET X=10.04
DO NUM
SET YSDA3=N
+3 SET X=11.09
DO NUM
SET YSDA36=N
+4 SET X=11.14
DO NUM
SET YSDA39=N
+5 SET X=11.16
DO NUM
SET YSDA41=N
+6 SET X=11.165
DO NUM
SET YSDA43=N
+7 ;
+8 SET YSDA1=(((YSDA1-8.1)/10.4)*3)+10
+9 SET YSDA3=(((YSDA3-6.2)/9.8)*3)+10
+10 SET YSDA36=(((YSDA36-42.1)/98)*3)+10
+11 SET YSDA39=(((YSDA39-4.4)/9.1)*3)+10
+12 SET YSDA41=(((YSDA41-0.8)/1.4)*3)+10
+13 SET YSDA43=(((YSDA43-1.1)/1.7)*3)+10
+14 SET YSFSAL=YSDA1+YSDA3+YSDA36+YSDA39+YSDA41+YSDA43+.0000001
ALCT IF (YSFSAL>101)
SET YSTALC=73
+1 IF (YSFSAL>98)&(YSFSAL<101)
SET YSTALC=70
+2 IF (YSFSAL>96)&(YSFSAL<98)
SET YSTALC=68
+3 IF (YSFSAL>94)&(YSFSAL<96)
SET YSTALC=67
+4 IF (YSFSAL>92)&(YSFSAL<94)
SET YSTALC=66
+5 IF (YSFSAL>90)&(YSFSAL<92)
SET YSTALC=65
+6 IF (YSFSAL>88)&(YSFSAL<90)
SET YSTALC=64
+7 IF (YSFSAL>86)&(YSFSAL<88)
SET YSTALC=63
+8 IF (YSFSAL>84)&(YSFSAL<86)
SET YSTALC=62
+9 IF (YSFSAL>81)&(YSFSAL<84)
SET YSTALC=61
+10 IF (YSFSAL>79)&(YSFSAL<81)
SET YSTALC=60
+11 IF (YSFSAL>76)&(YSFSAL<79)
SET YSTALC=59
+12 IF (YSFSAL>72)&(YSFSAL<76)
SET YSTALC=58
+13 IF (YSFSAL>69)&(YSFSAL<72)
SET YSTALC=57
+14 IF (YSFSAL>66)&(YSFSAL<69)
SET YSTALC=56
+15 IF (YSFSAL>63)&(YSFSAL<66)
SET YSTALC=55
+16 IF (YSFSAL>61)&(YSFSAL<63)
SET YSTALC=54
+17 IF (YSFSAL>58)&(YSFSAL<61)
SET YSTALC=53
+18 IF (YSFSAL>56)&(YSFSAL<58)
SET YSTALC=52
+19 IF (YSFSAL>53)&(YSFSAL<56)
SET YSTALC=51
+20 IF (YSFSAL>52)&(YSFSAL<53)
SET YSTALC=50
+21 IF (YSFSAL>51)&(YSFSAL<52)
SET YSTALC=49
+22 IF (YSFSAL>50)&(YSFSAL<51)
SET YSTALC=46
+23 IF (YSFSAL<50)
SET YSTALC=40
+24 SET YSDATA(2)="ALCOHOL^"_$JUSTIFY(YSFSAL-.0000001,6,2)_U_YSTALC
DRUGFS ;drug abuse factor
+1 SET X=9.25
DO NUM
SET YSE17=N
+2 SET X=10.07
DO NUM
SET YSDA5=N
+3 SET X=10.25
DO NUM
SET YSDA15=N
+4 SET X=10.42
DO NUM
SET YSDA25=N
+5 SET X=11.11
DO NUM
SET YSDA37=N
+6 SET X=11.15
DO NUM
SET YSDA40=N
+7 SET X=11.17
DO NUM
SET YSDA42=N
+8 SET X=11.175
DO NUM
SET YSDA44=N
+9 SET X=14.31
DO NUM
SET YSL25=N
+10 ;
+11 SET YSE17=(((YSE17-303.9)/1076.1)*3)+10
+12 SET YSDA5=(((YSDA5-7.2)/11.2)*3)+10
+13 SET YSDA15=(((YSDA15-7.4)/10.2)*3)+10
+14 SET YSDA25=(((YSDA25-10.9)/11.5)*3)+10
+15 SET YSDA37=(((YSDA37-489.8)/863.9)*3)+10
+16 SET YSDA40=(((YSDA40-12.5)/12.8)*3)+10
+17 SET YSDA42=(((YSDA42-2.2)/1.7)*3)+10
+18 SET YSDA44=(((YSDA44-2.7)/1.7)*3)+10
+19 SET YSL25=(((YSL25-3.9)/8.8)*3)+10
+20 ;
+21 SET YSFSDR=YSE17+YSDA5+YSDA15+YSDA25+YSDA37+YSDA40+YSDA42+YSDA44+YSL25+.0000001
DRT IF YSFSDR>141
SET YSTDRU=73
+1 IF (YSFSDR>135)&(YSFSDR<141)
SET YSTDRU=70
+2 IF (YSFSDR>131)&(YSFSDR<135)
SET YSTDRU=68
+3 IF (YSFSDR>127)&(YSFSDR<131)
SET YSTDRU=67
+4 IF (YSFSDR>125)&(YSFSDR<127)
SET YSTDRU=66
+5 IF (YSFSDR>121)&(YSFSDR<125)
SET YSTDRU=65
+6 IF (YSFSDR>117)&(YSFSDR<121)
SET YSTDRU=64
+7 IF (YSFSDR>116)&(YSFSDR<117)
SET YSTDRU=63
+8 IF (YSFSDR>113)&(YSFSDR<116)
SET YSTDRU=62
+9 IF (YSFSDR>111)&(YSFSDR<113)
SET YSTDRU=61
+10 IF (YSFSDR>109)&(YSFSDR<111)
SET YSTDRU=60
+11 IF (YSFSDR>107)&((YSFSDR<109))
SET YSTDRU=59
+12 IF (YSFSDR>104)&(YSFSDR<107)
SET YSTDRU=58
+13 IF (YSFSDR>102)&(YSFSDR<104)
SET YSTDRU=57
+14 IF (YSFSDR>100)&(YSFSDR<102)
SET YSTDRU=56
+15 IF (YSFSDR>98)&(YSFSDR<100)
SET YSTDRU=55
+16 IF (YSFSDR>96)&(YSFSDR<98)
SET YSTDRU=54
+17 IF (YSFSDR>94)&(YSFSDR<96)
SET YSTDRU=53
+18 IF (YSFSDR>92)&(YSFSDR<94)
SET YSTDRU=52
+19 IF (YSFSDR>90)&(YSFSDR<92)
SET YSTDRU=51
+20 IF (YSFSDR>89)&(YSFSDR<90)
SET YSTDRU=50
+21 IF (YSFSDR>87)&(YSFSDR<89)
SET YSTDRU=49
+22 IF (YSFSDR>86)&(YSFSDR<87)
SET YSTDRU=48
+23 IF (YSFSDR>84)&(YSFSDR<86)
SET YSTDRU=47
+24 IF (YSFSDR>82)&(YSFSDR<84)
SET YSTDRU=46
+25 IF (YSFSDR>80)&(YSFSDR<82)
SET YSTDRU=45
+26 IF (YSFSDR>78)&(YSFSDR<80)
SET YSTDRU=44
+27 IF (YSFSDR>76)&(YSFSDR<78)
SET YSTDRU=43
+28 IF (YSFSDR>75)&(YSFSDR<76)
SET YSTDRU=42
+29 IF (YSFSDR>72)&(YSFSDR<75)
SET YSTDRU=41
+30 IF (YSFSDR>70)&(YSFSDR<72)
SET YSTDRU=40
+31 IF (YSFSDR>69)&(YSFSDR<70)
SET YSTDRU=39
+32 IF YSFSDR<69
SET YSTDRU=35
+33 ;
+34 SET YSDATA(3)="DRUG^"_$JUSTIFY(YSFSDR-.0000001,6,2)_U_YSTDRU
+35 ;
+36 ;NEXT FACTORS
DO ^YSASFS1
