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

AUMAUTUP.m

Go to the documentation of this file. 
  1. AUMAUTUP ;IHS/OIT/ABK - AUM 10 patch 2 AD-HOC LOAD [ 10/11/2010  9:19 AM ]
  1.  ;;11.0;TABLE MAINTENANCE;**5**;Oct 15,2010
  1.  ;
  1. QUIT ; This routine should not be called at the top.  
  1.  ;
  1. PARTIAL ;This tag sets a variable to prevent the deactivation of all
  1.  ; existing topics like we do when we do a full update.  This is in
  1.  ; affect a partial update.
  1.  S APART=1
  1.  ;
  1. START ; 
  1.  ; First check to ensure AUMPCLN exists
  1.  N TOTCNT,AUMERR,TOTNEW,TOTUPD,TOTINACT,TMNMISS,AUMSKIP
  1.  S (TOTCNT,AUMERR,TOTNEW,TOTUPD,TOTINACT,TMNMISS,AUMSKIP)=0
  1.  I $D(^AUMPCLN)=0 D
  1.  .D BMES^XPDUTL("Source Global ^AUMPCLN does not exist, quitting.") ; Quit if no AUMPCLN
  1.  .Q
  1.  E  D
  1.  .D UPD
  1.  .Q
  1.  Q
  1. UPD ;
  1.  S AUMERR=0
  1.  D KILL^AUMUP102,POST^AUMUP102
  1.  ; Copy the target global AUTTEDT to a save global AUTTEDTSAV
  1.  D GCPY("AUTTEDT","AUTTEDTSAV")
  1.  ;
  1.  ; Inactivate all existing topics in AUTTEDT
  1.  I $G(APART)'=1 D
  1.  .W !,"Deactivating Topics",!
  1.  .D START^AUMP1012
  1.  .Q
  1.  ;
  1.  ; Clean target global from all control characters
  1.  W !,"Cleaning Target Global",!
  1.  D CLEAN("AUTTEDT","")
  1.  ;
  1.  W !,"Running Update",!
  1.  D START^AUMUP102
  1.  Q
  1.  ;
  1. T(TAG) QUIT $P($T(@TAG),";;",2)
  1.  ;
  1. MSG ; messages to display
  1.  ;; nodes in 
  1.  ;; were scanned. 
  1.  ;; instances of control characters were found and removed, 
  1.  ;; of them from node names, 
  1.  ;; from values. 
  1.  ;; Copying global 
  1.  ;; to  
  1.  ;; Removing control characters from 
  1.  ;; nodes were copied 
  1.  ;; from 
  1.  ;
  1. CLEAN(SRC,TAR) ; private, strip ctl chars out of a GLOBAL
  1.  ;
  1.  ; .SRC = input GLOBAL
  1.  ; .TAR = output GLOBAL; IF Null, replace data into same global
  1.  ;
  1.  ; traverse loop backward so our insertions do not throw off our position
  1.  ; within AUMMAP. Replacing one control character with _$C(#)_ expands
  1.  ; the value of AUMMAP, shifting all the character positions & throwing
  1.  ; off its positional mapping to AUMSTR; we work from the end of the
  1.  ; string forward so that the loss of correspondence happens in the part
  1.  ; of AUMMAP we have already looked at.
  1.  ;
  1.  S GLB="^"_SRC,INPLACE=0
  1.  D BMES^XPDUTL($$T("MSG+8")_GLB) ; removing control characters from ...
  1.  I (TAR="") S TAR=SRC,INPLACE=1
  1.  S TGLB="^"_TAR
  1.  S CNTC=0 ; how many nodes had control characters
  1.  S CNTN=0 ; how many node names had control characters
  1.  ;
  1.  F CNT=1:1 D  S GLB=$Q(@GLB) Q:GLB=""
  1.  .S VALU=$G(@GLB) ; fetch value of node
  1.  .S BADN=0 ; is it a bad name
  1.  .S BADV=0 ; is it a bad value
  1.  .S CLN=GLB ; save cleaned up name in CLN
  1.  .K X F X=1:1:$L(VALU) S Y=$E(VALU,X) I ($A(Y)<32)!($A(Y)>126) S BADV=1 Q
  1.  .K X F X=1:1:$L(GLB) S Y=$E(GLB,X) I ($A(Y)<32)!($A(Y)>126) S BADN=1 Q
  1.  .Q:('BADN&'BADV)&(INPLACE=1)  ; skip good nodes
  1.  .S MAPN=GLB
  1.  .S MAPV=VALU
  1.  .I BADN D  ; if the node name contains a control character
  1.  ..S CNTC=CNTC+1,CNTN=CNTN+1 ; add to both counts
  1.  ..D CLNSTR(.CLN) ; strip out the control characters
  1.  .;
  1.  .I BADV D  ; if the node value contains a control character
  1.  ..S CNTC=CNTC+1 ; add to our count of instances
  1.  ..D CLNSTR(.VALU) ; strip out the control characters
  1.  .I CNT>1 S TNODE=TGLB_"("_$P($P(CLN,"(",2,99),")",1,99)
  1.  .I CNT=1 S TNODE=TGLB
  1.  .S @TNODE=VALU
  1.  .Q
  1.  D BMES^XPDUTL(CNT-1_$$T("MSG+1")_SRC_$$T("MSG+2")) ; # nodes in ^SRC were scanned.
  1.  D MES^XPDUTL(CNTC_$$T("MSG+3")) ; # instances of control charact...
  1.  ; # of them from node names, # from values.
  1.  D MES^XPDUTL(CNTN_$$T("MSG+4")_(CNTC-CNTN)_$$T("MSG+5"))
  1.  Q
  1.  ;
  1. CLNSTR(AUMSTR) ; private, strip ctl chars out of a string
  1.  ;
  1.  ; .AUMSTR = input & output: string to clear of control characters
  1.  ;
  1.  N AUMPOS ; each position
  1.  F AUMPOS=$L(AUMSTR):-1:1 D:($A($E(AUMSTR,AUMPOS))<32)!($A($E(AUMSTR,AUMPOS))>126)
  1.  .N AUMCHAR S AUMCHAR=$E(AUMSTR,AUMPOS) ; cpy it
  1.  .N AUMASCI S AUMASCI=$A(AUMCHAR) ; get its ASCII code
  1.  .; replace control chars that have standard ASCII equivalents
  1.  .N AUMREPL
  1.  .S AUMREPL=$TR(AUMCHAR,$C(28,145,146,147,148,150,151),"C''""""--")
  1.  .; if no replacement, delete it
  1.  .I ($A($E(AUMSTR,AUMPOS))<32)!($A($E(AUMSTR,AUMPOS))>126) S AUMREPL=""
  1.  .S $E(AUMSTR,AUMPOS)=AUMREPL ; replace the ctl char
  1.  Q
  1. GCPY(SRC,TARG) ; global copy to save target before we modify it
  1.  ;
  1.  ; .SRC  = input  GLOBAL
  1.  ; .TARG = output GLOBAL
  1.  ;
  1.  S GLB="^"_SRC,TGLB="^"_TARG
  1.  D BMES^XPDUTL($$T("MSG+6")_GLB_$$T("MSG+7")_TGLB) ; copying global from to
  1.  F CNT=1:1 D  S GLB=$Q(@GLB) Q:GLB=""
  1.  .S VALU=$G(@GLB) ; fetch value of node
  1.  .S CLN=GLB ; save cleaned up name in CLN
  1.  .I CNT>1 S TNODE=TGLB_"("_$P($P(CLN,"(",2,99),")",1,99)
  1.  .I CNT=1 S TNODE=TGLB
  1.  .S @TNODE=VALU
  1.  .Q
  1.  D MES^XPDUTL(CNT_$$T("MSG+9")_$$T("MSG+10")_SRC_$$T("MSG+7")_TARG) ; nodes were copied from to
  1.  Q