VistA-WorldVistAEHR/r/HEALTH_LEVEL_SEVEN-HL/HLOFILER.m

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