Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/HEALTH_LEVEL_SEVEN-HL/HLOAPI1.m

    r613 r623  
    1 HLOAPI1 ;ALB/CJM-HL7 - Developer API's for sending & receiving messages(continued) ;07/18/2007
    2         ;;1.6;HEALTH LEVEL SEVEN;**126,132,134,137**;Oct 13, 1995;Build 21
    3         ;Per VHA Directive 2004-038, this routine should not be modified.
    4         ;
    5 SENDONE(HLMSTATE,PARMS,WHOTO,ERROR)     ;
    6         ;Sends the message to a single receiving application.
    7         ;
    8         ;Input:
    9         ;HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message.  The application MUST NOT touch it
    10         ;PARMS( *pass by reference*
    11         ;  "APP ACK RESPONSE")=<tag^routine> to call when the app ack is received (optional)
    12         ;    (NOTE: For batch messages, HLO best supports returning application
    13         ;     acknowledgments via a batch response.  However, non-VistA systems
    14         ;     may return individual messages as application acknowledgments to
    15         ;     messages within the original batch message, so for applications
    16         ;     sending batch messages might best code the "APP ACK RESPONSE"
    17         ;     routine to first check whether the response message is a batch.
    18         ;
    19         ;  "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
    20         ;  "ACCEPT ACK TYPE") = <AL,NE> (optional, defaults to AL)
    21         ;  "APP ACK TYPE") = <AL,NE> (optional, defaults to NE)
    22         ;  "FAILURE RESPONSE" - <tag>^<routine> (optional) The sending application routine to execute when the transmission of the message fails, i.e., the message can not be sent or no commit ack is received.
    23         ;  "QUEUE" - (optional) An application can name its own private queue - just a string up to 20 characters, it should be namespaced.
    24         ;  "SECURITY")=security information to include in the header segment, SEQ 8 (optional)
    25         ;  "SENDING APPLICATION")=name of sending app (required, 60 maximum length)
    26         ;
    27         ;  WHOTO (required,pass by reference) an array specifying a single recipient. These subscripts are allowed:
    28         ;
    29         ;    "RECEIVING APPLICATION" - (string, 60 char max, required)
    30         ;
    31         ;  EXACTLY ONE of these parameters must be provided to identify the Receiving Facility:
    32         ;
    33         ;   "FACILITY LINK IEN" - ien of the logical link
    34         ;   "FACILITY LINK NAME" - name of the logical link
    35         ;   "INSTITUTION IEN" - ptr to the INSTITUTION file
    36         ;   "STATION NUMBER" -  station # with suffix
    37         ;
    38         ;  EXACTLY ONE of these MAY be provided - optionally - to identify the interface engine to route the message through:
    39         ;
    40         ;   "IE LINK IEN" -  ptr to a logical link for the interface engine
    41         ;   "IE LINK NAME" - name of the logical link for the interface engine
    42         ;
    43         ;Output:
    44         ;  Function returns the ien of the message in file 778 on success, 0 on failure
    45         ;   HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message.  The application MUST NOT touch it!
    46         ;   ERROR (pass by reference, optional) - on failure, will contain an error message
    47         ;   PARMS - left undefined when the function returns
    48         ;   WHOTO - left undefined when the function returns
    49         ;
    50         ;
    51         N SUCCESS,ERR1,ERR2
    52         S SUCCESS=0
    53         D
    54         .I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) S ERROR="MESSAGE NOT YET CREATED" Q
    55         .;
    56         .I $$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERR1)&$$CHKWHO^HLOAPI2(.HLMSTATE,.WHOTO,.ERR2) D
    57         ..I $$SEND(.HLMSTATE,.ERROR) S SUCCESS=1
    58         .E  D
    59         ..S ERROR=$G(ERR1)_": "_$G(ERR2)
    60         ..D DONTSEND(.HLMSTATE,ERROR)
    61         K PARMS,WHOTO
    62         Q $S(SUCCESS:HLMSTATE("IEN"),1:0)
    63         ;
    64 SENDMANY(HLMSTATE,PARMS,WHOTO)  ;
    65         ;Sends the message to a list of receiving applications
    66         ;
    67         ;Input: Same as for $$SENDONE, except WHOTO is a list.
    68         ;  WHOTO (pass by reference)
    69         ;    Specifies a list of recipients.  Each recipient should be on the
    70         ;    list as WHOTO(i), where i=1,2,3,4, etc. for as many messages as to
    71         ;    send.  At each subscript WHOTO(i), the same lower level subscripts
    72         ;    may be defined as in the $$SENDONE API.  For example:
    73         ;
    74         ;      WHOTO(1,"LINK NAME")="VAALB"
    75         ;      WHOTO(1,"RECEIVING APPLICATION")="MPI"
    76         ;      WHOTO(2,"STATION NUMBER")=500
    77         ;      WHOTO(2,"RECEIVING APPLICATION")="MPI"
    78         ;
    79         ;
    80         ;Output:
    81         ;  Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
    82         ;  PARMS - left undefined when the function returns
    83         ;  WHOTO (pass by reference) returns the status of each message to be sent in the format:
    84         ;    (<i>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
    85         ;   (<i>,"IEN")=<ien, file 778>
    86         ;   (<i>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
    87         ;
    88         ;
    89         N ERROR,RETURN,WHO,STATE,I
    90         S RETURN=1
    91         I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) D  K PARMS Q 0
    92         .S ERROR="MESSAGE NOT YET CREATED"
    93         .S I=0 F  S I=$O(WHOTO(I)) Q:'I  S WHOTO(I,"QUEUED")=0,WHOTO(I,"IEN")=0,WHOTO(I,"ERROR")=ERROR
    94         ;
    95         I '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR) D  K PARMS Q 0
    96         .S I=0 F  S I=$O(WHOTO(I)) Q:'I  D
    97         ..K WHO M WHO=WHOTO(I)
    98         ..K STATE M STATE=HLMSTATE S STATE("IEN")=""
    99         ..S WHOTO(I,"QUEUED")=0
    100         ..D DONTSEND(.STATE,$G(ERROR))
    101         ..S WHOTO(I,"IEN")=$G(STATE("IEN"))
    102         ..S WHOTO(I,"ERROR")=ERROR
    103         ;
    104         S I=0 F  S I=$O(WHOTO(I)) Q:'I  D
    105         .K WHO M WHO=WHOTO(I)
    106         .K STATE M STATE=HLMSTATE S STATE("IEN")=""
    107         .S ERROR=""
    108         .I $$CHKWHO^HLOAPI2(.STATE,.WHO,.ERROR) D
    109         ..I $$SEND(.STATE,.ERROR) D
    110         ...S WHOTO(I,"QUEUED")=1
    111         ...S WHOTO(I,"IEN")=STATE("IEN")
    112         ...S WHOTO(I,"ERROR")=""
    113         ..E  D
    114         ...S WHOTO(I,"QUEUED")=0
    115         ...S WHOTO(I,"IEN")=$G(STATE("IEN"))
    116         ...S WHOTO(I,"ERROR")=$G(ERROR)
    117         ...S RETURN=0
    118         .E  D  ;who not adequately determined
    119         ..S WHOTO(I,"QUEUED")=0,RETURN=0
    120         ..D DONTSEND(.STATE,$G(ERROR))
    121         ..S WHOTO(I,"IEN")=$G(STATE("IEN")),WHOTO(I,"ERROR")=$G(ERROR)
    122         K PARMS
    123         Q RETURN
    124         ;
    125 SENDSUB(HLMSTATE,PARMS,MESSAGES)        ;
    126         ;Sends the message to a list of receiving applications based on the HL7 Subscription Registry
    127         ;
    128         ;Input:
    129         ;  HLMSTATE (pass by reference, required) same as $$SENDMANY
    130         ;  PARMS (pass by reference, required) same as $$SENDMANY, with one additional subscript:
    131         ;    "SUBSCRIPTION IEN" - the ien of an entry in the HL7 Subscription Registry, defining the intended recipients of this message
    132         ;
    133         ;Output:
    134         ;  Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
    135         ;  PARMS - left undefined when the function returns
    136         ;  MESSAGES (pass by reference) returns the status of each message to be sent in this format, where subien is the ien of the recipient in the RECIPEINTS subfile of the HL7 Subscription Registry
    137         ;   (<subien>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
    138         ;   (<subien>,"IEN")=<ien, file 778>
    139         ;   (<subien>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
    140         ;
    141         ;
    142         K MESSAGES
    143         N ERROR,RETURN,STATE,SUBIEN,WHO
    144         ;
    145         S RETURN=1
    146         ;
    147         ;
    148         I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) S ERROR="MESSAGE NOT YET CREATED" K PARMS Q 0
    149         I '$G(PARMS("SUBSCRIPTION IEN")) S ERROR="SUBSCRIPTION REGISTRY IEN NOT PROVIDED" K PARMS Q 0
    150         ;
    151         I '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR) D  K PARMS Q 0
    152         .S SUBIEN=0 F  S SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO) Q:'SUBIEN  D
    153         ..N SARY,HARY
    154         ..S HARY="STATE(""HDR"")"
    155         ..S SARY="STATE(""STATUS"")"
    156         ..K STATE M STATE=HLMSTATE S STATE("IEN")=""
    157         ..;move parameters into HLMSTATE
    158         ..S @SARY@("LINK IEN")=WHO("LINK IEN")
    159         ..S @SARY@("LINK NAME")=WHO("LINK NAME")
    160         ..S @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
    161         ..M @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
    162         ..D DONTSEND(.STATE,$G(ERROR))
    163         ..S MESSAGES(SUBIEN,"QUEUED")=0
    164         ..S MESSAGES(SUBIEN,"IEN")=$G(STATE("IEN"))
    165         ..S MESSAGES(SUBIEN,"ERROR")=$G(ERROR)
    166         ;
    167         F  S SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO) Q:'SUBIEN  D
    168         .N SARY,HARY
    169         .S HARY="STATE(""HDR"")"
    170         .S SARY="STATE(""STATUS"")"
    171         .K STATE M STATE=HLMSTATE S STATE("IEN")=""
    172         .;move parameters into HLMSTATE
    173         .S @SARY@("LINK IEN")=WHO("LINK IEN")
    174         .S @SARY@("LINK NAME")=WHO("LINK NAME")
    175         .S @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
    176         .M @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
    177         .S ERROR=""
    178         .I $$SEND(.STATE,.ERROR) D
    179         ..S MESSAGES(SUBIEN,"QUEUED")=1
    180         .E  D
    181         ..S MESSAGES(SUBIEN,"QUEUED")=0,RETURN=0
    182         .S MESSAGES(SUBIEN,"IEN")=$G(STATE("IEN")),MESSAGES(SUBIEN,"ERROR")=$G(ERROR)
    183         K PARMS
    184         Q RETURN
    185         ;
    186 SEND(HLMSTATE,ERROR)    ;
    187         ;
    188         K ERROR
    189         I HLMSTATE("UNSTORED LINES"),'$$SAVEMSG^HLOF777(.HLMSTATE) S ERROR="$$SAVE^HLOF777 FAILED!" Q 0
    190         ;
    191         I '$$SAVEMSG^HLOF778(.HLMSTATE) S ERROR="$$SAVE^HLOF778 FAILED!" Q 0
    192         I HLMSTATE("BATCH"),$L($G(HLMSTATE("STATUS","SEQUENCE QUEUE"))) S ERROR="SEQUENCE QUEUES NOT SUPPORTED FOR BATCH MESSAGES" Q 0
    193         I $L($G(HLMSTATE("STATUS","SEQUENCE QUEUE"))) D
    194         .S HLMSTATE("STATUS","MOVED TO OUT QUEUE")=$$SQUE^HLOQUE(HLMSTATE("STATUS","SEQUENCE QUEUE"),HLMSTATE("STATUS","LINK NAME"),$G(HLMSTATE("STATUS","PORT")),HLMSTATE("STATUS","QUEUE"),HLMSTATE("IEN")) D:HLMSTATE("STATUS","MOVED TO OUT QUEUE")
    195         ..S $P(^HLB(HLMSTATE("IEN"),5),"^",2)=1
    196         E  D
    197         .D OUTQUE^HLOQUE(HLMSTATE("STATUS","LINK NAME"),$G(HLMSTATE("STATUS","PORT")),HLMSTATE("STATUS","QUEUE"),HLMSTATE("IEN"))
    198         Q HLMSTATE("IEN")
    199         ;
    200 DONTSEND(HLMSTATE,ERROR)        ;
    201         ;This procedure does NOT send a message.  Rather, it creates an entry in file 778 with the status ER. 
    202         ;Input:
    203         ;       HLMSTATE - pass-by-reference
    204         ;       ERROR (optional, pass-by-value) error text to store with the message
    205         ;Output: none
    206         ;
    207         I HLMSTATE("UNSTORED LINES"),'$$SAVEMSG^HLOF777(.HLMSTATE) ; just continue
    208         ;
    209         S HLMSTATE("STATUS")="ER"
    210         S HLMSTATE("STATUS","PURGE")=$$FMADD^XLFDT(HLMSTATE("DT/TM CREATED"),HLMSTATE("SYSTEM","ERROR PURGE"))
    211         S HLMSTATE("STATUS","ERROR TEXT")=$G(ERROR)
    212         I '$$SAVEMSG^HLOF778(.HLMSTATE) ;already reported an error to the app
    213         Q
     1HLOAPI1 ;ALB/CJM-HL7 - Developer API's for sending & receiving messages(continued) ;02/06/2007
     2 ;;1.6;HEALTH LEVEL SEVEN;**126,132,134**;Oct 13, 1995;Build 30
     3 ;Per VHA Directive 2004-038, this routine should not be modified.
     4 ;
     5SENDONE(HLMSTATE,PARMS,WHOTO,ERROR) ;
     6 ;Sends the message to a single receiving application.
     7 ;
     8 ;Input:
     9 ;HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message.  The application MUST NOT touch it
     10 ;PARMS( *pass by reference*
     11 ;  "APP ACK RESPONSE")=<tag^routine> to call when the app ack is received (optional)
     12 ;    (NOTE: For batch messages, HLO best supports returning application
     13 ;     acknowledgments via a batch response.  However, non-VistA systems
     14 ;     may return individual messages as application acknowledgments to
     15 ;     messages within the original batch message, so for applications
     16 ;     sending batch messages might best code the "APP ACK RESPONSE"
     17 ;     routine to first check whether the response message is a batch.
     18 ;
     19 ;  "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
     20 ;  "ACCEPT ACK TYPE") = <AL,NE> (optional, defaults to AL)
     21 ;  "APP ACK TYPE") = <AL,NE> (optional, defaults to NE)
     22 ;  "FAILURE RESPONSE" - <tag>^<routine> (optional) The sending application routine to execute when the transmission of the message fails, i.e., the message can not be sent or no commit ack is received.
     23 ;  "QUEUE" - (optional) An application can name its own private queue - just a string up to 20 characters, it should be namespaced.
     24 ;  "SECURITY")=security information to include in the header segment, SEQ 8 (optional)
     25 ;  "SENDING APPLICATION")=name of sending app (required, 60 maximum length)
     26 ;
     27 ;  WHOTO (required,pass by reference) an array specifying a single recipient. These subscripts are allowed:
     28 ;
     29 ;    "RECEIVING APPLICATION" - (string, 60 char max, required)
     30 ;
     31 ;  EXACTLY ONE of these parameters must be provided to identify the Receiving Facility:
     32 ;
     33 ;   "FACILITY LINK IEN" - ien of the logical link
     34 ;   "FACILITY LINK NAME" - name of the logical link
     35 ;   "INSTITUTION IEN" - ptr to the INSTITUTION file
     36 ;   "STATION NUMBER" -  station # with suffix
     37 ;
     38 ;  EXACTLY ONE of these MAY be provided - optionally - to identify the interface engine to route the message through:
     39 ;
     40 ;   "IE LINK IEN" -  ptr to a logical link for the interface engine
     41 ;   "IE LINK NAME" - name of the logical link for the interface engine
     42 ;
     43 ;Output:
     44 ;  Function returns the ien of the message in file 778 on success, 0 on failure
     45 ;   HLMSTATE() - (pass by reference, required) This array is used by the HL7 package to track the progress of the message.  The application MUST NOT touch it!
     46 ;   ERROR (pass by reference, optional) - on failure, will contain an error message
     47 ;   PARMS - left undefined when the function returns
     48 ;   WHOTO - left undefined when the function returns
     49 ;
     50 ;
     51 N SUCCESS,ERR1,ERR2
     52 S SUCCESS=0
     53 D
     54 .I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) S ERROR="MESSAGE NOT YET CREATED" Q
     55 .;
     56 .I $$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERR1)&$$CHKWHO(.HLMSTATE,.WHOTO,.ERR2) D
     57 ..I $$SEND(.HLMSTATE,.ERROR) S SUCCESS=1
     58 .E  D
     59 .S ERROR=$G(ERR1)_": "_$G(ERR2)
     60 .D DONTSEND(.HLMSTATE,ERROR)
     61 K PARMS,WHOTO
     62 Q $S(SUCCESS:HLMSTATE("IEN"),1:0)
     63 ;
     64SENDMANY(HLMSTATE,PARMS,WHOTO) ;
     65 ;Sends the message to a list of receiving applications
     66 ;
     67 ;Input: Same as for $$SENDONE, except WHOTO is a list.
     68 ;  WHOTO (pass by reference)
     69 ;    Specifies a list of recipients.  Each recipient should be on the
     70 ;    list as WHOTO(i), where i=1,2,3,4, etc. for as many messages as to
     71 ;    send.  At each subscript WHOTO(i), the same lower level subscripts
     72 ;    may be defined as in the $$SENDONE API.  For example:
     73 ;
     74 ;      WHOTO(1,"LINK NAME")="VAALB"
     75 ;      WHOTO(1,"RECEIVING APPLICATION")="MPI"
     76 ;      WHOTO(2,"STATION NUMBER")=500
     77 ;      WHOTO(2,"RECEIVING APPLICATION")="MPI"
     78 ;
     79 ;
     80 ;Output:
     81 ;  Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
     82 ;  PARMS - left undefined when the function returns
     83 ;  WHOTO (pass by reference) returns the status of each message to be sent in the format:
     84 ;    (<i>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
     85 ;   (<i>,"IEN")=<ien, file 778>
     86 ;   (<i>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
     87 ;
     88 ;
     89 N ERROR,RETURN,WHO,STATE,I
     90 S RETURN=1
     91 I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) D  K PARMS Q 0
     92 .S ERROR="MESSAGE NOT YET CREATED"
     93 .S I=0 F  S I=$O(WHOTO(I)) Q:'I  S WHOTO(I,"QUEUED")=0,WHOTO(I,"IEN")=0,WHOTO(I,"ERROR")=ERROR
     94 ;
     95 I '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR) D  K PARMS Q 0
     96 .S I=0 F  S I=$O(WHOTO(I)) Q:'I  D
     97 ..K WHO M WHO=WHOTO(I)
     98 ..K STATE M STATE=HLMSTATE S STATE("IEN")=""
     99 ..S WHOTO(I,"QUEUED")=0
     100 ..D DONTSEND(.STATE,$G(ERROR))
     101 ..S WHOTO(I,"IEN")=$G(STATE("IEN"))
     102 ..S WHOTO(I,"ERROR")=ERROR
     103 ;
     104 S I=0 F  S I=$O(WHOTO(I)) Q:'I  D
     105 .K WHO M WHO=WHOTO(I)
     106 .K STATE M STATE=HLMSTATE S STATE("IEN")=""
     107 .S ERROR=""
     108 .I $$CHKWHO(.STATE,.WHO,.ERROR) D
     109 ..I $$SEND(.STATE,.ERROR) D
     110 ...S WHOTO(I,"QUEUED")=1
     111 ...S WHOTO(I,"IEN")=STATE("IEN")
     112 ...S WHOTO(I,"ERROR")=""
     113 ..E  D
     114 ...S WHOTO(I,"QUEUED")=0
     115 ...S WHOTO(I,"IEN")=$G(STATE("IEN"))
     116 ...S WHOTO(I,"ERROR")=$G(ERROR)
     117 ...S RETURN=0
     118 .E  D  ;who not adequately determined
     119 ..S WHOTO(I,"QUEUED")=0,RETURN=0
     120 ..D DONTSEND(.STATE,$G(ERROR))
     121 ..S WHOTO(I,"IEN")=$G(STATE("IEN")),WHOTO(I,"ERROR")=$G(ERROR)
     122 K PARMS
     123 Q RETURN
     124 ;
     125SENDSUB(HLMSTATE,PARMS,MESSAGES) ;
     126 ;Sends the message to a list of receiving applications based on the HL7 Subscription Registry
     127 ;
     128 ;Input:
     129 ;  HLMSTATE (pass by reference, required) same as $$SENDMANY
     130 ;  PARMS (pass by reference, required) same as $$SENDMANY, with one additional subscript:
     131 ;    "SUBSCRIPTION IEN" - the ien of an entry in the HL7 Subscription Registry, defining the intended recipients of this message
     132 ;
     133 ;Output:
     134 ;  Function returns 1 if a message is queued to be sent to each intended recipient, 0 otherwise
     135 ;  PARMS - left undefined when the function returns
     136 ;  MESSAGES (pass by reference) returns the status of each message to be sent in this format, where subien is the ien of the recipient in the RECIPEINTS subfile of the HL7 Subscription Registry
     137 ;   (<subien>,"QUEUED")= <1 if queued to be sent, 0 otherwise)
     138 ;   (<subien>,"IEN")=<ien, file 778>
     139 ;   (<subien>,"ERROR")= error message if an error was encountered (status=0), not defined otherwise
     140 ;
     141 ;
     142 K MESSAGES
     143 N ERROR,RETURN,STATE,SUBIEN,WHO
     144 ;
     145 S RETURN=1
     146 ;
     147 ;
     148 I '$G(HLMSTATE("BODY")),'$G(HLMSTATE("UNSTORED LINES")) S ERROR="MESSAGE NOT YET CREATED" K PARMS Q 0
     149 I '$G(PARMS("SUBSCRIPTION IEN")) S ERROR="SUBSCRIPTION REGISTRY IEN NOT PROVIDED" K PARMS Q 0
     150 ;
     151 I '$$CHKPARMS^HLOAPI2(.HLMSTATE,.PARMS,.ERROR) D  K PARMS Q 0
     152 .S SUBIEN=0 F  S SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO) Q:'SUBIEN  D
     153 ..N SARY,HARY
     154 ..S HARY="STATE(""HDR"")"
     155 ..S SARY="STATE(""STATUS"")"
     156 ..K STATE M STATE=HLMSTATE S STATE("IEN")=""
     157 ..;move parameters into HLMSTATE
     158 ..S @SARY@("LINK IEN")=WHO("LINK IEN")
     159 ..S @SARY@("LINK NAME")=WHO("LINK NAME")
     160 ..S @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
     161 ..M @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
     162 ..D DONTSEND(.STATE,$G(ERROR))
     163 ..S MESSAGES(SUBIEN,"QUEUED")=0
     164 ..S MESSAGES(SUBIEN,"IEN")=$G(STATE("IEN"))
     165 ..S MESSAGES(SUBIEN,"ERROR")=$G(ERROR)
     166 ;
     167 F  S SUBIEN=$$NEXT^HLOASUB(PARMS("SUBSCRIPTION IEN"),.WHO) Q:'SUBIEN  D
     168 .N SARY,HARY
     169 .S HARY="STATE(""HDR"")"
     170 .S SARY="STATE(""STATUS"")"
     171 .K STATE M STATE=HLMSTATE S STATE("IEN")=""
     172 .;move parameters into HLMSTATE
     173 .S @SARY@("LINK IEN")=WHO("LINK IEN")
     174 .S @SARY@("LINK NAME")=WHO("LINK NAME")
     175 .S @HARY@("RECEIVING APPLICATION")=WHO("RECEIVING APPLICATION")
     176 .M @HARY@("RECEIVING FACILITY")=WHO("RECEIVING FACILITY")
     177 .S ERROR=""
     178 .I $$SEND(.STATE,.ERROR) D
     179 ..S MESSAGES(SUBIEN,"QUEUED")=1
     180 .E  D
     181 ..S MESSAGES(SUBIEN,"QUEUED")=0,RETURN=0
     182 .S MESSAGES(SUBIEN,"IEN")=$G(STATE("IEN")),MESSAGES(SUBIEN,"ERROR")=$G(ERROR)
     183 K PARMS
     184 Q RETURN
     185 ;
     186SEND(HLMSTATE,ERROR) ;
     187 ;
     188 K ERROR
     189 I HLMSTATE("UNSTORED LINES"),'$$SAVEMSG^HLOF777(.HLMSTATE) S ERROR="$$SAVE^HLOF777 FAILED!" Q 0
     190 ;
     191 I '$$SAVEMSG^HLOF778(.HLMSTATE) S ERROR="$$SAVE^HLOF778 FAILED!" Q 0
     192 D OUTQUE^HLOQUE(HLMSTATE("STATUS","LINK NAME"),$G(HLMSTATE("STATUS","PORT")),HLMSTATE("STATUS","QUEUE"),HLMSTATE("IEN"))
     193 Q HLMSTATE("IEN")
     194 ;
     195DONTSEND(HLMSTATE,ERROR) ;
     196 ;This procedure does NOT send a message.  Rather, it creates an entry in file 778 with the
     197 ;of "SE". 
     198 ;Input:
     199 ;       HLMSTATE - pass-by-reference
     200 ;       ERROR (optional, pass-by-value) error text to store with the message
     201 ;Output: none
     202 ;
     203 I HLMSTATE("UNSTORED LINES"),'$$SAVEMSG^HLOF777(.HLMSTATE) ; just continue
     204 ;
     205 S HLMSTATE("STATUS")="SE"
     206 S HLMSTATE("STATUS","PURGE")=$$FMADD^XLFDT(HLMSTATE("DT/TM CREATED"),HLMSTATE("SYSTEM","ERROR PURGE"))
     207 S HLMSTATE("STATUS","ERROR TEXT")=$G(ERROR)
     208 I '$$SAVEMSG^HLOF778(.HLMSTATE) ;already reported an error to the app
     209 Q
     210 ;
     211CHKWHO(HLMSTATE,WHOTO,ERROR) ;
     212 N RETURN,I
     213 S RETURN=1
     214 I '$$CHECKWHO^HLOASUB1(.WHOTO,.RETURN,.ERROR) S RETURN=0
     215 ;
     216 ;move parameters into HLMSTATE
     217 S HLMSTATE("STATUS","LINK IEN")=$G(RETURN("LINK IEN"))
     218 S HLMSTATE("STATUS","LINK NAME")=$G(RETURN("LINK NAME"))
     219 S HLMSTATE("STATUS","PORT")=$P($G(RETURN("RECEIVING FACILITY",2)),":",2)
     220 S HLMSTATE("HDR","RECEIVING APPLICATION")=$G(RETURN("RECEIVING APPLICATION"))
     221 F I=1:1:3 S HLMSTATE("HDR","RECEIVING FACILITY",I)=$G(RETURN("RECEIVING FACILITY",I))
     222 Q RETURN
Note: See TracChangeset for help on using the changeset viewer.