- 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 Jan 18, 2025@03:14:13 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