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

INTSTR2.m

Go to the documentation of this file. 
  1. INTSTR2 ;DGH; 5 Aug 97 14:20;Continuation of Required Field functions
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q  ;no top entry
  1.  ;
  1. LOOP(INUIF,LVL,UIFMES,UCNT,INCDEC,DEFMES,INERR) ;Recursive logic
  1.  ;Compares message segment id at the current LVL
  1.  ;with the UIF segment id at the current UCNT.
  1.  ;INPUT:
  1.  ;   INUIF = Entry in UIF being evaluated
  1.  ;   LVL = level array LVL(1), LVL(2) set to segment being validated.
  1.  ;   UIFMES = UIF message array.
  1.  ;   UCNT = UIF array node being validated. UCNT is incremented inside
  1.  ;          LOOP if MSID=USID. Otherwise, it stays the same.
  1.  ;          Note that USID=UIFMES(UCNT)=segment id for the
  1.  ;   INCDEC = 1 to increment levels and work deeper into nests
  1.  ;          = 0 to decrement levels and back out of nests
  1.  ;          required segments only checked if INCDEC=1
  1.  ;   DEFMES = Defined message array.
  1.  ;   INERR = (PRB) flag. Initialized=0, will be set to 1 or 2
  1.  ;           if error conditions are found.
  1.  ;INPUT not passed
  1.  ;   INDELIM = delimiter. Must be local variable set previously
  1.  ;   INSUBDEL = subdelimiter set of all but INDELIM.
  1.  ;
  1.  ;set arrays for comparison
  1.  I $D(DEBUG) D
  1.  .D IO^INTSTR("==========================================================")
  1.  .D IO^INTSTR("Entering LOOP tag with UCNT= "_UCNT_" INCDEC= "_INCDEC)
  1.  .D IO^INTSTR("LVL array:")
  1.  .S QX=$Q(LVL) Q:'$L(QX)  S INMSG=QX_"="_$G(@(QX)) D IO^INTSTR(INMSG)
  1.  .F  S QX=$Q(@(QX)) Q:'$L(QX)  S INMSG=QX_"="_$G(@(QX)) D IO^INTSTR(INMSG)
  1.  N MESS,CURLVL,CURCNT,ORD,USID,MSID,G,MREP,MREQ,OUT2
  1.  Q:'$D(LVL)  Q:'UCNT
  1.  S CURLVL=$O(LVL(""),-1),CURCNT=LVL(CURLVL) S:'$D(LCT) LCT=0
  1.  ;If current level is 1 and current count=0, nothing left to do
  1.  I CURLVL=1,CURCNT=0 Q
  1.  S ORD="",I="" F  S I=$O(LVL(I)) Q:'I  D
  1.  .S ORD=ORD_LVL(I)_","
  1.  S G="DEFMES("_$E(ORD,1,($L(ORD)-1))_")"
  1.  S MESS(0)=$G(@G@(0))
  1.  S MSID=$P(MESS(0),U),MREP=$P(MESS(0),U,2),MREQ=$P(MESS(0),U,3),USID=UIFMES(UCNT)
  1.  I $G(DEBUG)>1 D
  1.  .S INMSG=G_"="_MESS(0) D IO^INTSTR(INMSG)
  1.  .S INMSG="MSID= "_MSID_"  USID= "_USID_" Repeating= "_MREP_" Required="_MREQ D IO^INTSTR(INMSG)
  1.  Q:'$L(MSID)
  1.  ;For navigational segments, increment LVL and recurse
  1.  I MSID="NAVIGATE" D  D LOOP(INUIF,.LVL,.UIFMES,.UCNT,.INCDEC,.DEFMES,.INERR) Q
  1.  .;Navigational segment should be a "parent segment" with a level below
  1.  .I $O(@G@(0)) S LVL(CURLVL+1)=1 Q
  1.  .;If another level does not exist, increment at current level and
  1.  .;see if node exists
  1.  .S LVL(CURLVL)=CURCNT+1 S X=$$EXIST(.LVL,.DEFMES) Q:X
  1.  .;If neither condition is met, back out
  1.  .D FNDNXT(.LVL,CURLVL,.DEFMES)
  1.  ;If this segment is not defined, print message, increment both the
  1.  ;USID and LCT counters, and recurse.
  1.  I '$D(DEFMES(USID)) S INMSG="Message contains unexpected segment "_USID,UCNT=$O(UIFMES(UCNT)) D GETLINE^INHOU(INUIF,.LCT,.LINE),IO^INTSTR(INMSG),LOOP(INUIF,.LVL,.UIFMES,.UCNT,.INCDEC,.DEFMES,.INERR) Q
  1.  ;If segments match (FNDNXT may have reset MSID, MREQ and MREP)
  1.  S MATCH=$S(MSID=USID:1,1:0)
  1.  I MATCH D
  1.  .I INEXPND S INMSG=$S(MREQ:"Required",1:"Optional")_" segment "_MSID_" found" D IO^INTSTR(INMSG)
  1.  .S INCDEC=1
  1.  .;Validate required fields if there are any
  1.  .D VALID^INTSTR1(.LCT,.DEFMES,MSID,.UIFMES,UCNT,INUIF,.INERR)
  1.  .;Check for repeating segments. Increment uif counter until
  1.  .;segments no longer match.
  1.  .S OUT=0 F  D  Q:OUT
  1.  ..S UCNT=$O(UIFMES(UCNT)) I 'UCNT S OUT=1 Q
  1.  ..S USID=$P(UIFMES(UCNT),U) I MSID'=USID S OUT=1 Q
  1.  ..;S INMSG=$S('MREP:"Unexpected repeating ",1:"Repeating ")_MSID_" segment found" S:'MREP INERR=1 I INEXPND!'MREP D IO^INTSTR(INMSG)
  1.  ..S INMSG="Repeating "_MSID_" segment found" I INEXPND D IO^INTSTR(INMSG)
  1.  ..D VALID^INTSTR1(.LCT,.DEFMES,MSID,.UIFMES,UCNT,INUIF,.INERR)
  1.  ;End of processing if segments match. At this point, the USID counter
  1.  ;has been incremented to the next segment (if another segment exists).
  1.  ;Quit if another segment does not exist. (But verify if another
  1.  ;segment Should exist)
  1.  ;Q:'UCNT
  1.  ;Q:'$D(UIFMES(UCNT))
  1.  S OUT=0 D
  1.  .;If UCNT has value, we are still looping through segments
  1.  .Q:UCNT
  1.  .;Otherwise no more segments in message being checked
  1.  .S OUT=1
  1.  .;quit if no other level exists
  1.  .Q:'$O(@G@(0))
  1.  .;otherwise see if next level is required
  1.  .S OUT2=0 F  D  Q:OUT2
  1.  ..S LVL(CURLVL+1)=1 S X=$$EXIST(.LVL,.DEFMES,.MESS) I 'X S OUT2=1 Q
  1.  ..;If next segment is navigational, look deeper
  1.  ..I $P(MESS,U)["NAVIGATE" S CURLVL=CURLVL+1 Q
  1.  ..I $P(MESS,U,3) S INMSG="Required segment "_$P(MESS,U,1)_" missing. Message ended abruptly.",INERR=2 D IO^INTSTR(INMSG) S OUT2=1
  1.  Q:OUT
  1.  ;Otherwise, fall through to recursive tag.
  1.  ;
  1.  ;If segment ids did not match, logic depends on whether we need
  1.  ;to look deeper into nesting (INCDEC=1) or are backing out (INCDEC=0)
  1.  D
  1.  .I INCDEC D  Q
  1.  ..;Check for required segment (only check going into nest)
  1.  ..I 'MATCH,MREQ S INMSG="Required segment "_MSID_" missing, "_USID_" segment found in it's place" D IO^INTSTR(INMSG)
  1.  ..;If another level exists, create another level counter. BUT don't
  1.  ..;go into nest if segments didn't match.
  1.  ..;First see if another level exists.
  1.  ..I MATCH,$O(@G@(0)) D  Q
  1.  ...S LVL(CURLVL+1)=1
  1.  ..;Else another level doesn't exist, increment at current level
  1.  ..;and see if node exists
  1.  ..S LVL(CURLVL)=CURCNT+1 S X=$$EXIST(.LVL,.DEFMES) Q:X
  1.  ..;If neither condition is met, set INCDEC=0 and back out
  1.  ..S INCDEC=0
  1.  ..I CURLVL>1 K LVL(CURLVL)
  1.  .I 'INCDEC D
  1.  ..;Test logic as of 4/28!!!!!
  1.  ..D FNDNXT(.LVL,CURLVL,.DEFMES)
  1.  ;Now that UCNT may have been incremented, and LVL definitely
  1.  ;has been modified, loop recursively
  1.  D LOOP(INUIF,.LVL,.UIFMES,.UCNT,.INCDEC,.DEFMES,.INERR)
  1.  Q
  1.  ;
  1. FNDNXT(LVL,CURLVL,DEFMES) ;Find next "nest"
  1.  ;If backing out of one nest, must find LVL at which another exists
  1.  ;or recursion will continually traverse up and down same nest.
  1.  ;INPUT:
  1.  ; LVL=Level array
  1.  ; LVL(CURLVL) = the current level in the LVL array
  1.  ; DEFMES = the defined message array
  1.  ;OUTPUT:
  1.  ; A new LVL at which a defined message exists
  1.  ; MREQ and MREP will be redefined if a match is found.
  1.  N OUT,ID,REP,REQ
  1.  ;If LVL=1, can't back out any further, increment LVL(1)
  1.  I CURLVL=1 S LVL(1)=LVL(1)+1 Q
  1.  S OUT=0 F  D  Q:OUT
  1.  .;Kill current level to back out one level
  1.  .K LVL(CURLVL)
  1.  .;Identify the deepest remaining level and its current count
  1.  .S CURLVL=$O(LVL(""),-1),CURCNT=LVL(CURLVL)
  1.  .;Again see if back out to LVL=1, can't back out any further
  1.  .I CURLVL=1 S LVL(1)=LVL(1)+1,OUT=1 Q
  1.  .;At current backed out level, if MSID=USID, it's a repeating segment.
  1.  .D MESSID(.LVL,.ID,.REP,.REQ) I ID=USID D  Q
  1.  ..;Be sure segment is allowed to repeat
  1.  ..I 'REP S INMSG="WARNING: Repeating segment "_ID_" is not defined as repeating" D IO^INTSTR(INMSG)
  1.  ..S MSID=ID,MREP=REP,MREQ=REQ,OUT=1
  1.  .;If no match on MSID, increment at this level and see if node exists.
  1.  .;If not, this function will continue to kill levels.
  1.  .S LVL(CURLVL)=CURCNT+1 S OUT=$$EXIST(.LVL,.DEFMES)
  1.  Q
  1.  ;
  1. EXIST(LVL,DEFMES,MESS) ;Return whether node exists at current level
  1.  ;INPUT:
  1.  ; LVL=the current nesting level
  1.  ; DEFMES = Defined message array
  1.  ; MESS (OPT) (PBR) = returns the 0 node
  1.  ;RETURN VALUE:
  1.  ;  1=YES 0=NO
  1.  S ORD="",I="" F  S I=$O(LVL(I)) Q:'I  D
  1.  .S ORD=ORD_LVL(I)_","
  1.  S G="DEFMES("_$E(ORD,1,($L(ORD)-1))_")"
  1.  I $D(MESS) S MESS=$G(@G@(0))
  1.  Q:$D(@G@(0)) 1
  1.  Q 0
  1.  ;
  1. MESSID(LVL,ID,REP,REQ) ;Lookup message id for segment at current level
  1.  ;This tag duplicates logic at LOOP+33, but it's too late in DIT
  1.  ;to consolidate.
  1.  ;INPUT:
  1.  ; ID=MESSAGE ID
  1.  ; LVL=LVL ARRAY
  1.  ; REP=Repeatable?
  1.  ; REQ=Required?
  1.  N ORD,I,G,MESS
  1.  S ORD="",I="" F  S I=$O(LVL(I)) Q:'I  D
  1.  .S ORD=ORD_LVL(I)_","
  1.  S G="DEFMES("_$E(ORD,1,($L(ORD)-1))_")"
  1.  S MESS(0)=$G(@G@(0))
  1.  S ID=$P(MESS(0),U),REP=$P(MESS(0),U,2),REQ=$P(MESS(0),U,3)
  1.  Q
  1.  ;