IS00004A ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002
;Part 2
;Copyright 2002 SAIC
EN S L1=$G(@INV@("ISA12")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
S D0=INDA S X=@INV@("ISA13"),Y(1)=X S X=1,Y(2)=X S X=9,X=$E(Y(1),Y(2),X) S L1=X
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,14,L1,.CP) S L1=$G(@INV@("ISA14")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
S L1=$G(@INV@("ISA15")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
S D0=INDA S X=@INV@("ISA16"),Y(1)=X S X=1,Y(2)=X S X=1,X=$E(Y(1),Y(2),X) S L1=X
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
D LINE^INHUT11(.LINE,DELIM,LCT)
I $L(LINE)'=0 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
D GS^BHLXHDR
;SET GS1 = $E(INTERNAL(@GS1),1,2)
S D0=INDA S X=$G(INA("GS1")),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@("GS1")=X K DXS,D0
;SET GS2 = @GS2
S D0=INDA S X=$G(INA("GS2"))
S @INV@("GS2")=X K DXS,D0
;SET GS3 = @GS3
S D0=INDA S X=$G(INA("GS3"))
S @INV@("GS3")=X K DXS,D0
;SET GS4 = INSGX\^INTHL7FT(4,3)\\8\@GS4
S D0=INDA S X=$G(INA("GS4"))
S X1="^INTHL7FT(4,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
S @INV@("GS4")=X K DXS,D0
;SET GS5 = @GS5
S D0=INDA S X=$G(INA("GS5"))
S @INV@("GS5")=X K DXS,D0
;SET GS6 = @GS6
S D0=INDA S X=$G(INA("GS6"))
S @INV@("GS6")=X K DXS,D0
;SET GS7 = $E(INTERNAL(@GS7),1,2)
S D0=INDA S X=$G(INA("GS7")),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@("GS7")=X K DXS,D0
;SET GS8 = @GS8
S D0=INDA S X=$G(INA("GS8"))
S @INV@("GS8")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="GS" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("GS1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
S D0=INDA S X=@INV@("GS2"),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,3,L1,.CP)
S D0=INDA S X=@INV@("GS3"),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,4,L1,.CP) S L1=$G(@INV@("GS4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
S D0=INDA S X=@INV@("GS5"),Y(1)=X S X=1,Y(2)=X S X=8,X=$E(Y(1),Y(2),X) S L1=X
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
S D0=INDA S X=@INV@("GS6"),Y(1)=X S X=1,Y(2)=X S X=9,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@("GS7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
S D0=INDA S X=@INV@("GS8"),Y(1)=X S X=1,Y(2)=X S X=12,X=$E(Y(1),Y(2),X) S L1=X
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
D LINE^INHUT11(.LINE,DELIM,LCT)
I $L(LINE)'=0 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
;SET ST1 = INSGX\^INTHL7FT(1,3)\\999\@276HFST1
S D0=INDA S X=$G(INA("276HFST1"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("ST1")=X K DXS,D0
;SET ST2 = @INSEQ
S D0=INDA S X=$G(INA("INSEQ"))
S @INV@("ST2")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="ST" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ST1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
S D0=INDA S X=@INV@("ST2"),Y(1)=X S X=1,Y(2)=X S X=9,X=$E(Y(1),Y(2),X) S L1=X
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
D LINE^INHUT11(.LINE,DELIM,LCT)
I $L(LINE)'=0 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
;SET BHT1 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT1
S D0=INDA S X=$G(INA("276HFBHT1"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("BHT1")=X K DXS,D0
;SET BHT2 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT2
S D0=INDA S X=$G(INA("276HFBHT2"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("BHT2")=X K DXS,D0
;SET BHT3 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT3
S D0=INDA S X=$G(INA("276HFBHT3"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
S @INV@("BHT3")=X K DXS,D0
;SET BHT4 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT4
S D0=INDA S X=$G(INA("276HFBHT4"))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
9 G EN^IS00004B
IS00004A ;Compiled from script 'Generated: X1 IHS 276-O' on DEC 09, 2002
+1 ;Part 2
+2 ;Copyright 2002 SAIC
EN SET L1=$GET(@INV@("ISA12"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
+1 SET D0=INDA
SET X=@INV@("ISA13")
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=9
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+2 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,14,L1,.CP)
SET L1=$GET(@INV@("ISA14"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
+3 SET L1=$GET(@INV@("ISA15"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
+4 SET D0=INDA
SET X=@INV@("ISA16")
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=1
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+5 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
+6 DO LINE^INHUT11(.LINE,DELIM,LCT)
+7 IF $LENGTH(LINE)'=0
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+8 SET INSETID=0
+9 DO GS^BHLXHDR
+10 ;SET GS1 = $E(INTERNAL(@GS1),1,2)
+11 SET D0=INDA
SET X=$GET(INA("GS1"))
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)
+12 SET @INV@("GS1")=X
KILL DXS,D0
+13 ;SET GS2 = @GS2
+14 SET D0=INDA
SET X=$GET(INA("GS2"))
+15 SET @INV@("GS2")=X
KILL DXS,D0
+16 ;SET GS3 = @GS3
+17 SET D0=INDA
SET X=$GET(INA("GS3"))
+18 SET @INV@("GS3")=X
KILL DXS,D0
+19 ;SET GS4 = INSGX\^INTHL7FT(4,3)\\8\@GS4
+20 SET D0=INDA
SET X=$GET(INA("GS4"))
+21 SET X1="^INTHL7FT(4,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,8)
+22 SET @INV@("GS4")=X
KILL DXS,D0
+23 ;SET GS5 = @GS5
+24 SET D0=INDA
SET X=$GET(INA("GS5"))
+25 SET @INV@("GS5")=X
KILL DXS,D0
+26 ;SET GS6 = @GS6
+27 SET D0=INDA
SET X=$GET(INA("GS6"))
+28 SET @INV@("GS6")=X
KILL DXS,D0
+29 ;SET GS7 = $E(INTERNAL(@GS7),1,2)
+30 SET D0=INDA
SET X=$GET(INA("GS7"))
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)
+31 SET @INV@("GS7")=X
KILL DXS,D0
+32 ;SET GS8 = @GS8
+33 SET D0=INDA
SET X=$GET(INA("GS8"))
+34 SET @INV@("GS8")=X
KILL DXS,D0
+35 IF 'INVS
DO MC^INHS
+36 KILL LINE
SET LINE=""
SET CP=0
SET L1="GS"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("GS1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+37 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
+38 SET D0=INDA
SET X=@INV@("GS2")
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
+39 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+40 SET D0=INDA
SET X=@INV@("GS3")
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
+41 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("GS4"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
+42 SET D0=INDA
SET X=@INV@("GS5")
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=8
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+43 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
+44 SET D0=INDA
SET X=@INV@("GS6")
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=9
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+45 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
SET L1=$GET(@INV@("GS7"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
+46 SET D0=INDA
SET X=@INV@("GS8")
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=12
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+47 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
+48 DO LINE^INHUT11(.LINE,DELIM,LCT)
+49 IF $LENGTH(LINE)'=0
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+50 SET INSETID=0
+51 ;SET ST1 = INSGX\^INTHL7FT(1,3)\\999\@276HFST1
+52 SET D0=INDA
SET X=$GET(INA("276HFST1"))
+53 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+54 SET @INV@("ST1")=X
KILL DXS,D0
+55 ;SET ST2 = @INSEQ
+56 SET D0=INDA
SET X=$GET(INA("INSEQ"))
+57 SET @INV@("ST2")=X
KILL DXS,D0
+58 IF 'INVS
DO MC^INHS
+59 KILL LINE
SET LINE=""
SET CP=0
SET L1="ST"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("ST1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+60 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
+61 SET D0=INDA
SET X=@INV@("ST2")
SET Y(1)=X
SET X=1
SET Y(2)=X
SET X=9
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+62 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+63 DO LINE^INHUT11(.LINE,DELIM,LCT)
+64 IF $LENGTH(LINE)'=0
SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+65 SET INSETID=0
+66 ;SET BHT1 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT1
+67 SET D0=INDA
SET X=$GET(INA("276HFBHT1"))
+68 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+69 SET @INV@("BHT1")=X
KILL DXS,D0
+70 ;SET BHT2 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT2
+71 SET D0=INDA
SET X=$GET(INA("276HFBHT2"))
+72 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+73 SET @INV@("BHT2")=X
KILL DXS,D0
+74 ;SET BHT3 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT3
+75 SET D0=INDA
SET X=$GET(INA("276HFBHT3"))
+76 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
+77 SET @INV@("BHT3")=X
KILL DXS,D0
+78 ;SET BHT4 = INSGX\^INTHL7FT(1,3)\\999\@276HFBHT4
+79 SET D0=INDA
SET X=$GET(INA("276HFBHT4"))
+80 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,999)
9 GOTO EN^IS00004B
