source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXII.m@ 814

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

initial load of WorldVistAEHR

File size: 5.9 KB
RevLine 
[613]1LEXXII ; ISL/KER - Lexicon Status (Install Info) ; 01/01/2007
2 ;;2.0;LEXICON UTILITY;**32,46,49**;Sep 23, 1996;Build 3
3 ;
4 ; Global Variables
5 ; DBIA 10096 ^%ZOSF("PROD"
6 ; DBIA 10096 ^%ZOSF("UCI"
7 ; DBIA 10060 ^VA(200
8 ; ^LEXM(0
9 ; ^TMP("LEX*",$J SACC 2.3.2.5.1
10 ;
11 ; External References
12 ; DBIA 10103 $$FMTE^XLFDT
13 ; DBIA 10103 $$NOW^XLFDT
14 ; DBIA 10103 $$FMDIFF^XLFDT
15 ; DBIA 2056 $$GET1^DIQ (file #200)
16 ; DBIA 2051 FIND^DIC
17 ; DBIA 2056 GETS^DIQ
18 ;
19 ; LEXCRE Newed in LEXXGI
20 ; LEXID Newed in LEXXFI
21 ; LEXIGHF Newed in Post-Install LEX20nnP
22 ;
23EN ; Main Entry
24 N LEXSUB S LEXSUB=$G(LEXID) S:LEXSUB="" LEXSUB="LEXXII" K ^TMP(LEXSUB,$J) D II
25 Q
26 ;
27II ; Install Information
28 N LEXT,LEXA,LEXACT,LEXB,LEXD,LEXE,LEXL,LEXU,LEXN,LEXP,LEXPRO,LEXPRON,LEXPROF,LEXDA H 2
29 S LEXA="",LEXACT=$G(LEXACCT),LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO")) S:+LEXPRO>0 LEXPRO=$$ED(LEXPRO),LEXPROF=1
30 S LEXT="Lexicon/ICD/CPT Installation" D TL(LEXT)
31 S LEXT="============================" D TL(LEXT),BL
32 S LEXD=$$ASOF,LEXA=$$UCI,LEXU=$$USR,LEXN=$P(LEXU,"^",1)
33 S:$L($P(LEXACT,"^",1))&($L($P(LEXACT,"^",1))) LEXA=LEXACT
34 S LEXP=$P(LEXU,"^",2),LEXN=$$PM^LEXXFI7(LEXN)
35 S:$L(LEXD) LEXT=" As of: "_LEXD
36 D:$L(LEXD) TL(LEXT)
37 S LEXT="" S:$L(LEXA) LEXT=" In Account: "_$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
38 S:$L(LEXT)&($L($P(LEXA,"^",2))) LEXT=LEXT_" "_$P(LEXA,"^",2)
39 D:$L(LEXA) TL(LEXT)
40 S LEXT="" S:$L(LEXU) LEXT=" Maint By: "
41 S:$L(LEXN) LEXT=LEXT_LEXN
42 S:$L(LEXP)&($L(LEXN)) LEXT=LEXT_" "_LEXP
43 D:$L(LEXT)&(LEXT'["UNKNOWN") TL(LEXT)
44 S LEXT="" S:$L($G(LEXBUILD)) LEXT=" Build: "_$G(LEXBUILD)
45 D:$L(LEXT) TL(LEXT)
46 S LEXT="" S:$L($G(LEXIGHF)) LEXT=" Host File: "_$G(LEXIGHF)
47 S:$L(LEXT)&($L($G(LEXCRE)))&($P($G(LEXCRE),".",1)?7N) LEXT=LEXT_" (Created "_$$ED($G(LEXCRE))_")"
48 S:'$L(LEXT)&($L($G(LEXCRE)))&($P($G(LEXCRE),".",1)?7N) LEXT=" Created: "_$$ED($G(LEXCRE))
49 D:$L(LEXT) TL(LEXT)
50 S LEXT="" I $L($G(LEXPRO))&($L($G(LEXPRON)))&(+($G(LEXPROF))>0) D
51 . S LEXT=" Protocol: "_LEXPRON D BL,TL(LEXT)
52 . S LEXT=" Invoked: "_LEXPRO D TL(LEXT)
53 S LEXB=$$SS($G(LEXBUILD)),LEXE=$P(LEXB,"^",2),LEXL=$P(LEXB,"^",3),LEXB=$P(LEXB,"^",1)
54 I $P(LEXB,".",1)?7N!($P(LEXB,".",2)?7N)!($P(LEXB,".",3)[":") D
55 . D BL
56 . I $P(LEXB,".",1)?7N D
57 . . S LEXT="" S LEXT=" Started: "_$$ED($G(LEXB)) D TL(LEXT)
58 . I $P(LEXE,".",1)?7N D
59 . . S LEXT="" S LEXT=" Finished: "_$$ED($G(LEXE)) D TL(LEXT)
60 . I $L(LEXL) D
61 . . S LEXT="" S LEXT=" Elapsed: "_$$ED($G(LEXL)) D TL(LEXT)
62 D BL
63 Q
64 ;
65 ; Miscellaneous
66UCI(X) ; UCI where Lexicon is installed
67 N LEXU,LEXP,LEXT,Y X ^%ZOSF("UCI") S LEXU=Y,LEXP="" S:LEXU=^%ZOSF("PROD")!($P(LEXU,",",1)=^%ZOSF("PROD")) LEXP=" (Production)"
68 S:LEXU'=^%ZOSF("PROD")&($P(LEXU,",",1)'=^%ZOSF("PROD")) LEXP=" (Test)" S X="",$P(X,"^",1)=LEXU,$P(X,"^",2)=LEXP
69 Q X
70USR(LEX) ; User/Person
71 N LEXDUZ,LEXPH,LEXNM
72 S LEX=+($G(DUZ)),LEXNM=$$GET1^DIQ(200,+LEX,.01) Q:'$L(LEXNM) "UNKNOWN^"
73 S LEXDUZ=LEX S LEXPH=$$GET1^DIQ(200,+LEXDUZ,.132) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXDUZ,.131)
74 S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXDUZ,.133) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXDUZ,.134)
75 S LEXDUZ=$$GET1^DIQ(200,+LEX,.01),LEX=LEXDUZ_"^"_LEXPH Q LEX
76SS(LEX) ; Start/Stop Times
77 N LEXDA,LEXOUT,LEXIENS,LEXB,LEXBUILD,LEXB,LEXE,LEXL
78 S LEXBUILD=$G(LEX),LEXD=0 S:$L(LEXBUILD) LEXD=$$DDA(LEXBUILD)
79 S LEXDA=+($G(XPDA))
80 I +LEXDA>0 D
81 . S LEXIENS=LEXDA_","
82 . D GETS^DIQ(9.7,LEXIENS,"11;17","I","LEXOUT")
83 . S LEXL=0,LEXB=$G(LEXOUT(9.7,LEXIENS,11,"I"))
84 . S LEXE=$G(LEXOUT(9.7,LEXIENS,17,"I"))
85 . S:+LEXE'>0 LEXE=$$NOW^XLFDT
86 . S:+LEXB>0&(+LEXE>0) LEXL=$$EP(LEXB,LEXE)
87 . S LEX=LEXB_"^"_LEXE S:$L(LEXL) $P(LEX,"^",3)=LEXL
88 I +LEXDA=0 D
89 . S LEX="" S LEXDA=+($G(LEXD)) Q:+LEXDA'>0
90 . S LEXL="",LEXB=$P($G(LEXD),"^",2) Q:$P(LEXB,".",1)'?7N
91 . S LEXE=$P($G(LEXD),"^",3) Q:$P(LEXE,".",1)'?7N
92 . S:+LEXB>0&(+LEXE>0) LEXL=$$EP(LEXB,LEXE)
93 . S LEX=LEXB_"^"_LEXE S:$L(LEXL) $P(LEX,"^",3)=LEXL
94 Q LEX
95DDA(LEX) ; Get Default DA of Build LEX
96 N LEXB,LEXE,LEXOUT,LEXMSG,LEXI S LEXB=$G(LEX) Q:'$L(LEXB) ""
97 D FIND^DIC(9.7,,"11I;17I","BP",LEXB,,"B",,,"LEXOUT","LEXMSG")
98 S LEXI=+($O(LEXOUT("DILIST"," "),-1))
99 S LEXB=$G(LEXOUT("DILIST",+LEXI,0))
100 S LEXI=$P(LEXB,"^",1),LEXE=$P(LEXB,"^",4),LEXB=$P(LEXB,"^",3)
101 Q:+($G(LEXI))'>0 "" Q:+($G(LEXB))'>0 "" S:+LEXE'>0 LEXE=$$NOW^XLFDT
102 S LEX=LEXI_"^"_LEXB_"^"_LEXE
103 Q LEX
104ASOF(LEX) ; As of date/time
105 S X=$$ED($$NOW^XLFDT) Q X
106ED(LEX) ; External Date MM/DD/YYYY TT:TT
107 S LEX=$$FMTE^XLFDT($G(LEX),"1Z")
108 S:LEX["@" LEX=$P(LEX,"@",1)_" "_$P(LEX,"@",2,299) Q LEX
109 Q LEX
110EP(X,Y) ; Elapsed Time (Begin, End)
111 N LEXTIM,LEXBEG,LEXEND
112 S LEXBEG=$G(X),LEXEND=$G(Y) Q:+LEXBEG'>0 "" Q:+LEXEND'>0 ""
113 S LEXTIM=$$FMDIFF^XLFDT(LEXEND,LEXBEG,2) Q:+LEXTIM'>0 "00:00:00"
114 S LEXTIM=$$TIM(LEXTIM)
115 Q LEXTIM
116TIM(X) ; Format Time Elapsed
117 N LEXD,LEXH,LEXM,LEXS,LEXT,LEXV S X=+($G(X)) Q:X'>0 "00:00:00"
118 S LEXD=X\86400 S LEXV=LEXD*86400 S:+LEXV>0&(LEXV<X) X=X-LEXV
119 S LEXH=X\3600 S LEXV=LEXH*3600 S:+LEXV>0&(LEXV<X) X=X-LEXV
120 S:$L(LEXH)<2 LEXH="0"_LEXH S:$L(LEXH)<2 LEXH="0"_LEXH
121 S LEXM=X\60 S LEXV=LEXM*60 S:+LEXV>0&(LEXV<X) X=X-LEXV
122 S:$L(LEXM)<2 LEXM="0"_LEXM S:$L(LEXM)<2 LEXM="0"_LEXM
123 S LEXS=X S:$L(LEXS)<2 LEXS="0"_LEXS S:$L(LEXS)<2 LEXS="0"_LEXS
124 S LEXT="" S:+LEXD>0 LEXT=+LEXD_" day"_$S(+LEXD>1:"s",1:"")_" "
125 S LEXT=LEXT_LEXH_":"_LEXM_":"_LEXS,X=LEXT
126 Q X
127BL ; Blank Line
128 D TL("") Q
129TL(LEXX) ; Text Line
130 S LEXSUB=$G(LEXSUB) S:'$L(LEXSUB) LEXSUB="LEXXII"
131 I '$D(^TMP(LEXSUB,$J,1)) S ^TMP(LEXSUB,$J,1)=" ",^TMP(LEXSUB,$J,0)=1
132 N LEXNX S LEXNX=$O(^TMP(LEXSUB,$J," "),-1),LEXNX=LEXNX+1
133 S ^TMP(LEXSUB,$J,LEXNX)=" "_$G(LEXX),^TMP(LEXSUB,$J,0)=LEXNX
134 Q
135ST ; Show Temp Array
136 S LEXSUB=$G(LEXSUB) S:'$L(LEXSUB) LEXSUB="LEXXII"
137 N LEXN,LEXC S LEXN="^TMP("""_LEXSUB_""","_$J_")",LEXC="^TMP("""_LEXSUB_""","_$J_","
138 F S LEXN=$Q(@LEXN) Q:LEXN=""!(LEXN'[LEXC) D
139 . Q:LEXN[",0)" W !,@LEXN
140 Q
Note: See TracBrowser for help on using the repository browser.