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

LA7PURG.m

Go to the documentation of this file. 
  1. LA7PURG ;DALOI/JMC - Purge Lab Messaging Interface Messages ;05/07/10  14:13
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,64,74**;Sep 27, 1994;Build 229
  1.  ;
  1.  ; This routine purges messages and checks file intregrity for Lab Messaging.
  1.  Q
  1.  ;
  1.  ;
  1. EN ; Entry point from taskman
  1.  D DQ^LA7CHKF
  1.  D PURGE,PSM,PLPO
  1.  S X=$$LACHK^LA7CHKF
  1.  Q
  1.  ;
  1.  ;
  1. PURGE ; purge messages previous to today
  1.  N DA,DIK,I,LA7CFG,LA7DA,LA7DAT,LA7ROOT,LA7Q,X,Y
  1.  ;
  1.  ; Get each configuration's grace period for messages.
  1.  ; Determine cut-off date for purging this configuration.
  1.  S I=0
  1.  F  S I=$O(^LAHM(62.48,I)) Q:'I  D
  1.  . S X=$P($G(^LAHM(62.48,I,0)),"^",6)
  1.  . I 'X S X=3 ; If missing, default to 3 days.
  1.  . S LA7DAT(I)=$$HTFM^XLFDT($$HADD^XLFDT($H,-X),1)
  1.  S LA7DAT=0
  1.  ;
  1.  F  S LA7DAT=$O(^LAHM(62.49,"AD",LA7DAT)) Q:'LA7DAT!(LA7DAT=DT)  D
  1.  . ; Set flag if "problem" messages for this date are purgeable --> have been removed from XTMP.
  1.  . S LA7DAT(0)=$G(^XTMP("LA7ERR^"_LA7DAT,0),0)
  1.  . S LA7DA=0
  1.  . F  S LA7DA=$O(^LAHM(62.49,"AD",LA7DAT,LA7DA)) Q:'LA7DA  D
  1.  . . L +^LAHM(62.49,LA7DA):1
  1.  . . I $T D
  1.  . . . I LA7DAT'=$P($P($G(^LAHM(62.49,LA7DA,0)),"^",5),".") D  Q
  1.  . . . . ; Date in cross-reference does not match field #4, remove x-ref.
  1.  . . . . K ^LAHM(62.49,"AD",LA7DAT,LA7DA)
  1.  . . . ; Don't purge if problem message and still in XTMP global.
  1.  . . . I LA7DAT(0),$P(^LAHM(62.49,LA7DA,0),"^",3)'="X" Q
  1.  . . . ; Get configuration for this message.
  1.  . . . S LA7CFG=+$G(^LAHM(62.49,LA7DA,.5))
  1.  . . . ; If message hasn't reached purge date --> skip.
  1.  . . . I LA7CFG,LA7DAT'<$G(LA7DAT(LA7CFG)) Q
  1.  . . . S DIK="^LAHM(62.49,",DA=LA7DA D ^DIK
  1.  . . L -^LAHM(62.49,LA7DA)
  1.  Q
  1.  ;
  1.  ;
  1. PSM ; Purge shipping manifests file (#62.8)
  1.  ;
  1.  ; Check each manifest to determine if accessions on manifest have all
  1.  ; been purged from file #68.
  1.  ;
  1.  ; If over 10000 entries purged from #62.85 then quit and pickup next
  1.  ; session. Avoid performance and journaling issues.
  1.  N DA,DIK,LA7628,LA7CNT
  1.  S (LA7628,LA7CNT)=0,DIK="^LAHM(62.8,"
  1.  F  S LA7628=$O(^LAHM(62.8,LA7628)) Q:'LA7628  D  Q:LA7CNT>10000
  1.  . I '$$CHK628(LA7628) Q
  1.  . D P6285
  1.  . S DA=LA7628 D ^DIK
  1.  Q
  1.  ;
  1.  ;
  1. PLPO ; Purge Lab Pending Orders file (#69.6)
  1.  ;
  1.  ; Check each order to determine if order can be purged.
  1.  ;
  1.  ; If over 5000 entries purged then quit and pickup next session.
  1.  ; Avoid performance and journaling issues.
  1.  ;
  1.  N DA,DIK,LA7696,LA7CNT,LA7COFF,LA7STAT
  1.  ;
  1.  S DIK="^LRO(69.6,",(LA7696,LA7CNT)=0
  1.  ; Cutoff dates
  1.  S LA7COFF(1)=$$FMADD^XLFDT(DT,-365),LA7COFF(2)=$$FMADD^XLFDT(DT,-730)
  1.  ; Results sent status ien
  1.  S LA7STAT=$$FIND1^DIC(64.061,"","OMX","Results/data Received","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
  1.  F  S LA7696=$O(^LRO(69.6,LA7696)) Q:'LA7696  D  Q:LA7CNT>5000
  1.  . I '$$CHK696(LA7696,.LA7COFF,LA7STAT) Q
  1.  . S LA7CNT=LA7CNT+1,DA=LA7696 D ^DIK
  1.  Q
  1.  ;
  1.  ;
  1. CHK628(LA7628) ; If all accessions have been purged then safe to purge manifest
  1.  ; and associated events (#62.85)
  1.  ;
  1.  ; Call with LA7628 = ien of manifest in #62.8
  1.  ;
  1.  ; Returns OK = 1(yes)/ 0(no) to purge
  1.  ;
  1.  N LRUID,OK
  1.  S OK=1,LRUID=""
  1.  F  S LRUID=$O(^LAHM(62.8,LA7628,10,"UID",LRUID)) Q:LRUID=""  I $$CHECKUID^LRWU4(LRUID) S OK=0 Q
  1.  Q OK
  1.  ;
  1.  ;
  1. P6285 ; Purge related entries in shipping activity log (#62.85)
  1.  ;
  1.  N DA,DIK,LA7SM,LRUID
  1.  S LA7SM=$P(^LAHM(62.8,LA7628,0),"^"),LRUID="",DIK="^LAHM(62.85,"
  1.  ;
  1.  ; Purge entries in 62.85 relating to accessions (UID) on manifest
  1.  F  S LRUID=$O(^LAHM(62.8,LA7628,10,"UID",LRUID)) Q:LRUID=""  D
  1.  . S DA=0
  1.  . F  S DA=$O(^LAHM(62.85,"AM",LRUID,LA7SM,DA)) Q:'DA  D ^DIK S LA7CNT=LA7CNT+1
  1.  ;
  1.  ; Purge entries in 62.85 relating to manifest
  1.  S DA=0
  1.  F  S DA=$O(^LAHM(62.85,"B",LA7SM,DA)) Q:'DA  D ^DIK S LA7CNT=LA7CNT+1
  1.  Q
  1.  ;
  1.  ;
  1. CHK696(LA7696,LA7COFF,LA7SPST) ; Check if order safe to purge
  1.  ;
  1.  ; Call with LA7696 = ien of order in #69.6
  1.  ;          LA7COFF = array of cutoff FileMan dates.
  1.  ;          LA7SPST = ien of specimen status Results/data Received
  1.  ;
  1.  ; Returns OK = 1(yes)/ 0(no) to purge
  1.  ;
  1.  N LAX,OK
  1.  S OK=0,LAX=$G(^LRO(69.6,LA7696,1))
  1.  ;
  1.  ; Check date order completed
  1.  I $P(LAX,"^",7),$P(LAX,"^",7)<LA7COFF(1) S OK=1
  1.  ;
  1.  ; Check date order received/tranmsitted
  1.  I 'OK D
  1.  . I $P(LAX,"^",4),$P(LAX,"^",4)<LA7COFF(2) S OK=1 Q
  1.  . I $P(LAX,"^",5),$P(LAX,"^",5)<LA7COFF(2) S OK=1 Q
  1.  ;
  1.  ; Check date order received and specimen status
  1.  I 'OK,$P(LAX,"^",5),$P(LAX,"^",5)<LA7COFF(1) D
  1.  . S X=$P($G(^LRO(69.6,LA7696,0)),"^",10) ; specimen status
  1.  . I LA7SPST,X=LA7SPST S OK=1
  1.  ;
  1.  Q OK