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

INHMGD2.m

Go to the documentation of this file. 
  1. INHMGD2 ;CAR; 27 Jun 97 15:34;HL7 MESSAGING - PROCESS SEGMENT
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ; MODULE NAME:
  1.  ; HL7 Messaging - Process Segment
  1.  ;
  1.  ; PURPOSE:
  1.  ; Module INHMGD2 is used to order through the fields
  1.  ; pointed to by ^INTHL7M(INDA,1,SEG,0)
  1.  ;
  1. SEG(INSEG,FLVL,FILE,INP,INERN) ;Process segment
  1.  ; Input:
  1.  ;   INSEG= Seg is the index to the ^INTHL7M(INDA,1,SEG,0) node, and
  1.  ;          is used to retrieve INMSG(1).
  1.  ;   FLVL = Current level in FILE.
  1.  ;   FILE = Stacks file# references.
  1.  ;   INP  = The output array used to create a data file for export to 
  1.  ;          a tab delimited text file.
  1.  ;   INERN= An incrementing counter to prevent multiple error msgs
  1.  ; Output:
  1.  ;   INERN,INP and FILE
  1.  ;
  1.  ;get next segment descriptor.
  1.  S INSEG(1)=$G(^INTHL7M(INMSG,1,INSEG,0)),INSEG=+INSEG(1),INSEG(2)=INSEG
  1.  Q:'$D(^INTHL7S(INSEG,0))
  1.  ;
  1.  ;quit if common or MSH segment?
  1.  S INSEG(0)=^INTHL7S(INSEG,0)
  1.  I 'INCSG,"MSH,PID,"[($P(INSEG(0),U,2)_",") Q
  1.  ;
  1.  ;check for MULTIPLE, OTHER.
  1.  N DIC,INWHILE,INCH,X,INX,Y,INUDI,INDHDR
  1.  S INWHILE=$P(INSEG(1),U,3)!$P(INSEG(1),U,4)
  1.  S INUDI=$P(INSEG(1),U,12) ;user defined index
  1.  I INWHILE,(INUDI="") D
  1.  .I $P(INSEG(1),U,3),'$P(INSEG(1),U,4) D  Q  ;MULTIPLE
  1.  ..K DIC S (X,INX)=$P(INSEG(1),U,8)
  1.  ..S DIC="^DD("_+FILE(FLVL)_",",DIC(0)="FMZ"
  1.  ..S DIC("S")="I $P(^(0),U,2)" D ^DIC
  1.  ..I Y<0 D  Q
  1.  ...S INWHILE=0 Q:INPARS  ;bogus segs ok in Parse Only msg.
  1.  ...S INERN=INERN+.001
  1.  ...S ^UTILITY("INHMGD",$J,"E",INMSG,INSEG,INERN)=+FILE(FLVL)_U_"Multiple "_INX_" does not exist"
  1.  ..S FLVL=FLVL+1,FILE(FLVL)=+$P(Y(0),U,2),INWHILE(1)=$P(Y,U,2)
  1.  .S FLVL=FLVL+1,FILE(FLVL)=+$P(INSEG(1),U,5)
  1.  .I 'FILE(FLVL) D  S FLVL=FLVL-1,INWHILE=0 Q
  1.  ..S INX="No OTHER file specified",INERN=INERN+.001
  1.  ..S ^UTILITY("INHMGD",$J,"E",INMSG,INERN)=+FILE(FLVL)_U_INX
  1.  .S INWHILE(1)=$P(^DIC(+FILE(FLVL),0),U)
  1.  ;
  1.  N INF,INY,INREPEAT,INFLD
  1.  S INY=INSEG(0)
  1.  S INSG("NM")=$E($P(INY,U),1,45) ;Segment Name
  1.  S INSG("NM",1)=$E($P(INY,U,2),1,6) ;Segment ID
  1.  ;
  1.  S INY=INSEG(1) ;from ^INTHL7M(INMSG,1,INX,0)
  1.  S INSG("NM",2)=$P(INY,U,2) ;Sequence Number
  1.  S INSG("NM",9)=$$YN^INHMGD1($P(INY,U,9),1) ;Required?
  1.  ;Parent Segment?
  1.  S X=$P(INY,U,11)
  1.  S INSG("PS")=$E($S(X="":X,$D(^INTHL7S(X,0))#2:$P(^(0),U),1:" "_X),1,45)
  1.  S INREPEAT=$P(INY,U,3)
  1.  S INSG("NM",3)=$$YN^INHMGD1(INREPEAT,1) ;Repeatable?
  1.  ;OTHER Flag & File Name
  1.  S INSG("NM",4)=$$YN^INHMGD1($P(INY,U,4),1)
  1.  S X=$P(INY,U,5)
  1.  S INSG("FL")=$E($S(X="":X,$D(^DIC(X,0))#2:$P(^(0),U),1:" "_X),1,45)
  1.  S INSG("MF")=$E($P(INY,U,8),1,30) ;Multiple Field Name
  1.  I +INSG("MF")=INSG("MF") D
  1.  .K DIC S X=INSG("MF"),DIC="^DD("_+FILE(FLVL)_",",DIC(0)="FMZ"
  1.  .S DIC("S")="I $P(^(0),U,2)" D ^DIC Q:Y<0
  1.  .S INSG("MF")=$E(Y(0,0),1,30)
  1.  S INSG("UD")=$P(INY,U,12)
  1.  ;
  1.  ;cleanup INP leaving flag & Message Name
  1.  I INP D
  1.  .S INP=$P(INP,TAB)_TAB_$P(INSEG(0),U,2) ;$P2 seg ID
  1.  .S INP=INP_TAB_$P(INSEG(0),U) ;          $P3 seg name
  1.  .S INP=INP_TAB_INSG("NM",2) ;            $P4 seg seq#
  1.  .S INP=INP_TAB_$S(INSG("NM",3)["Y":"Y",1:"") ;$P5 repeatable
  1.  .S INP=INP_TAB_INSG("MF") ;              $P6 Multiple Field Name
  1.  .S INP=INP_TAB_$S(INSG("NM",9)["Y":"Y",1:"") ;$P7 Seg Reqd (Y/"")
  1.  .S INP=INP_TAB_INSG("PS") ;              $P8 Parent Seg#
  1.  ;
  1.  ;Lookup Params
  1.  S INSG("LP")=$$LKPRM^INHMGD1($P(INY,U,7))
  1.  ;Make Links
  1.  S X=$P(INY,U,10),INSG("ML")=$$YN^INHMGD1(X,1)
  1.  ;Template
  1.  S X=$P(INY,U,6),INSG("TP")=$E($P(INY,U,6),1,30)
  1.  ;name of routine to run after lookup.
  1.  S X=$G(^INTHL7M(INMSG,1,INSEG,3)),INSG("RT")=$E(X,1,100)
  1.  ;
  1.  S INDHDR=0 ;Did we just write the header
  1.  I IO=IO(0)!'INPAGE!($Y>(IOSL-13)) S INDHDR=1 D HEADER^INHMGD1 Q:INEXIT
  1.  ;Output seg header
  1.  S DATA="""=====Segment Name"_$$DASH^INHMGD1(32+INOFF,"=")
  1.  S DATA=DATA_"ID=====Seq No==Req==Rep==OF=="""
  1.  I IO'=IO(0)!($Y<(IOSL-13)),'INDHDR S DATA="!,"_DATA
  1.  D WRITE^INHMGD1
  1.  ;
  1.  S DATA="INSG(""NM""),?(49+INOFF+ING),INSG(""NM"",1)" ;seg Name and ID
  1.  S DATA=DATA_",?(56+INOFF+ING),$J(INSG(""NM"",2),0,1)" ;seg seq. number
  1.  S DATA=DATA_",?(64+INOFF+ING),INSG(""NM"",9)" ;seg is required?
  1.  S DATA=DATA_",?(69+INOFF+ING),INSG(""NM"",3)" ;seg is repeatable?
  1.  S DATA=DATA_",?(74+INOFF+ING),INSG(""NM"",4)" ;OTHER FILE?
  1.  D WRITE^INHMGD1
  1.  ;
  1.  I $G(INSG("PS"))]"" D
  1.  .S DATA="?ING+8,""Parent Segment:"",?ING+24,INSG(""PS"")"
  1.  .D WRITE^INHMGD1
  1.  I $G(INSG("FL"))]"" D
  1.  .S DATA="?ING+18,""File:"",?ING+24,INSG(""FL"")"
  1.  .D WRITE^INHMGD1
  1.  I $G(INSG("MF"))]"" D
  1.  .S DATA="?ING+8,""Multiple Field:"",?ING+24,INSG(""MF"")"
  1.  .D WRITE^INHMGD1
  1.  I $G(INSG("UD"))]"" D
  1.  .S DATA="?ING+4,""User-Defined Index:"",?ING+24,INSG(""UD"")"
  1.  .D WRITE^INHMGD1
  1.  I $G(INSG("LP"))]"" D
  1.  .S DATA="?ING+6,""Lookup Parameter:"",?ING+24,INSG(""LP"")"
  1.  .D WRITE^INHMGD1
  1.  I $G(INSG("ML"))]"" D
  1.  .S DATA="?ING+12,""Make Links:"",?ING+24,INSG(""ML"")"
  1.  .D WRITE^INHMGD1
  1.  I $G(INSG("TP"))]"" D
  1.  .S DATA="?ING+14,""Template:"",?ING+24,INSG(""TP"")"
  1.  .D WRITE^INHMGD1
  1.  I $G(INSG("RT"))]"" D
  1.  .S DATA="?ING+15,""Routine:"",?ING+24,INSG(""RT"")"
  1.  .D WRITE^INHMGD1
  1.  S DATA="$C(32)" D WRITE^INHMGD1
  1.  S INHF2=-1
  1.  ;
  1.  S INF=""
  1.  ; order through the "AS" INF node (this is the sequence number)
  1.  F  S INF=$O(^INTHL7S(INSEG,1,"AS",INF)) Q:'INF!$G(DUOUT)  D
  1.  .S INX=0
  1.  .; now get the index number (INX) that the sequence number points to
  1.  .F  S INX=$O(^INTHL7S(INSEG,1,"AS",INF,INX)) Q:'INX!INEXIT  D
  1.  ..S X=INX,INFLD(1)=^INTHL7S(INSEG,1,X,0)
  1.  ..D:$D(^INTHL7F(+INFLD(1),0)) FIELD^INHMGD3(X,INF,FLVL,.FILE,.INP)
  1.  ;
  1.  ;pick up parent segments
  1.  I $D(^INTHL7M(INMSG,1,"ASP",INSEG)) D
  1.  .S INCH=0
  1.  .F  S INCH=$O(^INTHL7M(INMSG,1,"ASP",INSEG,INCH)) Q:'INCH  D
  1.  ..S INX=0 F  S INX=$O(^INTHL7M(INMSG,1,"ASP",INSEG,INCH,INX)) Q:'INX  D SEG(INX,.FLVL,.FILE,.INP,.INERN)
  1.  ;
  1.  ;adjust file level
  1.  I INWHILE S FLVL=FLVL-1
  1.  Q