Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOFILER.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOFILER.m
r613 r623 1 HLOFILER ;ALB/CJM- Passes messages on the incoming queue to the applications - 10/4/94 1pm ;07/10/20072 ;;1.6;HEALTH LEVEL SEVEN;**126,131,134,137**;Oct 13, 1995;Build 21 3 4 5 6 GETWORK(QUE) 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 DOWORK(QUEUE) 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 ENDWORK 65 66 67 68 DEQUE(MSGIEN,PURGE,ACKTOIEN) 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 ERROR 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 ERROR2 113 114 115 116 117 ;may need to change the status toError118 119 120 121 122 123 .Q:$P(NODE,"^",20)="ER"124 .S $P(NODE,"^",20)="ER",$P(NODE,"^",21)="APPLICATION ROUTINE ERROR"125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 .S ^HLB("ERRORS",RAPP,NOW,MSGIEN)=""141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 ERROR3 159 160 161 162 163 164 165 1 HLOFILER ;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 6 GETWORK(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 ; 35 DOWORK(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 ; 64 ENDWORK ;where the execution resumes upon an error 65 D DEQUE() 66 Q 67 ; 68 DEQUE(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 ; 91 ERROR ;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 ; 112 ERROR2 ; 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 158 ERROR3 ;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 TracChangeset
for help on using the changeset viewer.
