MCPOS01 ;HIRMFO/WAA - SEARCH AND DELETE - ;8/6/96 07:25
;;2.3;Medicine;;09/13/1996
;
G EN1^MCPOS01A
;
;====================================================================
;
; This routine will loop through a file and find all the x-references
; for that file and delete them.
;
; This routine is passed the file number of the file to look through.
;
; Input Varables
; MCFN = File number
;
EN1(MCFN) ; Main Entry Point
Q:MCFN<1
N MCTXT,MCNAME,DIK
S MCNAME=$$GET1^DID(MCFN,"","","NAME") ; Get Name of File
S MCTXT(1)=""
S MCTXT(2)="File: "_MCNAME_" ("_MCFN_")"
S MCTXT(3)="Cross references for file "_MCNAME_" have been deleted."
S MCTXT(4)=" Re-indexing file "_MCNAME_"..."
D MES^XPDUTL(.MCTXT) ; Printing message to output device.
K MCTXT
S DIK="^MCAR("_MCFN_","
D IXALL^DIK
D BMES^XPDUTL(" Complete...") ; Printing message to output device.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPOS01 918 printed Oct 16, 2024@18:16:52 Page 2
MCPOS01 ;HIRMFO/WAA - SEARCH AND DELETE - ;8/6/96 07:25
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 GOTO EN1^MCPOS01A
+4 ;
+5 ;====================================================================
+6 ;
+7 ; This routine will loop through a file and find all the x-references
+8 ; for that file and delete them.
+9 ;
+10 ; This routine is passed the file number of the file to look through.
+11 ;
+12 ; Input Varables
+13 ; MCFN = File number
+14 ;
EN1(MCFN) ; Main Entry Point
+1 if MCFN<1
QUIT
+2 NEW MCTXT,MCNAME,DIK
+3 ; Get Name of File
SET MCNAME=$$GET1^DID(MCFN,"","","NAME")
+4 SET MCTXT(1)=""
+5 SET MCTXT(2)="File: "_MCNAME_" ("_MCFN_")"
+6 SET MCTXT(3)="Cross references for file "_MCNAME_" have been deleted."
+7 SET MCTXT(4)=" Re-indexing file "_MCNAME_"..."
+8 ; Printing message to output device.
DO MES^XPDUTL(.MCTXT)
+9 KILL MCTXT
+10 SET DIK="^MCAR("_MCFN_","
+11 DO IXALL^DIK
+12 ; Printing message to output device.
DO BMES^XPDUTL(" Complete...")
+13 QUIT
