source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSESUT.m@ 1379

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1YSESUT ;SLC/DCM-UTILITY FUNCTIONS FOR DECISION EXPERT SYSTEM ; 6/28/89 09:33 ;
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;DECISION EXPERT SYSTEM (VERSION 1.0) FOR MENTAL HEALTH PACKAGE - DWIGHT MCDANIEL / REGION 5 ISC, SLC
4 ;
5ULC ; Called from DD(628.23 and routine YSESP
6 ;
7 F ESI=1:1 S ESI1=$E(EST,ESI) Q:ESI1="" I ESI1?1L S EST=$E(EST,1,ESI-1)_$C($A(ESI1)-32)_$E(EST,ESI+1,$L(EST))
8 K ESI,ESI1 Q
9ZRT ;
10 S Y=0 Q:X'>0 S Y=1+X/2
11Z ;
12 S T=Y,Y=X/T+T/2 G Z:Y<T Q
13CMIN ;
14 S X=X*.3937*10000+.5\1/10000 Q ; CONVERT CENTIMETERS TO INCHES
15INCM ;
16 S X=X*2.54*1000+.5\1/1000 Q ; CONVERT INCHES TO CENTIMETERS
17KGLB ;
18 S X=X*2.205*1000+.5\1/1000 Q ; CONVERT KILOGRAMS TO POUNDS
19LBKG ;
20 S X=X*.4535*1000+.5\1/1000 Q ; CONVERT POUNDS TO KILOGRAMS
21DFDC ;
22 S X=.5555556*(X-32)*10000+.5\1/10000 Q ; CONVERT DEGREES F TO DEGREES C
23DCDF ;
24 S X=1.8*X+32*10000+.5\1/10000 Q ; CONVERT DEGREES C TO DEGREES F
25LN ;
26 S X=$S(X=1:0,X=0:"LN(0) ERROR",X<0:"NEGATIVE LN ERROR",+X=0:"FORMULA ERROR",1:X) I X=0!(X["ERROR") G LNQ
27 I X>3!(X<.1) S ESLN=X D LN^YSESLOG S X=ESY G LNQ
28 S Z1=X-1,Z2=X+1,COUNT=1,ESLN=0,CHK=0,ACC=0
29 D LN1 S X=2*ESLN+.000000005,X=$P(X,".")_"."_$E($P(X,".",2),1,8) S:$E(X,$L(X))?1"0" X=$E(X,1,$L(X)-1)
30LNQ ;
31 K ACC,CHK,COUNT,ESI,J,L,K,N,P,ESE,ESAB,ESLN,ESLN1,ESY,Z,Z1,Z2,%Y Q
32LN1 ;
33 S ESLN=Z1/Z2,ESY=ESLN*ESLN,ACC=ESLN
34 F J=0:0 S COUNT=COUNT+2,CHK=ESLN,ACC=ACC*Y,ESLN1=ACC,ESLN=ESLN+(ESLN1/COUNT) Q:$E(ESLN,1,12)=$E(CHK,1,12)
35 Q
36LOG ;
37 S X=$S(X=1:0,X=0:"LOG(0) ERROR",X<0:"NEGATIVE LOG ERROR",+X=0:"FORMULA ERROR",1:X) I X=0!(X["ERROR") Q
38 K ESY,ESE,ESAB S ESLN=X D LOG^YSESLOG S X=ESY
39 K ESLN,ESY,ESE Q
40 ;; CALCULATE EXPONENTIAL FUNCTION
41EXP ;
42 S E=1,ET=1,FC=1,N=0,SN=1,SQ=1,TE=2.718281828459
43 I X=1 S E=TE G EX4
44 I X<0 S SN=-1,X=-X
45 S ER=X-(X\1),X=X\1 I ER=0 G EX2
46EX1 ;
47 S N=N+1,EE=ET,FC=FC*N,SQ=SQ*ER,ET=ET+(SQ/FC)
48 G:ET'=EE EX1
49 I X=0 S E=ET G EX3
50EX2 ;
51 F CN=1:1:X S E=TE*E
52 S E=E*ET
53EX3 ;
54 I SN<0 S E=1/E
55 S E=E+.000000000005,X=$P(E,".")_"."_$E($P(E,".",2),1,10)
56EX4 ;
57 S N="" K E,N,ER,EE,CN,ET,FC,SN,SQ,TE Q
Note: See TracBrowser for help on using the repository browser.