[623] | 1 | HLOPURGE ;IRMFO-ALB/CJM - Purging Old Messages;03/24/2004 14:43 ;04/30/2007
|
---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**126,134,136**;Oct 13, 1995;Build 9
|
---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ;
|
---|
| 5 | GETWORK(WORK) ;
|
---|
| 6 | ;
|
---|
| 7 | N OK
|
---|
| 8 | S OK=0
|
---|
| 9 | I $G(WORK)]"" L -HLPURGE(WORK)
|
---|
| 10 | F WORK="IN","OUT","OLD778","OLD777" I '$G(WORK("DONE",WORK)) S WORK("DONE",WORK)=1 L +HLPURGE(WORK):0 S OK=$T Q:OK
|
---|
| 11 | I 'OK K WORK("DONE") S WORK=""
|
---|
| 12 | Q OK
|
---|
| 13 | ;
|
---|
| 14 | DOWORK(WORK) ;
|
---|
| 15 | I WORK="OLD778" D OLD778
|
---|
| 16 | I WORK="OLD777" D OLD777
|
---|
| 17 | I (WORK="IN")!(WORK="OUT") D
|
---|
| 18 | .N TIME,NOW
|
---|
| 19 | .S NOW=$$NOW^XLFDT
|
---|
| 20 | .S TIME=0
|
---|
| 21 | .F S TIME=$O(^HLB("AD",WORK,TIME)) Q:TIME="" Q:TIME>NOW D
|
---|
| 22 | ..N MSGIEN
|
---|
| 23 | ..S MSGIEN=0
|
---|
| 24 | ..F S MSGIEN=$O(^HLB("AD",WORK,TIME,MSGIEN)) Q:'MSGIEN D
|
---|
| 25 | ...K ^HLB("AD",WORK,TIME,MSGIEN)
|
---|
| 26 | ...D DELETE(MSGIEN)
|
---|
| 27 | L -HLPURGE(WORK)
|
---|
| 28 | Q
|
---|
| 29 | OLD778 ;
|
---|
| 30 | N OLD,START,END,APP,TYPE,TODAY
|
---|
| 31 | S TODAY=$$DT^XLFDT
|
---|
| 32 | S OLD=$$FMADD^XLFDT(TODAY,-45)
|
---|
| 33 | F START=0,100000000000,200000000000,300000000000 D
|
---|
| 34 | .S END=(START+100000000000)-1
|
---|
| 35 | .N MSGIEN,QUIT
|
---|
| 36 | .S QUIT=0
|
---|
| 37 | .S MSGIEN=START
|
---|
| 38 | .F S MSGIEN=$O(^HLB(MSGIEN)) Q:'MSGIEN Q:(MSGIEN>END) D Q:QUIT
|
---|
| 39 | ..N WHEN,BODY,NODE
|
---|
| 40 | ..S NODE=$G(^HLB(MSGIEN,0))
|
---|
| 41 | ..S WHEN=$P(NODE,"^",16)
|
---|
| 42 | ..I WHEN,WHEN<OLD,$P(NODE,"^",9)<TODAY D DELETE(MSGIEN) Q
|
---|
| 43 | ..I 'WHEN D
|
---|
| 44 | ...S BODY=$P(NODE,"^",2)
|
---|
| 45 | ...Q:'BODY
|
---|
| 46 | ...S WHEN=+$G(^HLA(BODY,0))
|
---|
| 47 | ...I WHEN,WHEN<OLD D Q
|
---|
| 48 | ....;I've seen messages sitting on outgoing queues forever, but it should never happen for incoming
|
---|
| 49 | ....I $E($P(NODE,"^",4))="O",$P(NODE,"^",5)]"",$P(NODE,"^",6)]"" D
|
---|
| 50 | .....N FROM
|
---|
| 51 | .....S FROM=$P(NODE,"^",5)
|
---|
| 52 | .....I $P(NODE,"^",8) S FROM=FROM_":"_$P(NODE,"^",8)
|
---|
| 53 | .....Q:'$D(^HLB("QUEUE","OUT",FROM,$P(NODE,"^",6),MSGIEN))
|
---|
| 54 | .....D DEQUE^HLOQUE(FROM,$P(NODE,"^",6),"OUT",MSGIEN)
|
---|
| 55 | ....D DELETE(MSGIEN) Q
|
---|
| 56 | ...;stop looking for old records?
|
---|
| 57 | ...I WHEN,WHEN>OLD S QUIT=1
|
---|
| 58 | ;
|
---|
| 59 | ;also kill old errors left lying around
|
---|
| 60 | F TYPE="TF","AE","SE" S APP="" F S APP=$O(^HLB("ERRORS",TYPE,APP)) Q:APP="" D
|
---|
| 61 | .N TIME,PARMS
|
---|
| 62 | .D SYSPARMS^HLOSITE(.PARMS)
|
---|
| 63 | .S OLD=$$FMADD^XLFDT($$DT^XLFDT,-PARMS("ERROR PURGE"))
|
---|
| 64 | .S TIME=0
|
---|
| 65 | .F S TIME=$O(^HLB("ERRORS",TYPE,APP,TIME)) Q:'TIME Q:TIME>OLD K ^HLB("ERRORS",TYPE,APP,TIME)
|
---|
| 66 | Q
|
---|
| 67 | OLD777 ;
|
---|
| 68 | N OLD,TIME,TODAY
|
---|
| 69 | S TODAY=$$DT^XLFDT
|
---|
| 70 | S OLD=$$FMADD^XLFDT(TODAY,-45)
|
---|
| 71 | S TIME=0
|
---|
| 72 | F S TIME=$O(^HLA("B",TIME)) Q:'TIME Q:TIME>OLD D
|
---|
| 73 | .N MSGIEN
|
---|
| 74 | .S MSGIEN=0
|
---|
| 75 | .F S MSGIEN=$O(^HLA("B",TIME,MSGIEN)) Q:'MSGIEN D
|
---|
| 76 | ..N IEN778,STOP
|
---|
| 77 | ..S (STOP,IEN778)=0
|
---|
| 78 | ..F S IEN778=$O(^HLB("C",MSGIEN,IEN778)) Q:'IEN778 D
|
---|
| 79 | ...I $P($G(^HLB(IEN778,0)),"^",9)>TODAY S STOP=1 Q
|
---|
| 80 | ...D DELETE(IEN778,1)
|
---|
| 81 | ..K:'STOP ^HLB("C",MSGIEN),^HLA("B",TIME,MSGIEN),^HLA(MSGIEN)
|
---|
| 82 | Q
|
---|
| 83 | ;
|
---|
| 84 | DELETE(MSGIEN,FLAG) ;
|
---|
| 85 | ;Input:
|
---|
| 86 | ; MSGIEN - IEN, file 778
|
---|
| 87 | ; FLAG - if $G(FLAG), will not delete the pointed to record in file 777
|
---|
| 88 | N AC,SUBIEN,RAPP,SAPP,FS,CS,MSG
|
---|
| 89 | I '$$GETMSG^HLOMSG(MSGIEN,.MSG) ;MSG is corrupted, but there sill may be nodes to delete
|
---|
| 90 | S (RAPP,SAPP)=""
|
---|
| 91 | D
|
---|
| 92 | .S FS=$E(MSG("HDR",1),4)
|
---|
| 93 | .Q:FS=""
|
---|
| 94 | .S CS=$E(MSG("HDR",1),5)
|
---|
| 95 | .S SAPP=$P($P(MSG("HDR",1),FS,3),CS)
|
---|
| 96 | .I SAPP="" S SAPP="UNKNOWN"
|
---|
| 97 | .S RAPP=$P($P(MSG("HDR",1),FS,5),CS)
|
---|
| 98 | .I RAPP="" S RAPP="UNKNOWN"
|
---|
| 99 | ;
|
---|
| 100 | I 'MSG("BATCH") D KSEARCH(.MSG,MSG("MESSAGE TYPE"),MSG("EVENT"),SAPP,RAPP,MSGIEN)
|
---|
| 101 | ;if an error status,take care of the "ERRORS" x-ref
|
---|
| 102 | I MSG("STATUS")'="",MSG("STATUS")'="SU",MSG("BODY") D
|
---|
| 103 | .N APP
|
---|
| 104 | .S APP=$S(MSG("STATUS")="TF":SAPP,1:RAPP)
|
---|
| 105 | .K ^HLB("ERRORS",MSG("STATUS"),APP,MSG("DT/TM CREATED"),MSGIEN)
|
---|
| 106 | .I MSG("STATUS")="AE" D
|
---|
| 107 | ..N SUB
|
---|
| 108 | ..S SUB=MSGIEN_"^"
|
---|
| 109 | ..K ^HLB("ERRORS","AE",APP,MSG("DT/TM CREATED"),SUB)
|
---|
| 110 | ..F S SUB=$O(^HLB("ERRORS","AE",APP,MSG("DT/TM CREATED"),SUB)) Q:SUB="" Q:+SUB'=MSGIEN K ^HLB("ERRORS","AE",APP,MSG("DT/TM CREATED"),SUB)
|
---|
| 111 | ;
|
---|
| 112 | ;kill the whole-file xrefs for the message ien within a batch
|
---|
| 113 | S SUBIEN=0
|
---|
| 114 | F S SUBIEN=$O(^HLB(MSGIEN,3,SUBIEN)) Q:'SUBIEN D
|
---|
| 115 | .N MSGID
|
---|
| 116 | .I FS]"" D
|
---|
| 117 | ..N VALUE,HDR2,MSGTYPE,EVENT
|
---|
| 118 | ..S HDR2=$G(^HLB(MSGIEN,3,SUBIEN,2))
|
---|
| 119 | ..S VALUE=$P(HDR2,FS,4)
|
---|
| 120 | ..S MSGTYPE=$P(VALUE,CS)
|
---|
| 121 | ..S EVENT=$P(VALUE,CS,2)
|
---|
| 122 | ..D KSEARCH(.MSG,MSGTYPE,EVENT,SAPP,RAPP,MSGIEN_"^"_SUBIEN)
|
---|
| 123 | .S MSGID=$P($G(^HLB(MSGIEN,3,SUBIEN,0)),"^",2)
|
---|
| 124 | .I MSGID]"" K ^HLB("AE",MSGID,MSGIEN_"^"_SUBIEN)
|
---|
| 125 | ;
|
---|
| 126 | I MSG("DIRECTION")="IN" D
|
---|
| 127 | .Q:FS=""
|
---|
| 128 | .N VALUE,HDR
|
---|
| 129 | .S HDR("SENDING APPLICATION")=$P(MSG("HDR",1),FS,3)
|
---|
| 130 | .S VALUE=$P(MSG("HDR",1),FS,4)
|
---|
| 131 | .S HDR("SENDING FACILITY",1)=$P(VALUE,CS)
|
---|
| 132 | .S HDR("SENDING FACILITY",2)=$P(VALUE,CS,2)
|
---|
| 133 | .S HDR("SENDING FACILITY",3)=$P(VALUE,CS,3)
|
---|
| 134 | .S AC=$S(HDR("SENDING FACILITY",2)]"":HDR("SENDING FACILITY",2),1:HDR("SENDING FACILITY",1))_HDR("SENDING APPLICATION")_MSG("ID")
|
---|
| 135 | K ^HLB(MSGIEN)
|
---|
| 136 | I MSG("STATUS","PURGE"),MSG("DIRECTION")'="" K ^HLB("AD",MSG("DIRECTION"),MSG("STATUS","PURGE"),MSGIEN)
|
---|
| 137 | K:(MSG("ID")]"") ^HLB("B",MSG("ID"),MSGIEN)
|
---|
| 138 | I MSG("DIRECTION")="IN" D
|
---|
| 139 | .K:($G(AC)]"") ^HLB("AC",AC,MSGIEN)
|
---|
| 140 | .I MSG("BODY"),'$G(FLAG) D KILL777(MSG("BODY"))
|
---|
| 141 | I MSG("DIRECTION")="OUT" D
|
---|
| 142 | .K ^HLB("C",+MSG("BODY"),MSGIEN)
|
---|
| 143 | .I '$G(FLAG),'$O(^HLB("C",+MSG("BODY"),0)) D KILL777(MSG("BODY"))
|
---|
| 144 | Q
|
---|
| 145 | ;
|
---|
| 146 | KILL777(BODY) ;
|
---|
| 147 | Q:'$G(BODY)
|
---|
| 148 | N TIME
|
---|
| 149 | S TIME=$P($G(^HLA(BODY,0)),"^")
|
---|
| 150 | K ^HLA(BODY)
|
---|
| 151 | K:(TIME]"") ^HLA("B",TIME,BODY)
|
---|
| 152 | Q
|
---|
| 153 | ;
|
---|
| 154 | KSEARCH(MSG,MSGTYPE,EVENT,SAPP,RAPP,IEN) ;
|
---|
| 155 | ;Kills the ^HLB("SEARCH") x-ref
|
---|
| 156 | ;
|
---|
| 157 | N APP
|
---|
| 158 | S:MSGTYPE="" MSGTYPE="<none>"
|
---|
| 159 | S:EVENT="" EVENT="<none>"
|
---|
| 160 | Q:'MSG("DT/TM CREATED")
|
---|
| 161 | I MSG("DIRECTION")'="IN",MSG("DIRECTION")'="OUT" Q
|
---|
| 162 | S APP=$S(MSG("DIRECTION")="IN":RAPP,1:SAPP)
|
---|
| 163 | Q:APP=""
|
---|
| 164 | K ^HLB("SEARCH",MSG("DIRECTION"),MSG("DT/TM CREATED"),APP,MSGTYPE,EVENT,IEN)
|
---|
| 165 | Q
|
---|