Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LEX2073P

LEX2073P.m

Go to the documentation of this file. 
  1. LEX2073P ;ISL/KER - LEX*2.0*73 Pre/Post Install ;01/03/2011
  1.  ;;2.0;LEXICON UTILITY;**73**;Sep 23, 1996;Build 10
  1.  ;               
  1.  ; Global Variables
  1.  ;    ^%ZOSF("PROD")      ICR  10096
  1.  ;    ^%ZOSF("UCI")       ICR  10096
  1.  ;    ^ORD(101,           ICR    872
  1.  ;    ^TMP("LEXKID")      SACC 2.3.2.5.1
  1.  ;               
  1.  ; External References
  1.  ;    $$GET1^DIQ          ICR   2056
  1.  ;    $$FMTE^XLFDT        ICR  10103
  1.  ;    $$NOW^XLFDT         ICR  10103
  1.  ;    BMES^XPDUTL         ICR  10141
  1.  ;    MES^XPDUTL          ICR  10141
  1.  ;    EN^XQOR             ICR  10101
  1.  ;               
  1.  ; Deletion of Unversioned Fields Patch Numbers
  1.  ;               
  1.  ;   LEX*2.0*73   
  1.  ;     ICPT*6.0*46   
  1.  ;     ICD*18.0*40   
  1.  ;
  1.  Q
  1. PRE ; LEX*2.0*73 Pre-Install
  1.  Q
  1. POST ; LEX*2.0*73 Post-Install
  1.  N LEX1,LEX2,LEX3,LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXDUZ,LEXFI,LEXH,LEXI,LEXID,LEXIN,LEXNM,LEXP,LEXPH,LEXPRO,LEXS
  1.  N LEXSCHG,LEXT,LEXU,LEXUSR,X,Y D CON,POST^LEX2073A,INS
  1.  Q
  1.  ;             
  1. INS ; Install Message
  1.  K ^TMP("LEXKID",$J),LEXSCHG N LEXA,LEXAC,LEXAO,LEXB,LEXBUILD,LEXH,LEXIN,LEXPRO,LEXS,LEXT,LEXU
  1.  S LEXBUILD="LEX*2.0*73",LEXPRO=$$NOT,LEXS="LEX*2.0*73 Installation" H 2 D BL,TL((" "_LEXS)),TL(" ======================="),BL
  1.  S LEXAO="   As of:       "_$$ED($$NOW^XLFDT) D TL(LEXAO) S LEXAC=""
  1.  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:"")
  1.  S:$L($P(LEXA,"^",2)) LEXAC=LEXAC_"  "_$P(LEXA,"^",2) D TL(LEXAC) S LEXU=$$USR
  1.  S:$L($P(LEXU,"^",1)) LEXU="   Maint By:    "_$P(LEXU,"^",1)_"   "_$P(LEXU,"^",2) D TL(LEXU)
  1.  S LEXB="   Build:       "_LEXBUILD D TL(LEXB) S LEXIN=$P($G(LEXPRO),"^",1) I LEXIN>0 D
  1.  . S LEXT="   Protocol:    "_"LEXICAL SERVICES UPDATE" D BL,TL(LEXT) S LEXT="   Invoked:     "_$$ED(LEXIN) D TL(LEXT),BL
  1.  D:+($G(^TMP("LEXKID",$J,0)))>0 MAIL^LEX2073 K ^TMP("LEXKID",$J)
  1.  Q
  1. NOT(X) ; Notify by Protocol
  1.  N LEXIN,LEXFI,LEXID,LEXP,Y K LEXSCHG S LEXFI=0,LEXIN="",LEXSCHG("LEX")=""
  1.  S LEXP=+($O(^ORD(101,"B","LEXICAL SERVICES UPDATE",0))) Q:LEXP=0 ""  S X=LEXP_";ORD(101," D EN^XQOR
  1.  S:$P($G(LEXSCHG("LEX")),".",1)?7N LEXIN=$G(LEXSCHG("LEX"))
  1.  D:+LEXIN>0 BMES^XPDUTL(("  Protocol 'LEXICAL SERVICES UPDATE' invoked  "_$$ED(LEXIN))),MES^XPDUTL(" ") S X=LEXIN
  1.  Q X
  1.  ;            
  1.  ; Miscellaneous
  1. ED(X) ;   External Date
  1.  N Y S Y=$$FMTE^XLFDT($G(X)) S:Y["@" Y=$P(Y,"@",1)_"  "_$P(Y,"@",2,299) S:$L(Y) X=Y
  1.  Q X
  1. UCI(X) ;   UCI where Lexicon is installed
  1.  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"))
  1.  S:$L(LEX3)&(LEXU=LEX3!(LEX1=LEX3)!(LEX2=LEX3)) LEXP=" (Production)" S:'$L(LEXP) LEXP=" (Test)"
  1.  S:$L(LEX1)>5&($L(LEX2)>5)&(LEX1=LEX2) LEXU=LEX1 S X="",$P(X,"^",1)=LEXU,$P(X,"^",2)=LEXP
  1.  Q X
  1. USR(X) ;   User/Person Installing
  1.  N LEXDUZ,LEXUSR,LEXPH,LEXNM S LEXDUZ=+($G(DUZ)) Q:+LEXDUZ'>0 "UNKNOWN^"  S LEXNM=$$GET1^DIQ(200,+LEXDUZ,.01) Q:'$L(LEXNM) "UNKNOWN^"
  1.  S LEXUSR=LEXDUZ S LEXPH=$$GET1^DIQ(200,+LEXUSR,.132) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXUSR,.131)
  1.  S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXUSR,.133) S:LEXPH="" LEXPH=$$GET1^DIQ(200,+LEXUSR,.134)
  1.  S LEXUSR=$$GET1^DIQ(200,+LEXDUZ,.01),X=LEXUSR_"^"_LEXPH
  1.  Q X
  1. CON ;   Conversion of Data
  1.  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
  1.  . S DA=+IEN,DIK="^LEX(757.33," D IX1^DIK S CT=CT+1 W:(CT#238)'>0 ?4,"."
  1.  Q
  1. BL ;   Blank Line
  1.  D TL(" ")
  1.  Q
  1. TL(X) ;   Text Line
  1.  N LEXI S LEXI=$O(^TMP("LEXKID",$J," "),-1),LEXI=LEXI+1,^TMP("LEXKID",$J,LEXI)=$G(X),^TMP("LEXKID",$J,0)=LEXI
  1.  Q
  1. M(X) ;   Blank/Text
  1.  D MES^XPDUTL($G(X)) Q
  1. BM(X) ;   Blank/Text
  1.  D BMES^XPDUTL($G(X)) Q