- XLFMTH ;SF-ISC/RWF,HINES/CFB,DW - MATH FUNCTIONS;07/16/93 10:21 ;03/03/95 15:29
- ;;8.0;KERNEL;;Jul 10, 1995
- ABS(X) ;absolute value
- Q $S(X<0:-X,1:X)
- LN(X,PR) ;log base e
- N L,M,N,O,P,Y,LIM S PR=$$PR($G(PR),11) D A G Q
- LOG(X,PR) ;log base 10
- N L,M,N,O,P,Y,LIM S PR=$$PR($G(PR),11) D A S Y=Y/2.30258509298749 G Q
- ;
- A S M=1 I X>0 F N=0:1 Q:(X/M)<10 S M=M*10
- I X<1 F N=0:-1 Q:(X/M)>.1 S M=M*.1
- S X=X/M
- B S X=(X-1)/(X+1),(Y,L)=X D LIM F O=3:2 S L=L*X*X,M=L/O,Y=M+Y S:M<0 M=-M Q:M<LIM
- S Y=Y*2+(N*2.30258509298749) Q
- ;
- EXP(X,PR) ;e to the X power
- N L,M,N,O,P,Y,LIM S PR=$$PR($G(PR),11) D EX G Q
- ;
- EX S (Y,L)=X,Y=Y+1 D LIM F O=2:1 S L=L*X/O,Y=Y+L Q:($TR(L,"-")<LIM)
- Q
- PWR(Y,X,PR) ;X to the Y power
- N L,M,N,O,P,LIM S PR=$$PR($G(PR),11) D P G Q
- ;
- P S:X<0 X=X*-1,Y=1/Y S P=X,X=Y D A S X=Y*P D EX
- Q
- LIM S LIM=$S((PR+3)'>11:PR+3,1:11),@("LIM=1E-"_LIM) Q
- ;
- Q Q +$J(Y,0,$S((PR-$L(Y\1))'<0:PR-$L(Y\1),1:0))
- PR(PR,PL) Q $S('$L(PR):PL,PR>PL:PL,1:PR)
- E(PR) ;e
- N Y S Y=2.71828182845905 S PR=$$PR($G(PR),12) G Q
- PI(PR) ;PI
- N Y S Y=3.14159265358979 S PR=$$PR($G(PR),12) G Q
- ;
- SQRT(X,PR) ;square root of X
- N Y,T S Y=0,PR=$$PR($G(PR),12) Q:X'>0 Y S Y=X+.5
- L F S T=Y,Y=X/T+T/2 Q:Y'<T
- G Q
- SD(%S1,%S2,%N) ;%S1=SUM, %S2=SUM OF SQUARES, %N=COUNT
- N %X,%SD S %SD=-1,%X=-1 Q:%N<2 %SD
- S %X=%N*%S2-(%S1*%S1)/(%N*(%N-1)),%SD=$$SQRT(%X),%X=%S1/%N Q %SD
- MIN(%1,%2) Q $S(%1<%2:%1,1:%2)
- MAX(%1,%2) Q $S(%1<%2:%2,1:%1)
- ;
- DMSDEC(X,PR) ;degrees:min:sec to decimal
- N Y S PR=$$PR($G(PR),12),Y=$P(X,":")+($P(X,":",2)/60)+($P(X,":",3)/3600) G Q
- DECDMS(X,PR) ;decimal to degrees:min:sec
- N Y S PR=$$PR($G(PR),5),Y=X\1,X=X-(X\1)*60,Y=Y_":"_(X\1),X=X-(X\1)*60,X=+$J(X,0,$S((PR-$L(X\1))'<0:PR-$L(X\1),1:0)) Q Y_":"_X
- DTR(X,PR) ;degrees to radians
- N Y S Y=X*3.14159265358979/180 S PR=$$PR($G(PR),12) G Q
- RTD(X,PR) ;radians to degrees
- N Y S Y=X*180/3.14159265358979 S PR=$$PR($G(PR),12) G Q
- SINDEG(X,PR) ;sine in degrees
- S:X[":" X=$$DMSDEC(X,12) S PR=$$PR($G(PR),10),X=$$DTR(X) Q $$SIN(X,PR)
- SIN(X,PR) ;sine in radians
- N L,M,N,O,P,Y,LIM,SIGN S PR=$$PR($G(PR),10) D S G Q
- S S X=X#(2*3.14159265358979),(Y,L)=X,SIGN=-1 D LIM F O=3:2 S L=L/(O-1)*X/O*X,Y=Y+(SIGN*L) Q:($TR(L,"-")<LIM) S SIGN=SIGN*-1
- Q
- CSCDEG(X,PR) ;cosecant in degrees
- S:X[":" X=$$DMSDEC(X,12) S PR=$$PR($G(PR),10),X=$$DTR(X) Q $$CSC(X,PR)
- CSC(X,PR) ;cosecant in radians
- N L,M,N,O,P,Y,LIM,SIGN S PR=$$PR($G(PR),10) D S S Y=1/Y G Q
- COSDEG(X,PR) ;cosine in degrees
- S:X[":" X=$$DMSDEC(X,12) S PR=$$PR($G(PR),10),X=$$DTR(X) Q $$COS(X,PR)
- COS(X,PR) ;cosine in radians
- N L,M,N,O,P,Y,LIM,SIGN S PR=$$PR($G(PR),10) D C G Q
- C S X=X#(2*3.14159265358979),(Y,L)=1,SIGN=-1 D LIM F O=2:2 S L=L*X*X/(O-1*O),Y=Y+(SIGN*L) Q:($TR(L,"-")<LIM) S SIGN=SIGN*-1
- Q
- SECDEG(X,PR) ;secant in degrees
- S:X[":" X=$$DMSDEC(X,12) S PR=$$PR($G(PR),10),X=$$DTR(X) Q $$SEC(X,PR)
- SEC(X,PR) ;secant in radians
- N L,M,N,O,P,Y,LIM,SIGN S PR=$$PR($G(PR),10) D C S Y=1/Y G Q
- TANDEG(X,PR) ;tangent in degrees
- S:X[":" X=$$DMSDEC(X,12) S PR=$$PR($G(PR),10),X=$$DTR(X) Q $$TAN(X,PR)
- TAN(X,PR) ;tangent in radians
- N L,M,N,O,P,Y,LIM,S,SIGN S PR=$$PR($G(PR),10) D S S S=Y D C S Y=S/Y G Q
- COTDEG(X,PR) ;cotangent in degrees
- S:X[":" X=$$DMSDEC(X,12) S PR=$$PR($G(PR),10),X=$$DTR(X) Q $$COT(X,PR)
- COT(X,PR) ;contangent in radians
- N L,M,N,O,P,Y,LIM,C,SIGN S PR=$$PR($G(PR),10) D C S C=Y D S S Y=C/Y G Q
- ASINDEG(X,PR) ;arc-sine in degrees
- G ASIND^XLFMTH1
- ASIN(X,PR) ;arc-sine in radians
- G ASIN^XLFMTH1
- ACOSDEG(X,PR) ;arc-cosine in degrees
- G ACOSD^XLFMTH1
- ACOS(X,PR) ;arc-cosine in radians
- G ACOS^XLFMTH1
- ATANDEG(X,PR) ;arc-tangent in degrees
- G ATAND^XLFMTH1
- ATAN(X,PR) ;arc-tangent in radians
- G ATAN^XLFMTH1
- ACOTDEG(X,PR) ;arc-cotangent in degrees
- G ACOTD^XLFMTH1
- ACOT(X,PR) ;arc-cotangent in radians
- G ACOT^XLFMTH1
- ASECDEG(X,PR) ;arc-secant in degrees
- G ASECD^XLFMTH1
- ASEC(X,PR) ;arc-secant in radians
- G ASEC^XLFMTH1
- ACSCDEG(X,PR) ;arc-cosecant in degrees
- G ACSCD^XLFMTH1
- ACSC(X,PR) ;arc-cosecant in radians
- G ACSC^XLFMTH1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFMTH 4041 printed Jan 18, 2025@03:04:02 Page 2
- XLFMTH ;SF-ISC/RWF,HINES/CFB,DW - MATH FUNCTIONS;07/16/93 10:21 ;03/03/95 15:29
- +1 ;;8.0;KERNEL;;Jul 10, 1995
- ABS(X) ;absolute value
- +1 QUIT $SELECT(X<0:-X,1:X)
- LN(X,PR) ;log base e
- +1 NEW L,M,N,O,P,Y,LIM
- SET PR=$$PR($GET(PR),11)
- DO A
- GOTO Q
- LOG(X,PR) ;log base 10
- +1 NEW L,M,N,O,P,Y,LIM
- SET PR=$$PR($GET(PR),11)
- DO A
- SET Y=Y/2.30258509298749
- GOTO Q
- +2 ;
- A SET M=1
- IF X>0
- FOR N=0:1
- if (X/M)<10
- QUIT
- SET M=M*10
- +1 IF X<1
- FOR N=0:-1
- if (X/M)>.1
- QUIT
- SET M=M*.1
- +2 SET X=X/M
- B SET X=(X-1)/(X+1)
- SET (Y,L)=X
- DO LIM
- FOR O=3:2
- SET L=L*X*X
- SET M=L/O
- SET Y=M+Y
- if M<0
- SET M=-M
- if M<LIM
- QUIT
- +1 SET Y=Y*2+(N*2.30258509298749)
- QUIT
- +2 ;
- EXP(X,PR) ;e to the X power
- +1 NEW L,M,N,O,P,Y,LIM
- SET PR=$$PR($GET(PR),11)
- DO EX
- GOTO Q
- +2 ;
- EX SET (Y,L)=X
- SET Y=Y+1
- DO LIM
- FOR O=2:1
- SET L=L*X/O
- SET Y=Y+L
- if ($TRANSLATE(L,"-")<LIM)
- QUIT
- +1 QUIT
- PWR(Y,X,PR) ;X to the Y power
- +1 NEW L,M,N,O,P,LIM
- SET PR=$$PR($GET(PR),11)
- DO P
- GOTO Q
- +2 ;
- P if X<0
- SET X=X*-1
- SET Y=1/Y
- SET P=X
- SET X=Y
- DO A
- SET X=Y*P
- DO EX
- +1 QUIT
- LIM SET LIM=$SELECT((PR+3)'>11:PR+3,1:11)
- SET @("LIM=1E-"_LIM)
- QUIT
- +1 ;
- Q QUIT +$JUSTIFY(Y,0,$SELECT((PR-$LENGTH(Y\1))'<0:PR-$LENGTH(Y\1),1:0))
- PR(PR,PL) QUIT $SELECT('$LENGTH(PR):PL,PR>PL:PL,1:PR)
- E(PR) ;e
- +1 NEW Y
- SET Y=2.71828182845905
- SET PR=$$PR($GET(PR),12)
- GOTO Q
- PI(PR) ;PI
- +1 NEW Y
- SET Y=3.14159265358979
- SET PR=$$PR($GET(PR),12)
- GOTO Q
- +2 ;
- SQRT(X,PR) ;square root of X
- +1 NEW Y,T
- SET Y=0
- SET PR=$$PR($GET(PR),12)
- if X'>0
- QUIT Y
- SET Y=X+.5
- L FOR
- SET T=Y
- SET Y=X/T+T/2
- if Y'<T
- QUIT
- +1 GOTO Q
- SD(%S1,%S2,%N) ;%S1=SUM, %S2=SUM OF SQUARES, %N=COUNT
- +1 NEW %X,%SD
- SET %SD=-1
- SET %X=-1
- if %N<2
- QUIT %SD
- +2 SET %X=%N*%S2-(%S1*%S1)/(%N*(%N-1))
- SET %SD=$$SQRT(%X)
- SET %X=%S1/%N
- QUIT %SD
- MIN(%1,%2) QUIT $SELECT(%1<%2:%1,1:%2)
- MAX(%1,%2) QUIT $SELECT(%1<%2:%2,1:%1)
- +1 ;
- DMSDEC(X,PR) ;degrees:min:sec to decimal
- +1 NEW Y
- SET PR=$$PR($GET(PR),12)
- SET Y=$PIECE(X,":")+($PIECE(X,":",2)/60)+($PIECE(X,":",3)/3600)
- GOTO Q
- DECDMS(X,PR) ;decimal to degrees:min:sec
- +1 NEW Y
- SET PR=$$PR($GET(PR),5)
- SET Y=X\1
- SET X=X-(X\1)*60
- SET Y=Y_":"_(X\1)
- SET X=X-(X\1)*60
- SET X=+$JUSTIFY(X,0,$SELECT((PR-$LENGTH(X\1))'<0:PR-$LENGTH(X\1),1:0))
- QUIT Y_":"_X
- DTR(X,PR) ;degrees to radians
- +1 NEW Y
- SET Y=X*3.14159265358979/180
- SET PR=$$PR($GET(PR),12)
- GOTO Q
- RTD(X,PR) ;radians to degrees
- +1 NEW Y
- SET Y=X*180/3.14159265358979
- SET PR=$$PR($GET(PR),12)
- GOTO Q
- SINDEG(X,PR) ;sine in degrees
- +1 if X["
- SET X=$$DMSDEC(X,12)
- SET PR=$$PR($GET(PR),10)
- SET X=$$DTR(X)
- QUIT $$SIN(X,PR)
- SIN(X,PR) ;sine in radians
- +1 NEW L,M,N,O,P,Y,LIM,SIGN
- SET PR=$$PR($GET(PR),10)
- DO S
- GOTO Q
- S SET X=X#(2*3.14159265358979)
- SET (Y,L)=X
- SET SIGN=-1
- DO LIM
- FOR O=3:2
- SET L=L/(O-1)*X/O*X
- SET Y=Y+(SIGN*L)
- if ($TRANSLATE(L,"-")<LIM)
- QUIT
- SET SIGN=SIGN*-1
- +1 QUIT
- CSCDEG(X,PR) ;cosecant in degrees
- +1 if X["
- SET X=$$DMSDEC(X,12)
- SET PR=$$PR($GET(PR),10)
- SET X=$$DTR(X)
- QUIT $$CSC(X,PR)
- CSC(X,PR) ;cosecant in radians
- +1 NEW L,M,N,O,P,Y,LIM,SIGN
- SET PR=$$PR($GET(PR),10)
- DO S
- SET Y=1/Y
- GOTO Q
- COSDEG(X,PR) ;cosine in degrees
- +1 if X["
- SET X=$$DMSDEC(X,12)
- SET PR=$$PR($GET(PR),10)
- SET X=$$DTR(X)
- QUIT $$COS(X,PR)
- COS(X,PR) ;cosine in radians
- +1 NEW L,M,N,O,P,Y,LIM,SIGN
- SET PR=$$PR($GET(PR),10)
- DO C
- GOTO Q
- C SET X=X#(2*3.14159265358979)
- SET (Y,L)=1
- SET SIGN=-1
- DO LIM
- FOR O=2:2
- SET L=L*X*X/(O-1*O)
- SET Y=Y+(SIGN*L)
- if ($TRANSLATE(L,"-")<LIM)
- QUIT
- SET SIGN=SIGN*-1
- +1 QUIT
- SECDEG(X,PR) ;secant in degrees
- +1 if X["
- SET X=$$DMSDEC(X,12)
- SET PR=$$PR($GET(PR),10)
- SET X=$$DTR(X)
- QUIT $$SEC(X,PR)
- SEC(X,PR) ;secant in radians
- +1 NEW L,M,N,O,P,Y,LIM,SIGN
- SET PR=$$PR($GET(PR),10)
- DO C
- SET Y=1/Y
- GOTO Q
- TANDEG(X,PR) ;tangent in degrees
- +1 if X["
- SET X=$$DMSDEC(X,12)
- SET PR=$$PR($GET(PR),10)
- SET X=$$DTR(X)
- QUIT $$TAN(X,PR)
- TAN(X,PR) ;tangent in radians
- +1 NEW L,M,N,O,P,Y,LIM,S,SIGN
- SET PR=$$PR($GET(PR),10)
- DO S
- SET S=Y
- DO C
- SET Y=S/Y
- GOTO Q
- COTDEG(X,PR) ;cotangent in degrees
- +1 if X["
- SET X=$$DMSDEC(X,12)
- SET PR=$$PR($GET(PR),10)
- SET X=$$DTR(X)
- QUIT $$COT(X,PR)
- COT(X,PR) ;contangent in radians
- +1 NEW L,M,N,O,P,Y,LIM,C,SIGN
- SET PR=$$PR($GET(PR),10)
- DO C
- SET C=Y
- DO S
- SET Y=C/Y
- GOTO Q
- ASINDEG(X,PR) ;arc-sine in degrees
- +1 GOTO ASIND^XLFMTH1
- ASIN(X,PR) ;arc-sine in radians
- +1 GOTO ASIN^XLFMTH1
- ACOSDEG(X,PR) ;arc-cosine in degrees
- +1 GOTO ACOSD^XLFMTH1
- ACOS(X,PR) ;arc-cosine in radians
- +1 GOTO ACOS^XLFMTH1
- ATANDEG(X,PR) ;arc-tangent in degrees
- +1 GOTO ATAND^XLFMTH1
- ATAN(X,PR) ;arc-tangent in radians
- +1 GOTO ATAN^XLFMTH1
- ACOTDEG(X,PR) ;arc-cotangent in degrees
- +1 GOTO ACOTD^XLFMTH1
- ACOT(X,PR) ;arc-cotangent in radians
- +1 GOTO ACOT^XLFMTH1
- ASECDEG(X,PR) ;arc-secant in degrees
- +1 GOTO ASECD^XLFMTH1
- ASEC(X,PR) ;arc-secant in radians
- +1 GOTO ASEC^XLFMTH1
- ACSCDEG(X,PR) ;arc-cosecant in degrees
- +1 GOTO ACSCD^XLFMTH1
- ACSC(X,PR) ;arc-cosecant in radians
- +1 GOTO ACSC^XLFMTH1