- INHMGD7 ;CAR; 7 May 97 11:43;HL7 MESSAGING - SEGMENT SUBROUTINE FOR SENSITIVITY ANALYSIS
- ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- ;COPYRIGHT 1991-2000 SAIC
- ;
- ; PURPOSE:
- ; Module SEG^INHMGD7 is used to navigate the segment list under
- ; each message in ^INTHL7M. It is called by INHMGD6 and it is called
- ; recursively to reach the children of parent segments, which are
- ; skipped by INHMGD6. And it is used to evaluate the address of each
- ; field in each segment.
- ;
- SEG(INSEG,INERN) ;process the segment
- ;get the segment description string and segment number from '7M.
- ; Inputs
- ; INSEG = Segment index
- ; INERN = Error counter.
- S INSEG(1)=^INTHL7M(INM,1,INSEG,0),INSEG(2)=INSEG,INSEG=+INSEG(1)
- Q:'$D(^INTHL7S(INSEG,0))
- ;
- N DIC,INWHILE,INCH,INUDI,INX,X
- S INSEG(0)=^INTHL7S(INSEG,0) Q:$P(INSEG(0),U,2)="MSH"
- S INWHILE=$P(INSEG(1),U,3)!$P(INSEG(1),U,4) ;REPEATS or OTHER
- S INUDI=$P(INSEG(1),U,12) ;user defined index
- I INWHILE,(INUDI="") D
- .I $P(INSEG(1),U,3),'$P(INSEG(1),U,4) D Q ;MULTIPLE
- ..;look up the multiple name to get the field#
- ..K DIC S (X,INX)=$P(INSEG(1),U,8),DIC="^DD("_+FILE(FLVL)_","
- ..S DIC(0)="FMZ",DIC("S")="I $P(^(0),U,2)" D ^DIC
- ..I Y<0 D Q
- ...S INWHILE=0 Q:INPARS&('INMODE) ;bogus seg. ok in input ParseOnly
- ...S INERN=INERN+.1
- ...S ^UTILITY("INHMGD",$J,"E",INM,INSEG,INERN)=+FILE(FLVL)_U_"Multiple "_INX_" does not exist"
- ..;multiple found, store file# in FILE(FLVL) and name in INWHILE(1)
- ..S FLVL=FLVL+1,FILE(FLVL)=+$P(Y(0),U,2),INWHILE(1)=$P(Y,U,2)
- .;must have been an OTHER
- .S FLVL=FLVL+1,FILE(FLVL)=+$P(INSEG(1),U,5)
- .I 'FILE(FLVL) D Q
- ..S INX="No OTHER file specified",INERN=INERN+.001
- ..S ^UTILITY("INHMGD",$J,"E",INM,INSEG,INERN)=FILE(FLVL)_U_INX
- .;store other file name
- .S INWHILE(1)=$P(^DIC(+FILE(FLVL),0),U)
- ;
- ;continue processing this segment.
- N INAS,INFC,INFIL,INFL,INFLD,INJ,INRS
- ;could have done this check earlier, but wanted to eval FILE(FLVL)
- I $D(^UTILITY("INHMGD",$J,"S",INSEG)) D
- .;now go through list of fields for this segment INAS="ien^ien^ien..."
- .S INAS=^UTILITY("INHMGD",$J,"S",INSEG)
- .F INJ=1:1:$L(INAS,U) K X D
- ..;separate out the field pointer, then get the contents INFC
- ..S INFL=$P(INAS,U,INJ) Q:'INFL
- ..S INFC=$G(^UTILITY("INHMGD",$J,"F",INFL)) Q:INFC=""
- ..;derive the address
- ..S INRS=$$RESOLVE^INHMGD3(FILE(FLVL),INFC)
- ..;If no results returned, mark as error and quit
- ..I '$L(INRS) D Q
- ...S ^UTILITY("INHMGD",$J,"E",INM,INSEG,INFL)=FILE(FLVL)_U_INFC_" Unable to resolve or missing from Data Dictionary."
- ..;mark progress?
- ..I INDOT S INDOT=INDOT+1 I INDOT>70 S INDOT=1 W "."
- ..;separate out root and field name
- ..S INFLD=+$P(INRS,":"),INFIL=+$P(INRS,":",2)
- ..I INFLD,INFIL S ^UTILITY("INHMGD",$J,"A",INFIL,INFLD,INFL,INSEG,INM)="" Q
- ..;trap for 'INFLD or 'INFIL
- ..S ^UTILITY("INHMGD",$J,"E",INM,INSEG,INFL)=FILE(FLVL)_U_"Missing "_INFLD_" or "_INFIL
- ;
- ;pick up child segments
- I $D(^INTHL7M(INM,1,"ASP",INSEG)) D
- .S INCH=0
- .F S INCH=$O(^INTHL7M(INM,1,"ASP",INSEG,INCH)) Q:'INCH D
- ..S INX=0 F S INX=$O(^INTHL7M(INM,1,"ASP",INSEG,INCH,INX)) Q:'INX D SEG(INX,.INERN)
- ;
- ;adjust file level
- I INWHILE S FLVL=FLVL-1
- I FLVL<0 D
- .S INERN=INERN+.001
- .S ^UTILITY("INHMGD",$J,"E",INM,INSEG,INERN)=FILE(0)_U_"FLVL at -1"
- .S FLVL=0
- Q
- ;
- INHMGD7 ;CAR; 7 May 97 11:43;HL7 MESSAGING - SEGMENT SUBROUTINE FOR SENSITIVITY ANALYSIS
- +1 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
- +2 ;COPYRIGHT 1991-2000 SAIC
- +3 ;
- +4 ; PURPOSE:
- +5 ; Module SEG^INHMGD7 is used to navigate the segment list under
- +6 ; each message in ^INTHL7M. It is called by INHMGD6 and it is called
- +7 ; recursively to reach the children of parent segments, which are
- +8 ; skipped by INHMGD6. And it is used to evaluate the address of each
- +9 ; field in each segment.
- +10 ;
- SEG(INSEG,INERN) ;process the segment
- +1 ;get the segment description string and segment number from '7M.
- +2 ; Inputs
- +3 ; INSEG = Segment index
- +4 ; INERN = Error counter.
- +5 SET INSEG(1)=^INTHL7M(INM,1,INSEG,0)
- SET INSEG(2)=INSEG
- SET INSEG=+INSEG(1)
- +6 IF '$DATA(^INTHL7S(INSEG,0))
- QUIT
- +7 ;
- +8 NEW DIC,INWHILE,INCH,INUDI,INX,X
- +9 SET INSEG(0)=^INTHL7S(INSEG,0)
- IF $PIECE(INSEG(0),U,2)="MSH"
- QUIT
- +10 ;REPEATS or OTHER
- SET INWHILE=$PIECE(INSEG(1),U,3)!$PIECE(INSEG(1),U,4)
- +11 ;user defined index
- SET INUDI=$PIECE(INSEG(1),U,12)
- +12 IF INWHILE
- IF (INUDI="")
- Begin DoDot:1
- +13 ;MULTIPLE
- IF $PIECE(INSEG(1),U,3)
- IF '$PIECE(INSEG(1),U,4)
- Begin DoDot:2
- +14 ;look up the multiple name to get the field#
- +15 KILL DIC
- SET (X,INX)=$PIECE(INSEG(1),U,8)
- SET DIC="^DD("_+FILE(FLVL)_","
- +16 SET DIC(0)="FMZ"
- SET DIC("S")="I $P(^(0),U,2)"
- DO ^DIC
- +17 IF Y<0
- Begin DoDot:3
- +18 ;bogus seg. ok in input ParseOnly
- SET INWHILE=0
- IF INPARS&('INMODE)
- QUIT
- +19 SET INERN=INERN+.1
- +20 SET ^UTILITY("INHMGD",$JOB,"E",INM,INSEG,INERN)=+FILE(FLVL)_U_"Multiple "_INX_" does not exist"
- End DoDot:3
- QUIT
- +21 ;multiple found, store file# in FILE(FLVL) and name in INWHILE(1)
- +22 SET FLVL=FLVL+1
- SET FILE(FLVL)=+$PIECE(Y(0),U,2)
- SET INWHILE(1)=$PIECE(Y,U,2)
- End DoDot:2
- QUIT
- +23 ;must have been an OTHER
- +24 SET FLVL=FLVL+1
- SET FILE(FLVL)=+$PIECE(INSEG(1),U,5)
- +25 IF 'FILE(FLVL)
- Begin DoDot:2
- +26 SET INX="No OTHER file specified"
- SET INERN=INERN+.001
- +27 SET ^UTILITY("INHMGD",$JOB,"E",INM,INSEG,INERN)=FILE(FLVL)_U_INX
- End DoDot:2
- QUIT
- +28 ;store other file name
- +29 SET INWHILE(1)=$PIECE(^DIC(+FILE(FLVL),0),U)
- End DoDot:1
- +30 ;
- +31 ;continue processing this segment.
- +32 NEW INAS,INFC,INFIL,INFL,INFLD,INJ,INRS
- +33 ;could have done this check earlier, but wanted to eval FILE(FLVL)
- +34 IF $DATA(^UTILITY("INHMGD",$JOB,"S",INSEG))
- Begin DoDot:1
- +35 ;now go through list of fields for this segment INAS="ien^ien^ien..."
- +36 SET INAS=^UTILITY("INHMGD",$JOB,"S",INSEG)
- +37 FOR INJ=1:1:$LENGTH(INAS,U)
- KILL X
- Begin DoDot:2
- +38 ;separate out the field pointer, then get the contents INFC
- +39 SET INFL=$PIECE(INAS,U,INJ)
- IF 'INFL
- QUIT
- +40 SET INFC=$GET(^UTILITY("INHMGD",$JOB,"F",INFL))
- IF INFC=""
- QUIT
- +41 ;derive the address
- +42 SET INRS=$$RESOLVE^INHMGD3(FILE(FLVL),INFC)
- +43 ;If no results returned, mark as error and quit
- +44 IF '$LENGTH(INRS)
- Begin DoDot:3
- +45 SET ^UTILITY("INHMGD",$JOB,"E",INM,INSEG,INFL)=FILE(FLVL)_U_INFC_" Unable to resolve or missing from Data Dictionary."
- End DoDot:3
- QUIT
- +46 ;mark progress?
- +47 IF INDOT
- SET INDOT=INDOT+1
- IF INDOT>70
- SET INDOT=1
- WRITE "."
- +48 ;separate out root and field name
- +49 SET INFLD=+$PIECE(INRS,":")
- SET INFIL=+$PIECE(INRS,":",2)
- +50 IF INFLD
- IF INFIL
- SET ^UTILITY("INHMGD",$JOB,"A",INFIL,INFLD,INFL,INSEG,INM)=""
- QUIT
- +51 ;trap for 'INFLD or 'INFIL
- +52 SET ^UTILITY("INHMGD",$JOB,"E",INM,INSEG,INFL)=FILE(FLVL)_U_"Missing "_INFLD_" or "_INFIL
- End DoDot:2
- End DoDot:1
- +53 ;
- +54 ;pick up child segments
- +55 IF $DATA(^INTHL7M(INM,1,"ASP",INSEG))
- Begin DoDot:1
- +56 SET INCH=0
- +57 FOR
- SET INCH=$ORDER(^INTHL7M(INM,1,"ASP",INSEG,INCH))
- IF 'INCH
- QUIT
- Begin DoDot:2
- +58 SET INX=0
- FOR
- SET INX=$ORDER(^INTHL7M(INM,1,"ASP",INSEG,INCH,INX))
- IF 'INX
- QUIT
- DO SEG(INX,.INERN)
- End DoDot:2
- End DoDot:1
- +59 ;
- +60 ;adjust file level
- +61 IF INWHILE
- SET FLVL=FLVL-1
- +62 IF FLVL<0
- Begin DoDot:1
- +63 SET INERN=INERN+.001
- +64 SET ^UTILITY("INHMGD",$JOB,"E",INM,INSEG,INERN)=FILE(0)_U_"FLVL at -1"
- +65 SET FLVL=0
- End DoDot:1
- +66 QUIT
- +67 ;
