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

INTSTR1.m

Go to the documentation of this file. 
  1. INTSTR1 ;DGH; 5 Aug 97 10:35;Continuation of required field function
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  Q  ;no top entry
  1.  ; Entry points are all called from INTSTR.
  1.  ; MSG:
  1.  ;  Given an entry in the SCRIPT GENERATOR MESSAGE file, this
  1.  ;  builds an array of segments and required fields.
  1.  ; UIF:
  1.  ;  Given an entry in the Universal Interface File, build an array
  1.  ;  of segment ids.
  1.  ; VALID: Validates fields.
  1.  ;
  1. UIF(UIF,INARRAY,INDELIM,INSUBDEL) ;build array of UIF segment ids
  1.  ;INPUT
  1.  ;  UIF = Entry in the UIF
  1.  ;  INARRAY = PBR array to return array. Final format will be
  1.  ;     INARRAY(1)=MSH
  1.  ;     INARRAY(2)=PID  and so on.
  1.  ;       Note: this may be a sparse array if the UIF segments
  1.  ;       overflow into multiple INHTU(uif,3, nodes
  1.  ;  INDELIM = PBR value to find the HL7 delimiter from the message
  1.  ;RETURN VALUE
  1.  ; 0 = array build successfully
  1.  ; 1 = fatal error
  1.  ;
  1.  N LCT,LINE,INMSG
  1.  ;First entry in 3 node of UIF should be MSH, set HL7 delimiter
  1.  S LCT=0 D GETLINE^INHOU(UIF,.LCT,.LINE)
  1.  I '$D(LINE) D IO^INTSTR("No segments found in message") Q 1
  1.  S INDELIM=$E(LINE,4)
  1.  I $P(LINE,INDELIM)'="MSH" D IO^INTSTR("First segment is not MSH") Q 1
  1.  ;Set variable with ALL the delimiter set
  1.  S INSUBDEL=$P(LINE,INDELIM,2)
  1.  ;Build array of segment ids
  1.  S INARRAY(LCT)="MSH"
  1.  F  D GETLINE^INHOU(UIF,.LCT,.LINE) Q:'$D(LINE)  D
  1.  .S INARRAY(LCT)=$P(LINE,INDELIM)
  1.  Q 0
  1.  ;
  1. MSG(MESS,INSEG) ;Enter here with known message ien
  1.  ;INPUT
  1.  ;   MESS=ien of message
  1.  ;OUTPUT
  1.  ;   INSEG array with following format (PBR)
  1.  ;   INSEG(<sequence>,0) = <seg id>^Repeatable?^Required? (0=no, 1=yes)
  1.  ;   INSEG(<sequence>,<nested sequence>,0) = <seg id>^Repeat?^Required?
  1.  ;   INSEG(<seg id>)=Req field 1^Req field 2^....
  1.  ; Example:
  1.  ;   INSEG(1,0)=MSH^0^1
  1.  ;   INSEG(2,0)=PID^0^1
  1.  ;   INSEG(3,0)=OBC^1^1
  1.  ;   INSEG(3,1,0)=OBR^1^0
  1.  ;   INSEG("MSH")=1^1^^^1^^1
  1.  ;   INSEG("PID")=^^^1^^1^
  1.  ;INTERNALS
  1.  ;
  1.  ;Key variables
  1.  ;   MULTIEN= ien of segment multiple
  1.  ;   SEGIEN=  ien of segment in segment file
  1.  N INS,MULTIEN,SEG,SEGIEN,INMSG,LVL,I,ORD
  1.  ;Get message name
  1.  S INMSG=$P(^INTHL7M(MESS,0),U)
  1.  ;
  1.  ;------------Build array of segments-----------------------------
  1.  ;  This builds an array in variable INSEG, which is then inserted
  1.  ;if any are defined, in sequence order (the "AS" x-ref)
  1.  Q:'$D(^INTHL7M(MESS,1))
  1.  ;   Process segments in sequence order BUT if a segment is a parent
  1.  ;   to other segments, place those in order (see end of SEG tag).
  1.  S ORD=1,LVL(1)=0
  1.  S INS="" F  S INS=$O(^INTHL7M(MESS,1,"AS",INS)) Q:'INS  D
  1.  .;Accomodate possibility of duplicate sequence numbers
  1.  .S MULTIEN=""
  1.  .F  S MULTIEN=$O(^INTHL7M(MESS,1,"AS",INS,MULTIEN)) Q:'MULTIEN  D
  1.  ..S SEG(1)=^INTHL7M(MESS,1,MULTIEN,0),SEGIEN=+SEG(1)
  1.  ..;at this point int the loop only LVL(1) should remain. Kill
  1.  ..;other levels in case they weren't killed inside SEG tag.
  1.  ..S I=1 F  S I=$O(LVL(I)) Q:'I  K LVL(I)
  1.  ..;11 piece=parent. If this segment has a parent, don't process now.
  1.  ..D:'$P(SEG(1),U,11) SEG(MESS,MULTIEN,.LVL)
  1.  ;Add segments that have no sequence number
  1.  S INS=0 F  S INS=$O(^INTHL7M(MESS,1,INS)) Q:'INS  D
  1.  .Q:+$P(^INTHL7M(MESS,1,INS,0),U,2)
  1.  .D SEG(MESS,INS,.LVL)
  1.  Q
  1.  ;
  1. SEG(MESS,MULTIEN,LVL) ;  Load array with data from the segment multiple.
  1.  ;INPUT
  1.  ;  MESS = Pointer to Script Generator Message File
  1.  ;  MULTIEN= Pointer to the segment multiple in MESS
  1.  ;  LVL = Level array (PBR)
  1.  N CH,CH2,PARENT,SEGIEN,DIFF,FSEQ,MULT,SEGNAM,STR,FLD,I,LEN,ORD,REQ,SEG,FLDP,J
  1.  S SEGIEN=+^INTHL7M(MESS,1,MULTIEN,0)
  1.  ;MULT(0) is zero node of the entry in the segment multiple
  1.  S MULT(0)=^INTHL7M(MESS,1,MULTIEN,0)
  1.  ;SEG(0) is zero node of the entry in the segment file
  1.  S SEG(0)=^INTHL7S(SEGIEN,0)
  1.  ;set string of required fields
  1.  S (STR,FSEQ)="",REQ=0
  1.  F  S FSEQ=$O(^INTHL7S(SEGIEN,1,"AS",FSEQ)) Q:'FSEQ  D
  1.  .S FLD=$O(^INTHL7S(SEGIEN,1,"AS",FSEQ,"")) Q:'FLD
  1.  .;3rd piece defines "required" within the segment
  1.  .S REQ=$P(^INTHL7S(SEGIEN,1,FLD,0),U,3)
  1.  .;If not required, see if field has any required subfields.
  1.  .I 'REQ D
  1.  ..S FLDP=+^INTHL7S(SEGIEN,1,FLD,0)
  1.  ..Q:'$D(^INTHL7F(FLDP,10))
  1.  ..S J=0 F  S J=$O(^INTHL7F(FLDP,10,J)) Q:'J!REQ  D
  1.  ...;Set required flag to 2if any subfields are required.
  1.  ...S:$P($G(^INTHL7F(FLDP,10,J,0)),U,3) REQ=2
  1.  .S $P(STR,U,FSEQ)=+REQ
  1.  ;Ignore segments with no fields, they may be "navigational".
  1.  ;Only set level array if it is "real"
  1.  D
  1.  .;increment counter at highest level defined
  1.  .S I=$O(LVL(""),-1),LVL(I)=LVL(I)+1
  1.  .;set order variable to include all level counters
  1.  .S ORD="",I="" F  S I=$O(LVL(I)) Q:'I  D
  1.  ..S ORD=ORD_LVL(I)_","
  1.  .S ORD="INSEG("_ORD_"0)"
  1.  .;Only set level array if it is "real"
  1.  .I '$L(STR) D  Q
  1.  ..S @ORD="NAVIGATE"_U_$P(MULT(0),U,3)_U_$P(MULT(0),U,9)
  1.  ..I $D(DEBUG) S $P(@ORD,U,4)=$P(SEG(0),U)_U_$P(MULT(0),U,2)
  1.  .S @ORD=$P(SEG(0),U,2)_U_$P(MULT(0),U,3)_U_$P(MULT(0),U,9)
  1.  .;For debug, tack on segment name and sequence number
  1.  .I $D(DEBUG) S $P(@ORD,U,4)=$P(SEG(0),U)_U_$P(MULT(0),U,2)
  1.  .;Set array with seg id^repeatable?^required?
  1.  .S SEGNAM=$P(SEG(0),U,2)
  1.  .I '$D(INSEG(SEGNAM)) S INSEG(SEGNAM)=STR Q
  1.  .;If required field definition has already been set, check it
  1.  .S LEN=$L(STR,U) S:$L(INSEG(SEGNAM),U)>LEN LEN=$L(INSEG(SEGNAM),U)
  1.  .S DIFF=0 F I=1:1:LEN Q:DIFF  S:+$P(STR,U,I)'=+$P(INSEG(SEGNAM),U,I) DIFF=1
  1.  .Q:'DIFF
  1.  .;If there are differences, reset INSEG(SEGNAM) to maximum required.
  1.  .;But only display warning message once per segment
  1.  .D:'$D(INSEG(SEGNAM,1))
  1.  ..S INMSG="Multiple "_SEGNAM_" segments are included in this message definition" D IO^INTSTR(INMSG)
  1.  ..D IO^INTSTR("Validation will be performed using maximum set of required fields",0)
  1.  ..S INSEG(SEGNAM,1)=$G(INSEG(SEGNAM,1))+1
  1.  .F I=1:1:LEN S $P(INSEG(SEGNAM),U,I)=$P(STR,U,I)+$P(INSEG(SEGNAM),U,I)
  1.  ;parent
  1.  S PARENT=$S('$P(MULT(0),U,11):"",1:$P(^INTHL7S($P(MULT(0),U,11),0),U,2))
  1.  ;   See if this segment is a parent to others, Quit if not
  1.  Q:'$D(^INTHL7M(MESS,1,"ASP",SEGIEN))
  1.  ;   If it is a parent, call SEG recursively. Also create another LVL.
  1.  ;   Example, with LVL(1)=3, the current segment might be OBC, so
  1.  ;   INSEG(3,0)=OBC. With OBC as a parent, LVL(2)=0 is created here,
  1.  ;   incremented in the recursive call, and a "child" OBR is created
  1.  ;   at INSEG(3,1,0)=OBR. A "child" OBX becomes INSEG(3,1,1,0)=OBX.
  1.  ;   A second "child" to the OBR, (say NTE), becomes INSEG(3,1,2,0)=NTE.
  1.  ;S I=$O(LVL(""),-1) S:LVL(I)>0 LVL(I+1)=0
  1.  S I=$O(LVL(""),-1),LVL(I+1)=0
  1.  S CH=0 F  S CH=$O(^INTHL7M(MESS,1,"ASP",SEGIEN,CH)) Q:'CH  D
  1.  .S CH2=$O(^INTHL7M(MESS,1,"ASP",SEGIEN,CH,0))
  1.  .D SEG(MESS,CH2,.LVL)
  1.  ;After the recursion quits in previous line, kill current LVL
  1.  S I=$O(LVL(""),-1) K LVL(I)
  1.  Q
  1.  ;
  1. VALID(LCT,DEFMES,MSID,UIFMES,UCNT,INUIF,INERR) ;Validate required fields
  1.  ;Validation consists of checking for the existance of data in field.
  1.  ;No check is performed for type of data.
  1.  ;INPUT:
  1.  ; LCT = (PBR) Line count. It is incremented within VALID
  1.  ; DEFMES= (PBR) Defined message array
  1.  ; MSID= Segment ID for segment being evaluated
  1.  ;    DEFMES(MSID) = string of required fields in sequence order.
  1.  ;    Example: 1^0^1^2 means <SEG ID>-1 is required, -2 is not
  1.  ;    A value of 2 indicates field is not required, but subfield(s) are.
  1.  ;    The VALID function does not currently check individual subfields
  1.  ;    but the capability could be added.
  1.  ; UIFMES = (PBR) Actual message array
  1.  ; UCNT = Pointer in array
  1.  ; INUIF = Entry of actual message in UIF
  1.  ;OUTPUT
  1.  ;  A <validated> flag will be added to the UIFMES array
  1.  ;  UIFMES(segment number)=<seg id>^<validated>
  1.  ;  1=all required fields are present
  1.  ;  2=at least one required field is missing
  1.  ;  Nothing indicates the segment was not validated, probably
  1.  ;  because bad message structure made segment impossible to get to.
  1.  ; INERR = (PBR) Is set to 1 if any error condition is encountered
  1.  ; UIFMES(UCNT) = Is updated with flag in second piece
  1.  ;
  1.  N ERR,LINE,I,J,MSH,SEGID,VALSTR,VAR
  1.  S ERR=0
  1.  D GETLINE^INHOU(INUIF,.LCT,.LINE)
  1.  Q:'$D(LINE)
  1.  I $D(DEBUG)>1 D IO^INTSTR(LINE)
  1.  ;Set string of required fields for the current segment
  1.  S VALSTR=$G(DEFMES(MSID)) I '$L(VALSTR) S INMSG="Segment "_MSID_" is not defined for this message" D IO^INTSTR(INMSG) Q
  1.  ;Set flag if this is the MSH segment
  1.  S SEGID=$P(LINE,INDELIM),MSH=$S(SEGID="MSH":1,1:0)
  1.  F I=1:1:$L(VALSTR,U) D
  1.  .;If the piece position does not have value, it is not required.
  1.  .Q:'$P(VALSTR,U,I)
  1.  .;If checking MSH, $P position=HL7 position. Otherwise add one
  1.  .S J=$S(MSH:I,1:I+1)
  1.  .S VAR=$$PIECE^INHU(.LINE,INDELIM,J)
  1.  .;For all fields except MSH-2, translate out delimiter set (INSUBDEL).
  1.  .;If a field has required subfields, this does not check that the
  1.  .;proper subfield has value, only that the field containing it does.
  1.  .I MSH,(J=2),$L(VAR) Q
  1.  .S VAR=$TR(VAR,INSUBDEL,"")
  1.  .;If required field is not present, display it and set error flag
  1.  .I '$L(VAR) S INMSG="Missing required field "_SEGID_"("_I_")",ERR=1 D IO^INTSTR(INMSG)
  1.  .;;for debugging only
  1.  .I $D(DEBUG),$L(VAR) S INMSG="Required field "_SEGID_"("_I_") = "_VAR D IO^INTSTR(INMSG)
  1.  ;Set <valid> piece in array
  1.  S $P(UIFMES(UCNT),U,2)=$S(ERR:2,1:1) S:ERR INERR=1
  1.  Q
  1.  ;
  1.  ;
  1.  ;