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

HLOFILER.m

Go to the documentation of this file. 
  1. HLOFILER ;ALB/CJM- Passes messages on the incoming queue to the applications - 10/4/94 1pm
  1.  ;;1.6;HEALTH LEVEL SEVEN;**126,131**;Oct 13, 1995;Build 10
  1.  ;
  1.  ;GET WORK function for the process running under the Process Manager
  1. GETWORK(QUE) ;
  1.  ;Input:
  1.  ;  QUE - (pass by reference) These subscripts are used:
  1.  ;    ("FROM") - sending facility last obtained
  1.  ;    ("QUEUE") - name of the queue last obtained
  1.  ;Output:
  1.  ;  Function returns 1 if success, 0 if no more work
  1.  ;  QUE-  updated to identify next queu of messages to process.
  1.  ;
  1.  N FROM,QUEUE
  1.  I '$D(QUE("SYSTEM")) D
  1.  .N SYS
  1.  .D SYSPARMS^HLOSITE(.SYS)
  1.  .S QUE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE")
  1.  .S QUE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE")
  1.  S FROM=$G(QUE("FROM")),QUEUE=$G(QUE("QUEUE"))
  1.  I ($G(FROM)]""),($G(QUEUE)]"") D
  1.  .L -^HLB("QUEUE","IN",FROM,QUEUE)
  1.  .F  S QUEUE=$O(^HLB("QUEUE","IN",FROM,QUEUE)) Q:(QUEUE="")  I '$$STOPPED^HLOQUE("IN",QUEUE) L +^HLB("QUEUE","IN",FROM,QUEUE):0  Q:$T
  1.  I ($G(FROM)]""),($G(QUEUE)="") D
  1.  .F  S FROM=$O(^HLB("QUEUE","IN",FROM)) Q:FROM=""  D  Q:($G(QUEUE)]"")
  1.  ..S QUEUE="" F  S QUEUE=$O(^HLB("QUEUE","IN",FROM,QUEUE)) Q:(QUEUE="")  I '$$STOPPED^HLOQUE("IN",QUEUE) L +^HLB("QUEUE","IN",FROM,QUEUE):0 Q:$T
  1.  I FROM="" D
  1.  .F  S FROM=$O(^HLB("QUEUE","IN",FROM)) Q:FROM=""  D  Q:($G(QUEUE)]"")
  1.  ..S QUEUE="" F  S QUEUE=$O(^HLB("QUEUE","IN",FROM,QUEUE)) Q:(QUEUE="")  I '$$STOPPED^HLOQUE("IN",QUEUE) L +^HLB("QUEUE","IN",FROM,QUEUE):0 Q:$T
  1.  S QUE("FROM")=FROM,QUE("QUEUE")=QUEUE
  1.  Q:(QUEUE]"") 1
  1.  Q 0
  1.  ;
  1. DOWORK(QUEUE) ;sends the messages on the queue
  1.  N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOFILER"
  1.  ;
  1.  N MSGIEN,DEQUE,QUE
  1.  M QUE=QUEUE
  1.  S DEQUE=0
  1.  S MSGIEN=0
  1.  ;
  1.  F  S MSGIEN=$O(^HLB("QUEUE","IN",QUEUE("FROM"),QUEUE("QUEUE"),MSGIEN)) Q:'MSGIEN  D  M QUEUE=QUE
  1.  .N MCODE,ACTION,QUE,PURGE,ACKTOIEN,NODE
  1.  .N $ETRAP,$ESTACK S $ETRAP="G ERROR2^HLOFILER"
  1.  .S NODE=$G(^HLB("QUEUE","IN",QUEUE("FROM"),QUEUE("QUEUE"),MSGIEN))
  1.  .S ACTION=$P(NODE,"^",1,2)
  1.  .S PURGE=$P(NODE,"^",3)
  1.  .S ACKTOIEN=$P(NODE,"^",4)
  1.  .D DEQUE(MSGIEN,PURGE,ACKTOIEN)
  1.  .I ACTION]"" D
  1.  ..N HLMSGIEN,MCODE,DEQUE,DUZ
  1.  ..N $ETRAP,$ESTACK S $ETRAP="G ERROR3^HLOFILER"
  1.  ..S HLMSGIEN=MSGIEN
  1.  ..S MCODE="D "_ACTION
  1.  ..N MSGIEN,X
  1.  ..D DUZ^XUP(.5)
  1.  ..X MCODE
  1.  ..;kill the apps variables
  1.  ..D
  1.  ...N ZTSK
  1.  ...D KILL^XUSCLEAN
  1.  ;
  1. ENDWORK ;where the execution resumes upon an error
  1.  D DEQUE()
  1.  Q
  1.  ;
  1. DEQUE(MSGIEN,PURGE,ACKTOIEN) ;
  1.  ;Dequeues the message.  Also sets up the purge dt/tm and the completion status.
  1.  S:$G(MSGIEN) DEQUE=$G(DEQUE)+1,DEQUE(MSGIEN)=PURGE_"^"_ACKTOIEN
  1.  I '$G(MSGIEN)!(DEQUE>25) S MSGIEN=0 D
  1.  .F  S MSGIEN=$O(DEQUE(MSGIEN)) Q:'MSGIEN  D
  1.  ..N NODE,PURGE,ACKTOIEN
  1.  ..S NODE=DEQUE(MSGIEN)
  1.  ..S PURGE=$P(NODE,"^"),ACKTOIEN=$P(NODE,"^",2)
  1.  ..D DEQUE^HLOQUE(QUEUE("FROM"),QUEUE("QUEUE"),"IN",MSGIEN)
  1.  ..S NODE=$G(^HLB(MSGIEN,0))
  1.  ..Q:NODE=""
  1.  ..S $P(NODE,"^",19)=1 ;sets the flag to show that the app handoff was done
  1.  ..D:PURGE
  1.  ...N STATUS
  1.  ...S STATUS=$P(NODE,"^",20)
  1.  ...S:STATUS="" $P(NODE,"^",20)="SU",STATUS="SU"
  1.  ...S $P(NODE,"^",9)=$$FMADD^XLFDT($$NOW^XLFDT,,$S(STATUS'="SU":24*QUEUE("SYSTEM","ERROR PURGE"),$D(^HLB(MSGIEN,3,1,0)):24*QUEUE("SYSTEM","ERROR PURGE"),1:QUEUE("SYSTEM","NORMAL PURGE")))
  1.  ...S ^HLB("AD",$S($E($P(NODE,"^",4))="I":"IN",1:"OUT"),$P(NODE,"^",9),MSGIEN)=""
  1.  ...I ACKTOIEN,$D(^HLB(ACKTOIEN,0)) S $P(^HLB(ACKTOIEN,0),"^",9)=$P(NODE,"^",9),^HLB("AD",$S($E($P(NODE,"^",4))="I":"OUT",1:"IN"),$P(NODE,"^",9),ACKTOIEN)=""
  1.  ..S ^HLB(MSGIEN,0)=NODE
  1.  .K DEQUE S DEQUE=0
  1.  Q
  1.  ;
  1. ERROR ;error trap
  1.  S $ETRAP="D UNWIND^%ZTER"
  1.  ;
  1.  D DEQUE()
  1.  ;
  1.  ;a lot of errors of the same type may indicate an endless loop, so keep  a count
  1.  S ^TMP("HL7 ERRORS",$J,$ECODE)=$G(^TMP("HL7 ERRORS",$J,$ECODE))+1
  1.  Q:($G(^TMP("HL7 ERRORS",$J,$ECODE))>100)  ;return to the Process Manager error trap
  1.  ;
  1.  ;while debugging quit on all errors - returns to the Process Manager error trap
  1.  I $G(^HLTMP("LOG ALL ERRORS")) QUIT
  1.  ;
  1.  D ^%ZTER
  1.  D UNWIND^%ZTER
  1.  Q
  1.  ;
  1. ERROR2 ;
  1.  S $ETRAP="D UNWIND^%ZTER"
  1.  ;
  1.  D DEQUE()
  1.  ;
  1.  ;may need to change the status to Application Error
  1.  D
  1.  .N NODE,RAPP,FS,CS,HDR,TIME
  1.  .S NODE=$G(^HLB(MSGIEN,0))
  1.  .Q:NODE=""
  1.  .Q:$P(NODE,"^",20)="AE"
  1.  .S $P(NODE,"^",20)="AE",$P(NODE,"^",21)="APPLICATION ROUTINE ERROR"
  1.  .I $P(NODE,"^",9) K ^HLB("AD",$S($E($P(NODE,"^",4))="I":"IN",1:"OUT"),$P(NODE,"^",9),MSGIEN)
  1.  .S $P(NODE,"^",9)=$$FMADD^XLFDT($$NOW^XLFDT,,24*QUEUE("SYSTEM","ERROR PURGE"))
  1.  .S ^HLB(MSGIEN,0)=NODE
  1.  .S ^HLB("AD",$S($E($P(NODE,"^",4))="I":"IN",1:"OUT"),$P(NODE,"^",9),MSGIEN)=""
  1.  .I $P(NODE,"^",2) S TIME=+$G(^HLA($P(NODE,"^",2),0))
  1.  .Q:'$G(TIME)
  1.  .S HDR=$G(^HLB(MSGIEN,1))
  1.  .S FS=$E(HDR,4)
  1.  .Q:FS=""
  1.  .S CS=$E(HDR,5)
  1.  .S RAPP=$P($P(HDR,FS,5),CS)
  1.  .I RAPP="" S RAPP="UNKNOWN"
  1.  .S ^HLB("ERRORS","AE",RAPP,TIME,MSGIEN)=""
  1.  ;
  1.  ;kill the apps variables
  1.  D
  1.  .N ZTSK,MSGIEN,QUEUE
  1.  .D KILL^XUSCLEAN
  1.  ;
  1.  ;release all the locks the app may have set, except Taskman lock
  1.  L:$D(ZTSK) ^%ZTSCH("TASK",ZTSK):1
  1.  L:'$D(ZTSK)
  1.  ;reset HLO's lock
  1.  L +^HLTMP("HL7 RUNNING PROCESSES",$J):0
  1.  ;return to processing the next message on the queue
  1.  S $ECODE=""
  1.  ;
  1.  Q
  1. ERROR3 ;error trap for application context
  1.  S $ETRAP="Q $ESTACK"
  1.  D ^%ZTER
  1.  S $ECODE=",UAPPLICATION ERROR,"
  1.  ;
  1.  ;drop to the ERROR2 error handler
  1.  Q