INHSZ0.m

INHSZ0 ;JSH; 29 Jan 92 09:47;Interface Script compiler (cont'd)

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

 ;COPYRIGHT 1991-2000 SAIC

 ;

L G L^INHSZ1

 ;

GETLINE ;Returns next line of code in array LINE

 K LINE N I

 S CALL(CALL,0)=$O(^INRHS(CALL(CALL),1,CALL(CALL,0))) Q:'CALL(CALL,0)

 S LINE=^INRHS(CALL(CALL),1,CALL(CALL,0),0) I LINE["|CR|" S LINE=$$LBTB^UTIL($P(LINE,"|CR|")) Q

 S I=0

G1 S CALL(CALL,0)=$O(^INRHS(CALL(CALL),1,CALL(CALL,0))) G:'CALL(CALL,0) GQ S I=I+1,LINE(I)=^(CALL(CALL,0),0) G GQ:LINE(I)["|CR|",G1

GQ S:I LINE(I)=$P(LINE(I),"|CR|")

 S LINE=$$LB^UTIL(LINE) Q

 ;

QCHK ;Add code to check for errors and quit

 S A=" I $G(INSTERR) Q $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR)" D L

 Q

 ;

SYNTAX(%L,%P) ;Check syntax of a line using pattern match

 ;%L = string to check    %P = pattern match

 I $G(%P)="" Q 1

 I %L?@%P Q 1

 D ERROR("Statement syntax error.",1) Q 0

 ;

ERROR(%M,%L) ;Report an error

 ;%M = message   %L = print line (1=yes, 0=no)

 N I

 S ER=1

 W *7,!!,"ERROR: ",%M Q:'$G(%L)

EDISP W !,LINE I $D(LINE)>9 F I=1:1 Q:'$D(LINE(I))  W LINE(I)

 Q

 ;

WARN(%M,%L) ;Report a warning

 ;%M = message    %L = print line (0=no, 1=yes)

 W *7,!!,"WARNING: ",%M

 S WARN=$G(WARN)+1 G:$G(%L) EDISP

 Q

 ;

INHSZ0    ;JSH; 29 Jan 92 09:47;Interface Script compiler (cont'd)

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

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;

L          GOTO L^INHSZ1

 +1       ;

GETLINE   ;Returns next line of code in array LINE

 +1        KILL LINE

           NEW I

 +2        SET CALL(CALL,0)=$ORDER(^INRHS(CALL(CALL),1,CALL(CALL,0)))

           IF 'CALL(CALL,0)

               QUIT 

 +3        SET LINE=^INRHS(CALL(CALL),1,CALL(CALL,0),0)

           IF LINE["|CR|"

               SET LINE=$$LBTB^UTIL($PIECE(LINE,"|CR|"))

               QUIT 

 +4        SET I=0

G1         SET CALL(CALL,0)=$ORDER(^INRHS(CALL(CALL),1,CALL(CALL,0)))

           IF 'CALL(CALL,0)

               GOTO GQ

           SET I=I+1

           SET LINE(I)=^(CALL(CALL,0),0)

           IF LINE(I)["|CR|"

               GOTO GQ

           GOTO G1

GQ         IF I

               SET LINE(I)=$PIECE(LINE(I),"|CR|")

 +1        SET LINE=$$LB^UTIL(LINE)

           QUIT 

 +2       ;

QCHK      ;Add code to check for errors and quit

 +1        SET A=" I $G(INSTERR) Q $S($G(INREQERR)>INSTERR:INREQERR,1:INSTERR)"

           DO L

 +2        QUIT 

 +3       ;

SYNTAX(%L,%P) ;Check syntax of a line using pattern match

 +1       ;%L = string to check    %P = pattern match

 +2        IF $GET(%P)=""

               QUIT 1

 +3        IF %L?@%P

               QUIT 1

 +4        DO ERROR("Statement syntax error.",1)

           QUIT 0

 +5       ;

ERROR(%M,%L) ;Report an error

 +1       ;%M = message   %L = print line (1=yes, 0=no)

 +2        NEW I

 +3        SET ER=1

 +4        WRITE *7,!!,"ERROR: ",%M

           IF '$GET(%L)

               QUIT 

EDISP      WRITE !,LINE

           IF $DATA(LINE)>9

               FOR I=1:1

                   IF '$DATA(LINE(I))

                       QUIT 

                   WRITE LINE(I)

 +1        QUIT 

 +2       ;

WARN(%M,%L) ;Report a warning

 +1       ;%M = message    %L = print line (0=no, 1=yes)

 +2        WRITE *7,!!,"WARNING: ",%M

 +3        SET WARN=$GET(WARN)+1

           IF $GET(%L)

               GOTO EDISP

 +4        QUIT 

 +5       ;