IS00029H ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on SEP 05, 2011
;Part 9
;Copyright 2011 SAIC
EN ;SET RXA7 = INSGX\^INTHL7F(16990,5)\\20\"OUTPUT TRANSFORM"
S D0=INDA S X="OUTPUT TRANSFORM"
S X1="^INTHL7F(16990,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
S @INV@("RXA7")=X K DXS,D0
;SET RXA9.1 = INSGX\^INTHL7F(16739,5)\\2\"OUTPUT TRANSFORM"
S D0=INDA S X="OUTPUT TRANSFORM"
S X1="^INTHL7F(16739,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
S @INV@("RXA9.1")=X K DXS,D0
;SET RXA9.2 = INSGX\^INTHL7F(16740,5)\\40\"OUTPUT TRANSFORM"
S D0=INDA S X="OUTPUT TRANSFORM"
S X1="^INTHL7F(16740,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,40)
S @INV@("RXA9.2")=X K DXS,D0
;SET RXA9.3 = INSGX\^INTHL7FT(1,3)\\10\"NIP001"
S D0=INDA S X="NIP001"
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
S @INV@("RXA9.3")=X K DXS,D0
;SET RXA10 = INSGX\^INTHL7F(16731,5)\\50\#1204
S D0=INDA S Y(1)=$S($D(^AUPNVIMM(D0,12)):^(12),1:"") S X=$P($G(^VA(200,+$P(Y(1),U,4),0)),U)
S X1="^INTHL7F(16731,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("RXA10")=X K DXS,D0
;SET RXA11.1 = INSGX\^INTHL7FT(1,3)\\50\.03:.06
S DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,3) S:'D0!'$D(^AUPNVSIT(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUPNVSIT(D0,0)):^(0),1:"""")"
S D0=INDA X DXS(9.2) S Y(102)=$G(X),D0=$P(Y(101),U,6) S:'D0!'$D(^AUTTLOC(+D0,0)) D0=-1 S Y(201)=$S($D(^AUTTLOC(D0,0)):^(0),1:"") S X=$P($G(^DIC(4,+$P(Y(201),U,1),0)),U) S D0=I(0,0)
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("RXA11.1")=X K DXS,D0
;SET RXA11.2 = INSGX\^INTHL7FT(1,3)\\1\""
S D0=INDA S X=""
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
S @INV@("RXA11.2")=X K DXS,D0
;SET RXA11.3 = INSGX\^INTHL7FT(1,3)\\1\""
S D0=INDA S X=""
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
S @INV@("RXA11.3")=X K DXS,D0
;SET RXA11.4 = INSGX\^INTHL7FT(1,3)\\50\.03:2101
S D0=INDA S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""),D0=$P(Y(1),U,3) S:'D0!'$D(^AUPNVSIT(+D0,0)) D0=-1 S Y(101)=$S($D(^AUPNVSIT(D0,21)):^(21),1:"") S X=$P(Y(101),U,1) S D0=I(0,0)
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("RXA11.4")=X K DXS,D0
;SET RXA15 = INSGX\^INTHL7F(16723,5)\\20\"OUTPUT TRANSFORM"
S D0=INDA S X="OUTPUT TRANSFORM"
S X1="^INTHL7F(16723,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
S @INV@("RXA15")=X K DXS,D0
;SET RXA17.1 = INSGX\^INTHL7FT(1,3)\\3\.05:.02:.02
S DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
S D0=INDA X DXS(9.2) S Y(102)=$G(X),D0=$P(Y(101),U,2) S:'D0!'$D(^AUTTIMAN(+D0,0)) D0=-1 S Y(201)=$S($D(^AUTTIMAN(D0,0)):^(0),1:"") S X=$P(Y(201),U,2) S D0=I(0,0)
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,3)
S @INV@("RXA17.1")=X K DXS,D0
;SET RXA17.2 = INSGX\^INTHL7FT(1,3)\\50\.05:.02
S DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
S D0=INDA X DXS(9.2) S X=$P($G(^AUTTIMAN(+$P(Y(101),U,2),0)),U) S D0=I(0,0)
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("RXA17.2")=X K DXS,D0
;SET RXA17.3 = INSGX\^INTHL7FT(1,3)\\3\"MVX"
S D0=INDA S X="MVX"
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,3)
S @INV@("RXA17.3")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="RXA" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("RXA1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("RXA2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("RXA3"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("RXA4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
S L1=$G(@INV@("RXA5.1"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA5.2"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA5.3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("RXA6")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP) S L1=$G(@INV@("RXA7")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,8,L1,.CP) S L1=$G(@INV@("RXA9.1"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA9.2"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA9.3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,10,L1,.CP) S L1=$G(@INV@("RXA10")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,11,L1,.CP) S L1=$G(@INV@("RXA11.1"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA11.2"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA11.3"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA11.4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP) S L1=$G(@INV@("RXA15")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,16,L1,.CP) S L1=$G(@INV@("RXA17.1"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA17.2"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("RXA17.3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
SET INSETID=0
;SET ZRA1.1 = INSGX\^INTHL7F(14766,5)\\60\#.04
S D0=INDA S Y(2)=$C(59)_$P($G(^DD(9000010.11,.04,0)),U,3),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,4)_":",2),$C(59))
S X1="^INTHL7F(14766,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
S @INV@("ZRA1.1")=X K DXS,D0
;SET ZRA1.2 = INSGX\^INTHL7F(14768,5)\\60\#.04
S D0=INDA S Y(2)=$C(59)_$P($G(^DD(9000010.11,.04,0)),U,3),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($P(Y(2),$C(59)_$P(Y(1),U,4)_":",2),$C(59))
S X1="^INTHL7F(14768,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
S @INV@("ZRA1.2")=X K DXS,D0
;SET ZRA1.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
S D0=INDA S X="99IHS"
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,5)
S @INV@("ZRA1.3")=X K DXS,D0
;SET ZRA2.1 = INSGX\^INTHL7F(14769,5)\\60\#.06
S D0=INDA S Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($G(^BIREC(+$P(Y(1),U,6),0)),U)
S X1="^INTHL7F(14769,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
S @INV@("ZRA2.1")=X K DXS,D0
;SET ZRA2.2 = INSGX\^INTHL7F(14771,5)\\60\#.06
S D0=INDA S Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:"") S X=$P($G(^BIREC(+$P(Y(1),U,6),0)),U)
S X1="^INTHL7F(14771,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,60)
S @INV@("ZRA2.2")=X K DXS,D0
;SET ZRA2.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
S D0=INDA S X="99IHS"
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,5)
S @INV@("ZRA2.3")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="ZRA" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZRA1.1"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("ZRA1.2"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("ZRA1.3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZRA2.1"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("ZRA2.2"))
S D0=INDA S X="^" S L1=L1_X
S L1=L1_$G(@INV@("ZRA2.3")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
Q
L1 S INDA=INDA0 K INDA0
D:'INVS MC^INHS
;Entering END section.
9 G EN^IS00029I
IS00029H ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on SEP 05, 2011
+1 ;Part 9
+2 ;Copyright 2011 SAIC
EN ;SET RXA7 = INSGX\^INTHL7F(16990,5)\\20\"OUTPUT TRANSFORM"
+1 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+2 SET X1="^INTHL7F(16990,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+3 SET @INV@("RXA7")=X
KILL DXS,D0
+4 ;SET RXA9.1 = INSGX\^INTHL7F(16739,5)\\2\"OUTPUT TRANSFORM"
+5 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+6 SET X1="^INTHL7F(16739,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+7 SET @INV@("RXA9.1")=X
KILL DXS,D0
+8 ;SET RXA9.2 = INSGX\^INTHL7F(16740,5)\\40\"OUTPUT TRANSFORM"
+9 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+10 SET X1="^INTHL7F(16740,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,40)
+11 SET @INV@("RXA9.2")=X
KILL DXS,D0
+12 ;SET RXA9.3 = INSGX\^INTHL7FT(1,3)\\10\"NIP001"
+13 SET D0=INDA
SET X="NIP001"
+14 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+15 SET @INV@("RXA9.3")=X
KILL DXS,D0
+16 ;SET RXA10 = INSGX\^INTHL7F(16731,5)\\50\#1204
+17 SET D0=INDA
SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,12)):^(12),1:"")
SET X=$PIECE($GET(^VA(200,+$PIECE(Y(1),U,4),0)),U)
+18 SET X1="^INTHL7F(16731,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+19 SET @INV@("RXA10")=X
KILL DXS,D0
+20 ;SET RXA11.1 = INSGX\^INTHL7FT(1,3)\\50\.03:.06
+21 SET DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,3) S:'D0!'$D(^AUPNVSIT(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUPNVSIT(D0,0)):^(0),1:"""")"
+22 SET D0=INDA
XECUTE DXS(9.2)
SET Y(102)=$GET(X)
SET D0=$PIECE(Y(101),U,6)
IF 'D0!'$DATA(^AUTTLOC(+D0,0))
SET D0=-1
SET Y(201)=$SELECT($DATA(^AUTTLOC(D0,0)):^(0),1:"")
SET X=$PIECE($GET(^DIC(4,+$PIECE(Y(201),U,1),0)),U)
SET D0=I(0,0)
+23 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+24 SET @INV@("RXA11.1")=X
KILL DXS,D0
+25 ;SET RXA11.2 = INSGX\^INTHL7FT(1,3)\\1\""
+26 SET D0=INDA
SET X=""
+27 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,1)
+28 SET @INV@("RXA11.2")=X
KILL DXS,D0
+29 ;SET RXA11.3 = INSGX\^INTHL7FT(1,3)\\1\""
+30 SET D0=INDA
SET X=""
+31 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,1)
+32 SET @INV@("RXA11.3")=X
KILL DXS,D0
+33 ;SET RXA11.4 = INSGX\^INTHL7FT(1,3)\\50\.03:2101
+34 SET D0=INDA
SET I(0,0)=$GET(D0)
SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
SET D0=$PIECE(Y(1),U,3)
IF 'D0!'$DATA(^AUPNVSIT(+D0,0))
SET D0=-1
SET Y(101)=$SELECT($DATA(^AUPNVSIT(D0,21)):^(21),1:"")
SET X=$PIECE(Y(101),U,1)
SET D0=I(0,0)
+35 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+36 SET @INV@("RXA11.4")=X
KILL DXS,D0
+37 ;SET RXA15 = INSGX\^INTHL7F(16723,5)\\20\"OUTPUT TRANSFORM"
+38 SET D0=INDA
SET X="OUTPUT TRANSFORM"
+39 SET X1="^INTHL7F(16723,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+40 SET @INV@("RXA15")=X
KILL DXS,D0
+41 ;SET RXA17.1 = INSGX\^INTHL7FT(1,3)\\3\.05:.02:.02
+42 SET DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S I(100,0)=$G(D0),Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
+43 SET D0=INDA
XECUTE DXS(9.2)
SET Y(102)=$GET(X)
SET D0=$PIECE(Y(101),U,2)
IF 'D0!'$DATA(^AUTTIMAN(+D0,0))
SET D0=-1
SET Y(201)=$SELECT($DATA(^AUTTIMAN(D0,0)):^(0),1:"")
SET X=$PIECE(Y(201),U,2)
SET D0=I(0,0)
+44 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,3)
+45 SET @INV@("RXA17.1")=X
KILL DXS,D0
+46 ;SET RXA17.2 = INSGX\^INTHL7FT(1,3)\\50\.05:.02
+47 SET DXS(9.2)="S I(0,0)=$G(D0),Y(1)=$S($D(^AUPNVIMM(D0,0)):^(0),1:""""),D0=$P(Y(1),U,5) S:'D0!'$D(^AUTTIML(+D0,0)) D0=-1 S Y(101)=$S($D(^AUTTIML(D0,0)):^(0),1:"""")"
+48 SET D0=INDA
XECUTE DXS(9.2)
SET X=$PIECE($GET(^AUTTIMAN(+$PIECE(Y(101),U,2),0)),U)
SET D0=I(0,0)
+49 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+50 SET @INV@("RXA17.2")=X
KILL DXS,D0
+51 ;SET RXA17.3 = INSGX\^INTHL7FT(1,3)\\3\"MVX"
+52 SET D0=INDA
SET X="MVX"
+53 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,3)
+54 SET @INV@("RXA17.3")=X
KILL DXS,D0
+55 IF 'INVS
DO MC^INHS
+56 KILL LINE
SET LINE=""
SET CP=0
SET L1="RXA"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("RXA1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+57 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("RXA2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("RXA3"))
+58 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("RXA4"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
+59 SET L1=$GET(@INV@("RXA5.1"))
+60 SET D0=INDA
SET X="^"
SET L1=L1_X
+61 SET L1=L1_$GET(@INV@("RXA5.2"))
+62 SET D0=INDA
SET X="^"
SET L1=L1_X
+63 SET L1=L1_$GET(@INV@("RXA5.3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
SET L1=$GET(@INV@("RXA6"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+64 DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
SET L1=$GET(@INV@("RXA7"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,8,L1,.CP)
SET L1=$GET(@INV@("RXA9.1"))
+65 SET D0=INDA
SET X="^"
SET L1=L1_X
+66 SET L1=L1_$GET(@INV@("RXA9.2"))
+67 SET D0=INDA
SET X="^"
SET L1=L1_X
+68 SET L1=L1_$GET(@INV@("RXA9.3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
SET L1=$GET(@INV@("RXA10"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+69 DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
SET L1=$GET(@INV@("RXA11.1"))
+70 SET D0=INDA
SET X="^"
SET L1=L1_X
+71 SET L1=L1_$GET(@INV@("RXA11.2"))
+72 SET D0=INDA
SET X="^"
SET L1=L1_X
+73 SET L1=L1_$GET(@INV@("RXA11.3"))
+74 SET D0=INDA
SET X="^"
SET L1=L1_X
+75 SET L1=L1_$GET(@INV@("RXA11.4"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
SET L1=$GET(@INV@("RXA15"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+76 DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
SET L1=$GET(@INV@("RXA17.1"))
+77 SET D0=INDA
SET X="^"
SET L1=L1_X
+78 SET L1=L1_$GET(@INV@("RXA17.2"))
+79 SET D0=INDA
SET X="^"
SET L1=L1_X
+80 SET L1=L1_$GET(@INV@("RXA17.3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
+81 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+82 SET INSETID=0
+83 ;SET ZRA1.1 = INSGX\^INTHL7F(14766,5)\\60\#.04
+84 SET D0=INDA
SET Y(2)=$CHAR(59)_$PIECE($GET(^DD(9000010.11,.04,0)),U,3)
SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
SET X=$PIECE($PIECE(Y(2),$CHAR(59)_$PIECE(Y(1),U,4)_":",2),$CHAR(59))
+85 SET X1="^INTHL7F(14766,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+86 SET @INV@("ZRA1.1")=X
KILL DXS,D0
+87 ;SET ZRA1.2 = INSGX\^INTHL7F(14768,5)\\60\#.04
+88 SET D0=INDA
SET Y(2)=$CHAR(59)_$PIECE($GET(^DD(9000010.11,.04,0)),U,3)
SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
SET X=$PIECE($PIECE(Y(2),$CHAR(59)_$PIECE(Y(1),U,4)_":",2),$CHAR(59))
+89 SET X1="^INTHL7F(14768,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+90 SET @INV@("ZRA1.2")=X
KILL DXS,D0
+91 ;SET ZRA1.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
+92 SET D0=INDA
SET X="99IHS"
+93 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+94 SET @INV@("ZRA1.3")=X
KILL DXS,D0
+95 ;SET ZRA2.1 = INSGX\^INTHL7F(14769,5)\\60\#.06
+96 SET D0=INDA
SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
SET X=$PIECE($GET(^BIREC(+$PIECE(Y(1),U,6),0)),U)
+97 SET X1="^INTHL7F(14769,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+98 SET @INV@("ZRA2.1")=X
KILL DXS,D0
+99 ;SET ZRA2.2 = INSGX\^INTHL7F(14771,5)\\60\#.06
+100 SET D0=INDA
SET Y(1)=$SELECT($DATA(^AUPNVIMM(D0,0)):^(0),1:"")
SET X=$PIECE($GET(^BIREC(+$PIECE(Y(1),U,6),0)),U)
+101 SET X1="^INTHL7F(14771,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+102 SET @INV@("ZRA2.2")=X
KILL DXS,D0
+103 ;SET ZRA2.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
+104 SET D0=INDA
SET X="99IHS"
+105 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+106 SET @INV@("ZRA2.3")=X
KILL DXS,D0
+107 IF 'INVS
DO MC^INHS
+108 KILL LINE
SET LINE=""
SET CP=0
SET L1="ZRA"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("ZRA1.1"))
+109 SET D0=INDA
SET X="^"
SET L1=L1_X
+110 SET L1=L1_$GET(@INV@("ZRA1.2"))
+111 SET D0=INDA
SET X="^"
SET L1=L1_X
+112 SET L1=L1_$GET(@INV@("ZRA1.3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("ZRA2.1"))
+113 SET D0=INDA
SET X="^"
SET L1=L1_X
+114 SET L1=L1_$GET(@INV@("ZRA2.2"))
+115 SET D0=INDA
SET X="^"
SET L1=L1_X
+116 SET L1=L1_$GET(@INV@("ZRA2.3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+117 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+118 QUIT
L1 SET INDA=INDA0
KILL INDA0
+1 IF 'INVS
DO MC^INHS
+2 ;Entering END section.
9 GOTO EN^IS00029I
