MCPOS01.m

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

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