HLOCLNT.m

HLOCLNT ;ALB/CJM- Client for sending messages - 10/4/94 1pm

 ;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10

 ;

 ;GET WORK function for the process running under the Process Manager

GETWORK(QUE) ;

 ;Input:

 ;  QUE - (pass by reference) These subscripts are used:

 ;    ("LINK")  - <link name>_":"_<port> last obtained

 ;    ("QUEUE") - name of the queue last obtained

 ;Output:

 ;  Function returns 1 if success, 0 if no more work

 ;  QUE -  updated to identify next queue of messages to process.

 ;    ("LINK") - <link name>_":"_<port>

 ;    ("QUEUE") - the named queue on the link

 ;    ("DOWN") - =1 means that the last OPEN attempt failed

 ;

 N LINK,QUEUE

 S LINK=$G(QUE("LINK")),QUEUE=$G(QUE("QUEUE"))

 I (LINK]""),(QUEUE]"") D

 .L -^HLB("QUEUE","OUT",LINK,QUEUE)

 .I '$$CNNCTD(LINK),$$FAILING(.LINK) S QUEUE="" Q

 .F  S QUEUE=$O(^HLB("QUEUE","OUT",LINK,QUEUE)) Q:(QUEUE="")  I '$$STOPPED^HLOQUE("OUT",QUEUE) L +^HLB("QUEUE","OUT",LINK,QUEUE):0  Q:$T

 I (LINK]""),(QUEUE="") D

 .F  S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK=""  D  Q:$L(QUEUE)

 ..I '$$CNNCTD(LINK),$$FAILING(.LINK) Q

 ..S QUEUE="" F  S QUEUE=$O(^HLB("QUEUE","OUT",LINK,QUEUE)) Q:(QUEUE="")  I '$$STOPPED^HLOQUE("OUT",QUEUE) L +^HLB("QUEUE","OUT",LINK,QUEUE):0 Q:$T

 I LINK="" D

 .F  S LINK=$O(^HLB("QUEUE","OUT",LINK)) Q:LINK=""  D  Q:$L(QUEUE)

 ..I '$$CNNCTD(LINK),$$FAILING(.LINK) Q

 ..S QUEUE="" F  S QUEUE=$O(^HLB("QUEUE","OUT",LINK,QUEUE)) Q:(QUEUE="")  I '$$STOPPED^HLOQUE("OUT",QUEUE) L +^HLB("QUEUE","OUT",LINK,QUEUE):0 Q:$T

 S QUE("LINK")=LINK,QUE("QUEUE")=QUEUE,QUE("DOWN")=$G(LINK("DOWN"))

 Q:$L(QUEUE) 1

 D:$G(HLCSTATE("CONNECTED")) CLOSE^HLOT(.HLCSTATE)

 Q 0

 ;

FAILING(LINK) ;

 ;Returns 1 if the link has failed in the last 30 seconds, 0 otherwise

 ;Also returns LINK("DOWN")=1 if the link was failing > 30 seconds ago, not yet known if its up

 ;

 N LASTTIME,SET

 S LINK("DOWN")=0

 S LASTTIME=$G(^HLB("QUEUE","OUT",LINK))

 S SET=$S(LASTTIME]"":1,1:0)

 I SET D

 .I $$HDIFF^XLFDT($H,LASTTIME,2)>30 S ^HLB("QUEUE","OUT",LINK)="",SET=0,LINK("DOWN")=1

 I $D(^HLTMP("FAILING LINKS",LINK)) S LINK("DOWN")=1

 Q SET

 ;

LINKDOWN(HLCSTATE) ;

 D:$G(HLCSTATE("CONNECTED")) CLOSE^HLOT(.HLCSTATE)

 I $D(HLCSTATE("LINK","NAME")),$D(HLCSTATE("LINK","PORT")) D

 .S TO=HLCSTATE("LINK","NAME")_":"_HLCSTATE("LINK","PORT")

 .S ^HLB("QUEUE","OUT",TO)=$H

 .S:'$D(^HLTMP("FAILING LINKS",TO)) ^HLTMP("FAILING LINKS",TO)=$H

 Q

 ;

