177 lines
8.7 KiB
Mathematica
177 lines
8.7 KiB
Mathematica
LEXXST ; ISL/KER - Lexicon Status (Main/Files) ; 02/22/2007
|
|
;;2.0;LEXICON UTILITY;**4,5,8,25,27,49**;Sep 23, 1996;Build 3
|
|
;
|
|
; External References
|
|
; DBIA 10096 ^%ZOSF("PROD"
|
|
; DBIA 10096 ^%ZOSF("UCI"
|
|
; DBIA 10060 ^VA(200
|
|
; DBIA 10000 NOW^%DTC
|
|
; DBIA 10086 ^%ZIS
|
|
; DBIA 10086 HOME^%ZIS
|
|
; DBIA 10089 ^%ZISC
|
|
; DBIA 10063 ^%ZTLOAD
|
|
; DBIA 2052 FILE^DID
|
|
; DBIA 10103 $$FMTE^XLFDT
|
|
; DBIA 10104 $$UP^XLFSTR
|
|
; DBIA 10070 ^XMD
|
|
;
|
|
DISP ; Display Status only
|
|
K ^TMP($J,"LEXINFO"),LEXMAIL,LEXAO N X,Y,LEXM,LEXY
|
|
D DATA,SHOW Q
|
|
SEND ; Send Status to G.LEXINS@ISC-SLC.VA.GOV
|
|
K ^TMP($J,"LEXINFO") N X,Y,LEXM,LEXY
|
|
S:$L($G(LEXBUILD)) ZTSAVE("LEXBUILD")=""
|
|
S:$D(LEXSHORT) ZTSAVE("LEXSHORT")=""
|
|
S ZTRTN="SENDTO^LEXXST",ZTDESC="Lexicon Status Report Msg [LEXXST]",ZTIO="",ZTDTH=$H
|
|
D ^%ZTLOAD
|
|
D HOME^%ZIS K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
|
|
Q
|
|
SENDTO ; Send Status (Tasked)
|
|
N LEXMAIL,LEXAO S (LEXMAIL,LEXAO)="" S:$D(ZTQUEUED) ZTREQ="@"
|
|
D:'$D(LEXSHORT) N0 D DATA,SHOW Q
|
|
DATA ; Get Data
|
|
D TITLE Q:$D(LEXSHORT)
|
|
D FILES,PT^LEXXST2,RTT^LEXXST2
|
|
D KIDS^LEXXST3,RTN^LEXXST3
|
|
Q
|
|
TITLE ; Title of display/message
|
|
N LEXT,LEXA,LEXD,LEXU,LEXN,LEXP
|
|
S LEXT="LEXICON UTILITY STATUS",LEXD=$$A,LEXA=$$U
|
|
S LEXU=$$P,LEXN=$P(LEXU,"^",1),LEXP=$P(LEXU,"^",2)
|
|
I $D(LEXAO) D Q
|
|
. D:$L(LEXT) TT(LEXT),BL S:$L(LEXD) LEXT=" AS OF: "_LEXD D:$L(LEXD) TL(LEXT) S LEXT="" S:$L(LEXA) LEXT=" IN ACCOUNT: "_$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
|
|
. S:$L(LEXT)&($L($P(LEXA,"^",2))) LEXT=LEXT_" "_$P(LEXA,"^",2) D:$L(LEXA) TL(LEXT)
|
|
. S LEXT="" S:$L(LEXU) LEXT=" MAINT BY: " S:$L(LEXN) LEXT=LEXT_LEXN S:$L(LEXP)&($L(LEXN)) LEXT=LEXT_" "_LEXP D:$L(LEXT) TL(LEXT)
|
|
. S LEXT="" S:$L($G(LEXBUILD)) LEXT=" BUILD: "_$G(LEXBUILD)
|
|
. D:$L(LEXT) TL(LEXT) D BL
|
|
I '$D(LEXAO) D Q
|
|
. D:$L(LEXT) TT(LEXT),BL S:$L(LEXD) LEXT=" AS OF: "_LEXD D:$L(LEXD) TL(LEXT) S LEXT="" S:$L(LEXA) LEXT=" IN ACCOUNT: "_$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
|
|
. S:$L(LEXT)&($L($P(LEXA,"^",2))) LEXT=LEXT_" "_$P(LEXA,"^",2) D:$L(LEXA) TL(LEXT) D BL
|
|
Q
|
|
U(X) ; UCI where Lexicon is installed
|
|
N LEXU,LEXP,LEXT,Y X ^%ZOSF("UCI") S LEXU=Y,LEXP=""
|
|
S:LEXU=^%ZOSF("PROD")!($P(LEXU,",",1)=^%ZOSF("PROD")) LEXP=" (Production)"
|
|
S:LEXU'=^%ZOSF("PROD")&($P(LEXU,",",1)'=^%ZOSF("PROD")) LEXP=" (Test)"
|
|
S X="",$P(X,"^",1)=LEXU,$P(X,"^",2)=LEXP
|
|
Q X
|
|
FILES ; File version/contents
|
|
N LEXCT,LEXT,LEXSP,LEXFI,LEXX,LEXGL,LEXNM,LEXVR,LEXLR,LEXTR,LEXRLR
|
|
N LEXDDA,LEXPRD,LEXRN,LEXRD,LEXFCT
|
|
S LEXFI=756.999999,LEXCT=0,LEXSP=" ",LEXFCT=$$FC
|
|
S LEXT=" FILE NAME VER REV DATE LAST IEN RECORDS"
|
|
D BL,TT("FILE VERSIONS/REVISIONS"),BL,TL(LEXT),BK1
|
|
D:+LEXFCT'>0 BL,TL(" NO FILES FOUND") Q:+LEXFCT'>0
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEX(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") D FL
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEXT(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") D FL
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEXC(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") D FL
|
|
F LEXFI=80,80.1,81,81.3 D FL
|
|
Q
|
|
FL ; File List
|
|
N LEXN K LEXDDA S LEXN=$$ATTR(LEXFI,"NAME") Q:'$L(LEXN)
|
|
S LEXGL=$$ATTR(LEXFI,"GLOBAL NAME") Q:'$L(LEXGL)
|
|
S LEXX=LEXGL_"0)",LEXX=$G(@LEXX),LEXTR=+($P(LEXX,"^",4)),LEXLR=+($P(LEXX,"^",3))
|
|
S LEXRLR=$O(@(LEXGL_""" "")"),-1) S:'$L($G(LEXX)) (LEXTR,LEXLR)="??" S:LEXRLR'=LEXLR (LEXTR,LEXLR)="??"
|
|
S LEXNM=$E(LEXN,1,21),LEXX=$$ATTR(LEXFI,"VERSION")
|
|
S LEXVR=$P(LEXX,".",1),LEXX=$P(LEXX,".",2),LEXVR=$J(LEXVR,3)_$S($L(LEXVR):".",1:"")_LEXX
|
|
S LEXPRD=$$ATTR(LEXFI,"PACKAGE REVISION DATA")
|
|
S LEXRN=$P(LEXPRD,"^",1) S:LEXRN="" LEXRN="1"
|
|
S LEXRD=$P(LEXPRD,"^",2) S:LEXRD'="" LEXRD=$$MDCY(LEXRD)
|
|
S:LEXRD="" LEXRD="10/04/96"
|
|
S LEXCT=LEXCT+1,LEXT=$J(LEXCT,3)_" "_LEXFI_$E(LEXSP,1,(9-$L(LEXFI)))
|
|
S LEXT=LEXT_LEXNM_$E(LEXSP,1,(21-$L(LEXNM))),LEXT=LEXT_LEXVR_$E(LEXSP,1,(8-$L(LEXVR)))
|
|
S LEXT=LEXT_LEXRN_$E(LEXSP,1,(4-$L(LEXRN))),LEXT=LEXT_LEXRD_$E(LEXSP,1,(14-$L(LEXRD)))
|
|
S LEXT=LEXT_$J(LEXLR,7)_" "_$J(LEXTR,7) D TL(LEXT)
|
|
Q
|
|
SHOW ; Show global array (display or mail)
|
|
D:$D(LEXMAIL) MAIL,CLR D:'$D(LEXMAIL) DSP,CLR Q
|
|
SHOW2 ; Display global array
|
|
N LEXI S LEXI=0 F S LEXI=$O(^TMP($J,"LEXINFO",LEXI)) Q:+LEXI=0 W !,^TMP($J,"LEXINFO",LEXI)
|
|
Q
|
|
MAIL ; Mail global array in message
|
|
N DIFROM,LEXADR S U="^",XMSUB="LEXICON INFO"
|
|
S:$L($G(LEXBUILD)) XMSUB=LEXBUILD_" Installation"
|
|
S LEXADR=$$ADR^LEXU Q:'$L(LEXADR)
|
|
S XMY(("G.LEXINS@"_LEXADR))="",XMTEXT="^TMP($J,""LEXINFO"",",XMDUZ=.5 D ^XMD
|
|
K ^TMP($J,"LEXINFO"),%Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ Q
|
|
Q
|
|
CLR ; Clean up
|
|
K ^TMP($J,"LEXINFO") Q
|
|
BL ; Blank Line
|
|
N LEXNX S LEXNX=+($$NX),^TMP($J,"LEXINFO",LEXNX)="" Q
|
|
TT(LEXX) ; Title Line
|
|
Q:'$L($G(LEXX)) D TL(LEXX) N LEXBK S LEXBK="===============================================================================",LEXBK=$E(LEXBK,1,$L($G(LEXX))) D:$L(LEXBK) TL(LEXBK) Q
|
|
TL(LEXX) ; Text Line
|
|
N LEXNX S LEXNX=+($$NX),^TMP($J,"LEXINFO",LEXNX)=$G(LEXX) Q
|
|
BK1 ; Break Line
|
|
N LEXNX S LEXNX=+($$NX),^TMP($J,"LEXINFO",LEXNX)="-------------------------------------------------------------------------------" Q
|
|
NX(LEXX) ; Next Line #
|
|
S (LEXX,^TMP($J,"LEXINFO",0))=+($G(^TMP($J,"LEXINFO",0)))+1 Q LEXX
|
|
DSP ; Display ^TMP($J,"LEXINFO")
|
|
D DEV Q
|
|
DEV ; Select a device
|
|
N %,%ZIS,IOP,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO,ZTSK
|
|
S ZTRTN="DSPI^LEXXST",ZTDESC="printing Lexicon installation information"
|
|
S ZTIO=ION,ZTDTH=$H,%ZIS="PQ",ZTSAVE("^TMP($J,""LEXINFO"",")=""
|
|
D ^%ZIS Q:POP S ZTIO=ION I $D(IO("Q")) D QUE,^%ZISC Q
|
|
D NOQUE Q
|
|
NOQUE ; Do not que task
|
|
W @IOF W:IOST["P-" !,"< Not queued, printing Lexicon Installations >",! H 2 U:IOST["P-" IO D @ZTRTN,^%ZISC Q
|
|
QUE ; Task queued to print user defaults
|
|
K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),! H 2 Q
|
|
Q
|
|
DSPI ; Display installations
|
|
I '$D(ZTQUEUED),$G(IOST)'["P-" W:'$D(LEXDNC) # I '$D(^TMP($J,"LEXINFO")) W !,"Installations not found"
|
|
I IOST["P-" U IO
|
|
G:'$D(^TMP($J,"LEXINFO")) DSPQ
|
|
N LEXCONT,LEXI,LEXLC,LEXEOP S LEXCONT="",(LEXLC,LEXI)=0,LEXEOP=+($G(IOSL)) S:LEXEOP=0 LEXEOP=24
|
|
F S LEXI=$O(^TMP($J,"LEXINFO",LEXI)) Q:+LEXI=0!(LEXCONT["^") D
|
|
. W !,^TMP($J,"LEXINFO",LEXI) D LF Q:LEXCONT["^"
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
W:$G(IOST)["P-" @IOF
|
|
DSPQ ; Quit Display
|
|
Q
|
|
LF ; Line Feed
|
|
S LEXLC=LEXLC+1 D:IOST["P-"&(LEXLC>(LEXEOP-7)) CONT D:IOST'["P-"&(LEXLC>(LEXEOP-4)) CONT
|
|
Q
|
|
CONT ; Page/Form Feed
|
|
S LEXLC=0 W:IOST["P-" @IOF Q:IOST["P-" W !!,"Press <Return> to continue " R LEXCONT:300 S:'$T LEXCONT="^" S:LEXCONT'["^" LEXCONT=""
|
|
Q
|
|
A(LEX) ; As of date/time
|
|
N %,X,%I,%H D NOW^%DTC S LEX=$$UP^XLFSTR($$FMTE^XLFDT(%,"1")) S:LEX["@" LEX=$P(LEX,"@",1)_" "_$P(LEX,"@",2,299) Q LEX
|
|
P(LEX) ; Person
|
|
S LEX=+($G(DUZ)) Q:'$L($P($G(^VA(200,+($G(LEX)),0)),"^",1)) "UNKNOWN^"
|
|
N LEXDUZ,LEXPH S LEXDUZ=+($G(DUZ))
|
|
S LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",2) S:LEXPH="" LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",1) S:LEXPH="" LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",3) S:LEXPH="" LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",4)
|
|
S LEXDUZ=$P(^VA(200,LEXDUZ,0),"^",1),LEX=LEXDUZ_"^"_LEXPH Q LEX
|
|
N0 ; 0 Node
|
|
N LEXFI,LEXCT,DIC S LEXCT=0
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEX(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S DIC=$$ATTR(LEXFI,"GLOBAL NAME") D N0C
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEXT(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S DIC=$$ATTR(LEXFI,"GLOBAL NAME") D N0C
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEXC(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S DIC=$$ATTR(LEXFI,"GLOBAL NAME") D N0C
|
|
F LEXFI=80,80.1,81,81.3 S DIC=$$ATTR(LEXFI,"GLOBAL NAME") D N0C
|
|
Q
|
|
N0C ; 0 Node Count
|
|
N DA,LEXLR,LEXTR,LEXDDA,LEXNM
|
|
K LEXDDA D FILE^DID(LEXFI,"N","NAME","LEXDDA","LEXDDA")
|
|
S LEXNM=$G(LEXDDA("NAME")) Q:'$L(LEXNM) S (DA,LEXLR,LEXTR)=0
|
|
F S DA=$O(@(DIC_DA_")")) Q:+DA=0 S LEXLR=DA,LEXTR=LEXTR+1
|
|
S $P(@(DIC_"0)"),"^",3)=LEXLR,$P(@(DIC_"0)"),"^",4)=LEXTR
|
|
W:'$D(ZTQUEUED) !,LEXFI,?10,$J(LEXLR,10),$J(LEXTR,10)
|
|
Q
|
|
FC(X) ; File Count
|
|
N LEXFI,LEXCT S LEXCT=0
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEX(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S LEXCT=LEXCT+1
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEXT(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S LEXCT=LEXCT+1
|
|
S LEXFI=756.999999 F S LEXFI=$O(^LEXC(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S LEXCT=LEXCT+1
|
|
S X=LEXCT Q X
|
|
MDCY(X) ; Month/Day/Century-Year where X=FM Date
|
|
N LEXCY S LEXCY=+($G(X)) Q:LEXCY=0 "" S LEXCY=$P($$FMTE^XLFDT(LEXCY,2),"/",1,2)_"/"_$P($P($$FMTE^XLFDT(LEXCY,1)," ",3),"@",1)
|
|
S:$L($P(LEXCY,"/",1))<2 $P(LEXCY,"/",1)="0"_$P(LEXCY,"/",1) S:$L($P(LEXCY,"/",2))<2 $P(LEXCY,"/",2)="0"_$P(LEXCY,"/",2)
|
|
S:$L($P(LEXCY,"/",1))<2 $P(LEXCY,"/",1)="0"_$P(LEXCY,"/",1) S:$L($P(LEXCY,"/",2))<2 $P(LEXCY,"/",2)="0"_$P(LEXCY,"/",2)
|
|
S X=LEXCY Q X
|
|
ATTR(X,A) ; File Attributes
|
|
N LEXFI,LEXATT,LEXDDA
|
|
S LEXFI=+($G(X)) Q:+LEXFI'>0 "" S LEXATT=$G(A) Q:'$L(LEXATT) ""
|
|
D FILE^DID(LEXFI,"N",LEXATT,"LEXDDA","LEXDDA") S X=$G(LEXDDA(LEXATT))
|
|
Q X
|