INHSZ21.m

INHSZ21 ;JSH,DGH; 20 Dec 1999 09:35 ;INHSZ2 continued outbound msg; 19 Dec 91  1:00PM 

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;CHCS TOOLS_460; GEN 10; 23-JUL-1997

 ;COPYRIGHT 1988, 1989, 1990 SAIC

 ;Changes needed for X12, NOT for NCPDP after redesign.

L G L^INHSZ1

 ;

DELIM ;Set delimiter character

 N %1 S %1=$$LBTB^UTIL($P(LINE,"=",2))

 I MODE="I" D DELI G DELQ

 Q:'$$SYNTAX^INHSZ0($P(LINE,COMM,2,99),"."" ""1""=""."" ""1"""""""".E.""""""""")

 S A=" S DELIM="""_$P($P(%1,"""",2),"""")_"""" D L

DELQ S DELIM=1,DICOMPX("DELIM")=""""_$P($P(%1,"""",2),"""")_""""

 Q

DELI ;INPUT mode version of delimiter set.

 N DICOMPX S DICOMPX("DATA")="$$GL^INHOU(UIF,LCT)",X=%1 D DICOMP(.X)

 I '$D(X) D ERROR^INHSZ0("Invalid expression to set the DELIMITER.",1) Q

 S A=" "_X_" S DELIM=X K DXS" D L Q

 ;

SUBDELIM ;set subdelimiter character

 N %1 S %1=$$LBTB^UTIL($P(LINE,"=",2))

 I MODE="I" D SUBI G SUBQ

 Q:'$$SYNTAX^INHSZ0($P(LINE,COMM,2,99),"."" ""1""=""."" ""1"""""""".E1""""""""")

 S A=" S SUBDELIM="""_$P($P(%1,"""",2),"""")_"""" D L

SUBQ S SUBDELIM=1,DICOMPX("SUBDELIM")=""""_$P($P(%1,"""",2),"""")_""""

 Q

SUBI ;INPUT mode version of subdelimiter set

 N DICOMPX S DICOMPX("DATA")="$$GL^INHOU(UIF,LCT)",X=%1 D DICOMP(.X)

 I '$D(X) D ERROR^INHSZ0("Invalid expression to set the SUBDELIMITER.",1) Q

 S A=" "_X_" S SUBDELIM=X K DXS S INDELIMS=DELIM_$P(Y(1),DELIM,2)" D L

 Q

 ;

SET ;SET statement

 I MODE="I" D ERROR^INHSZ0("SET statement allow in Output scripts only.",1) Q

 Q:'$$SYNTAX^INHSZ0($$LB^UTIL($P(LINE,COMM,2,99)),"."" ""1.ANP1""=""1.E")

 N %1,I,J,V,X,INXFRM,INCONV

 S V=$$LBTB^UTIL($P($P(LINE,"SET",2),"="))

 S A=" ;"_LINE D L

 S X=$$LB^UTIL($P(LINE,"=",2)) S:X X="#"_X

 ;Following replaces old INSGX function

 I $E(X,1,5)="INSGX" S INXFRM=$P(X,"\",2),INCONV=$P(X,"\",3),LEN=$P(X,"\",4),X=$P(X,"\",5,99)

 S DICOMPX=""

 D ATSET(X),DICOMP(.X,0,1)

 I FILE="",$P(DICOMPX,U)=0 K X

 I '$D(X) D ERROR^INHSZ0("Invalid expression in SET statement.",1) Q

 S A=" S D0=INDA "_X D L

 ;To replace INSGX function create another line in compiled code which

 ;will execute the transform or the conversion.

 I ($L($G(INXFRM))!$L($G(INCONV))) D

 .I $L($G(INXFRM)) S A=" S X1="""_INXFRM_""" X:$L($G(@X1)) $G(@X1)"

 .S A=A_" S X=$E(X,1,"_LEN_")"

 .I $L($G(INCONV)) S A=A_" S X1="""_INCONV_""" X:$L($G(@X1)) $G(@X1)"

 .D L

 S A=" S @INV@("""_V_""")=X K DXS,D0" D L S SET(V)="",DICOMPX(V)="@INV@("""_V_""")"

 Q

 ;

IF ;IF statement

 Q:'$$SYNTAX^INHSZ0($P(LINE,COMM,2,99),"1."" ""1.ANP")

 N I,J,DA,DQI,X,Q,D0,%1 S D0=0

 S A=" ;"_LINE D L

 S (%1,X)=$$LBTB^UTIL($P(LINE," ",2,999))

 D ATSET(X),DICOMP(.X)

 G:'$D(X) IFM

 I Y'["B" D ERROR^INHSZ0("Expression is not Boolean in structure.",1) Q

 S:X["D0" D0=1

 I MODE="I",SECT'="STORE",D0 D ERROR^INHSZ0("Expression involves a file entry which is not yet determined.",1) Q

 S A=" "_X_" K DXS,D0 I X" D L

IFQ S IF=IF+1,A=" D:$T" D L,DOWN^INHSZ1("I") Q

 ;

IFM ;IF may be MUMPS code

 S X="I "_%1 D ^DIM I '$D(X) D ERROR^INHSZ0("Expression INVALID.",1) Q

 S A=" "_X D L G IFQ

 ;

ENDIF ;end of an IF block

 I 'IF D ERROR^INHSZ0("No active IF to end.",0) Q

 I $P(INDS(DOTLVL),U)'="I" D ERROR^INHSZ0("Misplaced ENDIF",0) Q

 S IF=IF-1 D UP^INHSZ1 Q

 ;

DICOMP(X,%N,%W) ;Run DICOMP to evaluate expression

 ;X= expression to evaluate (pass by reference)

 ;If %N=1 then DICOMPX will not be used

 ;If %W=1 then WP fields may be specified - first line will be used

 N %,V,V1,I,J,DICOMP,DS,DL,DE,DICMX,INOLDX N:$G(%N) DICOMPX

 S:$G(%W) DICMX="S INX=$P(X,""|CR|"") Q "

 S DA="DXS(",DQI="Y(",DICOMP="",I(0)="^"_$P(FILE,U,2),J(0)=+FILE,DICOMP="",INOLDX=X

 D ^DICOMP I '$D(X) D  Q:'$D(X)

 .  Q:$G(MODE)="I"   ;Don't double check inbound scripts

 .  S %=$P($G(^DIC(+FILE,0)),U,1) S:'$L(%) %=$P($G(^DD(+FILE,0)),U,1)

 .  W *7,!!,"Ambiguity in the following expression:"

 .  W !,"Current base file: ",%," (#",+FILE,")",!,"Expression:  ",INOLDX,!

 .  S X=INOLDX,DICOMP="?" D ^DICOMP S DICOMP=""

 .  W !,"Ambiguity ",$S($D(X):"",1:"NOT "),"resolved.",!

 F I=0:0 S I=$O(X(I)) Q:'I  S:X(I)["D0" D0=1 S A=" S DXS("_I_")="""_$$REPLACE^UTIL(X(I),"""","""""")_"""" D L

 S:Y["w"!(Y["l") X="K INX "_X_" S X=$G(INX)"

 Q

 ;

ATSET(X) ;Set DICOMPX array for any @variables in the code

 ;X = code to process

 N Q,I,J

 S Q=0 F I=1:1:$L(X) D

 . I $E(X,I)="""" S Q='Q Q

 . Q:$E(X,I)'="@"

 . F J=I+1:1 Q:$E(X,J)'?1AN

 . S DICOMPX($E(X,I,J-1))="$G(INA("""_$E(X,I+1,J-1)_""""_$G(WHSUB)_"))",I=J

 Q

 ;

WHILE ;WHILE loop initiate 

 N %E I $D(LINE)>9 D ERROR^INHSZ0("Line too long.",1)

 S %E=$$LBTB^UTIL($P(LINE,"WHILE",2,99))

 S:$P(%E," ")="~REQUIRED~" %E=$$LBTB^UTIL($P(LINE,"~REQUIRED~",2,99))

 I '$L(%E) D ERROR^INHSZ0("Condition missing from WHILE statement.",1) Q

 G:MODE="O" WHILE^INHSZ20

 S X="I "_%E D ^DIM I '$D(X) D ERROR^INHSZ0("Condition not valid.",1) Q

 S A=" ;"_LINE D L S WHILE=WHILE+1

 I $P(LINE," ",1,2)="WHILE ~REQUIRED~" S A=" I $P($$GL^INHOU(UIF,LCT),DELIM)'="_$P(%E,"=",2)_" Q:'$$CHECKSEG^INHOU("_$P(%E,"=",2)_",1,"_WHILE_")"_$S(WHILE>1:"",1:" 2") D L

 S A=" S INI("_WHILE_")=1 F  "_$S(MODE="I":"S DATA=$$GL^INHOU(UIF,LCT) Q:'$$CHECKSEG^INHOU("_$P(%E,"=",2)_",0,"_WHILE_")",1:"Q:'("_%E_")")_"  D  S INI("_WHILE_")=INI("_WHILE_")+1" D L

 D DOWN^INHSZ1("W")

 S WHSUB=WHSUB_",INI("_WHILE_")"

 Q

 ;

ENDWHILE ;End of while loop

 I 'DOTLVL D ERROR^INHSZ0("No active WHILE to end.",1) Q

 I $P(INDS(DOTLVL),U)'="W" D ERROR^INHSZ0("Misplaced ENDWHILE.",1) Q

 G:MODE="O" ENDWHILE^INHSZ20

 S WHILE=WHILE-1 D UP^INHSZ1 S WHSUB=$P(WHSUB,",",1,WHILE+1) S:'WHILE WHSUB=""

 Q

 ;

GROUP ;Initiate a GROUP

 I $P(LINE,COMM,2)]"" D WARN^INHSZ0("Characters after GROUP ignored.",1)

 S A=" ;Start of GROUP" D L

 S A=" F  S MATCH=0 D  Q:'MATCH" D L

 D DOWN^INHSZ1("G") S GROUP=1 Q

 ;

ENDGROUP ;End of group

 I 'DOTLVL D ERROR^INHSZ0("No active GROUP to end.",1) Q

 I $P(INDS(DOTLVL),U)'="G" D ERROR^INHSZ0("Misplaced ENDGROUP.",1) Q

 D UP^INHSZ1 S GROUP=0 Q

 ;

ERROR ;ERROR command

 Q:'$$SYNTAX^INHSZ0($P(LINE,COMM,2),"."" ""1""=""."" ""1""""""""1.ANP1""""""""."" "".1"";""."" "".1N")

 N M,T

 S M=$$LBTB^UTIL($P($P(LINE,"=",2),";"))

 S T=$$LBTB^UTIL($P(LINE,";",2))

 I T]"",$L(T)>1!("12"'[T) D ERROR^INHSZ0("Illegal error type '"_T_"' in ERROR statement.",1) Q

 S:T="" T=2

 S A=" D ERROR^INHS("_M_","_T_")" D L

 Q

 ;

BHLMIEN ;Set Message IEN

 N %1 S %1=$$LBTB^UTIL($P(LINE,"=",2))

 Q:'$$SYNTAX^INHSZ0($P(LINE,COMM,2,99),"."" ""1""=""."" ""1"""""""".E.""""""""")

 S A=" S BHLMIEN="""_$P($P(%1,"""",2),"""")_"""" D L

 S BHLMIEN=1,DICOMPX("BHLMIEN")=""""_$P($P(%1,"""",2),"""")_""""

 Q

INHSZ21   ;JSH,DGH; 20 Dec 1999 09:35 ;INHSZ2 continued outbound msg; 19 Dec 91  1:00PM 

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;CHCS TOOLS_460; GEN 10; 23-JUL-1997

 +4       ;COPYRIGHT 1988, 1989, 1990 SAIC

 +5       ;Changes needed for X12, NOT for NCPDP after redesign.

L          GOTO L^INHSZ1

 +1       ;

DELIM     ;Set delimiter character

 +1        NEW %1

           SET %1=$$LBTB^UTIL($PIECE(LINE,"=",2))

 +2        IF MODE="I"

               DO DELI

               GOTO DELQ

 +3        IF '$$SYNTAX^INHSZ0($PIECE(LINE,COMM,2,99),"."" ""1""=""."" ""1"""""""".E.""""""""")

               QUIT 

 +4        SET A=" S DELIM="""_$PIECE($PIECE(%1,"""",2),"""")_""""

           DO L

DELQ       SET DELIM=1

           SET DICOMPX("DELIM")=""""_$PIECE($PIECE(%1,"""",2),"""")_""""

 +1        QUIT 

DELI      ;INPUT mode version of delimiter set.

 +1        NEW DICOMPX

           SET DICOMPX("DATA")="$$GL^INHOU(UIF,LCT)"

           SET X=%1

           DO DICOMP(.X)

 +2        IF '$DATA(X)

               DO ERROR^INHSZ0("Invalid expression to set the DELIMITER.",1)

               QUIT 

 +3        SET A=" "_X_" S DELIM=X K DXS"

           DO L

           QUIT 

 +4       ;

SUBDELIM  ;set subdelimiter character

 +1        NEW %1

           SET %1=$$LBTB^UTIL($PIECE(LINE,"=",2))

 +2        IF MODE="I"

               DO SUBI

               GOTO SUBQ

 +3        IF '$$SYNTAX^INHSZ0($PIECE(LINE,COMM,2,99),"."" ""1""=""."" ""1"""""""".E1""""""""")

               QUIT 

 +4        SET A=" S SUBDELIM="""_$PIECE($PIECE(%1,"""",2),"""")_""""

           DO L

SUBQ       SET SUBDELIM=1

           SET DICOMPX("SUBDELIM")=""""_$PIECE($PIECE(%1,"""",2),"""")_""""

 +1        QUIT 

SUBI      ;INPUT mode version of subdelimiter set

 +1        NEW DICOMPX

           SET DICOMPX("DATA")="$$GL^INHOU(UIF,LCT)"

           SET X=%1

           DO DICOMP(.X)

 +2        IF '$DATA(X)

               DO ERROR^INHSZ0("Invalid expression to set the SUBDELIMITER.",1)

               QUIT 

 +3        SET A=" "_X_" S SUBDELIM=X K DXS S INDELIMS=DELIM_$P(Y(1),DELIM,2)"

           DO L

 +4        QUIT 

 +5       ;

SET       ;SET statement

 +1        IF MODE="I"

               DO ERROR^INHSZ0("SET statement allow in Output scripts only.",1)

               QUIT 

 +2        IF '$$SYNTAX^INHSZ0($$LB^UTIL($PIECE(LINE,COMM,2,99)),"."" ""1.ANP1""=""1.E")

               QUIT 

 +3        NEW %1,I,J,V,X,INXFRM,INCONV

 +4        SET V=$$LBTB^UTIL($PIECE($PIECE(LINE,"SET",2),"="))

 +5        SET A=" ;"_LINE

           DO L

 +6        SET X=$$LB^UTIL($PIECE(LINE,"=",2))

           IF X

               SET X="#"_X

 +7       ;Following replaces old INSGX function

 +8        IF $EXTRACT(X,1,5)="INSGX"

               SET INXFRM=$PIECE(X,"\",2)

               SET INCONV=$PIECE(X,"\",3)

               SET LEN=$PIECE(X,"\",4)

               SET X=$PIECE(X,"\",5,99)

 +9        SET DICOMPX=""

 +10       DO ATSET(X)

           DO DICOMP(.X,0,1)

 +11       IF FILE=""

               IF $PIECE(DICOMPX,U)=0

                   KILL X

 +12       IF '$DATA(X)

               DO ERROR^INHSZ0("Invalid expression in SET statement.",1)

               QUIT 

 +13       SET A=" S D0=INDA "_X

           DO L

 +14      ;To replace INSGX function create another line in compiled code which

 +15      ;will execute the transform or the conversion.

 +16       IF ($LENGTH($GET(INXFRM))!$LENGTH($GET(INCONV)))

               Begin DoDot:1

 +17               IF $LENGTH($GET(INXFRM))

                       SET A=" S X1="""_INXFRM_""" X:$L($G(@X1)) $G(@X1)"

 +18               SET A=A_" S X=$E(X,1,"_LEN_")"

 +19               IF $LENGTH($GET(INCONV))

                       SET A=A_" S X1="""_INCONV_""" X:$L($G(@X1)) $G(@X1)"

 +20               DO L

               End DoDot:1

 +21       SET A=" S @INV@("""_V_""")=X K DXS,D0"

           DO L

           SET SET(V)=""

           SET DICOMPX(V)="@INV@("""_V_""")"

 +22       QUIT 

 +23      ;

IF        ;IF statement

 +1        IF '$$SYNTAX^INHSZ0($PIECE(LINE,COMM,2,99),"1."" ""1.ANP")

               QUIT 

 +2        NEW I,J,DA,DQI,X,Q,D0,%1

           SET D0=0

 +3        SET A=" ;"_LINE

           DO L

 +4        SET (%1,X)=$$LBTB^UTIL($PIECE(LINE," ",2,999))

 +5        DO ATSET(X)

           DO DICOMP(.X)

 +6        IF '$DATA(X)

               GOTO IFM

 +7        IF Y'["B"

               DO ERROR^INHSZ0("Expression is not Boolean in structure.",1)

               QUIT 

 +8        IF X["D0"

               SET D0=1

 +9        IF MODE="I"

               IF SECT'="STORE"

                   IF D0

                       DO ERROR^INHSZ0("Expression involves a file entry which is not yet determined.",1)

                       QUIT 

 +10       SET A=" "_X_" K DXS,D0 I X"

           DO L

IFQ        SET IF=IF+1

           SET A=" D:$T"

           DO L

           DO DOWN^INHSZ1("I")

           QUIT 

 +1       ;

IFM       ;IF may be MUMPS code

 +1        SET X="I "_%1

           DO ^DIM

           IF '$DATA(X)

               DO ERROR^INHSZ0("Expression INVALID.",1)

               QUIT 

 +2        SET A=" "_X

           DO L

           GOTO IFQ

 +3       ;

ENDIF     ;end of an IF block

 +1        IF 'IF

               DO ERROR^INHSZ0("No active IF to end.",0)

               QUIT 

 +2        IF $PIECE(INDS(DOTLVL),U)'="I"

               DO ERROR^INHSZ0("Misplaced ENDIF",0)

               QUIT 

 +3        SET IF=IF-1

           DO UP^INHSZ1

           QUIT 

 +4       ;

DICOMP(X,%N,%W) ;Run DICOMP to evaluate expression

 +1       ;X= expression to evaluate (pass by reference)

 +2       ;If %N=1 then DICOMPX will not be used

 +3       ;If %W=1 then WP fields may be specified - first line will be used

 +4        NEW %,V,V1,I,J,DICOMP,DS,DL,DE,DICMX,INOLDX

           IF $GET(%N)

               NEW DICOMPX

 +5        IF $GET(%W)

               SET DICMX="S INX=$P(X,""|CR|"") Q "

 +6        SET DA="DXS("

           SET DQI="Y("

           SET DICOMP=""

           SET I(0)="^"_$PIECE(FILE,U,2)

           SET J(0)=+FILE

           SET DICOMP=""

           SET INOLDX=X

 +7        DO ^DICOMP

           IF '$DATA(X)

               Begin DoDot:1

 +8       ;Don't double check inbound scripts

                   IF $GET(MODE)="I"

                       QUIT 

 +9                SET %=$PIECE($GET(^DIC(+FILE,0)),U,1)

                   IF '$LENGTH(%)

                       SET %=$PIECE($GET(^DD(+FILE,0)),U,1)

 +10               WRITE *7,!!,"Ambiguity in the following expression:"

 +11               WRITE !,"Current base file: ",%," (#",+FILE,")",!,"Expression:  ",INOLDX,!

 +12               SET X=INOLDX

                   SET DICOMP="?"

                   DO ^DICOMP

                   SET DICOMP=""

 +13               WRITE !,"Ambiguity ",$SELECT($DATA(X):"",1:"NOT "),"resolved.",!

               End DoDot:1

               IF '$DATA(X)

                   QUIT 

 +14       FOR I=0:0

               SET I=$ORDER(X(I))

               IF 'I

                   QUIT 

               IF X(I)["D0"

                   SET D0=1

               SET A=" S DXS("_I_")="""_$$REPLACE^UTIL(X(I),"""","""""")_""""

               DO L

 +15       IF Y["w"!(Y["l")

               SET X="K INX "_X_" S X=$G(INX)"

 +16       QUIT 

 +17      ;

ATSET(X)  ;Set DICOMPX array for any @variables in the code

 +1       ;X = code to process

 +2        NEW Q,I,J

 +3        SET Q=0

           FOR I=1:1:$LENGTH(X)

               Begin DoDot:1

 +4                IF $EXTRACT(X,I)=""""

                       SET Q='Q

                       QUIT 

 +5                IF $EXTRACT(X,I)'="@"

                       QUIT 

 +6                FOR J=I+1:1

                       IF $EXTRACT(X,J)'?1AN

                           QUIT 

 +7                SET DICOMPX($EXTRACT(X,I,J-1))="$G(INA("""_$EXTRACT(X,I+1,J-1)_""""_$GET(WHSUB)_"))"

                   SET I=J

               End DoDot:1

 +8        QUIT 

 +9       ;

WHILE     ;WHILE loop initiate 

 +1        NEW %E

           IF $DATA(LINE)>9

               DO ERROR^INHSZ0("Line too long.",1)

 +2        SET %E=$$LBTB^UTIL($PIECE(LINE,"WHILE",2,99))

 +3        IF $PIECE(%E," ")="~REQUIRED~"

               SET %E=$$LBTB^UTIL($PIECE(LINE,"~REQUIRED~",2,99))

 +4        IF '$LENGTH(%E)

               DO ERROR^INHSZ0("Condition missing from WHILE statement.",1)

               QUIT 

 +5        IF MODE="O"

               GOTO WHILE^INHSZ20

 +6        SET X="I "_%E

           DO ^DIM

           IF '$DATA(X)

               DO ERROR^INHSZ0("Condition not valid.",1)

               QUIT 

 +7        SET A=" ;"_LINE

           DO L

           SET WHILE=WHILE+1

 +8        IF $PIECE(LINE," ",1,2)="WHILE ~REQUIRED~"

               SET A=" I $P($$GL^INHOU(UIF,LCT),DELIM)'="_$PIECE(%E,"=",2)_" Q:'$$CHECKSEG^INHOU("_$PIECE(%E,"=",2)_",1,"_WHILE_")"_$SELECT(WHILE>1:"",1:" 2")

               DO L

 +9        SET A=" S INI("_WHILE_")=1 F  "_$SELECT(MODE="I":"S DATA=$$GL^INHOU(UIF,LCT) Q:'$$CHECKSEG^INHOU("_$PIECE(%E,"=",2)_",0,"_WHILE_")",1:"Q:'("_%E_")")_"  D  S INI("_WHILE_")=INI("_WHILE_")+1"

           DO L

 +10       DO DOWN^INHSZ1("W")

 +11       SET WHSUB=WHSUB_",INI("_WHILE_")"

 +12       QUIT 

 +13      ;

ENDWHILE  ;End of while loop

 +1        IF 'DOTLVL

               DO ERROR^INHSZ0("No active WHILE to end.",1)

               QUIT 

 +2        IF $PIECE(INDS(DOTLVL),U)'="W"

               DO ERROR^INHSZ0("Misplaced ENDWHILE.",1)

               QUIT 

 +3        IF MODE="O"

               GOTO ENDWHILE^INHSZ20

 +4        SET WHILE=WHILE-1

           DO UP^INHSZ1

           SET WHSUB=$PIECE(WHSUB,",",1,WHILE+1)

           IF 'WHILE

               SET WHSUB=""

 +5        QUIT 

 +6       ;

GROUP     ;Initiate a GROUP

 +1        IF $PIECE(LINE,COMM,2)]""

               DO WARN^INHSZ0("Characters after GROUP ignored.",1)

 +2        SET A=" ;Start of GROUP"

           DO L

 +3        SET A=" F  S MATCH=0 D  Q:'MATCH"

           DO L

 +4        DO DOWN^INHSZ1("G")

           SET GROUP=1

           QUIT 

 +5       ;

ENDGROUP  ;End of group

 +1        IF 'DOTLVL

               DO ERROR^INHSZ0("No active GROUP to end.",1)

               QUIT 

 +2        IF $PIECE(INDS(DOTLVL),U)'="G"

               DO ERROR^INHSZ0("Misplaced ENDGROUP.",1)

               QUIT 

 +3        DO UP^INHSZ1

           SET GROUP=0

           QUIT 

 +4       ;

ERROR     ;ERROR command

 +1        IF '$$SYNTAX^INHSZ0($PIECE(LINE,COMM,2),"."" ""1""=""."" ""1""""""""1.ANP1""""""""."" "".1"";""."" "".1N")

               QUIT 

 +2        NEW M,T

 +3        SET M=$$LBTB^UTIL($PIECE($PIECE(LINE,"=",2),";"))

 +4        SET T=$$LBTB^UTIL($PIECE(LINE,";",2))

 +5        IF T]""

               IF $LENGTH(T)>1!("12"'[T)

                   DO ERROR^INHSZ0("Illegal error type '"_T_"' in ERROR statement.",1)

                   QUIT 

 +6        IF T=""

               SET T=2

 +7        SET A=" D ERROR^INHS("_M_","_T_")"

           DO L

 +8        QUIT 

 +9       ;

BHLMIEN   ;Set Message IEN

 +1        NEW %1

           SET %1=$$LBTB^UTIL($PIECE(LINE,"=",2))

 +2        IF '$$SYNTAX^INHSZ0($PIECE(LINE,COMM,2,99),"."" ""1""=""."" ""1"""""""".E.""""""""")

               QUIT 

 +3        SET A=" S BHLMIEN="""_$PIECE($PIECE(%1,"""",2),"""")_""""

           DO L

 +4        SET BHLMIEN=1

           SET DICOMPX("BHLMIEN")=""""_$PIECE($PIECE(%1,"""",2),"""")_""""

 +5        QUIT