HLOCLNT3 ;ALB/CJM- Updates messages missing application acks - 10/4/94 1pm ;03/12/2012
;;1.6;HEALTH LEVEL SEVEN;**126,130,134,137,158**;Oct 13, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
;
DOWORK(WORK) ;
;
N CUTOFF,MSGIEN,QUIT,NOW,SYSPURGE
S NOW=$$NOW^XLFDT
S QUIT=0
D SYSPURGE^HLOSITE(.SYSPURGE)
S PURGE=$$FMADD^XLFDT($$NOW^XLFDT,SYSPURGE("ERROR"))
;
;7 day wait for an application ack is more than reasonable
S CUTOFF=$$FMADD^XLFDT(NOW,-7)
;
S MSGIEN=+$G(^HLTMP("LAST IEN CHECKED FOR MISSING APPLICATION ACK"))
F S MSGIEN=$O(^HLB(MSGIEN)) Q:'MSGIEN Q:MSGIEN>99999999999 D Q:QUIT
.N MSG,HDR
.Q:'$$GETMSG^HLOMSG(MSGIEN,.MSG)
.Q:'MSG("DT/TM")
.Q:'MSG("BODY")
.I MSG("DT/TM")>CUTOFF S:MSG("DT/TM CREATED")>CUTOFF QUIT=1,MSGIEN=MSGIEN-1 Q
.Q:MSG("STATUS")'=""
.Q:MSG("DIRECTION")'="OUT"
.Q:MSG("BATCH")
.Q:MSG("STATUS","APP ACK'D")
.;Q:MSG("STATUS","APP ACK RESPONSE")=""
.;message has been in a incomplete status for a longtime, pending an application ack - set status to error and schedule for purging
.S $P(^HLB(MSGIEN,0),"^",9)=PURGE
.S ^HLB("AD","OUT",PURGE,MSGIEN)=""
.S $P(^HLB(MSGIEN,0),"^",20)="ER"
.S $P(^HLB(MSGIEN,0),"^",21)="MISSING APPLICATION ACKNOWLEDGMENT"
.M HDR=MSG("HDR")
.Q:'$$PARSEHDR^HLOPRS(.HDR)
.S ^HLB("ERRORS",$S($L(HDR("RECEIVING APPLICATION")):HDR("RECEIVING APPLICATION"),1:"UNKNOWN"),NOW,MSGIEN)=""
.D COUNT^HLOESTAT("OUT",HDR("RECEIVING APPLICATION"),HDR("SENDING APPLICATION"),$S(MSG("BATCH"):"BATCH",1:$G(HDR("MESSAGE TYPE"))),$G(HDR("EVENT")))
S:MSGIEN>99999999999 MSGIEN=0
S ^HLTMP("LAST IEN CHECKED FOR MISSING APPLICATION ACK")=MSGIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOCLNT3 1689 printed Oct 16, 2024@17:59:25 Page 2
HLOCLNT3 ;ALB/CJM- Updates messages missing application acks - 10/4/94 1pm ;03/12/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**126,130,134,137,158**;Oct 13, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
DOWORK(WORK) ;
+1 ;
+2 NEW CUTOFF,MSGIEN,QUIT,NOW,SYSPURGE
+3 SET NOW=$$NOW^XLFDT
+4 SET QUIT=0
+5 DO SYSPURGE^HLOSITE(.SYSPURGE)
+6 SET PURGE=$$FMADD^XLFDT($$NOW^XLFDT,SYSPURGE("ERROR"))
+7 ;
+8 ;7 day wait for an application ack is more than reasonable
+9 SET CUTOFF=$$FMADD^XLFDT(NOW,-7)
+10 ;
+11 SET MSGIEN=+$GET(^HLTMP("LAST IEN CHECKED FOR MISSING APPLICATION ACK"))
+12 FOR
SET MSGIEN=$ORDER(^HLB(MSGIEN))
if 'MSGIEN
QUIT
if MSGIEN>99999999999
QUIT
Begin DoDot:1
+13 NEW MSG,HDR
+14 if '$$GETMSG^HLOMSG(MSGIEN,.MSG)
QUIT
+15 if 'MSG("DT/TM")
QUIT
+16 if 'MSG("BODY")
QUIT
+17 IF MSG("DT/TM")>CUTOFF
if MSG("DT/TM CREATED")>CUTOFF
SET QUIT=1
SET MSGIEN=MSGIEN-1
QUIT
+18 if MSG("STATUS")'=""
QUIT
+19 if MSG("DIRECTION")'="OUT"
QUIT
+20 if MSG("BATCH")
QUIT
+21 if MSG("STATUS","APP ACK'D")
QUIT
+22 ;Q:MSG("STATUS","APP ACK RESPONSE")=""
+23 ;message has been in a incomplete status for a longtime, pending an application ack - set status to error and schedule for purging
+24 SET $PIECE(^HLB(MSGIEN,0),"^",9)=PURGE
+25 SET ^HLB("AD","OUT",PURGE,MSGIEN)=""
+26 SET $PIECE(^HLB(MSGIEN,0),"^",20)="ER"
+27 SET $PIECE(^HLB(MSGIEN,0),"^",21)="MISSING APPLICATION ACKNOWLEDGMENT"
+28 MERGE HDR=MSG("HDR")
+29 if '$$PARSEHDR^HLOPRS(.HDR)
QUIT
+30 SET ^HLB("ERRORS",$SELECT($LENGTH(HDR("RECEIVING APPLICATION")):HDR("RECEIVING APPLICATION"),1:"UNKNOWN"),NOW,MSGIEN)=""
+31 DO COUNT^HLOESTAT("OUT",HDR("RECEIVING APPLICATION"),HDR("SENDING APPLICATION"),$SELECT(MSG("BATCH"):"BATCH",1:$GET(HDR("MESSAGE TYPE"))),$GET(HDR("EVENT")))
End DoDot:1
if QUIT
QUIT
+32 if MSGIEN>99999999999
SET MSGIEN=0
+33 SET ^HLTMP("LAST IEN CHECKED FOR MISSING APPLICATION ACK")=MSGIEN
+34 QUIT
