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

IS00025.m

Go to the documentation of this file. 
  1. IS00025(UIF,INOA,INODA) ;Compiled from script 'Generated: HL IHS IZV04 V01VXQ IN-I' on AUG 15, 2018
  1.  ;Part 1
  1.  ;Copyright 2018 SAIC
  1. EN S X="ERROR^IS00025",@^%ZOSF("TRAP")
  1.  G START
  1. ERROR ;
  1.  S X="",@^%ZOSF("TRAP") X ^INTHOS(1,3) D ERROR^INHS($$GETERR^%ZTOS)
  1.  Q 2
  1. START ;Initialize variables
  1.  K FIELD,MDESC,INDA,DIPA S (INAUDIT,INLAYGO)=0
  1.  K INREQERR,INHERR,INHERCNT,INV D SETDT^UTDT S DUZ(0)="@",DUZ("AG")="^1",DTIME=1 S (LCT,GERR)=0,INMODE="I",INVS=$P(^INRHSITE(1,0),U,12),INV=$S(INVS<2:"INV",1:"^UTILITY(""INV"",$J)"),(MULT,INSTERR)=0
  1.  S INHLDUZ=$O(^VA(200,"B","GIS,USER",0)),DUZ=$S($G(INHLDUZ):INHLDUZ,1:.5)
  1.  S BHLMIEN="12441"
  1.  I $G(^INTHL7M(BHLMIEN,4,1,0))]"" X $G(^INTHL7M(BHLMIEN,4,1,0))
  1.  K INSETID
  1.  S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
  1.  S (DELIM,INDELIM)=$$FIELD^INHUT(),(SUBDELIM,INSUBDEL)=$$COMP^INHUT(),INSUBCOM=$$SUBCOMP^INHUT()
  1.  ;Entering DATA section.
  1.  S X=$$GL^INHOU(UIF,LCT),Y(1)=$G(X) S X=4,X=$E(Y(1),X) S DELIM=X K DXS
  1.  S X=$$GL^INHOU(UIF,LCT),Y(1)=$G(X) S X=5,X=$E(Y(1),X) S SUBDELIM=X K DXS S INDELIMS=DELIM_$P(Y(1),DELIM,2)
  1.  N INDEFSEG
  1.  S INDEFSEG("MSH",0)=0
  1.  S INDEFSEG("QRD",0)=0
  1.  S INDEFSEG("QRF",0)=0
  1.  ;Start of GROUP
  1.  F  S MATCH=0 D  Q:'MATCH
  1.  .D:'INVS MC^INHS
  1.  .D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
  1.  .I 'MATCH,LINE?1"M"1"S"1"H".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""MSH1"")")=$E($G(LINE),4)
  1.  .S:DO @("@INV@(""MSH2"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""MSH3"")")=$$PIECE^INHU(.LINE,DELIM,3)
  1.  .S:DO @("@INV@(""MSH4"")")=$$PIECE^INHU(.LINE,DELIM,4)
  1.  .S:DO @("@INV@(""MSH5"")")=$$PIECE^INHU(.LINE,DELIM,5)
  1.  .S:DO @("@INV@(""MSH6"")")=$$PIECE^INHU(.LINE,DELIM,6)
  1.  .S:DO @("@INV@(""MSH7"")")=$$PIECE^INHU(.LINE,DELIM,7)
  1.  .S:DO @("@INV@(""MSH8"")")=$$PIECE^INHU(.LINE,DELIM,8)
  1.  .S:DO @("@INV@(""MSH9"")")=$$PIECE^INHU(.LINE,DELIM,9)
  1.  .S:DO @("@INV@(""MSH10"")")=$$PIECE^INHU(.LINE,DELIM,10)
  1.  .S:DO @("@INV@(""MSH11"")")=$$PIECE^INHU(.LINE,DELIM,11)
  1.  .S:DO @("@INV@(""MSH12"")")=$$PIECE^INHU(.LINE,DELIM,12)
  1.  .S:DO @("@INV@(""MSH13"")")=$$PIECE^INHU(.LINE,DELIM,13)
  1.  .S:DO @("@INV@(""MSH14"")")=$$PIECE^INHU(.LINE,DELIM,14)
  1.  .S:DO @("@INV@(""MSH15"")")=$$PIECE^INHU(.LINE,DELIM,15)
  1.  .S:DO @("@INV@(""MSH16"")")=$$PIECE^INHU(.LINE,DELIM,16)
  1.  .S:DO @("@INV@(""MSH17"")")=$$PIECE^INHU(.LINE,DELIM,17)
  1.  .Q:MATCH
  1.  .D:'INVS MC^INHS
  1.  .D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
  1.  .I 'MATCH,LINE?1"Q"1"R"1"D".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""QRD1"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""QRD2"")")=$$PIECE^INHU(.LINE,DELIM,3)
  1.  .S:DO @("@INV@(""QRD3"")")=$$PIECE^INHU(.LINE,DELIM,4)
  1.  .S:DO @("@INV@(""QRD4"")")=$$PIECE^INHU(.LINE,DELIM,5)
  1.  .S:DO @("@INV@(""QRD7"")")=$$PIECE^INHU(.LINE,DELIM,8)
  1.  .S:DO @("@INV@(""QRD8"")")=$$PIECE^INHU(.LINE,DELIM,9)
  1.  .S:DO @("@INV@(""QRD9"")")=$$PIECE^INHU(.LINE,DELIM,10)
  1.  .S:DO @("@INV@(""QRD12"")")=$$PIECE^INHU(.LINE,DELIM,13)
  1.  .Q:MATCH
  1.  .D:'INVS MC^INHS
  1.  .D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
  1.  .I 'MATCH,LINE?1"Q"1"R"1"F".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""QRF1"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""QRF5"")")=$$PIECE^INHU(.LINE,DELIM,6)
  1.  .S:DO @("@INV@(""QRF6"")")=$$PIECE^INHU(.LINE,DELIM,7)
  1.  .S:DO @("@INV@(""QRF7"")")=$$PIECE^INHU(.LINE,DELIM,8)
  1.  .S:DO @("@INV@(""QRF8"")")=$$PIECE^INHU(.LINE,DELIM,9)
  1.  .S:DO @("@INV@(""QRF9"")")=$$PIECE^INHU(.LINE,DELIM,10)
  1.  .Q:MATCH
  1.  .Q
  1.  D:'INVS MC^INHS
  1.  ;Entering TRANS section.
  1.  ;IF $D(@INV@("MSH1"))
  1.  I $D(@INV@("MSH1"))
  1.  D:$T
  1.  .S (INX,X)=$G(@INV@("MSH1"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH1")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH1' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH2"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH2")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH2' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH3"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH3")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH3' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH4"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH4")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH4' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH5"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH5")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH5' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH6"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH6")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH6' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH7"))
  1.  .I X]"" S X=$$TIMEIO^INHUT10(X,$P($G(INTHL7F2),U),$P($G(INTHL7F2),U,2),$P($G(INTHL7F2),U,3),1)
  1.  .S @INV@("MSH7")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH7' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH8"))
  1.  .I X]"" S X=$$TIMEIO^INHUT10(X,$P($G(INTHL7F2),U),$P($G(INTHL7F2),U,2),$P($G(INTHL7F2),U,3),1)
  1.  .S @INV@("MSH8")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH8' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH10"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH10")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH10' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH12"))
  1.  .S:$L(X) X=+X
  1.  .S @INV@("MSH12")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH12' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH13"))
  1.  .S:$L(X) X=+X
  1.  .S @INV@("MSH13")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH13' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("MSH14"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("MSH14")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'MSH14' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .Q
  1.  ;IF $D(@INV@("QRD1"))
  1.  I $D(@INV@("QRD1"))
  1.  D:$T
  1.  .S (INX,X)=$G(@INV@("QRD1"))
  1.  .I X]"" S X=$$TIMEIO^INHUT10(X,$P($G(INTHL7F2),U),$P($G(INTHL7F2),U,2),$P($G(INTHL7F2),U,3),1)
  1.  .S @INV@("QRD1")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'QRD1' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("QRD4"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("QRD4")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'QRD4' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("QRD9"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("QRD9")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'QRD9' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .Q
  1.  ;IF $D(@INV@("QRF1"))
  1.  I $D(@INV@("QRF1"))
  1.  D:$T
  1.  .S (INX,X)=$G(@INV@("QRF1"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("QRF1")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'QRF1' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .S (INX,X)=$G(@INV@("QRF5"))
  1.  .I $P($G(INTHL7F2),U,4) S X=$$SUBESC^INHUT7(X,INDELIMS,"I")
  1.  .S @INV@("QRF5")=$G(X)
  1.  .I '$D(X) D ERROR^INHS("Variable 'QRF5' failed input transform. Processing continues.",0),ERROR^INHS("  Value = '"_INX_"'",0)
  1.  .K DXS
  1.  .Q
  1.  ;Entering REQUIRED section.
  1.  I $D(@INV@("MSH1"))#2,$G(@INV@("MSH1"))="" S INREQERR=2 D KILL^INHVA1("MSH","HL FIELD SEPARATOR")
  1.  I $D(@INV@("MSH1"))#2,$G(@INV@("MSH2"))="" S INREQERR=2 D KILL^INHVA1("MSH","HL ENCODING CHARACTERS")
  1.  I $D(@INV@("MSH1"))#2,$G(@INV@("MSH9"))="" S INREQERR=2 D KILL^INHVA1("MSH","HL MESSAGE TYPE")
  1.  I $D(@INV@("MSH1"))#2,$G(@INV@("MSH11"))="" S INREQERR=2 D KILL^INHVA1("MSH","HL PROCESSING ID")
  1.  I $D(@INV@("QRD1"))#2,$G(@INV@("QRD1"))="" S INREQERR=2 D KILL^INHVA1("QRD","HL IHS QRD IN QDTM (QRD-1)")
  1.  I $D(@INV@("QRD1"))#2,$G(@INV@("QRD2"))="" S INREQERR=2 D KILL^INHVA1("QRD","HL IHS QRD IN QFC (QRD-2)")
  1.  I $D(@INV@("QRD1"))#2,$G(@INV@("QRD3"))="" S INREQERR=2 D KILL^INHVA1("QRD","HL IHS QRD IN QP (QRD-3)")
  1.  I $D(@INV@("QRD1"))#2,$G(@INV@("QRD4"))="" S INREQERR=2 D KILL^INHVA1("QRD","HL IHS QRD IN QID (QRD-4)")
  1.  I $D(@INV@("QRD1"))#2,$G(@INV@("QRD7"))="" S INREQERR=2 D KILL^INHVA1("QRD","HL IHS QRD IN QTY (QRD-7)")
  1.  I $D(@INV@("QRD1"))#2,$G(@INV@("QRD8"))="" S INREQERR=2 D KILL^INHVA1("QRD","HL IHS QRD IN WHO (QRD-8)")
  1.  I $D(@INV@("QRD1"))#2,$G(@INV@("QRD9"))="" S INREQERR=2 D KILL^INHVA1("QRD","HL IHS QRD IN WHAT (QRD-9)")
  1.  I $D(@INV@("QRF1"))#2,$G(@INV@("QRF1"))="" S INREQERR=2 D KILL^INHVA1("QRF","HL IHS QRF IN WHERE (QRF-1)")
  1.  Q:$G(INSTERR) $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR)  D MAIN^BHLV01I
  1.  I $G(INSTERR) Q $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR)
  1.  ;Entering END section.
  1.  I $G(INSTERR) Q $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR)
  1.  K @INV,INV,INDA,DIPA Q +$G(INREQERR)