[628] | 1 | LEX2048P ; CIO ISL - LEX*2.0*48 Pre/Post Install ; 04/01/2007
|
---|
| 2 | ;;2.0;LEXICON UTILITY;**48**;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 | ;
|
---|
| 14 | POST ; LEX*2.0*48 Post-Install
|
---|
| 15 | N LEXEDT,LEXCHG,LEXSCHG,LEXMUMPS,LEXSHORT S LEXEDT=$G(^LEXM(0,"CREATED")),LEXSHORT=""
|
---|
| 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*48
|
---|
| 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 LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXSTR,LEXLAST D IMP^LEX2048
|
---|
| 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^LEX2048)
|
---|
| 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
|
---|
| 58 | LQ ; Load Quit
|
---|
| 59 | D KLEXM
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | MSG ; Send Installation Message to G.LEXICON
|
---|
| 63 | Q:+($G(DUZ))=0!($$NOTDEF^LEX2048($G(DUZ)))
|
---|
| 64 | D HOME^%ZIS N DIFROM,LEXPRO,LEXPRON,LEXLAST,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXSHORT
|
---|
| 65 | S LEXSHORT="" D IMP^LEX2048,POST^LEXXFI Q
|
---|
| 66 | ;
|
---|
| 67 | SCHG ; Save Change File Changes
|
---|
| 68 | N NN,NC,ND K LEXSCHG(0) S LEXCHG=0 S NN="^LEXM",NC="^LEXM(" F S NN=$Q(@NN) Q:'$L(NN)!(NN'[NC) D
|
---|
| 69 | . S ND=$G(@NN) I NN["LEXM(80,"&(+($P(NN,",",2))>1)!(NN["LEXM(80.1,"&(+($P(NN,",",2))>1)) D
|
---|
| 70 | . . S:ND["S ^ICD9("!(ND["K ^ICD9(") LEXSCHG(80,0)=+($G(^LEXM(80,0))),LEXSCHG("B",80)="",LEXSCHG(757.9,"B",80)="",LEXSCHG("C","ICD",80)="",LEXSCHG("D","PRO")=""
|
---|
| 71 | . . S:ND["S ^ICD0("!(ND["K ^ICD0(") LEXSCHG(80.1,0)=+($G(^LEXM(80.1,0))),LEXSCHG("B",80.1)="",LEXSCHG(757.9,"B",80.1)="",LEXSCHG("C","ICD",80.1)="",LEXSCHG("D","PRO")=""
|
---|
| 72 | . I NN["LEXM(81,"&(+($P(NN,",",2))>1)!(NN["LEXM(81.3,"&(+($P(NN,",",2))>1)) D
|
---|
| 73 | . . S:ND["S ^ICPT("!(ND["K ^ICPT(") LEXSCHG(81,0)=+($G(^LEXM(81,0))),LEXSCHG("B",81)="",LEXSCHG(757.9,"B",81)="",LEXSCHG("C","CPT",81)="",LEXSCHG("D","PRO")=""
|
---|
| 74 | . . S:ND["S ^DIC(81.3,"!(ND["K ^DIC(81.3,") LEXSCHG(81.3,0)=+($G(^LEXM(81.3,0))),LEXSCHG("B",81.3)="",LEXSCHG(757.9,"B",81.3)="",LEXSCHG("C","CPT",81.3)="",LEXSCHG("D","PRO")=""
|
---|
| 75 | . I NN["LEXM(81.2," D
|
---|
| 76 | . . S:ND["S ^DIC(81.2,"!(ND["K ^DIC(81.2,") LEXSCHG(81.2,0)=+($G(^LEXM(81.2,0))),LEXSCHG("B",81.2)="",LEXSCHG(757.9,"B",81,2)="",LEXSCHG("C","CPT",81.2)=""
|
---|
| 77 | . I NN["LEXM(757,"&(+($P(NN,",",2))>1)!(NN["LEXM(757."&(+($P(NN,",",2))>1)) D
|
---|
| 78 | . . N FI S FI=+($P(NN,"(",2))
|
---|
| 79 | . . S:ND["S ^LEX("!(ND["K ^LEX(") LEXSCHG(FI,0)=+($G(^LEXM(+FI,0))),LEXSCHG("B",FI)="",LEXSCHG("C","LEX",FI)="",LEXSCHG("D","PRO")=""
|
---|
| 80 | . . S:ND["S ^LEXT("!(ND["K ^LEXT(") LEXSCHG(FI,0)=+($G(^LEXM(+FI,0))),LEXSCHG("B",FI)="",LEXSCHG("C","LEX",FI)="",LEXSCHG("D","PRO")=""
|
---|
| 81 | 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
|
---|
| 82 | Q
|
---|
| 83 | ;
|
---|
| 84 | KLEXM ; Subscripted Kill of ^LEXM
|
---|
| 85 | N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
|
---|
| 86 | N LEX S LEX=$G(^LEXM(0,"PRO")) K ^LEXM(0)
|
---|
| 87 | ;S:$L(LEX) ^LEXM(0,"PRO")=LEX
|
---|
| 88 | Q
|
---|
| 89 | ;
|
---|
| 90 | PRE ; LEX*2.0*48 Pre-Install (N/A for patch 48)
|
---|
| 91 | Q
|
---|
| 92 | ;
|
---|
| 93 | RX ; Reindex files (N/A for patch 48)
|
---|
| 94 | Q
|
---|
| 95 | N LEX,DA,DIK,TH,TM,TD
|
---|
| 96 | D BMES^XPDUTL(" Re-indexing NEW Versioned Text Cross-References")
|
---|
| 97 | ;
|
---|
| 98 | D BMES^XPDUTL(" ICD-9 Diagnosis file #80") W !," "
|
---|
| 99 | 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 "."
|
---|
| 100 | K ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT"),^ICD9("BA"),^ICD9("D"),^ICD9("AST"),^ICD9("ADS") S DIK="^ICD9(" D IXALL^DIK
|
---|
| 101 | ;
|
---|
| 102 | D MES^XPDUTL(" ICD-9 Operations/Procedure file #80.1") W !," "
|
---|
| 103 | 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 "."
|
---|
| 104 | K ^ICD0("AB"),^ICD0("ACT"),^ICD0("ADS"),^ICD0("AST"),^ICD0("BA"),^ICD0("D"),^ICD0("E") S DIK="^ICD0(" D IXALL^DIK
|
---|
| 105 | ;
|
---|
| 106 | D MES^XPDUTL(" DRG file #80.2") W !," "
|
---|
| 107 | 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 "."
|
---|
| 108 | K ^ICD("ADS"),^ICD("B") S DIK="^ICD(" D IXALL^DIK
|
---|
| 109 | ;
|
---|
| 110 | D MES^XPDUTL(" CPT/HCPCS Procedure/Services file #81") W !," "
|
---|
| 111 | S (LEX,DA)=0 F S DA=$O(^ICPT(DA)) Q:+DA=0 D
|
---|
| 112 | . 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 "."
|
---|
| 113 | 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
|
---|
| 114 | ;
|
---|
| 115 | D MES^XPDUTL(" CPT Modifier file #81.3") W !," "
|
---|
| 116 | S (LEX,DA)=0 F S DA=$O(^DIC(81.3,DA)) Q:+DA=0 D
|
---|
| 117 | . 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 "."
|
---|
| 118 | 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
|
---|
| 119 | Q
|
---|
| 120 | ;
|
---|
| 121 | CON ; Conversion of data (N/A for patch 48)
|
---|
| 122 | Q
|
---|