Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: INHUT9

INHUT9.m

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