IS00029C ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on AUG 15, 2018
;Part 4
;Copyright 2018 SAIC
EN ;SET RXA10 = INSGX\^INTHL7F(17035,5)\\99\@RXA10
S D0=INDA S X=$G(INA("RXA10",INI(1)))
S X1="^INTHL7F(17035,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("RXA10")=X K DXS,D0
;SET RXA11 = INSGX\^INTHL7FT(1,3)\\250\@RXA11
S D0=INDA S X=$G(INA("RXA11",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("RXA11")=X K DXS,D0
;SET RXA15 = INSGX\^INTHL7FT(1,3)\\20\@RXA15
S D0=INDA S X=$G(INA("RXA15",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
S @INV@("RXA15")=X K DXS,D0
;SET RXA16 = INSGX\^INTHL7FT(1,3)\\8\@RXA16
S D0=INDA S X=$G(INA("RXA16",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
S @INV@("RXA16")=X K DXS,D0
;SET RXA17 = INSGX\^INTHL7FT(1,3)\\250\@RXA17
S D0=INDA S X=$G(INA("RXA17",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("RXA17")=X K DXS,D0
;SET RXA20 = INSGX\^INTHL7FT(1,3)\\10\"CP"
S D0=INDA S X="CP"
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
S @INV@("RXA20")=X K DXS,D0
;SET RXA21 = INSGX\^INTHL7FT(1,3)\\10\@RXA21
S D0=INDA S X=$G(INA("RXA21",INI(1)))
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
IS00029C ;Compiled from script 'Generated: HL IHS IZV04 V03VXR OUT-O' on AUG 15, 2018
+1 ;Part 4
+2 ;Copyright 2018 SAIC
EN ;SET RXA10 = INSGX\^INTHL7F(17035,5)\\99\@RXA10
+1 SET D0=INDA
SET X=$GET(INA("RXA10",INI(1)))
+2 SET X1="^INTHL7F(17035,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+3 SET @INV@("RXA10")=X
KILL DXS,D0
+4 ;SET RXA11 = INSGX\^INTHL7FT(1,3)\\250\@RXA11
+5 SET D0=INDA
SET X=$GET(INA("RXA11",INI(1)))
+6 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+7 SET @INV@("RXA11")=X
KILL DXS,D0
+8 ;SET RXA15 = INSGX\^INTHL7FT(1,3)\\20\@RXA15
+9 SET D0=INDA
SET X=$GET(INA("RXA15",INI(1)))
+10 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+11 SET @INV@("RXA15")=X
KILL DXS,D0
+12 ;SET RXA16 = INSGX\^INTHL7FT(1,3)\\8\@RXA16
+13 SET D0=INDA
SET X=$GET(INA("RXA16",INI(1)))
+14 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,8)
+15 SET @INV@("RXA16")=X
KILL DXS,D0
+16 ;SET RXA17 = INSGX\^INTHL7FT(1,3)\\250\@RXA17
+17 SET D0=INDA
SET X=$GET(INA("RXA17",INI(1)))
+18 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+19 SET @INV@("RXA17")=X
KILL DXS,D0
+20 ;SET RXA20 = INSGX\^INTHL7FT(1,3)\\10\"CP"
+21 SET D0=INDA
SET X="CP"
+22 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+23 SET @INV@("RXA20")=X
KILL DXS,D0
+24 ;SET RXA21 = INSGX\^INTHL7FT(1,3)\\10\@RXA21
+25 SET D0=INDA
SET X=$GET(INA("RXA21",INI(1)))
+26 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+27 SET @INV@("RXA21")=X
KILL DXS,D0
+28 ;SET RXA22 = INSGX\^INTHL7FT(1,3)\\50\@RXA22
+29 SET D0=INDA
SET X=$GET(INA("RXA22",INI(1)))
+30 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+31 SET @INV@("RXA22")=X
KILL DXS,D0
+32 IF 'INVS
DO MC^INHS
+33 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=""
+34 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"))
+35 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)
+36 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)
+37 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)
+38 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=""
+39 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"))
+40 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)
+41 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=""
+42 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)
+43 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+44 SET INSETID=0
+45 ;SET ZRA1.1 = INSGX\^INTHL7F(14766,5)\\60\#.04
+46 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))
+47 SET X1="^INTHL7F(14766,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+48 SET @INV@("ZRA1.1")=X
KILL DXS,D0
+49 ;SET ZRA1.2 = INSGX\^INTHL7F(14768,5)\\60\#.04
+50 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))
+51 SET X1="^INTHL7F(14768,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+52 SET @INV@("ZRA1.2")=X
KILL DXS,D0
+53 ;SET ZRA1.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
+54 SET D0=INDA
SET X="99IHS"
+55 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+56 SET @INV@("ZRA1.3")=X
KILL DXS,D0
+57 ;SET ZRA2.1 = INSGX\^INTHL7F(14769,5)\\60\#.06
+58 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)
+59 SET X1="^INTHL7F(14769,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+60 SET @INV@("ZRA2.1")=X
KILL DXS,D0
+61 ;SET ZRA2.2 = INSGX\^INTHL7F(14771,5)\\60\#.06
+62 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)
+63 SET X1="^INTHL7F(14771,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,60)
+64 SET @INV@("ZRA2.2")=X
KILL DXS,D0
+65 ;SET ZRA2.3 = INSGX\^INTHL7FT(1,3)\\5\"99IHS"
+66 SET D0=INDA
SET X="99IHS"
+67 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+68 SET @INV@("ZRA2.3")=X
KILL DXS,D0
+69 IF 'INVS
DO MC^INHS
+70 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"))
+71 SET D0=INDA
SET X="^"
SET L1=L1_X
+72 SET L1=L1_$GET(@INV@("ZRA1.2"))
+73 SET D0=INDA
SET X="^"
SET L1=L1_X
+74 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"))
+75 SET D0=INDA
SET X="^"
SET L1=L1_X
+76 SET L1=L1_$GET(@INV@("ZRA2.2"))
+77 SET D0=INDA
SET X="^"
SET L1=L1_X
+78 SET L1=L1_$GET(@INV@("ZRA2.3"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+79 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+80 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
