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

INXPORT.m

Go to the documentation of this file. 
  1. INXPORT ; cmi/flag/maw - IN GIS Package Exporter ;  [ 10/09/2002  11:05 AM ]
  1.  ;;3.01;BHL IHS Interfaces with GIS;**2,15**;OCT 15, 2002
  1.  ;
  1.  ;
  1.  ;this routine will take all components of a package and export
  1.  ;to transport global ^INXPORT.  This global will then get moved to
  1.  ;the remote system and get imported into GIS.  This will act as a
  1.  ;replacement to the KIDS data install
  1.  ;
  1. MAIN ;PEP - this is the main routine driver
  1.  D ASK
  1.  Q:$D(DIRUT)
  1.  Q:$G(INSTND)=""
  1.  Q:$G(INST)=""
  1.  D MSG(INSTND,INST,ININT)
  1.  W !!,"The export of ",INMSGPR," has completed successfully.  The content"
  1.  W !,"is in the global ^'INXPORT' which can be saved to a host file."
  1.  D EOJ
  1.  Q
  1.  ;
  1. ASK ;-- ask the site and project
  1.  S DIR(0)="S^HL7:HL;X12:X1"
  1.  S DIR("A")="What is the type of messaging you are exporting from"
  1.  D ^DIR
  1.  I $D(DIRUT) W !!,"Export aborted..." H 2 Q
  1.  S INSTND=Y(0)
  1.  K DIC
  1.  K DIR
  1.  S DIR(0)="F^2:10"
  1.  S DIR("A")="What is the site you are exporting from............."
  1.  D ^DIR
  1.  I $D(DIRUT) W !!,"Export aborted..." H 2 Q
  1.  S INST=Y
  1.  S DIC(0)="AEMQZ",DIC="^INRHNS("
  1.  S DIC("A")="What is the interface you are exporting from........: "
  1.  S DIC("S")="I $D(^(1))"
  1.  D ^DIC
  1.  I +Y<0 W !!,"Export aborted..." H 2 Q
  1.  S ININTI=+Y
  1.  S (INIF,ININT)=$P(Y,U,2)
  1.  I ININT="" S INIF="CORE"
  1.  I INIF="CORE" S ININTI=$O(^INRHNS("B","CORE",0))
  1.  S INMPRE="^INXPORT(INSTND,INST,INIF)"
  1.  Q
  1.  ;
  1. MSG(STD,SIT,INT)   ;PEP - get the data
  1.  ;lets find the message, tt, dest, bp, then segment, then field
  1.  K ^INXPORT
  1.  S INMSGPR=$G(STD)_" "_$G(SIT)_$S($G(INT)'="":" "_INT,1:"")
  1.  D SETD(INMSGPR)
  1.  D SETT(INMSGPR)
  1.  D SETBP(INMSGPR)
  1.  S INMDA=0 F  S INMDA=$O(^INTHL7M("B",INMDA)) Q:INMDA=""  D
  1.  . Q:INMDA'[INMSGPR
  1.  . S INIEN=0 F  S INIEN=$O(^INTHL7M("B",INMDA,INIEN)) Q:'INIEN  D
  1.  .. D TT(INIEN)
  1.  .. D MD(INIEN)
  1.  Q
  1.  ;
  1. TT(MSG) ;-- set up the transaction types based upon the message
  1.  S INTTDA=0
  1.  F  S INTTDA=$O(^INTHL7M(INIEN,2,INTTDA)) Q:'INTTDA  D
  1.  . S INSCNT=0
  1.  . S INTTI=$P($G(^INTHL7M(INIEN,2,INTTDA,0)),U)
  1.  . S INOUT=$$GET1^DIQ(4000,INTTI,.08,"E")
  1.  . S @INMPRE@(INIEN,"INOUT")=INOUT
  1.  . F INCNTI=$P($G(^INRHT(INTTI,0)),U,6),INTTI D
  1.  .. I INCNTI,'$D(@INMPRE@("TT",INCNTI)) D TTFIELD(INCNTI)
  1.  . D DEST(INTTI)
  1.  . Q:INDI=""
  1.  . D BP(INDI)
  1.  Q
  1.  ;
  1. DEST(TTI) ;-- setup the destination information
  1.  S INDI=$P($G(^INRHT(TTI,0)),U,2)
  1.  Q:'INDI
  1.  I '$D(@INMPRE@("DEST",INDI)) D DFIELD(INDI)
  1.  Q
  1.  ;
  1. BP(DSTI) ;-- setup the background process infomation
  1.  S INBPI=$O(^INTHPC("DEST",DSTI,0))
  1.  Q:'INBPI
  1.  I '$D(@INMPRE@("BP",INBPI)) D BPFIELD(INBPI)
  1.  Q
  1.  ;the following can be added if IP port and IP address are sent
  1.  S INBPDA=0 F  S INBPDA=$O(^INTHPC(INBPI,5,INBPDA)) Q:'INBPDA  D
  1.  . S INSRVP=$G(^INTHPC(INBPI,5,INBPDA,0))
  1.  . S @INMPRE@(INIEN,"BP",INBPI,5,INBPDA)=INSRVP
  1.  S INBPIEN=0 F  S INBPIEN=$O(^INTHPC(INBPI,6,INBPIEN)) Q:'INBPIEN  D
  1.  . S INSCNT=1
  1.  . S INCLIP=$G(^INTHPC(INBPI,6,INBPIEN,0))
  1.  . S $P(@INMPRE@(INIEN,"BP",INBPI,6,INBPIEN),U,INSCNT)=INCLIP
  1.  . S INBPOEN=0 F  S INBPOEN=$O(^INTHPC(INBPI,6,INBPIEN,1,INBPOEN)) Q:'INBPOEN  D
  1.  .. S INSCNT=INSCNT+1
  1.  .. S INCLP=$G(^INTHPC(INBPI,6,INBPIEN,1,INBPOEN,0))
  1.  .. S $P(@INMPRE@(INIEN,"BP",INBPI,6,INBPIEN),U,INSCNT)=INCLP
  1.  Q
  1.  ;
  1. MD(INIEN) ;-- setup the message structure
  1.  S INCNT=0
  1.  F INMF=.01,.02,.03,.04,.05,.06,.07,.08,.1,.11,.12,5,7.01,7.02,7.03,7.04 D
  1.  . S INCNT=INCNT+1
  1.  . S $P(@INMPRE@(INIEN,"MD"),";",INCNT)=INMF_"///"_$$GET1^DIQ(4011,INIEN,INMF,"E")
  1.  S INIMC=0 F  S INIMC=$O(^INTHL7M(INIEN,6,INIMC)) Q:'INIMC  D
  1.  . S @INMPRE@(INIEN,"MD","OIMC",INIMC)=$G(^INTHL7M(INIEN,6,INIMC,0))  ;8/2/2007 cmi/maw patch 15
  1.  S INIMC=0 F  S INIMC=$O(^INTHL7M(INIEN,4,INIMC)) Q:'INIMC  D
  1.  . S @INMPRE@(INIEN,"MD","MCFL",INIMC)=$G(^INTHL7M(INIEN,4,INIMC,0))
  1.  S INMDS=0 F  S INMDS=$O(^INTHL7M(INIEN,3,INMDS)) Q:'INMDS  D
  1.  . S @INMPRE@(INIEN,"MD","DESC",INMDS)=$G(^INTHL7M(INIEN,3,INMDS,0))
  1.  S INMTT=0 F  S INMTT=$O(^INTHL7M(INIEN,2,INMTT)) Q:'INMTT  D
  1.  . S INMTTI=+$G(^INTHL7M(INIEN,2,INMTT,0))
  1.  . Q:'INMTTI
  1.  . S INMTTE=$$GET1^DIQ(4000,INMTTI,.01,"E")
  1.  . S @INMPRE@(INIEN,"MD","TT",INMTT)=INMTTE
  1.  S INMS=0 F  S INMS=$O(^INTHL7M(INIEN,1,INMS)) Q:'INMS  D
  1.  . S INCNT=0
  1.  . K INFILE,INPNTE
  1.  . S INSIEN=$P($G(^INTHL7M(INIEN,1,INMS,0)),U)
  1.  . S INSDT=$G(^INTHL7M(INIEN,1,INMS,0))
  1.  . S INSEG=$P($G(^INTHL7S(INSIEN,0)),U)
  1.  . S INSEQ=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,2)
  1.  . S INREP=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,3)
  1.  . S INOF=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,4)
  1.  . S INFILI=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,5)
  1.  . I INFILI]"" S INFILE=$P($G(^DIC(INFILI,0)),U)
  1.  . S INPAR=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,7)
  1.  . S INMULT=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,8)
  1.  . S INPNTI=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,11)
  1.  . I INPNTI]"" S INPNTE=$P($G(^INTHL7S(INPNTI,0)),U)
  1.  . S INUDI=$P($G(^INTHL7M(INIEN,1,INMS,0)),U,12)
  1.  . S INSTR=INSEG_U_INSEQ_U_INREP_U_INOF_U_$G(INFILE)_U_INPAR_U_INMULT
  1.  . S INSTR=INSTR_U_$G(INPNTE)_U_INUDI
  1.  . S @INMPRE@(INIEN,"MD","SEG",INSIEN)=INSTR
  1.  . S INOMC=0 F  S INOMC=$O(^INTHL7M(INIEN,1,INMS,5,INOMC)) Q:'INOMC  D
  1.  .. S @INMPRE@(INIEN,"MD","SEG",INSIEN,"OMC",INOMC)=$G(^INTHL7M(INIEN,1,INMS,5,INOMC,0))
  1.  . D SD(INSIEN)
  1.  Q
  1.  ;
  1. SD(SIEN) ;-- get the segment definition
  1.  S INCNT=0
  1.  F INSF=.01,.02 D
  1.  . S INCNT=INCNT+1
  1.  . S $P(@INMPRE@(INIEN,"SD",SIEN),U,INCNT)=$$GET1^DIQ(4010,SIEN,INSF,"E")
  1.  S INSDA=0 F  S INSDA=$O(^INTHL7S(SIEN,1,INSDA)) Q:'INSDA  D
  1.  . S INFIEN=$P($G(^INTHL7S(SIEN,1,INSDA,0)),U)
  1.  . S INFLD=$P($G(^INTHL7F(INFIEN,0)),U)
  1.  . S INFSEQ=$P($G(^INTHL7S(SIEN,1,INSDA,0)),U,2)
  1.  . S INFREQ=$P($G(^INTHL7S(SIEN,1,INSDA,0)),U,3)
  1.  . S @INMPRE@(INIEN,"SD",SIEN,"FD",INSDA)=INFLD_U_INFSEQ_U_INFREQ
  1.  . D FD(INFIEN)
  1.  Q
  1.  ;
  1. FD(FIEN) ;-- define the fields in this message
  1.  S INCNT=0
  1.  F INF=.01,.02,.03,3 D
  1.  . S INCNT=INCNT+1
  1.  . S $P(@INMPRE@(INIEN,"FD",FIEN),U,INCNT)=$$GET1^DIQ(4012,FIEN,INF,"E")
  1.  S @INMPRE@(INIEN,"FD",FIEN,"OUT")=$$GET1^DIQ(4012,FIEN,5,"E")
  1.  S INFD=0 F  S INFD=$O(^INTHL7F(FIEN,1,INFD)) Q:'INFD  D
  1.  . S @INMPRE@(INIEN,"FD",FIEN,"DESC",INFD)=$G(^INTHL7F(FIEN,1,INFD,0))
  1.  S INFS=0 F  S INFS=$O(^INTHL7F(FIEN,10,INFS)) Q:'INFS  D
  1.  . S INFSFI=$P($G(^INTHL7F(FIEN,10,INFS,0)),U)
  1.  . S INFSFE=$P($G(^INTHL7F(INFSFI,0)),U)
  1.  . S INFSFDT=$P($G(^INTHL7F(INFSFI,0)),U,2)
  1.  . S INFSFLN=$P($G(^INTHL7F(INFSFI,0)),U,3)
  1.  . S INFSFDL=$G(^INTHL7F(INFSFI,"C"))
  1.  . S INFSFOT=$G(^INTHL7F(INFSFI,5))
  1.  . S INFSFS=$P($G(^INTHL7F(FIEN,10,INFS,0)),U,2)
  1.  . S @INMPRE@(INIEN,"FD",INFSFI)=INFSFE_U_INFSFDT_U_INFSFLN_U_INFSFDL
  1.  . S @INMPRE@(INIEN,"FD",INFSFI,"OUT")=INFSFOT
  1.  . S @INMPRE@(INIEN,"FD",FIEN,"SUB",INFS)=INFSFE_U_INFSFS
  1.  Q
  1.  ;
  1. EOJ ;-- kill variables and quit
  1.  D EN^XBVK("IN")
  1.  Q
  1.  ;
  1. LIST(INTI) ;-- return a list for the DIR reader
  1.  S INCNT=0
  1.  S INLDA=0 F  S INLDA=$O(^INRHNS(INTI,1,INLDA)) Q:INLDA=""  D
  1.  . S INCNT=INCNT+1
  1.  . S INDATA=$P($G(^INRHNS(INTI,1,INLDA,0)),U)
  1.  . S $P(INVAR,";",INCNT)=$E(INDATA,1,3)_":"_INDATA
  1.  Q INVAR
  1.  ;
  1. SETD(MSGPR)        ;-- get all destinations for this package
  1.  S INDA=0
  1.  F  S INDA=$O(^INRHD(INDA)) Q:'INDA  D
  1.  . S INPT=$$GET1^DIQ(4005,INDA,.02)
  1.  . S INPTX=$$GET1^DIQ(4005,INDA,.01)
  1.  . Q:INPT'[MSGPR&(INPTX'[MSGPR)
  1.  . D DFIELD(INDA)
  1.  Q
  1. DFIELD(INDA) ;
  1.  S INCNT=0
  1.  F INF=.01,.02,.03,.05,.06,.08,.1,.11 D
  1.  . S INCNT=INCNT+1
  1.  . S $P(@INMPRE@("DEST",INDA),";",INCNT)=INF_"///"_$$GET1^DIQ(4005,INDA,INF,"E")
  1.  Q
  1.  ;
  1. SETT(MSGPR)        ;-- get all destinations for this package
  1.  S INDA=0
  1.  F  S INDA=$O(^INRHT(INDA)) Q:'INDA  D
  1.  . S INTPT=$$GET1^DIQ(4000,INDA,.01)
  1.  . Q:INTPT'[MSGPR
  1.  . D TTFIELD(INDA)
  1.  Q
  1. TTFIELD(INDA) ;
  1.  S INCNT=0
  1.  F INF=.01,.02,.05,.06,.08,.09,.1,.11 D
  1.  . S INCNT=INCNT+1
  1.  . S $P(@INMPRE@("TT",INDA),";",INCNT)=INF_"///"_$$GET1^DIQ(4000,INDA,INF,"E")
  1.  Q
  1.  ;
  1. SETBP(MSGPR)        ;-- get all destinations for this package
  1.  S INDA=0 F  S INDA=$O(^INTHPC(INDA)) Q:'INDA  D
  1.  . S INTPT=$$GET1^DIQ(4004,INDA,.01)
  1.  . Q:INTPT'[MSGPR
  1.  . D BPFIELD(INDA)
  1.  Q
  1. BPFIELD(INDA) ;
  1.  S INCNT=0
  1.  F INF=.01,.02,.06,.07,.08,.09,1.8,1,8 D
  1.  . S INCNT=INCNT+1
  1.  . S $P(@INMPRE@("BP",INDA),";",INCNT)=INF_"///"_$$GET1^DIQ(4004,INDA,INF,"E")
  1.  Q
  1.  ;