AUMPREDC ;IHS/VEN/TOAD - AUM v 10.1 ;
;;10.1;TABLE MAINTENANCE;**1**;OCT 16, 2009
;
; This is the pre-init for AUM*9.1*4. It strips all control chars
; out of the ^DIC global prior to the install of the patch.
;
; 2008 04 18-20 Rick Marshall created this routine from scratch to
; clear out control characters found in the ^AICD globals in both
; values and subscripts.
;
QUIT ; This routine should not be called at the top or anywhere
; else. It is only to be called at CLEANALL by KIDS as the pre-init
; for AUM patches.
;
CHECK ; troubleshooting entry point
;
N AUMNAME S AUMNAME="^DIC" ; the name value of each node of ^DIC
N AUMCNTC S AUMCNTC=0 ; how many nodes had control characters
N AUMCNTN S AUMCNTN=0 ; how many node names had control characters
;
N AUMCNT ; count nodes
F AUMCNT=1:1 D S AUMNAME=$Q(@AUMNAME) Q:AUMNAME="" ; walk ^DIC
. ;
. I '(AUMCNT#1000) W "." ; indicate progress
. ;
. I AUMNAME?.E1C.E D ; if the node name contains a control char
. . S AUMCNTC=AUMCNTC+1,AUMCNTN=AUMCNTN+1 ; add to both counts
. . W "@",AUMCNT,"@",$C(7) ; note presence of control characters
. . W !,AUMNAME ; write node name
. ;
. N AUMVALU S AUMVALU=$G(@AUMNAME) ; fetch value of node
. ;
. I AUMVALU?.E1C.E D ; if the node value contains a control char
. . S AUMCNTC=AUMCNTC+1 ; add to our count of instances
. . W "=",AUMCNT,"=",$C(7) ; note presence of control characters
. . W !,AUMVALU ; write node name
;
W !!,"Number of nodes in global: ",AUMCNT
W !!,"Number of nodes with control characters: ",AUMCNTC
W !!,"Number of node names with control characters: ",AUMCNTN
QUIT ; end of CHECK
;
;
CLEANALL ; AUM*10.1 PRE-INIT: Remove Control Characters from ^DIC
;
D BMES^XPDUTL($$T("MSG+9")) ; AUM*10.1 PRE-INIT
D MES^XPDUTL($$T("MSG+8")) ; Removing control character from your ...
;
K ^TMP("AUM",$J) ; clear scratch space
;
N AUMNAME S AUMNAME="^DIC" ; the name value of each node of ^DIC
N AUMCNTC S AUMCNTC=0 ; how many nodes had control characters
N AUMCNTN S AUMCNTN=0 ; how many node names had control characters
;
N AUMCNT ; count nodes, walk ^DIC
F AUMCNT=1:1 D S AUMNAME=$Q(@AUMNAME) Q:AUMNAME=""
. ;
. I '(AUMCNT#1000) W "." ; indicate progress
. ;
. ;N AUMVALU S AUMVALU=$G(@AUMNAME) ; fetch value of node
. N AUMVALU S AUMVALU=$G(@AUMNAME) ; fetch value of node
. ;IHS/OIT/CLS 09/25/2008
. N AUMBADN S AUMBADN=AUMNAME?.E1C.E ; is it a bad name
. N AUMBADV S AUMBADV=AUMVALU?.E1C.E ; is it a bad value
. Q:'AUMBADN&'AUMBADV ; skip good nodes
. ;
. ; for output, show where control characters were
. N AUMMAPN S AUMMAPN=AUMNAME
. N AUMMAPV S AUMMAPV=AUMVALU
. ;
. N AUMCLN S AUMCLN=AUMNAME ; save cleaned up name in AUMCLN
. I AUMBADN D ; if the node name contains a control character
. . S AUMCNTC=AUMCNTC+1,AUMCNTN=AUMCNTN+1 ; add to both counts
. . W AUMCNT,$C(7),": bad name" ; note presence of control chars
. . D CLEAN(.AUMCLN,.AUMMAPN,1) ; strip out the control characters
. ;
. I AUMBADV D ; if the node value contains a control character
. . S AUMCNTC=AUMCNTC+1 ; add to our count of instances
. . W AUMCNT,$C(7),": bad value" ; note presence of control chars
. . D CLEAN(.AUMVALU,.AUMMAPV,0) ; strip out the control characters
. ;
. D MES^XPDUTL(AUMMAPN_"="_AUMMAPV_"...") ; show the problem (safely)
. ;
. I AUMBADV,'AUMBADN S @AUMNAME=AUMVALU Q ; good name but bad value
. ;
. ; what we wish we could do here is just kill the node and replace it
. ; but we would need the Millennium standard's KVALUE, which can kill
. ; just a node. We are stuck with KILL, which kills the entire tree
. ; and so would interfere with nodes we have not yet scanned and saved
. ; off. So, we have to separate the killing from the scanning & saving.
. ; For now we copy our cleaned up names and values out to ^TMP.
. N AUMEMP S AUMEMP=AUMCLN ; change name from ^DIC(*)
. ;S $E(AUMEMP,1,9)="^TMP(""AUM"","_$J_"," ; to ^TMP("AUM",$J,*)
. S $E(AUMEMP,1,5)="^TMP(""AUM"","_$J_"," ; to ^TMP("AUM",$J,*)
. ;IHS/OIT/CLS 09/17/2008 change to equal length of global root ^DIC(
. ; W AUMCLN," ==> ",AUMEMP ; debugging code
. S @AUMEMP=AUMVALU ; save off the cleaned up node to ^TMP
. S @AUMEMP@(U)=AUMNAME ; save off bad name with ctl chars
;
I AUMCNTN D BMES^XPDUTL($$T("MSG+7")) ; Replacing the bad node ...
;
S AUMNAME=$NA(^TMP("AUM",$J)) ; now we will traverse our saved nodes
N AUMLENG S AUMLENG=$L(AUMNAME) ; get the length of the prefix
N AUMPRE S AUMPRE=$E(AUMNAME,1,AUMLENG-1) ; & grab that prefix
; walk ^TMP("AUM",$J), exit when name no longer starts with prefix
F S AUMNAME=$Q(@AUMNAME) Q:$P(AUMNAME,AUMPRE)'=""!(AUMNAME="") D
. N AUTTST S AUTTST=AUMNAME,$E(AUTTST,1,AUMLENG)="^DIC(" ; change back
. K @(@AUMNAME@(U)) ; delete node in ^DIC whose bad name we saved off
. N AUMVALU S AUMVALU=@AUMNAME ; get the saved, clean value
. S AUTTST=AUMVALU ; copy cleaned up node back into ^DIC
. N AUMSUB S AUMSUB=$QS(AUMNAME,3) ; get the main subscript
. K @AUMNAME@(U) ; delete the saved node name to avoid it
. D MES^XPDUTL(AUTTST_"="_AUMVALU) ; report nodes as we copy them back
K ^TMP("AUM",$J) ; clean up rest of temp space
;
D BMES^XPDUTL(AUMCNT-1_$$T("MSG+1")) ; # nodes in ^DIC were scanned.
D MES^XPDUTL(AUMCNTC_$$T("MSG+2")) ; # instances of control charact...
; # of them from node names, # from values.
D MES^XPDUTL(AUMCNTN_$$T("MSG+3")_(AUMCNTC-AUMCNTN)_$$T("MSG+4"))
; Your ^DIC global is [now] free of control characters.
D BMES^XPDUTL($$T("MSG+5")_$S(AUMCNTC:"now ",1:"")_$$T("MSG+6"))
;
QUIT ; end of CLEANALL
;
;
T(TAG) QUIT $P($T(@TAG),";;",2)
;
;
MSG ; messages to display
;; nodes in ^DIC were scanned.
;; instances of control characters were found and removed,
;; of them from node names,
;; from values.
;;Your ^DIC global is
;;free of control characters.
;;Replacing the bad node names found in ^DIC
;;Removing control characters from your ^DIC global...
;;AUM*10.1 PRE-INIT
;
;
CLEAN(AUMSTR,AUMMAP,AUMNAME) ; private, strip ctl chars out of a string
;
; .AUMSTR = input & output: string to clear of control characters
; .AUMMAP = output: display version of AUMSTR
; AUMNAME = 1 if this is a name, else 0, affects quotation marks
;
; code useful another time, but not here
; N AUMCHAR
; S AUMCHAR=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21)
; S AUMCHAR=AUMCHAR_$C(22,23,24,25,26,27,28,29,30,31,127)
; S AUMSTR=$TR(AUMSTR,AUMCHAR) ; strip out standard ASCII ctl chars
;
; 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 AUMNAME=+$G(AUMNAME) ; default to not a name
S AUMMAP=AUMSTR ; create copy to highlight the control characters
N AUMPOS ; each position
F AUMPOS=$L(AUMSTR):-1:1 D:$E(AUMSTR,AUMPOS)?1C ; for each ctl char
. N AUMCHAR S AUMCHAR=$E(AUMSTR,AUMPOS) ; copy 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''""""--")
. I AUMNAME,AUMASCI=147!(AUMASCI=148) S AUMREPL="""""" ; dbl for nm
. ; I AUMASCI=153 S AUMREPL="(TM)" ; cutting legal text
. I AUMREPL?1C S AUMREPL="" ; if no replacement, delete it
. S $E(AUMSTR,AUMPOS)=AUMREPL ; replace the ctl char
. S $E(AUMMAP,AUMPOS)="_$C("_AUMASCI_")_" ; highlight it in AUMMAP
;
QUIT ; end of CLEAN
;
;
; end of routine AUMPREDC
AUMPREDC ;IHS/VEN/TOAD - AUM v 10.1 ;
+1 ;;10.1;TABLE MAINTENANCE;**1**;OCT 16, 2009
+2 ;
+3 ; This is the pre-init for AUM*9.1*4. It strips all control chars
+4 ; out of the ^DIC global prior to the install of the patch.
+5 ;
+6 ; 2008 04 18-20 Rick Marshall created this routine from scratch to
+7 ; clear out control characters found in the ^AICD globals in both
+8 ; values and subscripts.
+9 ;
+10 ; This routine should not be called at the top or anywhere
QUIT
+11 ; else. It is only to be called at CLEANALL by KIDS as the pre-init
+12 ; for AUM patches.
+13 ;
CHECK ; troubleshooting entry point
+1 ;
+2 ; the name value of each node of ^DIC
NEW AUMNAME
SET AUMNAME="^DIC"
+3 ; how many nodes had control characters
NEW AUMCNTC
SET AUMCNTC=0
+4 ; how many node names had control characters
NEW AUMCNTN
SET AUMCNTN=0
+5 ;
+6 ; count nodes
NEW AUMCNT
+7 ; walk ^DIC
FOR AUMCNT=1:1
Begin DoDot:1
+8 ;
+9 ; indicate progress
IF '(AUMCNT#1000)
WRITE "."
+10 ;
+11 ; if the node name contains a control char
IF AUMNAME?.E1C.E
Begin DoDot:2
+12 ; add to both counts
SET AUMCNTC=AUMCNTC+1
SET AUMCNTN=AUMCNTN+1
+13 ; note presence of control characters
WRITE "@",AUMCNT,"@",$CHAR(7)
+14 ; write node name
WRITE !,AUMNAME
End DoDot:2
+15 ;
+16 ; fetch value of node
NEW AUMVALU
SET AUMVALU=$GET(@AUMNAME)
+17 ;
+18 ; if the node value contains a control char
IF AUMVALU?.E1C.E
Begin DoDot:2
+19 ; add to our count of instances
SET AUMCNTC=AUMCNTC+1
+20 ; note presence of control characters
WRITE "=",AUMCNT,"=",$CHAR(7)
+21 ; write node name
WRITE !,AUMVALU
End DoDot:2
End DoDot:1
SET AUMNAME=$QUERY(@AUMNAME)
IF AUMNAME=""
QUIT
+22 ;
+23 WRITE !!,"Number of nodes in global: ",AUMCNT
+24 WRITE !!,"Number of nodes with control characters: ",AUMCNTC
+25 WRITE !!,"Number of node names with control characters: ",AUMCNTN
+26 ; end of CHECK
QUIT
+27 ;
+28 ;
CLEANALL ; AUM*10.1 PRE-INIT: Remove Control Characters from ^DIC
+1 ;
+2 ; AUM*10.1 PRE-INIT
DO BMES^XPDUTL($$T("MSG+9"))
+3 ; Removing control character from your ...
DO MES^XPDUTL($$T("MSG+8"))
+4 ;
+5 ; clear scratch space
KILL ^TMP("AUM",$JOB)
+6 ;
+7 ; the name value of each node of ^DIC
NEW AUMNAME
SET AUMNAME="^DIC"
+8 ; how many nodes had control characters
NEW AUMCNTC
SET AUMCNTC=0
+9 ; how many node names had control characters
NEW AUMCNTN
SET AUMCNTN=0
+10 ;
+11 ; count nodes, walk ^DIC
NEW AUMCNT
+12 FOR AUMCNT=1:1
Begin DoDot:1
+13 ;
+14 ; indicate progress
IF '(AUMCNT#1000)
WRITE "."
+15 ;
+16 ;N AUMVALU S AUMVALU=$G(@AUMNAME) ; fetch value of node
+17 ; fetch value of node
NEW AUMVALU
SET AUMVALU=$GET(@AUMNAME)
+18 ;IHS/OIT/CLS 09/25/2008
+19 ; is it a bad name
NEW AUMBADN
SET AUMBADN=AUMNAME?.E1C.E
+20 ; is it a bad value
NEW AUMBADV
SET AUMBADV=AUMVALU?.E1C.E
+21 ; skip good nodes
IF 'AUMBADN&'AUMBADV
QUIT
+22 ;
+23 ; for output, show where control characters were
+24 NEW AUMMAPN
SET AUMMAPN=AUMNAME
+25 NEW AUMMAPV
SET AUMMAPV=AUMVALU
+26 ;
+27 ; save cleaned up name in AUMCLN
NEW AUMCLN
SET AUMCLN=AUMNAME
+28 ; if the node name contains a control character
IF AUMBADN
Begin DoDot:2
+29 ; add to both counts
SET AUMCNTC=AUMCNTC+1
SET AUMCNTN=AUMCNTN+1
+30 ; note presence of control chars
WRITE AUMCNT,$CHAR(7),": bad name"
+31 ; strip out the control characters
DO CLEAN(.AUMCLN,.AUMMAPN,1)
End DoDot:2
+32 ;
+33 ; if the node value contains a control character
IF AUMBADV
Begin DoDot:2
+34 ; add to our count of instances
SET AUMCNTC=AUMCNTC+1
+35 ; note presence of control chars
WRITE AUMCNT,$CHAR(7),": bad value"
+36 ; strip out the control characters
DO CLEAN(.AUMVALU,.AUMMAPV,0)
End DoDot:2
+37 ;
+38 ; show the problem (safely)
DO MES^XPDUTL(AUMMAPN_"="_AUMMAPV_"...")
+39 ;
+40 ; good name but bad value
IF AUMBADV
IF 'AUMBADN
SET @AUMNAME=AUMVALU
QUIT
+41 ;
+42 ; what we wish we could do here is just kill the node and replace it
+43 ; but we would need the Millennium standard's KVALUE, which can kill
+44 ; just a node. We are stuck with KILL, which kills the entire tree
+45 ; and so would interfere with nodes we have not yet scanned and saved
+46 ; off. So, we have to separate the killing from the scanning & saving.
+47 ; For now we copy our cleaned up names and values out to ^TMP.
+48 ; change name from ^DIC(*)
NEW AUMEMP
SET AUMEMP=AUMCLN
+49 ;S $E(AUMEMP,1,9)="^TMP(""AUM"","_$J_"," ; to ^TMP("AUM",$J,*)
+50 ; to ^TMP("AUM",$J,*)
SET $EXTRACT(AUMEMP,1,5)="^TMP(""AUM"","_$JOB_","
+51 ;IHS/OIT/CLS 09/17/2008 change to equal length of global root ^DIC(
+52 ; W AUMCLN," ==> ",AUMEMP ; debugging code
+53 ; save off the cleaned up node to ^TMP
SET @AUMEMP=AUMVALU
+54 ; save off bad name with ctl chars
SET @AUMEMP@(U)=AUMNAME
End DoDot:1
SET AUMNAME=$QUERY(@AUMNAME)
IF AUMNAME=""
QUIT
+55 ;
+56 ; Replacing the bad node ...
IF AUMCNTN
DO BMES^XPDUTL($$T("MSG+7"))
+57 ;
+58 ; now we will traverse our saved nodes
SET AUMNAME=$NAME(^TMP("AUM",$JOB))
+59 ; get the length of the prefix
NEW AUMLENG
SET AUMLENG=$LENGTH(AUMNAME)
+60 ; & grab that prefix
NEW AUMPRE
SET AUMPRE=$EXTRACT(AUMNAME,1,AUMLENG-1)
+61 ; walk ^TMP("AUM",$J), exit when name no longer starts with prefix
+62 FOR
SET AUMNAME=$QUERY(@AUMNAME)
IF $PIECE(AUMNAME,AUMPRE)'=""!(AUMNAME="")
QUIT
Begin DoDot:1
+63 ; change back
NEW AUTTST
SET AUTTST=AUMNAME
SET $EXTRACT(AUTTST,1,AUMLENG)="^DIC("
+64 ; delete node in ^DIC whose bad name we saved off
KILL @(@AUMNAME@(U))
+65 ; get the saved, clean value
NEW AUMVALU
SET AUMVALU=@AUMNAME
+66 ; copy cleaned up node back into ^DIC
SET AUTTST=AUMVALU
+67 ; get the main subscript
NEW AUMSUB
SET AUMSUB=$QSUBSCRIPT(AUMNAME,3)
+68 ; delete the saved node name to avoid it
KILL @AUMNAME@(U)
+69 ; report nodes as we copy them back
DO MES^XPDUTL(AUTTST_"="_AUMVALU)
End DoDot:1
+70 ; clean up rest of temp space
KILL ^TMP("AUM",$JOB)
+71 ;
+72 ; # nodes in ^DIC were scanned.
DO BMES^XPDUTL(AUMCNT-1_$$T("MSG+1"))
+73 ; # instances of control charact...
DO MES^XPDUTL(AUMCNTC_$$T("MSG+2"))
+74 ; # of them from node names, # from values.
+75 DO MES^XPDUTL(AUMCNTN_$$T("MSG+3")_(AUMCNTC-AUMCNTN)_$$T("MSG+4"))
+76 ; Your ^DIC global is [now] free of control characters.
+77 DO BMES^XPDUTL($$T("MSG+5")_$SELECT(AUMCNTC:"now ",1:"")_$$T("MSG+6"))
+78 ;
+79 ; end of CLEANALL
QUIT
+80 ;
+81 ;
T(TAG) QUIT $PIECE($TEXT(@TAG),";;",2)
+1 ;
+2 ;
MSG ; messages to display
+1 ;; nodes in ^DIC were scanned.
+2 ;; instances of control characters were found and removed,
+3 ;; of them from node names,
+4 ;; from values.
+5 ;;Your ^DIC global is
+6 ;;free of control characters.
+7 ;;Replacing the bad node names found in ^DIC
+8 ;;Removing control characters from your ^DIC global...
+9 ;;AUM*10.1 PRE-INIT
+10 ;
+11 ;
CLEAN(AUMSTR,AUMMAP,AUMNAME) ; private, strip ctl chars out of a string
+1 ;
+2 ; .AUMSTR = input & output: string to clear of control characters
+3 ; .AUMMAP = output: display version of AUMSTR
+4 ; AUMNAME = 1 if this is a name, else 0, affects quotation marks
+5 ;
+6 ; code useful another time, but not here
+7 ; N AUMCHAR
+8 ; S AUMCHAR=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21)
+9 ; S AUMCHAR=AUMCHAR_$C(22,23,24,25,26,27,28,29,30,31,127)
+10 ; S AUMSTR=$TR(AUMSTR,AUMCHAR) ; strip out standard ASCII ctl chars
+11 ;
+12 ; traverse loop backward so our insertions do not throw off our position
+13 ; within AUMMAP. Replacing one control character with _$C(#)_ expands
+14 ; the value of AUMMAP, shifting all the character positions & throwing
+15 ; off its positional mapping to AUMSTR; we work from the end of the
+16 ; string forward so that the loss of correspondence happens in the part
+17 ; of AUMMAP we have already looked at.
+18 ;
+19 ; default to not a name
SET AUMNAME=+$GET(AUMNAME)
+20 ; create copy to highlight the control characters
SET AUMMAP=AUMSTR
+21 ; each position
NEW AUMPOS
+22 ; for each ctl char
FOR AUMPOS=$LENGTH(AUMSTR):-1:1
IF $EXTRACT(AUMSTR,AUMPOS)?1C
Begin DoDot:1
+23 ; copy it
NEW AUMCHAR
SET AUMCHAR=$EXTRACT(AUMSTR,AUMPOS)
+24 ; get its ASCII code
NEW AUMASCI
SET AUMASCI=$ASCII(AUMCHAR)
+25 ; replace control chars that have standard ASCII equivalents
+26 NEW AUMREPL
+27 SET AUMREPL=$TRANSLATE(AUMCHAR,$CHAR(28,145,146,147,148,150,151),"C''""""--")
+28 ; dbl for nm
IF AUMNAME
IF AUMASCI=147!(AUMASCI=148)
SET AUMREPL=""""""
+29 ; I AUMASCI=153 S AUMREPL="(TM)" ; cutting legal text
+30 ; if no replacement, delete it
IF AUMREPL?1C
SET AUMREPL=""
+31 ; replace the ctl char
SET $EXTRACT(AUMSTR,AUMPOS)=AUMREPL
+32 ; highlight it in AUMMAP
SET $EXTRACT(AUMMAP,AUMPOS)="_$C("_AUMASCI_")_"
End DoDot:1
+33 ;
+34 ; end of CLEAN
QUIT
+35 ;
+36 ;
+37 ; end of routine AUMPREDC
