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

LEXXFI.m

Go to the documentation of this file.
  1. LEXXFI ;ISL/KER - File Info ;05/23/2017
  1. ;;2.0;LEXICON UTILITY;**32,46,49,41,59,73,80,103**;Sep 23, 1996;Build 2
  1. ;
  1. ; Global Variables
  1. ; ^LEXM(0) N/A
  1. ; ^TMP("LEX*",$J) SACC 2.3.2.5.1
  1. ; ^TMP("LEXCNT") SACC 2.3.2.5.1
  1. ; ^TMP("LEXCS") SACC 2.3.2.5.1
  1. ; ^TMP("LEXI") SACC 2.3.2.5.1
  1. ; ^TMP("LEXINS") SACC 2.3.2.5.1
  1. ; ^TMP("LEXKID") SACC 2.3.2.5.1
  1. ; ^TMP("LEXMSG") SACC 2.3.2.5.1
  1. ;
  1. ; External References
  1. ; $$DTIME^XUP ICR 4409
  1. ; $$DT^XLFDT ICR 10103
  1. ; $$FMTE^XLFDT ICR 10103
  1. ; $$GET1^DIQ ICR 2056
  1. ; $$NOW^XLFDT ICR 10103
  1. ; HOME^%ZIS ICR 10086
  1. ; ^%ZISC ICR 10089
  1. ; ^%ZTLOAD ICR 10063
  1. ; ^XMD ICR 10070
  1. ;
  1. ; Newed by Post-Install LEX20nnP
  1. ; LEXBUILD Build
  1. ; LEXCRE Import Global Creation Date
  1. ; LEXIGHF Import Global Host File
  1. ; LEXLREV Revision
  1. ; LEXREQP Required Patches
  1. ; LEXSHORT Flag for Summary Install Message
  1. ;
  1. ; Newed by Post-Install LEXXGI
  1. ; LEXPROC Protocol Name
  1. ; LEXRES Install Results
  1. ; LEXSTART Install Start Time
  1. ;
  1. ; Other
  1. ; XPDA Newed by KIDS during Install
  1. ; LEXCOUNT Flag Checked $D() and not used
  1. ;
  1. Q
  1. ; Checksums/Counts
  1. EN ; For One or More File(s)
  1. N LEXENV,LEXMET,LEXID
  1. S LEXENV=$$ENV
  1. Q:+LEXENV'>0
  1. S LEXMET=$$MT^LEXXFI7
  1. I '$L(LEXMET) W !!," Checksum Files (One or All) not Selected" Q
  1. I $L($T(@(LEXMET_"^LEXXFI")))>0 W ! D @LEXMET
  1. Q
  1. ONE ; For ONE file
  1. K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
  1. N LEXBEG,LEXELP,LEXEND,LEXFC,LEXFI,LEXLDR,LEXMOD,LEXMUL,LEXNM,LEXTCS
  1. N LEXTND,LEXTT,LEXTXT
  1. S LEXBEG=$$TIC^LEXXFI8,LEXMUL=0,LEXMOD=0
  1. S LEXFI=$$FI^LEXXFI7 I +LEXFI'>0 W !!," Checksum File not Selected" Q
  1. S LEXLDR=$$LDR^LEXXFI8(LEXFI),LEXMOD=LEXMOD+($$MOD^LEXXFI8(LEXFI))
  1. S LEXNM=$$FN^LEXXFI8(LEXFI),LEXTT=" "
  1. W !
  1. D ONE^LEXXFI2(LEXFI),ONE^LEXXFI3(LEXFI),ONE^LEXXFI5(LEXFI)
  1. S LEXEND=$$TIC^LEXXFI8,LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
  1. S:LEXELP="" LEXELP="00:00:00"
  1. I +LEXBEG>0,LEXEND>0,$L(LEXELP) D TIM
  1. K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
  1. Q
  1. ALL ; For ALL files
  1. K ^TMP("LEXCS",$J),^TMP("LEXCNT",$J),^TMP("LEXI",$J),^TMP("LEXMSG",$J)
  1. K ^TMP("LEXINS",$J),^TMP("LEXKID",$J) S:$D(ZTQUEUED) ZTREQ="@"
  1. N LEXBEG,LEXELP,LEXEND,LEXFC,LEXMOD,LEXMUL,LEXTCS,LEXTND,LEXID
  1. S LEXID="LEXKID",LEXBEG=$$TIC^LEXXFI8,LEXMUL=1,(LEXTND,LEXTCS,LEXMOD,LEXFC)=0
  1. D:'$D(LEXPOST) HDR
  1. I '$D(LEXSHORT) D ALL^LEXXFI5,ALL^LEXXFI2,ALL^LEXXFI3
  1. S LEXEND=$$TIC^LEXXFI8 S LEXELP=$$ELAP^LEXXFI8(LEXBEG,LEXEND)
  1. S:LEXELP="" LEXELP="00:00:00"
  1. I +LEXBEG>0,LEXEND>0,$L(LEXELP) D TIM
  1. D:$D(LEXSEND)!($D(LEXPOST)) EN^LEXXII K ^LEXM(0,"PRO") D:$D(ZTQUEUED) MAIL
  1. I '$D(ZTQUEUED) D
  1. . N LEXI S LEXI=0 F S LEXI=$O(^TMP("LEXKID",$J,LEXI)) Q:+LEXI=0 D
  1. . . W !,$E($G(^TMP("LEXKID",$J,LEXI)),1,79)
  1. D KILL
  1. Q
  1. ;
  1. POST ; Entry Point for Post-Install Message
  1. N LEXPOST S LEXPOST=""
  1. ;
  1. SEND ; Send Message
  1. N LEXDESC,LEXENV,LEXP,LEXACCT,LEXPRO,LEXPRON,LEXSEND,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTQUEUED,ZTREQ
  1. S LEXP=0,LEXENV=$$ENV Q:+LEXENV'>0 S LEXSEND="",LEXPRON="LEXICAL SERVICES UPDATE",LEXPRO=$G(^LEXM(0,"PRO"))
  1. S:+LEXPRO>0 LEXPRO=$$FMTE^XLFDT(LEXPRO,"1"),LEXP=1
  1. S LEXACCT=$$U^LEXXFI7 S ZTSAVE("LEXACCT")=""
  1. S ZTRTN="ALL^LEXXFI",ZTSAVE("LEXSEND")="",ZTSAVE("LEXPOST")=""
  1. S:$D(LEXCOUNT) ZTSAVE("LEXCOUNT")=""
  1. I $L($G(LEXPRO)),$L($G(LEXPRON)),+$G(LEXP)>0 S ZTSAVE("LEXPRO")="",ZTSAVE("LEXPRON")=""
  1. S:$D(LEXPROC)&($O(LEXPROC(0))>0) ZTSAVE("LEXPROC(")=""
  1. S:$D(LEXLREV) ZTSAVE("LEXLREV")=""
  1. S:$D(LEXREQP) ZTSAVE("LEXREQP")=""
  1. S:$L($G(LEXSUBH)) ZTSAVE("LEXSUBH")=""
  1. S:$D(LEXPTYPE) ZTSAVE("LEXPTYPE")=""
  1. S:$D(LEXBUILD) ZTSAVE("LEXBUILD")=""
  1. S:$D(LEXSHORT) ZTSAVE("LEXSHORT")=""
  1. S:$D(LEXIGHF) ZTSAVE("LEXIGHF")=""
  1. S:$D(LEXCRE) ZTSAVE("LEXCRE")=""
  1. S:$D(LEXSTART) ZTSAVE("LEXSTART")=""
  1. S:$D(LEXID) ZTSAVE("LEXID")=""
  1. S:$D(LEXRES) ZTSAVE("LEXRES")=""
  1. S:$D(LEXNOTIM) ZTSAVE("LEXNOTIM")=""
  1. S:$D(XPDA) ZTSAVE("XPDA")=""
  1. S (LEXDESC,ZTDESC)="Post-Install File Counts "
  1. S:$D(LEXSHORT) (LEXDESC,ZTDESC)="Post-Install Summary"
  1. S ZTDTH=$H,ZTIO="" D ^%ZTLOAD
  1. I '$D(LEXQUIET) W:+($G(ZTSK))>0 !!," ",LEXDESC,!," Queued Task #",+($G(ZTSK)) W !
  1. N LEXQUIET
  1. Q
  1. MAIL ; Mail global array in message
  1. N DIFROM,LEXPRI,LEXADR,LEXI,LEXM,LEXSUB,XCNP,XMDUZ,XMSCR,XMSUB,XMTEXT,XMY,XMZ
  1. I '$D(LEXSHORT),+$G(^TMP("LEXCS",$J,0))'>0 G MAILQ
  1. K ^TMP("LEXMSG",$J)
  1. S LEXSUB="Lexicon/ICD/CPT Installation"
  1. S:$L($G(LEXBUILD)) LEXSUB=$G(LEXBUILD)_" Installation"
  1. S LEXPRI=$$ADR^LEXXFI8
  1. G:'$L(LEXPRI) MAILQ
  1. S LEXPRI="G.LEXINS@"_LEXPRI
  1. S LEXADR=$$GET1^DIQ(200,+($G(DUZ)),.01)
  1. G:'$L(LEXADR) MAILQ
  1. S U="^",XMSUB="LEX/ICD/CPT File Checksums - "_$$FMTE^XLFDT($$NOW^XLFDT)
  1. S:$D(LEXCOUNT) XMSUB="LEX/ICD/CPT File Checksums/Counts - "_$$FMTE^XLFDT($$NOW^XLFDT)
  1. S:$L($G(LEXBUILD)) XMSUB=$G(LEXBUILD)_" File Checksums"
  1. I $L($G(LEXBUILD)),$D(LEXCOUNT) S XMSUB=$G(LEXBUILD)_" File Checksums/Counts"
  1. S:$D(LEXPOST) XMSUB=LEXSUB
  1. S LEXI=0 F S LEXI=$O(^TMP("LEXKID",$J,LEXI)) Q:+LEXI=0 D
  1. . S LEXM=+($O(^TMP("LEXMSG",$J," "),-1))+1
  1. . S ^TMP("LEXMSG",$J,LEXM,0)=$E($G(^TMP("LEXKID",$J,LEXI)),1,79)
  1. . S ^TMP("LEXMSG",$J,0)=LEXM
  1. K ^TMP("LEXKID",$J)
  1. I '$D(LEXSHORT) S LEXI=0 F S LEXI=$O(^TMP("LEXCS",$J,LEXI)) Q:+LEXI=0 D
  1. . S LEXM=+($O(^TMP("LEXMSG",$J," "),-1))+1
  1. . S ^TMP("LEXMSG",$J,LEXM,0)=$E($G(^TMP("LEXCS",$J,LEXI)),1,79)
  1. . S ^TMP("LEXMSG",$J,0)=LEXM
  1. K ^TMP("LEXCS",$J) G:'$D(^TMP("LEXMSG",$J)) MAILQ G:+($G(^TMP("LEXMSG",$J,0)))'>0 MAILQ
  1. S XMY(LEXPRI)="",XMY(LEXADR)="",XMTEXT="^TMP(""LEXMSG"",$J,",XMDUZ=.5 D ^XMD
  1. MAILQ ; Quit Mail
  1. D KILL
  1. Q
  1. ;
  1. ; Miscellaneous
  1. HDR ; Header
  1. N LEXD,LEXP,LEXN,LEXT,LEXU,LEXA,LEXACT,LEXI,LEXF,LEXMUL S LEXF=0 S LEXACT=$G(LEXACCT),LEXA=""
  1. S:$L($P(LEXACT,"^",1))&($L($P(LEXACT,"^",1))) LEXA=LEXACT
  1. S:'$L($G(LEXA)) LEXA=$$U^LEXXFI7 S LEXU=$$P^LEXXFI7,LEXD=$$A^LEXXFI7 D TT^LEXXFI8("","Status")
  1. S LEXT="" S:$L(LEXD) LEXT=" As of: "_LEXD
  1. I $L(LEXD) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
  1. S LEXT="",LEXI=$S($L($P(LEXA,"^",1)):"[",1:"")_$P(LEXA,"^",1)_$S($L($P(LEXA,"^",2)):"]",1:"")
  1. I $L($P(LEXA,",",1))>3,$L($P(LEXA,"^",2)) S LEXI="["_$P(LEXA,",",1)_"]"
  1. S:$L(LEXI)&($L($P(LEXA,"^",2))) LEXI=LEXI_" "_$P(LEXA,"^",2)
  1. S LEXT="" S:$L(LEXI) LEXT=" In Account: "_LEXI
  1. I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
  1. S LEXN=$P(LEXU,"^",1),LEXP=$P(LEXU,"^",2)
  1. S LEXT="" S:$L(LEXN) LEXT=" Maint By: "
  1. S:$L(LEXN) LEXT=LEXT_LEXN S:$L(LEXP)&($L(LEXN)) LEXT=LEXT_" "_LEXP
  1. I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
  1. S LEXT="" S:$L($G(LEXBUILD)) LEXT=" Build: "_$G(LEXBUILD)
  1. I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
  1. S LEXT="" I $L($G(LEXPRO))&($L($G(LEXPRON))) D
  1. . S LEXT=" Protocol: "_LEXPRON_" invoked "_LEXPRO
  1. . I $L(LEXT) D:+LEXF'>0 BL^LEXXFI8 D TL^LEXXFI8(LEXT) S LEXF=1
  1. D BL^LEXXFI8
  1. Q
  1. TIM ; Time
  1. Q:$D(LEXPOST) Q:+($G(LEXBEG))'>0 Q:+($G(LEXEND))'>0 Q:'$L($G(LEXELP)) Q:$D(LEXNOTIM)
  1. D BL^LEXXFI8,TL^LEXXFI8((" Started: "_$TR($$FMTE^XLFDT(LEXBEG),"@"," ")))
  1. D TL^LEXXFI8((" Finished: "_$TR($$FMTE^XLFDT(LEXEND),"@"," ")))
  1. D TL^LEXXFI8((" Elapsed: "_LEXELP)),BL^LEXXFI8
  1. Q
  1. ENV(X) ; Environment check
  1. N LEXNM D HOME^%ZIS S U="^",DT=$$DT^XLFDT
  1. I +($G(DUZ))'>0 W !!," User (DUZ) not defined",! Q 0
  1. S LEXNM=$$GET1^DIQ(200,+($G(DUZ)),.01)
  1. I '$L(LEXNM) W !!," Invalid User (DUZ) defined",! Q 0
  1. S DTIME=$$DTIME^XUP(+($G(DUZ)))
  1. Q 1
  1. CLR ; Clear ^TMP("LEXCS",$J)
  1. K ^TMP("LEXCS",$J) N LEXBUILD,LEXCOUNT,LEXCRE,LEXIGHF,LEXLREV
  1. N LEXPROC,LEXREQP,LEXRES,LEXSHORT,LEXSTART,XPDA
  1. Q
  1. KILL ; Kill all ^TMP("LEX**"
  1. K ^TMP("LEXCNT",$J),^TMP("LEXCS",$J),^TMP("LEXI",$J)
  1. K ^TMP("LEXINS",$J),^TMP("LEXMSG",$J),^TMP("LEXKID",$J)
  1. Q
  1. ;;
  1. ;;
  1. FILES ;;
  1. ;;;;757
  1. ;;1;;757.001
  1. ;;1;;757.01
  1. ;;;;757.011
  1. ;;;;757.014
  1. ;;;;757.02
  1. ;;;;757.03
  1. ;;1;;757.04
  1. ;;1;;757.05
  1. ;;1;;757.06
  1. ;;;;757.1
  1. ;;;;757.11
  1. ;;;;757.12
  1. ;;;;757.13
  1. ;;;;757.14
  1. ;;1;;757.2
  1. ;;1;;757.21
  1. ;;;;757.3
  1. ;;;;757.31
  1. ;;1;;757.4
  1. ;;1;;757.41
  1. ;;;;80
  1. ;;;;80.1
  1. ;;;;80.3
  1. ;;;;81
  1. ;;;;81.1
  1. ;;1;;81.2
  1. ;;;;81.3
  1. ;;
  1. ;;
  1. ;;
  1. Q