IS00011E ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 03, 2015
;Part 6
;Copyright 2015 SAIC
EN S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,48)
S @INV@("ORC3")=X K DXS,D0
;SET ORC5 = INSGX\^INTHL7FT(1,3)\\2\@ORC5
S D0=INDA S X=$G(INA("ORC5",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
S @INV@("ORC5")=X K DXS,D0
;SET ORC10 = @ORC10
S D0=INDA S X=$G(INA("ORC10",INI(1)))
S @INV@("ORC10")=X K DXS,D0
;SET ORC12 = @ORC12
S D0=INDA S X=$G(INA("ORC12",INI(1)))
S @INV@("ORC12")=X K DXS,D0
;SET ORC17 = INSGX\^INTHL7FT(1,3)\\250\@ORC17
S D0=INDA S X=$G(INA("ORC17",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("ORC17")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="ORC" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ORC1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ORC2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ORC3"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ORC5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
S D0=INDA S X=@INV@("ORC10"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=99,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 D0=INDA S X=@INV@("ORC12"),Y(1)=$G(X) S X=1,Y(2)=$G(X) S X=99,X=$E(Y(1),Y(2),X) S L1=X
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,13,L1,.CP) S L1=$G(@INV@("ORC17")) 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
D RXA^BYIMSEGS
;SET RXA1 = INSGX\^INTHL7FT(3,3)\\4\"0"
S D0=INDA S X="0"
S X1="^INTHL7FT(3,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
S @INV@("RXA1")=X K DXS,D0
;SET RXA2 = INSGX\^INTHL7FT(3,3)\\4\@RXA2
S D0=INDA S X=$G(INA("RXA2",INI(1)))
S X1="^INTHL7FT(3,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
S @INV@("RXA2")=X K DXS,D0
;SET RXA3 = INSGX\^INTHL7FT(1,3)\\26\@RXA3
S D0=INDA S X=$G(INA("RXA3",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
S @INV@("RXA3")=X K DXS,D0
;SET RXA4 = INSGX\^INTHL7FT(1,3)\\26\@RXA4
S D0=INDA S X=$G(INA("RXA4",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
S @INV@("RXA4")=X K DXS,D0
;SET RXA5 = INSGX\^INTHL7FT(1,3)\\250\@RXA5
S D0=INDA S X=$G(INA("RXA5",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("RXA5")=X K DXS,D0
;SET RXA6 = INSGX\^INTHL7FT(1,3)\\99\@RXA6
S D0=INDA S X=$G(INA("RXA6",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("RXA6")=X K DXS,D0
;SET RXA7 = INSGX\^INTHL7FT(1,3)\\20\@RXA7
S D0=INDA S X=$G(INA("RXA7",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
S @INV@("RXA7")=X K DXS,D0
;SET RXA9 = INSGX\^INTHL7FT(1,3)\\100\@RXA9
S D0=INDA S X=$G(INA("RXA9",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,100)
S @INV@("RXA9")=X K DXS,D0
;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
D RXR^BYIMSEGS
;SET RXR1 = INSGX\^INTHL7FT(1,3)\\50\@RXR1
S D0=INDA S X=$G(INA("RXR1",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("RXR1")=X K DXS,D0
;SET RXR2 = INSGX\^INTHL7FT(1,3)\\250\@RXR2
S D0=INDA S X=$G(INA("RXR2",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("RXR2")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="RXR" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("RXR1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("RXR2")) 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
SET INSETID=0
D OBXCE^BYIMSEG1
;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXCE1
S D0=INDA S X=$G(INA("OBXCE1",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
S @INV@("OBX1")=X K DXS,D0
;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXCE2
S D0=INDA S X=$G(INA("OBXCE2",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
S @INV@("OBX2")=X K DXS,D0
9 G EN^IS00011F
IS00011E ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 03, 2015
+1 ;Part 6
+2 ;Copyright 2015 SAIC
EN SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,48)
+1 SET @INV@("ORC3")=X
KILL DXS,D0
+2 ;SET ORC5 = INSGX\^INTHL7FT(1,3)\\2\@ORC5
+3 SET D0=INDA
SET X=$GET(INA("ORC5",INI(1)))
+4 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+5 SET @INV@("ORC5")=X
KILL DXS,D0
+6 ;SET ORC10 = @ORC10
+7 SET D0=INDA
SET X=$GET(INA("ORC10",INI(1)))
+8 SET @INV@("ORC10")=X
KILL DXS,D0
+9 ;SET ORC12 = @ORC12
+10 SET D0=INDA
SET X=$GET(INA("ORC12",INI(1)))
+11 SET @INV@("ORC12")=X
KILL DXS,D0
+12 ;SET ORC17 = INSGX\^INTHL7FT(1,3)\\250\@ORC17
+13 SET D0=INDA
SET X=$GET(INA("ORC17",INI(1)))
+14 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+15 SET @INV@("ORC17")=X
KILL DXS,D0
+16 IF 'INVS
DO MC^INHS
+17 KILL LINE
SET LINE=""
SET CP=0
SET L1="ORC"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("ORC1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+18 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("ORC2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("ORC3"))
+19 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("ORC5"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
+20 SET D0=INDA
SET X=@INV@("ORC10")
SET Y(1)=$GET(X)
SET X=1
SET Y(2)=$GET(X)
SET X=99
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+21 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
+22 SET D0=INDA
SET X=@INV@("ORC12")
SET Y(1)=$GET(X)
SET X=1
SET Y(2)=$GET(X)
SET X=99
SET X=$EXTRACT(Y(1),Y(2),X)
SET L1=X
+23 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,13,L1,.CP)
SET L1=$GET(@INV@("ORC17"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
+24 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+25 SET INSETID=0
+26 DO RXA^BYIMSEGS
+27 ;SET RXA1 = INSGX\^INTHL7FT(3,3)\\4\"0"
+28 SET D0=INDA
SET X="0"
+29 SET X1="^INTHL7FT(3,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,4)
+30 SET @INV@("RXA1")=X
KILL DXS,D0
+31 ;SET RXA2 = INSGX\^INTHL7FT(3,3)\\4\@RXA2
+32 SET D0=INDA
SET X=$GET(INA("RXA2",INI(1)))
+33 SET X1="^INTHL7FT(3,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,4)
+34 SET @INV@("RXA2")=X
KILL DXS,D0
+35 ;SET RXA3 = INSGX\^INTHL7FT(1,3)\\26\@RXA3
+36 SET D0=INDA
SET X=$GET(INA("RXA3",INI(1)))
+37 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+38 SET @INV@("RXA3")=X
KILL DXS,D0
+39 ;SET RXA4 = INSGX\^INTHL7FT(1,3)\\26\@RXA4
+40 SET D0=INDA
SET X=$GET(INA("RXA4",INI(1)))
+41 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+42 SET @INV@("RXA4")=X
KILL DXS,D0
+43 ;SET RXA5 = INSGX\^INTHL7FT(1,3)\\250\@RXA5
+44 SET D0=INDA
SET X=$GET(INA("RXA5",INI(1)))
+45 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+46 SET @INV@("RXA5")=X
KILL DXS,D0
+47 ;SET RXA6 = INSGX\^INTHL7FT(1,3)\\99\@RXA6
+48 SET D0=INDA
SET X=$GET(INA("RXA6",INI(1)))
+49 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+50 SET @INV@("RXA6")=X
KILL DXS,D0
+51 ;SET RXA7 = INSGX\^INTHL7FT(1,3)\\20\@RXA7
+52 SET D0=INDA
SET X=$GET(INA("RXA7",INI(1)))
+53 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+54 SET @INV@("RXA7")=X
KILL DXS,D0
+55 ;SET RXA9 = INSGX\^INTHL7FT(1,3)\\100\@RXA9
+56 SET D0=INDA
SET X=$GET(INA("RXA9",INI(1)))
+57 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,100)
+58 SET @INV@("RXA9")=X
KILL DXS,D0
+59 ;SET RXA10 = INSGX\^INTHL7F(17035,5)\\99\@RXA10
+60 SET D0=INDA
SET X=$GET(INA("RXA10",INI(1)))
+61 SET X1="^INTHL7F(17035,5)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+62 SET @INV@("RXA10")=X
KILL DXS,D0
+63 ;SET RXA11 = INSGX\^INTHL7FT(1,3)\\250\@RXA11
+64 SET D0=INDA
SET X=$GET(INA("RXA11",INI(1)))
+65 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+66 SET @INV@("RXA11")=X
KILL DXS,D0
+67 ;SET RXA15 = INSGX\^INTHL7FT(1,3)\\20\@RXA15
+68 SET D0=INDA
SET X=$GET(INA("RXA15",INI(1)))
+69 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+70 SET @INV@("RXA15")=X
KILL DXS,D0
+71 ;SET RXA16 = INSGX\^INTHL7FT(1,3)\\8\@RXA16
+72 SET D0=INDA
SET X=$GET(INA("RXA16",INI(1)))
+73 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,8)
+74 SET @INV@("RXA16")=X
KILL DXS,D0
+75 ;SET RXA17 = INSGX\^INTHL7FT(1,3)\\250\@RXA17
+76 SET D0=INDA
SET X=$GET(INA("RXA17",INI(1)))
+77 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+78 SET @INV@("RXA17")=X
KILL DXS,D0
+79 ;SET RXA20 = INSGX\^INTHL7FT(1,3)\\10\"CP"
+80 SET D0=INDA
SET X="CP"
+81 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+82 SET @INV@("RXA20")=X
KILL DXS,D0
+83 ;SET RXA21 = INSGX\^INTHL7FT(1,3)\\10\@RXA21
+84 SET D0=INDA
SET X=$GET(INA("RXA21",INI(1)))
+85 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+86 SET @INV@("RXA21")=X
KILL DXS,D0
+87 ;SET RXA22 = INSGX\^INTHL7FT(1,3)\\50\@RXA22
+88 SET D0=INDA
SET X=$GET(INA("RXA22",INI(1)))
+89 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+90 SET @INV@("RXA22")=X
KILL DXS,D0
+91 IF 'INVS
DO MC^INHS
+92 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=""
+93 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"))
+94 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)
+95 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)
+96 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)
+97 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=""
+98 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"))
+99 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)
+100 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=""
+101 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)
+102 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+103 SET INSETID=0
+104 DO RXR^BYIMSEGS
+105 ;SET RXR1 = INSGX\^INTHL7FT(1,3)\\50\@RXR1
+106 SET D0=INDA
SET X=$GET(INA("RXR1",INI(1)))
+107 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+108 SET @INV@("RXR1")=X
KILL DXS,D0
+109 ;SET RXR2 = INSGX\^INTHL7FT(1,3)\\250\@RXR2
+110 SET D0=INDA
SET X=$GET(INA("RXR2",INI(1)))
+111 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+112 SET @INV@("RXR2")=X
KILL DXS,D0
+113 IF 'INVS
DO MC^INHS
+114 KILL LINE
SET LINE=""
SET CP=0
SET L1="RXR"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("RXR1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+115 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("RXR2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
+116 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+117 SET INSETID=0
+118 DO OBXCE^BYIMSEG1
+119 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXCE1
+120 SET D0=INDA
SET X=$GET(INA("OBXCE1",INI(1)))
+121 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+122 SET @INV@("OBX1")=X
KILL DXS,D0
+123 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXCE2
+124 SET D0=INDA
SET X=$GET(INA("OBXCE2",INI(1)))
+125 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+126 SET @INV@("OBX2")=X
KILL DXS,D0
9 GOTO EN^IS00011F
