Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLOCLNT2

HLOCLNT2.m

Go to the documentation of this file.
  1. HLOCLNT2 ;ALB/CJM- Performs message updates for the client - 10/4/94 1pm ;03/07/2012
  1. ;;1.6;HEALTH LEVEL SEVEN;**126,130,131,133,134,137,143,158**;Oct 13, 1995;Build 14
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. GETWORK(WORK) ;
  1. ;
  1. N OLD,DOLLARJ,SUCCESS,NOW
  1. S SUCCESS=0
  1. S NOW=$$NOW^XLFDT
  1. S (OLD,DOLLARJ)=$G(WORK("DOLLARJ"))
  1. F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" D Q:SUCCESS
  1. .L +^HLTMP("CLIENT UPDATES",DOLLARJ):0
  1. .Q:'$T
  1. .N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,""))
  1. .I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q
  1. .S SUCCESS=1
  1. ;
  1. I OLD'="",'SUCCESS F S DOLLARJ=$O(^HLTMP("CLIENT UPDATES",DOLLARJ)) Q:DOLLARJ="" Q:DOLLARJ>OLD D Q:SUCCESS
  1. .L +^HLTMP("CLIENT UPDATES",DOLLARJ):0
  1. .Q:'$T
  1. .N TIME S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,""))
  1. .I $$FMDIFF^XLFDT(NOW,TIME,2)<2 L -^HLTMP("CLIENT UPDATES",DOLLARJ) Q
  1. .S SUCCESS=1
  1. S WORK("DOLLARJ")=DOLLARJ,WORK("NOW")=NOW
  1. Q $S($L(WORK("DOLLARJ")):1,1:0)
  1. ;
  1. DOWORK(WORK) ;
  1. ;
  1. N DOLLARJ,TIME,IEN,PARMS,SYSTEM
  1. S TIME=""
  1. S DOLLARJ=WORK("DOLLARJ")
  1. D SYSPARMS^HLOSITE(.SYSTEM)
  1. F S TIME=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME)) Q:TIME="" Q:$$FMDIFF^XLFDT(WORK("NOW"),TIME,2)<2 D
  1. .S IEN=0
  1. .F S IEN=$O(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)) Q:'IEN D
  1. ..N NODE
  1. ..S NODE=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN))
  1. ..S PARMS("LINK")=$P(NODE,"^")
  1. ..S PARMS("QUEUE")=$P(NODE,"^",2)
  1. ..S PARMS("STATUS")=$P(NODE,"^",3)
  1. ..S PARMS("PURGE")=$P(NODE,"^",4)
  1. ..S PARMS("ACK TO IEN")=+$P($P(NODE,"^",4),"-",2)
  1. ..S PARMS("ACCEPT ACK")=$P(NODE,"^",5)
  1. ..S PARMS("RECEIVING APP")=$P(NODE,"^",6)
  1. ..S:PARMS("RECEIVING APP")="" PARMS("RECEIVING APP")="UNKNOWN RECEIVING APPLICATION"
  1. ..S PARMS("MSA")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"MSA"))
  1. ..S PARMS("ACTION")=$G(^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN,"ACTION"))
  1. ..D UPDATE(IEN,TIME,.PARMS)
  1. ..K ^HLTMP("CLIENT UPDATES",DOLLARJ,TIME,IEN)
  1. L -^HLTMP("CLIENT UPDATES",DOLLARJ)
  1. Q
  1. ;
  1. UPDATE(MSGIEN,TIME,PARMS) ;
  1. S:PARMS("STATUS")]"" $P(^HLB(MSGIEN,0),"^",20)=PARMS("STATUS")
  1. I PARMS("STATUS")="ER" D
  1. .S ^HLB("ERRORS",PARMS("RECEIVING APP"),TIME,MSGIEN_"^")=""
  1. .D COUNT^HLOESTAT("OUT",PARMS("RECEIVING APP"),$$GETSAP(MSGIEN),$$GETMTYPE(MSGIEN))
  1. S:PARMS("ACCEPT ACK") $P(^HLB(MSGIEN,0),"^",17)=PARMS("ACCEPT ACK")
  1. S $P(^HLB(MSGIEN,0),"^",16)=TIME
  1. S:PARMS("MSA")]"" ^HLB(MSGIEN,4)=TIME_"^"_PARMS("MSA")
  1. I PARMS("PURGE"),PARMS("ACTION")="" D SETPURGE^HLOF778A(MSGIEN,PARMS("STATUS"),PARMS("ACK TO IEN"))
  1. D:PARMS("ACTION")]""
  1. .N PURGE
  1. .S PURGE=PARMS("PURGE")
  1. .S:PARMS("ACK TO IEN") PURGE("ACKTOIEN")=PARMS("ACK TO IEN")
  1. .D INQUE^HLOQUE(PARMS("LINK"),PARMS("QUEUE"),MSGIEN,PARMS("ACTION"),.PURGE)
  1. Q
  1. ;
  1. GETMSG(IEN,MSG) ;
  1. ;
  1. ;Description: given the message ien=MSGIEN (required), it returns the MSG array containing information about the message, defined below.
  1. ;Input:
  1. ; IEN - the ien of the message in file 778
  1. ;Output:
  1. ; Function returns 1 on success, 0 on failure
  1. ; MSG (pass by reference, required) These are the subscripts returned:
  1. ; "ACCEPT ACK RESPONSE" - if the sending app requested notification of the accept ack, this is the routine to perform
  1. ; "ACK TO IEN" - if this is an app ack to a message not in a batch, this is the ien of the original message
  1. ; "ACK BY"
  1. ; "STATUS"
  1. ; "BATCH" = 1 if this is a batch message, 0 if not
  1. ; "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.
  1. ; "BODY" - ptr to file 778 which contains the body of the message.
  1. ; "LINE COUNT" - a counter used during writing of the
  1. ; messages to indicate the current line. For
  1. ; batch messages where each message within the batch is stored
  1. ; separately, this field indicates the position within the current
  1. ; individual message
  1. ; "HDR" at these lower subscripts:
  1. ; 1 - components 1-6
  1. ; 2 - components 7-end
  1. ; "ACCEPT ACK TYPE" = "AL" or "NE"
  1. ; "APP ACK TYPE" = "AL" or "NE"
  1. ; "MESSAGE CONTROL ID" - defined if NOT batch
  1. ; "BATCH CONTROL ID" - defined if batch
  1. ;
  1. ; "ID" - message id from the header
  1. ; "IEN" - ien, file 778
  1. ; "STATUS","SEQUENCE QUEUE")=name of the sequence queue (optional)
  1. ;
  1. K MSG
  1. Q:'$G(IEN) 0
  1. N NODE,FS,CS,REP,SUBCOMP,ESCAPE
  1. S MSG("IEN")=IEN
  1. S NODE=$G(^HLB(IEN,0))
  1. S MSG("BODY")=$P(NODE,"^",2)
  1. S MSG("ID")=$P(NODE,"^")
  1. Q:'MSG("BODY") 0
  1. ;
  1. S MSG("ACK BY")=$P(NODE,"^",7)
  1. S MSG("STATUS")=$P(NODE,"^",20)
  1. ;
  1. ;
  1. S MSG("STATUS","ACCEPTED")=$P(NODE,"^",17)
  1. S MSG("DT/TM")=$P(NODE,"^",16)
  1. S MSG("STATUS","QUEUE")=$P(NODE,"^",6)
  1. I MSG("STATUS","QUEUE")="" S MSG("STATUS","QUEUE")="DEFAULT"
  1. S MSG("ACCEPT ACK RESPONSE")=$P(NODE,"^",12,13)
  1. I MSG("ACCEPT ACK RESPONSE")="^" S MSG("ACCEPT ACK RESPONSE")=""
  1. ;
  1. S MSG("BATCH")=+$P($G(^HLA(MSG("BODY"),0)),"^",2)
  1. I MSG("BATCH") D
  1. .S MSG("BATCH","CURRENT MESSAGE")=0
  1. E D
  1. .N ACKTO
  1. .S ACKTO=$P(NODE,"^",3)
  1. .I ACKTO]"" S ACKTO=$$ACKTOIEN^HLOMSG1(MSG("ID"),ACKTO)
  1. .I ACKTO,+ACKTO=ACKTO S MSG("ACK TO IEN")=ACKTO
  1. S MSG("LINE COUNT")=0
  1. S MSG("HDR",1)=$G(^HLB(IEN,1))
  1. S MSG("HDR",2)=$G(^HLB(IEN,2))
  1. S FS=$E(MSG("HDR",1),4)
  1. S CS=$E(MSG("HDR",1),5)
  1. S REP=$E(MSG("HDR",1),6)
  1. S ESCAPE=$E(MSG("HDR",1),7)
  1. S SUBCOMP=$E(MSG("HDR",1),8)
  1. S MSG("HDR","FIELD SEPARATOR")=FS
  1. S MSG("HDR","SENDING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)
  1. S MSG("HDR","RECEIVING APPLICATION")=$$DESCAPE^HLOPRS1($P($P(MSG("HDR",1),FS,5),CS),FS,CS,SUBCOMP,REP,ESCAPE)
  1. I 'MSG("BATCH") D
  1. .S MSG("HDR","MESSAGE TYPE")=$P($P(MSG("HDR",2),FS,4),CS)
  1. .S MSG("HDR","EVENT")=$P($P(MSG("HDR",2),FS,4),CS,2)
  1. .S MSG("HDR","ACCEPT ACK TYPE")=$E($P(MSG("HDR",2),FS,10),1,2)
  1. .S MSG("HDR","APP ACK TYPE")=$E($P(MSG("HDR",2),FS,11),1,2)
  1. .S MSG("HDR","MESSAGE CONTROL ID")=MSG("ID")
  1. E D
  1. .S MSG("HDR","BATCH CONTROL ID")=MSG("ID")
  1. .S MSG("HDR","ACCEPT ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"ACCEPT ACK TYPE=",2),1,2)
  1. .S MSG("HDR","APP ACK TYPE")=$E($P($P(MSG("HDR",2),FS,4),"APP ACK TYPE=",2),1,2)
  1. S MSG("STATUS","SEQUENCE QUEUE")=$P($G(^HLB(IEN,5)),"^")
  1. Q 1
  1. ;
  1. GETMTYPE(MSGIEN) ;returns <message type>~<event> OR "BATCH"
  1. Q:'$G(MSGIEN) "UNKNOWN"
  1. N FS,CS,HDR1,HDR2
  1. S HDR1=$G(^HLB(IEN,1))
  1. I $E(HDR1,1,3)="BHS" Q "BATCH"
  1. S HDR2=$G(^HLB(IEN,2))
  1. S FS=$E(HDR1,4)
  1. S CS=$E(HDR1,5)
  1. Q $P($P(HDR2,FS,4),CS)_"~"_$P($P(HDR2,FS,4),CS,2)
  1. ;
  1. GETEVENT(MSGIEN) ; returns event if not a batch message
  1. Q:'$G(MSGIEN) ""
  1. N FS,CS,HDR1,HDR2
  1. S HDR1=$G(^HLB(MSGIEN,1))
  1. I $E(HDR1,1,3)="BHS" Q ""
  1. S HDR2=$G(^HLB(MSGIEN,2))
  1. S FS=$E(HDR1,4)
  1. S CS=$E(HDR1,5)
  1. Q $P($P(HDR2,FS,4),CS,2)
  1. ;
  1. GETSAP(MSGIEN) ;
  1. ;
  1. ;
  1. Q:'$G(MSGIEN) "UNKNOWN"
  1. N FS,CS,HDR1,REP,ESCAPE,SUBCOMP
  1. S HDR1=$G(^HLB(MSGIEN,1))
  1. S FS=$E(HDR1,4)
  1. S CS=$E(HDR1,5)
  1. S REP=$E(HDR1,6)
  1. S ESCAPE=$E(HDR1,7)
  1. S SUBCOMP=$E(HDR1,8)
  1. Q $$DESCAPE^HLOPRS1($P($P(HDR1,FS,3),CS),FS,CS,SUBCOMP,REP,ESCAPE)