ERROR ;error trap

 S $ETRAP="D UNWIND^%ZTER"

 D END

 D LINKDOWN(.HLCSTATE)

 ;

 ;while debugging quit on all errors - this will return the process to the Process Manager error trap

 I $G(^HLTMP("LOG ALL ERRORS")) QUIT

 ;

 ;don't log some common errors

 I ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR") D

 .;

 E  D

 .D ^%ZTER

 ;

 ;a lot of errors of the same type may indicate an endless loop, so keep a count

 S ^TMP("HL7 ERRORS",$J,$ECODE)=$G(^TMP("HL7 ERRORS",$J,$ECODE))+1

 ;

 QUIT:($G(^TMP("HL7 ERRORS",$J,$ECODE))>100)  ;return to the Process Manager error trap

 D UNWIND^%ZTER

 Q

 ;

DOWORK(QUEUE) ;sends the messages on the queue

 N $ETRAP,$ESTACK S $ETRAP="G ERROR^HLOCLNT"

 N MSGIEN,DEQUE,SUCCESS,MSGCOUNT

 S DEQUE=0

 S SUCCESS=1

 I '$$CNNCTD(QUEUE("LINK")),'$$CONNECT^HLOCLNT1($P(QUEUE("LINK"),":"),$P(QUEUE("LINK"),":",2),30,.HLCSTATE) Q

 ;

 S (MSGCOUNT,MSGIEN)=0

 F  S MSGIEN=$O(^HLB("QUEUE","OUT",QUEUE("LINK"),QUEUE("QUEUE"),MSGIEN)) Q:'MSGIEN  D  Q:'SUCCESS  Q:MSGCOUNT>1000

 .N UPDATE

 .I $$INC^HLOSITE($NA(^HLB(MSGIEN,"TRIES"))) S SUCCESS=0

 .S:$$TRANSMIT(.HLCSTATE,MSGIEN,.UPDATE) SUCCESS=1

 .Q:('SUCCESS)!('$D(UPDATE))  ;'$D(UPDATE) with SUCCESS=1 means that the message is to be removed from the queue without actually being transmitted

 .D DEQUE(.UPDATE)

 .S MSGCOUNT=MSGCOUNT+1

 .D:HLCSTATE("COUNTS")>4 SAVECNTS^HLOSTAT(.HLCSTATE)

 .;

 .;if the queue was on the down list, and not since shutdown, mark it as up, since a message has been successfully transmitted across it

 .I $G(QUEUE("DOWN"))!$$FAILING(QUEUE("LINK")),'$$IFSHUT^HLOTLNK(QUEUE("LINK")) S QUEUE("DOWN")=0,^HLB("QUEUE","OUT",QUEUE("LINK"))="" K ^HLTMP("FAILING LINKS",QUEUE("LINK"))

 ;

END D DEQUE()

 D SAVECNTS^HLOSTAT(.HLCSTATE)

 Q

CNNCTD(LINK) ;

 ;Connected to LINK?  HLCSTATE must be defined, LINK=<link name>:<port>

 ;

 I ($G(HLCSTATE("LINK","NAME"))=$P(LINK,":")),($G(HLCSTATE("LINK","PORT"))=$P(LINK,":",2)),$G(HLCSTATE("CONNECTED")) Q 1

 Q 0

 ;

DEQUE(UPDATE) ;

 I $D(UPDATE) S DEQUE=DEQUE+1,DEQUE(+UPDATE)=$P(UPDATE,"^",2,99) S:$G(UPDATE("MSA"))]"" DEQUE(+UPDATE,"MSA")=UPDATE("MSA") S:$G(UPDATE("ACTION"))]"" DEQUE(+UPDATE,"ACTION")=UPDATE("ACTION")

 I '$D(UPDATE)!(DEQUE>15) D

 .N MSGIEN S MSGIEN=0

 .F  S MSGIEN=$O(DEQUE(MSGIEN)) Q:'MSGIEN  D

 ..N NODE,TIME

 ..D DEQUE^HLOQUE(QUEUE("LINK"),QUEUE("QUEUE"),"OUT",MSGIEN)

 ..S TIME=$P(DEQUE(MSGIEN),"^")

 ..S NODE=QUEUE("LINK")_"^"_QUEUE("QUEUE")_"^"_$P(DEQUE(MSGIEN),"^",2,99)

 ..S ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN)=NODE

 ..S:$G(DEQUE(MSGIEN,"MSA"))]"" ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN,"MSA")=DEQUE(MSGIEN,"MSA")

 ..S:$G(DEQUE(MSGIEN,"ACTION"))]"" ^HLTMP("CLIENT UPDATES",$J,TIME,MSGIEN,"ACTION")=DEQUE(MSGIEN,"ACTION")

 .K DEQUE S DEQUE=0

 Q

 ;

