Index: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOFILER.m
===================================================================
--- WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOFILER.m	(revision 613)
+++ WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOFILER.m	(revision 623)
@@ -1,165 +1,165 @@
-HLOFILER	;ALB/CJM- Passes messages on the incoming queue to the applications - 10/4/94 1pm ;07/10/2007
-	;;1.6;HEALTH LEVEL SEVEN;**126,131,134,137**;Oct 13, 1995;Build 21
-	;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 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)="ER"
-	.S $P(NODE,"^",20)="ER",$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",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
+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
