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

ACPT28P1.m

Go to the documentation of this file. 
  1. ACPT28P1 ;IHS/VEN/TOAD - ACPT*2.08*1 pre-init ; 04/21/2008 00:29
  1.  ;;2.09;CPT FILES;;JAN 2, 2009
  1.  ;
  1.  ; This is the pre-init for ACPT*2.08*1. It strips all control chars
  1.  ; out of the ^ICPT 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 ^ICPT global 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 ACPT*2.08*1.
  1.  ;
  1. CHECK ; troubleshooting entry point
  1.  ;
  1.  N ACPTNAME S ACPTNAME="^ICPT" ; the name value of each node of ^ICPT
  1.  N ACPTCNTC S ACPTCNTC=0 ; how many nodes had control characters
  1.  N ACPTCNTN S ACPTCNTN=0 ; how many node names had control characters
  1.  ;
  1.  N ACPTCNT ; count nodes
  1.  F ACPTCNT=1:1 D  S ACPTNAME=$Q(@ACPTNAME) Q:ACPTNAME=""  ; walk ^ICPT
  1.  . ;
  1.  . I '(ACPTCNT#1000) W "." ; indicate progress
  1.  . ;
  1.  . I ACPTNAME?.E1C.E D  ; if the node name contains a control char
  1.  . . S ACPTCNTC=ACPTCNTC+1,ACPTCNTN=ACPTCNTN+1 ; add to both counts
  1.  . . W "@",ACPTCNT,"@",$C(7) ; note presence of control characters
  1.  . . W !,ACPTNAME ; write node name
  1.  . ;
  1.  . N ACPTVALU S ACPTVALU=$G(@ACPTNAME) ; fetch value of node
  1.  . ;
  1.  . I ACPTVALU?.E1C.E D  ; if the node value contains a control char
  1.  . . S ACPTCNTC=ACPTCNTC+1 ; add to our count of instances
  1.  . . W "=",ACPTCNT,"=",$C(7) ; note presence of control characters
  1.  . . W !,ACPTVALU ; write node name
  1.  ;
  1.  QUIT  ; end of CHECK
  1.  ;
  1.  ;
  1. CLEANALL ; ACPT*2.08*1 PRE-INIT: Remove Control Characters from ^ICPT
  1.  ;
  1.  D BMES^XPDUTL($$T("MSG+9")) ; ACPT*2.08*1 PRE-INIT
  1.  D MES^XPDUTL($$T("MSG+8")) ; Removing control character from your ...
  1.  ;
  1.  K ^TMP("ACPT",$J) ; clear scratch space
  1.  ;
  1.  N ACPTNAME S ACPTNAME="^ICPT" ; the name value of each node of ^ICPT
  1.  N ACPTCNTC S ACPTCNTC=0 ; how many nodes had control characters
  1.  N ACPTCNTN S ACPTCNTN=0 ; how many node names had control characters
  1.  ;
  1.  N ACPTCNT ; count nodes, walk ^ICPT
  1.  F ACPTCNT=1:1 D  S ACPTNAME=$Q(@ACPTNAME) Q:ACPTNAME=""
  1.  . ;
  1.  . I '(ACPTCNT#1000) W "." ; indicate progress
  1.  . ;
  1.  . N ACPTVALU S ACPTVALU=$G(@ACPTNAME) ; fetch value of node
  1.  . N ACPTBADN S ACPTBADN=ACPTNAME?.E1C.E ; is it a bad name
  1.  . N ACPTBADV S ACPTBADV=ACPTVALU?.E1C.E ; is it a bad value
  1.  . Q:'ACPTBADN&'ACPTBADV  ; skip good nodes
  1.  . ;
  1.  . ; for output, show where control characters were
  1.  . N ACPTMAPN S ACPTMAPN=ACPTNAME
  1.  . N ACPTMAPV S ACPTMAPV=ACPTVALU
  1.  . ;
  1.  . N ACPTCLN S ACPTCLN=ACPTNAME ; save cleaned up name in ACPTCLN
  1.  . I ACPTBADN D  ; if the node name contains a control character
  1.  . . S ACPTCNTC=ACPTCNTC+1,ACPTCNTN=ACPTCNTN+1 ; add to both counts
  1.  . . W ACPTCNT,$C(7),": bad name" ; note presence of control chars
  1.  . . D CLEAN(.ACPTCLN,.ACPTMAPN,1) ; strip out the control characters
  1.  . ;
  1.  . I ACPTBADV D  ; if the node value contains a control character
  1.  . . S ACPTCNTC=ACPTCNTC+1 ; add to our count of instances
  1.  . . W ACPTCNT,$C(7),": bad value" ; note presence of control chars
  1.  . . D CLEAN(.ACPTVALU,.ACPTMAPV,0) ; strip out the control characters
  1.  . ;
  1.  . D MES^XPDUTL(ACPTMAPN_"="_ACPTMAPV_"...") ; show the problem (safely)
  1.  . ;
  1.  . I ACPTBADV,'ACPTBADN S @ACPTNAME=ACPTVALU 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 ACPTEMP S ACPTEMP=ACPTCLN ; change name from ^ICPT(*)
  1.  . S $E(ACPTEMP,1,6)="^TMP(""ACPT"","_$J_"," ; to ^TMP("ACPT",$J,*)
  1.  . ; W ACPTCLN,"  ==>  ",ACPTEMP ; debugging code
  1.  . S @ACPTEMP=ACPTVALU ; save off the cleaned up node to ^TMP
  1.  . S @ACPTEMP@(U)=ACPTNAME ; save off bad name with ctl chars
  1.  ;
  1.  I ACPTCNTN D BMES^XPDUTL($$T("MSG+7")) ; Replacing the bad node ...
  1.  ;
  1.  S ACPTNAME=$NA(^TMP("ACPT",$J)) ; now we will traverse our saved nodes
  1.  N ACPTLENG S ACPTLENG=$L(ACPTNAME) ; get the length of the prefix
  1.  N ACPTPRE S ACPTPRE=$E(ACPTNAME,1,ACPTLENG-1) ; & grab that prefix
  1.  ; walk ^TMP("ACPT",$J), exit when name no longer starts with prefix
  1.  F  S ACPTNAME=$Q(@ACPTNAME) Q:$P(ACPTNAME,ACPTPRE)'=""  D
  1.  . N ICPT S ICPT=ACPTNAME,$E(ICPT,1,ACPTLENG)="^ICPT(" ; change back
  1.  . K @(@ACPTNAME@(U)) ; delete node in ^ICPT whose bad name we saved off
  1.  . N ACPTVALU S ACPTVALU=@ACPTNAME ; get the saved, clean value
  1.  . S @ICPT=ACPTVALU ; copy cleaned up node back into ^ICPT
  1.  . N ACPTSUB S ACPTSUB=$QS(ACPTNAME,3) ; get the main subscript
  1.  . K @ACPTNAME@(U) ; delete the saved node name to avoid it
  1.  . D MES^XPDUTL(ICPT_"="_ACPTVALU) ; report nodes as we copy them back
  1.  K ^TMP("ACPT",$J) ; clean up rest of temp space
  1.  ;
  1.  D BMES^XPDUTL(ACPTCNT-1_$$T("MSG+1")) ; # nodes in ^ICPT were scanned.
  1.  D MES^XPDUTL(ACPTCNTC_$$T("MSG+2")) ; # instances of control charact...
  1.  ; # of them from node names, # from values.
  1.  D MES^XPDUTL(ACPTCNTN_$$T("MSG+3")_(ACPTCNTC-ACPTCNTN)_$$T("MSG+4"))
  1.  ; Your ^ICPT global is [now] free of control characters.
  1.  D BMES^XPDUTL($$T("MSG+5")_$S(ACPTCNTC:"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 ^ICPT were scanned.
  1.  ;; instances of control characters were found and removed,
  1.  ;; of them from node names, 
  1.  ;; from values.
  1.  ;;Your ^ICPT global is 
  1.  ;;free of control characters.
  1.  ;;Replacing the bad node names found in ^ICPT
  1.  ;;Removing control characters from your ^ICPT global...
  1.  ;;ACPT*2.08*1 PRE-INIT
  1.  ;
  1.  ;
  1. CLEAN(ACPTSTR,ACPTMAP,ACPTNAME) ; private, strip ctl chars out of a string
  1.  ;
  1.  ; .ACPTSTR = input & output: string to clear of control characters
  1.  ; .ACPTMAP = output: display version of ACPTSTR
  1.  ; ACPTNAME = 1 if this is a name, else 0, affects quotation marks
  1.  ;
  1.  ; code useful another time, but not here
  1.  ; N ACPTCHAR
  1.  ; S ACPTCHAR=$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 ACPTCHAR=ACPTCHAR_$C(22,23,24,25,26,27,28,29,30,31,127)
  1.  ; S ACPTSTR=$TR(ACPTSTR,ACPTCHAR) ; strip out standard ASCII ctl chars
  1.  ;
  1.  ; traverse loop backward so our insertions do not throw off our position
  1.  ; within ACPTMAP. Replacing one control character with _$C(#)_ expands
  1.  ; the value of ACPTMAP, shifting all the character positions & throwing
  1.  ; off its positional mapping to ACPTSTR; we work from the end of the
  1.  ; string forward so that the loss of correspondence happens in the part
  1.  ; of ACPTMAP we have already looked at.
  1.  ;
  1.  S ACPTNAME=+$G(ACPTNAME) ; default to not a name
  1.  S ACPTMAP=ACPTSTR ; create copy to highlight the control characters
  1.  N ACPTPOS ; each position
  1.  F ACPTPOS=$L(ACPTSTR):-1:1 D:$E(ACPTSTR,ACPTPOS)?1C  ; for each ctl char
  1.  . N ACPTCHAR S ACPTCHAR=$E(ACPTSTR,ACPTPOS) ; copy it
  1.  . N ACPTASCI S ACPTASCI=$A(ACPTCHAR) ; get its ASCII code
  1.  . ; replace control chars that have standard ASCII equivalents
  1.  . N ACPTREPL
  1.  . S ACPTREPL=$TR(ACPTCHAR,$C(28,145,146,147,148,150,151),"C''""""--")
  1.  . I ACPTNAME,ACPTASCI=147!(ACPTASCI=148) S ACPTREPL="""""" ; dbl for nm
  1.  . ; I ACPTASCI=153 S ACPTREPL="(TM)" ; cutting legal text
  1.  . I ACPTREPL?1C S ACPTREPL="" ; if no replacement, delete it
  1.  . S $E(ACPTSTR,ACPTPOS)=ACPTREPL ; replace the ctl char
  1.  . S $E(ACPTMAP,ACPTPOS)="_$C("_ACPTASCI_")_" ; highlight it in ACPTMAP
  1.  ;
  1.  QUIT  ; end of CLEAN
  1.  ;
  1.  ;
  1.  ; end of routine ACPT28P1