TRANSMIT(HLCSTATE,MSGIEN,UPDATE) ;

 ;Transmits a single message and if a commit ack was requested reads it.  Updates file 778 with the result.  Queues for the infiler the application accept action if one was requested.

 ;Input:

 ;   HLCSTATE (pass by reference)

 ;   MSGIEN - ien, file 778, of message to be transmitted

 ;Output:

 ;  Function returns 1 on success, 0 on failure

 ;  UPDATE - (pass by reference) to contain updates needed for message

 ;

 N HLMSTATE,MSA,HDR,SUCCESS

 ;

 S SUCCESS=0

 S HLCSTATE("ATTEMPT")=0

 ;

 Q:'$$GETMSG^HLOCLNT2(MSGIEN,.HLMSTATE) 1  ;returns 1 so the message will be removed from the queue

 I HLMSTATE("DT/TM"),HLMSTATE("STATUS","ACCEPTED")!(HLMSTATE("HDR","ACCEPT ACK TYPE")="NE") Q 1  ;the message was already transmitted

 ;

 ;start saving updates needed after the message is transmitted

 S UPDATE=MSGIEN_"^"_$$NOW^XLFDT

RETRY D

 .S HLCSTATE("ATTEMPT")=HLCSTATE("ATTEMPT")+1

 .I 'HLCSTATE("CONNECTED") D OPEN^HLOT(.HLCSTATE)

 .;

 .;try to send the message

 .Q:'$$WRITEMSG^HLOCLNT1(.HLCSTATE,.HLMSTATE)

 .;does the message need an accept ack?

 .I HLMSTATE("HDR","ACCEPT ACK TYPE")="AL" D

 ..N FS

 ..Q:'$$READACK^HLOCLNT1(.HLCSTATE,.HDR,.MSA)

 ..;does the MSA refer to the correct control id?

 ..S FS=$E(HDR(1),4)

 ..Q:$P(MSA,FS,3)'=HLMSTATE("ID")

 ..N ACKID,ACKCODE

 ..S ACKCODE=$P(MSA,FS,2)

 ..S ACKID=$S($E(HDR(1),1,3)="MSH":$P(HDR(2),FS,5),1:$P(HDR(2),FS,6))

 ..S $P(UPDATE,"^",5)=1

 ..S UPDATE("MSA")=ACKID_"^"_MSA

 ..I '(ACKCODE="CA") S $P(UPDATE,"^",3)="SE",$P(UPDATE,"^",4)=2

 ..I ACKCODE="CA",HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):"2",1:1)

 ..I ($P(UPDATE,"^",3)="SE") S $P(UPDATE,"^",6)=$P(HLMSTATE("HDR",1),FS,5) ;errors need the application for xref

 ..;

 ..;did the app request notification of accept ack?

 ..S UPDATE("ACTION")=HLMSTATE("ACCEPT ACK RESPONSE")

 ..S SUCCESS=1

 .E  D  ;accept ack wasn't requested

 ..S SUCCESS=1

 ..I HLMSTATE("HDR","APP ACK TYPE")="NE" S $P(UPDATE,"^",3)="SU",$P(UPDATE,"^",4)=$S(HLMSTATE("BATCH"):2,1:1)

 ;

 I 'SUCCESS,'HLCSTATE("CONNECTED"),(HLCSTATE("ATTEMPT")<2) G RETRY

 I SUCCESS D

 .D COUNT^HLOSTAT(.HLCSTATE,HLMSTATE("HDR","RECEIVING APPLICATION"),HLMSTATE("HDR","SENDING APPLICATION"),$S(HLMSTATE("BATCH"):"BATCH",1:HLMSTATE("HDR","MESSAGE TYPE")_"~"_HLMSTATE("HDR","EVENT")))

 .;if this is an ack to a message need to purge the original message, so store its ien with the purge date

 .S:$G(HLMSTATE("ACK TO IEN")) $P(UPDATE,"^",4)=$P(UPDATE,"^",4)_"-"_HLMSTATE("ACK TO IEN")

 I ('HLCSTATE("CONNECTED"))!('SUCCESS) D LINKDOWN(.HLCSTATE)

 Q SUCCESS

