source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEX2031P.m@ 1801

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1LEX2031P ;ISA/FJF-Pre/Post Install; 10/01/2004
2 ;;2.0;LEXICON UTILITY;**31**;Sep 23, 1996
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*31 Post-Install
15 N LEXEDT,LEXCHG,LEXSCHG 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 ; Save Changes
18 D SCHG
19 ; Load Data into Files
20 D LOAD
21 ; Data Conversion
22 D CON
23 ; Re-Index Files
24 ; Not used for Annual/Quarterly Updates
25 ; It disrupts the Protocol
26 ; D RX
27 ; Notify Applications that a Change has occurred
28 D NOTIFY^LEXXGI
29 ; Send a Install Message
30 D MSG
31 ; Clean up and Quit
32 D KLEXM
33 Q
34 ;
35LOAD ; Load Data from ^LEXM into IC*/LEX Files
36 N LEXB,LEXBUILD,LEXCD,LEXIGHF,LEXLAST,LEXLREV D IMP^LEX2031
37 S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:LEXBUILD=""
38 S LEXCD=0 S LEXCD=+($$CPD^LEX2031)
39 I LEXCD,LEXB=LEXBUILD D G LQ
40 . S X="Data for patch "_LEXBUILD_" has already been installed"
41 . W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X)
42 . S X="" W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(X)
43 D:'LEXCD&(LEXB=LEXBUILD) EN^LEXXGI
44LQ ; Load Quit
45 D KLEXM
46 Q
47 ;
48MSG ; Send Installation Message to G.LEXICON
49 Q:+($G(DUZ))=0!($$NOTDEF^LEX2031($G(DUZ)))
50 D HOME^%ZIS N DIFROM,LEXLREV,LEXLAST,LEXBUILD,LEXIGHF
51 D IMP^LEX2031,SEND^LEXXST Q
52 ;
53SCHG ; Save Change File Changes
54 D MES^XPDUTL(" Updating Change File")
55 N LEXI,LEXFI,LEXFIL S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI=0 D
56 . S LEXI=0 F S LEXI=$O(^LEXM(LEXFI,LEXI)) Q:+LEXI=0 D
57 . . N LEXCF,LEXIEN S LEXMUMPS=$G(^LEXM(LEXFI,LEXI)),LEXRT=$P(LEXMUMPS,"^",2)
58 . . S:LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(")!(LEXMUMPS["^LEXC(") LEXFIL=+($P(LEXRT,"(",2))
59 . . S:LEXMUMPS["^ICD9(" LEXFIL=80 S:LEXMUMPS["^ICD0(" LEXFIL=80.1 S:LEXMUMPS["^ICPT(" LEXFIL=81 S:LEXMUMPS["^DIC(81.3" LEXFIL=81.3
60 . . S:+LEXFIL>0 LEXSCHG(+LEXFIL,0)="" S LEXCF=+($P(LEXMUMPS,"LEXC(757.9,""AFIL"",",2))
61 . . S:$P(LEXCF,".",1)'="757"&("^80^80.1^81^81.3^"'[("^"_LEXCF_"^")) LEXCF=""
62 . . S LEXIEN=+($P(LEXMUMPS,("LEXC(757.9,""AFIL"","_+LEXCF_","),2))
63 . . I +LEXIEN>0&(+LEXCF)>0&("^80^80.1^81^81.3)"[LEXCF)&(+LEXFIL=757.9)&(LEXMUMPS["LEXC(757.9") D
64 . . . S LEXSCHG(+LEXFIL,LEXIEN)=LEXCF,LEXSCHG(757.9,"B",+LEXCF,LEXIEN)=""
65 . . S:$L(LEXMUMPS)&($L(LEXCF)) LEXCHGS(LEXCF)=""
66 Q
67 ;
68KLEXM ; Subscripted Kill of ^LEXM
69 N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
70 K ^LEXM(0)
71 Q
72 ;
73PRE ; LEX*2.0*31 Pre-Install (N/A for patch 31)
74 Q
75 ;
76RX ; Reindex files 80, 80.1, 80.2, 81 and 81.3
77 N LEX,DA,DIK,TH,TM,TD
78 D BMES^XPDUTL(" Re-indexing NEW Versioned Text Cross-References")
79 ;
80 D BMES^XPDUTL(" ICD-9 Diagnosis file #80") W !," "
81 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 "."
82 K ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT"),^ICD9("BA"),^ICD9("D"),^ICD9("AST"),^ICD9("ADS") S DIK="^ICD9(" D IXALL^DIK
83 ;
84 D MES^XPDUTL(" ICD-9 Operations/Procedure file #80.1") W !," "
85 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 "."
86 K ^ICD0("AB"),^ICD0("ACT"),^ICD0("ADS"),^ICD0("AST"),^ICD0("BA"),^ICD0("D"),^ICD0("E") S DIK="^ICD0(" D IXALL^DIK
87 ;
88 D MES^XPDUTL(" DRG file #80.2") W !," "
89 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 "."
90 K ^ICD("ADS"),^ICD("B") S DIK="^ICD(" D IXALL^DIK
91 ;
92 D MES^XPDUTL(" CPT/HCPCS Procedure/Services file #81") W !," "
93 S (LEX,DA)=0 F S DA=$O(^ICPT(DA)) Q:+DA=0 D
94 . 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 "."
95 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
96 ;
97 D MES^XPDUTL(" CPT Modifier file #81.3") W !," "
98 S (LEX,DA)=0 F S DA=$O(^DIC(81.3,DA)) Q:+DA=0 D
99 . 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 "."
100 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
101 Q
102 ;
103CON ; Conversion of data (for patch 31 only)
104 D BMES^XPDUTL(" Checking File 80/80.1 Input Transformations")
105 D AGE,SEX
106 D MES^XPDUTL(" ")
107 Q
108SEX ; Sex Field
109 N LEXIEN,LEXSEX S LEXIEN=0 F S LEXIEN=$O(^ICD0(LEXIEN)) Q:+LEXIEN=0 D
110 . S LEXSEX=$P($G(^ICD0(LEXIEN,0)),"^",10) Q:LEXSEX'="T047" S $P(^ICD0(LEXIEN,0),"^",10)=""
111 Q
112AGE ; Age High Field
113 N LEXIEN,LEXAGE S LEXIEN=0 F S LEXIEN=$O(^ICD9(LEXIEN)) Q:+LEXIEN=0 D
114 . S LEXAGE=$P($G(^ICD9(LEXIEN,0)),"^",15) Q:+LEXAGE'=124 S $P(^ICD9(LEXIEN,0),"^",15)="99"
115 Q
Note: See TracBrowser for help on using the repository browser.