HLOCNRT1 ;ALB/CJM-Generate HL7 Optimized Message ;12/02/2008
;;1.6;HEALTH LEVEL SEVEN;**139**;Oct 13, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
;
;
HLO(PARAMETERS,TRANSFORM) ;
;INPUT -
; PARMAMETERS (optional,pass by reference) The following parameters,
; if specififed, will override what is specied by the Event and
; Subscriber Protocols.
;
; "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
; "ACCEPT ACK TYPE") = <AL,NE>
; "APP ACK TYPE") = <AL,NE>
; "COUNTRY")=3 character country code
; "CONTINUATION POINTER" -indicates a fragmented message
; "EVENT")=3 character event type
; "FAILURE RESPONSE" - <tag>^<routine> 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.
; "MESSAGE STRUCTURE" - MSH 9, component 3 - a code from the standard HL7 table
; "MESSAGE TYPE")=3 character message type
; "PROCESSING MODE" - MSH 11, component 2 - a 1 character code
; "QUEUE" - An application can name its own private queue -just a string up to 20 characters, it should be namespaced.
; "SECURITY")=security information to include in the header segment, SEQ 8
; "SEQUENCE QUEUE") The sequence queue to use, up to 30 characters. It should be namespaced. Requires that application acks be used.
; "SENDING APPLICATION")=name of sending app (60 maximum length)
; "VERSION")=the HL7 Version ID, for example, "2.4"
;
;
; TRANSFORM (optional) A routine that will transform the message
; before the message is sent. The routine must
; have a formal parameter to received the name of the
; array that contains the message. The array may be either
; local or global.The application references the array
; by indirection to add, edit, or delete segments. The
; application may decide not to send the message, in which
; case it should delete the message array.
;
; An application's TRANSFORM routine can loop through the
; segments in the message in this way:
; 1) The application's TRANSFORM routine should be defined
; to accept an input parameter. HLO will set the parameter
; to the name of an array that contains the message, one
; segment per subscript:
;
; MSG(1)=<first segment>
; MSG(2)=<second segment>
; etc.
;
; 2) The application's TRANSFORM routine should loop through
; the message array using indirection:
;
; S I=0 F S I=$O(@MSG@(I)) Q:'I D <process the segment>
;
; *Note: MSG is show here, but the name of of the variable
; is actually whatever the application routine defined as
; its formal input parameter.
;
; 3) The segment value is obtained by:
; S SEGMENT=$G(@MSG@(I)) D <process the segment>
;
; 4) These variables are defined for the application to use
; in parsing segments:
;
; FS - field separator
; CS - component separator
; SUB - subcomponent separator
; REP - repitition separator
; ESC - escape character
;
;
; !!! CAUTION: This API currently has these limitations: !!!
; 1) Each individual segment must fit in a single node.
; 2) It can not be used for batch messages.
;
;OUTPUT:
; Function returns:
; - 0:if the message is not forwarded
; - message ien, file 778: if the message is forwarded
;
; Example 1: The application wants to subscribe to an existing
; message produced by the old HL7 1.6 set of messaging APIs,
; but it wants to route the messages via HLO.
; To accomplish that the application needs to create a
; new subscriber protocol with this M code to the ROUTING LOGIC:
;
; D HLO^HLOCNRT1()
;
; Example 2: Same as example 1, except that the application would
; like to:
; - Change the version of the message to 2.4
; - Strip out the Z segments from the message before sending it. To
; do so, it may devise the following routine:
;
; ZSTRIP^ZZRTN(MSG) ;
; N I S I=0
; F S I=$O(@MSG@(I)) Q:'I D
; .I $E(@MSG@(I),1)="Z" K @MSG@(I)
; Q
;
; Here is the ROUTING LOGIC for the new subscriber protocol:
;
; N PARMS S PARMS("VERSION")=2.4 I $$HLO^CNRT1(.PARMS,"STRIPZ^ZZRTN")
;
; Output: none
;
N HLMSTATE,PARMS,WHO,EVENT,SUBSCRIBER,MARY,SUB
;
;
S EVENT=$G(HLEID)
Q:'EVENT 0
S SUBSCRIBER=$G(HLEIDS)
Q:'SUBSCRIBER 0
;
Q:'$$GETPARMS(EVENT,SUBSCRIBER,.PARMS,.WHO) 0
;
;accept parameters passed in via PARMETERS
F SUB="COUNTRY","CONTINUATION POINTER","EVENT","MESSAGE TYPE","PROCESSING MODE","MESSAGE STRUCTURE","VERSION" I $D(PARAMETERS(SUB)) S PARMS(SUB)=$G(PARAMETERS(SUB))
;
Q:'$$NEWMSG^HLOAPI(.PARMS,.HLMSTATE,.ERROR) 0
;
;
;if there is transform logic, copy the message to a workspace and execute the transform
I $L($G(TRANSFORM)) D
.N FROM,I,J
.I $E($G(HLARYTYP),1)="G" S FROM="^TMP(""HLS"",$J)",MARY="^TMP(""HLO"",$J)"
.I $E($G(HLARYTYP),1)="L" S FROM="HLA(""HLS"")",MARY="HLA(""HLO"")"
.Q:'$L($G(MARY))
.S I=0
.F S I=$O(@FROM@(I)) Q:'I D
..S @MARY@(I)=$G(@FROM@(I))
..S J=0
..F S J=$O(@MARY@(I,J)) Q:'J S @MARY@(I)=@MARY@(I)_$G(@FROM@(I,J))
.;
.;execute the applications transform logic
.D
..N FS,CS,SUB,REP,ESC,NODE
..S NODE=HLMSTATE("HDR","ENCODING CHARACTERS")
..S FS=HLMSTATE("HDR","FIELD SEPARATOR")
..S CS=$E(NODE,1)
..S REP=$E(NODE,2)
..S ESC=$E(NODE,3)
..S SUB=$E(NODE,4)
..X "D "_TRANSFORM_"(MARY)"
.;
.;if the application chose not to subscribe, delete the message array
.I '$D(@MARY) K MARY Q
.;Move the existing message from array into HL0
.D MOVEMSG^HLOAPI(.HLMSTATE,MARY)
.K @MARY
E D
.I $E($G(HLARYTYP),1)="G" S MARY="^TMP(""HLS"",$J)"
.I $E($G(HLARYTYP),1)="L" S MARY="HLA(""HLS"")"
.Q:'$L($G(MARY))
.;Move the existing message from array into HL0
.D MOVEMSG^HLOAPI(.HLMSTATE,MARY)
Q:'$L($G(MARY)) 0
;
;
;accept parameters passed in via PARAMETERS
F SUB="APP ACK RESPONSE","ACCEPT ACK RESPONSE","ACCEPT ACK TYPE","APP ACK TYPE","FAILURE RESPONSE","QUEUE","SECURITY","SEQUENCE QUEUE","SENDING APPLICATION" I $D(PARAMETERS(SUB)) S PARMS(SUB)=$G(PARAMETERS(SUB))
;
Q $$SENDONE^HLOAPI1(.HLMSTATE,.PARMS,.WHO)
;
GETPARMS(EVENT,SUBSCRIBER,PARMS,WHO) ; Set up PARMS & WHO arrays from Protocols
K PARMS,WHO
N NODE,APP,LINK
S NODE=$G(^ORD(101,EVENT,770))
S PARMS("EVENT")=$P(NODE,"^",4),PARMS("EVENT")=$S(PARMS("EVENT"):$P($G(^HL(779.001,PARMS("EVENT"),0)),"^"),1:"")
S PARMS("MESSAGE TYPE")=$P(NODE,"^",3),PARMS("MESSAGE TYPE")=$S(PARMS("MESSAGE TYPE"):$P($G(^HL(771.2,PARMS("MESSAGE TYPE"),0)),"^"),1:"")
S PARMS("APP ACK TYPE")=$P(NODE,"^",9),PARMS("APP ACK TYPE")=$S(PARMS("APP ACK TYPE"):$P($G(^HL(779.003,PARMS("APP ACK TYPE"),0)),"^"),1:"")
S PARMS("ACCEPT ACK TYPE")=$P(NODE,"^",8),PARMS("ACCEPT ACK TYPE")=$S(PARMS("ACCEPT ACK TYPE"):$P($G(^HL(779.003,PARMS("ACCEPT ACK TYPE"),0)),"^"),1:"")
S PARMS("VERSION")=$P(NODE,"^",10),PARMS("VERSION")=$S(PARMS("VERSION"):$P($G(^HL(771.5,PARMS("VERSION"),0)),"^"),1:"")
S PARMS("SENDING APPLICATION")=$P(NODE,"^")
I PARMS("SENDING APPLICATION") D
.N COUNTRY
.S COUNTRY=$P($G(^HL(771,PARMS("SENDING APPLICATION"),0)),"^",7)
.I $L(COUNTRY) S COUNTRY=$P($G(^HL(779.004,COUNTRY,0)),"^")
.S PARMS("COUNTRY")=$G(COUNTRY)
.S PARMS("FIELD SEPARATOR")=$E($G(^HL(771,PARMS("SENDING APPLICATION"),"FS")),1)
.S:PARMS("FIELD SEPARATOR")="" PARMS("FIELD SEPARATOR")="^"
.S PARMS("ENCODING CHARACTERS")=$E($G(^HL(771,PARMS("SENDING APPLICATION"),"EC")),1,4)
.S:PARMS("ENCODING CHARACTERS")="" PARMS("ENCODING CHARACTERS")="~|\&"
.S PARMS("SENDING APPLICATION")=$P($G(^HL(771,PARMS("SENDING APPLICATION"),0)),"^")
.I PARMS("SENDING APPLICATION")'="",'$O(^HLD(779.2,"C",PARMS("SENDING APPLICATION"),0)) D
..;add the sending applcation to the registry
..N DATA,ERROR
..S DATA(.01)=PARMS("SENDING APPLICATION")
..S DATA(2)=$P($G(^ORD(101,HLEID,0)),"^",12)
..I $$ADD^HLOASUB1(779.2,,.DATA,.ERROR)
E D
.S PARMS("SENDING APPLICATION")=""
.S PARMS("FIELD SEPARATOR")="^"
.S PARMS("ENCODING CHARACTERS")="~|\&"
;
S NODE=$G(^ORD(101,SUBSCRIBER,770))
S APP=$P(NODE,"^",2)
Q:'APP 0
S LINK=$P(NODE,"^",7)
Q:'LINK 0
S WHO("RECEIVING APPLICATION")=$P($G(^HL(771,APP,0)),"^")
S WHO("FACILITY LINK NAME")=$P($G(^HLCS(870,LINK,0)),"^")
Q 1
STRIPZ(MSG) ;strips the Z segments from the message
N I S I=0
F S I=$O(@MSG@(I)) Q:'I D
.I $E(@MSG@(I),1)="Z" K @MSG@(I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLOCNRT1 9030 printed Sep 23, 2025@19:34:44 Page 2
HLOCNRT1 ;ALB/CJM-Generate HL7 Optimized Message ;12/02/2008
+1 ;;1.6;HEALTH LEVEL SEVEN;**139**;Oct 13, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
HLO(PARAMETERS,TRANSFORM) ;
+1 ;INPUT -
+2 ; PARMAMETERS (optional,pass by reference) The following parameters,
+3 ; if specififed, will override what is specied by the Event and
+4 ; Subscriber Protocols.
+5 ;
+6 ; "ACCEPT ACK RESPONSE")=<tag^routine> to call when the commit ack is received (optional)
+7 ; "ACCEPT ACK TYPE") = <AL,NE>
+8 ; "APP ACK TYPE") = <AL,NE>
+9 ; "COUNTRY")=3 character country code
+10 ; "CONTINUATION POINTER" -indicates a fragmented message
+11 ; "EVENT")=3 character event type
+12 ; "FAILURE RESPONSE" - <tag>^<routine> 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.
+13 ; "MESSAGE STRUCTURE" - MSH 9, component 3 - a code from the standard HL7 table
+14 ; "MESSAGE TYPE")=3 character message type
+15 ; "PROCESSING MODE" - MSH 11, component 2 - a 1 character code
+16 ; "QUEUE" - An application can name its own private queue -just a string up to 20 characters, it should be namespaced.
+17 ; "SECURITY")=security information to include in the header segment, SEQ 8
+18 ; "SEQUENCE QUEUE") The sequence queue to use, up to 30 characters. It should be namespaced. Requires that application acks be used.
+19 ; "SENDING APPLICATION")=name of sending app (60 maximum length)
+20 ; "VERSION")=the HL7 Version ID, for example, "2.4"
+21 ;
+22 ;
+23 ; TRANSFORM (optional) A routine that will transform the message
+24 ; before the message is sent. The routine must
+25 ; have a formal parameter to received the name of the
+26 ; array that contains the message. The array may be either
+27 ; local or global.The application references the array
+28 ; by indirection to add, edit, or delete segments. The
+29 ; application may decide not to send the message, in which
+30 ; case it should delete the message array.
+31 ;
+32 ; An application's TRANSFORM routine can loop through the
+33 ; segments in the message in this way:
+34 ; 1) The application's TRANSFORM routine should be defined
+35 ; to accept an input parameter. HLO will set the parameter
+36 ; to the name of an array that contains the message, one
+37 ; segment per subscript:
+38 ;
+39 ; MSG(1)=<first segment>
+40 ; MSG(2)=<second segment>
+41 ; etc.
+42 ;
+43 ; 2) The application's TRANSFORM routine should loop through
+44 ; the message array using indirection:
+45 ;
+46 ; S I=0 F S I=$O(@MSG@(I)) Q:'I D <process the segment>
+47 ;
+48 ; *Note: MSG is show here, but the name of of the variable
+49 ; is actually whatever the application routine defined as
+50 ; its formal input parameter.
+51 ;
+52 ; 3) The segment value is obtained by:
+53 ; S SEGMENT=$G(@MSG@(I)) D <process the segment>
+54 ;
+55 ; 4) These variables are defined for the application to use
+56 ; in parsing segments:
+57 ;
+58 ; FS - field separator
+59 ; CS - component separator
+60 ; SUB - subcomponent separator
+61 ; REP - repitition separator
+62 ; ESC - escape character
+63 ;
+64 ;
+65 ; !!! CAUTION: This API currently has these limitations: !!!
+66 ; 1) Each individual segment must fit in a single node.
+67 ; 2) It can not be used for batch messages.
+68 ;
+69 ;OUTPUT:
+70 ; Function returns:
+71 ; - 0:if the message is not forwarded
+72 ; - message ien, file 778: if the message is forwarded
+73 ;
+74 ; Example 1: The application wants to subscribe to an existing
+75 ; message produced by the old HL7 1.6 set of messaging APIs,
+76 ; but it wants to route the messages via HLO.
+77 ; To accomplish that the application needs to create a
+78 ; new subscriber protocol with this M code to the ROUTING LOGIC:
+79 ;
+80 ; D HLO^HLOCNRT1()
+81 ;
+82 ; Example 2: Same as example 1, except that the application would
+83 ; like to:
+84 ; - Change the version of the message to 2.4
+85 ; - Strip out the Z segments from the message before sending it. To
+86 ; do so, it may devise the following routine:
+87 ;
+88 ; ZSTRIP^ZZRTN(MSG) ;
+89 ; N I S I=0
+90 ; F S I=$O(@MSG@(I)) Q:'I D
+91 ; .I $E(@MSG@(I),1)="Z" K @MSG@(I)
+92 ; Q
+93 ;
+94 ; Here is the ROUTING LOGIC for the new subscriber protocol:
+95 ;
+96 ; N PARMS S PARMS("VERSION")=2.4 I $$HLO^CNRT1(.PARMS,"STRIPZ^ZZRTN")
+97 ;
+98 ; Output: none
+99 ;
+100 NEW HLMSTATE,PARMS,WHO,EVENT,SUBSCRIBER,MARY,SUB
+101 ;
+102 ;
+103 SET EVENT=$GET(HLEID)
+104 if 'EVENT
QUIT 0
+105 SET SUBSCRIBER=$GET(HLEIDS)
+106 if 'SUBSCRIBER
QUIT 0
+107 ;
+108 if '$$GETPARMS(EVENT,SUBSCRIBER,.PARMS,.WHO)
QUIT 0
+109 ;
+110 ;accept parameters passed in via PARMETERS
+111 FOR SUB="COUNTRY","CONTINUATION POINTER","EVENT","MESSAGE TYPE","PROCESSING MODE","MESSAGE STRUCTURE","VERSION"
IF $DATA(PARAMETERS(SUB))
SET PARMS(SUB)=$GET(PARAMETERS(SUB))
+112 ;
+113 if '$$NEWMSG^HLOAPI(.PARMS,.HLMSTATE,.ERROR)
QUIT 0
+114 ;
+115 ;
+116 ;if there is transform logic, copy the message to a workspace and execute the transform
+117 IF $LENGTH($GET(TRANSFORM))
Begin DoDot:1
+118 NEW FROM,I,J
+119 IF $EXTRACT($GET(HLARYTYP),1)="G"
SET FROM="^TMP(""HLS"",$J)"
SET MARY="^TMP(""HLO"",$J)"
+120 IF $EXTRACT($GET(HLARYTYP),1)="L"
SET FROM="HLA(""HLS"")"
SET MARY="HLA(""HLO"")"
+121 if '$LENGTH($GET(MARY))
QUIT
+122 SET I=0
+123 FOR
SET I=$ORDER(@FROM@(I))
if 'I
QUIT
Begin DoDot:2
+124 SET @MARY@(I)=$GET(@FROM@(I))
+125 SET J=0
+126 FOR
SET J=$ORDER(@MARY@(I,J))
if 'J
QUIT
SET @MARY@(I)=@MARY@(I)_$GET(@FROM@(I,J))
End DoDot:2
+127 ;
+128 ;execute the applications transform logic
+129 Begin DoDot:2
+130 NEW FS,CS,SUB,REP,ESC,NODE
+131 SET NODE=HLMSTATE("HDR","ENCODING CHARACTERS")
+132 SET FS=HLMSTATE("HDR","FIELD SEPARATOR")
+133 SET CS=$EXTRACT(NODE,1)
+134 SET REP=$EXTRACT(NODE,2)
+135 SET ESC=$EXTRACT(NODE,3)
+136 SET SUB=$EXTRACT(NODE,4)
+137 XECUTE "D "_TRANSFORM_"(MARY)"
End DoDot:2
+138 ;
+139 ;if the application chose not to subscribe, delete the message array
+140 IF '$DATA(@MARY)
KILL MARY
QUIT
+141 ;Move the existing message from array into HL0
+142 DO MOVEMSG^HLOAPI(.HLMSTATE,MARY)
+143 KILL @MARY
End DoDot:1
+144 IF '$TEST
Begin DoDot:1
+145 IF $EXTRACT($GET(HLARYTYP),1)="G"
SET MARY="^TMP(""HLS"",$J)"
+146 IF $EXTRACT($GET(HLARYTYP),1)="L"
SET MARY="HLA(""HLS"")"
+147 if '$LENGTH($GET(MARY))
QUIT
+148 ;Move the existing message from array into HL0
+149 DO MOVEMSG^HLOAPI(.HLMSTATE,MARY)
End DoDot:1
+150 if '$LENGTH($GET(MARY))
QUIT 0
+151 ;
+152 ;
+153 ;accept parameters passed in via PARAMETERS
+154 FOR SUB="APP ACK RESPONSE","ACCEPT ACK RESPONSE","ACCEPT ACK TYPE","APP ACK TYPE","FAILURE RESPONSE","QUEUE","SECURITY","SEQUENCE QUEUE","SENDING APPLICATION"
IF $DATA(PARAMETERS(SUB))
SET PARMS(SUB)=$GET(PARAMETERS(SUB))
+155 ;
+156 QUIT $$SENDONE^HLOAPI1(.HLMSTATE,.PARMS,.WHO)
+157 ;
GETPARMS(EVENT,SUBSCRIBER,PARMS,WHO) ; Set up PARMS & WHO arrays from Protocols
+1 KILL PARMS,WHO
+2 NEW NODE,APP,LINK
+3 SET NODE=$GET(^ORD(101,EVENT,770))
+4 SET PARMS("EVENT")=$PIECE(NODE,"^",4)
SET PARMS("EVENT")=$SELECT(PARMS("EVENT"):$PIECE($GET(^HL(779.001,PARMS("EVENT"),0)),"^"),1:"")
+5 SET PARMS("MESSAGE TYPE")=$PIECE(NODE,"^",3)
SET PARMS("MESSAGE TYPE")=$SELECT(PARMS("MESSAGE TYPE"):$PIECE($GET(^HL(771.2,PARMS("MESSAGE TYPE"),0)),"^"),1:"")
+6 SET PARMS("APP ACK TYPE")=$PIECE(NODE,"^",9)
SET PARMS("APP ACK TYPE")=$SELECT(PARMS("APP ACK TYPE"):$PIECE($GET(^HL(779.003,PARMS("APP ACK TYPE"),0)),"^"),1:"")
+7 SET PARMS("ACCEPT ACK TYPE")=$PIECE(NODE,"^",8)
SET PARMS("ACCEPT ACK TYPE")=$SELECT(PARMS("ACCEPT ACK TYPE"):$PIECE($GET(^HL(779.003,PARMS("ACCEPT ACK TYPE"),0)),"^"),1:"")
+8 SET PARMS("VERSION")=$PIECE(NODE,"^",10)
SET PARMS("VERSION")=$SELECT(PARMS("VERSION"):$PIECE($GET(^HL(771.5,PARMS("VERSION"),0)),"^"),1:"")
+9 SET PARMS("SENDING APPLICATION")=$PIECE(NODE,"^")
+10 IF PARMS("SENDING APPLICATION")
Begin DoDot:1
+11 NEW COUNTRY
+12 SET COUNTRY=$PIECE($GET(^HL(771,PARMS("SENDING APPLICATION"),0)),"^",7)
+13 IF $LENGTH(COUNTRY)
SET COUNTRY=$PIECE($GET(^HL(779.004,COUNTRY,0)),"^")
+14 SET PARMS("COUNTRY")=$GET(COUNTRY)
+15 SET PARMS("FIELD SEPARATOR")=$EXTRACT($GET(^HL(771,PARMS("SENDING APPLICATION"),"FS")),1)
+16 if PARMS("FIELD SEPARATOR")=""
SET PARMS("FIELD SEPARATOR")="^"
+17 SET PARMS("ENCODING CHARACTERS")=$EXTRACT($GET(^HL(771,PARMS("SENDING APPLICATION"),"EC")),1,4)
+18 if PARMS("ENCODING CHARACTERS")=""
SET PARMS("ENCODING CHARACTERS")="~|\&"
+19 SET PARMS("SENDING APPLICATION")=$PIECE($GET(^HL(771,PARMS("SENDING APPLICATION"),0)),"^")
+20 IF PARMS("SENDING APPLICATION")'=""
IF '$ORDER(^HLD(779.2,"C",PARMS("SENDING APPLICATION"),0))
Begin DoDot:2
+21 ;add the sending applcation to the registry
+22 NEW DATA,ERROR
+23 SET DATA(.01)=PARMS("SENDING APPLICATION")
+24 SET DATA(2)=$PIECE($GET(^ORD(101,HLEID,0)),"^",12)
+25 IF $$ADD^HLOASUB1(779.2,,.DATA,.ERROR)
End DoDot:2
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 SET PARMS("SENDING APPLICATION")=""
+28 SET PARMS("FIELD SEPARATOR")="^"
+29 SET PARMS("ENCODING CHARACTERS")="~|\&"
End DoDot:1
+30 ;
+31 SET NODE=$GET(^ORD(101,SUBSCRIBER,770))
+32 SET APP=$PIECE(NODE,"^",2)
+33 if 'APP
QUIT 0
+34 SET LINK=$PIECE(NODE,"^",7)
+35 if 'LINK
QUIT 0
+36 SET WHO("RECEIVING APPLICATION")=$PIECE($GET(^HL(771,APP,0)),"^")
+37 SET WHO("FACILITY LINK NAME")=$PIECE($GET(^HLCS(870,LINK,0)),"^")
+38 QUIT 1
STRIPZ(MSG) ;strips the Z segments from the message
+1 NEW I
SET I=0
+2 FOR
SET I=$ORDER(@MSG@(I))
if 'I
QUIT
Begin DoDot:1
+3 IF $EXTRACT(@MSG@(I),1)="Z"
KILL @MSG@(I)
End DoDot:1
+4 QUIT
