DG53688A ;ALB/SCK - Patch DG*5.3*688 Pre-Install Utility Routine ; 5 MAR 2007
;;5.3;Registration;**688**;AUG 13, 1993;Build 29
;
START ; Entry point for EVENT^IVMPLOG trigger clean-up
N DGXRF,DGFLD,X,Y,LINE,CNT,DGFILE,DGXNUM,RSLT,MSG
;
; Set start-notice into KIDS build file
D BMES^XPDUTL(">> Starting Index cleanup...")
; Get the file number for the cross-reference clean-up from the file parameters below
S LINE=$P($T(FILE+1),";;",2)
; If unable to determine file to clean-up, post warning and quit
I LINE']"" D BMES^XPDUTL(">> Index cleanup canceled, unable to determine file information") Q
S DGFILE=$P(LINE,";",2)
I DGFILE'>0 D BMES^XPDUTL(">> Index cleanup canceled, No File number specified") Q
;
; Cycle through the cross-references listed in the TEXT section below to remove/cleanup each x-ref.
; For each cross-reference, call $$FIND to get the x-ref number from the DD file
; if a x-ref number is determined, call the REMOVE procedure to delete the cross-reference
;
F CNT=1:1 S LINE=$P($T(TEXT+CNT),";;",2) Q:LINE="DONE" D
. K DGRXF,DGFLD
. S DGXRF=$P(LINE,";"),DGFLD=$P(LINE,";",2)
. S DGXNUM=$$FIND(DGXRF,DGFLD)
. I DGXNUM>0 D REMOVE(DGXRF,DGFLD,DGXNUM)
;
;Set the completion notice into the KIDS build file
D BMES^XPDUTL(">> Index cleanup completed")
Q
;
FIND(DGXRF,DGFLD) ; This procedure will determine the selected x-ref's number from the DD file
; and return the number to the calling procedure
; Input
; DGXRF - Name of the cross-reference
; DGFLD - DD Field the cross-reference is stored on
; Output
; DGNUM - The number of the cross-reference
;
N XX,DGDONE,DGNUM
;
S XX=0
F S XX=$O(^DD(DGFILE,DGFLD,1,XX)) Q:'XX D Q:$G(DGDONE)
. I $P(^DD(DGFILE,DGFLD,1,XX,0),U,2)=DGXRF S DGNUM=XX,DGDONE=1
;
Q $G(DGNUM)
;
REMOVE(DGXRF,DGFLD,DGXNUM) ; The procedure will delete the cross-reference from the Data Dictionary
; Input
; DGXRF - Name of the cross-reference
; DGFLD - DD Field number the cross-reference is stored on
; DGXNUM - The cross-reference number
;
N DGOUT,DGERR,DGTEXT,DGX,DGCNT,DGNAME,MSG
;
S DGNAME=$P($G(^DD(DGFILE,DGFLD,0)),U,1)
S MSG=">> Removing the "_DGXRF_" cross-reference, #"_DGXNUM_", from the "_DGNAME_" field, #"_DGFLD
D BMES^XPDUTL(MSG)
;
D DELIX^DDMOD(DGFILE,DGFLD,DGXNUM,"","DGOUT","DGERR")
;
; If the output array is populated, pull the template information from the array and add it to the
; message array to posted into the KIDS results
I $D(DGOUT) D
. S DGX=0,DGCNT=100
. F S DGX=$O(DGOUT("DIEZ",DGX)) Q:'DGX D
. . S DGTEXT(DGCNT)=" Input Template "_$P($G(^DGOUT("DIEZ",DGX)),U,1)_" was recompiled in "_$P($G(^DGOUT("DIEZ",DGX)),U,3)
. . S DGCNT=DGCNT+1
;
; If an error occurred, post the error array into the KIDS results for display
; otherwise post a success message
I $D(DGERR) D
. M DGTEXT=DGERR
E D
. S DGTEXT(1)=" Cross-Reference "_DGXRF_" Successfully removed."
D MES^XPDUTL(.DGTEXT)
Q
;
FILE ; Data Dictionary containing the cross-references to be cleaned-up
;;PATIENT;2
;
TEXT ; Cross-reference ID;Field Number
;;AENR99101;991.01
;;AENR99103;991.03
;;AENR01;.01
;;AENR03;.03
;;AENR02;.02
;;AENR09;.09
;;DONE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG53688A 3287 printed Apr 09, 2024@21:56:24 Page 2
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
+2 ;
START ; Entry point for EVENT^IVMPLOG trigger clean-up
+1 NEW DGXRF,DGFLD,X,Y,LINE,CNT,DGFILE,DGXNUM,RSLT,MSG
+2 ;
+3 ; Set start-notice into KIDS build file
+4 DO BMES^XPDUTL(">> Starting Index cleanup...")
+5 ; Get the file number for the cross-reference clean-up from the file parameters below
+6 SET LINE=$PIECE($TEXT(FILE+1),";;",2)
+7 ; If unable to determine file to clean-up, post warning and quit
+8 IF LINE']""
DO BMES^XPDUTL(">> Index cleanup canceled, unable to determine file information")
QUIT
+9 SET DGFILE=$PIECE(LINE,";",2)
+10 IF DGFILE'>0
DO BMES^XPDUTL(">> Index cleanup canceled, No File number specified")
QUIT
+11 ;
+12 ; Cycle through the cross-references listed in the TEXT section below to remove/cleanup each x-ref.
+13 ; For each cross-reference, call $$FIND to get the x-ref number from the DD file
+14 ; if a x-ref number is determined, call the REMOVE procedure to delete the cross-reference
+15 ;
+16 FOR CNT=1:1
SET LINE=$PIECE($TEXT(TEXT+CNT),";;",2)
if LINE="DONE"
QUIT
Begin DoDot:1
+17 KILL DGRXF,DGFLD
+18 SET DGXRF=$PIECE(LINE,";")
SET DGFLD=$PIECE(LINE,";",2)
+19 SET DGXNUM=$$FIND(DGXRF,DGFLD)
+20 IF DGXNUM>0
DO REMOVE(DGXRF,DGFLD,DGXNUM)
End DoDot:1
+21 ;
+22 ;Set the completion notice into the KIDS build file
+23 DO BMES^XPDUTL(">> Index cleanup completed")
+24 QUIT
+25 ;
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
+2 ; Input
+3 ; DGXRF - Name of the cross-reference
+4 ; DGFLD - DD Field the cross-reference is stored on
+5 ; Output
+6 ; DGNUM - The number of the cross-reference
+7 ;
+8 NEW XX,DGDONE,DGNUM
+9 ;
+10 SET XX=0
+11 FOR
SET XX=$ORDER(^DD(DGFILE,DGFLD,1,XX))
if 'XX
QUIT
Begin DoDot:1
+12 IF $PIECE(^DD(DGFILE,DGFLD,1,XX,0),U,2)=DGXRF
SET DGNUM=XX
SET DGDONE=1
End DoDot:1
if $GET(DGDONE)
QUIT
+13 ;
+14 QUIT $GET(DGNUM)
+15 ;
REMOVE(DGXRF,DGFLD,DGXNUM) ; The procedure will delete the cross-reference from the Data Dictionary
+1 ; Input
+2 ; DGXRF - Name of the cross-reference
+3 ; DGFLD - DD Field number the cross-reference is stored on
+4 ; DGXNUM - The cross-reference number
+5 ;
+6 NEW DGOUT,DGERR,DGTEXT,DGX,DGCNT,DGNAME,MSG
+7 ;
+8 SET DGNAME=$PIECE($GET(^DD(DGFILE,DGFLD,0)),U,1)
+9 SET MSG=">> Removing the "_DGXRF_" cross-reference, #"_DGXNUM_", from the "_DGNAME_" field, #"_DGFLD
+10 DO BMES^XPDUTL(MSG)
+11 ;
+12 DO DELIX^DDMOD(DGFILE,DGFLD,DGXNUM,"","DGOUT","DGERR")
+13 ;
+14 ; If the output array is populated, pull the template information from the array and add it to the
+15 ; message array to posted into the KIDS results
+16 IF $DATA(DGOUT)
Begin DoDot:1
+17 SET DGX=0
SET DGCNT=100
+18 FOR
SET DGX=$ORDER(DGOUT("DIEZ",DGX))
if 'DGX
QUIT
Begin DoDot:2
+19 SET DGTEXT(DGCNT)=" Input Template "_$PIECE($GET(^DGOUT("DIEZ",DGX)),U,1)_" was recompiled in "_$PIECE($GET(^DGOUT("DIEZ",DGX)),U,3)
+20 SET DGCNT=DGCNT+1
End DoDot:2
End DoDot:1
+21 ;
+22 ; If an error occurred, post the error array into the KIDS results for display
+23 ; otherwise post a success message
+24 IF $DATA(DGERR)
Begin DoDot:1
+25 MERGE DGTEXT=DGERR
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 SET DGTEXT(1)=" Cross-Reference "_DGXRF_" Successfully removed."
End DoDot:1
+28 DO MES^XPDUTL(.DGTEXT)
+29 QUIT
+30 ;
FILE ; Data Dictionary containing the cross-references to be cleaned-up
+1 ;;PATIENT;2
+2 ;
TEXT ; Cross-reference ID;Field Number
+1 ;;AENR99101;991.01
+2 ;;AENR99103;991.03
+3 ;;AENR01;.01
+4 ;;AENR03;.03
+5 ;;AENR02;.02
+6 ;;AENR09;.09
+7 ;;DONE
