HLCSUTL ;ALB/MTC - CS Utility Routines ;05/31/2000  13:34
 ;;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