Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IS00008

IS00008.m

Go to the documentation of this file.
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