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

AUMPRESU.m

Go to the documentation of this file. 
  1. AUMPRESU ;IHS/VEN/TOAD - AUM v 10.1 ;
  1.  ;;10.1;TABLE MAINTENANCE;**1**;OCT 16, 2009
  1.  ;
  1.  ; This is the pre-init for AUM*9.1*4. It strips all control chars
  1.  ; out of the ^AUTTSU global prior to the install of the patch.
  1.  ;
  1.  ; 2008 04 18-20 Rick Marshall created this routine from scratch to
  1.  ; clear out control characters found in the ^AICD globals in both
  1.  ; values and subscripts.
  1.  ;
  1.  QUIT  ; This routine should not be called at the top or anywhere
  1.  ; else. It is only to be called at CLEANALL by KIDS as the pre-init
  1.  ; for AUM patches.
  1.  ;
  1. CHECK ; troubleshooting entry point
  1.  ;
  1.  N AUMNAME S AUMNAME="^AUTTSU" ; the name value of each node of ^AUTTSU
  1.  N AUMCNTC S AUMCNTC=0 ; how many nodes had control characters
  1.  N AUMCNTN S AUMCNTN=0 ; how many node names had control characters
  1.  ;
  1.  N AUMCNT ; count nodes
  1.  F AUMCNT=1:1 D  S AUMNAME=$Q(@AUMNAME) Q:AUMNAME=""  ; walk ^AUTTSU
  1.  . ;
  1.  . I '(AUMCNT#1000) W "." ; indicate progress
  1.  . ;
  1.  . I AUMNAME?.E1C.E D  ; if the node name contains a control char
  1.  . . S AUMCNTC=AUMCNTC+1,AUMCNTN=AUMCNTN+1 ; add to both counts
  1.  . . W "@",AUMCNT,"@",$C(7) ; note presence of control characters
  1.  . . W !,AUMNAME ; write node name
  1.  . ;
  1.  . N AUMVALU S AUMVALU=$G(@AUMNAME) ; fetch value of node
  1.  . ;
  1.  . I AUMVALU?.E1C.E D  ; if the node value contains a control char
  1.  . . S AUMCNTC=AUMCNTC+1 ; add to our count of instances
  1.  . . W "=",AUMCNT,"=",$C(7) ; note presence of control characters
  1.  . . W !,AUMVALU ; write node name
  1.  ;
  1.  W !!,"Number of nodes in global: ",AUMCNT
  1.  W !!,"Number of nodes with control characters: ",AUMCNTC
  1.  W !!,"Number of node names with control characters: ",AUMCNTN
  1.  QUIT  ; end of CHECK
  1.  ;
  1.  ;
  1. CLEANALL ; AUM*10.1 PRE-INIT: Remove Control Characters from ^AUTTSU
  1.  ;
  1.  D BMES^XPDUTL($$T("MSG+9")) ; AUM*10.1 PRE-INIT
  1.  D MES^XPDUTL($$T("MSG+8")) ; Removing control character from your ...
  1.  ;
  1.  K ^TMP("AUM",$J) ; clear scratch space
  1.  ;
  1.  N AUMNAME S AUMNAME="^AUTTSU" ; the name value of each node of ^AUTTSU
  1.  N AUMCNTC S AUMCNTC=0 ; how many nodes had control characters
  1.  N AUMCNTN S AUMCNTN=0 ; how many node names had control characters
  1.  ;
  1.  N AUMCNT ; count nodes, walk ^AUTTSU
  1.  F AUMCNT=1:1 D  S AUMNAME=$Q(@AUMNAME) Q:AUMNAME=""
  1.  . ;
  1.  . I '(AUMCNT#1000) W "." ; indicate progress
  1.  . ;
  1.  . N AUMVALU S AUMVALU=$G(@AUMNAME) ; fetch value of node
  1.  . N AUMBADN S AUMBADN=AUMNAME?.E1C.E ; is it a bad name
  1.  . N AUMBADV S AUMBADV=AUMVALU?.E1C.E ; is it a bad value
  1.  . Q:'AUMBADN&'AUMBADV  ; skip good nodes
  1.  . ;
  1.  . ; for output, show where control characters were
  1.  . N AUMMAPN S AUMMAPN=AUMNAME
  1.  . N AUMMAPV S AUMMAPV=AUMVALU
  1.  . ;
  1.  . N AUMCLN S AUMCLN=AUMNAME ; save cleaned up name in AUMCLN
  1.  . I AUMBADN D  ; if the node name contains a control character
  1.  . . S AUMCNTC=AUMCNTC+1,AUMCNTN=AUMCNTN+1 ; add to both counts
  1.  . . W AUMCNT,$C(7),": bad name" ; note presence of control chars
  1.  . . D CLEAN(.AUMCLN,.AUMMAPN,1) ; strip out the control characters
  1.  . ;
  1.  . I AUMBADV D  ; if the node value contains a control character
  1.  . . S AUMCNTC=AUMCNTC+1 ; add to our count of instances
  1.  . . W AUMCNT,$C(7),": bad value" ; note presence of control chars
  1.  . . D CLEAN(.AUMVALU,.AUMMAPV,0) ; strip out the control characters
  1.  . ;
  1.  . D MES^XPDUTL(AUMMAPN_"="_AUMMAPV_"...") ; show the problem (safely)
  1.  . ;
  1.  . I AUMBADV,'AUMBADN S @AUMNAME=AUMVALU Q  ; good name but bad value
  1.  . ;
  1.  . ; what we wish we could do here is just kill the node and replace it
  1.  . ; but we would need the Millennium standard's KVALUE, which can kill
  1.  . ; just a node. We are stuck with KILL, which kills the entire tree
  1.  . ; and so would interfere with nodes we have not yet scanned and saved
  1.  . ; off. So, we have to separate the killing from the scanning & saving.
  1.  . ; For now we copy our cleaned up names and values out to ^TMP.
  1.  . N AUMEMP S AUMEMP=AUMCLN ; change name from ^AUTTSU(*)
  1.  . ;S $E(AUMEMP,1,9)="^TMP(""AUM"","_$J_"," ; to ^TMP("AUM",$J,*)
  1.  . S $E(AUMEMP,1,8)="^TMP(""AUM"","_$J_"," ; to ^TMP("AUM",$J,*)
  1.  . ;IHS/OIT/CLS 09/17/2008 change to equal length of global root ^AUTTSU(
  1.  . ; W AUMCLN,"  ==>  ",AUMEMP ; debugging code
  1.  . S @AUMEMP=AUMVALU ; save off the cleaned up node to ^TMP
  1.  . S @AUMEMP@(U)=AUMNAME ; save off bad name with ctl chars
  1.  ;
  1.  I AUMCNTN D BMES^XPDUTL($$T("MSG+7")) ; Replacing the bad node ...
  1.  ;
  1.  S AUMNAME=$NA(^TMP("AUM",$J)) ; now we will traverse our saved nodes
  1.  N AUMLENG S AUMLENG=$L(AUMNAME) ; get the length of the prefix
  1.  N AUMPRE S AUMPRE=$E(AUMNAME,1,AUMLENG-1) ; & grab that prefix
  1.  ; walk ^TMP("AUM",$J), exit when name no longer starts with prefix
  1.  F  S AUMNAME=$Q(@AUMNAME) Q:$P(AUMNAME,AUMPRE)'=""!(AUMNAME="")  D
  1.  . N AUTTSU S AUTTSU=AUMNAME,$E(AUTTSU,1,AUMLENG)="^AUTTSU(" ; change back
  1.  . K @(@AUMNAME@(U)) ; delete node in ^AUTTSU whose bad name we saved off
  1.  . N AUMVALU S AUMVALU=@AUMNAME ; get the saved, clean value
  1.  . S @AUTTSU=AUMVALU ; copy cleaned up node back into ^AUTTSU
  1.  . N AUMSUB S AUMSUB=$QS(AUMNAME,3) ; get the main subscript
  1.  . K @AUMNAME@(U) ; delete the saved node name to avoid it
  1.  . D MES^XPDUTL(AUTTSU_"="_AUMVALU) ; report nodes as we copy them back
  1.  K ^TMP("AUM",$J) ; clean up rest of temp space
  1.  ;
  1.  D BMES^XPDUTL(AUMCNT-1_$$T("MSG+1")) ; # nodes in ^AUTTSU were scanned.
  1.  D MES^XPDUTL(AUMCNTC_$$T("MSG+2")) ; # instances of control charact...
  1.  ; # of them from node names, # from values.
  1.  D MES^XPDUTL(AUMCNTN_$$T("MSG+3")_(AUMCNTC-AUMCNTN)_$$T("MSG+4"))
  1.  ; Your ^AUTTSU global is [now] free of control characters.
  1.  D BMES^XPDUTL($$T("MSG+5")_$S(AUMCNTC:"now ",1:"")_$$T("MSG+6"))
  1.  ;
  1.  QUIT  ; end of CLEANALL
  1.  ;
  1.  ;
  1. T(TAG) QUIT $P($T(@TAG),";;",2)
  1.  ;
  1.  ;
  1. MSG ; messages to display
  1.  ;; nodes in ^AUTTSU were scanned.
  1.  ;; instances of control characters were found and removed,
  1.  ;; of them from node names, 
  1.  ;; from values.
  1.  ;;Your ^AUTTSU global is 
  1.  ;;free of control characters.
  1.  ;;Replacing the bad node names found in ^AUTTSU
  1.  ;;Removing control characters from your ^AUTTSU global...
  1.  ;;AUM*10.1 PRE-INIT
  1.  ;
  1.  ;
  1. CLEAN(AUMSTR,AUMMAP,AUMNAME) ; private, strip ctl chars out of a string
  1.  ;
  1.  ; .AUMSTR = input & output: string to clear of control characters
  1.  ; .AUMMAP = output: display version of AUMSTR
  1.  ; AUMNAME = 1 if this is a name, else 0, affects quotation marks
  1.  ;
  1.  ; code useful another time, but not here
  1.  ; N AUMCHAR
  1.  ; 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)
  1.  ; S AUMCHAR=AUMCHAR_$C(22,23,24,25,26,27,28,29,30,31,127)
  1.  ; S AUMSTR=$TR(AUMSTR,AUMCHAR) ; strip out standard ASCII ctl chars
  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 AUMNAME=+$G(AUMNAME) ; default to not a name
  1.  S AUMMAP=AUMSTR ; create copy to highlight the control characters
  1.  N AUMPOS ; each position
  1.  F AUMPOS=$L(AUMSTR):-1:1 D:$E(AUMSTR,AUMPOS)?1C  ; for each ctl char
  1.  . N AUMCHAR S AUMCHAR=$E(AUMSTR,AUMPOS) ; copy 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.  . I AUMNAME,AUMASCI=147!(AUMASCI=148) S AUMREPL="""""" ; dbl for nm
  1.  . ; I AUMASCI=153 S AUMREPL="(TM)" ; cutting legal text
  1.  . I AUMREPL?1C S AUMREPL="" ; if no replacement, delete it
  1.  . S $E(AUMSTR,AUMPOS)=AUMREPL ; replace the ctl char
  1.  . S $E(AUMMAP,AUMPOS)="_$C("_AUMASCI_")_" ; highlight it in AUMMAP
  1.  ;
  1.  QUIT  ; end of CLEAN
  1.  ;
  1.  ;
  1.  ; end of routine AUMPRESU