IS00011F ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 03, 2015
;Part 7
;Copyright 2015 SAIC
EN ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXCE3
S D0=INDA S X=$G(INA("OBXCE3",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("OBX3")=X K DXS,D0
;SET OBX4 = INSGX\^INTHL7FT(1,3)\\20\@OBXCE4
S D0=INDA S X=$G(INA("OBXCE4",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
S @INV@("OBX4")=X K DXS,D0
;SET OBX5 = INSGX\^INTHL7FT(1,3)\\50\@OBXCE5
S D0=INDA S X=$G(INA("OBXCE5",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("OBX5")=X K DXS,D0
;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXCE11
S D0=INDA S X=$G(INA("OBXCE11",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,5)
S @INV@("OBX11")=X K DXS,D0
;SET OBX14 = INSGX\^INTHL7FT(1,3)\\26\@OBXCE14
S D0=INDA S X=$G(INA("OBXCE14",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
S @INV@("OBX14")=X K DXS,D0
;SET OBX17 = INSGX\^INTHL7FT(1,3)\\100\@OBXCE17
S D0=INDA S X=$G(INA("OBXCE17",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,100)
S @INV@("OBX17")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="OBX" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("OBX1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("OBX2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("OBX3"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("OBX4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
S L1=$G(@INV@("OBX5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("OBX11")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
S L1=$G(@INV@("OBX14")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,15,L1,.CP) S L1=$G(@INV@("OBX17")) 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 OBXFS^BYIMSEG1
;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXFS1
S D0=INDA S X=$G(INA("OBXFS1",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\@OBXFS2
S D0=INDA S X=$G(INA("OBXFS2",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
;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXFS3
S D0=INDA S X=$G(INA("OBXFS3",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("OBX3")=X K DXS,D0
;SET OBX4 = INSGX\^INTHL7FT(1,3)\\20\@OBXFS4
S D0=INDA S X=$G(INA("OBXFS4",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,20)
S @INV@("OBX4")=X K DXS,D0
;SET OBX5 = INSGX\^INTHL7FT(1,3)\\50\@OBXFS5
S D0=INDA S X=$G(INA("OBXFS5",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,50)
S @INV@("OBX5")=X K DXS,D0
;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXFS11
S D0=INDA S X=$G(INA("OBXFS11",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,5)
S @INV@("OBX11")=X K DXS,D0
;SET OBX14 = INSGX\^INTHL7FT(1,3)\\26\@OBXFS14
S D0=INDA S X=$G(INA("OBXFS14",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,26)
S @INV@("OBX14")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="OBX" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("OBX1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("OBX2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("OBX3"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("OBX4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
S L1=$G(@INV@("OBX5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("OBX11")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
S L1=$G(@INV@("OBX14")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,15,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 OBXTY^BYIMSEG1
;SET OBX1 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY1
S D0=INDA S X=$G(INA("OBXTY1",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("OBX1")=X K DXS,D0
;SET OBX2 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY2
S D0=INDA S X=$G(INA("OBXTY2",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("OBX2")=X K DXS,D0
;SET OBX3 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY3
S D0=INDA S X=$G(INA("OBXTY3",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("OBX3")=X K DXS,D0
;SET OBX4 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY4
S D0=INDA S X=$G(INA("OBXTY4",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("OBX4")=X K DXS,D0
;SET OBX5 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY5
S D0=INDA S X=$G(INA("OBXTY5",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("OBX5")=X K DXS,D0
;SET OBX11 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY11
S D0=INDA S X=$G(INA("OBXTY11",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,99)
S @INV@("OBX11")=X K DXS,D0
D:'INVS MC^INHS
K LINE S LINE="",CP=0 S L1="OBX" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("OBX1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("OBX2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("OBX3"))
S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("OBX4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
S L1=$G(@INV@("OBX5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("OBX11")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,12,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 OBXPB^BYIMSEG1
;SET OBX1 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB1
S D0=INDA S X=$G(INA("OBXPB1",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("OBX1")=X K DXS,D0
;SET OBX2 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB2
S D0=INDA S X=$G(INA("OBXPB2",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("OBX2")=X K DXS,D0
;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB3
S D0=INDA S X=$G(INA("OBXPB3",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("OBX3")=X K DXS,D0
;SET OBX4 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB4
S D0=INDA S X=$G(INA("OBXPB4",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("OBX4")=X K DXS,D0
;SET OBX5 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB5
S D0=INDA S X=$G(INA("OBXPB5",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,250)
S @INV@("OBX5")=X K DXS,D0
;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXFS11
S D0=INDA S X=$G(INA("OBXFS11",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,5)
S @INV@("OBX11")=X K DXS,D0
D:'INVS MC^INHS
9 G EN^IS00011G
IS00011F ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 03, 2015
+1 ;Part 7
+2 ;Copyright 2015 SAIC
EN ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXCE3
+1 SET D0=INDA
SET X=$GET(INA("OBXCE3",INI(1)))
+2 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+3 SET @INV@("OBX3")=X
KILL DXS,D0
+4 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\20\@OBXCE4
+5 SET D0=INDA
SET X=$GET(INA("OBXCE4",INI(1)))
+6 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+7 SET @INV@("OBX4")=X
KILL DXS,D0
+8 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\50\@OBXCE5
+9 SET D0=INDA
SET X=$GET(INA("OBXCE5",INI(1)))
+10 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+11 SET @INV@("OBX5")=X
KILL DXS,D0
+12 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXCE11
+13 SET D0=INDA
SET X=$GET(INA("OBXCE11",INI(1)))
+14 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+15 SET @INV@("OBX11")=X
KILL DXS,D0
+16 ;SET OBX14 = INSGX\^INTHL7FT(1,3)\\26\@OBXCE14
+17 SET D0=INDA
SET X=$GET(INA("OBXCE14",INI(1)))
+18 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+19 SET @INV@("OBX14")=X
KILL DXS,D0
+20 ;SET OBX17 = INSGX\^INTHL7FT(1,3)\\100\@OBXCE17
+21 SET D0=INDA
SET X=$GET(INA("OBXCE17",INI(1)))
+22 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,100)
+23 SET @INV@("OBX17")=X
KILL DXS,D0
+24 IF 'INVS
DO MC^INHS
+25 KILL LINE
SET LINE=""
SET CP=0
SET L1="OBX"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("OBX1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+26 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("OBX2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("OBX3"))
+27 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("OBX4"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
+28 SET L1=$GET(@INV@("OBX5"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
SET L1=$GET(@INV@("OBX11"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
+29 SET L1=$GET(@INV@("OBX14"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
SET L1=$GET(@INV@("OBX17"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+30 DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
+31 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+32 SET INSETID=0
+33 DO OBXFS^BYIMSEG1
+34 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXFS1
+35 SET D0=INDA
SET X=$GET(INA("OBXFS1",INI(1)))
+36 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+37 SET @INV@("OBX1")=X
KILL DXS,D0
+38 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXFS2
+39 SET D0=INDA
SET X=$GET(INA("OBXFS2",INI(1)))
+40 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+41 SET @INV@("OBX2")=X
KILL DXS,D0
+42 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXFS3
+43 SET D0=INDA
SET X=$GET(INA("OBXFS3",INI(1)))
+44 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+45 SET @INV@("OBX3")=X
KILL DXS,D0
+46 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\20\@OBXFS4
+47 SET D0=INDA
SET X=$GET(INA("OBXFS4",INI(1)))
+48 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+49 SET @INV@("OBX4")=X
KILL DXS,D0
+50 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\50\@OBXFS5
+51 SET D0=INDA
SET X=$GET(INA("OBXFS5",INI(1)))
+52 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+53 SET @INV@("OBX5")=X
KILL DXS,D0
+54 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXFS11
+55 SET D0=INDA
SET X=$GET(INA("OBXFS11",INI(1)))
+56 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+57 SET @INV@("OBX11")=X
KILL DXS,D0
+58 ;SET OBX14 = INSGX\^INTHL7FT(1,3)\\26\@OBXFS14
+59 SET D0=INDA
SET X=$GET(INA("OBXFS14",INI(1)))
+60 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+61 SET @INV@("OBX14")=X
KILL DXS,D0
+62 IF 'INVS
DO MC^INHS
+63 KILL LINE
SET LINE=""
SET CP=0
SET L1="OBX"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("OBX1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+64 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("OBX2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("OBX3"))
+65 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("OBX4"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
+66 SET L1=$GET(@INV@("OBX5"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
SET L1=$GET(@INV@("OBX11"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
+67 SET L1=$GET(@INV@("OBX14"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
+68 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+69 SET INSETID=0
+70 DO OBXTY^BYIMSEG1
+71 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY1
+72 SET D0=INDA
SET X=$GET(INA("OBXTY1",INI(1)))
+73 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+74 SET @INV@("OBX1")=X
KILL DXS,D0
+75 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY2
+76 SET D0=INDA
SET X=$GET(INA("OBXTY2",INI(1)))
+77 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+78 SET @INV@("OBX2")=X
KILL DXS,D0
+79 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY3
+80 SET D0=INDA
SET X=$GET(INA("OBXTY3",INI(1)))
+81 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+82 SET @INV@("OBX3")=X
KILL DXS,D0
+83 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY4
+84 SET D0=INDA
SET X=$GET(INA("OBXTY4",INI(1)))
+85 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+86 SET @INV@("OBX4")=X
KILL DXS,D0
+87 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY5
+88 SET D0=INDA
SET X=$GET(INA("OBXTY5",INI(1)))
+89 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+90 SET @INV@("OBX5")=X
KILL DXS,D0
+91 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY11
+92 SET D0=INDA
SET X=$GET(INA("OBXTY11",INI(1)))
+93 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+94 SET @INV@("OBX11")=X
KILL DXS,D0
+95 IF 'INVS
DO MC^INHS
+96 KILL LINE
SET LINE=""
SET CP=0
SET L1="OBX"
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
SET L1=$GET(@INV@("OBX1"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
+97 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
SET L1=$GET(@INV@("OBX2"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
SET L1=$GET(@INV@("OBX3"))
+98 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
SET L1=$GET(@INV@("OBX4"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
+99 SET L1=$GET(@INV@("OBX5"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
SET L1=$GET(@INV@("OBX11"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,12,L1,.CP)
+100 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+101 SET INSETID=0
+102 DO OBXPB^BYIMSEG1
+103 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB1
+104 SET D0=INDA
SET X=$GET(INA("OBXPB1",INI(1)))
+105 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+106 SET @INV@("OBX1")=X
KILL DXS,D0
+107 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB2
+108 SET D0=INDA
SET X=$GET(INA("OBXPB2",INI(1)))
+109 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+110 SET @INV@("OBX2")=X
KILL DXS,D0
+111 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB3
+112 SET D0=INDA
SET X=$GET(INA("OBXPB3",INI(1)))
+113 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+114 SET @INV@("OBX3")=X
KILL DXS,D0
+115 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB4
+116 SET D0=INDA
SET X=$GET(INA("OBXPB4",INI(1)))
+117 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+118 SET @INV@("OBX4")=X
KILL DXS,D0
+119 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB5
+120 SET D0=INDA
SET X=$GET(INA("OBXPB5",INI(1)))
+121 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+122 SET @INV@("OBX5")=X
KILL DXS,D0
+123 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXFS11
+124 SET D0=INDA
SET X=$GET(INA("OBXFS11",INI(1)))
+125 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+126 SET @INV@("OBX11")=X
KILL DXS,D0
+127 IF 'INVS
DO MC^INHS
9 GOTO EN^IS00011G
