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