LEX2029P ; ISL/KER - Pre/Post Install; 04/07/2004
;;2.0;LEXICON UTILITY;**29**;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*29 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
; Re-Index Files
D RX
; Notify Applications that a Change has occurred
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 LEXB,LEXBUILD,LEXCD,LEXIGHF,LEXREQP,LEXLREV D IMP^LEX2029
S U="^",LEXB=$G(^LEXM(0,"BUILD")) Q:LEXB="" Q:$G(LEXBUILD)=""
S LEXCD=0 S LEXCD=+($$CPD^LEX2029)
I LEXCD,LEXB=LEXBUILD D G LOADQ
. 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 D KLEXM
LOADQ ; Quit Load
D KLEXM
Q
;
MSG ; Send Installation Message to G.LEXICON
Q:+($G(DUZ))=0!($$NOTDEF^LEX2029($G(DUZ)))
D HOME^%ZIS N DIFROM,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXSHORT
S LEXSHORT="" D IMP^LEX2029,SEND^LEXXST
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.2^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),^LEXM(0)
Q
;
PRE ; LEX*2.0*29 Pre-Install (N/A for patch 29)
Q
;
RX ; Re-Index Files (N/A for patch 29)
Q
;
CON ; Conversion of Data (N/A for patch 29)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2029P 2743 printed Sep 23, 2025@19:39:39 Page 2
LEX2029P ; ISL/KER - Pre/Post Install; 04/07/2004
+1 ;;2.0;LEXICON UTILITY;**29**;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*29 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 ; Save Changes
+4 DO SCHG
+5 ; Load Data into Files
+6 DO LOAD
+7 ; Re-Index Files
+8 DO RX
+9 ; Notify Applications that a Change has occurred
+10 DO NOTIFY^LEXXGI
+11 ; Send a Install Message
+12 DO MSG
+13 ; Clean up and Quit
+14 DO KLEXM
+15 QUIT
+16 ;
LOAD ; Load Data from ^LEXM into IC*/LEX Files
+1 NEW LEXB,LEXBUILD,LEXCD,LEXIGHF,LEXREQP,LEXLREV
DO IMP^LEX2029
+2 SET U="^"
SET LEXB=$GET(^LEXM(0,"BUILD"))
if LEXB=""
QUIT
if $GET(LEXBUILD)=""
QUIT
+3 SET LEXCD=0
SET LEXCD=+($$CPD^LEX2029)
+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 LOADQ
+8 if 'LEXCD&(LEXB=LEXBUILD)
DO EN^LEXXGI
DO KLEXM
LOADQ ; Quit Load
+1 DO KLEXM
+2 QUIT
+3 ;
MSG ; Send Installation Message to G.LEXICON
+1 if +($GET(DUZ))=0!($$NOTDEF^LEX2029($GET(DUZ)))
QUIT
+2 DO HOME^%ZIS
NEW DIFROM,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXSHORT
+3 SET LEXSHORT=""
DO IMP^LEX2029
DO SEND^LEXXST
+4 QUIT
+5 ;
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.2^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),^LEXM(0)
+2 QUIT
+3 ;
PRE ; LEX*2.0*29 Pre-Install (N/A for patch 29)
+1 QUIT
+2 ;
RX ; Re-Index Files (N/A for patch 29)
+1 QUIT
+2 ;
CON ; Conversion of Data (N/A for patch 29)
+1 QUIT
