- LEX2043P ; ISL/KER - Pre/Post Install ; 09/06/2006
- ;;2.0;LEXICON UTILITY;**43**;Sep 23, 1996;Build 24
- ;
- ; 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*43 Post-Install
- N LEXEDT,LEXCHG,LEXSCHG S LEXEDT=$G(^LEXM(0,"CREATED"))
- 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*43
- ; Do not use for Annual/Quarterly Updates, it disrupts the Protocol
- ; D RX
- ;
- ;-----------------------------
- ; Fire Protocol
- D NOTIFY^LEXXGI
- ;
- ;-----------------------------
- ; Install Remedy Tickets
- D ALL^LEX2043A
- ;
- ;-----------------------------
- ; Send a Install Message
- D MSG
- ;
- ;-----------------------------
- ; Clean up and Quit
- D KLEXM
- Q
- ;
- LOAD ; Load Data from ^LEXM into IC*/LEX Files
- N LEXB,LEXBUILD,LEXCD,LEXIGHF,LEXLAST,LEXLREV D IMP^LEX2043
- S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:LEXBUILD=""
- S LEXCD=0 S LEXCD=+($$CPD^LEX2043)
- 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^LEX2043($G(DUZ)))
- D HOME^%ZIS N DIFROM,LEXLREV,LEXLAST,LEXBUILD,LEXIGHF
- D IMP^LEX2043,POST^LEXXFI Q
- ;
- SCHG ; Save Change File Changes
- N LEXI,LEXFI,LEXFIL S LEXFI=0 F S LEXFI=$O(^LEXM(LEXFI)) Q:+LEXFI=0 D
- . S LEXI=0 F S LEXI=$O(^LEXM(LEXFI,LEXI)) Q:+LEXI=0 D
- . . N LEXCF,LEXIEN S LEXMUMPS=$G(^LEXM(LEXFI,LEXI)),LEXRT=$P(LEXMUMPS,"^",2)
- . . S:LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(")!(LEXMUMPS["^LEXC(") LEXFIL=+($P(LEXRT,"(",2))
- . . S:LEXMUMPS["^ICD9(" LEXFIL=80 S:LEXMUMPS["^ICD0(" LEXFIL=80.1 S:LEXMUMPS["^ICPT(" LEXFIL=81 S:LEXMUMPS["^DIC(81.3" LEXFIL=81.3
- . . S:+LEXFIL>0 LEXSCHG(+LEXFIL,0)="" S LEXCF=+($P(LEXMUMPS,"LEXC(757.9,""AFIL"",",2))
- . . S:$P(LEXCF,".",1)'="757"&("^80^80.1^81^81.3^"'[("^"_LEXCF_"^")) LEXCF=""
- . . S LEXIEN=+($P(LEXMUMPS,("LEXC(757.9,""AFIL"","_+LEXCF_","),2))
- . . I +LEXIEN>0&(+LEXCF)>0&("^80^80.1^81^81.3)"[LEXCF)&(+LEXFIL=757.9)&(LEXMUMPS["LEXC(757.9") D
- . . . S LEXSCHG(+LEXFIL,LEXIEN)=LEXCF,LEXSCHG(757.9,"B",+LEXCF,LEXIEN)=""
- . . S:$L(LEXMUMPS)&($L(LEXCF)) LEXCHGS(LEXCF)=""
- Q
- ;
- KLEXM ; Subscripted Kill of ^LEXM
- N DA S DA=0 F S DA=$O(^LEXM(DA)) Q:+DA=0 K ^LEXM(DA)
- K ^LEXM(0)
- Q
- ;
- PRE ; LEX*2.0*40 Pre-Install (N/A for patch 40)
- Q
- ;
- RX ; Reindex files (N/A for patch 40)
- 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 LEX2043)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2043P 4918 printed Jan 18, 2025@03:05:01 Page 2
- LEX2043P ; ISL/KER - Pre/Post Install ; 09/06/2006
- +1 ;;2.0;LEXICON UTILITY;**43**;Sep 23, 1996;Build 24
- +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*43 Post-Install
- +1 NEW LEXEDT,LEXCHG,LEXSCHG
- SET LEXEDT=$GET(^LEXM(0,"CREATED"))
- +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*43
- +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 ; Install Remedy Tickets
- +27 DO ALL^LEX2043A
- +28 ;
- +29 ;-----------------------------
- +30 ; Send a Install Message
- +31 DO MSG
- +32 ;
- +33 ;-----------------------------
- +34 ; Clean up and Quit
- +35 DO KLEXM
- +36 QUIT
- +37 ;
- LOAD ; Load Data from ^LEXM into IC*/LEX Files
- +1 NEW LEXB,LEXBUILD,LEXCD,LEXIGHF,LEXLAST,LEXLREV
- DO IMP^LEX2043
- +2 SET U="^"
- SET LEXB=$GET(^LEXM(0,"BUILD"))
- if LEXB=""
- QUIT
- if LEXBUILD=""
- QUIT
- +3 SET LEXCD=0
- SET LEXCD=+($$CPD^LEX2043)
- +4 IF LEXCD
- IF LEXB=LEXBUILD
- Begin DoDot:1
- +5 SET X="Data for patch "_LEXBUILD_" has already been installed"
- +6 if '$DATA(XPDNM)
- WRITE !!,X
- if $DATA(XPDNM)
- DO BMES^XPDUTL(X)
- +7 SET X=""
- if '$DATA(XPDNM)
- WRITE !
- if $DATA(XPDNM)
- DO MES^XPDUTL(X)
- End DoDot:1
- GOTO LQ
- +8 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^LEX2043($GET(DUZ)))
- QUIT
- +2 DO HOME^%ZIS
- NEW DIFROM,LEXLREV,LEXLAST,LEXBUILD,LEXIGHF
- +3 DO IMP^LEX2043
- DO POST^LEXXFI
- QUIT
- +4 ;
- SCHG ; Save Change File Changes
- +1 NEW LEXI,LEXFI,LEXFIL
- SET LEXFI=0
- FOR
- SET LEXFI=$ORDER(^LEXM(LEXFI))
- if +LEXFI=0
- QUIT
- Begin DoDot:1
- +2 SET LEXI=0
- FOR
- SET LEXI=$ORDER(^LEXM(LEXFI,LEXI))
- if +LEXI=0
- QUIT
- Begin DoDot:2
- +3 NEW LEXCF,LEXIEN
- SET LEXMUMPS=$GET(^LEXM(LEXFI,LEXI))
- SET LEXRT=$PIECE(LEXMUMPS,"^",2)
- +4 if LEXMUMPS["^LEX("!(LEXMUMPS["^LEXT(")!(LEXMUMPS["^LEXC(")
- SET LEXFIL=+($PIECE(LEXRT,"(",2))
- +5 if LEXMUMPS["^ICD9("
- SET LEXFIL=80
- if LEXMUMPS["^ICD0("
- SET LEXFIL=80.1
- if LEXMUMPS["^ICPT("
- SET LEXFIL=81
- if LEXMUMPS["^DIC(81.3"
- SET LEXFIL=81.3
- +6 if +LEXFIL>0
- SET LEXSCHG(+LEXFIL,0)=""
- SET LEXCF=+($PIECE(LEXMUMPS,"LEXC(757.9,""AFIL"",",2))
- +7 if $PIECE(LEXCF,".",1)'="757"&("^80^80.1^81^81.3^"'[("^"_LEXCF_"^"))
- SET LEXCF=""
- +8 SET LEXIEN=+($PIECE(LEXMUMPS,("LEXC(757.9,""AFIL"","_+LEXCF_","),2))
- +9 IF +LEXIEN>0&(+LEXCF)>0&("^80^80.1^81^81.3)"[LEXCF)&(+LEXFIL=757.9)&(LEXMUMPS["LEXC(757.9")
- Begin DoDot:3
- +10 SET LEXSCHG(+LEXFIL,LEXIEN)=LEXCF
- SET LEXSCHG(757.9,"B",+LEXCF,LEXIEN)=""
- End DoDot:3
- +11 if $LENGTH(LEXMUMPS)&($LENGTH(LEXCF))
- SET LEXCHGS(LEXCF)=""
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ;
- 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 KILL ^LEXM(0)
- +3 QUIT
- +4 ;
- PRE ; LEX*2.0*40 Pre-Install (N/A for patch 40)
- +1 QUIT
- +2 ;
- RX ; Reindex files (N/A for patch 40)
- +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 LEX2043)
- +1 QUIT