source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7PURG.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
[613]1LA7PURG ;DALOI/JMC - Purge Lab Messaging Interface Messages ; Nov 4, 2004
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,64**;Sep 27, 1994
3 ;
4 ; This routine purges messages and checks file intregrity for Lab Messaging.
5 Q
6 ;
7 ;
8EN ; Entry point from taskman
9 D IC^LA7CHKF
10 D PURGE,PSM,PLPO
11 S X=$$LACHK^LA7CHKF
12 Q
13 ;
14 ;
15PURGE ; purge messages previous to today
16 N DA,DIK,I,LA7CFG,LA7DA,LA7DAT,LA7ROOT,LA7Q,X,Y
17 ;
18 ; Get each configuration's grace period for messages.
19 ; Determine cut-off date for purging this configuration.
20 S I=0
21 F S I=$O(^LAHM(62.48,I)) Q:'I D
22 . S X=$P($G(^LAHM(62.48,I,0)),"^",6)
23 . I 'X S X=3 ; If missing, default to 3 days.
24 . S LA7DAT(I)=$$HTFM^XLFDT($$HADD^XLFDT($H,-X),1)
25 S LA7DAT=0
26 ;
27 F S LA7DAT=$O(^LAHM(62.49,"AD",LA7DAT)) Q:'LA7DAT!(LA7DAT=DT) D
28 . ; Set flag if "problem" messages for this date are purgeable --> have been removed from XTMP.
29 . S LA7DAT(0)=$G(^XTMP("LA7ERR^"_LA7DAT,0),0)
30 . S LA7DA=0
31 . F S LA7DA=$O(^LAHM(62.49,"AD",LA7DAT,LA7DA)) Q:'LA7DA D
32 . . L +^LAHM(62.49,LA7DA):1
33 . . I $T D
34 . . . I LA7DAT'=$P($P($G(^LAHM(62.49,LA7DA,0)),"^",5),".") D Q
35 . . . . ; Date in cross-reference does not match field #4, remove x-ref.
36 . . . . K ^LAHM(62.49,"AD",LA7DAT,LA7DA)
37 . . . ; Don't purge if problem message and still in XTMP global.
38 . . . I LA7DAT(0),$P(^LAHM(62.49,LA7DA,0),"^",3)'="X" Q
39 . . . ; Get configuration for this message.
40 . . . S LA7CFG=+$G(^LAHM(62.49,LA7DA,.5))
41 . . . ; If message hasn't reached purge date --> skip.
42 . . . I LA7CFG,LA7DAT'<$G(LA7DAT(LA7CFG)) Q
43 . . . S DIK="^LAHM(62.49,",DA=LA7DA D ^DIK
44 . . L -^LAHM(62.49,LA7DA)
45 Q
46 ;
47 ;
48PSM ; Purge shipping manifests file (#62.8)
49 ;
50 ; Check each manifest to determine if accessions on manifest have all
51 ; been purged from file #68.
52 ;
53 ; If over 10000 entries purged from #62.85 then quit and pickup next
54 ; session. Avoid performance and journaling issues.
55 N DA,DIK,LA7628,LA7CNT
56 S (LA7628,LA7CNT)=0,DIK="^LAHM(62.8,"
57 F S LA7628=$O(^LAHM(62.8,LA7628)) Q:'LA7628 D Q:LA7CNT>10000
58 . I '$$CHK628(LA7628) Q
59 . D P6285
60 . S DA=LA7628 D ^DIK
61 Q
62 ;
63 ;
64PLPO ; Purge Lab Pending Orders file (#69.6)
65 ;
66 ; Check each order to determine if order can be purged.
67 ;
68 ; If over 5000 entries purged then quit and pickup next session.
69 ; Avoid performance and journaling issues.
70 ;
71 N DA,DIK,LA7696,LA7CNT,LA7COFF,LA7STAT
72 ;
73 S DIK="^LRO(69.6,",(LA7696,LA7CNT)=0
74 ; Cutoff dates
75 S LA7COFF(1)=$$FMADD^XLFDT(DT,-365),LA7COFF(2)=$$FMADD^XLFDT(DT,-730)
76 ; Results sent status ien
77 S LA7STAT=$$FIND1^DIC(64.061,"","OMX","Results/data Received","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
78 F S LA7696=$O(^LRO(69.6,LA7696)) Q:'LA7696 D Q:LA7CNT>5000
79 . I '$$CHK696(LA7696,.LA7COFF,LA7STAT) Q
80 . S LA7CNT=LA7CNT+1,DA=LA7696 D ^DIK
81 Q
82 ;
83 ;
84CHK628(LA7628) ; If all accessions have been purged then safe to purge manifest
85 ; and associated events (#62.85)
86 ;
87 ; Call with LA7628 = ien of manifest in #62.8
88 ;
89 ; Returns OK = 1(yes)/ 0(no) to purge
90 ;
91 N LRUID,OK
92 S OK=1,LRUID=""
93 F S LRUID=$O(^LAHM(62.8,LA7628,10,"UID",LRUID)) Q:LRUID="" I $$CHECKUID^LRWU4(LRUID) S OK=0 Q
94 Q OK
95 ;
96 ;
97P6285 ; Purge related entries in shipping activity log (#62.85)
98 ;
99 N DA,DIK,LA7SM,LRUID
100 S LA7SM=$P(^LAHM(62.8,LA7628,0),"^"),LRUID="",DIK="^LAHM(62.85,"
101 ;
102 ; Purge entries in 62.85 relating to accessions (UID) on manifest
103 F S LRUID=$O(^LAHM(62.8,LA7628,10,"UID",LRUID)) Q:LRUID="" D
104 . S DA=0
105 . F S DA=$O(^LAHM(62.85,"AM",LRUID,LA7SM,DA)) Q:'DA D ^DIK S LA7CNT=LA7CNT+1
106 ;
107 ; Purge entries in 62.85 relating to manifest
108 S DA=0
109 F S DA=$O(^LAHM(62.85,"B",LA7SM,DA)) Q:'DA D ^DIK S LA7CNT=LA7CNT+1
110 Q
111 ;
112 ;
113CHK696(LA7696,LA7COFF,LA7SPST) ; Check if order safe to purge
114 ;
115 ; Call with LA7696 = ien of order in #69.6
116 ; LA7COFF = array of cutoff FileMan dates.
117 ; LA7SPST = ien of specimen status Results/data Received
118 ;
119 ; Returns OK = 1(yes)/ 0(no) to purge
120 ;
121 N LAX,OK
122 S OK=0,LAX=$G(^LRO(69.6,LA7696,1))
123 ;
124 ; Check date order completed
125 I $P(LAX,"^",7),$P(LAX,"^",7)<LA7COFF(1) S OK=1
126 ;
127 ; Check date order received/tranmsitted
128 I 'OK D
129 . I $P(LAX,"^",4),$P(LAX,"^",4)<LA7COFF(2) S OK=1 Q
130 . I $P(LAX,"^",5),$P(LAX,"^",5)<LA7COFF(2) S OK=1 Q
131 ;
132 ; Check date order received and specimen status
133 I 'OK,$P(LAX,"^",5),$P(LAX,"^",5)<LA7COFF(1) D
134 . S X=$P($G(^LRO(69.6,LA7696,0)),"^",10) ; specimen status
135 . I LA7SPST,X=LA7SPST S OK=1
136 ;
137 Q OK
Note: See TracBrowser for help on using the repository browser.