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

HLMA2.m

Go to the documentation of this file. 
  1. HLMA2 ;AISC/SAW-Message Administration Module ;09/23/2005  17:45
  1.  ;;1.6;HEALTH LEVEL SEVEN;**19,43,57,58,64,65,76,82,91,94,109,120**;Oct 13, 1995;Build 12
  1.  ; References to ^ORD(101) supported by IA# 1373.
  1.  ;
  1. SEND(EIDS,MTIEN,CLIENT,PRIORITY,MTIENS,LOGLINK) ;
  1.  ;Entry point to create
  1.  ;an entry in the Message Administrator and Message Text
  1.  ;files for a message that is about to be sent to a recipient
  1.  ;
  1.  ;This is a subroutine call with parameter passing.  It returns a value
  1.  ;in the variable MTIENS with 1 to 3 pieces separated by uparrows
  1.  ;as follows:  MTIENS^error code^error description
  1.  ;If no error occurs, only the first piece is returned equal to the IEN
  1.  ;the entry created in the Message Text or Administration file.
  1.  ;Otherwise, three pieces are returned with the first piece equal to 0
  1.  ;
  1.  ;All the following input parameters are required
  1.  ;    EIDS = The IEN from the Protocol file of the subscriber event
  1.  ;   MTIEN = The IEN from the Message Text file created when the
  1.  ;           GENERATE^HLMA or GENACK^HLMA1 entry points were invoked
  1.  ;  CLIENT = The IEN of the client (subscriber) application from
  1.  ;             the Application Parameter file
  1.  ;PRIORITY = I for immediate or D for deferred
  1.  ;  MTIENS = The variable that will be returned to the calling
  1.  ;             application as described above
  1.  ;Optional parameter
  1.  ; LOGLINK = The IEN of the logical link from the Logical Link file
  1.  ;
  1.  ;     ACK = 1 or 0 to indicate if original message or response-passed
  1.  ;             by ^HLCS
  1.  ;
  1.  ; Save passed parameters for restore... HL*1.6*94
  1.  N HL94P
  1.  ;
  1.  ; patch HL*1.6*120 start
  1.  ; save the receiving facility from HLSUP("S") variable in routine ADD^HLCS2
  1.  I $G(MTIENS("REC-FACILITY"))]"" D
  1.  . S HLP("REC-FACILITY")=MTIENS("REC-FACILITY")
  1.  ; F HL94P="CONTPTR","NAMESPACE","SECURITY","SUBSCRIBER" D
  1.  F HL94P="CONTPTR","NAMESPACE","SECURITY","SUBSCRIBER","PMOD","REC-FACILITY" D
  1.  .  QUIT:'$D(HLP(HL94P))  ;->
  1.  .  MERGE HL94P(HL94P)=HLP(HL94P)
  1.  ; patch HL*1.6*120 end
  1.  ;
  1.  ;Check for required parameters
  1.  S MTIENS=""
  1.  I '$G(EIDS)!('$G(MTIEN))!('$G(CLIENT))!("ID"'[$E($G(PRIORITY))) S MTIENS="0^7^"_$G(^HL(771.7,7,0))_" at SEND^HLMA entry point" G EXIT
  1.  ;Get message ID and Message Text IEN
  1.  N HLJ,HLHDRBLD,HLMIDS,HLDTS,HLDT1S,HLP,REPLYTO,SERVER,X
  1.  ;
  1.  ; Restore parameters if needed... HL*1.6*94
  1.  S HL94P=""
  1.  F  S HL94P=$O(HL94P(HL94P)) Q:HL94P']""  D
  1.  .  MERGE HLP(HL94P)=HL94P(HL94P)
  1.  ;
  1.  ;check if LL is TCP
  1.  I $G(LOGLINK) D  Q:MTIENS!($G(HLERROR)]"")
  1.  . ;quit if it is not TCP
  1.  . Q:$P(^HLCS(870,LOGLINK,0),U,3)'=4
  1.  . ;create client in 773, MTIENS=ien in 773
  1.  . S (MTIENS,HLTCP)=$$MA^HLTF(MTIEN,.HLMIDS)
  1.  .;
  1.  .;**109
  1.  .; F  L +^HLMA(MTIENS):1 Q:$T  H 1
  1.  .;
  1.  . D MIDAR(HLMIDS)
  1.  . ;get info from parent (772)
  1.  . S X=^HL(772,MTIEN,0),HLTYPE=$P(X,U,14),SERVER=$P(X,U,2),REPLYTO=$P(X,U,7)
  1.  . ;get ack timeout override
  1.  . S:$P($G(^HL(772,MTIEN,"P")),U,7) HLP("ACKTIME")=+$P(^("P"),U,7)
  1.  . ;get message type and event type from protocol
  1.  . S X=$G(^ORD(101,EIDS,770)),HLP("MTYPE")=$P(X,U,11),HLP("EVENT")=$P(X,U,4),HLP("HLTCPI")=MTIENS
  1.  . S:$P(X,U,5) HLP("MTYPE_EVENT")=$P(X,U,5)
  1.  . ;update date in client (773)
  1.  . D UPDATE^HLTF0(MTIENS,"","O",EIDS,CLIENT,SERVER,"D",REPLYTO,"",.HLP)
  1.  . ;create header for message in 773
  1.  . I (HLTYPE="M") D HEADER^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
  1.  . I (HLTYPE'="M") D BHSHDR^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
  1.  . ;if error set status to ERROR DURING TRANSMISSION
  1.  . I ($G(HLERROR)'="") D  Q
  1.  ..;**109**
  1.  ..; D STATUS^HLTF0(MTIENS,4,12,HLERROR) L -^HLMA(MTIENS)
  1.  .. D STATUS^HLTF0(MTIENS,4,12,HLERROR)
  1.  ..;
  1.  .. S MTIENS="0^12^"_$G(^HL(771.7,12,0))_" in HLCSHDR1"
  1.  .. Q
  1.  . ;do we still need MTIEN=ien of file 772
  1.  . S MTIEN=""
  1.  . ;update status of 773 to PENDING TRANSMISSION
  1.  . D STATUS^HLTF0(MTIENS,1)
  1.  . ;set header, HLHDR and Logical Link in 773
  1.  . K HLJ
  1.  . S X=MTIENS_",",HLJ(773,X,7)=LOGLINK,HLJ(773,X,200)="HLHDR"
  1.  . D FILE^HLDIE("","HLJ","","SEND","HLMA2") ;HL*1.6*109
  1.  .D ENQUE^HLCSREP(LOGLINK,"O",MTIENS)
  1.  .;
  1.  .;**109
  1.  .; L -^HLMA(MTIENS)
  1.  ;
  1.  ;if not TCP get msg. ID
  1.  S HLMIDS=$P($G(^HL(772,MTIEN,0)),"^",6)
  1.  ;create child message
  1.  D CREATE^HLTF(.HLMIDS,.MTIENS,.HLDTS,.HLDT1S),MIDAR(HLMIDS)
  1.  ;Link new Message Text file entry to MTIENG entry and update fields
  1.  ;on zero node
  1.  D UPDATE^HLTF0(MTIENS,MTIEN,"O",EIDS,CLIENT,"",PRIORITY,"",$S($G(LOGLINK):LOGLINK,1:""))
  1. EXIT Q
  1.  ;
  1. MIDAR(X) ;update HLMIDAR array with X=message id
  1.  Q:$G(X)=""
  1.  I 'HLMIDAR S HLMIDAR("N")=1,HLMIDAR=X Q
  1.  S HLMIDAR(HLMIDAR("N"))=X,HLMIDAR("N")=HLMIDAR("N")+1
  1.  Q
  1.  ;
  1. DC ;direct connect
  1.  N CLIENT,EIDS,HLMIDS,LOGLINK,MTIEN,MTIENS,POP,HLHDR,HLHDRO,HLMSA,REPLYTO,SERVER,X,HLTCPI
  1.  N HLCSOUT,HLDBACK,HLDBSIZE,HLDP,HLDREAD,HLDRETR,HLDWAIT,HLMSG,HLOS,HLPORT,HLTCPADD,HLTCPCS,HLTCPLNK,HLTCPO,HLTCPORT,HLRESP,HLTYPE,HLRETRA,HLRETRY,HLTCPRET
  1.  S (EIDS,LOGLINK)="",MTIEN=HLMTIEN
  1.  I $D(HLL("LINKS")) D
  1.  . S EIDS=$P(HLL("LINKS",1),U),LOGLINK=$P(HLL("LINKS",1),U,2)
  1.  . K HLL("LINKS")
  1.  . Q:EIDS=""  I EIDS<1 S EIDS=$O(^ORD(101,"B",EIDS,0))
  1.  . Q:LOGLINK=""  I LOGLINK<1 S LOGLINK=$O(^HLCS(870,"B",LOGLINK,0))
  1.  . S CLIENT=+$$PTR^HLUTIL2(EIDS)
  1.  I 'LOGLINK!'EIDS D
  1.  . S EIDS=+$O(^ORD(101,HLEID,775,0)) Q:'EIDS  S EIDS=$P($G(^(EIDS,0)),U)
  1.  . S X=$$PTR^HLUTIL2(EIDS),CLIENT=$P(X,U),LOGLINK=$P(X,U,2)
  1.  I 'EIDS S HLERROR="15^Invalid Subscriber for Immediate connection" Q
  1.  I 'LOGLINK S HLERROR="15^Invalid Logical Link for Immediate connection" Q
  1.  I CLIENT<0 S HLERROR="15^Invalid Subscriber Protocol for Immediate connection" Q
  1.  ;open connection
  1.  I '$$DCOPEN^HLCSTCP(LOGLINK) S HLERROR="15^Connection Failed" Q
  1.  ;create client in 773
  1.  S HLDP=LOGLINK,(MTIENS,HLTCP,HLTCPI,HLMSG)=$$MA^HLTF(MTIEN,.HLMIDS)
  1.  ;
  1.  ; patch HL*1.6*120 start
  1.  S HLMIDAR("HLMID")=$G(HLMIDS)
  1.  S HLMIDAR("IEN773")=MTIENS
  1.  ; patch HL*1.6*120 end
  1.  ;
  1.  ;**109**
  1.  ;F  L +^HLMA(MTIENS):1 Q:$T  H 1
  1.  ;
  1.  ;get info from parent (772)
  1.  S X=^HL(772,MTIEN,0),HLTYPE=$P(X,U,14),SERVER=$P(X,U,2),REPLYTO=$P(X,U,7)
  1.  ;get ack timeout override
  1.  S:$P($G(^HL(772,MTIEN,"P")),U,7) HLP("ACKTIME")=+$P(^("P"),U,7)
  1.  ;get message type and event type from protocol
  1.  S X=$G(^ORD(101,EIDS,770)),HLP("MTYPE")=$P(X,U,11),HLP("EVENT")=$P(X,U,4),HLP("HLTCPI")=MTIENS
  1.  S:$P(X,U,5) HLP("MTYPE_EVENT")=$P(X,U,5)
  1.  ;update date in client (773)
  1.  D UPDATE^HLTF0(MTIENS,"","O",EIDS,CLIENT,SERVER,"I",REPLYTO,"",.HLP)
  1.  ;create header for message in 773
  1.  I (HLTYPE="M") D HEADER^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
  1.  I (HLTYPE'="M") D BHSHDR^HLCSHDR1(MTIENS,CLIENT,.HLERROR)
  1.  ;if error set status to ERROR DURING TRANSMISSION
  1.  I ($G(HLERROR)'="") D  Q
  1.  .;
  1.  .;**109**
  1.  .; D STATUS^HLTF0(MTIENS,4,12,HLERROR) L -^HLMA(MTIENS)
  1.  . D STATUS^HLTF0(MTIENS,4,12,HLERROR)
  1.  .;
  1.  . S MTIENS="0^12^"_$G(^HL(771.7,12,0))_" in HLCSHDR1"
  1.  .;
  1.  .;**109**
  1.  .; L -^HLMA(HLMSG) D MON^HLCSTCP("Idle")
  1.  . D MON^HLCSTCP("Idle")
  1.  .;
  1.  . Q
  1.  ;set header, HLHDR and Logical Link in 773
  1.  K HLJ S X=MTIENS_",",HLJ(773,X,7)=LOGLINK,HLJ(773,X,200)="HLHDR"
  1.  ;
  1.  D FILE^HLDIE("","HLJ","","DC","HLMA2") ; HL*1.6*109
  1.  ;
  1.  ;**109**
  1.  D LLCNT^HLCSTCP(LOGLINK,3)
  1.  ;
  1.  D DCSEND^HLCSTCP2
  1.  G EXIT2:'$G(HLRESP)
  1.  ;X=ien in 773^ien in 772 for response
  1.  S X=HLRESP D INIT^HLTP3A  ;patch HL*1.6*109 - hltp3 routine split
  1.  D:'$G(HL) STATUS^HLTF0(HLMTIENS,3,,,1)
  1.  S HLMTIENR=HLMTIEN
  1.  D EXIT^HLTP3
  1. EXIT2 ;
  1.  ;**109**
  1.  ;L -^HLMA(HLMSG)
  1.  Q