65 lines
3.6 KiB
Mathematica
65 lines
3.6 KiB
Mathematica
LEXXST4 ; ISL Lexicon Status (Dates) ; 05-17-97
|
|
;;2.0;LEXICON UTILITY;**4,5**;Sep 23, 1996
|
|
Q
|
|
DTS(LEXX) ; Date to sequential
|
|
; PCH 5 default quit value 0
|
|
S LEXX=$$UP^XLFSTR($$TRIM($G(LEXX))) Q:LEXX="" 0
|
|
N LEXCUR,LEXMON S LEXCUR=$$CUR
|
|
N LEXMON S LEXMON="JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"
|
|
S:LEXX["@" LEXX=$P(LEXX,"@",1)
|
|
S LEXX=$TR(LEXX,"-"," "),LEXX=$TR(LEXX,"/"," ") S:$L(LEXX," ")>3 LEXX=$P(LEXX," ",1,3)
|
|
N LEX1,LEX2,LEX3 S LEX1=$P(LEXX," ",1),LEX2=$P(LEXX," ",2),LEX3=$P(LEXX," ",3)
|
|
S LEXM=$$NM(LEX1) I +LEXM>0,+LEXM<13 D Q LEXX
|
|
. S:$L(LEXM)=1 LEXM="0"_LEXM S LEXD=$$DTN(LEX2),LEXY=$$YTN(LEX3,$P(LEXCUR,"^",1)),LEXX=LEXY_LEXM_LEXD
|
|
S LEXM=$$NM(LEX2) I +LEXM>0,+LEXM<13 D Q LEXX
|
|
. S:$L(LEXM)=1 LEXM="0"_LEXM S LEXD=$$DTN(LEX1),LEXY=$$YTN(LEX3,$P(LEXCUR,"^",1)),LEXX=LEXY_LEXM_LEXD
|
|
S LEXM=$$AN(LEX1) I +LEXM>0,+LEXM<13 D Q LEXX
|
|
. S:$L(LEXM)=1 LEXM="0"_LEXM S LEXD=$$DTN(LEX2),LEXY=$$YTN(LEX3,$P(LEXCUR,"^",1)),LEXX=LEXY_LEXM_LEXD
|
|
S LEXM=$$AN(LEX2) I +LEXM>0,+LEXM<13 D Q LEXX
|
|
. S:$L(LEXM)=1 LEXM="0"_LEXM S LEXD=$$DTN(LEX1),LEXY=$$YTN(LEX3,$P(LEXCUR,"^",1)),LEXX=LEXY_LEXM_LEXD
|
|
S LEXX=0 Q LEXX
|
|
FTE(LEXX) ; Fileman to External (other)
|
|
S LEXX=$G(LEXX) Q:LEXX="" LEXX
|
|
S:LEXX["." LEXX=$P(LEXX,".",1) N LEXY,LEXM,LEXD S LEXY=+($E(LEXX,1,3)),LEXY=LEXY+1700
|
|
S LEXM=$E(LEXX,4,5) S:$E(LEXM,1)="0" LEXM=+($E(LEXM,2)) S:LEXM=0 LEXM=1
|
|
S LEXD=$E(LEXX,6,7) S:$E(LEXD,1)="0" LEXD=+($E(LEXD,2)) S:LEXD=0 LEXD=1 S:$L(LEXD)=1 LEXD=" "_LEXD
|
|
S LEXM=$S(LEXM=1:"Jan",LEXM=2:"FEB",LEXM=3:"Mar",LEXM=4:"Apr",LEXM=5:"May",LEXM=6:"Jun",LEXM=7:"Jul",LEXM=8:"Aug",LEXM=9:"Sep",LEXM=10:"Oct",LEXM=11:"Nov",LEXM=12:"Dec",1:"Jan")
|
|
S LEXX=LEXM_" "_LEXD_", "_LEXY
|
|
Q LEXX
|
|
MTN(LEXX,LEXC) ; Alpha Month to 2 character numeric
|
|
S LEXC=$G(LEXC),LEXX=$$UP^XLFSTR($G(LEXX)) Q:'$L(LEXX) LEXC
|
|
S LEXX=$S(LEXX["JAN":"01",LEXX["FEB":"02",LEXX["MAR":"03",LEXX["APR":"04",LEXX["MAY":"05",LEXX["JUN":"06",LEXX["JUL":"07",LEXX["AUG":"08",LEXX["SEP":"09",LEXX["OCT":"10",LEXX["NOV":"11",LEXX["DEC":"12",1:LEXC)
|
|
Q LEXX
|
|
DTN(LEXX) ; Day to 2 character numeric
|
|
S LEXX=$G(LEXX) Q:'$L(LEXX) "01"
|
|
S LEXX=$TR(LEXX,",",""),LEXX=$TR(LEXX,"-",""),LEXX=$TR(LEXX,"/",""),LEXX=$$TRIM(LEXX)
|
|
S:$L(LEXX)=1 LEXX="0"_LEXX
|
|
Q LEXX
|
|
YTN(LEXX,LEXC) ; Year to 4 character year
|
|
S LEXC=$G(LEXC),LEXX=$$TRIM($G(LEXX)) Q:'$L(LEXX) LEXC S LEXX=$TR(LEXX,"-",""),LEXX=$TR(LEXX,"/","") Q:$L(LEXX)'=2&($L(LEXX)'=4) LEXC
|
|
S:$L(LEXX)=2&(+LEXX>83) LEXX="19"_LEXX S:$L(LEXX)=2&(+LEXX'>83) LEXX="20"_LEXX
|
|
Q LEXX
|
|
STL(LEXX) ; Sequential to Long
|
|
S LEXX=$G(LEXX) N LEXC S LEXC=$TR($$CUR,"^","") S:'$L(LEXX) LEXX=LEXC
|
|
N LEXM,LEXD,LEXY S LEXY=$E(LEXX,1,4),LEXM=$E(LEXX,5,6),LEXD=$E(LEXX,7,8)
|
|
S:$E(LEXM,1)="0" LEXM=$E(LEXM,2) S LEXM=+LEXM
|
|
S LEXM=$S(LEXM=1:"Jan",LEXM=2:"Feb",LEXM=3:"Mar",LEXM=4:"Apr",LEXM=5:"May",LEXM=6:"Jun",LEXM=7:"Jul",LEXM=8:"Aug",LEXM=9:"Sep",LEXM=10:"Oct",LEXM=11:"Nov",LEXM=12:"Dec",1:"Jan")
|
|
S:$E(LEXD,1)="0" LEXD=" "_$E(LEXD,2) S LEXX=LEXM_" "_LEXD_", "_LEXY Q LEXX
|
|
CUR(LEXX) ; Current Date
|
|
N I,%,%I,%H,X D NOW^%DTC
|
|
S LEXX=(+($E(X,1,3))+1700)_"^"_$E(X,4,5)_"^"_$E(X,6,7)
|
|
Q LEXX
|
|
NM(LEXX) ; Numeric Month
|
|
S LEXX=$$UP^XLFSTR($G(LEXX)) Q:+LEXX>0 ""
|
|
N LEXMON S LEXMON="JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC"
|
|
Q:LEXMON'[LEXX "" N LEXI,LEXM F LEXI=1:1:12 S LEXM=$P(LEXMON,"^",LEXI) S:LEXX=LEXM LEXX=LEXI Q:+LEXX>0
|
|
S LEXX=+LEXX S:LEXX=0 LEXX="" Q LEXX
|
|
AN(LEXX) ; Alpha to Numeric
|
|
S LEXX=$G(LEXX) S:$E(LEXX,1)="0" LEXX=$E(LEXX,2) S LEXX=+LEXX
|
|
Q LEXX
|
|
TRIM(LEXX) ; Trim Spaces
|
|
S LEXX=$G(LEXX),LEXX=$TR(LEXX,"*","") F Q:$E(LEXX,1)'=" " S LEXX=$E(LEXX,2,$L(LEXX))
|
|
F Q:$E(LEXX,$L(LEXX))'=" " S LEXX=$E(LEXX,1,($L(LEXX)-1))
|
|
F Q:LEXX'[" " S LEXX=$P(LEXX," ",1)_" "_$P(LEXX," ",2)
|
|
Q LEXX
|