source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXST.m@ 1375

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

initial load of WorldVistAEHR
File size: 8.7 KB
RevLine 
[613]1LEXXST ; ISL/KER - Lexicon Status (Main/Files) ; 02/22/2007
2 ;;2.0;LEXICON UTILITY;**4,5,8,25,27,49**;Sep 23, 1996;Build 3
3 ;
4 ; External References
5 ; DBIA 10096 ^%ZOSF("PROD"
6 ; DBIA 10096 ^%ZOSF("UCI"
7 ; DBIA 10060 ^VA(200
8 ; DBIA 10000 NOW^%DTC
9 ; DBIA 10086 ^%ZIS
10 ; DBIA 10086 HOME^%ZIS
11 ; DBIA 10089 ^%ZISC
12 ; DBIA 10063 ^%ZTLOAD
13 ; DBIA 2052 FILE^DID
14 ; DBIA 10103 $$FMTE^XLFDT
15 ; DBIA 10104 $$UP^XLFSTR
16 ; DBIA 10070 ^XMD
17 ;
18DISP ; Display Status only
19 K ^TMP($J,"LEXINFO"),LEXMAIL,LEXAO N X,Y,LEXM,LEXY
20 D DATA,SHOW Q
21SEND ; Send Status to G.LEXINS@ISC-SLC.VA.GOV
22 K ^TMP($J,"LEXINFO") N X,Y,LEXM,LEXY
23 S:$L($G(LEXBUILD)) ZTSAVE("LEXBUILD")=""
24 S:$D(LEXSHORT) ZTSAVE("LEXSHORT")=""
25 S ZTRTN="SENDTO^LEXXST",ZTDESC="Lexicon Status Report Msg [LEXXST]",ZTIO="",ZTDTH=$H
26 D ^%ZTLOAD
27 D HOME^%ZIS K Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN
28 Q
29SENDTO ; Send Status (Tasked)
30 N LEXMAIL,LEXAO S (LEXMAIL,LEXAO)="" S:$D(ZTQUEUED) ZTREQ="@"
31 D:'$D(LEXSHORT) N0 D DATA,SHOW Q
32DATA ; Get Data
33 D TITLE Q:$D(LEXSHORT)
34 D FILES,PT^LEXXST2,RTT^LEXXST2
35 D KIDS^LEXXST3,RTN^LEXXST3
36 Q
37TITLE ; Title of display/message
38 N LEXT,LEXA,LEXD,LEXU,LEXN,LEXP
39 S LEXT="LEXICON UTILITY STATUS",LEXD=$$A,LEXA=$$U
40 S LEXU=$$P,LEXN=$P(LEXU,"^",1),LEXP=$P(LEXU,"^",2)
41 I $D(LEXAO) D Q
42 . 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:"")
43 . S:$L(LEXT)&($L($P(LEXA,"^",2))) LEXT=LEXT_" "_$P(LEXA,"^",2) D:$L(LEXA) TL(LEXT)
44 . 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)
45 . S LEXT="" S:$L($G(LEXBUILD)) LEXT=" BUILD: "_$G(LEXBUILD)
46 . D:$L(LEXT) TL(LEXT) D BL
47 I '$D(LEXAO) D Q
48 . 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:"")
49 . S:$L(LEXT)&($L($P(LEXA,"^",2))) LEXT=LEXT_" "_$P(LEXA,"^",2) D:$L(LEXA) TL(LEXT) D BL
50 Q
51U(X) ; UCI where Lexicon is installed
52 N LEXU,LEXP,LEXT,Y X ^%ZOSF("UCI") S LEXU=Y,LEXP=""
53 S:LEXU=^%ZOSF("PROD")!($P(LEXU,",",1)=^%ZOSF("PROD")) LEXP=" (Production)"
54 S:LEXU'=^%ZOSF("PROD")&($P(LEXU,",",1)'=^%ZOSF("PROD")) LEXP=" (Test)"
55 S X="",$P(X,"^",1)=LEXU,$P(X,"^",2)=LEXP
56 Q X
57FILES ; File version/contents
58 N LEXCT,LEXT,LEXSP,LEXFI,LEXX,LEXGL,LEXNM,LEXVR,LEXLR,LEXTR,LEXRLR
59 N LEXDDA,LEXPRD,LEXRN,LEXRD,LEXFCT
60 S LEXFI=756.999999,LEXCT=0,LEXSP=" ",LEXFCT=$$FC
61 S LEXT=" FILE NAME VER REV DATE LAST IEN RECORDS"
62 D BL,TT("FILE VERSIONS/REVISIONS"),BL,TL(LEXT),BK1
63 D:+LEXFCT'>0 BL,TL(" NO FILES FOUND") Q:+LEXFCT'>0
64 S LEXFI=756.999999 F S LEXFI=$O(^LEX(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") D FL
65 S LEXFI=756.999999 F S LEXFI=$O(^LEXT(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") D FL
66 S LEXFI=756.999999 F S LEXFI=$O(^LEXC(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") D FL
67 F LEXFI=80,80.1,81,81.3 D FL
68 Q
69FL ; File List
70 N LEXN K LEXDDA S LEXN=$$ATTR(LEXFI,"NAME") Q:'$L(LEXN)
71 S LEXGL=$$ATTR(LEXFI,"GLOBAL NAME") Q:'$L(LEXGL)
72 S LEXX=LEXGL_"0)",LEXX=$G(@LEXX),LEXTR=+($P(LEXX,"^",4)),LEXLR=+($P(LEXX,"^",3))
73 S LEXRLR=$O(@(LEXGL_""" "")"),-1) S:'$L($G(LEXX)) (LEXTR,LEXLR)="??" S:LEXRLR'=LEXLR (LEXTR,LEXLR)="??"
74 S LEXNM=$E(LEXN,1,21),LEXX=$$ATTR(LEXFI,"VERSION")
75 S LEXVR=$P(LEXX,".",1),LEXX=$P(LEXX,".",2),LEXVR=$J(LEXVR,3)_$S($L(LEXVR):".",1:"")_LEXX
76 S LEXPRD=$$ATTR(LEXFI,"PACKAGE REVISION DATA")
77 S LEXRN=$P(LEXPRD,"^",1) S:LEXRN="" LEXRN="1"
78 S LEXRD=$P(LEXPRD,"^",2) S:LEXRD'="" LEXRD=$$MDCY(LEXRD)
79 S:LEXRD="" LEXRD="10/04/96"
80 S LEXCT=LEXCT+1,LEXT=$J(LEXCT,3)_" "_LEXFI_$E(LEXSP,1,(9-$L(LEXFI)))
81 S LEXT=LEXT_LEXNM_$E(LEXSP,1,(21-$L(LEXNM))),LEXT=LEXT_LEXVR_$E(LEXSP,1,(8-$L(LEXVR)))
82 S LEXT=LEXT_LEXRN_$E(LEXSP,1,(4-$L(LEXRN))),LEXT=LEXT_LEXRD_$E(LEXSP,1,(14-$L(LEXRD)))
83 S LEXT=LEXT_$J(LEXLR,7)_" "_$J(LEXTR,7) D TL(LEXT)
84 Q
85SHOW ; Show global array (display or mail)
86 D:$D(LEXMAIL) MAIL,CLR D:'$D(LEXMAIL) DSP,CLR Q
87SHOW2 ; Display global array
88 N LEXI S LEXI=0 F S LEXI=$O(^TMP($J,"LEXINFO",LEXI)) Q:+LEXI=0 W !,^TMP($J,"LEXINFO",LEXI)
89 Q
90MAIL ; Mail global array in message
91 N DIFROM,LEXADR S U="^",XMSUB="LEXICON INFO"
92 S:$L($G(LEXBUILD)) XMSUB=LEXBUILD_" Installation"
93 S LEXADR=$$ADR^LEXU Q:'$L(LEXADR)
94 S XMY(("G.LEXINS@"_LEXADR))="",XMTEXT="^TMP($J,""LEXINFO"",",XMDUZ=.5 D ^XMD
95 K ^TMP($J,"LEXINFO"),%Z,XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ Q
96 Q
97CLR ; Clean up
98 K ^TMP($J,"LEXINFO") Q
99BL ; Blank Line
100 N LEXNX S LEXNX=+($$NX),^TMP($J,"LEXINFO",LEXNX)="" Q
101TT(LEXX) ; Title Line
102 Q:'$L($G(LEXX)) D TL(LEXX) N LEXBK S LEXBK="===============================================================================",LEXBK=$E(LEXBK,1,$L($G(LEXX))) D:$L(LEXBK) TL(LEXBK) Q
103TL(LEXX) ; Text Line
104 N LEXNX S LEXNX=+($$NX),^TMP($J,"LEXINFO",LEXNX)=$G(LEXX) Q
105BK1 ; Break Line
106 N LEXNX S LEXNX=+($$NX),^TMP($J,"LEXINFO",LEXNX)="-------------------------------------------------------------------------------" Q
107NX(LEXX) ; Next Line #
108 S (LEXX,^TMP($J,"LEXINFO",0))=+($G(^TMP($J,"LEXINFO",0)))+1 Q LEXX
109DSP ; Display ^TMP($J,"LEXINFO")
110 D DEV Q
111DEV ; Select a device
112 N %,%ZIS,IOP,ZTRTN,ZTSAVE,ZTDESC,ZTDTH,ZTIO,ZTSK
113 S ZTRTN="DSPI^LEXXST",ZTDESC="printing Lexicon installation information"
114 S ZTIO=ION,ZTDTH=$H,%ZIS="PQ",ZTSAVE("^TMP($J,""LEXINFO"",")=""
115 D ^%ZIS Q:POP S ZTIO=ION I $D(IO("Q")) D QUE,^%ZISC Q
116 D NOQUE Q
117NOQUE ; Do not que task
118 W @IOF W:IOST["P-" !,"< Not queued, printing Lexicon Installations >",! H 2 U:IOST["P-" IO D @ZTRTN,^%ZISC Q
119QUE ; Task queued to print user defaults
120 K IO("Q") D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued",1:"Request Cancelled"),! H 2 Q
121 Q
122DSPI ; Display installations
123 I '$D(ZTQUEUED),$G(IOST)'["P-" W:'$D(LEXDNC) # I '$D(^TMP($J,"LEXINFO")) W !,"Installations not found"
124 I IOST["P-" U IO
125 G:'$D(^TMP($J,"LEXINFO")) DSPQ
126 N LEXCONT,LEXI,LEXLC,LEXEOP S LEXCONT="",(LEXLC,LEXI)=0,LEXEOP=+($G(IOSL)) S:LEXEOP=0 LEXEOP=24
127 F S LEXI=$O(^TMP($J,"LEXINFO",LEXI)) Q:+LEXI=0!(LEXCONT["^") D
128 . W !,^TMP($J,"LEXINFO",LEXI) D LF Q:LEXCONT["^"
129 S:$D(ZTQUEUED) ZTREQ="@"
130 W:$G(IOST)["P-" @IOF
131DSPQ ; Quit Display
132 Q
133LF ; Line Feed
134 S LEXLC=LEXLC+1 D:IOST["P-"&(LEXLC>(LEXEOP-7)) CONT D:IOST'["P-"&(LEXLC>(LEXEOP-4)) CONT
135 Q
136CONT ; Page/Form Feed
137 S LEXLC=0 W:IOST["P-" @IOF Q:IOST["P-" W !!,"Press <Return> to continue " R LEXCONT:300 S:'$T LEXCONT="^" S:LEXCONT'["^" LEXCONT=""
138 Q
139A(LEX) ; As of date/time
140 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
141P(LEX) ; Person
142 S LEX=+($G(DUZ)) Q:'$L($P($G(^VA(200,+($G(LEX)),0)),"^",1)) "UNKNOWN^"
143 N LEXDUZ,LEXPH S LEXDUZ=+($G(DUZ))
144 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)
145 S LEXDUZ=$P(^VA(200,LEXDUZ,0),"^",1),LEX=LEXDUZ_"^"_LEXPH Q LEX
146N0 ; 0 Node
147 N LEXFI,LEXCT,DIC S LEXCT=0
148 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
149 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
150 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
151 F LEXFI=80,80.1,81,81.3 S DIC=$$ATTR(LEXFI,"GLOBAL NAME") D N0C
152 Q
153N0C ; 0 Node Count
154 N DA,LEXLR,LEXTR,LEXDDA,LEXNM
155 K LEXDDA D FILE^DID(LEXFI,"N","NAME","LEXDDA","LEXDDA")
156 S LEXNM=$G(LEXDDA("NAME")) Q:'$L(LEXNM) S (DA,LEXLR,LEXTR)=0
157 F S DA=$O(@(DIC_DA_")")) Q:+DA=0 S LEXLR=DA,LEXTR=LEXTR+1
158 S $P(@(DIC_"0)"),"^",3)=LEXLR,$P(@(DIC_"0)"),"^",4)=LEXTR
159 W:'$D(ZTQUEUED) !,LEXFI,?10,$J(LEXLR,10),$J(LEXTR,10)
160 Q
161FC(X) ; File Count
162 N LEXFI,LEXCT S LEXCT=0
163 S LEXFI=756.999999 F S LEXFI=$O(^LEX(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S LEXCT=LEXCT+1
164 S LEXFI=756.999999 F S LEXFI=$O(^LEXT(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S LEXCT=LEXCT+1
165 S LEXFI=756.999999 F S LEXFI=$O(^LEXC(LEXFI)) Q:+LEXFI=0!($E(LEXFI,1,3)'="757") S LEXCT=LEXCT+1
166 S X=LEXCT Q X
167MDCY(X) ; Month/Day/Century-Year where X=FM Date
168 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)
169 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)
170 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)
171 S X=LEXCY Q X
172ATTR(X,A) ; File Attributes
173 N LEXFI,LEXATT,LEXDDA
174 S LEXFI=+($G(X)) Q:+LEXFI'>0 "" S LEXATT=$G(A) Q:'$L(LEXATT) ""
175 D FILE^DID(LEXFI,"N",LEXATT,"LEXDDA","LEXDDA") S X=$G(LEXDDA(LEXATT))
176 Q X
Note: See TracBrowser for help on using the repository browser.