HLOCLNT   ;ALB/CJM- Client for sending messages - 10/4/94 1pm

 +1       ;;1.6;HEALTH LEVEL SEVEN;**126,130,131**;Oct 13, 1995;Build 10

 +2       ;

 +3       ;GET WORK function for the process running under the Process Manager

GETWORK(QUE) ;

 +1       ;Input:

 +2       ;  QUE - (pass by reference) These subscripts are used:

 +3       ;    ("LINK")  - <link name>_":"_<port> last obtained

 +4       ;    ("QUEUE") - name of the queue last obtained

 +5       ;Output:

 +6       ;  Function returns 1 if success, 0 if no more work

 +7       ;  QUE -  updated to identify next queue of messages to process.

 +8       ;    ("LINK") - <link name>_":"_<port>

 +9       ;    ("QUEUE") - the named queue on the link

 +10      ;    ("DOWN") - =1 means that the last OPEN attempt failed

 +11      ;

 +12       NEW LINK,QUEUE

 +13       SET LINK=$GET(QUE("LINK"))

           SET QUEUE=$GET(QUE("QUEUE"))

 +14       IF (LINK]"")

               IF (QUEUE]"")

                   Begin DoDot:1

 +15                   LOCK -^HLB("QUEUE","OUT",LINK,QUEUE)

 +16                   IF '$$CNNCTD(LINK)

                           IF $$FAILING(.LINK)

                               SET QUEUE=""

                               QUIT 

 +17                   FOR 

                           SET QUEUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE))

                           IF (QUEUE="")

                               QUIT 

                           IF '$$STOPPED^HLOQUE("OUT",QUEUE)

                               LOCK +^HLB("QUEUE","OUT",LINK,QUEUE):0

                               IF $TEST

                                   QUIT 

                   End DoDot:1

 +18       IF (LINK]"")

               IF (QUEUE="")

                   Begin DoDot:1

 +19                   FOR 

                           SET LINK=$ORDER(^HLB("QUEUE","OUT",LINK))

                           IF LINK=""

                               QUIT 

                           Begin DoDot:2

 +20                           IF '$$CNNCTD(LINK)

                                   IF $$FAILING(.LINK)

                                       QUIT 

 +21                           SET QUEUE=""

                               FOR 

                                   SET QUEUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE))

                                   IF (QUEUE="")

                                       QUIT 

                                   IF '$$STOPPED^HLOQUE("OUT",QUEUE)

                                       LOCK +^HLB("QUEUE","OUT",LINK,QUEUE):0

                                       IF $TEST

                                           QUIT 

                           End DoDot:2

                           IF $LENGTH(QUEUE)

                               QUIT 

                   End DoDot:1

 +22       IF LINK=""

               Begin DoDot:1

 +23               FOR 

                       SET LINK=$ORDER(^HLB("QUEUE","OUT",LINK))

                       IF LINK=""

                           QUIT 

                       Begin DoDot:2

 +24                       IF '$$CNNCTD(LINK)

                               IF $$FAILING(.LINK)

                                   QUIT 

 +25                       SET QUEUE=""

                           FOR 

                               SET QUEUE=$ORDER(^HLB("QUEUE","OUT",LINK,QUEUE))

                               IF (QUEUE="")

                                   QUIT 

                               IF '$$STOPPED^HLOQUE("OUT",QUEUE)

                                   LOCK +^HLB("QUEUE","OUT",LINK,QUEUE):0

                                   IF $TEST

                                       QUIT 

                       End DoDot:2

                       IF $LENGTH(QUEUE)

                           QUIT 

               End DoDot:1

 +26       SET QUE("LINK")=LINK

           SET QUE("QUEUE")=QUEUE

           SET QUE("DOWN")=$GET(LINK("DOWN"))

 +27       IF $LENGTH(QUEUE)

               QUIT 1

 +28       IF $GET(HLCSTATE("CONNECTED"))

               DO CLOSE^HLOT(.HLCSTATE)

 +29       QUIT 0

 +30      ;

