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

INHMGD3.m

Go to the documentation of this file. 
  1. INHMGD3 ;CAR; 16 May 97 16:46;HL7 MESSAGING - MANAGEMENT OF DATA SOURCES
  1.  ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001
  1.  ;COPYRIGHT 1991-2000 SAIC
  1.  ;
  1.  ; MODULE NAME:
  1.  ; HL7 Messaging - Data Source Display and Validation
  1.  ;                 Handle Field (INHMGD3).
  1.  ;
  1.  ; PURPOSE:
  1.  ; Module INHMGD3 is used to extract information describing the
  1.  ; source file and field for HL7 Messaging segment fields.
  1.  ;(X,INF,FLVL,.FILE,.INP)
  1. FIELD(INFLD,INF,FLVL,FILE,INP) ;Handle a field in SCRIPT GENERATOR FIELD^4012
  1.  ;
  1.  ; Inputs:
  1.  ;   INFLD = Field index # into ^INTHL7F(INFLD,
  1.  ;   INF   = Sequence Number
  1.  ;   FLVL  = File SP
  1.  ;   FILE  = File Stack
  1.  ;   INP   = Output array (call by reference)
  1.  ; Output:
  1.  ;   INP   = Output array
  1.  ;
  1.  N INSF,IN,INFLDC,INDENT,INUFL,INY,INSUPRES,INREQ,INREP,XFM,INFD
  1.  S INFLD(1)=^INTHL7S(INSEG,1,INFLD,0),INFLD(2)=INFLD,INFLD=+INFLD(1)
  1.  S INY=INFLD(1)
  1.  ;get field specifications that are stored at the segment level:
  1.  S INREQ=$$YN^INHMGD1($P(INY,U,3)) ;required
  1.  S INREP=$$YN^INHMGD1($P(INY,U,4)) ;repeating field
  1.  S INUFL=$$YN^INHMGD1($P(INY,U,5)) ;used for lookup
  1.  S XFM=$$YN^INHMGD1($P(INY,U,6)) ;required to pass transform
  1.  S INFD("SQ")=INF ;sequence number
  1.  S INSVAR=$P(INSEG(0),U,2)_INF
  1.  ;leaving the Flag_MessageName...SegmentName, remove any field data.
  1.  I INP S INP=$P(INP,TAB,1,8)_TAB_INF ;$P9 field sequence#
  1.  S INFLDC=INFLD,(INDENT,INSUPRES)=0
  1.  ;
  1.  ;check for subfields:
  1.  S INSF=$O(^INTHL7F(INFLD,10,0)),(IN(0),IN)=0
  1.  ;
  1.  ;Handle subfields ;INSF>0 subfields present
  1.  I INSF D  Q
  1.  .S INSUPRES=1 D FD1 ;do the header field, first
  1.  .F  S IN(0)=$O(^INTHL7F(INFLD,10,"AS",IN(0))) Q:'IN(0)  D
  1.  ..S IN(10)=$G(^INTHL7F(INFLD,10,+$O(^INTHL7F(INFLD,10,"AS",IN(0),0)),0))
  1.  ..S INFLDC=+IN(10),IN=IN+1
  1.  ..Q:'INFLDC  Q:'$D(^INTHL7F(INFLDC,0))
  1.  ..S INFLDC(0)=^INTHL7F(INFLDC,0),INSVAR=$P(INSEG(0),U,2)_INF_"."_IN
  1.  ..S INREQ=$$YN^INHMGD1($P(IN(10),U,3))
  1.  ..S INUFL=$$YN^INHMGD1($P(IN(10),U,4))
  1.  ..S INDENT=1
  1.  ..D FD1
  1.  ;
  1. FD1 ;one field
  1.  N INERR,INY
  1.  ;
  1.  ;get the field data
  1.  S (INY,INFLDC(0))=^INTHL7F(INFLDC,0)
  1.  ;S INFLDC(4)=$G(^INTHL7F(INFLDC,4)) ;Input Xform
  1.  ;S INFLDC(5)=$G(^INTHL7F(INFLDC,5)) ;Output Xform
  1.  ;S INFLDC(50)=$G(^INTHL7F(INFLDC,50)) ;Map Function
  1.  S INFD("FN")=$P(INY,U) ;field name
  1.  S:$P(INY,U,2)="" $P(INY,U,2)=0
  1.  S INFD("DT")=$P($G(^INTHL7FT($P(INY,U,2),0)),U,2) ;data type abbrev
  1.  S INFD("LEN")=$P(INY,U,3) ;field length
  1.  S INFD("OIT")=$P(INY,U,5) ;override input transforms 1=yes
  1.  ;
  1.  ;process the field, o.k. to output column header if needed
  1.  D:INHF2<0 HDR2^INHMGD1 ;since we have data, now need to write col header
  1.  S INHF2=1 ;if we need a new page, write the col header
  1.  D PROC(.INFLDC,.INP)
  1.  S INHF2=0 ;if we need a new page, don't write the col header
  1.  Q
  1.  ;
  1. PROC(INFLDC,INP) ;Print the data source, utilizing the current Seg. File
  1.  N DICOMPX,INDESC,INDDL,INDL,INS,X,INJ,INX,INOLDX
  1.  ;
  1.  ;Use documented data type, if one exists.
  1.  I $P(INFLDC(0),U,12)]"" S INFD("DT")=$P(INFLDC(0),U,12)
  1.  I INFD("DT")="" D
  1.  .S ^UTILITY("INHMGD",$J,"E",INMSG,INSEG,INFLDC)=+FILE(FLVL)_U_"***NO DATA TYPE***"
  1.  ;
  1.  S J(0)=FILE(FLVL),INDL=""
  1.  ;Use documented data source, if one exists.
  1.  S INDL=$$LBTB^UTIL($P(INFLDC(0),U,11))
  1.  I INDL]"" S INOLDX=INDL,INDL="##"_INDL
  1.  ;else use data location
  1.  I INDL="" S (INDL,INOLDX)=$$LBTB^UTIL($G(^INTHL7F(INFLDC,"C")))
  1.  ;use DICOMP to get data location
  1.  I $L(INDL) D
  1.  .S INDL=$$RESOLVE(J(0),INDL)
  1.  .Q:$L(INDL)
  1.  .S ^UTILITY("INHMGD",$J,"E",INMSG,INSEG,INFLDC)=+FILE(FLVL)_U_INOLDX_"  Unable to resolve or missing from Data Dictionary."
  1.  D PRINT^INHMGD4(INDL,.INP)
  1.  D:0 MAPXFRM^INHMGD4(.INFLDC)
  1.  Q
  1. RESOLVE(INRT,INAD) ;Extrensic ***add DIC lookup
  1.  ; Inputs:
  1.  ;   INRT = file#, or file name
  1.  ;   INAD = field string: e.g.: #.01:#.01:INTERNAL(#3.5)_";40.8"
  1.  ;          delimited by ":"
  1.  ; Output:
  1.  ;   String containing  Field#:File# (Field Name)
  1.  ;                      with no leading spaces, and 1 space before the
  1.  ;                      Field Name. e.g.: .01:8550 (NAME)
  1.  ;
  1.  N DIC,X,Y,I,INAME,INFLD,INFIL,INJ,INS,INPY
  1.  S (INFIL,INFLD)=""
  1.  ;
  1.  ;fixup address from documented data source
  1.  I $E(INAD,1,2)="##" S INAD=$E(INAD,3,999) D
  1.  .S INFIL=$P(INAD,":",2) S:INFIL]"" INRT=INFIL
  1.  .S INAD=$P(INAD,":")
  1.  ;
  1.  ;find file number from file name:
  1.  I +INRT=0,$L(INRT) D  ;make sure it's not like "8550^^CPG("
  1.  .K DIC S DIC="^DIC(",DIC(0)="FZ",X=INRT D ^DIC ;find file
  1.  .I Y>0 S INRT=+Y Q
  1.  .S DIC="^DD(",DIC(0)="FMZ",DIC("S")="I $P(^(0),U,2)" D ^DIC ;sub-file
  1.  .I Y>0 S INRT=+Y Q
  1.  S INRT=+INRT
  1.  I 'INRT D  Q INAD_":"_INRT_" (FILE# MISSING***)"
  1.  .S ^UTILITY("INHMGD",$J,"E",INMSG,INSEG,INFLDC)=+FILE(FLVL)_U_"FILE# MISSING***"
  1.  ;
  1.  ;exit on quoted string or @ (user defined routine)
  1.  S INS=INAD
  1.  Q:INAD["@" INAD
  1.  I INAD'["INTERNAL" S X=$E(INAD) I X="""" Q INAD
  1.  ;
  1.  ;try a ^DD lookup
  1.  S X=$TR(INAD,"#") I X'[":" D  Q:$L(INFIL) INFIL
  1.  .K DIC S DIC="^DD("_INRT_",",DIC(0)="FMZ" D ^DIC
  1.  .I Y>0 S INFIL=+Y_":"_INRT_" ("_Y(0,0)_")"
  1.  ;
  1.  S J(0)=+INRT,I(0)="",DA="DA(",DQI="Y(",DICOMPX="",X=INAD
  1.  D ^DICOMP S INPY=$G(%Y)
  1.  I '$L($G(X)) Q ""
  1.  S INAME=""
  1.  ;if DICOMPX has the results, just reassemble for PRINT
  1.  I $L($G(DICOMPX),U)>1 D  Q INAD_$S($L(INAME):" ("_INAME_")",1:"")
  1.  .;rebuild the address for compatibility with PRINT
  1.  .S INFIL=+DICOMPX,INFLD=+$P(DICOMPX,U,2)
  1.  .S INAD=INFLD_":"_INFIL
  1.  .;
  1.  .;have the address, now look for the field name
  1.  .I $D(^DD(INFIL,INFLD,0)) S INAME=$P(^DD(INFIL,INFLD,0),U) Q
  1.  .;didn't find it, use what DICOMP returned
  1.  .I INPY'["^",+INPY'=INPY S INAME=INPY Q  ;looks like text, use it.
  1.  .;still didn't find it, try using what we started with.
  1.  .I '$TR(INS,"#") S INAME=INS
  1.  ;
  1.  I $L(X) D  Q:$L(INFIL) INFIL
  1.  .S INFIL=""
  1.  .I INAD["NUMBER"!(INAD["#.001") S INFIL=".001:"_+FILE(FLVL)_" (NUMBER)"
  1.  .I INAD["INSITE"  S INFIL="8000:4 (INSITE)"
  1.  Q ""
  1.  ;