1 | LEX2042P ; ISL/KER - Pre/Post Install ; 07/01/2006
|
---|
2 | ;;2.0;LEXICON UTILITY;**42**;Sep 23, 1996;Build 1
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 10086 HOME^%ZIS
|
---|
6 | ; DBIA 2052 $$GET1^DID
|
---|
7 | ; DBIA 2055 PRD^DILFD
|
---|
8 | ; DBIA 10014 EN^DIU2
|
---|
9 | ; DBIA 10141 BMES^XPDUTL
|
---|
10 | ; DBIA 10141 MES^XPDUTL
|
---|
11 | ;
|
---|
12 | Q
|
---|
13 | ;
|
---|
14 | POST ; LEX*2.0*42 Post-Install
|
---|
15 | N LEXEDT,LEXCHG,LEXSCHG,LEXMUMPS S LEXEDT=$G(^LEXM(0,"CREATED"))
|
---|
16 | S LEXCHG=0 S:$D(^LEXM(80))!($D(^LEXM(80.1)))!($D(^LEXM(81)))!($D(^LEXM(81.2)))!($D(^LEXM(81.3))) LEXCHG=1
|
---|
17 | ;
|
---|
18 | ;-----------------------------
|
---|
19 | ; Save Changes
|
---|
20 | D SCHG
|
---|
21 | ;
|
---|
22 | ;-----------------------------
|
---|
23 | ; Load Data into Files
|
---|
24 | D LOAD
|
---|
25 | ;
|
---|
26 | ;-----------------------------
|
---|
27 | ; Data Conversion
|
---|
28 | D CON
|
---|
29 | ;
|
---|
30 | ;-----------------------------
|
---|
31 | ; Re-Index Files - N/A for LEX*2.0*42
|
---|
32 | ; Do not use for Annual/Quarterly Updates, it disrupts the Protocol
|
---|
33 | ; D RX
|
---|
34 | ;
|
---|
35 | ;-----------------------------
|
---|
36 | ; Fire Protocol
|
---|
37 | D NOTIFY^LEXXGI
|
---|
38 | ;
|
---|
39 | ;-----------------------------
|
---|
40 | ; Send a Install Message
|
---|
41 | D MSG
|
---|
42 | ;
|
---|
43 | ;-----------------------------
|
---|
44 | ; Clean up and Quit
|
---|
45 | D KLEXM
|
---|
46 | Q
|
---|
47 | ;
|
---|
48 | LOAD ; Load Data from ^LEXM into IC*/LEX Files
|
---|
49 | N LEXB,LEXBUILD,LEXCD,LEXIGHF,LEXLAST,LEXLREV D IMP^LEX2042
|
---|
50 | S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:LEXBUILD=""
|
---|
51 | S LEXCD=0 S LEXCD=+($$CPD^LEX2042)
|
---|
52 | I LEXCD,LEXB=LEXBUILD D G LQ
|
---|
53 | . S X="Data for patch "_LEXBUILD_" has already been installed"
|
---|
54 | . W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X)
|
---|
55 | . S X="" W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(X)
|
---|
56 | D:'LEXCD&(LEXB=LEXBUILD) EN^LEXXGI
|
---|
57 | LQ ; Load Quit
|
---|
58 | D KLEXM
|
---|
59 | Q
|
---|
60 | ;
|
---|
61 | MSG ; Send Installation Message to G.LEXICON
|
---|
62 | Q:+($G(DUZ))=0!($$NOTDEF^LEX2042($G(DUZ)))
|
---|
63 | D HOME^%ZIS N DIFROM,LEXLREV,LEXLAST,LEXBUILD,LEXIGHF
|
---|
64 | D IMP^LEX2042,POST^LEXXFI Q
|
---|
65 | ;
|
---|
66 | SCHG ; Save Change File Changes
|
---|
67 | N LEXI,LEXFI,LEXFIL,LEXRT S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI=0 D
|
---|
68 | . S LEXI=0 F S LEXI=$O(^LEXM(LEXFI,LEXI)) Q:+LEXI=0 D
|
---|
69 | . . N LEXCF,LEXIEN,LEXMUMPS S LEXMUMPS=$G(^LEXM(LEXFI,LEXI)),LEXRT=$P(LEXMUMPS,"^",2)
|
---|
70 | . . S:LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(") LEXFIL=+($P(LEXRT,"(",2))
|
---|
71 | . . S:LEXMUMPS["^ICD9(" LEXFIL=80 S:LEXMUMPS["^ICD0(" LEXFIL=80.1 S:LEXMUMPS["^ICPT(" LEXFIL=81
|
---|
72 | . . S:LEXMUMPS["^DIC(81.3" LEXFIL=81.3 S:+LEXFIL>0 LEXSCHG(+LEXFIL,0)=""
|
---|
73 | Q
|
---|
74 | ;
|
---|
75 | KLEXM ; Subscripted Kill of ^LEXM
|
---|
76 | N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
|
---|
77 | K ^LEXM(0)
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | PRE ; LEX*2.0*42 Pre-Install (N/A for patch 42)
|
---|
81 | Q
|
---|
82 | ;
|
---|
83 | RX ; Reindex files (N/A for patch 42)
|
---|
84 | Q
|
---|
85 | N LEX,DA,DIK,TH,TM,TD
|
---|
86 | D BMES^XPDUTL(" Re-indexing NEW Versioned Text Cross-References")
|
---|
87 | ;
|
---|
88 | D BMES^XPDUTL(" ICD-9 Diagnosis file #80") W !," "
|
---|
89 | S (LEX,DA)=0 F S DA=$O(^ICD9(DA)) Q:+DA=0 K ^ICD9(DA,66,"B"),^ICD9(DA,67,"B"),^ICD9(DA,68,"B") S LEX=+($G(LEX))+1 W:LEX#120=0 "."
|
---|
90 | K ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT"),^ICD9("BA"),^ICD9("D"),^ICD9("AST"),^ICD9("ADS") S DIK="^ICD9(" D IXALL^DIK
|
---|
91 | ;
|
---|
92 | D MES^XPDUTL(" ICD-9 Operations/Procedure file #80.1") W !," "
|
---|
93 | S (LEX,DA)=0 F S DA=$O(^ICD0(DA)) Q:+DA=0 K ^ICD0(DA,66,"B"),^ICD0(DA,67,"B"),^ICD0(DA,68,"B") S LEX=+($G(LEX))+1 W:LEX#120=0 "."
|
---|
94 | K ^ICD0("AB"),^ICD0("ACT"),^ICD0("ADS"),^ICD0("AST"),^ICD0("BA"),^ICD0("D"),^ICD0("E") S DIK="^ICD0(" D IXALL^DIK
|
---|
95 | ;
|
---|
96 | D MES^XPDUTL(" DRG file #80.2") W !," "
|
---|
97 | S (LEX,DA)=0 F S DA=$O(^ICD(DA)) Q:+DA=0 K ^ICD(DA,1,"B"),^ICD(DA,66,"B"),^ICD(DA,68,"B") S LEX=+($G(LEX))+1 W:LEX#120=0 "."
|
---|
98 | K ^ICD("ADS"),^ICD("B") S DIK="^ICD(" D IXALL^DIK
|
---|
99 | ;
|
---|
100 | D MES^XPDUTL(" CPT/HCPCS Procedure/Services file #81") W !," "
|
---|
101 | S (LEX,DA)=0 F S DA=$O(^ICPT(DA)) Q:+DA=0 D
|
---|
102 | . K ^ICPT(DA,60,"B"),^ICPT(DA,61,"B"),^ICPT(DA,62,"B"),^ICPT(DA,"D","B") S LEX=+($G(LEX))+1 W:LEX#120=0 "."
|
---|
103 | K ^ICPT("ACT"),^ICPT("ADS"),^ICPT("AST"),^ICPT("B"),^ICPT("BA"),^ICPT("C"),^ICPT("D"),^ICPT("E"),^ICPT("F") S DIK="^ICPT(" D IXALL^DIK
|
---|
104 | ;
|
---|
105 | D MES^XPDUTL(" CPT Modifier file #81.3") W !," "
|
---|
106 | S (LEX,DA)=0 F S DA=$O(^DIC(81.3,DA)) Q:+DA=0 D
|
---|
107 | . K ^DIC(81.3,DA,60,"B"),^DIC(81.3,DA,61,"B"),^DIC(81.3,DA,62,"B") S LEX=+($G(LEX))+1 W:LEX#120=0 "."
|
---|
108 | K ^DIC(81.3,"ACT"),^DIC(81.3,"ADS"),^DIC(81.3,"AST"),^DIC(81.3,"B"),^DIC(81.3,"BA"),^DIC(81.3,"C"),^DIC(81.3,"D"),^DIC(81.3,"M") S DIK="^DIC(81.3," D IXALL^DIK
|
---|
109 | Q
|
---|
110 | ;
|
---|
111 | CON ; Conversion of data (N/A for patch 42)
|
---|
112 | Q
|
---|