source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXLGM.m@ 901

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1LEXLGM ; ISL Lexicon Survey (Post Inst/Oper) ; 05/14/2003
2 ;;2.0;LEXICON UTILITY;**25**;Sep 23, 1996;Build 1
3 ;
4EN ; Operational Task
5 K ^TMP("LEXMSG")
6 S ZTRTN="OPR^LEXLGM",ZTDESC="Lexicon Terms in Problem List",ZTIO="",ZTDTH=$H
7 D ^%ZTLOAD,HOME^%ZIS K %X,%Y,Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN Q
8 Q
9EN2 ; Post-Install Task
10 K ^TMP("LEXMSG")
11 S ZTRTN="POST^LEXLGM",ZTDESC="Lexicon Installation",ZTIO="",ZTDTH=$H
12 D ^%ZTLOAD,HOME^%ZIS K %X,%Y,Y,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN Q
13 Q
14OPR ; Operational Survey
15 K ^TMP("LEXMSG") N LEXTYPE S LEXTYPE="O"
16 N LEXQ,LEXVERS,LEXFI,LEXDT,LEXS
17 D DATE S:'$D(LEXDT) LEXDT="" S LEXVERS=$$VR
18 D PLT^LEXLGM3,ASOF^LEXLGM3,PLUR^LEXLGM3,SG,SEND
19 S:$D(ZTQUEUED) ZTREQ="@"
20 Q
21POST ; Post-Install Survey
22 K ^TMP("LEXMSG") N LEXTYPE,LEXQ,LEXVERS,LEXFI,LEXDT,LEXS
23 S LEXTYPE="P" D DATE S:'$D(LEXDT) LEXDT="" S LEXVERS=$$VR
24 D TITLE,INIT D:+LEXVERS>1 INST,ACCT,WHO D:+LEXVERS'>1 ATTPT,ACCT,WHO
25 D BL,POST^LEXLGM2,PLUR^LEXLGM3,VER,SG,SEND
26 S:$D(ZTQUEUED) ZTREQ="@"
27 Q
28SG ; Show TMP Global
29 N LEXI S LEXI=0 F S LEXI=$O(^TMP("LEXMSG",LEXI)) Q:+LEXI=0 W:'$D(ZTQUEUED) !,^TMP("LEXMSG",LEXI)
30 Q
31SEND ; Create message to send to ISC-SLC
32 N LEXADR,DIFROM Q:'$D(ZTQUEUED) Q:'$L($G(LEXTYPE)) S LEXADR=$$ADR^LEXU Q:'$L(LEXADR)
33 N LEXT S LEXT=$G(LEXTYPE) Q:"OP"'[LEXT
34 K XMZ S:LEXT="P" XMSUB="Lexicon Installation" S:LEXT="O" XMSUB="Lexicon/Problem List Survey"
35 S XMY(("G.LEXICON@"_LEXADR))=""
36 S XMTEXT="^TMP(""LEXMSG"",",XMDUZ=.5 D ^XMD
37 K ^TMP("LEXMSG"),XCNP,XMDUZ,XMY,XMZ,XMSUB,XMTEXT,XMDUZ,LEXT
38 S:$D(ZTQUEUED) ZTREQ="@"
39 Q
40TITLE N LEXS,LEXVERS S LEXS="Lexicon Installation"
41 S LEXVERS=$P($G(^DD(757.01,0,"VR")),"^",1)
42 S:+LEXVERS>1 LEXS=LEXS_" v"_LEXVERS D SET($G(LEXS)) Q
43VER ; Verify
44 I +($G(LEXQ))>0 D Q
45 . D BL S LEXS="Lexicon v 2.0 not completely installed"
46 . S LEXQ=1 D SET($G(LEXS))
47 D BL S LEXS="Lexicon v 2.0 installed" D SET($G(LEXS))
48 Q
49VR(LEXX) ; Version
50 S LEXX=$P($G(^DD(757.01,0,"VR")),"^",1) Q LEXX
51INIT ; Init/Install
52 N LEXS,LEXR,LEX1,LEX2,LEX4 I $L($T(+2^LEXLGM))>2 D
53 . S LEX1=$T(+2^LEXLGM)
54 . S LEX1=$P(LEX1,";",3),LEXR="^DD(",LEX4=1
55 . S LEX2="Lexicon Utility"
56 . D BL S LEXS=" Installing Version:" D SET($G(LEXS))
57 . S LEXS=" "_LEX1 D SET2($G(LEXS))
58 Q
59INST ; Installed on
60 N LEXS
61 I LEXDT'="" D Q
62 . S LEXS=" Installed on:" D SET($G(LEXS))
63 . S LEXS=" "_LEXDT D SET2($G(LEXS))
64 D:$L($G(LEXS)) SET($G(LEXS)) Q
65ATTPT ; Attempted install on
66 N LEXS I $G(LEXDT)'="" D
67 . S LEXS=" Installation Attempted on:" D SET($G(LEXS))
68 . S LEXS=LEXDT D SET2($G(LEXS))
69 Q
70ACCT ; Account
71 N LEXS,LEXA X ^%ZOSF("UCI") S LEXA=Y
72 S:Y=^%ZOSF("PROD") LEXA=LEXA_" (Production)"
73 S:Y'=^%ZOSF("PROD") LEXA=LEXA_" (Test)"
74 S LEXS=" Installation in account:" D SET($G(LEXS))
75 S LEXS=" "_LEXA D SET2($G(LEXS))
76 Q
77WHO ; Installed by
78 N LEXDUZ,LEXPH S LEXDUZ=+($G(DUZ)) I +LEXDUZ<1 S LEXDUZ="UNKNOWN",LEXPH="" G W2
79 I '$D(^VA(200,LEXDUZ)) S LEXDUZ="UNKNOWN",LEXPH="" G W2
80 S LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",2)
81 S:LEXPH="" LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",1)
82 S:LEXPH="" LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",3)
83 S:LEXPH="" LEXPH=$P($G(^VA(200,LEXDUZ,.13)),"^",4)
84 S LEXDUZ=$P(^VA(200,LEXDUZ,0),"^",1) S:LEXDUZ="" LEXDUZ="UNKNOWN"
85W2 S LEXS=" Installation by (POC):" D SET($G(LEXS))
86 S LEXS=" "_LEXDUZ S:LEXPH'="" LEXS=LEXS_" ("_LEXPH_")"
87 D SET2($G(LEXS))
88 Q
89BL ; Blank Line
90 D SET("") Q
91SET(X) ; Set text in ^TMP (col 1)
92 S X=$G(X) N LEXLC S LEXLC=+($G(^TMP("LEXMSG",0))),LEXLC=LEXLC+1
93 S ^TMP("LEXMSG",0)=LEXLC,^TMP("LEXMSG",LEXLC)=X
94 Q
95SET2(X) ; Set text in ^TMP (col 2)
96 S X=$G(X) N LEXL,LEXLC,LEX1 S LEXL=32
97 S LEXLC=+($G(^TMP("LEXMSG",0))),LEX1=$G(^TMP("LEXMSG",LEXLC))
98 F Q:$L(LEX1)=LEXL!($L(LEX1)>LEXL) S LEX1=LEX1_" "
99 S X=$$TRIM(X),^TMP("LEXMSG",LEXLC)=LEX1_" "_X
100 Q
101TRIM(X) ; Remove spaces from text
102 S X=$G(X) F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
103 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
104 Q X
105DATE ; Installation Date and Time
106 N %,%H,X,LEXP,LEXMO,LEXDA,LEXYR,LEXHR,LEXMN,LEXSC D NOW^%DTC Q:+($G(%))=0
107 N LEXP,LEXMO,LEXDA,LEXYR,LEXHR,LEXMN,LEXSC S LEXYR=1700+($E(%,1,3)),LEXP=+($E(%,4,5)),LEXDA=+($E(%,6,7)),LEXHR=$E($P(%,".",2),1,2),LEXMN=$E($P(%,".",2),3,4),LEXSC=$E($P(%,".",2),5,6)
108 S LEXMO=$S(+LEXP=1:"January",+LEXP=2:"February",+LEXP=3:"March",+LEXP=4:"April",+LEXP=5:"May",+LEXP=6:"June",+LEXP=7:"July",+LEXP=8:"August",+LEXP=9:"September",+LEXP=10:"October",+LEXP=11:"November",+LEXP=12:"December",1:"")
109 S:$L(LEXSC)=1 LEXSC=LEXSC_"0" I LEXMO'="" S LEXDT=LEXMO_" "_LEXDA_", "_LEXYR_" at "_LEXHR_":"_LEXMN_":"_LEXSC
110 Q
Note: See TracBrowser for help on using the repository browser.