IS00003(UIF,INOA,INODA) ;Compiled from script 'Generated: X1 IHS 835 IN-I' on DEC 03, 2002
;Part 1
;Copyright 2002 SAIC
EN S X="ERROR^IS00003",@^%ZOSF("TRAP")
G START
ERROR ;
S X="",@^%ZOSF("TRAP") X ^INTHOS(1,3) D ERROR^INHS($$GETERR^%ZTOS)
Q 2
START ;Initialize variables
K FIELD,MDESC,INDA,DIPA S (INAUDIT,INLAYGO)=0
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
S INHLDUZ=$O(^VA(200,"B","GIS,USER",0)),DUZ=$S($G(INHLDUZ):INHLDUZ,1:.5)
S BHLMIEN="12417"
S INEOSM=""
K INSETID
S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
S (DELIM,INDELIM)=$$FIELD^INHUT(),(SUBDELIM,INSUBDEL)=$$COMP^INHUT(),INSUBCOM=$$SUBCOMP^INHUT()
;Entering DATA section.
S X=$$GL^INHOU(UIF,LCT),Y(1)=X S X=4,X=$E(Y(1),X) S DELIM=X K DXS
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)
N INDEFSEG
S INDEFSEG("ST",0)=0
S INDEFSEG("BPR",0)=0
S INDEFSEG("TRN",0)=0
S INDEFSEG("CUR",0)=0
S INDEFSEG("REF",0)=0
S INDEFSEG("REF",0)=0
S INDEFSEG("DTM",0)=0
S INDEFSEG("N1",0)=0
S INDEFSEG("N3",0)=0
S INDEFSEG("N4",0)=0
S INDEFSEG("REF",0)=0
S INDEFSEG("PER",0)=0
S INDEFSEG("N1",0)=0
S INDEFSEG("N3",0)=0
S INDEFSEG("N4",0)=0
S INDEFSEG("REF",0)=0
S INDEFSEG("LX",0)=0
S INDEFSEG("TS3",0)=0
S INDEFSEG("TS2",0)=0
S INDEFSEG("CLP",0)=0
S INDEFSEG("CAS",0)=0
S INDEFSEG("NM1",0)=0
S INDEFSEG("NM1",0)=0
S INDEFSEG("NM1",0)=0
S INDEFSEG("NM1",0)=0
S INDEFSEG("NM1",0)=0
S INDEFSEG("NM1",0)=0
S INDEFSEG("MIA",0)=0
S INDEFSEG("MOA",0)=0
S INDEFSEG("REF",1)=1
S INDEFSEG("REF",1)=1
S INDEFSEG("DTM",1)=1
S INDEFSEG("PER",1)=1
S INDEFSEG("AMT",1)=1
S INDEFSEG("QTY",1)=1
S INDEFSEG("SVC",0)=0
S INDEFSEG("DTM",1)=1
S INDEFSEG("CAS",1)=1
S INDEFSEG("REF",1)=1
S INDEFSEG("REF",1)=1
S INDEFSEG("AMT",1)=1
S INDEFSEG("QTY",1)=1
S INDEFSEG("LQ",1)=1
S INDEFSEG("PLB",0)=0
S INDEFSEG("ST",0)=0
;Start of GROUP
F S MATCH=0 D Q:'MATCH
.D:'INVS MC^INHS
.D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
.I 'MATCH,LINE?1"S"1"T".ANPC S DO=1,MATCH=1
.E S LCT=LCT-CNT,DO=0
.S:DO @("@INV@(""ST1"")")=$$PIECE^INHU(.LINE,DELIM,2)
.S:DO @("@INV@(""ST2"")")=$$PIECE^INHU(.LINE,DELIM,3)
.Q:MATCH
.D:'INVS MC^INHS
.D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
.I 'MATCH,LINE?1"B"1"P"1"R".ANPC S DO=1,MATCH=1
.E S LCT=LCT-CNT,DO=0
.S:DO @("@INV@(""BPR1"")")=$$PIECE^INHU(.LINE,DELIM,2)
.S:DO @("@INV@(""BPR2"")")=$$PIECE^INHU(.LINE,DELIM,3)
.S:DO @("@INV@(""BPR3"")")=$$PIECE^INHU(.LINE,DELIM,4)
.S:DO @("@INV@(""BPR4"")")=$$PIECE^INHU(.LINE,DELIM,5)
.S:DO @("@INV@(""BPR5"")")=$$PIECE^INHU(.LINE,DELIM,6)
.S:DO @("@INV@(""BPR6"")")=$$PIECE^INHU(.LINE,DELIM,7)
.S:DO @("@INV@(""BPR7"")")=$$PIECE^INHU(.LINE,DELIM,8)
.S:DO @("@INV@(""BPR8"")")=$$PIECE^INHU(.LINE,DELIM,9)
.S:DO @("@INV@(""BPR9"")")=$$PIECE^INHU(.LINE,DELIM,10)
.S:DO @("@INV@(""BPR10"")")=$$PIECE^INHU(.LINE,DELIM,11)
.S:DO @("@INV@(""BPR11"")")=$$PIECE^INHU(.LINE,DELIM,12)
.S:DO @("@INV@(""BPR12"")")=$$PIECE^INHU(.LINE,DELIM,13)
.S:DO @("@INV@(""BPR13"")")=$$PIECE^INHU(.LINE,DELIM,14)
.S:DO @("@INV@(""BPR14"")")=$$PIECE^INHU(.LINE,DELIM,15)
.S:DO @("@INV@(""BPR15"")")=$$PIECE^INHU(.LINE,DELIM,16)
.S:DO @("@INV@(""BPR16"")")=$$PIECE^INHU(.LINE,DELIM,17)
.Q:MATCH
.D:'INVS MC^INHS
.D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
.I 'MATCH,LINE?1"T"1"R"1"N".ANPC S DO=1,MATCH=1
.E S LCT=LCT-CNT,DO=0
.S:DO @("@INV@(""TRN1"")")=$$PIECE^INHU(.LINE,DELIM,2)
.S:DO @("@INV@(""TRN2"")")=$$PIECE^INHU(.LINE,DELIM,3)
.S:DO @("@INV@(""TRN3"")")=$$PIECE^INHU(.LINE,DELIM,4)
.S:DO @("@INV@(""TRN4"")")=$$PIECE^INHU(.LINE,DELIM,5)
.Q:MATCH
.D:'INVS MC^INHS
.D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
.I 'MATCH,LINE?1"C"1"U"1"R".ANPC S DO=1,MATCH=1
.E S LCT=LCT-CNT,DO=0
.S:DO @("@INV@(""CUR1"")")=$$PIECE^INHU(.LINE,DELIM,2)
.S:DO @("@INV@(""CUR2"")")=$$PIECE^INHU(.LINE,DELIM,3)
.S:DO @("@INV@(""CUR3"")")=$$PIECE^INHU(.LINE,DELIM,4)
.Q:MATCH
.D:'INVS MC^INHS
.D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
.I 'MATCH,LINE?1"R"1"E"1"F".ANPC S DO=1,MATCH=1
.E S LCT=LCT-CNT,DO=0
.S:DO @("@INV@(""REF1"")")=$$PIECE^INHU(.LINE,DELIM,2)
.S:DO @("@INV@(""REF2"")")=$$PIECE^INHU(.LINE,DELIM,3)
.Q:MATCH
.D:'INVS MC^INHS
.D GET^INHOU(UIF,0) S LINE=$G(LINE),DO=0
.I 'MATCH,LINE?1"R"1"E"1"F".ANPC S DO=1,MATCH=1
.E S LCT=LCT-CNT,DO=0
9 .D EN^IS00003A
G A1^IS00003D
IS00003(UIF,INOA,INODA) ;Compiled from script 'Generated: X1 IHS 835 IN-I' on DEC 03, 2002
+1 ;Part 1
+2 ;Copyright 2002 SAIC
EN SET X="ERROR^IS00003"
SET @^%ZOSF("TRAP")
+1 GOTO START
ERROR ;
+1 SET X=""
SET @^%ZOSF("TRAP")
XECUTE ^INTHOS(1,3)
DO ERROR^INHS($$GETERR^%ZTOS)
+2 QUIT 2
START ;Initialize variables
+1 KILL FIELD,MDESC,INDA,DIPA
SET (INAUDIT,INLAYGO)=0
+2 KILL INREQERR,INHERR,INHERCNT,INV
DO SETDT^UTDT
SET DUZ(0)="@"
SET DUZ("AG")="^1"
SET DTIME=1
SET (LCT,GERR)=0
SET INMODE="I"
SET INVS=$PIECE(^INRHSITE(1,0),U,12)
SET INV=$SELECT(INVS<2:"INV",1:"^UTILITY(""INV"",$J)")
SET (MULT,INSTERR)=0
+3 SET INHLDUZ=$ORDER(^VA(200,"B","GIS,USER",0))
SET DUZ=$SELECT($GET(INHLDUZ):INHLDUZ,1:.5)
+4 SET BHLMIEN="12417"
+5 SET INEOSM=""
+6 KILL INSETID
+7 SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
+8 SET (DELIM,INDELIM)=$$FIELD^INHUT()
SET (SUBDELIM,INSUBDEL)=$$COMP^INHUT()
SET INSUBCOM=$$SUBCOMP^INHUT()
+9 ;Entering DATA section.
+10 SET X=$$GL^INHOU(UIF,LCT)
SET Y(1)=X
SET X=4
SET X=$EXTRACT(Y(1),X)
SET DELIM=X
KILL DXS
+11 SET X=$$GL^INHOU(UIF,LCT)
SET Y(1)=X
SET X=105
SET X=$EXTRACT(Y(1),X)
SET SUBDELIM=X
KILL DXS
SET INDELIMS=DELIM_$PIECE(Y(1),DELIM,2)
+12 NEW INDEFSEG
+13 SET INDEFSEG("ST",0)=0
+14 SET INDEFSEG("BPR",0)=0
+15 SET INDEFSEG("TRN",0)=0
+16 SET INDEFSEG("CUR",0)=0
+17 SET INDEFSEG("REF",0)=0
+18 SET INDEFSEG("REF",0)=0
+19 SET INDEFSEG("DTM",0)=0
+20 SET INDEFSEG("N1",0)=0
+21 SET INDEFSEG("N3",0)=0
+22 SET INDEFSEG("N4",0)=0
+23 SET INDEFSEG("REF",0)=0
+24 SET INDEFSEG("PER",0)=0
+25 SET INDEFSEG("N1",0)=0
+26 SET INDEFSEG("N3",0)=0
+27 SET INDEFSEG("N4",0)=0
+28 SET INDEFSEG("REF",0)=0
+29 SET INDEFSEG("LX",0)=0
+30 SET INDEFSEG("TS3",0)=0
+31 SET INDEFSEG("TS2",0)=0
+32 SET INDEFSEG("CLP",0)=0
+33 SET INDEFSEG("CAS",0)=0
+34 SET INDEFSEG("NM1",0)=0
+35 SET INDEFSEG("NM1",0)=0
+36 SET INDEFSEG("NM1",0)=0
+37 SET INDEFSEG("NM1",0)=0
+38 SET INDEFSEG("NM1",0)=0
+39 SET INDEFSEG("NM1",0)=0
+40 SET INDEFSEG("MIA",0)=0
+41 SET INDEFSEG("MOA",0)=0
+42 SET INDEFSEG("REF",1)=1
+43 SET INDEFSEG("REF",1)=1
+44 SET INDEFSEG("DTM",1)=1
+45 SET INDEFSEG("PER",1)=1
+46 SET INDEFSEG("AMT",1)=1
+47 SET INDEFSEG("QTY",1)=1
+48 SET INDEFSEG("SVC",0)=0
+49 SET INDEFSEG("DTM",1)=1
+50 SET INDEFSEG("CAS",1)=1
+51 SET INDEFSEG("REF",1)=1
+52 SET INDEFSEG("REF",1)=1
+53 SET INDEFSEG("AMT",1)=1
+54 SET INDEFSEG("QTY",1)=1
+55 SET INDEFSEG("LQ",1)=1
+56 SET INDEFSEG("PLB",0)=0
+57 SET INDEFSEG("ST",0)=0
+58 ;Start of GROUP
+59 FOR
SET MATCH=0
Begin DoDot:1
+60 IF 'INVS
DO MC^INHS
+61 DO GET^INHOU(UIF,0)
SET LINE=$GET(LINE)
SET DO=0
+62 IF 'MATCH
IF LINE?1"S"1"T".ANPC
SET DO=1
SET MATCH=1
+63 IF '$TEST
SET LCT=LCT-CNT
SET DO=0
+64 IF DO
SET @("@INV@(""ST1"")")=$$PIECE^INHU(.LINE,DELIM,2)
+65 IF DO
SET @("@INV@(""ST2"")")=$$PIECE^INHU(.LINE,DELIM,3)
+66 IF MATCH
QUIT
+67 IF 'INVS
DO MC^INHS
+68 DO GET^INHOU(UIF,0)
SET LINE=$GET(LINE)
SET DO=0
+69 IF 'MATCH
IF LINE?1"B"1"P"1"R".ANPC
SET DO=1
SET MATCH=1
+70 IF '$TEST
SET LCT=LCT-CNT
SET DO=0
+71 IF DO
SET @("@INV@(""BPR1"")")=$$PIECE^INHU(.LINE,DELIM,2)
+72 IF DO
SET @("@INV@(""BPR2"")")=$$PIECE^INHU(.LINE,DELIM,3)
+73 IF DO
SET @("@INV@(""BPR3"")")=$$PIECE^INHU(.LINE,DELIM,4)
+74 IF DO
SET @("@INV@(""BPR4"")")=$$PIECE^INHU(.LINE,DELIM,5)
+75 IF DO
SET @("@INV@(""BPR5"")")=$$PIECE^INHU(.LINE,DELIM,6)
+76 IF DO
SET @("@INV@(""BPR6"")")=$$PIECE^INHU(.LINE,DELIM,7)
+77 IF DO
SET @("@INV@(""BPR7"")")=$$PIECE^INHU(.LINE,DELIM,8)
+78 IF DO
SET @("@INV@(""BPR8"")")=$$PIECE^INHU(.LINE,DELIM,9)
+79 IF DO
SET @("@INV@(""BPR9"")")=$$PIECE^INHU(.LINE,DELIM,10)
+80 IF DO
SET @("@INV@(""BPR10"")")=$$PIECE^INHU(.LINE,DELIM,11)
+81 IF DO
SET @("@INV@(""BPR11"")")=$$PIECE^INHU(.LINE,DELIM,12)
+82 IF DO
SET @("@INV@(""BPR12"")")=$$PIECE^INHU(.LINE,DELIM,13)
+83 IF DO
SET @("@INV@(""BPR13"")")=$$PIECE^INHU(.LINE,DELIM,14)
+84 IF DO
SET @("@INV@(""BPR14"")")=$$PIECE^INHU(.LINE,DELIM,15)
+85 IF DO
SET @("@INV@(""BPR15"")")=$$PIECE^INHU(.LINE,DELIM,16)
+86 IF DO
SET @("@INV@(""BPR16"")")=$$PIECE^INHU(.LINE,DELIM,17)
+87 IF MATCH
QUIT
+88 IF 'INVS
DO MC^INHS
+89 DO GET^INHOU(UIF,0)
SET LINE=$GET(LINE)
SET DO=0
+90 IF 'MATCH
IF LINE?1"T"1"R"1"N".ANPC
SET DO=1
SET MATCH=1
+91 IF '$TEST
SET LCT=LCT-CNT
SET DO=0
+92 IF DO
SET @("@INV@(""TRN1"")")=$$PIECE^INHU(.LINE,DELIM,2)
+93 IF DO
SET @("@INV@(""TRN2"")")=$$PIECE^INHU(.LINE,DELIM,3)
+94 IF DO
SET @("@INV@(""TRN3"")")=$$PIECE^INHU(.LINE,DELIM,4)
+95 IF DO
SET @("@INV@(""TRN4"")")=$$PIECE^INHU(.LINE,DELIM,5)
+96 IF MATCH
QUIT
+97 IF 'INVS
DO MC^INHS
+98 DO GET^INHOU(UIF,0)
SET LINE=$GET(LINE)
SET DO=0
+99 IF 'MATCH
IF LINE?1"C"1"U"1"R".ANPC
SET DO=1
SET MATCH=1
+100 IF '$TEST
SET LCT=LCT-CNT
SET DO=0
+101 IF DO
SET @("@INV@(""CUR1"")")=$$PIECE^INHU(.LINE,DELIM,2)
+102 IF DO
SET @("@INV@(""CUR2"")")=$$PIECE^INHU(.LINE,DELIM,3)
+103 IF DO
SET @("@INV@(""CUR3"")")=$$PIECE^INHU(.LINE,DELIM,4)
+104 IF MATCH
QUIT
+105 IF 'INVS
DO MC^INHS
+106 DO GET^INHOU(UIF,0)
SET LINE=$GET(LINE)
SET DO=0
+107 IF 'MATCH
IF LINE?1"R"1"E"1"F".ANPC
SET DO=1
SET MATCH=1
+108 IF '$TEST
SET LCT=LCT-CNT
SET DO=0
+109 IF DO
SET @("@INV@(""REF1"")")=$$PIECE^INHU(.LINE,DELIM,2)
+110 IF DO
SET @("@INV@(""REF2"")")=$$PIECE^INHU(.LINE,DELIM,3)
+111 IF MATCH
QUIT
+112 IF 'INVS
DO MC^INHS
+113 DO GET^INHOU(UIF,0)
SET LINE=$GET(LINE)
SET DO=0
+114 IF 'MATCH
IF LINE?1"R"1"E"1"F".ANPC
SET DO=1
SET MATCH=1
+115 IF '$TEST
SET LCT=LCT-CNT
SET DO=0
9 DO EN^IS00003A
End DoDot:1
IF 'MATCH
QUIT
+1 GOTO A1^IS00003D
