- IS00009(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: HL IHS DW1 TRAILER-O' on SEP 08, 2008
- ;Part 1
- ;Copyright 2008 SAIC
- EN S X="ERROR^IS00009",@^%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="12424"
- 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 TRL^BDWBHL
- ;Entering DATA section.
- S DELIM="|"
- S SUBDELIM="^"
- SET INSETID=0
- S INDA0=INDA,INI(1)=0 F S INI(1)=$O(INDA("NTE",INI(1))) Q:'INI(1) S INDA=$S(INDA("NTE",INI(1)):INDA("NTE",INI(1)),1:INI(1)) D
- .;SET NTE1 = INSGX\^INTHL7FT(11,3)\\4\"NTE"
- .S D0=INDA S X="NTE"
- .S X1="^INTHL7FT(11,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,4)
- .S @INV@("NTE1")=X K DXS,D0
- .;SET NTE2 = INSGX\^INTHL7FT(1,3)\\2\"TX"
- .S D0=INDA S X="TX"
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,2)
- .S @INV@("NTE2")=X K DXS,D0
- .;SET NTE3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1NTE3
- .S D0=INDA S X=$G(INA("BDW1NTE3",INI(1)))
- .S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- .S @INV@("NTE3")=X K DXS,D0
- .D:'INVS MC^INHS
- .K LINE S LINE="",CP=0 S L1="NTE" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("NTE1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- .D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("NTE2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("NTE3"))
- .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
- S INDA=INDA0 K INDA0
- SET INSETID=0
- ;SET ZTS1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS1
- S D0=INDA S X=$G(INA("BDW1ZTS1"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZTS1")=X K DXS,D0
- ;SET ZTS2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS2
- S D0=INDA S X=$G(INA("BDW1ZTS2"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZTS2")=X K DXS,D0
- ;SET ZTS3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS3
- S D0=INDA S X=$G(INA("BDW1ZTS3"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZTS3")=X K DXS,D0
- ;SET ZTS4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS4
- S D0=INDA S X=$G(INA("BDW1ZTS4"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZTS4")=X K DXS,D0
- ;SET ZTS5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS5
- S D0=INDA S X=$G(INA("BDW1ZTS5"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("ZTS5")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="ZTS" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("ZTS1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("ZTS2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("ZTS3"))
- S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,4,L1,.CP) S L1=$G(@INV@("ZTS4")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- S L1=$G(@INV@("ZTS5")) 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
- SET INSETID=0
- ;SET BTS1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BTS1
- S D0=INDA S X=$G(INA("BDW1BTS1"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BTS1")=X K DXS,D0
- ;SET BTS2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BTS2
- S D0=INDA S X=$G(INA("BDW1BTS2"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BTS2")=X K DXS,D0
- ;SET BTS3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BTS3
- S D0=INDA S X=$G(INA("BDW1BTS3"))
- S X1="^INTHL7FT(1,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,999)
- S @INV@("BTS3")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="BTS" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("BTS1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,L1,.CP) S L1=$G(@INV@("BTS2")) S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,3,L1,.CP) S L1=$G(@INV@("BTS3"))
- 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
- 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
- IS00009(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: HL IHS DW1 TRAILER-O' on SEP 08, 2008
- +1 ;Part 1
- +2 ;Copyright 2008 SAIC
- EN SET X="ERROR^IS00009"
- 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="12424"
- +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 TRL^BDWBHL
- +13 ;Entering DATA section.
- +14 SET DELIM="|"
- +15 SET SUBDELIM="^"
- +16 SET INSETID=0
- +17 SET INDA0=INDA
- SET INI(1)=0
- FOR
- SET INI(1)=$ORDER(INDA("NTE",INI(1)))
- IF 'INI(1)
- QUIT
- SET INDA=$SELECT(INDA("NTE",INI(1)):INDA("NTE",INI(1)),1:INI(1))
- Begin DoDot:1
- +18 ;SET NTE1 = INSGX\^INTHL7FT(11,3)\\4\"NTE"
- +19 SET D0=INDA
- SET X="NTE"
- +20 SET X1="^INTHL7FT(11,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,4)
- +21 SET @INV@("NTE1")=X
- KILL DXS,D0
- +22 ;SET NTE2 = INSGX\^INTHL7FT(1,3)\\2\"TX"
- +23 SET D0=INDA
- SET X="TX"
- +24 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,2)
- +25 SET @INV@("NTE2")=X
- KILL DXS,D0
- +26 ;SET NTE3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1NTE3
- +27 SET D0=INDA
- SET X=$GET(INA("BDW1NTE3",INI(1)))
- +28 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +29 SET @INV@("NTE3")=X
- KILL DXS,D0
- +30 IF 'INVS
- DO MC^INHS
- +31 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="NTE"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("NTE1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +32 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("NTE2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("NTE3"))
- +33 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- +34 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +35 QUIT
- End DoDot:1
- +36 SET INDA=INDA0
- KILL INDA0
- +37 SET INSETID=0
- +38 ;SET ZTS1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS1
- +39 SET D0=INDA
- SET X=$GET(INA("BDW1ZTS1"))
- +40 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +41 SET @INV@("ZTS1")=X
- KILL DXS,D0
- +42 ;SET ZTS2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS2
- +43 SET D0=INDA
- SET X=$GET(INA("BDW1ZTS2"))
- +44 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +45 SET @INV@("ZTS2")=X
- KILL DXS,D0
- +46 ;SET ZTS3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS3
- +47 SET D0=INDA
- SET X=$GET(INA("BDW1ZTS3"))
- +48 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +49 SET @INV@("ZTS3")=X
- KILL DXS,D0
- +50 ;SET ZTS4 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS4
- +51 SET D0=INDA
- SET X=$GET(INA("BDW1ZTS4"))
- +52 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +53 SET @INV@("ZTS4")=X
- KILL DXS,D0
- +54 ;SET ZTS5 = INSGX\^INTHL7FT(1,3)\\999\@BDW1ZTS5
- +55 SET D0=INDA
- SET X=$GET(INA("BDW1ZTS5"))
- +56 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +57 SET @INV@("ZTS5")=X
- KILL DXS,D0
- +58 IF 'INVS
- DO MC^INHS
- +59 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="ZTS"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("ZTS1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +60 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("ZTS2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("ZTS3"))
- +61 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- SET L1=$GET(@INV@("ZTS4"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,5,L1,.CP)
- +62 SET L1=$GET(@INV@("ZTS5"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,6,L1,.CP)
- +63 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +64 SET INSETID=0
- +65 ;SET BTS1 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BTS1
- +66 SET D0=INDA
- SET X=$GET(INA("BDW1BTS1"))
- +67 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +68 SET @INV@("BTS1")=X
- KILL DXS,D0
- +69 ;SET BTS2 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BTS2
- +70 SET D0=INDA
- SET X=$GET(INA("BDW1BTS2"))
- +71 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +72 SET @INV@("BTS2")=X
- KILL DXS,D0
- +73 ;SET BTS3 = INSGX\^INTHL7FT(1,3)\\999\@BDW1BTS3
- +74 SET D0=INDA
- SET X=$GET(INA("BDW1BTS3"))
- +75 SET X1="^INTHL7FT(1,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,999)
- +76 SET @INV@("BTS3")=X
- KILL DXS,D0
- +77 IF 'INVS
- DO MC^INHS
- +78 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="BTS"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("BTS1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +79 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- SET L1=$GET(@INV@("BTS2"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,3,L1,.CP)
- SET L1=$GET(@INV@("BTS3"))
- +80 IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,4,L1,.CP)
- +81 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +82 IF 'INVS
- DO MC^INHS
- +83 ;Entering END section.
- +84 IF $GET(INSTERR)
- QUIT $SELECT($GET(INREQERR)>INSTERR:INREQERR,1:INSTERR)
- +85 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")))
- +86 IF UIF<0
- DO ERROR^INHS("UIF creation failed",2)
- QUIT 2
- +87 QUIT 0
