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