- 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 ;