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
Q
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
