INHUT9 ;JPD ; 6 May 98 12:49;HL7 MESSAGE PARSER UTILITY
;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
;COPYRIGHT 1991-2000 SAIC
W !,"Not an entry point",*7
;
Q
ONE(IND,INOUT,INIOM,INDNT,INSEP,INDL,INK) ;Get 1 set of nodes and
; separate by INSEP
; Input :
; IND - Global or local node. ie ^INTHU(ien,3,0) or TEMP(1)
; INIOM - Margin Width
; INDNT - Indent by this number after 1st line
; INSEP - Separate on this value. ie |CR|
; INDL - delimit using these values
; INK - 1 Kill Output node upon entry 0 don't kill output node
; Output :
; INOUT - Global or local
;
N TEMP,COUNT,Y,INP,INP1,I,INSMIN
S IND=$G(IND),INIOM=+$G(INIOM),INDNT=+$G(INDNT),INSEP=$G(INSEP)
S INDL=$G(INDL),INK=+$G(INK),INP=$L(IND,","),COUNT=0
S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
I INP>2 S INP1="" F I=1:1:($L(IND,",")-1) S INP1=INP1_$P(IND,",",I)_","
E S INP1=$P(IND,",",1)
F S IND=$Q(@IND) Q:IND=""!(IND'[$P(INP1,")")) D
.I INSEP="" D PARSEDCT(IND,.INOUT,INIOM,INDNT,INDL,INK) Q
.S TEMP=@IND
.S COUNT=COUNT+1,Y(COUNT)=TEMP
.I TEMP[INSEP D
..S TEMP=$P(TEMP,INSEP,1)
..S Y(COUNT)=TEMP
..D PARSEDCT("Y",.INOUT,INIOM,INDNT,INDL,INK)
..I $S<INSMIN,(INOUT'["^") N INTEMPY S INTEMPY=INOUT,INOUT="^UTILITY(""INHUT9"",$J)" K @INOUT M @INOUT=@INTEMPY K @INTEMPY,INTEMPY
..K Y S COUNT=0
Q
PARSE(INIG1,IOM,INIG2,INDENT,INDL,INK) ;Set INIG array
;This will return INIG2 in array of 245 or less per line
; each line in array will take delimeted value or IOM, whichever is grtr
; Input -
; INIG1 - Array or Single line of data or both
; IOM - width
; INDENT - Indent this number of spaces on overflow line
; INDL - delimiter for line
; Pass in as array or string
; INK - 0 - Don't kill INIG2 upon entry - 1 - kill INIG2
; Output - INIG2 - Array of parsed data
S IOM=+$G(IOM),INDENT=+$G(INDENT)+1,INDL=$G(INDL),INIG2=+$G(INIG2)
S INK=$G(INK)
I INK K INIG2
I $D(INIG1)>1 D ARRAY(.INIG1,.INIG2,IOM,INDL,INDENT) Q
D LINE(.INIG1,.INIG2,IOM,INDL,INDENT)
I $L(INIG1) D SETTMP(INIG1,.INIG2,.IND)
Q
PARSEDCT(INIG1,INIG2,IOM,INDENT,INDL,INK) ;Parse Global Array
; This will return a value in the indirection value of what is
; passed in in INIG2 from the indirection of whatever value is
; passed in from INIG1 in a delimted format of IOM long lines
;Input -
; INIG1 - Name of Global or local variable to parse
; IOM - width
; INDENT - Indent this number of spaces on overflow line
; INDL - delimiter for line
; Pass in as array or string
; INK - 0 - Don't kill INIG2 upon entry - 1 - kill INIG2
;Output -
; INIG2 - Name of Global or local variable with parsed data in it
;
N J,INFST,IND,INX
S IOM=+$G(IOM),INDENT=+$G(INDENT)+1,INDL=$G(INDL),INIG2=$G(INIG2)
S INFST=0,(IND,INX)="",INK=$G(INK)
I INK K @INIG2
S INX=$G(@INIG1)
I $L(INX) D LINE(.INX,.INIG2,IOM,INDL,INDENT,.INFST,.IND,1)
S J="" F S J=$O(@INIG1@(J)) Q:J="" D
.S INX=INX_@INIG1@(J)
.D LINE(.INX,.INIG2,.IOM,INDL,INDENT,.INFST,.IND,1)
;If there was anything left over put in array
I $L(INX) D SETTMP(INX,.INIG2,IND,1)
Q
ARRAY(INIG1,INIG2,IOM,INDL,INDENT) ;Parse array of data
; Input:
; INIG1 - array of Data
; IOM - Width
; INDL - Delimeter(s)
; INDENT - Chars to indent for overflow of line
; Output:
; INIG2 - Array of data broken down by delimeters and IOM length
;
N J,INFST,IND,INX
S INFST=0,(IND,INX)=""
I $D(INIG1)=11 D
.S INX=INIG1
.D LINE(.INX,.INIG2,IOM,INDL,INDENT,.INFST,.IND,0)
S J="" F S J=$O(INIG1(J)) Q:J="" D
.S INX=INX_INIG1(J)
.D LINE(.INX,.INIG2,.IOM,INDL,INDENT,.INFST,.IND,0)
I $L(INX) D SETTMP(INX,.INIG2,.IND)
Q
LINE(INIG1,INIG2,IOM,INDL,INDENT,INFST,IND,INDCT) ;
; Input:
; INIG1 - Single line of data
; INIG2 - Array with old and new data
; IOM - Width
; INDL - Delimeter(s)
; INDENT - Chars to indent for overflow of line
; Output:
; INIG1 - Orig data with front part removed up to delimeter or IOM
; INIG2 - Array of data broken down by delimeters and IOM length
N OPOS,POS,J,INTMP
S IND=$G(IND),INFST=+$G(INFST),INDCT=+$G(INDCT)
;get parts of line and process until less than IOM length.
F Q:$L(INIG1)<IOM D
.;get section of line up to desired length
.S INTMP=$E(INIG1,1,IOM),OPOS=0
.;check for delimeters
.I $L($G(INDL)) D
..S POS=0
..;loop and look for last occurence of delimeter within section
..F J=1:1:$L(INDL) D
...F S POS=$F(INTMP,$E(INDL,J),POS) Q:'POS S:POS>OPOS OPOS=POS
.;If delimeter was not found stick whole section in array
.I 'OPOS D
..D SETTMP(INTMP,.INIG2,IND,INDCT)
..S INIG1=$E(INIG1,$L(INTMP)+1,$L(INIG1))
.E I OPOS D
..;delimeter was found, break at last occurence of it.
..D SETTMP($E(INTMP,1,OPOS-1),.INIG2,IND,INDCT)
..S INIG1=$E(INIG1,OPOS,$L(INIG1))
.I 'INFST S INFST=1,$P(IND," ",INDENT)="",IOM=IOM-$L(IND)
Q
;
SETTMP(INTMP,INX,IND,INDCT) ;set array
; Input - INTMP - next set of words< or = to IOM
; IND - Spaces to indent
; INDCT - 1 store in indirection of output
; 0 - store in array
; Output INX - temporary to go in INIG1
N INCNT
S IND=$G(IND),INDCT=$G(INDCT)
I 'INDCT S INX=INX+1,INX(INX)=IND_INTMP
E D
.S INCNT=+$O(@INX@(""),-1),INCNT=$G(INCNT)+1
.S @INX@(INCNT)=IND_INTMP
.S @INX=INCNT
Q
ROULNCNT(ROU) ;Count lines in routine
;Input:
; ROU - Routine name
N I,X
I '$$ROUTEST^%ZTF(ROU) W *7,"ROUTINE NOT FOUND" Q ""
F I=0:1 S @("X=$T("_ROU_"+"_I_"^"_ROU_")") Q:X=""
W I," Lines of code in routine "_ROU
Q I
INHUT9 ;JPD ; 6 May 98 12:49;HL7 MESSAGE PARSER UTILITY
+1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
+2 ;COPYRIGHT 1991-2000 SAIC
+3 WRITE !,"Not an entry point",*7
+4 ;
+5 QUIT
ONE(IND,INOUT,INIOM,INDNT,INSEP,INDL,INK) ;Get 1 set of nodes and
+1 ; separate by INSEP
+2 ; Input :
+3 ; IND - Global or local node. ie ^INTHU(ien,3,0) or TEMP(1)
+4 ; INIOM - Margin Width
+5 ; INDNT - Indent by this number after 1st line
+6 ; INSEP - Separate on this value. ie |CR|
+7 ; INDL - delimit using these values
+8 ; INK - 1 Kill Output node upon entry 0 don't kill output node
+9 ; Output :
+10 ; INOUT - Global or local
+11 ;
+12 NEW TEMP,COUNT,Y,INP,INP1,I,INSMIN
+13 SET IND=$GET(IND)
SET INIOM=+$GET(INIOM)
SET INDNT=+$GET(INDNT)
SET INSEP=$GET(INSEP)
+14 SET INDL=$GET(INDL)
SET INK=+$GET(INK)
SET INP=$LENGTH(IND,",")
SET COUNT=0
+15 SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
+16 IF INP>2
SET INP1=""
FOR I=1:1:($LENGTH(IND,",")-1)
SET INP1=INP1_$PIECE(IND,",",I)_","
+17 IF '$TEST
SET INP1=$PIECE(IND,",",1)
+18 FOR
SET IND=$QUERY(@IND)
IF IND=""!(IND'[$PIECE(INP1,")"))
QUIT
Begin DoDot:1
+19 IF INSEP=""
DO PARSEDCT(IND,.INOUT,INIOM,INDNT,INDL,INK)
QUIT
+20 SET TEMP=@IND
+21 SET COUNT=COUNT+1
SET Y(COUNT)=TEMP
+22 IF TEMP[INSEP
Begin DoDot:2
+23 SET TEMP=$PIECE(TEMP,INSEP,1)
+24 SET Y(COUNT)=TEMP
+25 DO PARSEDCT("Y",.INOUT,INIOM,INDNT,INDL,INK)
+26 IF $STORAGE<INSMIN
IF (INOUT'["^")
NEW INTEMPY
SET INTEMPY=INOUT
SET INOUT="^UTILITY(""INHUT9"",$J)"
KILL @INOUT
MERGE @INOUT=@INTEMPY
KILL @INTEMPY,INTEMPY
+27 KILL Y
SET COUNT=0
End DoDot:2
End DoDot:1
+28 QUIT
PARSE(INIG1,IOM,INIG2,INDENT,INDL,INK) ;Set INIG array
+1 ;This will return INIG2 in array of 245 or less per line
+2 ; each line in array will take delimeted value or IOM, whichever is grtr
+3 ; Input -
+4 ; INIG1 - Array or Single line of data or both
+5 ; IOM - width
+6 ; INDENT - Indent this number of spaces on overflow line
+7 ; INDL - delimiter for line
+8 ; Pass in as array or string
+9 ; INK - 0 - Don't kill INIG2 upon entry - 1 - kill INIG2
+10 ; Output - INIG2 - Array of parsed data
+11 SET IOM=+$GET(IOM)
SET INDENT=+$GET(INDENT)+1
SET INDL=$GET(INDL)
SET INIG2=+$GET(INIG2)
+12 SET INK=$GET(INK)
+13 IF INK
KILL INIG2
+14 IF $DATA(INIG1)>1
DO ARRAY(.INIG1,.INIG2,IOM,INDL,INDENT)
QUIT
+15 DO LINE(.INIG1,.INIG2,IOM,INDL,INDENT)
+16 IF $LENGTH(INIG1)
DO SETTMP(INIG1,.INIG2,.IND)
+17 QUIT
PARSEDCT(INIG1,INIG2,IOM,INDENT,INDL,INK) ;Parse Global Array
+1 ; This will return a value in the indirection value of what is
+2 ; passed in in INIG2 from the indirection of whatever value is
+3 ; passed in from INIG1 in a delimted format of IOM long lines
+4 ;Input -
+5 ; INIG1 - Name of Global or local variable to parse
+6 ; IOM - width
+7 ; INDENT - Indent this number of spaces on overflow line
+8 ; INDL - delimiter for line
+9 ; Pass in as array or string
+10 ; INK - 0 - Don't kill INIG2 upon entry - 1 - kill INIG2
+11 ;Output -
+12 ; INIG2 - Name of Global or local variable with parsed data in it
+13 ;
+14 NEW J,INFST,IND,INX
+15 SET IOM=+$GET(IOM)
SET INDENT=+$GET(INDENT)+1
SET INDL=$GET(INDL)
SET INIG2=$GET(INIG2)
+16 SET INFST=0
SET (IND,INX)=""
SET INK=$GET(INK)
+17 IF INK
KILL @INIG2
+18 SET INX=$GET(@INIG1)
+19 IF $LENGTH(INX)
DO LINE(.INX,.INIG2,IOM,INDL,INDENT,.INFST,.IND,1)
+20 SET J=""
FOR
SET J=$ORDER(@INIG1@(J))
IF J=""
QUIT
Begin DoDot:1
+21 SET INX=INX_@INIG1@(J)
+22 DO LINE(.INX,.INIG2,.IOM,INDL,INDENT,.INFST,.IND,1)
End DoDot:1
+23 ;If there was anything left over put in array
+24 IF $LENGTH(INX)
DO SETTMP(INX,.INIG2,IND,1)
+25 QUIT
ARRAY(INIG1,INIG2,IOM,INDL,INDENT) ;Parse array of data
+1 ; Input:
+2 ; INIG1 - array of Data
+3 ; IOM - Width
+4 ; INDL - Delimeter(s)
+5 ; INDENT - Chars to indent for overflow of line
+6 ; Output:
+7 ; INIG2 - Array of data broken down by delimeters and IOM length
+8 ;
+9 NEW J,INFST,IND,INX
+10 SET INFST=0
SET (IND,INX)=""
+11 IF $DATA(INIG1)=11
Begin DoDot:1
+12 SET INX=INIG1
+13 DO LINE(.INX,.INIG2,IOM,INDL,INDENT,.INFST,.IND,0)
End DoDot:1
+14 SET J=""
FOR
SET J=$ORDER(INIG1(J))
IF J=""
QUIT
Begin DoDot:1
+15 SET INX=INX_INIG1(J)
+16 DO LINE(.INX,.INIG2,.IOM,INDL,INDENT,.INFST,.IND,0)
End DoDot:1
+17 IF $LENGTH(INX)
DO SETTMP(INX,.INIG2,.IND)
+18 QUIT
LINE(INIG1,INIG2,IOM,INDL,INDENT,INFST,IND,INDCT) ;
+1 ; Input:
+2 ; INIG1 - Single line of data
+3 ; INIG2 - Array with old and new data
+4 ; IOM - Width
+5 ; INDL - Delimeter(s)
+6 ; INDENT - Chars to indent for overflow of line
+7 ; Output:
+8 ; INIG1 - Orig data with front part removed up to delimeter or IOM
+9 ; INIG2 - Array of data broken down by delimeters and IOM length
+10 NEW OPOS,POS,J,INTMP
+11 SET IND=$GET(IND)
SET INFST=+$GET(INFST)
SET INDCT=+$GET(INDCT)
+12 ;get parts of line and process until less than IOM length.
+13 FOR
IF $LENGTH(INIG1)<IOM
QUIT
Begin DoDot:1
+14 ;get section of line up to desired length
+15 SET INTMP=$EXTRACT(INIG1,1,IOM)
SET OPOS=0
+16 ;check for delimeters
+17 IF $LENGTH($GET(INDL))
Begin DoDot:2
+18 SET POS=0
+19 ;loop and look for last occurence of delimeter within section
+20 FOR J=1:1:$LENGTH(INDL)
Begin DoDot:3
+21 FOR
SET POS=$FIND(INTMP,$EXTRACT(INDL,J),POS)
IF 'POS
QUIT
IF POS>OPOS
SET OPOS=POS
End DoDot:3
End DoDot:2
+22 ;If delimeter was not found stick whole section in array
+23 IF 'OPOS
Begin DoDot:2
+24 DO SETTMP(INTMP,.INIG2,IND,INDCT)
+25 SET INIG1=$EXTRACT(INIG1,$LENGTH(INTMP)+1,$LENGTH(INIG1))
End DoDot:2
+26 IF '$TEST
IF OPOS
Begin DoDot:2
+27 ;delimeter was found, break at last occurence of it.
+28 DO SETTMP($EXTRACT(INTMP,1,OPOS-1),.INIG2,IND,INDCT)
+29 SET INIG1=$EXTRACT(INIG1,OPOS,$LENGTH(INIG1))
End DoDot:2
+30 IF 'INFST
SET INFST=1
SET $PIECE(IND," ",INDENT)=""
SET IOM=IOM-$LENGTH(IND)
End DoDot:1
+31 QUIT
+32 ;
SETTMP(INTMP,INX,IND,INDCT) ;set array
+1 ; Input - INTMP - next set of words< or = to IOM
+2 ; IND - Spaces to indent
+3 ; INDCT - 1 store in indirection of output
+4 ; 0 - store in array
+5 ; Output INX - temporary to go in INIG1
+6 NEW INCNT
+7 SET IND=$GET(IND)
SET INDCT=$GET(INDCT)
+8 IF 'INDCT
SET INX=INX+1
SET INX(INX)=IND_INTMP
+9 IF '$TEST
Begin DoDot:1
+10 SET INCNT=+$ORDER(@INX@(""),-1)
SET INCNT=$GET(INCNT)+1
+11 SET @INX@(INCNT)=IND_INTMP
+12 SET @INX=INCNT
End DoDot:1
+13 QUIT
ROULNCNT(ROU) ;Count lines in routine
+1 ;Input:
+2 ; ROU - Routine name
+3 NEW I,X
+4 IF '$$ROUTEST^%ZTF(ROU)
WRITE *7,"ROUTINE NOT FOUND"
QUIT ""
+5 FOR I=0:1
SET @("X=$T("_ROU_"+"_I_"^"_ROU_")")
IF X=""
QUIT
+6 WRITE I," Lines of code in routine "_ROU
+7 QUIT I
