source: WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOFILER.m@ 700

Last change on this file since 700 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 5.4 KB
RevLine 
[623]1HLOFILER ;ALB/CJM- Passes messages on the incoming queue to the applications - 10/4/94 1pm ;03/28/2007
2 ;;1.6;HEALTH LEVEL SEVEN;**126,131,134**;Oct 13, 1995;Build 30
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 ;
5 ;GET WORK function for the process running under the Process Manager
6GETWORK(QUE) ;
7 ;Input:
8 ; QUE - (pass by reference) These subscripts are used:
9 ; ("FROM") - sending facility last obtained
10 ; ("QUEUE") - name of the queue last obtained
11 ;Output:
12 ; Function returns 1 if success, 0 if no more work
13 ; QUE- updated to identify next queu of messages to process.
14 ;
15 N FROM,QUEUE
16 I '$D(QUE("SYSTEM")) D
17 .N SYS
18 .D SYSPARMS^HLOSITE(.SYS)
19 .S QUE("SYSTEM","NORMAL PURGE")=SYS("NORMAL PURGE")
20 .S QUE("SYSTEM","ERROR PURGE")=SYS("ERROR PURGE")
21 S FROM=$G(QUE("FROM")),QUEUE=$G(QUE("QUEUE"))
22 I ($G(FROM)]""),($G(QUEUE)]"") D
23 .L -^HLB("QUEUE","IN",FROM,QUEUE)
24 .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
25 I ($G(FROM)]""),($G(QUEUE)="") D
26 .F S FROM=$O(^HLB("QUEUE","IN",FROM)) Q:FROM="" D Q:($G(QUEUE)]"")
27 ..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
28 I FROM="" D
29 .F S FROM=$O(^HLB("QUEUE","IN",FROM)) Q:FROM="" D Q:($G(QUEUE)]"")
30 ..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
31 S QUE("FROM")=FROM,QUE("QUEUE")=QUEUE
32 Q:(QUEUE]"") 1
33 Q 0
34 ;
35DOWORK(QUEUE) ;sends the messages on the queue
36 N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOFILER"
37 ;
38 N MSGIEN,DEQUE,QUE
39 M QUE=QUEUE
40 S DEQUE=0
41 S MSGIEN=0
42 ;
43 F S MSGIEN=$O(^HLB("QUEUE","IN",QUEUE("FROM"),QUEUE("QUEUE"),MSGIEN)) Q:'MSGIEN D M QUEUE=QUE
44 .N MCODE,ACTION,QUE,PURGE,ACKTOIEN,NODE
45 .N $ETRAP,$ESTACK S $ETRAP="G ERROR2^HLOFILER"
46 .S NODE=$G(^HLB("QUEUE","IN",QUEUE("FROM"),QUEUE("QUEUE"),MSGIEN))
47 .S ACTION=$P(NODE,"^",1,2)
48 .S PURGE=$P(NODE,"^",3)
49 .S ACKTOIEN=$P(NODE,"^",4)
50 .D DEQUE(MSGIEN,PURGE,ACKTOIEN)
51 .I ACTION]"" D
52 ..N HLMSGIEN,MCODE,DEQUE,DUZ
53 ..N $ETRAP,$ESTACK S $ETRAP="G ERROR3^HLOFILER"
54 ..S HLMSGIEN=MSGIEN
55 ..S MCODE="D "_ACTION
56 ..N MSGIEN,X
57 ..D DUZ^XUP(.5)
58 ..X MCODE
59 ..;kill the apps variables
60 ..D
61 ...N ZTSK
62 ...D KILL^XUSCLEAN
63 ;
64ENDWORK ;where the execution resumes upon an error
65 D DEQUE()
66 Q
67 ;
68DEQUE(MSGIEN,PURGE,ACKTOIEN) ;
69 ;Dequeues the message. Also sets up the purge dt/tm and the completion status.
70 S:$G(MSGIEN) DEQUE=$G(DEQUE)+1,DEQUE(MSGIEN)=PURGE_"^"_ACKTOIEN
71 I '$G(MSGIEN)!($G(DEQUE)>25) S MSGIEN=0 D
72 .F S MSGIEN=$O(DEQUE(MSGIEN)) Q:'MSGIEN D
73 ..N NODE,PURGE,ACKTOIEN
74 ..S NODE=DEQUE(MSGIEN)
75 ..S PURGE=$P(NODE,"^"),ACKTOIEN=$P(NODE,"^",2)
76 ..D DEQUE^HLOQUE(QUEUE("FROM"),QUEUE("QUEUE"),"IN",MSGIEN)
77 ..S NODE=$G(^HLB(MSGIEN,0))
78 ..Q:NODE=""
79 ..S $P(NODE,"^",19)=1 ;sets the flag to show that the app handoff was done
80 ..D:PURGE
81 ...N STATUS
82 ...S STATUS=$P(NODE,"^",20)
83 ...S:STATUS="" $P(NODE,"^",20)="SU",STATUS="SU"
84 ...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")))
85 ...S ^HLB("AD",$S($E($P(NODE,"^",4))="I":"IN",1:"OUT"),$P(NODE,"^",9),MSGIEN)=""
86 ...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)=""
87 ..S ^HLB(MSGIEN,0)=NODE
88 .K DEQUE S DEQUE=0
89 Q
90 ;
91ERROR ;error trap
92 S $ETRAP="Q:$QUIT """" Q"
93 N HOUR
94 S HOUR=$E($$NOW^XLFDT,1,10)
95 S ^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2))=$G(^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2)))+1
96 ;
97 D DEQUE()
98 ;
99 ;a lot of errors of the same type may indicate an endless loop
100 ;return to the Process Manager error trap
101 I ($G(^TMP("HL7 ERRORS",$J,HOUR,$P($ECODE,",",2)))>30) Q:$QUIT "" Q
102 ;
103 ;while debugging quit on all errors - returns to the Process Manager error trap
104 I $G(^HLTMP("LOG ALL ERRORS")) Q:$QUIT "" Q
105 I $ECODE["EDITED" Q:$QUIT "" Q
106 ;
107 D ^%ZTER
108 D UNWIND^%ZTER
109 Q:$QUIT ""
110 Q
111 ;
112ERROR2 ;
113 S $ETRAP="Q:$QUIT """" Q"
114 ;
115 D DEQUE()
116 ;
117 ;may need to change the status to Application Error
118 D
119 .N NODE,RAPP,SAPP,FS,CS,REP,ESCAPE,SUBCOMP,HDR,DIR,NOW
120 .S NOW=$$NOW^XLFDT
121 .S NODE=$G(^HLB(MSGIEN,0))
122 .Q:NODE=""
123 .Q:$P(NODE,"^",20)="AE"
124 .S $P(NODE,"^",20)="AE",$P(NODE,"^",21)="APPLICATION ROUTINE ERROR"
125 .S DIR=$S($E($P(NODE,"^",4))="I":"IN",1:"OUT")
126 .I $P(NODE,"^",9) K ^HLB("AD",DIR,$P(NODE,"^",9),MSGIEN)
127 .S $P(NODE,"^",9)=$$FMADD^XLFDT(NOW,,24*QUEUE("SYSTEM","ERROR PURGE"))
128 .S ^HLB(MSGIEN,0)=NODE
129 .S ^HLB("AD",DIR,$P(NODE,"^",9),MSGIEN)=""
130 .S HDR=$G(^HLB(MSGIEN,1))
131 .S FS=$E(HDR,4)
132 .Q:FS=""
133 .S CS=$E(HDR,5)
134 .S REP=$E(HDR,6)
135 .S ESCAPE=$E(HDR,7)
136 .S SUBCOMP=$E(HDR,8)
137 .S RAPP=$$DESCAPE^HLOPRS1($P($P(HDR,FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE)
138 .I RAPP="" S RAPP="UNKNOWN"
139 .S SAPP=$$DESCAPE^HLOPRS1($P($P(HDR,FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
140 .S ^HLB("ERRORS","AE",RAPP,NOW,MSGIEN)=""
141 .D COUNT^HLOESTAT(DIR,RAPP,SAPP,"UNKNOWN")
142 ;
143 ;kill the apps variables
144 D
145 .N ZTSK,MSGIEN,QUEUE
146 .D KILL^XUSCLEAN
147 ;
148 ;release all the locks the app may have set, except Taskman lock
149 L:$D(ZTSK) ^%ZTSCH("TASK",ZTSK):1
150 L:'$D(ZTSK)
151 ;reset HLO's lock
152 L +^HLTMP("HL7 RUNNING PROCESSES",$J):0
153 ;return to processing the next message on the queue
154 S $ECODE=""
155 ;
156 Q:$QUIT ""
157 Q
158ERROR3 ;error trap for application context
159 S $ETRAP="Q:$QUIT """" Q"
160 D ^%ZTER
161 S $ECODE=",UAPPLICATION ERROR,"
162 ;
163 ;drop to the ERROR2 error handler
164 Q:$QUIT ""
165 Q
Note: See TracBrowser for help on using the repository browser.