LEX2048P ; CIO ISL - LEX*2.0*48 Pre/Post Install ; 04/01/2007
;;2.0;LEXICON UTILITY;**48**;Sep 23, 1996
;
; External References
; DBIA 10086 HOME^%ZIS
; DBIA 2052 $$GET1^DID
; DBIA 2055 PRD^DILFD
; DBIA 10014 EN^DIU2
; DBIA 10141 BMES^XPDUTL
; DBIA 10141 MES^XPDUTL
;
Q
;
POST ; LEX*2.0*48 Post-Install
N LEXEDT,LEXCHG,LEXSCHG,LEXMUMPS,LEXSHORT S LEXEDT=$G(^LEXM(0,"CREATED")),LEXSHORT=""
S LEXCHG=0 S:$D(^LEXM(80))!($D(^LEXM(80.1)))!($D(^LEXM(81)))!($D(^LEXM(81.2)))!($D(^LEXM(81.3))) LEXCHG=1
;
;-----------------------------
; Save Changes
D SCHG
;
;-----------------------------
; Load Data into Files
D LOAD
;
;-----------------------------
; Data Conversion
D CON
;
;-----------------------------
; Re-Index Files - N/A for LEX*2.0*48
; Do not use for Annual/Quarterly Updates, it disrupts the Protocol
; D RX
;
;-----------------------------
; Fire Protocol
D NOTIFY^LEXXGI
;
;-----------------------------
; Send a Install Message
D MSG
;
;-----------------------------
; Clean up and Quit
D KLEXM
Q
;
LOAD ; Load Data from ^LEXM into IC*/LEX Files
N LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXSTR,LEXLAST D IMP^LEX2048
S LEXSTR=$G(LEXPTYPE) S:$L($G(LEXFY))&($L($G(LEXQTR))) LEXSTR=LEXSTR_" for "_$G(LEXFY)_" "_$G(LEXQTR)_" Quarter"
S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:LEXBUILD=""
S LEXCD=0 S LEXCD=+($$CPD^LEX2048)
I LEXCD,LEXB=LEXBUILD D G LQ
. S X="Data for patch "_LEXBUILD_" has already been installed"
. W:'$D(XPDNM) !!,X D:$D(XPDNM) BMES^XPDUTL(X)
. S X="" W:'$D(XPDNM) ! D:$D(XPDNM) MES^XPDUTL(X)
D:'LEXCD&(LEXB=LEXBUILD) EN^LEXXGI
LQ ; Load Quit
D KLEXM
Q
;
MSG ; Send Installation Message to G.LEXICON
Q:+($G(DUZ))=0!($$NOTDEF^LEX2048($G(DUZ)))
D HOME^%ZIS N DIFROM,LEXPRO,LEXPRON,LEXLAST,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXSHORT
S LEXSHORT="" D IMP^LEX2048,POST^LEXXFI Q
;
SCHG ; Save Change File Changes
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
. S ND=$G(@NN) I NN["LEXM(80,"&(+($P(NN,",",2))>1)!(NN["LEXM(80.1,"&(+($P(NN,",",2))>1)) D
. . 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")=""
. . 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")=""
. I NN["LEXM(81,"&(+($P(NN,",",2))>1)!(NN["LEXM(81.3,"&(+($P(NN,",",2))>1)) D
. . 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")=""
. . 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")=""
. I NN["LEXM(81.2," D
. . 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)=""
. I NN["LEXM(757,"&(+($P(NN,",",2))>1)!(NN["LEXM(757."&(+($P(NN,",",2))>1)) D
. . N FI S FI=+($P(NN,"(",2))
. . S:ND["S ^LEX("!(ND["K ^LEX(") LEXSCHG(FI,0)=+($G(^LEXM(+FI,0))),LEXSCHG("B",FI)="",LEXSCHG("C","LEX",FI)="",LEXSCHG("D","PRO")=""
. . S:ND["S ^LEXT("!(ND["K ^LEXT(") LEXSCHG(FI,0)=+($G(^LEXM(+FI,0))),LEXSCHG("B",FI)="",LEXSCHG("C","LEX",FI)="",LEXSCHG("D","PRO")=""
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
Q
;
KLEXM ; Subscripted Kill of ^LEXM
N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
N LEX S LEX=$G(^LEXM(0,"PRO")) K ^LEXM(0)
;S:$L(LEX) ^LEXM(0,"PRO")=LEX
Q
;
PRE ; LEX*2.0*48 Pre-Install (N/A for patch 48)
Q
;
RX ; Reindex files (N/A for patch 48)
Q
N LEX,DA,DIK,TH,TM,TD
D BMES^XPDUTL(" Re-indexing NEW Versioned Text Cross-References")
;
D BMES^XPDUTL(" ICD-9 Diagnosis file #80") W !," "
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 "."
K ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT"),^ICD9("BA"),^ICD9("D"),^ICD9("AST"),^ICD9("ADS") S DIK="^ICD9(" D IXALL^DIK
;
D MES^XPDUTL(" ICD-9 Operations/Procedure file #80.1") W !," "
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 "."
K ^ICD0("AB"),^ICD0("ACT"),^ICD0("ADS"),^ICD0("AST"),^ICD0("BA"),^ICD0("D"),^ICD0("E") S DIK="^ICD0(" D IXALL^DIK
;
D MES^XPDUTL(" DRG file #80.2") W !," "
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 "."
K ^ICD("ADS"),^ICD("B") S DIK="^ICD(" D IXALL^DIK
;
D MES^XPDUTL(" CPT/HCPCS Procedure/Services file #81") W !," "
S (LEX,DA)=0 F S DA=$O(^ICPT(DA)) Q:+DA=0 D
. 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 "."
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
;
D MES^XPDUTL(" CPT Modifier file #81.3") W !," "
S (LEX,DA)=0 F S DA=$O(^DIC(81.3,DA)) Q:+DA=0 D
. 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 "."
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
Q
;
CON ; Conversion of data (N/A for patch 48)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2048P 5915 printed Nov 22, 2024@17:14:24 Page 2
LEX2048P ; CIO ISL - LEX*2.0*48 Pre/Post Install ; 04/01/2007
+1 ;;2.0;LEXICON UTILITY;**48**;Sep 23, 1996
+2 ;
+3 ; External References
+4 ; DBIA 10086 HOME^%ZIS
+5 ; DBIA 2052 $$GET1^DID
+6 ; DBIA 2055 PRD^DILFD
+7 ; DBIA 10014 EN^DIU2
+8 ; DBIA 10141 BMES^XPDUTL
+9 ; DBIA 10141 MES^XPDUTL
+10 ;
+11 QUIT
+12 ;
POST ; LEX*2.0*48 Post-Install
+1 NEW LEXEDT,LEXCHG,LEXSCHG,LEXMUMPS,LEXSHORT
SET LEXEDT=$GET(^LEXM(0,"CREATED"))
SET LEXSHORT=""
+2 SET LEXCHG=0
if $DATA(^LEXM(80))!($DATA(^LEXM(80.1)))!($DATA(^LEXM(81)))!($DATA(^LEXM(81.2)))!($DATA(^LEXM(81.3)))
SET LEXCHG=1
+3 ;
+4 ;-----------------------------
+5 ; Save Changes
+6 DO SCHG
+7 ;
+8 ;-----------------------------
+9 ; Load Data into Files
+10 DO LOAD
+11 ;
+12 ;-----------------------------
+13 ; Data Conversion
+14 DO CON
+15 ;
+16 ;-----------------------------
+17 ; Re-Index Files - N/A for LEX*2.0*48
+18 ; Do not use for Annual/Quarterly Updates, it disrupts the Protocol
+19 ; D RX
+20 ;
+21 ;-----------------------------
+22 ; Fire Protocol
+23 DO NOTIFY^LEXXGI
+24 ;
+25 ;-----------------------------
+26 ; Send a Install Message
+27 DO MSG
+28 ;
+29 ;-----------------------------
+30 ; Clean up and Quit
+31 DO KLEXM
+32 QUIT
+33 ;
LOAD ; Load Data from ^LEXM into IC*/LEX Files
+1 NEW LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXSTR,LEXLAST
DO IMP^LEX2048
+2 SET LEXSTR=$GET(LEXPTYPE)
if $LENGTH($GET(LEXFY))&($LENGTH($GET(LEXQTR)))
SET LEXSTR=LEXSTR_" for "_$GET(LEXFY)_" "_$GET(LEXQTR)_" Quarter"
+3 SET U="^"
SET LEXB=$GET(^LEXM(0,"BUILD"))
if LEXB=""
QUIT
if LEXBUILD=""
QUIT
+4 SET LEXCD=0
SET LEXCD=+($$CPD^LEX2048)
+5 IF LEXCD
IF LEXB=LEXBUILD
Begin DoDot:1
+6 SET X="Data for patch "_LEXBUILD_" has already been installed"
+7 if '$DATA(XPDNM)
WRITE !!,X
if $DATA(XPDNM)
DO BMES^XPDUTL(X)
+8 SET X=""
if '$DATA(XPDNM)
WRITE !
if $DATA(XPDNM)
DO MES^XPDUTL(X)
End DoDot:1
GOTO LQ
+9 if 'LEXCD&(LEXB=LEXBUILD)
DO EN^LEXXGI
LQ ; Load Quit
+1 DO KLEXM
+2 QUIT
+3 ;
MSG ; Send Installation Message to G.LEXICON
+1 if +($GET(DUZ))=0!($$NOTDEF^LEX2048($GET(DUZ)))
QUIT
+2 DO HOME^%ZIS
NEW DIFROM,LEXPRO,LEXPRON,LEXLAST,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXSHORT
+3 SET LEXSHORT=""
DO IMP^LEX2048
DO POST^LEXXFI
QUIT
+4 ;
SCHG ; Save Change File Changes
+1 NEW NN,NC,ND
KILL LEXSCHG(0)
SET LEXCHG=0
SET NN="^LEXM"
SET NC="^LEXM("
FOR
SET NN=$QUERY(@NN)
if '$LENGTH(NN)!(NN'[NC)
QUIT
Begin DoDot:1
+2 SET ND=$GET(@NN)
IF NN["LEXM(80,"&(+($PIECE(NN,",",2))>1)!(NN["LEXM(80.1,"&(+($PIECE(NN,",",2))>1))
Begin DoDot:2
+3 if ND["S ^ICD9("!(ND["K ^ICD9(")
SET LEXSCHG(80,0)=+($GET(^LEXM(80,0)))
SET LEXSCHG("B",80)=""
SET LEXSCHG(757.9,"B",80)=""
SET LEXSCHG("C","ICD",80)=""
SET LEXSCHG("D","PRO")=""
+4 if ND["S ^ICD0("!(ND["K ^ICD0(")
SET LEXSCHG(80.1,0)=+($GET(^LEXM(80.1,0)))
SET LEXSCHG("B",80.1)=""
SET LEXSCHG(757.9,"B",80.1)=""
SET LEXSCHG("C","ICD",80.1)=""
SET LEXSCHG("D","PRO")=""
End DoDot:2
+5 IF NN["LEXM(81,"&(+($PIECE(NN,",",2))>1)!(NN["LEXM(81.3,"&(+($PIECE(NN,",",2))>1))
Begin DoDot:2
+6 if ND["S ^ICPT("!(ND["K ^ICPT(")
SET LEXSCHG(81,0)=+($GET(^LEXM(81,0)))
SET LEXSCHG("B",81)=""
SET LEXSCHG(757.9,"B",81)=""
SET LEXSCHG("C","CPT",81)=""
SET LEXSCHG("D","PRO")=""
+7 if ND["S ^DIC(81.3,"!(ND["K ^DIC(81.3,")
SET LEXSCHG(81.3,0)=+($GET(^LEXM(81.3,0)))
SET LEXSCHG("B",81.3)=""
SET LEXSCHG(757.9,"B",81.3)=""
SET LEXSCHG("C","CPT",81.3)=""
SET LEXSCHG("D","PRO")=""
End DoDot:2
+8 IF NN["LEXM(81.2,"
Begin DoDot:2
+9 if ND["S ^DIC(81.2,"!(ND["K ^DIC(81.2,")
SET LEXSCHG(81.2,0)=+($GET(^LEXM(81.2,0)))
SET LEXSCHG("B",81.2)=""
SET LEXSCHG(757.9,"B",81,2)=""
SET LEXSCHG("C","CPT",81.2)=""
End DoDot:2
+10 IF NN["LEXM(757,"&(+($PIECE(NN,",",2))>1)!(NN["LEXM(757."&(+($PIECE(NN,",",2))>1))
Begin DoDot:2
+11 NEW FI
SET FI=+($PIECE(NN,"(",2))
+12 if ND["S ^LEX("!(ND["K ^LEX(")
SET LEXSCHG(FI,0)=+($GET(^LEXM(+FI,0)))
SET LEXSCHG("B",FI)=""
SET LEXSCHG("C","LEX",FI)=""
SET LEXSCHG("D","PRO")=""
+13 if ND["S ^LEXT("!(ND["K ^LEXT(")
SET LEXSCHG(FI,0)=+($GET(^LEXM(+FI,0)))
SET LEXSCHG("B",FI)=""
SET LEXSCHG("C","LEX",FI)=""
SET LEXSCHG("D","PRO")=""
End DoDot:2
End DoDot:1
+14 if $DATA(^LEXM(80))!($DATA(^LEXM(80.1)))!($DATA(^LEXM(81)))!($DATA(^LEXM(81.2)))!($DATA(^LEXM(81.3)))!($DATA(LEXSCHG("D","PRO")))
SET LEXCHG=1
SET LEXSCHG(0)=1
+15 QUIT
+16 ;
KLEXM ; Subscripted Kill of ^LEXM
+1 NEW DA
SET DA=0
FOR
SET DA=$ORDER(^LEXM(DA))
if +DA=0
QUIT
KILL ^LEXM(DA)
+2 NEW LEX
SET LEX=$GET(^LEXM(0,"PRO"))
KILL ^LEXM(0)
+3 ;S:$L(LEX) ^LEXM(0,"PRO")=LEX
+4 QUIT
+5 ;
PRE ; LEX*2.0*48 Pre-Install (N/A for patch 48)
+1 QUIT
+2 ;
RX ; Reindex files (N/A for patch 48)
+1 QUIT
+2 NEW LEX,DA,DIK,TH,TM,TD
+3 DO BMES^XPDUTL(" Re-indexing NEW Versioned Text Cross-References")
+4 ;
+5 DO BMES^XPDUTL(" ICD-9 Diagnosis file #80")
WRITE !," "
+6 SET (LEX,DA)=0
FOR
SET DA=$ORDER(^ICD9(DA))
if +DA=0
QUIT
KILL ^ICD9(DA,66,"B"),^ICD9(DA,67,"B"),^ICD9(DA,68,"B")
SET LEX=+($GET(LEX))+1
if LEX#120=0
WRITE "."
+7 KILL ^ICD9("AB"),^ICD9("ACC"),^ICD9("ACT"),^ICD9("BA"),^ICD9("D"),^ICD9("AST"),^ICD9("ADS")
SET DIK="^ICD9("
DO IXALL^DIK
+8 ;
+9 DO MES^XPDUTL(" ICD-9 Operations/Procedure file #80.1")
WRITE !," "
+10 SET (LEX,DA)=0
FOR
SET DA=$ORDER(^ICD0(DA))
if +DA=0
QUIT
KILL ^ICD0(DA,66,"B"),^ICD0(DA,67,"B"),^ICD0(DA,68,"B")
SET LEX=+($GET(LEX))+1
if LEX#120=0
WRITE "."
+11 KILL ^ICD0("AB"),^ICD0("ACT"),^ICD0("ADS"),^ICD0("AST"),^ICD0("BA"),^ICD0("D"),^ICD0("E")
SET DIK="^ICD0("
DO IXALL^DIK
+12 ;
+13 DO MES^XPDUTL(" DRG file #80.2")
WRITE !," "
+14 SET (LEX,DA)=0
FOR
SET DA=$ORDER(^ICD(DA))
if +DA=0
QUIT
KILL ^ICD(DA,1,"B"),^ICD(DA,66,"B"),^ICD(DA,68,"B")
SET LEX=+($GET(LEX))+1
if LEX#120=0
WRITE "."
+15 KILL ^ICD("ADS"),^ICD("B")
SET DIK="^ICD("
DO IXALL^DIK
+16 ;
+17 DO MES^XPDUTL(" CPT/HCPCS Procedure/Services file #81")
WRITE !," "
+18 SET (LEX,DA)=0
FOR
SET DA=$ORDER(^ICPT(DA))
if +DA=0
QUIT
Begin DoDot:1
+19 KILL ^ICPT(DA,60,"B"),^ICPT(DA,61,"B"),^ICPT(DA,62,"B"),^ICPT(DA,"D","B")
SET LEX=+($GET(LEX))+1
if LEX#120=0
WRITE "."
End DoDot:1
+20 KILL ^ICPT("ACT"),^ICPT("ADS"),^ICPT("AST"),^ICPT("B"),^ICPT("BA"),^ICPT("C"),^ICPT("D"),^ICPT("E"),^ICPT("F")
SET DIK="^ICPT("
DO IXALL^DIK
+21 ;
+22 DO MES^XPDUTL(" CPT Modifier file #81.3")
WRITE !," "
+23 SET (LEX,DA)=0
FOR
SET DA=$ORDER(^DIC(81.3,DA))
if +DA=0
QUIT
Begin DoDot:1
+24 KILL ^DIC(81.3,DA,60,"B"),^DIC(81.3,DA,61,"B"),^DIC(81.3,DA,62,"B")
SET LEX=+($GET(LEX))+1
if LEX#120=0
WRITE "."
End DoDot:1
+25 KILL ^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")
SET DIK="^DIC(81.3,"
DO IXALL^DIK
+26 QUIT
+27 ;
CON ; Conversion of data (N/A for patch 48)
+1 QUIT
