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

INHMGD6.m

Go to the documentation of this file. 
  1. INHMGD6 ;CAR; 7 May 97 11:43;HL7 MESSAGING - REBUILD SENSITIVITY ANALYSIS GLOBAL
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ; PURPOSE:
  1.  ; Module INHMGD6 is used to rebuild the Sensitivity Analysis Global
  1.  ; ^UTILITY("INHMGD",
  1.  ;
  1. INSUPDT ;Create ^UTILITY("INHMGD",$J,...) dBase
  1.  ; Input:
  1.  ;   None:
  1.  ;
  1.  N INAS,INDA,INDC,INDL,INDOT,INF,INFS,INH,INJ
  1.  N INM,INS,INSEG,INSQ
  1.  S INDOT=0 ;show user some activity when rebuilding?
  1.  I $E(IOST)="C",'$D(IO("Q")),IO=IO(0) S INDOT=1
  1.  I INDOT W !,"Rebuilding ^UTILITY(""INHMGD""), this may take a while."
  1.  ;
  1.  ;1. load all Fields (^INTHL7F(X)), containing a "C" node and ] "", but
  1.  ;   watch for 10 nodes and expand subfields.
  1.  S INF=0 F  S INF=$O(^INTHL7F(INF)) Q:'INF  D
  1.  .;try for the DOCUMENTED DATA SOURCE 1st
  1.  .S INDL=$P($G(^INTHL7F(INF,0)),U,11)
  1.  .I INDL]"" S INDL="##"_INDL
  1.  .;else  go for the DATA LOCATION
  1.  .S:INDL="" INDL=$G(^INTHL7F(INF,"C"))
  1.  .;pick up any sub-fields, must check for actual content
  1.  .I $D(^INTHL7F(INF,10,"AS")) D  Q
  1.  ..S (INX,INAS)="" F  S INX=$O(^INTHL7F(INF,10,"AS",INX)) Q:'INX  D
  1.  ...S INDA=$O(^INTHL7F(INF,10,"AS",INX,0))
  1.  ...S INDA=+$G(^INTHL7F(INF,10,+INDA,0)) Q:'INDA
  1.  ...Q:'$D(^INTHL7F(INDA,"C"))  S INDC=^INTHL7F(INDA,"C")
  1.  ...Q:$TR(INDC," ")=""!(INDC["@")
  1.  ...I INDC'["INTERNAL",$E(INDC)="""" Q
  1.  ...S INAS=INAS_$S(INAS]"":"^"_INDA,1:INDA)
  1.  ..I $L(INAS) S ^UTILITY("INHMGD",$J,"F10",INF)=INAS
  1.  .Q:INDL=""
  1.  .;don't save what we can't use
  1.  .Q:INDL["@"
  1.  .I $E(INDL)="""",INDL'["INTERNAL" Q
  1.  .S ^UTILITY("INHMGD",$J,"F",INF)=INDL
  1.  I INDOT W "."
  1.  ;
  1.  ;2. load Segments (^INTHL7S(X)), pointing to an ^INTHL7F(fld,"C")
  1.  ;   containing more than "".
  1.  S INS=0 F  S INS=$O(^INTHL7S(INS)) Q:'INS  D
  1.  .;order through the fields using the "AS" field
  1.  .S INFS=0,INAS="" F  S INFS=$O(^INTHL7S(INS,1,"AS",INFS)) Q:'INFS  D
  1.  ..;get the "in order" index INSQ
  1.  ..S INSQ=$O(^INTHL7S(INS,1,"AS",INFS,0)) Q:'INSQ
  1.  ..;which points to the INSEG field
  1.  ..S INSEG=+$G(^INTHL7S(INS,1,INSQ,0))
  1.  ..;check if there is a DATA LOCATION or DOCUMENTED DATA SOURCE
  1.  ..I INSEG,$D(^UTILITY("INHMGD",$J,"F",INSEG)) D  Q
  1.  ...S INAS=INAS_$S(INAS]"":"^"_INSEG,1:INSEG) ;format is: ien^ien^ien...
  1.  ..;how about a sub-field
  1.  ..I INSEG,$D(^UTILITY("INHMGD",$J,"F10",INSEG)) D
  1.  ...S INSFS=^UTILITY("INHMGD",$J,"F10",INSEG) ;get the subfield string
  1.  ...S INAS=INAS_$S(INAS]"":"^"_INSFS,1:INSFS) ;tack it on to INAS
  1.  .;save any fields that we found.
  1.  .S:INAS]"" ^UTILITY("INHMGD",$J,"S",INS)=INAS
  1.  I INDOT W "."
  1.  ;
  1.  ;3. then order through the messages (^INTHL7M(X)), and for each segment
  1.  ;in ^UTILITY, store the following:
  1.  ; (root,field,HL7field,segment,message) where there is a field
  1.  ;-----------main message loop-------------------
  1.  S INM=0 F  S INM=$O(^INTHL7M(INM)) Q:'INM  D
  1.  .S INM(0)=$G(^INTHL7M(INM,0))
  1.  .Q:$P(INM(0),U,8)  ;inactive - quit
  1.  .S INTRP=$G(^INTHL7M(INM,"S")) ;get script pointers
  1.  .S INMODE=$S($P(INTRP,U,2):1,1:0) ;incoming (0) or outgoing (1) message
  1.  .S INPARS=$S($P(INM(0),U,7)="P":1,1:0) ;is parse only set
  1.  .K FILE,FLVL S FLVL=0
  1.  .;get the root from $P5 of ^(0), exit if there is no root.
  1.  .S FILE=$P(INM(0),U,5) Q:'FILE  S FILE(0)=FILE
  1.  .;order through the segment pointers. "AS" x-ref is in output order
  1.  .S INS=0 F  S INS=$O(^INTHL7M(INM,1,"AS",INS)) Q:'INS  D
  1.  ..;$O to get the index that the "AS" references
  1.  ..S INX=$O(^INTHL7M(INM,1,"AS",INS,0)) Q:'INX
  1.  ..;check for common err:2 INSQs
  1.  ..S INSEG(1)=$O(^INTHL7M(INM,1,"AS",INS,INX)) I INSEG(1) D
  1.  ...S INSEG(1)=$G(^INTHL7M(INM,1,INX,0)),INERN=INERN+.001
  1.  ...S ^UTILITY("INHMGD",$J,"E",INM,+INSEG(1),INERN)=FILE(FLVL)_U_"Msg# "_INM_" has multiple segments defined for Sequence# "_$P(INSEG(1),U,2)
  1.  ..;retrieve segment info, skip processing if seg has parent segment,
  1.  ..;since it will be called recursively from SEG
  1.  ..S INSEG(1)=$G(^INTHL7M(INM,1,INX,0)) D:'$P(INSEG(1),U,11) SEG^INHMGD7(INX,.INERN)
  1.  ;
  1.  ;the UTILITY global is complete, delete the nodes we no longer need.
  1.  K ^UTILITY("INHMGD",$J,"F"),^UTILITY("INHMGD",$J,"S")
  1.  K ^UTILITY("INHMGD",$J,"F10"),^UTILITY("INHMGD",$J,"M")
  1.  Q
  1.  ;