FAILING(LINK) ;

 +1       ;Returns 1 if the link has failed in the last 30 seconds, 0 otherwise

 +2       ;Also returns LINK("DOWN")=1 if the link was failing > 30 seconds ago, not yet known if its up

 +3       ;

 +4        NEW LASTTIME,SET

 +5        SET LINK("DOWN")=0

 +6        SET LASTTIME=$GET(^HLB("QUEUE","OUT",LINK))

 +7        SET SET=$SELECT(LASTTIME]"":1,1:0)

 +8        IF SET

               Begin DoDot:1

 +9                IF $$HDIFF^XLFDT($HOROLOG,LASTTIME,2)>30

                       SET ^HLB("QUEUE","OUT",LINK)=""

                       SET SET=0

                       SET LINK("DOWN")=1

               End DoDot:1

 +10       IF $DATA(^HLTMP("FAILING LINKS",LINK))

               SET LINK("DOWN")=1

 +11       QUIT SET

 +12      ;

LINKDOWN(HLCSTATE) ;

 +1        IF $GET(HLCSTATE("CONNECTED"))

               DO CLOSE^HLOT(.HLCSTATE)

 +2        IF $DATA(HLCSTATE("LINK","NAME"))

               IF $DATA(HLCSTATE("LINK","PORT"))

                   Begin DoDot:1

 +3                    SET TO=HLCSTATE("LINK","NAME")_":"_HLCSTATE("LINK","PORT")

 +4                    SET ^HLB("QUEUE","OUT",TO)=$HOROLOG

 +5                    IF '$DATA(^HLTMP("FAILING LINKS",TO))

                           SET ^HLTMP("FAILING LINKS",TO)=$HOROLOG

                   End DoDot:1

 +6        QUIT 

 +7       ;

