source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2045P.m@ 789

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
[613]1LEX2045P ; ISL/KER - Pre/Post Install ; 09/13/2006
2 ;;2.0;LEXICON UTILITY;**45**;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 ;
14POST ; LEX*2.0*45 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*45
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 ;
48LOAD ; Load Data from ^LEXM into IC*/LEX Files
49 N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXSTR,LEXLAST D IMP^LEX2045
50 S LEXSTR=$G(LEXPTYPE) S:$L($G(LEXFY))&($L($G(LEXQTR))) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
51 S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:LEXBUILD=""
52 S LEXCD=0 S LEXCD=+($$CPD^LEX2045)
53 I LEXCD,LEXB=LEXBUILD D G LQ
54 . S X="Data for patch "_LEXBUILD_" has already been installed"
55 . W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X)
56 . S X="" W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(X)
57 D:'LEXCD&(LEXB=LEXBUILD) EN^LEXXGI
58LQ ; Load Quit
59 D KLEXM
60 Q
61 ;
62MSG ; Send Installation Message to G.LEXICON
63 Q:+($G(DUZ))=0!($$NOTDEF^LEX2045($G(DUZ)))
64 D HOME^%ZIS N DIFROM,LEXLAST,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
65 D IMP^LEX2045,POST^LEXXFI Q
66 ;
67SCHG ; Save Change File Changes
68 N LEXI,LEXFI,LEXFIL,LEXRT S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI=0 D
69 . S LEXI=0 F S LEXI=$O(^LEXM(LEXFI,LEXI)) Q:+LEXI=0 D
70 . . N LEXCF,LEXIEN,LEXMUMPS S LEXMUMPS=$G(^LEXM(LEXFI,LEXI)),LEXRT=$P(LEXMUMPS,"^",2)
71 . . S:LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(") LEXFIL=+($P(LEXRT,"(",2))
72 . . S:LEXMUMPS["^ICD9(" LEXFIL=80 S:LEXMUMPS["^ICD0(" LEXFIL=80.1 S:LEXMUMPS["^ICPT(" LEXFIL=81
73 . . S:LEXMUMPS["^DIC(81.3" LEXFIL=81.3 S:+LEXFIL>0 LEXSCHG(+LEXFIL,0)=""
74 Q
75 ;
76KLEXM ; Subscripted Kill of ^LEXM
77 N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
78 K ^LEXM(0)
79 Q
80 ;
81PRE ; LEX*2.0*45 Pre-Install
82 ; Delete IENS entered in error
83 N DA,DIK S DIK="^ICD9(",DA=14245 D ^DIK S DA=14246 D ^DIK
84 Q
85 ;
86RX ; Reindex files (N/A for patch 45)
87 Q
88 N LEX,DA,DIK,TH,TM,TD
89 D BMES^XPDUTL(" Re-indexing NEW Versioned Text Cross-References")
90 ;
91 D BMES^XPDUTL(" ICD-9 Diagnosis file #80") W !," "
92 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 "."
93 K ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT"),^ICD9("BA"),^ICD9("D"),^ICD9("AST"),^ICD9("ADS") S DIK="^ICD9(" D IXALL^DIK
94 ;
95 D MES^XPDUTL(" ICD-9 Operations/Procedure file #80.1") W !," "
96 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 "."
97 K ^ICD0("AB"),^ICD0("ACT"),^ICD0("ADS"),^ICD0("AST"),^ICD0("BA"),^ICD0("D"),^ICD0("E") S DIK="^ICD0(" D IXALL^DIK
98 ;
99 D MES^XPDUTL(" DRG file #80.2") W !," "
100 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 "."
101 K ^ICD("ADS"),^ICD("B") S DIK="^ICD(" D IXALL^DIK
102 ;
103 D MES^XPDUTL(" CPT/HCPCS Procedure/Services file #81") W !," "
104 S (LEX,DA)=0 F S DA=$O(^ICPT(DA)) Q:+DA=0 D
105 . 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 "."
106 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
107 ;
108 D MES^XPDUTL(" CPT Modifier file #81.3") W !," "
109 S (LEX,DA)=0 F S DA=$O(^DIC(81.3,DA)) Q:+DA=0 D
110 . 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 "."
111 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
112 Q
113 ;
114CON ; Conversion of data (N/A for patch 45)
115 Q
Note: See TracBrowser for help on using the repository browser.