LEX2073P ;ISL/KER - LEX*2.0*73 Pre/Post Install ;01/03/2011
;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10
;
; Global Variables
; ^%ZOSF("PROD") ICR 10096
; ^%ZOSF("UCI") ICR 10096
; ^ORD(101, ICR 872
; ^TMP("LEXKID") SACC 2.3.2.5.1
;
; External References
; $$GET1^DIQ ICR 2056
; $$FMTE^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; BMES^XPDUTL ICR 10141
; MES^XPDUTL ICR 10141
; EN^XQOR ICR 10101
;
; Deletion of Unversioned Fields Patch Numbers
;
; LEX*2.0*73
; ICPT*6.0*46
; ICD*18.0*40
;
Q
PRE ; LEX*2.0*73 Pre-Install
Q
POST ; LEX*2.0*73 Post-Install
N LEX1,LEX2,LEX3,LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXDUZ,LEXFI,LEXH,LEXI,LEXID,LEXIN,LEXNM,LEXP,LEXPH,LEXPRO,LEXS
N LEXSCHG,LEXT,LEXU,LEXUSR,X,Y D CON,POST^LEX2073A,INS
Q
;
INS ; Install Message
K ^TMP("LEXKID",$J),LEXSCHG N LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXH,LEXIN,LEXPRO,LEXS,LEXT,LEXU
S LEXBUILD="LEX*2.0*73",LEXPRO=$$NOT,LEXS="LEX*2.0*73 Installation" H 2 D BL,TL((" "_LEXS)),TL(" ======================="),BL
S LEXAO=" As of: "_$$ED($$NOW^XLFDT) D TL(LEXAO) S LEXAC=""
S LEXA=$$UCI S:$L($P(LEXA,"^",1)) LEXAC=" In Account: " S LEXAC=LEXAC_$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
S:$L($P(LEXA,"^",2)) LEXAC=LEXAC_" "_$P(LEXA,"^",2) D TL(LEXAC) S LEXU=$$USR
S:$L($P(LEXU,"^",1)) LEXU=" Maint By: "_$P(LEXU,"^",1)_" "_$P(LEXU,"^",2) D TL(LEXU)
S LEXB=" Build: "_LEXBUILD D TL(LEXB) S LEXIN=$P($G(LEXPRO),"^",1) I LEXIN>0 D
. S LEXT=" Protocol: "_"LEXICAL SERVICES UPDATE" D BL,TL(LEXT) S LEXT=" Invoked: "_$$ED(LEXIN) D TL(LEXT),BL
D:+($G(^TMP("LEXKID",$J,0)))>0 MAIL^LEX2073 K ^TMP("LEXKID",$J)
Q
NOT(X) ; Notify by Protocol
N LEXIN,LEXFI,LEXID,LEXP,Y K LEXSCHG S LEXFI=0,LEXIN="",LEXSCHG("LEX")=""
S LEXP=+($O(^ORD(101,"B","LEXICAL SERVICES UPDATE",0))) Q:LEXP=0 "" S X=LEXP_";ORD(101," D EN^XQOR
S:$P($G(LEXSCHG("LEX")),".",1)?7N LEXIN=$G(LEXSCHG("LEX"))
D:+LEXIN>0 BMES^XPDUTL((" Protocol 'LEXICAL SERVICES UPDATE' invoked "_$$ED(LEXIN))),MES^XPDUTL(" ") S X=LEXIN
Q X
;
; Miscellaneous
ED(X) ; External Date
N Y S Y=$$FMTE^XLFDT($G(X)) S:Y["@" Y=$P(Y,"@",1)_" "_$P(Y,"@",2,299) S:$L(Y) X=Y
Q X
UCI(X) ; UCI where Lexicon is installed
N LEXU,LEX1,LEX2,LEX3,LEXP,LEXT,Y X ^%ZOSF("UCI") S LEXU=Y,LEXP="",LEX1=$P(Y,",",1),LEX2=$P(Y,",",2,299),LEX3=$G(^%ZOSF("PROD"))
S:$L(LEX3)&(LEXU=LEX3!(LEX1=LEX3)!(LEX2=LEX3)) LEXP=" (Production)" S:'$L(LEXP) LEXP=" (Test)"
S:$L(LEX1)>5&($L(LEX2)>5)&(LEX1=LEX2) LEXU=LEX1 S X="",$P(X,"^",1)=LEXU,$P(X,"^",2)=LEXP
Q X
USR(X) ; User/Person Installing
N LEXDUZ,LEXUSR,LEXPH,LEXNM S LEXDUZ=+($G(DUZ)) Q:+LEXDUZ'>0 "UNKNOWN^" S LEXNM=$$GET1^DIQ(200,+LEXDUZ,.01) Q:'$L(LEXNM) "UNKNOWN^"
S LEXUSR=LEXDUZ S LEXPH=$$GET1^DIQ(200,+LEXUSR,.132) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXUSR,.131)
S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXUSR,.133) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXUSR,.134)
S LEXUSR=$$GET1^DIQ(200,+LEXDUZ,.01),X=LEXUSR_"^"_LEXPH
Q X
CON ; Conversion of Data
D BM(" Re-building Mapping File 757.33") N IEN,DIK,DA,CT S (CT,IEN)=0 W ! F S IEN=$O(^LEX(757.33,IEN)) Q:+IEN'>0 D
. S DA=+IEN,DIK="^LEX(757.33," D IX1^DIK S CT=CT+1 W:(CT#238)'>0 ?4,"."
Q
BL ; Blank Line
D TL(" ")
Q
TL(X) ; Text Line
N LEXI S LEXI=$O(^TMP("LEXKID",$J," "),-1),LEXI=LEXI+1,^TMP("LEXKID",$J,LEXI)=$G(X),^TMP("LEXKID",$J,0)=LEXI
Q
M(X) ; Blank/Text
D MES^XPDUTL($G(X)) Q
BM(X) ; Blank/Text
D BMES^XPDUTL($G(X)) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2073P 3750 printed Oct 16, 2024@18:05:33 Page 2
LEX2073P ;ISL/KER - LEX*2.0*73 Pre/Post Install ;01/03/2011
+1 ;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10
+2 ;
+3 ; Global Variables
+4 ; ^%ZOSF("PROD") ICR 10096
+5 ; ^%ZOSF("UCI") ICR 10096
+6 ; ^ORD(101, ICR 872
+7 ; ^TMP("LEXKID") SACC 2.3.2.5.1
+8 ;
+9 ; External References
+10 ; $$GET1^DIQ ICR 2056
+11 ; $$FMTE^XLFDT ICR 10103
+12 ; $$NOW^XLFDT ICR 10103
+13 ; BMES^XPDUTL ICR 10141
+14 ; MES^XPDUTL ICR 10141
+15 ; EN^XQOR ICR 10101
+16 ;
+17 ; Deletion of Unversioned Fields Patch Numbers
+18 ;
+19 ; LEX*2.0*73
+20 ; ICPT*6.0*46
+21 ; ICD*18.0*40
+22 ;
+23 QUIT
PRE ; LEX*2.0*73 Pre-Install
+1 QUIT
POST ; LEX*2.0*73 Post-Install
+1 NEW LEX1,LEX2,LEX3,LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXDUZ,LEXFI,LEXH,LEXI,LEXID,LEXIN,LEXNM,LEXP,LEXPH,LEXPRO,LEXS
+2 NEW LEXSCHG,LEXT,LEXU,LEXUSR,X,Y
DO CON
DO POST^LEX2073A
DO INS
+3 QUIT
+4 ;
INS ; Install Message
+1 KILL ^TMP("LEXKID",$JOB),LEXSCHG
NEW LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXH,LEXIN,LEXPRO,LEXS,LEXT,LEXU
+2 SET LEXBUILD="LEX*2.0*73"
SET LEXPRO=$$NOT
SET LEXS="LEX*2.0*73 Installation"
HANG 2
DO BL
DO TL((" "_LEXS))
DO TL(" =======================")
DO BL
+3 SET LEXAO=" As of: "_$$ED($$NOW^XLFDT)
DO TL(LEXAO)
SET LEXAC=""
+4 SET LEXA=$$UCI
if $LENGTH($PIECE(LEXA,"^",1))
SET LEXAC=" In Account: "
SET LEXAC=LEXAC_$SELECT($LENGTH($PIECE(LEXA,"^",1)):"[",1:"")_$PIECE(LEXA,"^",1)_$SELECT($LENGTH($PIECE(LEXA,"^",2)):"]",1:"")
+5 if $LENGTH($PIECE(LEXA,"^",2))
SET LEXAC=LEXAC_" "_$PIECE(LEXA,"^",2)
DO TL(LEXAC)
SET LEXU=$$USR
+6 if $LENGTH($PIECE(LEXU,"^",1))
SET LEXU=" Maint By: "_$PIECE(LEXU,"^",1)_" "_$PIECE(LEXU,"^",2)
DO TL(LEXU)
+7 SET LEXB=" Build: "_LEXBUILD
DO TL(LEXB)
SET LEXIN=$PIECE($GET(LEXPRO),"^",1)
IF LEXIN>0
Begin DoDot:1
+8 SET LEXT=" Protocol: "_"LEXICAL SERVICES UPDATE"
DO BL
DO TL(LEXT)
SET LEXT=" Invoked: "_$$ED(LEXIN)
DO TL(LEXT)
DO BL
End DoDot:1
+9 if +($GET(^TMP("LEXKID",$JOB,0)))>0
DO MAIL^LEX2073
KILL ^TMP("LEXKID",$JOB)
+10 QUIT
NOT(X) ; Notify by Protocol
+1 NEW LEXIN,LEXFI,LEXID,LEXP,Y
KILL LEXSCHG
SET LEXFI=0
SET LEXIN=""
SET LEXSCHG("LEX")=""
+2 SET LEXP=+($ORDER(^ORD(101,"B","LEXICAL SERVICES UPDATE",0)))
if LEXP=0
QUIT ""
SET X=LEXP_";ORD(101,"
DO EN^XQOR
+3 if $PIECE($GET(LEXSCHG("LEX")),".",1)?7N
SET LEXIN=$GET(LEXSCHG("LEX"))
+4 if +LEXIN>0
DO BMES^XPDUTL((" Protocol 'LEXICAL SERVICES UPDATE' invoked "_$$ED(LEXIN)))
DO MES^XPDUTL(" ")
SET X=LEXIN
+5 QUIT X
+6 ;
+7 ; Miscellaneous
ED(X) ; External Date
+1 NEW Y
SET Y=$$FMTE^XLFDT($GET(X))
if Y["@"
SET Y=$PIECE(Y,"@",1)_" "_$PIECE(Y,"@",2,299)
if $LENGTH(Y)
SET X=Y
+2 QUIT X
UCI(X) ; UCI where Lexicon is installed
+1 NEW LEXU,LEX1,LEX2,LEX3,LEXP,LEXT,Y
XECUTE ^%ZOSF("UCI")
SET LEXU=Y
SET LEXP=""
SET LEX1=$PIECE(Y,",",1)
SET LEX2=$PIECE(Y,",",2,299)
SET LEX3=$GET(^%ZOSF("PROD"))
+2 if $LENGTH(LEX3)&(LEXU=LEX3!(LEX1=LEX3)!(LEX2=LEX3))
SET LEXP=" (Production)"
if '$LENGTH(LEXP)
SET LEXP=" (Test)"
+3 if $LENGTH(LEX1)>5&($LENGTH(LEX2)>5)&(LEX1=LEX2)
SET LEXU=LEX1
SET X=""
SET $PIECE(X,"^",1)=LEXU
SET $PIECE(X,"^",2)=LEXP
+4 QUIT X
USR(X) ; User/Person Installing
+1 NEW LEXDUZ,LEXUSR,LEXPH,LEXNM
SET LEXDUZ=+($GET(DUZ))
if +LEXDUZ'>0
QUIT "UNKNOWN^"
SET LEXNM=$$GET1^DIQ(200,+LEXDUZ,.01)
if '$LENGTH(LEXNM)
QUIT "UNKNOWN^"
+2 SET LEXUSR=LEXDUZ
SET LEXPH=$$GET1^DIQ(200,+LEXUSR,.132)
if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+LEXUSR,.131)
+3 if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+LEXUSR,.133)
if LEXPH=""
SET LEXPH=$$GET1^DIQ(200,+LEXUSR,.134)
+4 SET LEXUSR=$$GET1^DIQ(200,+LEXDUZ,.01)
SET X=LEXUSR_"^"_LEXPH
+5 QUIT X
CON ; Conversion of Data
+1 DO BM(" Re-building Mapping File 757.33")
NEW IEN,DIK,DA,CT
SET (CT,IEN)=0
WRITE !
FOR
SET IEN=$ORDER(^LEX(757.33,IEN))
if +IEN'>0
QUIT
Begin DoDot:1
+2 SET DA=+IEN
SET DIK="^LEX(757.33,"
DO IX1^DIK
SET CT=CT+1
if (CT#238)'>0
WRITE ?4,"."
End DoDot:1
+3 QUIT
BL ; Blank Line
+1 DO TL(" ")
+2 QUIT
TL(X) ; Text Line
+1 NEW LEXI
SET LEXI=$ORDER(^TMP("LEXKID",$JOB," "),-1)
SET LEXI=LEXI+1
SET ^TMP("LEXKID",$JOB,LEXI)=$GET(X)
SET ^TMP("LEXKID",$JOB,0)=LEXI
+2 QUIT
M(X) ; Blank/Text
+1 DO MES^XPDUTL($GET(X))
QUIT
BM(X) ; Blank/Text
+1 DO BMES^XPDUTL($GET(X))
QUIT
