- 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 Apr 23, 2025@18:19:10 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
