- IS00008(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: HL IHS DW1 HEADER-O' on SEP 08, 2008
- ;Part 1
- ;Copyright 2008 SAIC
- EN S X="ERROR^IS00008",@^%ZOSF("TRAP")
- G START
- ERROR ;
- S X="",@^%ZOSF("TRAP") X ^INTHOS(1,3) D ERROR^INHS($$GETERR^%ZTOS)
- Q 2
- START ;Initialize variables
- K ^UTILITY("INH",$J) S (MESSID,INA("MESSID"))=$$MESSID^INHD
- K INUIF6 M INUIF6=INDA
- K INREQERR,INHERR,INHERCNT,INV D SETDT^UTDT S DUZ(0)="@",DUZ("AG")="^1",DTIME=1 S (LCT,GERR)=0,INMODE="O",INVS=$P(^INRHSITE(1,0),U,12),INV=$S(INVS<2:"INV",1:"^UTILITY(""INV"",$J)"),(MULT,INSTERR)=0
- S INHLDUZ=$O(^VA(200,"B","GIS,USER",0)),DUZ=$S($G(INHLDUZ):INHLDUZ,1:.5)
- S BHLMIEN="12423"
- I $G(^INTHL7M(BHLMIEN,4,1,0))]"" X $G(^INTHL7M(BHLMIEN,4,1,0))
- K INSETID
- S INSMIN=$S($P($G(^INRHSITE(1,0)),U,14):$P(^(0),U,14),1:2500)
- S (DELIM,INDELIM)=$$FIELD^INHUT(),(SUBDELIM,INSUBDEL)=$$COMP^INHUT(),INSUBCOM=$$SUBCOMP^INHUT()
- S INDELIMS=$$FIELD^INHUT_$$COMP^INHUT_$$REP^INHUT_$$ESC^INHUT_$$SUBCOMP^INHUT
- ;Entering MUMPS section.
- D HDR^BDWBHL,^BHLMSH
- ;Entering DATA section.
- S DELIM="|"
- S SUBDELIM="^"
- SET INSETID=0
- ;SET BHS1 = INSGX\^INTHL7F(16685,5)\\4\@ENC
- S D0=INDA S X=$G(INA("ENC"))
- S X1="^INTHL7F(16685,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
- S @INV@("BHS1")=X K DXS,D0
- ;SET BHS2 = INSGX\^INTHL7FT(1,3)\\4\"RPMS"
- S D0=INDA S X="RPMS"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
- S @INV@("BHS2")=X K DXS,D0
- ;SET BHS3 = INSGX\^INTHL7F(16687,5)\\999\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16687,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BHS3")=X K DXS,D0
- ;SET BHS4 = INSGX\^INTHL7FT(1,3)\\999\"DW1"
- S D0=INDA S X="DW1"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BHS4")=X K DXS,D0
- ;SET BHS5 = INSGX\^INTHL7FT(1,3)\\999\"IHS"
- S D0=INDA S X="IHS"
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BHS5")=X K DXS,D0
- ;SET BHS6 = INSGX\^INTHL7F(16690,5)\\999\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16690,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BHS6")=X K DXS,D0
- ;SET BHS8 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BHS9
- S D0=INDA S X=$G(INA("BDW1BHS9"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BHS8")=X K DXS,D0
- ;SET BHS9 = INSGX\^INTHL7F(16692,5)\\999\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(16692,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BHS9")=X K DXS,D0
- ;SET BHS10 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BHS11
- S D0=INDA S X=$G(INA("BDW1BHS11"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BHS10")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="BHS" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("BHS1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("BHS2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("BHS3"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("BHS4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- S L1=$G(@INV@("BHS5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("BHS6")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- S L1=$G(@INV@("BHS8")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,9,L1,.CP) S L1=$G(@INV@("BHS9")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- S L1=$G(@INV@("BHS10")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- S LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- SET INSETID=0
- ;SET ZHS1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS1
- S D0=INDA S X=$G(INA("BDW1ZHS1"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZHS1")=X K DXS,D0
- ;SET ZHS2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS2
- S D0=INDA S X=$G(INA("BDW1ZHS2"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZHS2")=X K DXS,D0
- ;SET ZHS3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS3
- S D0=INDA S X=$G(INA("BDW1ZHS3"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZHS3")=X K DXS,D0
- ;SET ZHS4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS4
- S D0=INDA S X=$G(INA("BDW1ZHS4"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZHS4")=X K DXS,D0
- ;SET ZHS5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS5
- S D0=INDA S X=$G(INA("BDW1ZHS5"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZHS5")=X K DXS,D0
- ;SET ZHS6 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS6
- S D0=INDA S X=$G(INA("BDW1ZHS6"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZHS6")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="ZHS" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZHS1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZHS2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZHS3"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ZHS4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- S L1=$G(@INV@("ZHS5")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,6,L1,.CP) S L1=$G(@INV@("ZHS6")) 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
- 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
- IS00008(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: HL IHS DW1 HEADER-O' on SEP 08, 2008
- +1 ;Part 1
- +2 ;Copyright 2008 SAIC
- EN SET X="ERROR^IS00008"
- SET @^%ZOSF("TRAP")
- +1 GOTO START
- ERROR ;
- +1 SET X=""
- SET @^%ZOSF("TRAP")
- XECUTE ^INTHOS(1,3)
- DO ERROR^INHS($$GETERR^%ZTOS)
- +2 QUIT 2
- START ;Initialize variables
- +1 KILL ^UTILITY("INH",$JOB)
- SET (MESSID,INA("MESSID"))=$$MESSID^INHD
- +2 KILL INUIF6
- MERGE INUIF6=INDA
- +3 KILL INREQERR,INHERR,INHERCNT,INV
- DO SETDT^UTDT
- SET DUZ(0)="@"
- SET DUZ("AG")="^1"
- SET DTIME=1
- SET (LCT,GERR)=0
- SET INMODE="O"
- SET INVS=$PIECE(^INRHSITE(1,0),U,12)
- SET INV=$SELECT(INVS<2:"INV",1:"^UTILITY(""INV"",$J)")
- SET (MULT,INSTERR)=0
- +4 SET INHLDUZ=$ORDER(^VA(200,"B","GIS,USER",0))
- SET DUZ=$SELECT($GET(INHLDUZ):INHLDUZ,1:.5)
- +5 SET BHLMIEN="12423"
- +6 IF $GET(^INTHL7M(BHLMIEN,4,1,0))]""
- XECUTE $GET(^INTHL7M(BHLMIEN,4,1,0))
- +7 KILL INSETID
- +8 SET INSMIN=$SELECT($PIECE($GET(^INRHSITE(1,0)),U,14):$PIECE(^(0),U,14),1:2500)
- +9 SET (DELIM,INDELIM)=$$FIELD^INHUT()
- SET (SUBDELIM,INSUBDEL)=$$COMP^INHUT()
- SET INSUBCOM=$$SUBCOMP^INHUT()
- +10 SET INDELIMS=$$FIELD^INHUT_$$COMP^INHUT_$$REP^INHUT_$$ESC^INHUT_$$SUBCOMP^INHUT
- +11 ;Entering MUMPS section.
- +12 DO HDR^BDWBHL
- DO ^BHLMSH
- +13 ;Entering DATA section.
- +14 SET DELIM="|"
- +15 SET SUBDELIM="^"
- +16 SET INSETID=0
- +17 ;SET BHS1 = INSGX\^INTHL7F(16685,5)\\4\@ENC
- +18 SET D0=INDA
- SET X=$GET(INA("ENC"))
- +19 SET X1="^INTHL7F(16685,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,4)
- +20 SET @INV@("BHS1")=X
- KILL DXS,D0
- +21 ;SET BHS2 = INSGX\^INTHL7FT(1,3)\\4\"RPMS"
- +22 SET D0=INDA
- SET X="RPMS"
- +23 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,4)
- +24 SET @INV@("BHS2")=X
- KILL DXS,D0
- +25 ;SET BHS3 = INSGX\^INTHL7F(16687,5)\\999\"OUTPUT TRANSFORM"
- +26 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +27 SET X1="^INTHL7F(16687,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +28 SET @INV@("BHS3")=X
- KILL DXS,D0
- +29 ;SET BHS4 = INSGX\^INTHL7FT(1,3)\\999\"DW1"
- +30 SET D0=INDA
- SET X="DW1"
- +31 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +32 SET @INV@("BHS4")=X
- KILL DXS,D0
- +33 ;SET BHS5 = INSGX\^INTHL7FT(1,3)\\999\"IHS"
- +34 SET D0=INDA
- SET X="IHS"
- +35 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +36 SET @INV@("BHS5")=X
- KILL DXS,D0
- +37 ;SET BHS6 = INSGX\^INTHL7F(16690,5)\\999\"OUTPUT TRANSFORM"
- +38 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +39 SET X1="^INTHL7F(16690,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +40 SET @INV@("BHS6")=X
- KILL DXS,D0
- +41 ;SET BHS8 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BHS9
- +42 SET D0=INDA
- SET X=$GET(INA("BDW1BHS9"))
- +43 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +44 SET @INV@("BHS8")=X
- KILL DXS,D0
- +45 ;SET BHS9 = INSGX\^INTHL7F(16692,5)\\999\"OUTPUT TRANSFORM"
- +46 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +47 SET X1="^INTHL7F(16692,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +48 SET @INV@("BHS9")=X
- KILL DXS,D0
- +49 ;SET BHS10 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BHS11
- +50 SET D0=INDA
- SET X=$GET(INA("BDW1BHS11"))
- +51 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +52 SET @INV@("BHS10")=X
- KILL DXS,D0
- +53 IF 'INVS
- DO MC^INHS
- +54 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="BHS"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("BHS1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +55 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("BHS2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("BHS3"))
- +56 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("BHS4"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- +57 SET L1=$GET(@INV@("BHS5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- SET L1=$GET(@INV@("BHS6"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- +58 SET L1=$GET(@INV@("BHS8"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,9,L1,.CP)
- SET L1=$GET(@INV@("BHS9"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,10,L1,.CP)
- +59 SET L1=$GET(@INV@("BHS10"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,11,L1,.CP)
- +60 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +61 SET INSETID=0
- +62 ;SET ZHS1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS1
- +63 SET D0=INDA
- SET X=$GET(INA("BDW1ZHS1"))
- +64 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +65 SET @INV@("ZHS1")=X
- KILL DXS,D0
- +66 ;SET ZHS2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS2
- +67 SET D0=INDA
- SET X=$GET(INA("BDW1ZHS2"))
- +68 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +69 SET @INV@("ZHS2")=X
- KILL DXS,D0
- +70 ;SET ZHS3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS3
- +71 SET D0=INDA
- SET X=$GET(INA("BDW1ZHS3"))
- +72 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +73 SET @INV@("ZHS3")=X
- KILL DXS,D0
- +74 ;SET ZHS4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS4
- +75 SET D0=INDA
- SET X=$GET(INA("BDW1ZHS4"))
- +76 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +77 SET @INV@("ZHS4")=X
- KILL DXS,D0
- +78 ;SET ZHS5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS5
- +79 SET D0=INDA
- SET X=$GET(INA("BDW1ZHS5"))
- +80 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +81 SET @INV@("ZHS5")=X
- KILL DXS,D0
- +82 ;SET ZHS6 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZHS6
- +83 SET D0=INDA
- SET X=$GET(INA("BDW1ZHS6"))
- +84 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +85 SET @INV@("ZHS6")=X
- KILL DXS,D0
- +86 IF 'INVS
- DO MC^INHS
- +87 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="ZHS"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("ZHS1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +88 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ZHS2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("ZHS3"))
- +89 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("ZHS4"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- +90 SET L1=$GET(@INV@("ZHS5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- SET L1=$GET(@INV@("ZHS6"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,7,L1,.CP)
- +91 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +92 IF 'INVS
- DO MC^INHS
- +93 ;Entering END section.
- +94 IF $GET(INSTERR)
- QUIT $SELECT($GET(INREQERR)>INSTERR:INREQERR,1:INSTERR)
- +95 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")))
- +96 IF UIF<0
- DO ERROR^INHS("UIF creation failed",2)
- QUIT 2
- +97 QUIT 0