HLCSUTL ;ALB/MTC - CS Utility Routines ;05/31/2000 13:34 [ 04/02/2003 8:38 AM ]
;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
;;1.6;HEALTH LEVEL SEVEN;**2,19,58,64,65**;Oct 13, 1995
;
Q
;
READ(HLDHANG,HLDBSIZE,HLTRM) ; This function will perform a read on the device and
; return the characters read and the termination character.
;
; INPUT : HLDHANG - TimeOut for read
; HLDBSIZE- Block Size for read
; HLTRM - Passed by reference to return termination char
; OUTPUT: <Data> - Ok
; -1^TIMEOUT : fails
;
N RESULT,X,Y
;
K HLTOUT
;-- do read
U IO R X#HLDBSIZE:HLDHANG I '$T S RESULT="-1^TIMEOUT" G READQ
X ^%ZOSF("TRMRD") S HLTRM=Y
S RESULT=X
;
READQ Q RESULT
;
NEXTLINE(LL0,LL1,LINE,ARR,QUE) ; This function will return the next line from the
; Logical Link file #870 specified by LL0 and the position in the queue
; specified by QUE at the position LL1. This function will return the
; line in the array specifed by ARR. And the position in the WP
; field where the last part of the segment was found.
; Lastly a <CR> will be appended to the end of the segment
;
; INPUT :
; LL0 - IFN of logical link
; LL1 - Position in QUE to begin search for next line
; LINE- Last line position, "" will return first line
; ARR - Array to store next line. The output will be in the
; following format ARR(1), ARR(2)
; QUE - Will specify "IN" or "OUT" queue to pull data from
;
; OUTPUT:
; ARR - As specified above
; RESULT - Position last segment was found or "" if no line
; was found.
;
;
N RESULT,HLQUE,X,I
S RESULT="",HLQUE=$S(QUE="IN":1,QUE="OUT":2,1:"")
;-- start looking for next line
S X=+LINE,I=0 F S X=$O(^HLCS(870,LL0,HLQUE,LL1,1,X)) Q:'X D I $G(^HLCS(870,LL0,HLQUE,LL1,1,X,0))="" S RESULT=X,@ARR@(I)=@ARR@(I)_$C(13) Q
. I $D(^HLCS(870,LL0,HLQUE,LL1,1,X,0)),^(0)'="" S I=I+1,@ARR@(I)=$G(^HLCS(870,LL0,HLQUE,LL1,1,X,0))
;
Q RESULT
;
FLD(NODE,FLD) ;This function will return the value for the field
;INPUT: NODE=HLNODE from the HLNEXT call, passed by reference
; FLD=field position in segment
; HL("FS") must be defined
;OUTPUT: value for the field in this segment
Q:$G(HL("FS"))=""!($G(NODE)="")!('$G(FLD)) ""
N I,L,L1,X,Y
S NODE(0)=NODE,L=0,Y=1,X=""
;Y=begining piece of each node, L1=number of pieces in each node
;L=last piece in each node, quit when last piece is greater than FLD
F I=0:1 Q:'$D(NODE(I)) S L1=$L(NODE(I),HL("FS")),L=L1+Y-1 D Q:Y>FLD
. ;if FLD is less than last piece, this node has field you want
. S:FLD'>L X=X_$P(NODE(I),HL("FS"),(FLD-Y+1))
. S Y=L
K NODE(0)
Q X
;
CHKSUM(HLTEXT) ; This function will return the checksum for the segment
; contained in the array ARR. If no checksum can be calculated an -1
; will be returned.
;
; INPUT - HLTEXT the name of the array to be used in the calulation
; of the checksum. The format is ARR(1,N),...ARR(M,N)
; OUTPUT - Decimal checksum %ZOSF("LPC")^Lenght of segment
;
N RESULT,LEN,X,X1,X2,X3,Y,I
S RESULT="",LEN=0,X1=0
;
F S X1=$O(@HLTEXT@(X1)) Q:'X1 S X=@HLTEXT@(X1),X2=$D(@HLTEXT@(X1)),LEN=LEN+$L(X) D
. X ^%ZOSF("LPC") S RESULT=RESULT_$C(Y)
. I X2=11 S X3=0 F S X3=$O(@HLTEXT@(X1,X3)) Q:'X3 D
.. S X=@HLTEXT@(X1,X3),LEN=LEN+$L(X) X ^%ZOSF("LPC") S RESULT=RESULT_$C(Y)
;
S X=RESULT X ^%ZOSF("LPC") S RESULT=Y
Q RESULT_"^"_LEN
;
CHKSUM2(HLTEXT) ; *** Add in <CR> *** This function will return the checksum for the segment
; contained in the array ARR. If no checksum can be calculated an -1
; will be returned.
;
; INPUT - HLTEXT the name of the array to be used in the calulation
; of the checksum. The format is ARR(1,N),...ARR(M,N)
; OUTPUT - Decimal checksum %ZOSF("LPC")^Lenght of segment
;
N RESULT,LEN,X,X1,X2,X3,Y,I
S RESULT="",LEN=0,X1=0
;
F S X1=$O(@HLTEXT@(X1)) Q:'X1 S X=@HLTEXT@(X1),X2=$D(@HLTEXT@(X1)),LEN=LEN+$L(X) D
. X ^%ZOSF("LPC") S RESULT=RESULT_$C(Y)
. I X2=1 S RESULT=RESULT_$C(13),LEN=LEN+1 Q
. I X2=11 S X3=0 F S X3=$O(@HLTEXT@(X1,X3)) Q:'X3 D
.. S X=@HLTEXT@(X1,X3),LEN=LEN+$L(X) X ^%ZOSF("LPC") S RESULT=RESULT_$C(Y)
..I $O(@HLTEXT@(X1,X3))="" S RESULT=RESULT_$C(13),LEN=LEN+1
;
S X=RESULT X ^%ZOSF("LPC") S RESULT=Y
Q RESULT_"^"_LEN
;
APPEND(HLTEXT,LL0,LL1) ; This function will append the data contained in
; the HLTEXT array into the IN queue multiple (LL1) of the Logical
; Link (LL0) file 870.
; INPUT : HLTEXT - Array containing text to append
; LL0 - IEN of File 870
; LL1 - IEN of IN queue multiple
;
N HLI,X,X1,X2,X3
S X=""
S HLI=$P($G(^HLCS(870,LL0,1,LL1,1,0)),U,3)
S:'HLI HLI=0
F S X=$O(@HLTEXT@(X)) Q:'X S HLI=HLI+1,^HLCS(870,LL0,1,LL1,1,HLI,0)=@HLTEXT@(X),X2=$D(@HLTEXT@(X)) D
. I X2=11 S ^HLCS(870,LL0,1,LL1,2,HLI,0)="" S X3=0 F S X3=$O(@HLTEXT@(X,X3)) Q:'X3 D
.. S HLI=HLI+1,^HLCS(870,LL0,1,LL1,1,HLI,0)=$G(@HLTEXT@(X,X3))
. S HLI=HLI+1,^HLCS(870,LL0,1,LL1,1,HLI,0)="" Q
;
;-- update 0 node
S ^HLCS(870,LL0,1,LL1,1,0)="^^"_HLI_"^"_HLI_"^"_DT_"^"
Q
;
HLNEXT ;-- This routine is used to return the next segment from file 772
; during processing of an inbound message. The following variables
; are used for the processing.
; HLMTIEN - Entry in 772 where message is
; HLQUIT - Curent ien of "IN" wp field
; HLNODE - Data is returned in HLNODE=Segment and HLNODE(n) if
; segmemt is greater than 245 chars.
;
K HLNODE
N HLI,HLDONE,HLX
S HLNODE="",HLDONE=0
I HLQUIT="" S HLQUIT=0
;HLMTIEN is undef, no response to process
I '$G(HLMTIEN) S HLQUIT=0 Q
;first time, check if new format
I '$D(HLDONE1) D Q:HLQUIT
. S HLX=$O(^HLMA("B",HLMTIEN,0))
. ;old format, set HLDONE1 so we won't come here again
. I 'HLX S HLDONE1=0 Q
. ;already got header, reset HLQUIT for text
. I HLQUIT S (HLDONE1,HLQUIT)=0 Q
. ;new format, get header in 773
. S HLQUIT=$O(^HLMA(HLX,"MSH",HLQUIT))
. ;there is no header
. I 'HLQUIT S (HLDONE1,HLQUIT)=0 Q
. S HLNODE=$G(^HLMA(HLX,"MSH",HLQUIT,0)),HLI=0
. F S HLQUIT=$O(^HLMA(HLX,"MSH",HLQUIT)) Q:'HLQUIT D Q:HLDONE
.. I ^HLMA(HLX,"MSH",HLQUIT,0)="" S HLDONE=1 Q
.. S HLI=HLI+1,HLNODE(HLI)=$G(^HLMA(HLX,"MSH",HLQUIT,0)) Q
. S HLQUIT=1 Q
S HLQUIT=$O(^HL(772,HLMTIEN,"IN",HLQUIT))
I HLQUIT D Q
. S HLNODE=$G(^HL(772,HLMTIEN,"IN",HLQUIT,0)),HLI=0
. F S HLQUIT=$O(^HL(772,HLMTIEN,"IN",HLQUIT)) Q:'HLQUIT D Q:HLDONE
.. I ^HL(772,HLMTIEN,"IN",HLQUIT,0)="" S HLDONE=1 Q
.. S HLI=HLI+1,HLNODE(HLI)=$G(^HL(772,HLMTIEN,"IN",HLQUIT,0)) Q
;no more nodes, kill flag and quit
K HLDONE1 Q
;
MSGLINE(HLMID) ;return the number of lines in a message, TCP type only
;input: HLMID=message id
Q:$G(HLMID)="" 0
N HLCNT,HLIENS,HLIEN
;can't find message
S HLIENS=$O(^HLMA("C",HLMID,0)) Q:'HLIENS 0
S HLIEN=+$G(^HLMA(HLIENS,0)) Q:'HLIEN 0
S HLCNT=$P($G(^HLMA(HLIENS,"MSH",0)),U,4)+$P($G(^HL(772,HLIEN,"IN",0)),U,4)
Q HLCNT
;
MSGSIZE(HLIENS) ;return the number of characters in a message, TCP type only
;input: HLIENS= ien in file 773
Q:'$G(HLIENS) 0
N HLCNT,HLI,HLIEN,HLZ
;HLIEN=ien in file 772, message text. Blank lines are CR, add 1
Q:'$G(^HLMA(HLIENS,0)) 0 S HLIEN=+(^(0)) Q:'HLIEN 0
S (HLCNT,HLI,HLZ)=0
;get header
F S HLI=$O(^HLMA(HLIENS,"MSH",HLI)) Q:'HLI S HLZ=$L($G(^(HLI,0))),HLCNT=HLCNT+$S(HLZ:HLZ,1:1)
;if last line of header wasn't blank, add 1 for CR
S:HLZ HLCNT=HLCNT+1
;get body
S HLI=0 F S HLI=$O(^HL(772,HLIEN,"IN",HLI)) Q:'HLI S HLZ=$L($G(^(HLI,0))),HLCNT=HLCNT+$S(HLZ:HLZ,1:1)
Q HLCNT
;
MSG(HLMID,HLREST) ;return the message text in the reference HLREST
;only for TCP type messages
;input: HLMID=message id, HLREST=closed local or global reference
;to place message text
;output: return 1 for success and 0 if message doesn't exist
Q:$G(HLMID)=""!($G(HLREST)="") 0
N HLCNT,HLI,HLIENS,HLIEN,HLZ
;can't find message
S HLIENS=$O(^HLMA("C",HLMID,0)) Q:'HLIENS 0
S HLIEN=+$G(^HLMA(HLIENS,0)) Q:'HLIEN 0
;RESULT must be close reference
D I '$D(HLREST) Q 0
. Q:HLREST'["("
. I $E(HLREST,$L(HLREST))=")",$F(HLREST,")")>($F(HLREST,"(")+1) Q
. K HLREST
S (HLCNT,HLI)=0,HLZ=""
;get header
F S HLI=$O(^HLMA(HLIENS,"MSH",HLI)) Q:'HLI S HLCNT=HLCNT+1,(HLZ,@HLREST@(HLCNT))=$G(^(HLI,0))
S:HLZ'="" HLCNT=HLCNT+1,@HLREST@(HLCNT)=""
;get body
S HLI=0 F S HLI=$O(^HL(772,HLIEN,"IN",HLI)) Q:'HLI S HLCNT=HLCNT+1,@HLREST@(HLCNT)=$G(^(HLI,0))
Q 1
HLCSUTL ;ALB/MTC - CS Utility Routines ;05/31/2000 13:34 [ 04/02/2003 8:38 AM ]
+1 ;;1.6;HEALTH LEVEL SEVEN;**1004**;APR 1, 2003
+2 ;;1.6;HEALTH LEVEL SEVEN;**2,19,58,64,65**;Oct 13, 1995
+3 ;
+4 QUIT
+5 ;
READ(HLDHANG,HLDBSIZE,HLTRM) ; This function will perform a read on the device and
+1 ; return the characters read and the termination character.
+2 ;
+3 ; INPUT : HLDHANG - TimeOut for read
+4 ; HLDBSIZE- Block Size for read
+5 ; HLTRM - Passed by reference to return termination char
+6 ; OUTPUT: <Data> - Ok
+7 ; -1^TIMEOUT : fails
+8 ;
+9 NEW RESULT,X,Y
+10 ;
+11 KILL HLTOUT
+12 ;-- do read
+13 USE IO
READ X#HLDBSIZE:HLDHANG
IF '$TEST
SET RESULT="-1^TIMEOUT"
GOTO READQ
+14 XECUTE ^%ZOSF("TRMRD")
SET HLTRM=Y
+15 SET RESULT=X
+16 ;
READQ QUIT RESULT
+1 ;
NEXTLINE(LL0,LL1,LINE,ARR,QUE) ; This function will return the next line from the
+1 ; Logical Link file #870 specified by LL0 and the position in the queue
+2 ; specified by QUE at the position LL1. This function will return the
+3 ; line in the array specifed by ARR. And the position in the WP
+4 ; field where the last part of the segment was found.
+5 ; Lastly a <CR> will be appended to the end of the segment
+6 ;
+7 ; INPUT :
+8 ; LL0 - IFN of logical link
+9 ; LL1 - Position in QUE to begin search for next line
+10 ; LINE- Last line position, "" will return first line
+11 ; ARR - Array to store next line. The output will be in the
+12 ; following format ARR(1), ARR(2)
+13 ; QUE - Will specify "IN" or "OUT" queue to pull data from
+14 ;
+15 ; OUTPUT:
+16 ; ARR - As specified above
+17 ; RESULT - Position last segment was found or "" if no line
+18 ; was found.
+19 ;
+20 ;
+21 NEW RESULT,HLQUE,X,I
+22 SET RESULT=""
SET HLQUE=$SELECT(QUE="IN":1,QUE="OUT":2,1:"")
+23 ;-- start looking for next line
+24 SET X=+LINE
SET I=0
FOR
SET X=$ORDER(^HLCS(870,LL0,HLQUE,LL1,1,X))
IF 'X
QUIT
Begin DoDot:1
+25 IF $DATA(^HLCS(870,LL0,HLQUE,LL1,1,X,0))
IF ^(0)'=""
SET I=I+1
SET @ARR@(I)=$GET(^HLCS(870,LL0,HLQUE,LL1,1,X,0))
End DoDot:1
IF $GET(^HLCS(870,LL0,HLQUE,LL1,1,X,0))=""
SET RESULT=X
SET @ARR@(I)=@ARR@(I)_$CHAR(13)
QUIT
+26 ;
+27 QUIT RESULT
+28 ;
FLD(NODE,FLD) ;This function will return the value for the field
+1 ;INPUT: NODE=HLNODE from the HLNEXT call, passed by reference
+2 ; FLD=field position in segment
+3 ; HL("FS") must be defined
+4 ;OUTPUT: value for the field in this segment
+5 IF $GET(HL("FS"))=""!($GET(NODE)="")!('$GET(FLD))
QUIT ""
+6 NEW I,L,L1,X,Y
+7 SET NODE(0)=NODE
SET L=0
SET Y=1
SET X=""
+8 ;Y=begining piece of each node, L1=number of pieces in each node
+9 ;L=last piece in each node, quit when last piece is greater than FLD
+10 FOR I=0:1
IF '$DATA(NODE(I))
QUIT
SET L1=$LENGTH(NODE(I),HL("FS"))
SET L=L1+Y-1
Begin DoDot:1
+11 ;if FLD is less than last piece, this node has field you want
+12 IF FLD'>L
SET X=X_$PIECE(NODE(I),HL("FS"),(FLD-Y+1))
+13 SET Y=L
End DoDot:1
IF Y>FLD
QUIT
+14 KILL NODE(0)
+15 QUIT X
+16 ;
CHKSUM(HLTEXT) ; This function will return the checksum for the segment
+1 ; contained in the array ARR. If no checksum can be calculated an -1
+2 ; will be returned.
+3 ;
+4 ; INPUT - HLTEXT the name of the array to be used in the calulation
+5 ; of the checksum. The format is ARR(1,N),...ARR(M,N)
+6 ; OUTPUT - Decimal checksum %ZOSF("LPC")^Lenght of segment
+7 ;
+8 NEW RESULT,LEN,X,X1,X2,X3,Y,I
+9 SET RESULT=""
SET LEN=0
SET X1=0
+10 ;
+11 FOR
SET X1=$ORDER(@HLTEXT@(X1))
IF 'X1
QUIT
SET X=@HLTEXT@(X1)
SET X2=$DATA(@HLTEXT@(X1))
SET LEN=LEN+$LENGTH(X)
Begin DoDot:1
+12 XECUTE ^%ZOSF("LPC")
SET RESULT=RESULT_$CHAR(Y)
+13 IF X2=11
SET X3=0
FOR
SET X3=$ORDER(@HLTEXT@(X1,X3))
IF 'X3
QUIT
Begin DoDot:2
+14 SET X=@HLTEXT@(X1,X3)
SET LEN=LEN+$LENGTH(X)
XECUTE ^%ZOSF("LPC")
SET RESULT=RESULT_$CHAR(Y)
End DoDot:2
End DoDot:1
+15 ;
+16 SET X=RESULT
XECUTE ^%ZOSF("LPC")
SET RESULT=Y
+17 QUIT RESULT_"^"_LEN
+18 ;
CHKSUM2(HLTEXT) ; *** Add in <CR> *** This function will return the checksum for the segment
+1 ; contained in the array ARR. If no checksum can be calculated an -1
+2 ; will be returned.
+3 ;
+4 ; INPUT - HLTEXT the name of the array to be used in the calulation
+5 ; of the checksum. The format is ARR(1,N),...ARR(M,N)
+6 ; OUTPUT - Decimal checksum %ZOSF("LPC")^Lenght of segment
+7 ;
+8 NEW RESULT,LEN,X,X1,X2,X3,Y,I
+9 SET RESULT=""
SET LEN=0
SET X1=0
+10 ;
+11 FOR
SET X1=$ORDER(@HLTEXT@(X1))
IF 'X1
QUIT
SET X=@HLTEXT@(X1)
SET X2=$DATA(@HLTEXT@(X1))
SET LEN=LEN+$LENGTH(X)
Begin DoDot:1
+12 XECUTE ^%ZOSF("LPC")
SET RESULT=RESULT_$CHAR(Y)
+13 IF X2=1
SET RESULT=RESULT_$CHAR(13)
SET LEN=LEN+1
QUIT
+14 IF X2=11
SET X3=0
FOR
SET X3=$ORDER(@HLTEXT@(X1,X3))
IF 'X3
QUIT
Begin DoDot:2
+15 SET X=@HLTEXT@(X1,X3)
SET LEN=LEN+$LENGTH(X)
XECUTE ^%ZOSF("LPC")
SET RESULT=RESULT_$CHAR(Y)
+16 IF $ORDER(@HLTEXT@(X1,X3))=""
SET RESULT=RESULT_$CHAR(13)
SET LEN=LEN+1
End DoDot:2
End DoDot:1
+17 ;
+18 SET X=RESULT
XECUTE ^%ZOSF("LPC")
SET RESULT=Y
+19 QUIT RESULT_"^"_LEN
+20 ;
APPEND(HLTEXT,LL0,LL1) ; This function will append the data contained in
+1 ; the HLTEXT array into the IN queue multiple (LL1) of the Logical
+2 ; Link (LL0) file 870.
+3 ; INPUT : HLTEXT - Array containing text to append
+4 ; LL0 - IEN of File 870
+5 ; LL1 - IEN of IN queue multiple
+6 ;
+7 NEW HLI,X,X1,X2,X3
+8 SET X=""
+9 SET HLI=$PIECE($GET(^HLCS(870,LL0,1,LL1,1,0)),U,3)
+10 IF 'HLI
SET HLI=0
+11 FOR
SET X=$ORDER(@HLTEXT@(X))
IF 'X
QUIT
SET HLI=HLI+1
SET ^HLCS(870,LL0,1,LL1,1,HLI,0)=@HLTEXT@(X)
SET X2=$DATA(@HLTEXT@(X))
Begin DoDot:1
+12 IF X2=11
SET ^HLCS(870,LL0,1,LL1,2,HLI,0)=""
SET X3=0
FOR
SET X3=$ORDER(@HLTEXT@(X,X3))
IF 'X3
QUIT
Begin DoDot:2
+13 SET HLI=HLI+1
SET ^HLCS(870,LL0,1,LL1,1,HLI,0)=$GET(@HLTEXT@(X,X3))
End DoDot:2
+14 SET HLI=HLI+1
SET ^HLCS(870,LL0,1,LL1,1,HLI,0)=""
QUIT
End DoDot:1
+15 ;
+16 ;-- update 0 node
+17 SET ^HLCS(870,LL0,1,LL1,1,0)="^^"_HLI_"^"_HLI_"^"_DT_"^"
+18 QUIT
+19 ;
HLNEXT ;-- This routine is used to return the next segment from file 772
+1 ; during processing of an inbound message. The following variables
+2 ; are used for the processing.
+3 ; HLMTIEN - Entry in 772 where message is
+4 ; HLQUIT - Curent ien of "IN" wp field
+5 ; HLNODE - Data is returned in HLNODE=Segment and HLNODE(n) if
+6 ; segmemt is greater than 245 chars.
+7 ;
+8 KILL HLNODE
+9 NEW HLI,HLDONE,HLX
+10 SET HLNODE=""
SET HLDONE=0
+11 IF HLQUIT=""
SET HLQUIT=0
+12 ;HLMTIEN is undef, no response to process
+13 IF '$GET(HLMTIEN)
SET HLQUIT=0
QUIT
+14 ;first time, check if new format
+15 IF '$DATA(HLDONE1)
Begin DoDot:1
+16 SET HLX=$ORDER(^HLMA("B",HLMTIEN,0))
+17 ;old format, set HLDONE1 so we won't come here again
+18 IF 'HLX
SET HLDONE1=0
QUIT
+19 ;already got header, reset HLQUIT for text
+20 IF HLQUIT
SET (HLDONE1,HLQUIT)=0
QUIT
+21 ;new format, get header in 773
+22 SET HLQUIT=$ORDER(^HLMA(HLX,"MSH",HLQUIT))
+23 ;there is no header
+24 IF 'HLQUIT
SET (HLDONE1,HLQUIT)=0
QUIT
+25 SET HLNODE=$GET(^HLMA(HLX,"MSH",HLQUIT,0))
SET HLI=0
+26 FOR
SET HLQUIT=$ORDER(^HLMA(HLX,"MSH",HLQUIT))
IF 'HLQUIT
QUIT
Begin DoDot:2
+27 IF ^HLMA(HLX,"MSH",HLQUIT,0)=""
SET HLDONE=1
QUIT
+28 SET HLI=HLI+1
SET HLNODE(HLI)=$GET(^HLMA(HLX,"MSH",HLQUIT,0))
QUIT
End DoDot:2
IF HLDONE
QUIT
+29 SET HLQUIT=1
QUIT
End DoDot:1
IF HLQUIT
QUIT
+30 SET HLQUIT=$ORDER(^HL(772,HLMTIEN,"IN",HLQUIT))
+31 IF HLQUIT
Begin DoDot:1
+32 SET HLNODE=$GET(^HL(772,HLMTIEN,"IN",HLQUIT,0))
SET HLI=0
+33 FOR
SET HLQUIT=$ORDER(^HL(772,HLMTIEN,"IN",HLQUIT))
IF 'HLQUIT
QUIT
Begin DoDot:2
+34 IF ^HL(772,HLMTIEN,"IN",HLQUIT,0)=""
SET HLDONE=1
QUIT
+35 SET HLI=HLI+1
SET HLNODE(HLI)=$GET(^HL(772,HLMTIEN,"IN",HLQUIT,0))
QUIT
End DoDot:2
IF HLDONE
QUIT
End DoDot:1
QUIT
+36 ;no more nodes, kill flag and quit
+37 KILL HLDONE1
QUIT
+38 ;
MSGLINE(HLMID) ;return the number of lines in a message, TCP type only
+1 ;input: HLMID=message id
+2 IF $GET(HLMID)=""
QUIT 0
+3 NEW HLCNT,HLIENS,HLIEN
+4 ;can't find message
+5 SET HLIENS=$ORDER(^HLMA("C",HLMID,0))
IF 'HLIENS
QUIT 0
+6 SET HLIEN=+$GET(^HLMA(HLIENS,0))
IF 'HLIEN
QUIT 0
+7 SET HLCNT=$PIECE($GET(^HLMA(HLIENS,"MSH",0)),U,4)+$PIECE($GET(^HL(772,HLIEN,"IN",0)),U,4)
+8 QUIT HLCNT
+9 ;
MSGSIZE(HLIENS) ;return the number of characters in a message, TCP type only
+1 ;input: HLIENS= ien in file 773
+2 IF '$GET(HLIENS)
QUIT 0
+3 NEW HLCNT,HLI,HLIEN,HLZ
+4 ;HLIEN=ien in file 772, message text. Blank lines are CR, add 1
+5 IF '$GET(^HLMA(HLIENS,0))
QUIT 0
SET HLIEN=+(^(0))
IF 'HLIEN
QUIT 0
+6 SET (HLCNT,HLI,HLZ)=0
+7 ;get header
+8 FOR
SET HLI=$ORDER(^HLMA(HLIENS,"MSH",HLI))
IF 'HLI
QUIT
SET HLZ=$LENGTH($GET(^(HLI,0)))
SET HLCNT=HLCNT+$SELECT(HLZ:HLZ,1:1)
+9 ;if last line of header wasn't blank, add 1 for CR
+10 IF HLZ
SET HLCNT=HLCNT+1
+11 ;get body
+12 SET HLI=0
FOR
SET HLI=$ORDER(^HL(772,HLIEN,"IN",HLI))
IF 'HLI
QUIT
SET HLZ=$LENGTH($GET(^(HLI,0)))
SET HLCNT=HLCNT+$SELECT(HLZ:HLZ,1:1)
+13 QUIT HLCNT
+14 ;
MSG(HLMID,HLREST) ;return the message text in the reference HLREST
+1 ;only for TCP type messages
+2 ;input: HLMID=message id, HLREST=closed local or global reference
+3 ;to place message text
+4 ;output: return 1 for success and 0 if message doesn't exist
+5 IF $GET(HLMID)=""!($GET(HLREST)="")
QUIT 0
+6 NEW HLCNT,HLI,HLIENS,HLIEN,HLZ
+7 ;can't find message
+8 SET HLIENS=$ORDER(^HLMA("C",HLMID,0))
IF 'HLIENS
QUIT 0
+9 SET HLIEN=+$GET(^HLMA(HLIENS,0))
IF 'HLIEN
QUIT 0
+10 ;RESULT must be close reference
+11 Begin DoDot:1
+12 IF HLREST'["("
QUIT
+13 IF $EXTRACT(HLREST,$LENGTH(HLREST))=")"
IF $FIND(HLREST,")")>($FIND(HLREST,"(")+1)
QUIT
+14 KILL HLREST
End DoDot:1
IF '$DATA(HLREST)
QUIT 0
+15 SET (HLCNT,HLI)=0
SET HLZ=""
+16 ;get header
+17 FOR
SET HLI=$ORDER(^HLMA(HLIENS,"MSH",HLI))
IF 'HLI
QUIT
SET HLCNT=HLCNT+1
SET (HLZ,@HLREST@(HLCNT))=$GET(^(HLI,0))
+18 IF HLZ'=""
SET HLCNT=HLCNT+1
SET @HLREST@(HLCNT)=""
+19 ;get body
+20 SET HLI=0
FOR
SET HLI=$ORDER(^HL(772,HLIEN,"IN",HLI))
IF 'HLI
QUIT
SET HLCNT=HLCNT+1
SET @HLREST@(HLCNT)=$GET(^(HLI,0))
+21 QUIT 1
+22
***** ERRORS & WARNINGS IN HLCSUTL *****
READ+13 I - Star or pound READ used.
MSG+22 W - Null line (no commands or comment).
