Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOCLNT2.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/HLOCLNT2.m
r613 r623 1 HLOCLNT2 ;ALB/CJM- Performs message updates for the client - 10/4/94 1pm ;07/10/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,133,134,137**;Oct 13, 1995;Build 21 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 GETWORK(WORK) ; 6 ; 7 N OLD,DOLLARJ,SUCCESS,NOW 8 S SUCCESS=0 9 S NOW=$$NOW^XLFDT 10 S (OLD,DOLLARJ)=$G(WORK("DOLLARJ")) 11 F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS 12 .L +^HLTMP("CLIENT UPDATES",DOLLARJ):0 13 .Q:'$T 14 .N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,"")) 15 .I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q 16 .S SUCCESS=1 17 ; 18 I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS 19 .L +^HLTMP("CLIENT UPDATES",DOLLARJ):0 20 .Q:'$T 21 .N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,"")) 22 .I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q 23 .S SUCCESS=1 24 S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW 25 Q $S($L(WORK("DOLLARJ")):1,1:0) 26 ; 27 DOWORK(WORK) ; 28 ; 29 N DOLLARJ,TIME,IEN,PARMS,SYSTEM 30 S TIME="" 31 S DOLLARJ=WORK("DOLLARJ") 32 D SYSPARMS^HLOSITE(.SYSTEM) 33 F S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME)) Q:TIME="" Q:$$FMDIFF^XLFDT(WORK("NOW"),TIME,2)<2 D 34 .S IEN=0 35 .F S IEN=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)) Q:'IEN D 36 ..N NODE 37 ..S NODE=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)) 38 ..S PARMS("LINK")=$P(NODE,"^") 39 ..S PARMS("QUEUE")=$P(NODE,"^",2) 40 ..S PARMS("STATUS")=$P(NODE,"^",3) 41 ..S PARMS("PURGE TYPE")=$P(NODE,"^",4) 42 ..S PARMS("ACK TO IEN")=+$P($P(NODE,"^",4),"-",2) 43 ..S PARMS("ACCEPT ACK")=$P(NODE,"^",5) 44 ..S PARMS("RECEIVING APP")=$P(NODE,"^",6) 45 ..S:PARMS("RECEIVING APP")="" PARMS("RECEIVING APP")="UNKNOWN RECEIVING APPLICATION" 46 ..S PARMS("MSA")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"MSA")) 47 ..S PARMS("ACTION")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"ACTION")) 48 ..D UPDATE(IEN,TIME,.PARMS) 49 ..K ^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN) 50 L -^HLTMP("CLIENT UPDATES",DOLLARJ) 51 Q 52 ; 53 UPDATE(MSGIEN,TIME,PARMS) ; 54 S:PARMS("STATUS")]"" $P(^HLB(MSGIEN,0),"^",20)=PARMS("STATUS") 55 I PARMS("STATUS")="ER" D 56 .S ^HLB("ERRORS",PARMS("RECEIVING APP"),TIME,MSGIEN_"^")="" 57 .D COUNT^HLOESTAT("OUT",PARMS("RECEIVING APP"),$$GETSAP(MSGIEN),$$GETMTYPE(MSGIEN)) 58 S:PARMS("ACCEPT ACK") $P(^HLB(MSGIEN,0),"^",17)=PARMS("ACCEPT ACK") 59 S $P(^HLB(MSGIEN,0),"^",16)=TIME 60 S:PARMS("MSA")]"" ^HLB(MSGIEN,4)=TIME_"^"_PARMS("MSA") 61 I PARMS("PURGE TYPE"),PARMS("ACTION")="" D 62 .;don't set purge if going on the infiler - let infiler do it 63 .N PTIME 64 .S:(PARMS("PURGE TYPE")=2) PTIME=$$FMADD^XLFDT(TIME,SYSTEM("ERROR PURGE")) ;error purge is in days 65 .S:(PARMS("PURGE TYPE")'=2) PTIME=$$FMADD^XLFDT(TIME,,SYSTEM("NORMAL PURGE")) ;normal purge is in hours 66 .S $P(^HLB(MSGIEN,0),"^",9)=PTIME,^HLB("AD","OUT",PTIME,MSGIEN)="" 67 .I PARMS("ACK TO IEN"),$D(^HLB(PARMS("ACK TO IEN"),0)) S $P(^HLB(PARMS("ACK TO IEN"),0),"^",9)=PTIME,^HLB("AD","OUT",PTIME,PARMS("ACK TO IEN"))="" 68 D:PARMS("ACTION")]"" 69 .N PURGE 70 .S PURGE=$S(PARMS("PURGE TYPE"):1,1:0) 71 .S:PARMS("ACK TO IEN") PURGE("ACKTOIEN")=PARMS("ACK TO IEN") 72 .D INQUE^HLOQUE(PARMS("LINK"),PARMS("QUEUE"),MSGIEN,PARMS("ACTION"),.PURGE) 73 Q 74 ; 75 GETMSG(IEN,MSG) ; 76 ; 77 ;Description: given the message ien=MSGIEN (required), it returns the MSG array containing information about the message, defined below. 78 ;Input: 79 ; IEN - the ien of the message in file 778 80 ;Output: 81 ; Function returns 1 on success, 0 on failure 82 ; MSG (pass by reference, required) These are the subscripts returned: 83 ; "ACCEPT ACK RESPONSE" - if the sending app requested notification of the accept ack, this is the routine to perform 84 ; "ACKTOIEN" - if this is an app ack to a message not in a batch, this is the ien of the original message 85 ; "BATCH" = 1 if this is a batch message, 0 if not 86 ; "CURRENT MESSAGE" - defined only for batch messages - a counterused during building and parsing messages to indicate the current message. It will be set to 0 initially. 87 ; "BODY" - ptr to file 778 which contains the body of the message. 88 ; "LINE COUNT" - a counter used during writing of the 89 ; messages to indicate the current line. For 90 ; batch messages where each message within the batch is stored 91 ; separately, this field indicates the position within the current 92 ; individual message 93 ; "HDR" at these lower subscripts: 94 ; 1 - components 1-6 95 ; 2 - components 7-end 96 ; "ACCEPT ACK TYPE" = "AL" or "NE" 97 ; "APP ACK TYPE" = "AL" or "NE" 98 ; "MESSAGE CONTROL ID" - defined if NOT batch 99 ; "BATCH CONTROL ID" - defined if batch 100 ; 101 ; "ID" - message id from the header 102 ; "IEN" - ien, file 778 103 ; "STATUS","SEQUENCE QUEUE")=name of the sequence queue (optional) 104 ; 105 K MSG 106 Q:'$G(IEN) 0 107 N NODE,FS,CS,REP,SUBCOMP,ESCAPE 108 S MSG("IEN")=IEN 109 S NODE=$G(^HLB(IEN,0)) 110 S MSG("BODY")=$P(NODE,"^",2) 111 S MSG("ID")=$P(NODE,"^") 112 Q:'MSG("BODY") 0 113 S MSG("STATUS","ACCEPTED")=$P(NODE,"^",17) 114 S MSG("DT/TM")=$P(NODE,"^",16) 115 S MSG("STATUS","QUEUE")=$P(NODE,"^",6) 116 I MSG("STATUS","QUEUE")="" S MSG("STATUS","QUEUE")="DEFAULT" 117 S MSG("ACCEPT ACK RESPONSE")=$P(NODE,"^",12,13) 118 I MSG("ACCEPT ACK RESPONSE")="^" S MSG("ACCEPT ACK RESPONSE")="" 119 ; 120 S MSG("BATCH")=+$P($G(^HLA(MSG("BODY"),0)),"^",2) 121 I MSG("BATCH") D 122 .S MSG("BATCH","CURRENT MESSAGE")=0 123 E D 124 .N ACKTO 125 .S ACKTO=$P(NODE,"^",3) 126 .I ACKTO]"" S ACKTO=$$ACKTOIEN^HLOMSG1(MSG("ID"),ACKTO) 127 .I ACKTO,+ACKTO=ACKTO S MSG("ACK TO IEN")=ACKTO 128 S MSG("LINE COUNT")=0 129 S MSG("HDR",1)=$G(^HLB(IEN,1)) 130 S MSG("HDR",2)=$G(^HLB(IEN,2)) 131 S FS=$E(MSG("HDR",1),4) 132 S CS=$E(MSG("HDR",1),5) 133 S REP=$E(MSG("HDR",1),6) 134 S ESCAPE=$E(MSG("HDR",1),7) 135 S SUBCOMP=$E(MSG("HDR",1),8) 136 S MSG("HDR","FIELD SEPARATOR")=FS 137 S MSG("HDR","SENDING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE) 138 S MSG("HDR","RECEIVING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE) 139 I 'MSG("BATCH") D 140 .S MSG("HDR","MESSAGE TYPE")=$P($P(MSG("HDR",2),FS,4),CS) 141 .S MSG("HDR","EVENT")=$P($P(MSG("HDR",2),FS,4),CS,2) 142 .S MSG("HDR","ACCEPT ACK TYPE")=$E($P(MSG("HDR",2),FS,10),1,2) 143 .S MSG("HDR","APP ACK TYPE")=$E($P(MSG("HDR",2),FS,11),1,2) 144 .S MSG("HDR","MESSAGE CONTROL ID")=MSG("ID") 145 E D 146 .S MSG("HDR","BATCH CONTROL ID")=MSG("ID") 147 .S MSG("HDR","ACCEPT ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"ACCEPT ACK TYPE=",2),1,2) 148 .S MSG("HDR","APP ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"APP ACK TYPE=",2),1,2) 149 S MSG("STATUS","SEQUENCE QUEUE")=$P($G(^HLB(IEN,5)),"^") 150 Q 1 151 ; 152 GETMTYPE(MSGIEN) ;returns <message type>~<event> OR "BATCH" 153 Q:'$G(MSGIEN) "UNKNOWN" 154 N FS,CS,HDR1,HDR2 155 S HDR1=$G(^HLB(IEN,1)) 156 I $E(HDR1,1,3)="BHS" Q "BATCH" 157 S HDR2=$G(^HLB(IEN,2)) 158 S FS=$E(HDR1,4) 159 S CS=$E(HDR1,5) 160 Q $P($P(HDR2,FS,4),CS)_"~"_$P($P(HDR2,FS,4),CS,2) 161 ; 162 GETEVENT(MSGIEN) ; returns event if not a batch message 163 Q:'$G(MSGIEN) "" 164 N FS,CS,HDR1,HDR2 165 S HDR1=$G(^HLB(MSGIEN,1)) 166 I $E(HDR1,1,3)="BHS" Q "" 167 S HDR2=$G(^HLB(MSGIEN,2)) 168 S FS=$E(HDR1,4) 169 S CS=$E(HDR1,5) 170 Q $P($P(HDR2,FS,4),CS,2) 171 ; 172 GETSAP(MSGIEN) ; 173 ; 174 ; 175 Q:'$G(MSGIEN) "UNKNOWN" 176 N FS,CS,HDR1,REP,ESCAPE,SUBCOMP 177 S HDR1=$G(^HLB(MSGIEN,1)) 178 S FS=$E(HDR1,4) 179 S CS=$E(HDR1,5) 180 S REP=$E(HDR1,6) 181 S ESCAPE=$E(HDR1,7) 182 S SUBCOMP=$E(HDR1,8) 183 Q $$DESCAPE^HLOPRS1($P($P(HDR1,FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE) 1 HLOCLNT2 ;ALB/CJM- Performs message updates for the client - 10/4/94 1pm ;03/09/2007 2 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,133,134**;Oct 13, 1995;Build 30 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 GETWORK(WORK) ; 6 ; 7 N OLD,DOLLARJ,SUCCESS,NOW 8 S SUCCESS=0 9 S NOW=$$NOW^XLFDT 10 S (OLD,DOLLARJ)=$G(WORK("DOLLARJ")) 11 F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS 12 .L +^HLTMP("CLIENT UPDATES",DOLLARJ):0 13 .Q:'$T 14 .N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,"")) 15 .I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q 16 .S SUCCESS=1 17 ; 18 I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS 19 .L +^HLTMP("CLIENT UPDATES",DOLLARJ):0 20 .Q:'$T 21 .N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,"")) 22 .I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q 23 .S SUCCESS=1 24 S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW 25 Q $S($L(WORK("DOLLARJ")):1,1:0) 26 ; 27 DOWORK(WORK) ; 28 ; 29 N DOLLARJ,TIME,IEN,PARMS,SYSTEM 30 S TIME="" 31 S DOLLARJ=WORK("DOLLARJ") 32 D SYSPARMS^HLOSITE(.SYSTEM) 33 F S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME)) Q:TIME="" Q:$$FMDIFF^XLFDT(WORK("NOW"),TIME,2)<2 D 34 .S IEN=0 35 .F S IEN=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)) Q:'IEN D 36 ..N NODE 37 ..S NODE=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)) 38 ..S PARMS("LINK")=$P(NODE,"^") 39 ..S PARMS("QUEUE")=$P(NODE,"^",2) 40 ..S PARMS("STATUS")=$P(NODE,"^",3) 41 ..S PARMS("PURGE TYPE")=$P(NODE,"^",4) 42 ..S PARMS("ACK TO IEN")=+$P($P(NODE,"^",4),"-",2) 43 ..S PARMS("ACCEPT ACK")=$P(NODE,"^",5) 44 ..S PARMS("RECEIVING APP")=$P(NODE,"^",6) 45 ..S:PARMS("RECEIVING APP")="" PARMS("RECEIVING APP")="UNKNOWN RECEIVING APPLICATION" 46 ..S PARMS("MSA")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"MSA")) 47 ..S PARMS("ACTION")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"ACTION")) 48 ..D UPDATE(IEN,TIME,.PARMS) 49 ..K ^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN) 50 L -^HLTMP("CLIENT UPDATES",DOLLARJ) 51 Q 52 ; 53 UPDATE(MSGIEN,TIME,PARMS) ; 54 S:PARMS("STATUS")]"" $P(^HLB(MSGIEN,0),"^",20)=PARMS("STATUS") 55 S:PARMS("STATUS")="SE" ^HLB("ERRORS","SE",PARMS("RECEIVING APP"),TIME,MSGIEN)="" 56 S:PARMS("STATUS")="AE" ^HLB("ERRORS","AE",PARMS("RECEIVING APP"),TIME,MSGIEN_"^")="" 57 I PARMS("STATUS")["E" D COUNT^HLOESTAT("OUT",PARMS("RECEIVING APP"),$$GETSAP(MSGIEN),$$GETMTYPE(MSGIEN)) 58 S:PARMS("ACCEPT ACK") $P(^HLB(MSGIEN,0),"^",17)=PARMS("ACCEPT ACK") 59 S $P(^HLB(MSGIEN,0),"^",16)=TIME 60 S:PARMS("MSA")]"" ^HLB(MSGIEN,4)=TIME_"^"_PARMS("MSA") 61 I PARMS("PURGE TYPE"),PARMS("ACTION")="" D 62 .;don't set purge if going on the infiler - let infiler do it 63 .N PTIME 64 .S:(PARMS("PURGE TYPE")=2) PTIME=$$FMADD^XLFDT(TIME,SYSTEM("ERROR PURGE")) ;error purge is in days 65 .S:(PARMS("PURGE TYPE")'=2) PTIME=$$FMADD^XLFDT(TIME,,SYSTEM("NORMAL PURGE")) ;normal purge is in hours 66 .S $P(^HLB(MSGIEN,0),"^",9)=PTIME,^HLB("AD","OUT",PTIME,MSGIEN)="" 67 .I PARMS("ACK TO IEN"),$D(^HLB(PARMS("ACK TO IEN"),0)) S $P(^HLB(PARMS("ACK TO IEN"),0),"^",9)=PTIME,^HLB("AD","OUT",PTIME,PARMS("ACK TO IEN"))="" 68 D:PARMS("ACTION")]"" 69 .N PURGE 70 .S PURGE=$S(PARMS("PURGE TYPE"):1,1:0) 71 .S:PARMS("ACK TO IEN") PURGE("ACKTOIEN")=PARMS("ACK TO IEN") 72 .D INQUE^HLOQUE(PARMS("LINK"),PARMS("QUEUE"),MSGIEN,PARMS("ACTION"),.PURGE) 73 Q 74 ; 75 GETMSG(IEN,MSG) ; 76 ; 77 ;Description: given the message ien=MSGIEN (required), it returns the MSG array containing information about the message, defined below. 78 ;Input: 79 ; IEN - the ien of the message in file 778 80 ;Output: 81 ; Function returns 1 on success, 0 on failure 82 ; MSG (pass by reference, required) These are the subscripts returned: 83 ; "ACCEPT ACK RESPONSE" - if the sending app requested notification of the accept ack, this is the routine to perform 84 ; "ACKTOIEN" - if this is an app ack to a message not in a batch, this is the ien of the original message 85 ; "BATCH" = 1 if this is a batch message, 0 if not 86 ; "CURRENT MESSAGE" - defined only for batch messages - a counterused during building and parsing messages to indicate the current message. It will be set to 0 initially. 87 ; "BODY" - ptr to file 778 which contains the body of the message. 88 ; "LINE COUNT" - a counter used during writing of the 89 ; messages to indicate the current line. For 90 ; batch messages where each message within the batch is stored 91 ; separately, this field indicates the position within the current 92 ; individual message 93 ; "HDR" at these lower subscripts: 94 ; 1 - components 1-6 95 ; 2 - components 7-end 96 ; "ACCEPT ACK TYPE" = "AL" or "NE" 97 ; "APP ACK TYPE" = "AL" or "NE" 98 ; "MESSAGE CONTROL ID" - defined if NOT batch 99 ; "BATCH CONTROL ID" - defined if batch 100 ; 101 ; "ID" - message id from the header 102 ; "IEN" - ien, file 778 103 ; 104 K MSG 105 Q:'$G(IEN) 0 106 N NODE,FS,CS,REP,SUBCOMP,ESCAPE 107 S MSG("IEN")=IEN 108 S NODE=$G(^HLB(IEN,0)) 109 S MSG("BODY")=$P(NODE,"^",2) 110 S MSG("ID")=$P(NODE,"^") 111 Q:'MSG("BODY") 0 112 S MSG("STATUS","ACCEPTED")=$P(NODE,"^",17) 113 S MSG("DT/TM")=$P(NODE,"^",16) 114 S MSG("STATUS","QUEUE")=$P(NODE,"^",6) 115 I MSG("STATUS","QUEUE")="" S MSG("STATUS","QUEUE")="DEFAULT" 116 S MSG("ACCEPT ACK RESPONSE")=$P(NODE,"^",12,13) 117 I MSG("ACCEPT ACK RESPONSE")="^" S MSG("ACCEPT ACK RESPONSE")="" 118 ; 119 S MSG("BATCH")=+$P($G(^HLA(MSG("BODY"),0)),"^",2) 120 I MSG("BATCH") D 121 .S MSG("BATCH","CURRENT MESSAGE")=0 122 E D 123 .N ACKTO 124 .S ACKTO=$P(NODE,"^",3) 125 .I ACKTO]"" S ACKTO=$$ACKTOIEN^HLOMSG1(MSG("ID"),ACKTO) 126 .I ACKTO,+ACKTO=ACKTO S MSG("ACK TO IEN")=ACKTO 127 S MSG("LINE COUNT")=0 128 S MSG("HDR",1)=$G(^HLB(IEN,1)) 129 S MSG("HDR",2)=$G(^HLB(IEN,2)) 130 S FS=$E(MSG("HDR",1),4) 131 S CS=$E(MSG("HDR",1),5) 132 S REP=$E(MSG("HDR",1),6) 133 S ESCAPE=$E(MSG("HDR",1),7) 134 S SUBCOMP=$E(MSG("HDR",1),8) 135 S MSG("HDR","FIELD SEPARATOR")=FS 136 S MSG("HDR","SENDING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE) 137 S MSG("HDR","RECEIVING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE) 138 I 'MSG("BATCH") D 139 .S MSG("HDR","MESSAGE TYPE")=$P($P(MSG("HDR",2),FS,4),CS) 140 .S MSG("HDR","EVENT")=$P($P(MSG("HDR",2),FS,4),CS,2) 141 .S MSG("HDR","ACCEPT ACK TYPE")=$E($P(MSG("HDR",2),FS,10),1,2) 142 .S MSG("HDR","APP ACK TYPE")=$E($P(MSG("HDR",2),FS,11),1,2) 143 .S MSG("HDR","MESSAGE CONTROL ID")=MSG("ID") 144 E D 145 .S MSG("HDR","BATCH CONTROL ID")=MSG("ID") 146 .S MSG("HDR","ACCEPT ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"ACCEPT ACK TYPE=",2),1,2) 147 .S MSG("HDR","APP ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"APP ACK TYPE=",2),1,2) 148 Q 1 149 ; 150 GETMTYPE(MSGIEN) ;returns <message type>~<event> OR "BATCH" 151 Q:'$G(MSGIEN) "UNKNOWN" 152 N FS,CS,HDR1,HDR2 153 S HDR1=$G(^HLB(IEN,1)) 154 I $E(HDR1,1,3)="BHS" Q "BATCH" 155 S HDR2=$G(^HLB(IEN,2)) 156 S FS=$E(HDR1,4) 157 S CS=$E(HDR1,5) 158 Q $P($P(HDR2,FS,4),CS)_"~"_$P($P(HDR2,FS,4),CS,2) 159 ; 160 GETEVENT(MSGIEN) ; returns event if not a batch message 161 Q:'$G(MSGIEN) "" 162 N FS,CS,HDR1,HDR2 163 S HDR1=$G(^HLB(MSGIEN,1)) 164 I $E(HDR1,1,3)="BHS" Q "" 165 S HDR2=$G(^HLB(MSGIEN,2)) 166 S FS=$E(HDR1,4) 167 S CS=$E(HDR1,5) 168 Q $P($P(HDR2,FS,4),CS,2) 169 ; 170 GETSAP(MSGIEN) ; 171 ; 172 ; 173 Q:'$G(MSGIEN) "UNKNOWN" 174 N FS,CS,HDR1,REP,ESCAPE,SUBCOMP 175 S HDR1=$G(^HLB(MSGIEN,1)) 176 S FS=$E(HDR1,4) 177 S CS=$E(HDR1,5) 178 S REP=$E(HDR1,6) 179 S ESCAPE=$E(HDR1,7) 180 S SUBCOMP=$E(HDR1,8) 181 Q $$DESCAPE^HLOPRS1($P($P(HDR1,FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
Note:
See TracChangeset
for help on using the changeset viewer.
