Changeset 636 for FOIAVistA/tag/r/LEXICON_UTILITY-LEX-GMPT/LEXXGI2.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• LEXICON_UTILITY-LEX-GMPT/LEXXGI2.m (modified) (4 diffs)

FOIAVistA/tag/r/LEXICON_UTILITY-LEX-GMPT/LEXXGI2.m

@@ -1 @@
-LEXXGI2 ;ISL/KER - Global Import (Update Change File w/^LEXM) ;06/06/2007
- ;;2.0;LEXICON UTILITY;**25,26,28,29,46,49,50**;Sep 23, 1996
+LEXXGI2 ; ISL/KER - Global Import (Update Change File w/^LEXM)  ; 02/22/2007
+ ;;2.0;LEXICON UTILITY;**25,26,28,29,46,49**;Sep 23, 1996;Build 3
  ;             
- ; Variables NEWed or KILLed Elsewhere
- ;    XPDNM  NEWed by KIDS during Install
- ;              
  ; Global Variables
- ;    ^LEXM
- ;    DBIA   872  ^ORD(101
- ;    DBIA 10011  ^UTILITY($J
- ;              
+ ;   ^LEXM(
+ ;   DBIA 10011  ^UTILITY($J
+ ;             
  ; External References
- ;    DBIA  10011  ^DIWP
- ;    DBIA 10103  $$FMDIFF^XLFDT
- ;    DBIA 10103  $$NOW^XLFDT
- ;    DBIA 10141  BMES^XPDUTL 
- ;    DBIA 10141  MES^XPDUTL
- ;    DBIA 10101  EN^XQOR
- ;              
+ ;   DBIA 10011  ^DIWP
+ ;   DBIA 10103  $$NOW^XLFDT
+ ;   DBIA 10103  $$FMDIFF^XLFDT
+ ;   DBIA 10141  BMES^XPDUTL
+ ;   DBIA 10141  MES^XPDUTL
+ ;             
+ ; XPDNM   Newed by KIDS during Install
  Q
 NOTIFY ; Notify by Protocol - LEXICAL SERVICES UPDATE
  ;     Uses LEXSCHG() from the Post-Install
  ;     Sets ^LEXM(0,"PRO")=$$NOW^XLFDT
+ W !!,"NOTIFY^LEXXGI1",!
  N X,LEXU,LEXT,LEXF,LEXI,LEXL,LEX1,LEX2,LEX3,LEXN,LEXP,LEXUP D:$O(LEXSCHG(0))'>0 SCHG
  S LEXUP="" S:$D(LEXSCHG("C","ICD"))!($D(LEXSCHG(80)))!($D(LEXSCHG(80.1))) LEXUP=$G(LEXUP)_"ICD"
@@ -52 +49 @@
  Q
 UPCHG ;
- Q:+($G(LEXFI))'>0  N LEXID S LEXID=$S($P(LEXFI,".",1)="757":"LEX",$P(LEXFI,".",1)="80":"ICD",$P(LEXFI,".",1)="81":"CPT",1:"UNK")
+ Q:+LEXFI'>0  N LEXID S LEXID=$S($P(LEXFI,".",1)="757":"LEX",$P(LEXFI,".",1)="80":"ICD",$P(LEXFI,".",1)="81":"CPT",1:"UNK")
  I $D(LEXSCHG) S LEXSCHG(LEXFI,0)="",LEXSCHG("B",LEXFI)="",LEXSCHG("C",LEXID,LEXFI)=""
  Q
@@ -79 +76 @@
  S (LEXSCHG("757.1",0),LEXSCHG("B","757.1"),LEXSCHG("C","LEX","757.1"))=""
  Q
-CS ;   Checksum for import global
- N LEXCHK,LEXNDS,LEXVER S LEXCHK=+($G(^LEXM(0,"CHECKSUM")))
- W !,"   Running checksum routine on the ^LEXM import global, please wait"
- S LEXNDS=+($G(^LEXM(0,"NODES"))),LEXVER=+($$VC(LEXCHK,LEXNDS)) W !
- W:LEXVER>0 !,"     Checksum is ok",! Q:LEXVER>0
- I LEXVER=0 W !!,"   Import global ^LEXM is missing.  Please obtain a copy of ^LEXM before",!,"   continuing." Q
- I LEXVER<0 D  Q
- . I LEXVER'=-3 W !,"   Unable to verify checksum for import global ^LEXM (possibly corrupt)"
- . I LEXVER=-3 W !,"   Import global ^LEXM failed checksum"
- . W !!,"     Please KILL the existing import global ^LEXM from your system and"
- . W !,"     obtain a new copy of ^LEXM before continuing with the installation."
- Q
-VC(X,Y) ;   Verify Checksum for import global
- Q:'$D(^LEXM)!('$D(^LEXM(0)))!($O(^LEXM(0))'>0) 0  N LEXCHK,LEXNDS,LEXCNT,LEXLC,LEXL,LEXS,LEXNC,LEXD,LEXN,LEXC,LEXGCS,LEXP,LEXT
- S LEXCHK=+($G(X)),LEXNDS=+($G(Y)) Q:LEXCHK'>0!(LEXNDS'>0) -2  S LEXL=64,(LEXCNT,LEXLC)=0,LEXS=(+(LEXNDS\LEXL))
- S:LEXS=0 LEXS=1 W:+($O(^LEXM(0)))>0 ! S (LEXC,LEXN)="^LEXM",(LEXNC,LEXGCS)=0 W "   "
- F  S LEXN=$Q(@LEXN) Q:LEXN=""!(LEXN'[LEXC)  D
- . Q:LEXN="^LEXM(0,""CHECKSUM"")"  Q:LEXN="^LEXM(0,""NODES"")"  S LEXCNT=LEXCNT+1
- . I LEXCNT'<LEXS S LEXLC=LEXLC+1 W:LEXLC'>LEXL "." S LEXCNT=0
- . S LEXNC=LEXNC+1,LEXD=@LEXN,LEXT=LEXN_"="_LEXD F LEXP=1:1:$L(LEXT) S LEXGCS=$A(LEXT,LEXP)*LEXP+LEXGCS
- Q:LEXNC'=LEXNDS -3  Q:LEXGCS'=LEXCHK -3
- Q 1
  ; Miscellaneous
 NF ;   Import Global Not Found
@@ -157 +132 @@
  K ^UTILITY($J,"W")
  Q
-CLR ;   Clear
- K %,%DT,C,CT,D,D0,D1,D2,DA,DG,DIC,DICR,DILOCKTM,DIW,DIWF,DIWI,DIWL,DIWR,DIWT,DIWTC,DIWX,DN,DTOUT
- K DUOUT,END,FI,I,ID,IREC,J,L,LENGTH,LEX,LEX1,LEX2,LEX3,LEXB,LEXBUILD,LEXC,LEXCD,LEXCHG,LEXCHK,LEXCNT
- K LEXD,LEXE,LEXF,LEXFI,LEXFY,LEXGCS,LEXI,LEXID,LEXIGHF,LEXL,LEXLAST,LEXLC,LEXLREV,LEXN,LEXNC,LEXNDS,LEXP
- K LEXPTYPE,LEXQTR,LEXREQP,LEXS,LEXSCHG,LEXSTR,LEXT,LEXU,LEXUP,LEXVER,LEXX,TI,X,X1,X2,XMDUN,XMZ,Y,Z,ZTSK
- Q
 TRIM(X) ;   Trim Spaces
  S X=$G(X) Q:X="" X F  Q:$E(X,1)'=" "  S X=$E(X,2,$L(X))