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

IS00003.m

Go to the documentation of this file. 
  1. IS00003(UIF,INOA,INODA) ;Compiled from script 'Generated: X1 IHS 835 IN-I' on DEC 03, 2002
  1.  ;Part 1
  1.  ;Copyright 2002 SAIC
  1. EN S X="ERROR^IS00003",@^%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="12417"
  1.  S INEOSM=""
  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)=X S X=4,X=$E(Y(1),X) S DELIM=X K DXS
  1.  S X=$$GL^INHOU(UIF,LCT),Y(1)=X S X=105,X=$E(Y(1),X) S SUBDELIM=X K DXS S INDELIMS=DELIM_$P(Y(1),DELIM,2)
  1.  N INDEFSEG
  1.  S INDEFSEG("ST",0)=0
  1.  S INDEFSEG("BPR",0)=0
  1.  S INDEFSEG("TRN",0)=0
  1.  S INDEFSEG("CUR",0)=0
  1.  S INDEFSEG("REF",0)=0
  1.  S INDEFSEG("REF",0)=0
  1.  S INDEFSEG("DTM",0)=0
  1.  S INDEFSEG("N1",0)=0
  1.  S INDEFSEG("N3",0)=0
  1.  S INDEFSEG("N4",0)=0
  1.  S INDEFSEG("REF",0)=0
  1.  S INDEFSEG("PER",0)=0
  1.  S INDEFSEG("N1",0)=0
  1.  S INDEFSEG("N3",0)=0
  1.  S INDEFSEG("N4",0)=0
  1.  S INDEFSEG("REF",0)=0
  1.  S INDEFSEG("LX",0)=0
  1.  S INDEFSEG("TS3",0)=0
  1.  S INDEFSEG("TS2",0)=0
  1.  S INDEFSEG("CLP",0)=0
  1.  S INDEFSEG("CAS",0)=0
  1.  S INDEFSEG("NM1",0)=0
  1.  S INDEFSEG("NM1",0)=0
  1.  S INDEFSEG("NM1",0)=0
  1.  S INDEFSEG("NM1",0)=0
  1.  S INDEFSEG("NM1",0)=0
  1.  S INDEFSEG("NM1",0)=0
  1.  S INDEFSEG("MIA",0)=0
  1.  S INDEFSEG("MOA",0)=0
  1.  S INDEFSEG("REF",1)=1
  1.  S INDEFSEG("REF",1)=1
  1.  S INDEFSEG("DTM",1)=1
  1.  S INDEFSEG("PER",1)=1
  1.  S INDEFSEG("AMT",1)=1
  1.  S INDEFSEG("QTY",1)=1
  1.  S INDEFSEG("SVC",0)=0
  1.  S INDEFSEG("DTM",1)=1
  1.  S INDEFSEG("CAS",1)=1
  1.  S INDEFSEG("REF",1)=1
  1.  S INDEFSEG("REF",1)=1
  1.  S INDEFSEG("AMT",1)=1
  1.  S INDEFSEG("QTY",1)=1
  1.  S INDEFSEG("LQ",1)=1
  1.  S INDEFSEG("PLB",0)=0
  1.  S INDEFSEG("ST",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"S"1"T".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""ST1"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""ST2"")")=$$PIECE^INHU(.LINE,DELIM,3)
  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"B"1"P"1"R".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""BPR1"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""BPR2"")")=$$PIECE^INHU(.LINE,DELIM,3)
  1.  .S:DO @("@INV@(""BPR3"")")=$$PIECE^INHU(.LINE,DELIM,4)
  1.  .S:DO @("@INV@(""BPR4"")")=$$PIECE^INHU(.LINE,DELIM,5)
  1.  .S:DO @("@INV@(""BPR5"")")=$$PIECE^INHU(.LINE,DELIM,6)
  1.  .S:DO @("@INV@(""BPR6"")")=$$PIECE^INHU(.LINE,DELIM,7)
  1.  .S:DO @("@INV@(""BPR7"")")=$$PIECE^INHU(.LINE,DELIM,8)
  1.  .S:DO @("@INV@(""BPR8"")")=$$PIECE^INHU(.LINE,DELIM,9)
  1.  .S:DO @("@INV@(""BPR9"")")=$$PIECE^INHU(.LINE,DELIM,10)
  1.  .S:DO @("@INV@(""BPR10"")")=$$PIECE^INHU(.LINE,DELIM,11)
  1.  .S:DO @("@INV@(""BPR11"")")=$$PIECE^INHU(.LINE,DELIM,12)
  1.  .S:DO @("@INV@(""BPR12"")")=$$PIECE^INHU(.LINE,DELIM,13)
  1.  .S:DO @("@INV@(""BPR13"")")=$$PIECE^INHU(.LINE,DELIM,14)
  1.  .S:DO @("@INV@(""BPR14"")")=$$PIECE^INHU(.LINE,DELIM,15)
  1.  .S:DO @("@INV@(""BPR15"")")=$$PIECE^INHU(.LINE,DELIM,16)
  1.  .S:DO @("@INV@(""BPR16"")")=$$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"T"1"R"1"N".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""TRN1"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""TRN2"")")=$$PIECE^INHU(.LINE,DELIM,3)
  1.  .S:DO @("@INV@(""TRN3"")")=$$PIECE^INHU(.LINE,DELIM,4)
  1.  .S:DO @("@INV@(""TRN4"")")=$$PIECE^INHU(.LINE,DELIM,5)
  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"C"1"U"1"R".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""CUR1"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""CUR2"")")=$$PIECE^INHU(.LINE,DELIM,3)
  1.  .S:DO @("@INV@(""CUR3"")")=$$PIECE^INHU(.LINE,DELIM,4)
  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"R"1"E"1"F".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1.  .S:DO @("@INV@(""REF1"")")=$$PIECE^INHU(.LINE,DELIM,2)
  1.  .S:DO @("@INV@(""REF2"")")=$$PIECE^INHU(.LINE,DELIM,3)
  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"R"1"E"1"F".ANPC S DO=1,MATCH=1
  1.  .E  S LCT=LCT-CNT,DO=0
  1. 9 .D EN^IS00003A
  1.  G A1^IS00003D