IS00004.m

IS00004(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002

 ;Part 1

 ;Copyright 2002 SAIC

EN S X="ERROR^IS00004",@^%ZOSF("TRAP")

 G START

ERROR ;

 S X="",@^%ZOSF("TRAP") X ^INTHOS(1,3) D ERROR^INHS($$GETERR^%ZTOS)

 Q 2

START ;Initialize variables

 K ^UTILITY("INH",$J) S (MESSID,INA("MESSID"))=$$MESSID^INHD

 S INA("INSEQ")=$P(MESSID,$P($G(^INRHSITE(1,0)),U,8),2)#10000000

 K INUIF6 M INUIF6=INDA

 K INREQERR,INHERR,INHERCNT,INV D SETDT^UTDT S DUZ(0)="@",DUZ("AG")="^1",DTIME=1 S (LCT,GERR)=0,INMODE="O",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="12418"

 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()

 S INDELIMS=$$FIELD^INHUT_$$COMP^INHUT_$$REP^INHUT_$$ESC^INHUT_$$SUBCOMP^INHUT

 ;Entering DATA section.

 S DELIM=""

 S SUBDELIM=":"

 S SUBDELIM=""

 SET INSETID=0

 D ^BHLXHDR

 ;SET ISA1 = $E(INTERNAL(@ISA1),1,2)

 S D0=INDA S X=$G(INA("ISA1")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=2,X=$E(Y(1),Y(2),X)

 S @INV@("ISA1")=X K DXS,D0

 ;SET ISA2 = @ISA2

 S D0=INDA S X=$G(INA("ISA2"))

 S @INV@("ISA2")=X K DXS,D0

 ;SET ISA3 = $E(INTERNAL(@ISA3),1,2)

 S D0=INDA S X=$G(INA("ISA3")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=2,X=$E(Y(1),Y(2),X)

 S @INV@("ISA3")=X K DXS,D0

 ;SET ISA4 = @ISA4

 S D0=INDA S X=$G(INA("ISA4"))

 S @INV@("ISA4")=X K DXS,D0

 ;SET ISA5 = $E(INTERNAL(@ISA5),1,2)

 S D0=INDA S X=$G(INA("ISA5")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=2,X=$E(Y(1),Y(2),X)

 S @INV@("ISA5")=X K DXS,D0

 ;SET ISA6 = @ISA6

 S D0=INDA S X=$G(INA("ISA6"))

 S @INV@("ISA6")=X K DXS,D0

 ;SET ISA7 = $E(INTERNAL(@ISA7),1,2)

 S D0=INDA S X=$G(INA("ISA7")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=2,X=$E(Y(1),Y(2),X)

 S @INV@("ISA7")=X K DXS,D0

 ;SET ISA8 = @ISA8

 S D0=INDA S X=$G(INA("ISA8"))

 S @INV@("ISA8")=X K DXS,D0

 ;SET ISA9 = INSGX\^INTHL7F(15396,5)\\6\@ISA9

 S D0=INDA S X=$G(INA("ISA9"))

 S X1="^INTHL7F(15396,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,6)

 S @INV@("ISA9")=X K DXS,D0

 ;SET ISA10 = @ISA10

 S D0=INDA S X=$G(INA("ISA10"))

 S @INV@("ISA10")=X K DXS,D0

 ;SET ISA11 = $E(INTERNAL(@ISA11),1,1)

 S D0=INDA S X=$G(INA("ISA11")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=1,X=$E(Y(1),Y(2),X)

 S @INV@("ISA11")=X K DXS,D0

 ;SET ISA12 = $E(INTERNAL(@ISA12),1,5)

 S D0=INDA S X=$G(INA("ISA12")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=5,X=$E(Y(1),Y(2),X)

 S @INV@("ISA12")=X K DXS,D0

 ;SET ISA13 = @ISA13

 S D0=INDA S X=$G(INA("ISA13"))

 S @INV@("ISA13")=X K DXS,D0

 ;SET ISA14 = $E(INTERNAL(@ISA14),1,1)

 S D0=INDA S X=$G(INA("ISA14")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=1,X=$E(Y(1),Y(2),X)

 S @INV@("ISA14")=X K DXS,D0

 ;SET ISA15 = $E(INTERNAL(@ISA15),1,1)

 S D0=INDA S X=$G(INA("ISA15")),X=X S X=X,Y(1)=X S X=1,Y(2)=X S X=1,X=$E(Y(1),Y(2),X)

 S @INV@("ISA15")=X K DXS,D0

 ;SET ISA16 = @ISA16

 S D0=INDA S X=$G(INA("ISA16"))

 S @INV@("ISA16")=X K DXS,D0

 D:'INVS MC^INHS

 K LINE S LINE="",CP=0 S L1="ISA" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ISA1")) S:$TR(L1,$G(SUBDELIM))="" L1=""

 D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)

 S D0=INDA S X=@INV@("ISA2"),Y(1)=X S X=1,Y(2)=X S X=10,X=$E(Y(1),Y(2),X) S L1=X

 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ISA3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

 S D0=INDA S X=@INV@("ISA4"),Y(1)=X S X=1,Y(2)=X S X=10,X=$E(Y(1),Y(2),X) S L1=X

 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP) S L1=$G(@INV@("ISA5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)

 S D0=INDA S X=@INV@("ISA6"),Y(1)=X S X=1,Y(2)=X S X=15,X=$E(Y(1),Y(2),X) S L1=X

 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP) S L1=$G(@INV@("ISA7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)

 S D0=INDA S X=@INV@("ISA8"),Y(1)=X S X=1,Y(2)=X S X=15,X=$E(Y(1),Y(2),X) S L1=X

 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP) S L1=$G(@INV@("ISA9")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)

 S D0=INDA S X=@INV@("ISA10"),Y(1)=X S X=1,Y(2)=X S X=4,X=$E(Y(1),Y(2),X) S L1=X

 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,11,L1,.CP) S L1=$G(@INV@("ISA11")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)

9 G EN^IS00004A

IS00004(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002

 +1       ;Part 1

 +2       ;Copyright 2002 SAIC

EN         SET X="ERROR^IS00004"

           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 ^UTILITY("INH",$JOB)

           SET (MESSID,INA("MESSID"))=$$MESSID^INHD

 +2        SET INA("INSEQ")=$PIECE(MESSID,$PIECE($GET(^INRHSITE(1,0)),U,8),2)#10000000

 +3        KILL INUIF6

           MERGE INUIF6=INDA

 +4        KILL INREQERR,INHERR,INHERCNT,INV

           DO SETDT^UTDT

           SET DUZ(0)="@"

           SET DUZ("AG")="^1"

           SET DTIME=1

           SET (LCT,GERR)=0

           SET INMODE="O"

           SET INVS=$PIECE(^INRHSITE(1,0),U,12)

           SET INV=$SELECT(INVS<2:"INV",1:"^UTILITY(""INV"",$J)")

           SET (MULT,INSTERR)=0

 +5        SET INHLDUZ=$ORDER(^VA(200,"B","GIS,USER",0))

           SET DUZ=$SELECT($GET(INHLDUZ):INHLDUZ,1:.5)

 +6        SET BHLMIEN="12418"

 +7        SET INEOSM=""

 +8        KILL INSETID

 +9        SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)

 +10       SET (DELIM,INDELIM)=$$FIELD^INHUT()

           SET (SUBDELIM,INSUBDEL)=$$COMP^INHUT()

           SET INSUBCOM=$$SUBCOMP^INHUT()

 +11       SET INDELIMS=$$FIELD^INHUT_$$COMP^INHUT_$$REP^INHUT_$$ESC^INHUT_$$SUBCOMP^INHUT

 +12      ;Entering DATA section.

 +13       SET DELIM=""

 +14       SET SUBDELIM=":"

 +15       SET SUBDELIM=""

 +16       SET INSETID=0

 +17       DO ^BHLXHDR

 +18      ;SET ISA1 = $E(INTERNAL(@ISA1),1,2)

 +19       SET D0=INDA

           SET X=$GET(INA("ISA1"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=2

           SET X=$EXTRACT(Y(1),Y(2),X)

 +20       SET @INV@("ISA1")=X

           KILL DXS,D0

 +21      ;SET ISA2 = @ISA2

 +22       SET D0=INDA

           SET X=$GET(INA("ISA2"))

 +23       SET @INV@("ISA2")=X

           KILL DXS,D0

 +24      ;SET ISA3 = $E(INTERNAL(@ISA3),1,2)

 +25       SET D0=INDA

           SET X=$GET(INA("ISA3"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=2

           SET X=$EXTRACT(Y(1),Y(2),X)

 +26       SET @INV@("ISA3")=X

           KILL DXS,D0

 +27      ;SET ISA4 = @ISA4

 +28       SET D0=INDA

           SET X=$GET(INA("ISA4"))

 +29       SET @INV@("ISA4")=X

           KILL DXS,D0

 +30      ;SET ISA5 = $E(INTERNAL(@ISA5),1,2)

 +31       SET D0=INDA

           SET X=$GET(INA("ISA5"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=2

           SET X=$EXTRACT(Y(1),Y(2),X)

 +32       SET @INV@("ISA5")=X

           KILL DXS,D0

 +33      ;SET ISA6 = @ISA6

 +34       SET D0=INDA

           SET X=$GET(INA("ISA6"))

 +35       SET @INV@("ISA6")=X

           KILL DXS,D0

 +36      ;SET ISA7 = $E(INTERNAL(@ISA7),1,2)

 +37       SET D0=INDA

           SET X=$GET(INA("ISA7"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=2

           SET X=$EXTRACT(Y(1),Y(2),X)

 +38       SET @INV@("ISA7")=X

           KILL DXS,D0

 +39      ;SET ISA8 = @ISA8

 +40       SET D0=INDA

           SET X=$GET(INA("ISA8"))

 +41       SET @INV@("ISA8")=X

           KILL DXS,D0

 +42      ;SET ISA9 = INSGX\^INTHL7F(15396,5)\\6\@ISA9

 +43       SET D0=INDA

           SET X=$GET(INA("ISA9"))

 +44       SET X1="^INTHL7F(15396,5)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,6)

 +45       SET @INV@("ISA9")=X

           KILL DXS,D0

 +46      ;SET ISA10 = @ISA10

 +47       SET D0=INDA

           SET X=$GET(INA("ISA10"))

 +48       SET @INV@("ISA10")=X

           KILL DXS,D0

 +49      ;SET ISA11 = $E(INTERNAL(@ISA11),1,1)

 +50       SET D0=INDA

           SET X=$GET(INA("ISA11"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=1

           SET X=$EXTRACT(Y(1),Y(2),X)

 +51       SET @INV@("ISA11")=X

           KILL DXS,D0

 +52      ;SET ISA12 = $E(INTERNAL(@ISA12),1,5)

 +53       SET D0=INDA

           SET X=$GET(INA("ISA12"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=5

           SET X=$EXTRACT(Y(1),Y(2),X)

 +54       SET @INV@("ISA12")=X

           KILL DXS,D0

 +55      ;SET ISA13 = @ISA13

 +56       SET D0=INDA

           SET X=$GET(INA("ISA13"))

 +57       SET @INV@("ISA13")=X

           KILL DXS,D0

 +58      ;SET ISA14 = $E(INTERNAL(@ISA14),1,1)

 +59       SET D0=INDA

           SET X=$GET(INA("ISA14"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=1

           SET X=$EXTRACT(Y(1),Y(2),X)

 +60       SET @INV@("ISA14")=X

           KILL DXS,D0

 +61      ;SET ISA15 = $E(INTERNAL(@ISA15),1,1)

 +62       SET D0=INDA

           SET X=$GET(INA("ISA15"))

           SET X=X

           SET X=X

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=1

           SET X=$EXTRACT(Y(1),Y(2),X)

 +63       SET @INV@("ISA15")=X

           KILL DXS,D0

 +64      ;SET ISA16 = @ISA16

 +65       SET D0=INDA

           SET X=$GET(INA("ISA16"))

 +66       SET @INV@("ISA16")=X

           KILL DXS,D0

 +67       IF 'INVS

               DO MC^INHS

 +68       KILL LINE

           SET LINE=""

           SET CP=0

           SET L1="ISA"

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)

           SET L1=$GET(@INV@("ISA1"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

 +69       DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)

 +70       SET D0=INDA

           SET X=@INV@("ISA2")

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=10

           SET X=$EXTRACT(Y(1),Y(2),X)

           SET L1=X

 +71       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)

           SET L1=$GET(@INV@("ISA3"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

 +72       SET D0=INDA

           SET X=@INV@("ISA4")

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=10

           SET X=$EXTRACT(Y(1),Y(2),X)

           SET L1=X

 +73       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)

           SET L1=$GET(@INV@("ISA5"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)

 +74       SET D0=INDA

           SET X=@INV@("ISA6")

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=15

           SET X=$EXTRACT(Y(1),Y(2),X)

           SET L1=X

 +75       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)

           SET L1=$GET(@INV@("ISA7"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)

 +76       SET D0=INDA

           SET X=@INV@("ISA8")

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=15

           SET X=$EXTRACT(Y(1),Y(2),X)

           SET L1=X

 +77       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)

           SET L1=$GET(@INV@("ISA9"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)

 +78       SET D0=INDA

           SET X=@INV@("ISA10")

           SET Y(1)=X

           SET X=1

           SET Y(2)=X

           SET X=4

           SET X=$EXTRACT(Y(1),Y(2),X)

           SET L1=X

 +79       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)

           SET L1=$GET(@INV@("ISA11"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)

9          GOTO EN^IS00004A