IS00011C ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 15, 2018
;Part 4
;Copyright 2018 SAIC
EN 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
;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
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 OBXPR^BYIMSEG1
;SET OBX1 = INSGX\^INTHL7FT(1,3)\\2\@OBXPR1
S D0=INDA S X=$G(INA("OBXPR1",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
S @INV@("OBX1")=X K DXS,D0
;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXPR2
S D0=INDA S X=$G(INA("OBXPR2",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\@OBXPR3
S D0=INDA S X=$G(INA("OBXPR3",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)\\2\@OBXPR4
S D0=INDA S X=$G(INA("OBXPR4",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
S @INV@("OBX4")=X K DXS,D0
;SET OBX5 = INSGX\^INTHL7FT(1,3)\\8\@OBXPR5
S D0=INDA S X=$G(INA("OBXPR5",INI(1)))
S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,8)
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
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
Q
I1 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
IS00011C ;Compiled from script 'Generated: HL IHS IZV04 OUT-O' on AUG 15, 2018
+1 ;Part 4
+2 ;Copyright 2018 SAIC
EN DO RXR^BYIMSEGS
+1 ;SET RXR1 = INSGX\^INTHL7FT(1,3)\\50\@RXR1
+2 SET D0=INDA
SET X=$GET(INA("RXR1",INI(1)))
+3 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+4 SET @INV@("RXR1")=X
KILL DXS,D0
+5 ;SET RXR2 = INSGX\^INTHL7FT(1,3)\\250\@RXR2
+6 SET D0=INDA
SET X=$GET(INA("RXR2",INI(1)))
+7 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+8 SET @INV@("RXR2")=X
KILL DXS,D0
+9 IF 'INVS
DO MC^INHS
+10 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=""
+11 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)
+12 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+13 SET INSETID=0
+14 DO OBXCE^BYIMSEG1
+15 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXCE1
+16 SET D0=INDA
SET X=$GET(INA("OBXCE1",INI(1)))
+17 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+18 SET @INV@("OBX1")=X
KILL DXS,D0
+19 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXCE2
+20 SET D0=INDA
SET X=$GET(INA("OBXCE2",INI(1)))
+21 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+22 SET @INV@("OBX2")=X
KILL DXS,D0
+23 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXCE3
+24 SET D0=INDA
SET X=$GET(INA("OBXCE3",INI(1)))
+25 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+26 SET @INV@("OBX3")=X
KILL DXS,D0
+27 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\20\@OBXCE4
+28 SET D0=INDA
SET X=$GET(INA("OBXCE4",INI(1)))
+29 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+30 SET @INV@("OBX4")=X
KILL DXS,D0
+31 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\50\@OBXCE5
+32 SET D0=INDA
SET X=$GET(INA("OBXCE5",INI(1)))
+33 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+34 SET @INV@("OBX5")=X
KILL DXS,D0
+35 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXCE11
+36 SET D0=INDA
SET X=$GET(INA("OBXCE11",INI(1)))
+37 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+38 SET @INV@("OBX11")=X
KILL DXS,D0
+39 ;SET OBX14 = INSGX\^INTHL7FT(1,3)\\26\@OBXCE14
+40 SET D0=INDA
SET X=$GET(INA("OBXCE14",INI(1)))
+41 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+42 SET @INV@("OBX14")=X
KILL DXS,D0
+43 ;SET OBX17 = INSGX\^INTHL7FT(1,3)\\100\@OBXCE17
+44 SET D0=INDA
SET X=$GET(INA("OBXCE17",INI(1)))
+45 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,100)
+46 SET @INV@("OBX17")=X
KILL DXS,D0
+47 IF 'INVS
DO MC^INHS
+48 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=""
+49 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"))
+50 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)
+51 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)
+52 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=""
+53 DO SETPIECE^INHU(.LINE,DELIM,18,L1,.CP)
+54 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+55 SET INSETID=0
+56 DO OBXFS^BYIMSEG1
+57 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\10\@OBXFS1
+58 SET D0=INDA
SET X=$GET(INA("OBXFS1",INI(1)))
+59 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,10)
+60 SET @INV@("OBX1")=X
KILL DXS,D0
+61 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXFS2
+62 SET D0=INDA
SET X=$GET(INA("OBXFS2",INI(1)))
+63 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+64 SET @INV@("OBX2")=X
KILL DXS,D0
+65 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXFS3
+66 SET D0=INDA
SET X=$GET(INA("OBXFS3",INI(1)))
+67 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+68 SET @INV@("OBX3")=X
KILL DXS,D0
+69 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\20\@OBXFS4
+70 SET D0=INDA
SET X=$GET(INA("OBXFS4",INI(1)))
+71 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,20)
+72 SET @INV@("OBX4")=X
KILL DXS,D0
+73 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\50\@OBXFS5
+74 SET D0=INDA
SET X=$GET(INA("OBXFS5",INI(1)))
+75 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,50)
+76 SET @INV@("OBX5")=X
KILL DXS,D0
+77 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXFS11
+78 SET D0=INDA
SET X=$GET(INA("OBXFS11",INI(1)))
+79 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+80 SET @INV@("OBX11")=X
KILL DXS,D0
+81 ;SET OBX14 = INSGX\^INTHL7FT(1,3)\\26\@OBXFS14
+82 SET D0=INDA
SET X=$GET(INA("OBXFS14",INI(1)))
+83 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,26)
+84 SET @INV@("OBX14")=X
KILL DXS,D0
+85 IF 'INVS
DO MC^INHS
+86 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=""
+87 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"))
+88 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)
+89 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)
+90 SET L1=$GET(@INV@("OBX14"))
IF $TRANSLATE(L1,$GET(SUBDELIM))=""
SET L1=""
DO SETPIECE^INHU(.LINE,DELIM,15,L1,.CP)
+91 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+92 SET INSETID=0
+93 DO OBXTY^BYIMSEG1
+94 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY1
+95 SET D0=INDA
SET X=$GET(INA("OBXTY1",INI(1)))
+96 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+97 SET @INV@("OBX1")=X
KILL DXS,D0
+98 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY2
+99 SET D0=INDA
SET X=$GET(INA("OBXTY2",INI(1)))
+100 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+101 SET @INV@("OBX2")=X
KILL DXS,D0
+102 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY3
+103 SET D0=INDA
SET X=$GET(INA("OBXTY3",INI(1)))
+104 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+105 SET @INV@("OBX3")=X
KILL DXS,D0
+106 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY4
+107 SET D0=INDA
SET X=$GET(INA("OBXTY4",INI(1)))
+108 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+109 SET @INV@("OBX4")=X
KILL DXS,D0
+110 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY5
+111 SET D0=INDA
SET X=$GET(INA("OBXTY5",INI(1)))
+112 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+113 SET @INV@("OBX5")=X
KILL DXS,D0
+114 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\99\@OBXTY11
+115 SET D0=INDA
SET X=$GET(INA("OBXTY11",INI(1)))
+116 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,99)
+117 SET @INV@("OBX11")=X
KILL DXS,D0
+118 IF 'INVS
DO MC^INHS
+119 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=""
+120 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"))
+121 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)
+122 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)
+123 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+124 SET INSETID=0
+125 DO OBXPB^BYIMSEG1
+126 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB1
+127 SET D0=INDA
SET X=$GET(INA("OBXPB1",INI(1)))
+128 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+129 SET @INV@("OBX1")=X
KILL DXS,D0
+130 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB2
+131 SET D0=INDA
SET X=$GET(INA("OBXPB2",INI(1)))
+132 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+133 SET @INV@("OBX2")=X
KILL DXS,D0
+134 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB3
+135 SET D0=INDA
SET X=$GET(INA("OBXPB3",INI(1)))
+136 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+137 SET @INV@("OBX3")=X
KILL DXS,D0
+138 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB4
+139 SET D0=INDA
SET X=$GET(INA("OBXPB4",INI(1)))
+140 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+141 SET @INV@("OBX4")=X
KILL DXS,D0
+142 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\250\@OBXPB5
+143 SET D0=INDA
SET X=$GET(INA("OBXPB5",INI(1)))
+144 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+145 SET @INV@("OBX5")=X
KILL DXS,D0
+146 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXFS11
+147 SET D0=INDA
SET X=$GET(INA("OBXFS11",INI(1)))
+148 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+149 SET @INV@("OBX11")=X
KILL DXS,D0
+150 IF 'INVS
DO MC^INHS
+151 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=""
+152 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"))
+153 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)
+154 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)
+155 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+156 SET INSETID=0
+157 DO OBXPR^BYIMSEG1
+158 ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\2\@OBXPR1
+159 SET D0=INDA
SET X=$GET(INA("OBXPR1",INI(1)))
+160 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+161 SET @INV@("OBX1")=X
KILL DXS,D0
+162 ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\2\@OBXPR2
+163 SET D0=INDA
SET X=$GET(INA("OBXPR2",INI(1)))
+164 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+165 SET @INV@("OBX2")=X
KILL DXS,D0
+166 ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\250\@OBXPR3
+167 SET D0=INDA
SET X=$GET(INA("OBXPR3",INI(1)))
+168 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,250)
+169 SET @INV@("OBX3")=X
KILL DXS,D0
+170 ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\2\@OBXPR4
+171 SET D0=INDA
SET X=$GET(INA("OBXPR4",INI(1)))
+172 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,2)
+173 SET @INV@("OBX4")=X
KILL DXS,D0
+174 ;SET OBX5 = INSGX\^INTHL7FT(1,3)\\8\@OBXPR5
+175 SET D0=INDA
SET X=$GET(INA("OBXPR5",INI(1)))
+176 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,8)
+177 SET @INV@("OBX5")=X
KILL DXS,D0
+178 ;SET OBX11 = INSGX\^INTHL7FT(1,3)\\5\@OBXFS11
+179 SET D0=INDA
SET X=$GET(INA("OBXFS11",INI(1)))
+180 SET X1="^INTHL7FT(1,3)"
IF $LENGTH($GET(@X1))
XECUTE $GET(@X1)
SET X=$EXTRACT(X,1,5)
+181 SET @INV@("OBX11")=X
KILL DXS,D0
+182 IF 'INVS
DO MC^INHS
+183 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=""
+184 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"))
+185 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)
+186 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)
+187 SET LCT=LCT+1
SET ^UTILITY("INH",$JOB,LCT)=LINE
IF $DATA(LINE)>9
MERGE ^UTILITY("INH",$JOB,LCT)=LINE
+188 QUIT
I1 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
