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

DG53688A.m

Go to the documentation of this file. 
  1. DG53688A ;ALB/SCK - Patch DG*5.3*688 Pre-Install Utility Routine ; 5 MAR 2007
  1.  ;;5.3;Registration;**688**;AUG 13, 1993;Build 29
  1.  ;
  1. START ; Entry point for EVENT^IVMPLOG trigger clean-up
  1.  N DGXRF,DGFLD,X,Y,LINE,CNT,DGFILE,DGXNUM,RSLT,MSG
  1.  ;
  1.  ; Set start-notice into KIDS build file
  1.  D BMES^XPDUTL(">> Starting Index cleanup...")
  1.  ; Get the file number for the cross-reference clean-up from the file parameters below
  1.  S LINE=$P($T(FILE+1),";;",2)
  1.  ; If unable to determine file to clean-up, post warning and quit
  1.  I LINE']"" D BMES^XPDUTL(">> Index cleanup canceled, unable to determine file information") Q 
  1.  S DGFILE=$P(LINE,";",2)
  1.  I DGFILE'>0 D BMES^XPDUTL(">> Index cleanup canceled, No File number specified") Q
  1.  ;
  1.  ; Cycle through the cross-references listed in the TEXT section below to remove/cleanup each x-ref.
  1.  ; For each cross-reference, call $$FIND to get the x-ref number from the DD file
  1.  ; if a x-ref number is determined, call the REMOVE procedure to delete the cross-reference
  1.  ; 
  1.  F CNT=1:1 S LINE=$P($T(TEXT+CNT),";;",2) Q:LINE="DONE"  D
  1.  . K DGRXF,DGFLD
  1.  . S DGXRF=$P(LINE,";"),DGFLD=$P(LINE,";",2)
  1.  . S DGXNUM=$$FIND(DGXRF,DGFLD)
  1.  . I DGXNUM>0 D REMOVE(DGXRF,DGFLD,DGXNUM)
  1.  ;
  1.  ;Set the completion notice into the KIDS build file
  1.  D BMES^XPDUTL(">> Index cleanup completed")
  1.  Q
  1.  ;
  1. FIND(DGXRF,DGFLD) ; This procedure will determine the selected x-ref's number from the DD file
  1.  ; and return the number to the calling procedure
  1.  ; Input
  1.  ;         DGXRF - Name of the cross-reference
  1.  ;         DGFLD - DD Field the cross-reference is stored on
  1.  ; Output
  1.  ;         DGNUM - The number of the cross-reference
  1.  ; 
  1.  N XX,DGDONE,DGNUM
  1.  ;
  1.  S XX=0
  1.  F  S XX=$O(^DD(DGFILE,DGFLD,1,XX)) Q:'XX  D  Q:$G(DGDONE)
  1.  . I $P(^DD(DGFILE,DGFLD,1,XX,0),U,2)=DGXRF S DGNUM=XX,DGDONE=1
  1.  ;
  1.  Q $G(DGNUM)
  1.  ;
  1. REMOVE(DGXRF,DGFLD,DGXNUM) ; The procedure will delete the cross-reference from the Data Dictionary
  1.  ; Input
  1.  ;    DGXRF   - Name of the cross-reference
  1.  ;    DGFLD   - DD Field number the cross-reference is stored on
  1.  ;    DGXNUM  - The cross-reference number
  1.  ; 
  1.  N DGOUT,DGERR,DGTEXT,DGX,DGCNT,DGNAME,MSG
  1.  ;
  1.  S DGNAME=$P($G(^DD(DGFILE,DGFLD,0)),U,1)
  1.  S MSG=">> Removing the "_DGXRF_" cross-reference, #"_DGXNUM_", from the "_DGNAME_" field, #"_DGFLD
  1.  D BMES^XPDUTL(MSG)
  1.  ;
  1.  D DELIX^DDMOD(DGFILE,DGFLD,DGXNUM,"","DGOUT","DGERR")
  1.  ;
  1.  ; If the output array is populated, pull the template information from the array and add it to the 
  1.  ; message array to posted into the KIDS results
  1.  I $D(DGOUT) D
  1.  . S DGX=0,DGCNT=100
  1.  . F  S DGX=$O(DGOUT("DIEZ",DGX)) Q:'DGX  D
  1.  . . S DGTEXT(DGCNT)="    Input Template "_$P($G(^DGOUT("DIEZ",DGX)),U,1)_" was recompiled in "_$P($G(^DGOUT("DIEZ",DGX)),U,3)
  1.  . . S DGCNT=DGCNT+1
  1.  ;
  1.  ; If an error occurred, post the error array into the KIDS results for display
  1.  ; otherwise post a success message
  1.  I $D(DGERR) D
  1.  . M DGTEXT=DGERR
  1.  E  D
  1.  . S DGTEXT(1)="   Cross-Reference "_DGXRF_" Successfully removed."
  1.  D MES^XPDUTL(.DGTEXT)
  1.  Q
  1.  ;
  1. FILE ; Data Dictionary containing the cross-references to be cleaned-up
  1.  ;;PATIENT;2
  1.  ;
  1. TEXT ; Cross-reference ID;Field Number
  1.  ;;AENR99101;991.01
  1.  ;;AENR99103;991.03
  1.  ;;AENR01;.01
  1.  ;;AENR03;.03
  1.  ;;AENR02;.02
  1.  ;;AENR09;.09
  1.  ;;DONE