- IS00013(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: HL IHS IZV04 BATCH FOOTER-O' on AUG 15, 2018
- ;Part 1
- ;Copyright 2018 SAIC
- EN S X="ERROR^IS00013",@^%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="12428"
- 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 DATA section.
- S DELIM="|"
- S SUBDELIM="^"
- SET INSETID=0
- ;SET BTS1 = INSGX\^INTHL7F(17048,5)\\10\"OUTPUT TRANSFORM"
- S D0=INDA S X="OUTPUT TRANSFORM"
- S X1="^INTHL7F(17048,5)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,10)
- S @INV@("BTS1")=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 LCT=LCT+1,^UTILITY("INH",$J,LCT)=LINE I $D(LINE)>9 M ^UTILITY("INH",$J,LCT)=LINE
- SET INSETID=0
- ;SET FTS1 = INSGX\^INTHL7FT(3,3)\\1\"1"
- S D0=INDA S X="1"
- S X1="^INTHL7FT(3,3)" X:$L($G(@X1)) $G(@X1) S X=$E(X,1,1)
- S @INV@("FTS1")=X K DXS,D0
- D:'INVS MC^INHS
- K LINE S LINE="",CP=0 S L1="FTS" S:$TR(L1,$G(SUBDELIM))="" L1="" D SETPIECE^INHU(.LINE,DELIM,1,L1,.CP) S L1=$G(@INV@("FTS1")) S:$TR(L1,$G(SUBDELIM))="" L1=""
- D SETPIECE^INHU(.LINE,DELIM,2,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
- IS00013(INTT,INDA,INA,INDEST,INQUE,INORDUZ,INORDIV) ;Compiled from script 'Generated: HL IHS IZV04 BATCH FOOTER-O' on AUG 15, 2018
- +1 ;Part 1
- +2 ;Copyright 2018 SAIC
- EN SET X="ERROR^IS00013"
- 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="12428"
- +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 DATA section.
- +12 SET DELIM="|"
- +13 SET SUBDELIM="^"
- +14 SET INSETID=0
- +15 ;SET BTS1 = INSGX\^INTHL7F(17048,5)\\10\"OUTPUT TRANSFORM"
- +16 SET D0=INDA
- SET X="OUTPUT TRANSFORM"
- +17 SET X1="^INTHL7F(17048,5)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,10)
- +18 SET @INV@("BTS1")=X
- KILL DXS,D0
- +19 IF 'INVS
- DO MC^INHS
- +20 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=""
- +21 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- +22 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +23 SET INSETID=0
- +24 ;SET FTS1 = INSGX\^INTHL7FT(3,3)\\1\"1"
- +25 SET D0=INDA
- SET X="1"
- +26 SET X1="^INTHL7FT(3,3)"
- IF $LENGTH($GET(@X1))
- XECUTE $GET(@X1)
- SET X=$EXTRACT(X,1,1)
- +27 SET @INV@("FTS1")=X
- KILL DXS,D0
- +28 IF 'INVS
- DO MC^INHS
- +29 KILL LINE
- SET LINE=""
- SET CP=0
- SET L1="FTS"
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- DO SETPIECE^INHU(.LINE,DELIM,1,L1,.CP)
- SET L1=$GET(@INV@("FTS1"))
- IF $TRANSLATE(L1,$GET(SUBDELIM))=""
- SET L1=""
- +30 DO SETPIECE^INHU(.LINE,DELIM,2,L1,.CP)
- +31 SET LCT=LCT+1
- SET ^UTILITY("INH",$JOB,LCT)=LINE
- IF $DATA(LINE)>9
- MERGE ^UTILITY("INH",$JOB,LCT)=LINE
- +32 IF 'INVS
- DO MC^INHS
- +33 ;Entering END section.
- +34 IF $GET(INSTERR)
- QUIT $SELECT($GET(INREQERR)>INSTERR:INREQERR,1:INSTERR)
- +35 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")))
- +36 IF UIF<0
- DO ERROR^INHS("UIF creation failed",2)
- QUIT 2
- +37 QUIT 0
