- 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