- HLCSUTL ;ALB/MTC - CS Utility Routines ;06/03/2008 11:57
- ;;1.6;HEALTH LEVEL SEVEN;**2,19,58,64,65,142**;Oct 13, 1995;Build 17
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- 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
- . ; patch HL*1.6*142 start
- . N HLQUIT2 ; use to save the last ien
- . 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
- . F S HLQUIT2=HLQUIT,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
- . ; for the occurrence when the last segment is not followed by <CR>
- . I HLQUIT="" S HLQUIT=HLQUIT2
- . ; patch HL*1.6*142 end
- ;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLCSUTL 8915 printed Jan 18, 2025@02:58:27 Page 2
- HLCSUTL ;ALB/MTC - CS Utility Routines ;06/03/2008 11:57
- +1 ;;1.6;HEALTH LEVEL SEVEN;**2,19,58,64,65,142**;Oct 13, 1995;Build 17
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +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 ; patch HL*1.6*142 start
- +33 ; use to save the last ien
- NEW HLQUIT2
- +34 SET HLNODE=$GET(^HL(772,HLMTIEN,"IN",HLQUIT,0))
- SET HLI=0
- +35 ; F S HLQUIT=$O(^HL(772,HLMTIEN,"IN",HLQUIT)) Q:'HLQUIT D Q:HLDONE
- +36 FOR
- SET HLQUIT2=HLQUIT
- SET HLQUIT=$ORDER(^HL(772,HLMTIEN,"IN",HLQUIT))
- if 'HLQUIT
- QUIT
- Begin DoDot:2
- +37 IF ^HL(772,HLMTIEN,"IN",HLQUIT,0)=""
- SET HLDONE=1
- QUIT
- +38 SET HLI=HLI+1
- SET HLNODE(HLI)=$GET(^HL(772,HLMTIEN,"IN",HLQUIT,0))
- QUIT
- End DoDot:2
- if HLDONE
- QUIT
- +39 ; for the occurrence when the last segment is not followed by <CR>
- +40 IF HLQUIT=""
- SET HLQUIT=HLQUIT2
- +41 ; patch HL*1.6*142 end
- End DoDot:1
- QUIT
- +42 ;no more nodes, kill flag and quit
- +43 KILL HLDONE1
- QUIT
- +44 ;
- 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