source: FOIAVistA/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXGI.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1LEXXGI ;ISL/KER/FJF - Global Import (Needs ^LEXM) ;04/22/2008
2 ;;2.0;LEXICON UTILITY;**4,25,26,27,28,29,46,49,50,41**;Sep 23, 1996;Build 34
3 ;
4 ; NEWed by Lexicon Environment Check routine LEX20nn
5 ; LEXBUILD
6 ; LEXFY
7 ; LEXIGHF
8 ; LEXLREV
9 ; LEXPTYPE
10 ; LEXQTR
11 ; LEXREQP
12 ;
13 ; NEWed by KIDS during the Install of a patch/build
14 ; XPDNM
15 ;
16 ; Global Variables
17 ; ^LEXM
18 ;
19 ; External References
20 ; DBIA 10086 HOME^%ZIS
21 ; DBIA 10016 ^DIM
22 ; DBIA 2056 $$GET1^DIQ (file 200)
23 ; DBIA 10103 $$DT^XLFDT
24 ; DBIA 10103 $$FMTE^XLFDT
25 ; DBIA 10141 BMES^XPDUTL
26 ; DBIA 10141 MES^XPDUTL
27 ;
28EN ; Main Entry Point for Installing LEXM in Post-Installs
29 ;
30 ; Requires
31 ;
32 ; LEXBUILD - the name of the patch/build being installed
33 ;
34 ; Uses
35 ;
36 ; LEXMSG - If this variable exist, then an install message
37 ; message will be set to G.LEXICON
38 ;
39 ; LEXSHORT - If this variable exist, the install message
40 ; will be an abbreviated message, without the
41 ; file totals and checksums
42 ;
43 ; Abbreviated Install Message
44 ;
45 ; Date and Time Installed
46 ; Account where the Data was Installed
47 ; Who Installed the Data
48 ; The Name of the Build Installed
49 ; The Name of the Global Host File
50 ; Protocol Invoked
51 ; Date and time Protocol was Invoked
52 ; Install Start Date/Time
53 ; Install Complete Date/Time
54 ; Install Elapsed Time
55 ;
56 ; Long Install Message
57 ;
58 ; All of the elements above plus:
59 ;
60 ; File Versions/Revisions
61 ; File Checksums
62 ; File Record Counts
63 ;
64 ; LEXPTYPE - Patch Type
65 ; LEXLREV - Revision
66 ; LEXREQP - Required Patches/Builds
67 ; LEXIGHF - The patch Export Global Host Filename
68 ; LEXFY - Fiscal Year
69 ; LEXQTR - Quarter
70 ; LEXCRE - Import Global Creation Date
71 ;
72 D IMPORT D KALL^LEXXGI2
73 Q
74TASK ; Queue Lexicon Update with Taskman
75 N Y,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,ZTSAVE,ZTQUEUED
76 S:$D(LEXBUILD) ZTSAVE("LEXBUILD")=""
77 S:$D(LEXMSG) ZTSAVE("LEXMSG")=""
78 S:$D(LEXSHORT) ZTSAVE("LEXSHORT")=""
79 S:$D(LEXPTYPE) ZTSAVE("LEXPTYPE")=""
80 S:$D(LEXLREV) ZTSAVE("LEXLREV")=""
81 S:$D(LEXREQP) ZTSAVE("LEXREQP")=""
82 S:$D(LEXIGHF) ZTSAVE("LEXIGHF")=""
83 S:$D(LEXFY) ZTSAVE("LEXFY")=""
84 S:$D(LEXQTR) ZTSAVE("LEXQTR")=""
85 S:$D(LEXCRE) ZTSAVE("LEXCRE")=""
86 S ZTRTN="EN^LEXXGI",ZTDESC="Importing Updated Lexicon Data"
87 S ZTIO="",ZTDTH=$H
88 D ^%ZTLOAD,HOME^%ZIS
89 Q
90IMPORT ; Import Data during a Patch Installation
91 S:$D(ZTQUEUED) ZTREQ="@"
92 S:$L($G(LEXPTYPE)) LEXPTYPE=$G(LEXPTYPE) S:$L($G(LEXLREV)) LEXLREV=$G(LEXLREV) S:$L($G(LEXREQP)) LEXREQP=$G(LEXREQP)
93 S:$L($G(LEXBUILD)) LEXBUILD=$G(LEXBUILD) S:$L($G(LEXIGHF)) LEXIGHF=$G(LEXIGHF) S:$L($G(LEXFY)) LEXFY=$G(LEXFY)
94 S:$L($G(LEXQTR)) LEXQTR=$G(LEXQTR) K LEXSCHG,LEXCHG
95 N LEXB,LEXCD,LEXSTR,LEXLAST,%,%DT,C,D,D0,D1,D2,DG,DIC,DICR,DILOCKTM,DIW,IREC,J,XMDUN,XMZ,ZTSK
96 S U="^",LEXSTR=$G(LEXPTYPE),LEXB=$G(^LEXM(0,"BUILD"))
97 S:$L($G(LEXFY))&($L($G(LEXQTR)))&($L(LEXSTR)) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
98 S:$L(LEXB) LEXBLD=LEXB S:'$L(LEXBLD)&($L(LEXBUILD)) LEXBLD=LEXBUILD
99 I '$L(LEXB)!(LEXB'=LEXBUILD) D
100 . N X,LEXBLD I '$L(LEXB) D Q
101 . . S X=" Invalid export global, aborting data install" W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
102 . I '$L(LEXBUILD) D Q
103 . . S X=" Undefined KIDS Build, aborting data install" W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
104 I $L(LEXB)&(LEXB=LEXBUILD) D
105 . N LEXFI,LEXID S X="Installing Data for patch "_LEXB W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X) W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(" ")
106 . K LEXSCHG S LEXCHG=0,LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI'>0 D
107 . . S LEXID=$S(LEXFI=80!(LEXFI=80.1):"ICD",LEXFI=81!(LEXFI=81.1)!(LEXFI=81.2)!(LEXFI=81.3):"CPT",$P(LEXFI,".",1)=757:"LEX",1:"UNK")
108 . . S LEXSCHG(LEXFI,0)=+($G(^LEXM(LEXFI,0))),LEXSCHG("B",LEXFI)="" S LEXSCHG("C",LEXID,LEXFI)=""
109 . S:$D(LEXSCHG("C","CPT"))!($D(LEXSCHG("C","ICD"))) LEXSCHG("D","PRO")="",LEXCHG=1,LEXSCHG(0)=1
110 . D LOAD,NOTIFY^LEXXGI2 I +($G(DUZ))>0,$L($$GET1^DIQ(200,(+($G(DUZ))_","),.01)) D
111 . . D HOME^%ZIS N DIFROM,LEXPRO,LEXPRON,LEXLAST S LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO")) D:$D(LEXMSG) POST^LEXXFI
112 Q
113LOAD ; Load Data from ^LEXM into IC*/LEX Files
114 Q:'$L($G(LEXB)) S:$D(ZTQUEUED) ZTREQ="@"
115 N LEXBEG,LEXELP,LEXEND,LEXMSG,LEXOK,LEXFL
116 D:'$D(^LEXM) NF^LEXXGI2 Q:'$D(^LEXM)
117 S LEXOK=0 S:$O(^LEXM(0))>0 LEXOK=1 D:'LEXOK IG^LEXXGI2 Q:'LEXOK
118 S LEXBEG=$$HACK^LEXXGI2 D FILES S LEXEND=$$HACK^LEXXGI2,LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND)
119 S:LEXELP="" LEXELP="00:00:00"
120 D PB^LEXXGI2(" Data Updated ")
121 D PB^LEXXGI2((" Started: "_$TR($$FMTE^XLFDT(LEXBEG),"@"," ")))
122 D TL^LEXXGI2((" Finished: "_$TR($$FMTE^XLFDT(LEXEND),"@"," ")))
123 D TL^LEXXGI2((" Elapsed: "_LEXELP))
124 Q
125FILES ; Load Data for all files
126 Q:'$L($G(LEXB)) N LEXHDR,LEXBLD,LEXDAT,LEXFI,LEXFIC,LEXHDRS,LEXLOG,LEXINS
127 S (LEXFI,LEXFIC)=0,LEXHDR=0,LEXBLD=LEXB
128 S LEXDAT=$P($G(^LEXM(0,"VRRVDT")),"^",1),LEXINS=1
129 S:+LEXDAT'>0 LEXDAT=$$DT^XLFDT I LEXOK D
130 . N LEXCRE,LEXL1 S LEXL1="" S LEXCRE=$G(^LEXM(0,"CREATED")) S LEXCRE=$S(+LEXCRE>0:($$MIX^LEXXGI2($$FMTE^XLFDT(LEXCRE))),1:"")
131 . S:$L($P(LEXCRE,"@",2)) LEXCRE=$P(LEXCRE,"@",1)_" at "_$P(LEXCRE,"@",2) S LEXL1=" Updating files "
132 . S:$L($G(LEXCRE))&($L($G(LEXL1))) LEXL1=$G(LEXL1)_"using export global created "_$G(LEXCRE)
133 . D PB^LEXXGI2(LEXL1)
134 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI=0 D FILE
135 Q
136FILE ; Load Data for one file
137 N LEXCF,LEXCHG,LEXCHGS,LEXCNT,LEXFIL,LEXI,LEXID,LEXIEN,LEXL,LEXLC
138 N LEXMUMPS,LEXNM,LEXRT,LEXS,LEXTOT,LEXTXT,LEXIGL,LEXIGI,LEXIGF,LEXIGT
139 N LEXIGD,LEXIGO,LEXBEG,LEXEND,LEXELP,LEXFB
140 S LEXFB=$G(^LEXM(+LEXFI,0,"BUILD")),LEXIGO=0,LEXBEG=$$HACK^LEXXGI2
141 S (LEXCNT,LEXLC,LEXI)=0,LEXL=68,LEXFIC=LEXFIC+1 I LEXOK D
142 . N LEXB,LEXFID,LEXNM,LEXVR,LEXRV,LEXDT,LEXL1,LEXL2 S (LEXL1,LEXL2)="",LEXFID=$P(LEXFI,".",1)
143 . Q:+LEXFID'>0 Q:$D(LEXHDRS(+LEXFID)) S LEXHDRS(LEXFID)="" S:+LEXFI=81!(+LEXFI=81.3) LEXHDRS(81)="",LEXHDRS(81.3)=""
144 . S:LEXFID=80 LEXNM="ICD-9-CM" S:LEXFID=81 LEXNM="CPT-4/HCPCS" S:LEXFID=757 LEXNM="Lexicon" S LEXB=$G(^LEXM(LEXFI,0,"BUILD"))
145 . S LEXVR=$G(^LEXM(LEXFI,0,"VR")),LEXRV=$G(^LEXM(LEXFI,0,"VRRV")),LEXDT=$$MIX^LEXXGI2($$FMTE^XLFDT($P(LEXRV,"^",2))),LEXRV=$P(LEXRV,"^",1)
146 . S LEXL1="Updating "_LEXNM S:$L(LEXB) LEXL1=LEXL1_" with patch/build "_LEXB S:$L(LEXVR) LEXL2=" To version "_LEXVR
147 . S:$L(LEXVR)&($L(LEXRV)) LEXL2=LEXL2_" revision "_LEXRV S:$L(LEXVR)&($L(LEXRV))&($L(LEXDT)) LEXL2=LEXL2_" dated "_LEXDT
148 . S:$L(LEXL1) LEXL1=" "_LEXL1 S:$L(LEXL2) LEXL2=" "_LEXL2 D BL^LEXXGI2 D:$L(LEXL1) TL^LEXXGI2(LEXL1) D:$L(LEXL2) TL^LEXXGI2(LEXL2),BL^LEXXGI2
149 S LEXTOT=+($G(^LEXM(LEXFI,0))) G:LEXTOT=0 FILEQ
150 S LEXNM=$G(^LEXM(LEXFI,0,"NM"))
151 I $L(LEXNM),$$UP^LEXXGI2(LEXNM)'["FILE" S LEXNM=LEXNM_" FILE"
152 S:$L(LEXNM) LEXNM=$$MIX^LEXXGI2(LEXNM) S LEXCHG=$G(^LEXM(LEXFI,0))
153 S LEXTXT=" "_LEXNM,LEXTXT=LEXTXT_$J("",(40-$L(LEXTXT)))_LEXFI
154 D:LEXFIC=1 PB^LEXXGI2(LEXTXT) D:LEXFIC'=1 TL^LEXXGI2(LEXTXT)
155 S LEXS=+(LEXTOT\LEXL) S:LEXS=0 LEXS=1 W:+($O(^LEXM(LEXFI,0)))>0 !," "
156 D UPCHG^LEXXGI2 F S LEXI=$O(^LEXM(LEXFI,LEXI)) Q:+LEXI=0 D
157 . S LEXCNT=LEXCNT+1,LEXMUMPS=$G(^LEXM(LEXFI,LEXI))
158 . I LEXCNT'<LEXS S LEXLC=LEXLC+1 W:LEXLC'>LEXL "." S LEXCNT=0
159 . S LEXRT=$P(LEXMUMPS,"^",2),LEXFIL=""
160 . S:LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(")!(LEXMUMPS["^LEXC(") LEXFIL=+($P(LEXRT,"(",2)),LEXFL(+($P(LEXRT,"(",2)))=""
161 . S:LEXMUMPS["^ICD9(" LEXFIL=80,LEXFL(80)=""
162 . S:LEXMUMPS["^ICD0(" LEXFIL=80.1,LEXFL(80.1)=""
163 . S:LEXMUMPS["^ICPT(" LEXFIL=81,LEXFL(81)=""
164 . S:LEXMUMPS["^DIC(81.3" LEXFIL=81.3,LEXFL(81.3)=""
165 . S:LEXMUMPS["^DIC(81.2" LEXFIL=81.2,LEXFL(81.2)=""
166 . S:LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(")!(LEXMUMPS["^LEXC(") LEXFIL=+($P(LEXRT,"(",2))
167 . S:LEXMUMPS["^ICD9(" LEXFIL=80 S:LEXMUMPS["^ICD0(" LEXFIL=80.1
168 . S:LEXMUMPS["^ICPT(" LEXFIL=81 S:LEXMUMPS["^DIC(81.3" LEXFIL=81.3
169 . S:+LEXFIL>0 LEXSCHG(+LEXFIL,0)=""
170 . I $L(LEXMUMPS) D
171 . . N X S X=LEXMUMPS D ^DIM Q:'$D(X) X LEXMUMPS S LEXIGO=1
172 I +($G(LEXIGO))>0 D
173 . S LEXEND=$$HACK^LEXXGI2 S LEXELP=$$ELAP^LEXXGI2(LEXBEG,LEXEND) S:LEXELP="" LEXELP="00:00:00"
174FILEQ ; Load Data for one file - QUIT
175 K ^LEXM(+LEXFI)
176 Q
177 ;
178NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
179 D NOTIFY^LEXXGI2,KALL^LEXXGI2
180 Q
181SCHG ; Save Change File Changes (for NOTIFY)
182 N FI,ID K LEXSCHG S LEXCHG=0
183 N FI S FI=0 F S FI=$O(^LEXM(FI)) Q:+FI'>0 D
184 . S ID=$S(FI=80!(FI=80.1):"ICD",FI=81!(FI=81.1)!(FI=81.2)!(FI=81.3):"CPT",$P(FI,".",1)=757:"LEX",1:"UNK")
185 . S LEXSCHG(FI,0)=+($G(^LEXM(FI,0))),LEXSCHG("B",FI)="" S LEXSCHG("C",ID,FI)=""
186 S:$D(LEXSCHG("C","CPT"))!($D(LEXSCHG("C","ICD"))) LEXSCHG("D","PRO")=""
187 S:$D(^LEXM(80))!($D(^LEXM(80.1)))!($D(^LEXM(81)))!($D(^LEXM(81.2)))!($D(^LEXM(81.3)))!($D(LEXSCHG("D","PRO"))) LEXCHG=1,LEXSCHG(0)=1
188 Q
189ZTQ ; Taskman Quit
190 K ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
191 Q
192CHECKSUM ; Check ^LEXM Checksum
193 D CS^LEXXGI2
194 Q
Note: See TracBrowser for help on using the repository browser.