ERROR     ;error trap

 +1        SET $ETRAP="D UNWIND^%ZTER"

 +2        DO END

 +3        DO LINKDOWN(.HLCSTATE)

 +4       ;

 +5       ;while debugging quit on all errors - this will return the process to the Process Manager error trap

 +6        IF $GET(^HLTMP("LOG ALL ERRORS"))

               QUIT 

 +7       ;

 +8       ;don't log some common errors

 +9        IF ($ECODE["READ")!($ECODE["NOTOPEN")!($ECODE["DEVNOTOPN")!($ECODE["WRITE")!($ECODE["OPENERR")

               Begin DoDot:1

 +10      ;

               End DoDot:1

 +11      IF '$TEST

               Begin DoDot:1

 +12               DO ^%ZTER

               End DoDot:1

 +13      ;

 +14      ;a lot of errors of the same type may indicate an endless loop, so keep a count

 +15       SET ^TMP("HL7 ERRORS",$JOB,$ECODE)=$GET(^TMP("HL7 ERRORS",$JOB,$ECODE))+1

 +16      ;

 +17      ;return to the Process Manager error trap

           IF ($GET(^TMP("HL7 ERRORS",$JOB,$ECODE))>100)

               QUIT 

 +18       DO UNWIND^%ZTER

 +19       QUIT 

 +20      ;

DOWORK(QUEUE) ;sends the messages on the queue

 +1        NEW $ETRAP,$ESTACK

           SET $ETRAP="G ERROR^HLOCLNT"

 +2        NEW MSGIEN,DEQUE,SUCCESS,MSGCOUNT

 +3        SET DEQUE=0

 +4        SET SUCCESS=1

 +5        IF '$$CNNCTD(QUEUE("LINK"))

               IF '$$CONNECT^HLOCLNT1($PIECE(QUEUE("LINK"),":"),$PIECE(QUEUE("LINK"),":",2),30,.HLCSTATE)

                   QUIT 

 +6       ;

 +7        SET (MSGCOUNT,MSGIEN)=0

 +8        FOR 

               SET MSGIEN=$ORDER(^HLB("QUEUE","OUT",QUEUE("LINK"),QUEUE("QUEUE"),MSGIEN))

               IF 'MSGIEN

                   QUIT 

               Begin DoDot:1

 +9                NEW UPDATE

 +10               IF $$INC^HLOSITE($NAME(^HLB(MSGIEN,"TRIES")))

                       SET SUCCESS=0

 +11               IF $$TRANSMIT(.HLCSTATE,MSGIEN,.UPDATE)

                       SET SUCCESS=1

 +12      ;'$D(UPDATE) with SUCCESS=1 means that the message is to be removed from the queue without actually being transmitted

                   IF ('SUCCESS)!('$DATA(UPDATE))

                       QUIT 

 +13               DO DEQUE(.UPDATE)

 +14               SET MSGCOUNT=MSGCOUNT+1

 +15               IF HLCSTATE("COUNTS")>4

                       DO SAVECNTS^HLOSTAT(.HLCSTATE)

 +16      ;

 +17      ;if the queue was on the down list, and not since shutdown, mark it as up, since a message has been successfully transmitted across it

 +18               IF $GET(QUEUE("DOWN"))!$$FAILING(QUEUE("LINK"))

                       IF '$$IFSHUT^HLOTLNK(QUEUE("LINK"))

                           SET QUEUE("DOWN")=0

                           SET ^HLB("QUEUE","OUT",QUEUE("LINK"))=""

                           KILL ^HLTMP("FAILING LINKS",QUEUE("LINK"))

               End DoDot:1

               IF 'SUCCESS

                   QUIT 

               IF MSGCOUNT>1000

                   QUIT 

 +19      ;

END        DO DEQUE()

 +1        DO SAVECNTS^HLOSTAT(.HLCSTATE)

 +2        QUIT 

CNNCTD(LINK) ;

 +1       ;Connected to LINK?  HLCSTATE must be defined, LINK=<link name>:<port>

 +2       ;

 +3        IF ($GET(HLCSTATE("LINK","NAME"))=$PIECE(LINK,":"))

               IF ($GET(HLCSTATE("LINK","PORT"))=$PIECE(LINK,":",2))

                   IF $GET(HLCSTATE("CONNECTED"))

                       QUIT 1

 +4        QUIT 0

 +5       ;

DEQUE(UPDATE) ;

 +1        IF $DATA(UPDATE)

               SET DEQUE=DEQUE+1

               SET DEQUE(+UPDATE)=$PIECE(UPDATE,"^",2,99)

               IF $GET(UPDATE("MSA"))]""

                   SET DEQUE(+UPDATE,"MSA")=UPDATE("MSA")

               IF $GET(UPDATE("ACTION"))]""

                   SET DEQUE(+UPDATE,"ACTION")=UPDATE("ACTION")

 +2        IF '$DATA(UPDATE)!(DEQUE>15)

               Begin DoDot:1

 +3                NEW MSGIEN

                   SET MSGIEN=0

 +4                FOR 

                       SET MSGIEN=$ORDER(DEQUE(MSGIEN))

                       IF 'MSGIEN

                           QUIT 

                       Begin DoDot:2

 +5                        NEW NODE,TIME

 +6                        DO DEQUE^HLOQUE(QUEUE("LINK"),QUEUE("QUEUE"),"OUT",MSGIEN)

 +7                        SET TIME=$PIECE(DEQUE(MSGIEN),"^")

 +8                        SET NODE=QUEUE("LINK")_"^"_QUEUE("QUEUE")_"^"_$PIECE(DEQUE(MSGIEN),"^",2,99)

 +9                        SET ^HLTMP("CLIENT UPDATES",$JOB,TIME,MSGIEN)=NODE

 +10                       IF $GET(DEQUE(MSGIEN,"MSA"))]""

                               SET ^HLTMP("CLIENT UPDATES",$JOB,TIME,MSGIEN,"MSA")=DEQUE(MSGIEN,"MSA")

 +11                       IF $GET(DEQUE(MSGIEN,"ACTION"))]""

                               SET ^HLTMP("CLIENT UPDATES",$JOB,TIME,MSGIEN,"ACTION")=DEQUE(MSGIEN,"ACTION")

                       End DoDot:2

 +12               KILL DEQUE

                   SET DEQUE=0

               End DoDot:1

 +13       QUIT 

 +14      ;

TRANSMIT(HLCSTATE,MSGIEN,UPDATE) ;

 +1       ;Transmits a single message and if a commit ack was requested reads it.  Updates file 778 with the result.  Queues for the infiler the application accept action if one was requested.

 +2       ;Input:

 +3       ;   HLCSTATE (pass by reference)

 +4       ;   MSGIEN - ien, file 778, of message to be transmitted

 +5       ;Output:

 +6       ;  Function returns 1 on success, 0 on failure

 +7       ;  UPDATE - (pass by reference) to contain updates needed for message

 +8       ;

 +9        NEW HLMSTATE,MSA,HDR,SUCCESS

 +10      ;

 +11       SET SUCCESS=0

 +12       SET HLCSTATE("ATTEMPT")=0

 +13      ;

 +14      ;returns 1 so the message will be removed from the queue

           IF '$$GETMSG^HLOCLNT2(MSGIEN,.HLMSTATE)

               QUIT 1

 +15      ;the message was already transmitted

           IF HLMSTATE("DT/TM")

               IF HLMSTATE("STATUS","ACCEPTED")!(HLMSTATE("HDR","ACCEPT ACK TYPE")="NE")

                   QUIT 1

 +16      ;

 +17      ;start saving updates needed after the message is transmitted

 +18       SET UPDATE=MSGIEN_"^"_$$NOW^XLFDT

RETRY      Begin DoDot:1

 +1            SET HLCSTATE("ATTEMPT")=HLCSTATE("ATTEMPT")+1

 +2            IF 'HLCSTATE("CONNECTED")

                   DO OPEN^HLOT(.HLCSTATE)

 +3       ;

 +4       ;try to send the message

 +5            IF '$$WRITEMSG^HLOCLNT1(.HLCSTATE,.HLMSTATE)

                   QUIT 

 +6       ;does the message need an accept ack?

 +7            IF HLMSTATE("HDR","ACCEPT ACK TYPE")="AL"

                   Begin DoDot:2

 +8                    NEW FS

 +9                    IF '$$READACK^HLOCLNT1(.HLCSTATE,.HDR,.MSA)

                           QUIT 

 +10      ;does the MSA refer to the correct control id?

 +11                   SET FS=$EXTRACT(HDR(1),4)

 +12                   IF $PIECE(MSA,FS,3)'=HLMSTATE("ID")

                           QUIT 

 +13                   NEW ACKID,ACKCODE

 +14                   SET ACKCODE=$PIECE(MSA,FS,2)

 +15                   SET ACKID=$SELECT($EXTRACT(HDR(1),1,3)="MSH":$PIECE(HDR(2),FS,5),1:$PIECE(HDR(2),FS,6))

 +16                   SET $PIECE(UPDATE,"^",5)=1

 +17                   SET UPDATE("MSA")=ACKID_"^"_MSA

 +18                   IF '(ACKCODE="CA")

                           SET $PIECE(UPDATE,"^",3)="SE"

                           SET $PIECE(UPDATE,"^",4)=2

 +19                   IF ACKCODE="CA"

                           IF HLMSTATE("HDR","APP ACK TYPE")="NE"

                               SET $PIECE(UPDATE,"^",3)="SU"

                               SET $PIECE(UPDATE,"^",4)=$SELECT(HLMSTATE("BATCH"):"2",1:1)

 +20      ;errors need the application for xref

                       IF ($PIECE(UPDATE,"^",3)="SE")

                           SET $PIECE(UPDATE,"^",6)=$PIECE(HLMSTATE("HDR",1),FS,5)

 +21      ;

 +22      ;did the app request notification of accept ack?

 +23                   SET UPDATE("ACTION")=HLMSTATE("ACCEPT ACK RESPONSE")

 +24                   SET SUCCESS=1

                   End DoDot:2

 +25      ;accept ack wasn't requested

              IF '$TEST

                   Begin DoDot:2

 +26                   SET SUCCESS=1

 +27                   IF HLMSTATE("HDR","APP ACK TYPE")="NE"

                           SET $PIECE(UPDATE,"^",3)="SU"

                           SET $PIECE(UPDATE,"^",4)=$SELECT(HLMSTATE("BATCH"):2,1:1)

                   End DoDot:2

           End DoDot:1

 +28      ;

 +29       IF 'SUCCESS

               IF 'HLCSTATE("CONNECTED")

                   IF (HLCSTATE("ATTEMPT")<2)

                       GOTO RETRY

 +30       IF SUCCESS

               Begin DoDot:1

 +31               DO COUNT^HLOSTAT(.HLCSTATE,HLMSTATE("HDR","RECEIVING APPLICATION"),HLMSTATE("HDR","SENDING APPLICATION"),$SELECT(HLMSTATE("BATCH"):"BATCH",1:HLMSTATE("HDR","MESSAGE TYPE")_"~"_HLMSTATE("HDR","EVENT")))

 +32      ;if this is an ack to a message need to purge the original message, so store its ien with the purge date

 +33               IF $GET(HLMSTATE("ACK TO IEN"))

                       SET $PIECE(UPDATE,"^",4)=$PIECE(UPDATE,"^",4)_"-"_HLMSTATE("ACK TO IEN")

               End DoDot:1

 +34       IF ('HLCSTATE("CONNECTED"))!('SUCCESS)

               DO LINKDOWN(.HLCSTATE)

 +35       QUIT SUCCESS