Routine: IS00007I

IS00007I ;Compiled from script 'Generated: HL IHS DW1 A08-O' on SEP 08, 2008

 ;Part 10

 ;Copyright 2008 SAIC

EN S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("ZDP1")=X K DXS,D0

 ;SET ZDP2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDP2

 S D0=INDA S X=$G(INA("BDW1ZDP2",INI(1)))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("ZDP2")=X K DXS,D0

 ;SET ZDP3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDP3

 S D0=INDA S X=$G(INA("BDW1ZDP3",INI(1)))

 S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 S @INV@("ZDP3")=X K DXS,D0

 D:'INVS MC^INHS

 K LINE S LINE="",CP=0 S L1="ZDP" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZDP1")) S:$TR(L1,$G(SUBDELIM))="" L1=""

 D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZDP2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZDP3"))

 S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

 S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE

F1 S INDA=INDA0 K INDA0

 SET INSETID=0

 S INDA0=INDA,INI(1)=0  F  S INI(1)=$O(INDA("ZIM",INI(1))) Q:'INI(1)  S INDA=$S(INDA("ZIM",INI(1)):INDA("ZIM",INI(1)),1:INI(1)) D

 .;SET ZIM1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM1

 .S D0=INDA S X=$G(INA("BDW1ZIM1",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZIM1")=X K DXS,D0

 .;SET ZIM2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM2

 .S D0=INDA S X=$G(INA("BDW1ZIM2",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZIM2")=X K DXS,D0

 .;SET ZIM3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM3

 .S D0=INDA S X=$G(INA("BDW1ZIM3",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZIM3")=X K DXS,D0

 .;SET ZIM4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM4

 .S D0=INDA S X=$G(INA("BDW1ZIM4",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZIM4")=X K DXS,D0

 .;SET ZIM5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM5

 .S D0=INDA S X=$G(INA("BDW1ZIM5",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZIM5")=X K DXS,D0

 .;SET ZIM6 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM6

 .S D0=INDA S X=$G(INA("BDW1ZIM6",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZIM6")=X K DXS,D0

 .D:'INVS MC^INHS

 .K LINE S LINE="",CP=0 S L1="ZIM" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZIM1")) S:$TR(L1,$G(SUBDELIM))="" L1=""

 .D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZIM2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZIM3"))

 .S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ZIM4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)

 .S L1=$G(@INV@("ZIM5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("ZIM6")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)

 .S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE

.Q

 S INDA=INDA0 K INDA0

 SET INSETID=0

 S INDA0=INDA,INI(1)=0  F  S INI(1)=$O(INDA("ZMD",INI(1))) Q:'INI(1)  S INDA=$S(INDA("ZMD",INI(1)):INDA("ZMD",INI(1)),1:INI(1)) D

 .;SET ZMD1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD1

 .S D0=INDA S X=$G(INA("BDW1ZMD1",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZMD1")=X K DXS,D0

 .;SET ZMD2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD2

 .S D0=INDA S X=$G(INA("BDW1ZMD2",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZMD2")=X K DXS,D0

 .;SET ZMD3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD3

 .S D0=INDA S X=$G(INA("BDW1ZMD3",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZMD3")=X K DXS,D0

 .;SET ZMD4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD4

 .S D0=INDA S X=$G(INA("BDW1ZMD4",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZMD4")=X K DXS,D0

 .;SET ZMD5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD5

 .S D0=INDA S X=$G(INA("BDW1ZMD5",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("ZMD5")=X K DXS,D0

 .D:'INVS MC^INHS

 .K LINE S LINE="",CP=0 S L1="ZMD" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZMD1")) S:$TR(L1,$G(SUBDELIM))="" L1=""

 .D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZMD2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZMD3"))

 .S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ZMD4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)

 .S L1=$G(@INV@("ZMD5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)

 .S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE

.Q

 S INDA=INDA0 K INDA0

 SET INSETID=0

 S INDA0=INDA,INI(1)=0  F  S INI(1)=$O(INDA("HEF",INI(1))) Q:'INI(1)  S INDA=$S(INDA("HEF",INI(1)):INDA("HEF",INI(1)),1:INI(1)) D

 .;SET OBX1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF1

 .S D0=INDA S X=$G(INA("BDW1HEF1",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("OBX1")=X K DXS,D0

 .;SET OBX2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF2

 .S D0=INDA S X=$G(INA("BDW1HEF2",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("OBX2")=X K DXS,D0

 .;SET OBX3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF3

 .S D0=INDA S X=$G(INA("BDW1HEF3",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("OBX3")=X K DXS,D0

 .;SET OBX4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF4

 .S D0=INDA S X=$G(INA("BDW1HEF4",INI(1)))

 .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)

 .S @INV@("OBX4")=X K DXS,D0

 .;SET OBX5 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX5")=X K DXS,D0

 .;SET OBX6 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX6")=X K DXS,D0

 .;SET OBX7 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX7")=X K DXS,D0

 .;SET OBX8 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX8")=X K DXS,D0

 .;SET OBX9 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX9")=X K DXS,D0

 .;SET OBX10 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX10")=X K DXS,D0

 .;SET OBX11 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX11")=X K DXS,D0

 .;SET OBX12 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX12")=X K DXS,D0

 .;SET OBX13 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX13")=X K DXS,D0

 .;SET OBX14 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX14")=X K DXS,D0

 .;SET OBX15 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX15")=X K DXS,D0

 .;SET OBX16 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX16")=X K DXS,D0

 .;SET OBX17 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX17")=X K DXS,D0

 .;SET OBX18 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX18")=X K DXS,D0

 .;SET OBX19 = ""

 .S D0=INDA S X=""

 .S @INV@("OBX19")=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)

9 .D EN^IS00007J

 G I1^IS00007J

IS00007I  ;Compiled from script 'Generated: HL IHS DW1 A08-O' on SEP 08, 2008

 +1       ;Part 10

 +2       ;Copyright 2008 SAIC

EN         SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +1        SET @INV@("ZDP1")=X

           KILL DXS,D0

 +2       ;SET ZDP2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDP2

 +3        SET D0=INDA

           SET X=$GET(INA("BDW1ZDP2",INI(1)))

 +4        SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +5        SET @INV@("ZDP2")=X

           KILL DXS,D0

 +6       ;SET ZDP3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZDP3

 +7        SET D0=INDA

           SET X=$GET(INA("BDW1ZDP3",INI(1)))

 +8        SET X1="^INTHL7FT(1,3)"

           IF $LENGTH($GET(@X1))

               XECUTE $GET(@X1)

           SET X=$EXTRACT(X,1,999)

 +9        SET @INV@("ZDP3")=X

           KILL DXS,D0

 +10       IF 'INVS

               DO MC^INHS

 +11       KILL LINE

           SET LINE=""

           SET CP=0

           SET L1="ZDP"

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)

           SET L1=$GET(@INV@("ZDP1"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

 +12       DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)

           SET L1=$GET(@INV@("ZDP2"))

           IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)

           SET L1=$GET(@INV@("ZDP3"))

 +13       IF $TRANSLATE(L1,$GET(SUBDELIM))=""

               SET L1=""

           DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

 +14       SET LCT=LCT+1

           SET ^UTILITY("INH",$JOB,LCT)=LINE

           IF $DATA(LINE)>9

               MERGE ^UTILITY("INH",$JOB,LCT)=LINE

 +15       QUIT

F1         SET INDA=INDA0

           KILL INDA0

 +1        SET INSETID=0

 +2        SET INDA0=INDA

           SET INI(1)=0

FOR

               SET INI(1)=$ORDER(INDA("ZIM",INI(1)))

               IF 'INI(1)

                   QUIT

               SET INDA=$SELECT(INDA("ZIM",INI(1)):INDA("ZIM",INI(1)),1:INI(1))

               Begin DoDot:1

 +3       ;SET ZIM1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM1

 +4                SET D0=INDA

                   SET X=$GET(INA("BDW1ZIM1",INI(1)))

 +5                SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +6                SET @INV@("ZIM1")=X

                   KILL DXS,D0

 +7       ;SET ZIM2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM2

 +8                SET D0=INDA

                   SET X=$GET(INA("BDW1ZIM2",INI(1)))

 +9                SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +10               SET @INV@("ZIM2")=X

                   KILL DXS,D0

 +11      ;SET ZIM3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM3

 +12               SET D0=INDA

                   SET X=$GET(INA("BDW1ZIM3",INI(1)))

 +13               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +14               SET @INV@("ZIM3")=X

                   KILL DXS,D0

 +15      ;SET ZIM4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM4

 +16               SET D0=INDA

                   SET X=$GET(INA("BDW1ZIM4",INI(1)))

 +17               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +18               SET @INV@("ZIM4")=X

                   KILL DXS,D0

 +19      ;SET ZIM5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM5

 +20               SET D0=INDA

                   SET X=$GET(INA("BDW1ZIM5",INI(1)))

 +21               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +22               SET @INV@("ZIM5")=X

                   KILL DXS,D0

 +23      ;SET ZIM6 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZIM6

 +24               SET D0=INDA

                   SET X=$GET(INA("BDW1ZIM6",INI(1)))

 +25               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +26               SET @INV@("ZIM6")=X

                   KILL DXS,D0

 +27               IF 'INVS

                       DO MC^INHS

 +28               KILL LINE

                   SET LINE=""

                   SET CP=0

                   SET L1="ZIM"

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)

                   SET L1=$GET(@INV@("ZIM1"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

 +29               DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)

                   SET L1=$GET(@INV@("ZIM2"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)

                   SET L1=$GET(@INV@("ZIM3"))

 +30               IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

                   SET L1=$GET(@INV@("ZIM4"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)

 +31               SET L1=$GET(@INV@("ZIM5"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)

                   SET L1=$GET(@INV@("ZIM6"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)

 +32               SET LCT=LCT+1

                   SET ^UTILITY("INH",$JOB,LCT)=LINE

                   IF $DATA(LINE)>9

                       MERGE ^UTILITY("INH",$JOB,LCT)=LINE

 +33               QUIT

               End DoDot:1

 +34       SET INDA=INDA0

           KILL INDA0

 +35       SET INSETID=0

 +36       SET INDA0=INDA

           SET INI(1)=0

FOR

               SET INI(1)=$ORDER(INDA("ZMD",INI(1)))

               IF 'INI(1)

                   QUIT

               SET INDA=$SELECT(INDA("ZMD",INI(1)):INDA("ZMD",INI(1)),1:INI(1))

               Begin DoDot:1

 +37      ;SET ZMD1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD1

 +38               SET D0=INDA

                   SET X=$GET(INA("BDW1ZMD1",INI(1)))

 +39               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +40               SET @INV@("ZMD1")=X

                   KILL DXS,D0

 +41      ;SET ZMD2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD2

 +42               SET D0=INDA

                   SET X=$GET(INA("BDW1ZMD2",INI(1)))

 +43               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +44               SET @INV@("ZMD2")=X

                   KILL DXS,D0

 +45      ;SET ZMD3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD3

 +46               SET D0=INDA

                   SET X=$GET(INA("BDW1ZMD3",INI(1)))

 +47               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +48               SET @INV@("ZMD3")=X

                   KILL DXS,D0

 +49      ;SET ZMD4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD4

 +50               SET D0=INDA

                   SET X=$GET(INA("BDW1ZMD4",INI(1)))

 +51               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +52               SET @INV@("ZMD4")=X

                   KILL DXS,D0

 +53      ;SET ZMD5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZMD5

 +54               SET D0=INDA

                   SET X=$GET(INA("BDW1ZMD5",INI(1)))

 +55               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +56               SET @INV@("ZMD5")=X

                   KILL DXS,D0

 +57               IF 'INVS

                       DO MC^INHS

 +58               KILL LINE

                   SET LINE=""

                   SET CP=0

                   SET L1="ZMD"

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)

                   SET L1=$GET(@INV@("ZMD1"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

 +59               DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)

                   SET L1=$GET(@INV@("ZMD2"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)

                   SET L1=$GET(@INV@("ZMD3"))

 +60               IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)

                   SET L1=$GET(@INV@("ZMD4"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)

 +61               SET L1=$GET(@INV@("ZMD5"))

                   IF $TRANSLATE(L1,$GET(SUBDELIM))=""

                       SET L1=""

                   DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)

 +62               SET LCT=LCT+1

                   SET ^UTILITY("INH",$JOB,LCT)=LINE

                   IF $DATA(LINE)>9

                       MERGE ^UTILITY("INH",$JOB,LCT)=LINE

 +63               QUIT

               End DoDot:1

 +64       SET INDA=INDA0

           KILL INDA0

 +65       SET INSETID=0

 +66       SET INDA0=INDA

           SET INI(1)=0

FOR

               SET INI(1)=$ORDER(INDA("HEF",INI(1)))

               IF 'INI(1)

                   QUIT

               SET INDA=$SELECT(INDA("HEF",INI(1)):INDA("HEF",INI(1)),1:INI(1))

               Begin DoDot:1

 +67      ;SET OBX1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF1

 +68               SET D0=INDA

                   SET X=$GET(INA("BDW1HEF1",INI(1)))

 +69               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +70               SET @INV@("OBX1")=X

                   KILL DXS,D0

 +71      ;SET OBX2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF2

 +72               SET D0=INDA

                   SET X=$GET(INA("BDW1HEF2",INI(1)))

 +73               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +74               SET @INV@("OBX2")=X

                   KILL DXS,D0

 +75      ;SET OBX3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF3

 +76               SET D0=INDA

                   SET X=$GET(INA("BDW1HEF3",INI(1)))

 +77               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +78               SET @INV@("OBX3")=X

                   KILL DXS,D0

 +79      ;SET OBX4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1HEF4

 +80               SET D0=INDA

                   SET X=$GET(INA("BDW1HEF4",INI(1)))

 +81               SET X1="^INTHL7FT(1,3)"

                   IF $LENGTH($GET(@X1))

                       XECUTE $GET(@X1)

                   SET X=$EXTRACT(X,1,999)

 +82               SET @INV@("OBX4")=X

                   KILL DXS,D0

 +83      ;SET OBX5 = ""

 +84               SET D0=INDA

                   SET X=""

 +85               SET @INV@("OBX5")=X

                   KILL DXS,D0

 +86      ;SET OBX6 = ""

 +87               SET D0=INDA

                   SET X=""

 +88               SET @INV@("OBX6")=X

                   KILL DXS,D0

 +89      ;SET OBX7 = ""

 +90               SET D0=INDA

                   SET X=""

 +91               SET @INV@("OBX7")=X

                   KILL DXS,D0

 +92      ;SET OBX8 = ""

 +93               SET D0=INDA

                   SET X=""

 +94               SET @INV@("OBX8")=X

                   KILL DXS,D0

 +95      ;SET OBX9 = ""

 +96               SET D0=INDA

                   SET X=""

 +97               SET @INV@("OBX9")=X

                   KILL DXS,D0

 +98      ;SET OBX10 = ""

 +99               SET D0=INDA

                   SET X=""

 +100              SET @INV@("OBX10")=X

                   KILL DXS,D0

 +101     ;SET OBX11 = ""

 +102              SET D0=INDA

                   SET X=""

 +103              SET @INV@("OBX11")=X

                   KILL DXS,D0

 +104     ;SET OBX12 = ""

 +105              SET D0=INDA

                   SET X=""

 +106              SET @INV@("OBX12")=X

                   KILL DXS,D0

 +107     ;SET OBX13 = ""

 +108              SET D0=INDA

                   SET X=""

 +109              SET @INV@("OBX13")=X

                   KILL DXS,D0

 +110     ;SET OBX14 = ""

 +111              SET D0=INDA

                   SET X=""

 +112              SET @INV@("OBX14")=X

                   KILL DXS,D0

 +113     ;SET OBX15 = ""

 +114              SET D0=INDA

                   SET X=""

 +115              SET @INV@("OBX15")=X

                   KILL DXS,D0

 +116     ;SET OBX16 = ""

 +117              SET D0=INDA

                   SET X=""

 +118              SET @INV@("OBX16")=X

                   KILL DXS,D0

 +119     ;SET OBX17 = ""

 +120              SET D0=INDA

                   SET X=""

 +121              SET @INV@("OBX17")=X

                   KILL DXS,D0

 +122     ;SET OBX18 = ""

 +123              SET D0=INDA

                   SET X=""

 +124              SET @INV@("OBX18")=X

                   KILL DXS,D0

 +125     ;SET OBX19 = ""

 +126              SET D0=INDA

                   SET X=""

 +127              SET @INV@("OBX19")=X

                   KILL DXS,D0

 +128              IF 'INVS

                       DO MC^INHS

 +129              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=""

 +130              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"))

 +131              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)

9                  DO EN^IS00007J

               End DoDot:1

 +1        GOTO I1^IS00007J

IS00007I.m