IS00029F ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on FEB 28, 2013
;Part 7
;Copyright 2013 SAIC
EN S @INV@("RXA20")=X K DXS,D0
;SET RXA21 = INSGX\^INTHL7FT(1,3)\\10\"A"
S D0=INDA S X="A"
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
S @INV@("RXA21")=X K DXS,D0
;SET RXA22 = INSGX\^INTHL7FT(1,3)\\50\@RXA22
S D0=INDA S X=$G(INA("RXA22",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("RXA22")=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")) 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")) 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")) 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@("RXA16"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,17,L1,.CP) S L1=$G(@INV@("RXA17")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
S L1=$G(@INV@("RXA20")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,21,L1,.CP) S L1=$G(@INV@("RXA21")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,22,L1,.CP) S L1=$G(@INV@("RXA22")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,23,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.
I $G(INSTERR) Q $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR)
S UIF=$$NEWO^INHD(INDEST,"^UTILITY(""INH"",$J)",+$P($G(^INRHT(INTT,0)),U,12),INTT,MESSID,$G(INQUE),$G(INORDUZ),$G(INORDIV),.INUIF6,.INUIF7,$G(INA("INMIDGEN")))
I UIF<0 D ERROR^INHS("UIF creation failed",2) Q 2
Q 0
IS00029F ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on FEB 28, 2013
+1 ;Part 7
+2 ;Copyright 2013 SAIC
EN SET @INV@("RXA20")=X
KILL DXS,D0
+1 ;SET RXA21 = INSGX\^INTHL7FT(1,3)\\10\"A"
+2 SET D0=INDA
SET X="A"
+3 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+4 SET @INV@("RXA21")=X
KILL DXS,D0
+5 ;SET RXA22 = INSGX\^INTHL7FT(1,3)\\50\@RXA22
+6 SET D0=INDA
SET X=$GET(INA("RXA22",INI(1)))
+7 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+8 SET @INV@("RXA22")=X
KILL DXS,D0
+9 IF 'INVS
DO MC^INHS
+10 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=""
+11 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"))
+12 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)
+13 SET L1=$GET(@INV@("RXA5"))
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=""
DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
+14 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"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
+15 SET L1=$GET(@INV@("RXA10"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
SET L1=$GET(@INV@("RXA11"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+16 DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
SET L1=$GET(@INV@("RXA15"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,16,L1,.CP)
SET L1=$GET(@INV@("RXA16"))
+17 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,17,L1,.CP)
SET L1=$GET(@INV@("RXA17"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
+18 SET L1=$GET(@INV@("RXA20"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,21,L1,.CP)
SET L1=$GET(@INV@("RXA21"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+19 DO SETPIECE^INHU(.LINE,DELIM,22,L1,.CP)
SET L1=$GET(@INV@("RXA22"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,23,L1,.CP)
+20 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+21 SET INSETID=0
+22 ;SET ZRA1.1 = INSGX\^INTHL7F(14766,5)\\60\#.04
+23 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))
+24 SET X1="^INTHL7F(14766,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+25 SET @INV@("ZRA1.1")=X
KILL DXS,D0
+26 ;SET ZRA1.2 = INSGX\^INTHL7F(14768,5)\\60\#.04
+27 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))
+28 SET X1="^INTHL7F(14768,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+29 SET @INV@("ZRA1.2")=X
KILL DXS,D0
+30 ;SET ZRA1.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
+31 SET D0=INDA
SET X="99IHS"
+32 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+33 SET @INV@("ZRA1.3")=X
KILL DXS,D0
+34 ;SET ZRA2.1 = INSGX\^INTHL7F(14769,5)\\60\#.06
+35 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)
+36 SET X1="^INTHL7F(14769,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+37 SET @INV@("ZRA2.1")=X
KILL DXS,D0
+38 ;SET ZRA2.2 = INSGX\^INTHL7F(14771,5)\\60\#.06
+39 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)
+40 SET X1="^INTHL7F(14771,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+41 SET @INV@("ZRA2.2")=X
KILL DXS,D0
+42 ;SET ZRA2.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
+43 SET D0=INDA
SET X="99IHS"
+44 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+45 SET @INV@("ZRA2.3")=X
KILL DXS,D0
+46 IF 'INVS
DO MC^INHS
+47 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"))
+48 SET D0=INDA
SET X="^"
SET L1=L1_X
+49 SET L1=L1_$GET(@INV@("ZRA1.2"))
+50 SET D0=INDA
SET X="^"
SET L1=L1_X
+51 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"))
+52 SET D0=INDA
SET X="^"
SET L1=L1_X
+53 SET L1=L1_$GET(@INV@("ZRA2.2"))
+54 SET D0=INDA
SET X="^"
SET L1=L1_X
+55 SET L1=L1_$GET(@INV@("ZRA2.3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+56 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+57 QUIT
L1 SET INDA=INDA0
KILL INDA0
+1 IF 'INVS
DO MC^INHS
+2 ;Entering END section.
+3 IF $GET(INSTERR)
QUIT $SELECT($GET(INREQERR)>INSTERR:INREQERR,1:INSTERR)
+4 SET UIF=$$NEWO^INHD(INDEST,"^UTILITY(""INH"",$J)",+$PIECE($GET(^INRHT(INTT,0)),U,12),INTT,MESSID,$GET(INQUE),$GET(INORDUZ),$GET(INORDIV),.INUIF6,.INUIF7,$GET(INA("INMIDGEN")))
+5 IF UIF<0
DO ERROR^INHS("UIF creation failed",2)
QUIT 2
+6 QUIT 0
