C SUBROUTINE BPDINI.FOR
C+
C; BPDINI IS THE INITIALIZATION SUBROUTINE FOR PROGRAM "BPD".
C-
CD+
C; THIS SUBROUTINE WILL DETERMINE THE RECORD NUMBER OF THE PICTORIAL
C;DISPLAY THAT IS TO BE BACKED-UP AS A VAX-11 RMS FILE (OR THE FACT THAT
C;ALL DEFINED DISPLAYS ARE TO BE BACKED-UP). THIS INFORMATION MUST
C;EXIST IN A "FOREIGN COMMAND-LINE" IN THE EXACT FORMAT DESCRIBED
C;BELOW:
C;
C; BPD XXX
C;
C; WHERE; "XXX" IS THE RECORD NUMBER IN THE PICTORIAL FILE THAT IS TO
C; BE BACKED-UP. "XXX" MAY BE ANY NUMBER OF DECIMAL DIGITS
C; BETWEEN ONE AND SIX. LEADING ZEROES ARE OPTIONAL AND
C; IGNORED. A TRAILING DECIMAL-POINT IS OPTIONAL AND IGNORED.
C; THE THREE-CHARACTER STRING "ALL" MAY BE SUPPLIED INSTEAD,
C; IN WHICH CASE ALL DEFINED DISPLAYS WILL BE BACKED-UP.
C;
C;
CD-
C; WRITTEN BY E. NICHOLAS CUPERY 26 AUGUST 1981
C*+
SUBROUTINE BPDINI(TI,ALLFLG,RECNUM,STATUS)
C*
C* ARGUMENT INPUTS:
C* TI = INITIATING TERMINAL LUN (NOT USED)
[WORD]
C*
C* INPUTS FROM COMMON:
C* (NONE)
C*
C* ARGUMENT OUTPUTS:
C* ALLFLG = BACKUP-ALL-DISPLAYS FLAG (0=NO) [WORD]
C* RECNUM = RECORD NUMBER IN PICTORIAL FILE (IF ALLFLG=0) [LONGWORD]
C* STATUS = RETURN STATUS (+1 = SUCCESS) [WORD]
C*
C* OUTPUTS TO COMMON:
C* (NONE)
C*
C*-
C
C
C
INTEGER*2 TI !INITIATING TERMINAL LUN
INTEGER*2 ALLFLG !BACKUP-ALL-DISPLAYS FLAG (0=NO)
INTEGER*4 RECNUM !RECORD NUMBER IN PICTORIAL FILE
INTEGER*2 STATUS !RETURN STATUS FOR CALLER
C
INTEGER*4 I !LOCAL DO-LOOP COUNTER
INTEGER*4 J !LOCAL DO-LOOP COUNTER
CHARACTER*84 CHRBUF !CHARACTER BUFFER FOR "LIB$GET_FOREIGN"
BYTE FILSPC(84) !ASCII ARRAY FOR COMMAND-LINE
INTEGER*2 NCHARS !COMMAND-LINE CHARACTER-COUNT
INTEGER*2 NUMDIG !NUMBER OF DIGITS IN RECORD NUMBER
INTEGER*4 SYSTAT !STATUS VALUE FOR "GET-FOREIGN-COMMAND-LINE"
INTEGER*4 LIB$GET_FOREIGN !"GET-FOREIGN-COMMAND-LINE" FUNCTION
INTEGER*4 LIB$CVT_DTB !"CONVERT-DECIMAL-TO-BINARY" FUNCTION
C
EQUIVALENCE (CHRBUF,FILSPC)
C
C
C
C
C
C$INDENT
C
C SET BAD RETURN STATUS FOR CALLER
STATUS = -1
C
C ASSUME SPECIFICATION IS NOT "ALL"
ALLFLG = 0
C
C GET "FOREIGN" COMMAND-LINE
SYSTAT = LIB$GET_FOREIGN(CHRBUF,,NCHARS)
C
C IF ANY ERROR OCCURRED
IF (SYSTAT) GO TO 10
C
C DECLARE ERROR GETTING COMMAND-LINE
WRITE (*,5)
5 FORMAT(' BPD -- ERROR GETTING COMMAND-LINE',/)
C
C BREAK -- RETURN IMMEDIATELY
GO TO 999
C
C ENDI
10 CONTINUE
C
C IF SPECIFICATION IS "ALL
IF (FILSPC(1) .NE. 'A' .OR. FILSPC(2) .NE. 'L'
*.OR. FILSPC(3) .NE. 'L' .OR. NCHARS .NE. 3) GO TO 20
C
C SET THE "BACKUP-ALL-DISPLAYS" FLAG
ALLFLG = 1
C
C SET A GOOD RETURN STATUS FOR CALLER
STATUS = 1
C
C BREAK -- RETURN TO CALLER NOW
GO TO 999
C
C ENDI
20 CONTINUE
C
C
C
C
C
C CALCULATE NUMBER OF DIGITS IN THE RECORD NUMBER
NUMDIG = NCHARS
C
C IF THE DIGIT-COUNT IS ILLEGAL
IF (NUMDIG .GT. 0 .AND. NUMDIG .LE. 6) GO TO 30
C
C BREAK -- DECLARE SYNTAX ERROR
GO TO 888
C
C ENDI
30 CONTINUE
C
C CONVERT DECIMAL ASCII DIGITS TO BINARY
SYSTAT = LIB$CVT_DTB(%VAL(NUMDIG),FILSPC(1),RECNUM)
C
C IF ANY ERROR OCCURRED
IF (SYSTAT) GO TO 40
C
C DECLARE SYNTAX ERROR
888 WRITE (*,889)
889 FORMAT(' BPD -- COMMAND-LINE SYNTAX ERROR ',
* '(NEED DISPLAY NUMBER OR "ALL")',/)
C
C BREAK -- RETURN TO CALLER
GO TO 999
C
C ENDI
40 CONTINUE
C
C SET GOOD RETURN STATUS FOR CALLER
STATUS = 1
C
C RETURN TO CALLER
999 RETURN
C
C END OF SUBROUTINE
END