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

PRC46PT.m

Go to the documentation of this file.
  1. PRC46PT ;WIRMFO/DHH-CLEAN UP FILE 410.1 ;1/17/02 11:01 AM
  1. V ;;5.1;IFCAP;**46**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ;
  1. QUIT Q
  1. ;
  1. CLEAN ;
  1. ; clean up file 410.1
  1. ; if entry is no longer in 442 then delete 1358 entry in 410.1
  1. ;
  1. D MES^XPDUTL(">>>Starting clean up of file 410.1.<<<")
  1. D MES^XPDUTL(" ")
  1. N PAT
  1. S PAT="" F S PAT=$O(^PRCS(410.1,"B",PAT)) Q:PAT="" D
  1. . ;check for pattern match X?3N1"-"6AN
  1. . Q:'(PAT?3N1"-"6AN)
  1. . ;check to see if transaction exists in 442
  1. . Q:$D(^PRC(442,"B",PAT))
  1. . N DA
  1. . S DA=$O(^PRCS(410.1,"B",PAT,0))
  1. . Q:'$D(^PRCS(410.1,DA,0))
  1. . D MES^XPDUTL(" >>>Deleting entry - "_PAT)
  1. . S DIK="^PRCS(410.1," D ^DIK
  1. . K DIK,X
  1. D MES^XPDUTL(" ")
  1. D MES^XPDUTL(">>>Clean up of file 410.1 COMPLETED.")
  1. Q