82 lines
4.1 KiB
Mathematica
82 lines
4.1 KiB
Mathematica
LEXXST2 ; ISL Lexicon Status (Routine Count) ; 12-08-97
|
|
;;2.0;LEXICON UTILITY;**4,5,8**;Sep 23, 1996;Build 1
|
|
Q
|
|
RTT ; Total Routines
|
|
D BL,TT("ROUTINES"),BL
|
|
D:$O(^DIC(9.8,"B","LEW~"))'["LEX" BL,TL(" NO ROUTINES FOUND")
|
|
Q:$O(^DIC(9.8,"B","LEW~"))'["LEX" N LEXT,LEXR,LEXROU,LEXV,LEXVD,LEXL,LEXP,LEXROU,LEXRC,LEXC,LEXVER,LEXVERD,LEXLAST,LEXFST,LEXSEC S LEXRC=0,LEXR=$E("LEX",1,($L("LEX")-1))_$C($A($E("LEX",$L("LEX")))-1)_"~",LEXC="LEX"
|
|
F S LEXR=$O(^DIC(9.8,"B",LEXR)) Q:LEXR=""!($E(LEXR,1,$L(LEXC))'=LEXC) D GET
|
|
I +($G(LEXRC))>0 D SET
|
|
Q
|
|
GET ; Retrieve first 2 lines of routine
|
|
; PCH 8 quit if routine is a environment check, pre/post install
|
|
Q:$E(LEXR,4)?1N
|
|
; PCH 5 replace indirection $T(@LEXR) with executable string
|
|
K LEXFST,LEXSEC N X,LEXEXC S X=LEXR X ^%ZOSF("TEST") I $T D
|
|
. S LEXRC=+($G(LEXRC))+1
|
|
. S LEXEXC="S LEXFST=$T(^"_LEXR_")"
|
|
. X LEXEXC S LEXFST=$G(LEXFST),LEXL=$$TRIMD($P($G(LEXFST),";",3)) D LAST
|
|
. S LEXEXC="S LEXSEC=$T("_LEXR_"+1^"_LEXR_")"
|
|
. X LEXEXC S LEXSEC=$G(LEXSEC),LEXV=$$TRIMS($P($G(LEXSEC),";",3)),LEXVD=$$TRIMS($P($G(LEXSEC),";",6)),LEXP=$$TRIMS($P($G(LEXSEC),";",5)) D VER,VERD
|
|
Q
|
|
SET ; Update global array
|
|
N LEXT,LEXV,LEXVD,LEXL
|
|
S LEXV=$G(LEXVER(0)),LEXVD=$G(LEXVERD(0)),LEXL=$G(LEXLAST(0))
|
|
S LEXT=" ROUTINES FOUND: "_LEXRC D TL(LEXT)
|
|
I $L($G(LEXV)) S LEXT=" VERSION: "_LEXV D TL(LEXT)
|
|
I $L($G(LEXVD)) S LEXT=" VERSION DATE: "_LEXVD D TL(LEXT)
|
|
I $L(LEXL) S LEXT=" DATE LAST MODIFIED: "_LEXL D TL(LEXT)
|
|
Q
|
|
PT ; Pointed to ...
|
|
D BL,TT("POINTED TO BY") D:'$D(^DD(757.01,0,"PT")) BL,TL(" NO FILES POINT TO THE LEXICON") Q:'$D(^DD(757.01,0,"PT"))
|
|
N LEXC,LEXFI,LEXFIN,LEXFF,LEXFD,LEXFDN,LEXND,LEXPT,LEXF1,LEXF2,LEXD1,LEXD2
|
|
S (LEXFI,LEXC)=0 F S LEXFI=$O(^DD(757.01,0,"PT",LEXFI)) Q:+LEXFI=0 I $E(LEXFI,1,3)'["757" S LEXFD=0 F S LEXFD=$O(^DD(757.01,0,"PT",LEXFI,LEXFD)) Q:+LEXFD=0 D PTX
|
|
D:LEXC=0 BL,TL(" NO FILES POINT TO THE LEXICON")
|
|
Q
|
|
PTX ; Pointed to Text
|
|
S LEXFIN=$O(^DD(LEXFI,0,"NM","")) Q:LEXFIN="" S LEXFDN=$P($G(^DD(LEXFI,LEXFD,0)),"^",1) Q:LEXFDN=""
|
|
S LEXFF=LEXFI_";"_LEXFD,LEXF1=" "_LEXFIN_" FILE"
|
|
S LEXD1=$P(LEXFI,".",1),LEXD2=$P(LEXFI,".",2.299),LEXF1=LEXF1_$J("",(55-($L(LEXF1)+$L(LEXD1))))_LEXD1_$S(LEXFF[".":".",1:"")_LEXD2
|
|
S LEXD1=$P(LEXFD,".",1),LEXD2=$P(LEXFD,".",2.299),LEXF1=LEXF1_$J("",(70-($L(LEXF1)+$L(LEXD1))))_LEXD1_$S(LEXFF[".":".",1:"")_LEXD2
|
|
S LEXF2=" "_LEXFDN_" FIELD"
|
|
S LEXC=LEXC+1 D BL,TL(LEXF1),TL(LEXF2)
|
|
Q
|
|
TT(LEXX) ; Title Text
|
|
D TT^LEXXST($G(LEXX)) Q
|
|
TL(LEXX) ; Noraml Text Line
|
|
D TL^LEXXST($G(LEXX)) Q
|
|
BL ; Blank Line
|
|
D BL^LEXXST Q
|
|
LAST ; Routine date-last-modified
|
|
S LEXL=$G(LEXL) Q:LEXL="" N LEXS,LEXD S LEXS=$$DTS^LEXXST4(LEXL)
|
|
S LEXD=$$STL^LEXXST4(LEXS) S:(+(LEXS)>+($G(LEXLAST))) LEXLAST=LEXS,LEXLAST(0)=LEXD Q
|
|
VER ; Routine version number
|
|
S LEXV=$G(LEXV) S:(+(LEXV)>+($G(LEXVER))) LEXVER=+(LEXV),LEXVER(0)=LEXV Q
|
|
VERD ; Routine version date
|
|
S LEXVD=$G(LEXVD) N LEXY,LEXM,LEXD,LEXL S LEXY=$E(LEXVD,($L(LEXVD)-1),$L(LEXVD))
|
|
S LEXD=+($P(LEXVD," ",2)),LEXM=$$UP^XLFSTR($P(LEXVD," ",1))
|
|
S LEXM=$S(LEXM["JAN":"01",LEXM["FEB":"02",LEXM["MAR":"03",LEXM["APR":"04",LEXM["MAY":"05",LEXM["JUN":"06",LEXM["JUL":"07",LEXM["AUG":"08",LEXM["SEP":"09",LEXM["OCT":"10",LEXM["NOV":"11",LEXM["DEC":"12",1:"01")
|
|
S LEXL=LEXY_LEXM_LEXD S:+LEXL>+($G(LEXVERD)) LEXVERD=+LEXL,LEXVERD(0)=LEXVD
|
|
Q
|
|
TRIMD(LEXX) ; Trim Date
|
|
S LEXX=$G(LEXX),LEXX=$$TRIMS(LEXX)
|
|
S:LEXX["@" LEXX=$P(LEXX,"@",1)
|
|
S:LEXX["-"&(LEXX[" ") LEXX=$P(LEXX," ",1) S:LEXX["/"&(LEXX[" ") LEXX=$P(LEXX," ",1)
|
|
S:$E(LEXX,1)?1A&($L(LEXX," ")>3) LEXX=$P(LEXX," ",1,3)
|
|
S:$E(LEXX,1)?1N&($L(LEXX," ")>3) LEXX=$P(LEXX," ",1,3)
|
|
S LEXX=$$TRIMW(LEXX)
|
|
I $L(LEXX," ")'=3&($L(LEXX,"-")'=3)&($L(LEXX,"/")'=3) S LEXX=""
|
|
N LEX,LEXP S LEX=LEXX
|
|
F LEXP=1:1:3 D
|
|
. I LEX["-",$L($P(LEX,"-",LEXP))>4 S LEXX=""
|
|
. I LEX["/",$L($P(LEX,"/",LEXP))>4 S LEXX=""
|
|
. I LEX[" ",$L($P(LEX," ",LEXP))>4 S LEXX=""
|
|
Q LEXX
|
|
TRIMS(LEXX) ; Trim String
|
|
S LEXX=$G(LEXX),LEXX=$TR(LEXX,"*",""),LEXX=$$TRIMW(LEXX) Q LEXX
|
|
TRIMW(LEXX) ; Trim Word
|
|
S LEXX=$G(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
|