LEX2081P ;ISL/KER - LEX*2.0*81 Pre/Post Install ;08/17/2011
;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
;
; Global Variables
; ^%ZOSF("PROD") ICR 10096
; ^%ZOSF("UCI") ICR 10096
; ^TMP("LEXKID",$J) SACC 2.3.2.5.1
; ^TMP("LEXMSG",$J) SACC 2.3.2.5.1
;
; External References
; ^DIC ICR 10006
; $$GET1^DIQ ICR 2056
; $$FMTE^XLFDT ICR 10103
; $$NOW^XLFDT ICR 10103
; ^XMD ICR 10070
Q
PRE ; Pre-Install
Q
POST ; Post-Install
;
; From IMP in the Environment Check
;
; LEXBUILD Build Name LEX*2.0*81
; LEXPTYPE Patch Type Emergency Patch (Remedy Ticket Fixes)
; LEXFY Fiscal Year N/A
; LEXQTR Quarter N/A
; LEXIGHF Name of Host File N/A
; LEXLREV Revision 81
; LEXREQP Required Builds LEX*2.0*73^3110628
;
N LEXEDT,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXSTR,LEXLAST,LEXOK,X,Y S LEXOK=0 D IMP
D:LEXOK>0 POST^LEX2081A,INS
Q
INS ; Install Message
K ^TMP("LEXKID",$J),LEXSCHG N LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXH,LEXIN,LEXS,LEXT,LEXU
S LEXBUILD="LEX*2.0*81",LEXS="Emergency Patch LEX*2.0*81 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)
D:+($G(^TMP("LEXKID",$J,0)))>0 MAIL K ^TMP("LEXKID",$J)
Q
MAIL ; Mail global array in message
N DIFROM,LEXPRI,LEXADR,LEXI,LEXM,LEXSUB,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
D IMP K ^TMP("LEXMSG",$J) S LEXSUB="Lexicon/ICD/CPT Installation" S:$L($G(LEXBUILD)) LEXSUB=$G(LEXBUILD)_" Installation"
S LEXPRI=$$ADR G:'$L(LEXPRI) MAILQ S LEXPRI="G.LEXINS@"_LEXPRI S LEXADR=$$GET1^DIQ(200,+($G(DUZ)),.01) G:'$L(LEXADR) MAILQ
S XMSUB=LEXSUB S LEXI=0 F S LEXI=$O(^TMP("LEXKID",$J,LEXI)) Q:+LEXI=0 D
. S LEXM=+($O(^TMP("LEXMSG",$J," "),-1))+1,^TMP("LEXMSG",$J,LEXM,0)=$E($G(^TMP("LEXKID",$J,LEXI)),1,79),^TMP("LEXMSG",$J,0)=LEXM
K ^TMP("LEXKID",$J) G:'$D(^TMP("LEXMSG",$J)) MAILQ G:+($G(^TMP("LEXMSG",$J,0)))'>0 MAILQ S XMY(LEXPRI)="",XMY(LEXADR)=""
S XMTEXT="^TMP(""LEXMSG"",$J,",XMDUZ=.5 D ^XMD
MAILQ ; Quit Mail
D KILL K XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ
Q
;
; Miscellaneous
ADR(LEX) ; Mailing Address
N DIC,DTOUT,DUOUT,X,Y
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="FO-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="FO-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
S DIC="^DIC(4.2,",DIC(0)="M",(LEX,X)="ISC-SLC.DOMAIN.EXT" D ^DIC Q:+Y>0 LEX
Q "ISC-SLC.DOMAIN.EXT"
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
KILL ; Kill all ^TMP(
K ^TMP("LEXMSG",$J),^TMP("LEXKID",$J)
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
PIEN(X) ; Package IEN
N DIC,DTOUT,DTOUT,Y S X=$G(X),DIC="^DIC(9.4,",DIC(0)="B" D ^DIC S X=+Y
Q X
IMP ; Call IMP in Environment Check
K LEXBUILD,LEXFY,LEXIGHF,LEXLREV,LEXPTYPE,LEXQTR,LEXREQP N LEXF
S LEXF=$P($T(+1)," ",1) S:$E(LEXF,$L(LEXF))="P" LEXF=$E(LEXF,1,($L(LEXF)-1)) Q:'$L(LEXF)
S LEXF="IMP^"_LEXF Q:'$L($T(@LEXF)) D @LEXF S:$L(LEXBUILD) LEXOK=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEX2081P 4719 printed Nov 22, 2024@17:15:08 Page 2
LEX2081P ;ISL/KER - LEX*2.0*81 Pre/Post Install ;08/17/2011
+1 ;;2.0;LEXICON UTILITY;**81**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^%ZOSF("PROD") ICR 10096
+5 ; ^%ZOSF("UCI") ICR 10096
+6 ; ^TMP("LEXKID",$J) SACC 2.3.2.5.1
+7 ; ^TMP("LEXMSG",$J) SACC 2.3.2.5.1
+8 ;
+9 ; External References
+10 ; ^DIC ICR 10006
+11 ; $$GET1^DIQ ICR 2056
+12 ; $$FMTE^XLFDT ICR 10103
+13 ; $$NOW^XLFDT ICR 10103
+14 ; ^XMD ICR 10070
+15 QUIT
PRE ; Pre-Install
+1 QUIT
POST ; Post-Install
+1 ;
+2 ; From IMP in the Environment Check
+3 ;
+4 ; LEXBUILD Build Name LEX*2.0*81
+5 ; LEXPTYPE Patch Type Emergency Patch (Remedy Ticket Fixes)
+6 ; LEXFY Fiscal Year N/A
+7 ; LEXQTR Quarter N/A
+8 ; LEXIGHF Name of Host File N/A
+9 ; LEXLREV Revision 81
+10 ; LEXREQP Required Builds LEX*2.0*73^3110628
+11 ;
+12 NEW LEXEDT,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR,LEXB,LEXCD,LEXSTR,LEXLAST,LEXOK,X,Y
SET LEXOK=0
DO IMP
+13 if LEXOK>0
DO POST^LEX2081A
DO INS
+14 QUIT
INS ; Install Message
+1 KILL ^TMP("LEXKID",$JOB),LEXSCHG
NEW LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXH,LEXIN,LEXS,LEXT,LEXU
+2 SET LEXBUILD="LEX*2.0*81"
SET LEXS="Emergency Patch LEX*2.0*81 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)
+8 if +($GET(^TMP("LEXKID",$JOB,0)))>0
DO MAIL
KILL ^TMP("LEXKID",$JOB)
+9 QUIT
MAIL ; Mail global array in message
+1 NEW DIFROM,LEXPRI,LEXADR,LEXI,LEXM,LEXSUB,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ,LEXPTYPE,LEXLREV,LEXREQP,LEXBUILD,LEXIGHF,LEXFY,LEXQTR
+2 DO IMP
KILL ^TMP("LEXMSG",$JOB)
SET LEXSUB="Lexicon/ICD/CPT Installation"
if $LENGTH($GET(LEXBUILD))
SET LEXSUB=$GET(LEXBUILD)_" Installation"
+3 SET LEXPRI=$$ADR
if '$LENGTH(LEXPRI)
GOTO MAILQ
SET LEXPRI="G.LEXINS@"_LEXPRI
SET LEXADR=$$GET1^DIQ(200,+($GET(DUZ)),.01)
if '$LENGTH(LEXADR)
GOTO MAILQ
+4 SET XMSUB=LEXSUB
SET LEXI=0
FOR
SET LEXI=$ORDER(^TMP("LEXKID",$JOB,LEXI))
if +LEXI=0
QUIT
Begin DoDot:1
+5 SET LEXM=+($ORDER(^TMP("LEXMSG",$JOB," "),-1))+1
SET ^TMP("LEXMSG",$JOB,LEXM,0)=$EXTRACT($GET(^TMP("LEXKID",$JOB,LEXI)),1,79)
SET ^TMP("LEXMSG",$JOB,0)=LEXM
End DoDot:1
+6 KILL ^TMP("LEXKID",$JOB)
if '$DATA(^TMP("LEXMSG",$JOB))
GOTO MAILQ
if +($GET(^TMP("LEXMSG",$JOB,0)))'>0
GOTO MAILQ
SET XMY(LEXPRI)=""
SET XMY(LEXADR)=""
+7 SET XMTEXT="^TMP(""LEXMSG"",$J,"
SET XMDUZ=.5
DO ^XMD
MAILQ ; Quit Mail
+1 DO KILL
KILL XCNP,XMSCR,XMDUZ,XMY,XMZ,XMSUB,XMY,XMTEXT,XMDUZ
+2 QUIT
+3 ;
+4 ; Miscellaneous
ADR(LEX) ; Mailing Address
+1 NEW DIC,DTOUT,DUOUT,X,Y
+2 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="FO-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+3 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="FO-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+4 SET DIC="^DIC(4.2,"
SET DIC(0)="M"
SET (LEX,X)="ISC-SLC.DOMAIN.EXT"
DO ^DIC
if +Y>0
QUIT LEX
+5 QUIT "ISC-SLC.DOMAIN.EXT"
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
KILL ; Kill all ^TMP(
+1 KILL ^TMP("LEXMSG",$JOB),^TMP("LEXKID",$JOB)
+2 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
PIEN(X) ; Package IEN
+1 NEW DIC,DTOUT,DTOUT,Y
SET X=$GET(X)
SET DIC="^DIC(9.4,"
SET DIC(0)="B"
DO ^DIC
SET X=+Y
+2 QUIT X
IMP ; Call IMP in Environment Check
+1 KILL LEXBUILD,LEXFY,LEXIGHF,LEXLREV,LEXPTYPE,LEXQTR,LEXREQP
NEW LEXF
+2 SET LEXF=$PIECE($TEXT(+1)," ",1)
if $EXTRACT(LEXF,$LENGTH(LEXF))="P"
SET LEXF=$EXTRACT(LEXF,1,($LENGTH(LEXF)-1))
if '$LENGTH(LEXF)
QUIT
+3 SET LEXF="IMP^"_LEXF
if '$LENGTH($TEXT(@LEXF))
QUIT
DO @LEXF
if $LENGTH(LEXBUILD)
SET LEXOK=1
+4 QUIT
