META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      1
ACCHK            

    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C FILE NAME ACCHK
    	C
0001	      PROGRAM ACCHK
    	C
    	C
    	C       FUNKTION:
    	C       G\R recive data or STOP FORTL\PANDE
    	C       TASKAR SOM SKA COMMUNICERA (=FTJ) G\R SDAT SAMT USTP P] DET
    	C       ACCHK S[NDER INFORMATIONEN VIDARE TILL CITY::BIB000
    	C       UNDER TIDEN DEN V[NTAR P] SVAR G\R DEN STOPFR(FLAG)
    	C       N[R SVARET HAR F]TTS SKRIVER DEN P] SPECOM I FTJCOM
    	C       SAMT G\R VDPSYSMESSAGE TILL DET REQUESTANDE TASKET.
    	C
    	C       HISTORIK:
    	C       DATUM           NAMN                    ORSAK
    	C       870529          B-E TAPPER              URUPPF\RANDE FR]N ACCITY
    	C       870610          B-E TAPPER              kommunikation via specom
    	C       870618          B-E TAPPER              OPTION: KONSOLDUMP
    	C       870626          B-E TAPPER              MERA JOBB, NY KOMMUNIKATION
    	C       870904          B-E TAPPER              VDPSYSMSG DEBUGGAD
    	C
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       INTERNA VARIABLER
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
0002	      LOGICAL*1       NONET           <.TRUE. OM NETACESS FAILS
    	C                                       <WILL CAUSE RETRY TO START NET AT
    	C                                       <EVERY REQUEST
0003	      INTEGER         AFAN
0004	      EQUIVALENCE(NONET,AFAN)
    	C
0005	      LOGICAL*1       STAT            <STATUS RETURN CODE
0006	      INTEGER         BFAN
0007	      EQUIVALENCE(STAT,BFAN)
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      2
ACCHK            

    	C
0008	      INTEGER         RECBUF(15)      <RECEIVA DATA BUFFER
0009	      INTEGER         COMBUF(13)      <COMMUNICATIONS BUFFER
0010	      EQUIVALENCE     (COMBUF(1),RECBUF(3))
0011	      BYTE            HOMBUF(26)      <COMMUNICATIONS BUFFER
0012	      EQUIVALENCE     (HOMBUF(1),COMBUF(1))
    	C
    	C
0013	      INTEGER         RESULT          <TRACE-BACK FAULT CODE
    	C
0014	      INTEGER         FAULT           <TRACE-BACK FAULT CODE
    	C
0015	      INTEGER         MLTYP           <
    	C
0016	      INTEGER         IDS             <DIRECTIVE STATUS RETURN CODE
    	C
0017	      BYTE            CONBLK(72)      <CONNECT BLOCK
    	C
0018	      BYTE            ERRMES(2)       <ERRMES CODE
    	C
0019	      INTEGER         IESB(8)         <EXIT STATUS BLOCK
    	C
0020	      INTEGER         IOST(2)         <IO-STATUS BLOCK
    	C
0021	      INTEGER         MSTAT(3)        <M-STATUS BLOCK
    	C
0022	      REAL            TASK            <CALLING TASK RADIX-50 NAME
    	C
0023	      LOGICAL*1       IMMED           <.TRUE. FOR ???
0024	      INTEGER         CFAN
0025	      EQUIVALENCE(IMMED,CFAN)
    	C
0026	      LOGICAL*1       ABORT           <.TRUE. IF TASK SHALL EXIT
0027	      INTEGER         DFAN
0028	      EQUIVALENCE(ABORT,DFAN)
    	C
0029	      LOGICAL*1       INPROC          <.TRUE. IF REQUEST IN PROCESS
0030	      INTEGER         EFAN
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      3
ACCHK            

0031	      EQUIVALENCE(INPROC,EFAN)
    	C
0032	      LOGICAL*1       DUMP            <.TRUE. FOR TRACE DUMP
    	C
0033	      INTEGER REC                     <VDP NUMBER TO RECIVE DATA
0034	      INTEGER MESBLK(20)              <(7) = MESTYPE
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       COMMONS
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
0035	      INTEGER SPECOM(4015)            <HELA SPECOM
0036	      COMMON/SPECOM/SPECOM
    	C
    	C       NYA STARTADRESSEN ANTAGES TILL 17004
    	C
0037	      INTEGER RECDUM(13)
0038	      EQUIVALENCE(SPECOM(3843),RECDUM)
    	C
0039	      INTEGER PG1BUF(160)
0040	      EQUIVALENCE(SPECOM(3856),PG1BUF)
0041	      EQUIVALENCE(RAD(1,1),PG1BUF)
0042	      BYTE RAD(80,4)
0043	      BYTE RAD1(80)
0044	      EQUIVALENCE(RAD(1,1),RAD1)
0045	      BYTE RAD2(80)
0046	      EQUIVALENCE(RAD(1,2),RAD2)
0047	      BYTE RAD3(80)
0048	      EQUIVALENCE(RAD(1,3),RAD3)
0049	      BYTE RAD4(80)
0050	      EQUIVALENCE(RAD(1,4),RAD4)
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       KONSTANTER
    	C
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      4
ACCHK            

    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C
0051	      BYTE            NDNAM(6)        <NODE NAME
0052	      'ASCII' NDNAM/HK    /
0053	      INTEGER         NDLEN
0054	      DATA    NDLEN/2/
    	C
0055	      BYTE            TSKNAM(6)       <TASK NAME
0056	      'ASCII' TSKNAM/BIB000/
0057	      INTEGER         TSKLEN
0058	      DATA    TSKLEN/6/
    	C
0059	      INTEGER         OPNLUN          <OPEN LUN
0060	      DATA    OPNLUN/1/
    	C
0061	      INTEGER         CONLUN          <CONNECT LUN
0062	      DATA    CONLUN/2/
    	C
0063	      INTEGER         LRP             <LINK RECOVERY PERIOD
0064	      DATA    LRP/60/                 <60 SEKUNDER = 1 MINUT
    	C
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       FORMATSATSER
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
0065	1000  FORMAT(1X,'** ACCHK ERROR NETWORK CONNECT FAILED. IOST(1)=',I4)
0066	1001  FORMAT(1X,'ACCHK CONNECTED TO HK::BIB000.')
0067	1002  FORMAT(1X,'** ACCHK ERROR CONNECT REQ. RECEIVED. MES=',2I5)
0068	1003  FORMAT(1X,'** ACCHK ERROR INTERRUPT MES. RECEIVED. MES=',2I5)
0069	1004  FORMAT(1X,'** ACCHK ERROR USER DISCONNECT. MES=',2I5)
0070	1005  FORMAT(1X,'** ACCHK ERROR USER ABORT. MES=',2I5)
0071	1006  FORMAT(1X,'** ACCHK ERROR NETWORK ABORT. MES=',2I5)
0072	1007  FORMAT(1X,'** ACCHK ERROR IN GNDNTW. IOST(1)=',2I5)
0073	1008  FORMAT(1X,'** ACCHK ERROR IN CLSNTW. IOST(1)=',2I5)
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      5
ACCHK            

0074	1010  FORMAT(1X,'** ACCHK FAULT=',I5)
    	C
0075	1020  FORMAT(1X,'ACCHK RETRIES NETWORK CONNECT.')
0076	1021  FORMAT(1X,'ACCHK EXITS AS ORDERED.')
    	C
0077	1030  FORMAT(1X,'** ACCHK ERROR NETWORK DISCONNECT FAILED.
    	     *IOST(1)=',I4)
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       STYRSEKTION
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
0078	      ABORT=.FALSE.           <SHALL NOT ABORT
0079	      IMMED=.TRUE.            <FORCES GNDTW TO COMPLETE
0080	      INPROC=.FALSE.          <REQUEST NOT IN PROCESS YET
0081	      DUMP=.FALSE.
    	C
    	C%%     WRITE(5,10)
    	C%%10   FORMAT('$DUMP (T/F)')
    	C%%     READ(5,20)DUMP
    	C%%20   FORMAT(L1)
    	C
0082	      'WHILE'(.TRUE.)         <NEVER EXIT THIS LOOP
    	C
    	C
    	C       -- DECLARE AS DECNET TASK
    	C
0084	      .   NONET=.FALSE.           <NET IS ACCESSED
0085	      .   CALL OPNNTW(OPNLUN,IOST,MSTAT,0,LRP)
0086	      .   'IF'(IOST(1).NE.1)
0088	      .   .   NONET=.TRUE.
0090	      .   'ELSE'
    	C
    	C       -- BUILD CONNECT BLOCK FOR HK::BIB000
    	C
0091	      .   .   CALL BFMT1(STAT,CONBLK,NDLEN,NDNAM,0,TSKLEN,TSKNAM)
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      6
ACCHK            

0092	      .   .   'IF'(.NOT.STAT)
0094	      .   .   .   STOP 'BUILD CONNECT BLOCK'
0096	      .   .   'ENDIF'                 
    	C
    	C       -- OPEN LOGICAL LINK TO HK::BIB000 AND REQUEST IT
    	C
0097	      .   .   CALL CONNTW(CONLUN,IOST,CONBLK,2,'CO')
0098	      .   .   'IF'(IOST(1).NE.1)
0100	      .   .   .   NONET=.TRUE.
0101	      .   .   .   WRITE(5,1000)IOST(1)    <CONNECT FAILED
0103	      .   .   .   'PERFORM' DEACCES
0106	      .   .   'ELSE'
0107	      .   .   .   WRITE(5,1001)           <CONNECT OK
0109	      .   .   'ENDIF'
0111	      .   'ENDIF'
    	C
    	C       -- INNER LOOP
    	C
0112	      .   'WHILE'(.TRUE.)
    	C
0114	      .   .   'POSIT'         <EJ SYSTEMFEL VID FR]GA TILL CITY
    	C
    	C       - GET ALL DATA FROM NETWORK QUE IF NET IS UP
    	C
0115	      .   .   .   'IF'(.NOT.NONET)
0117	      .   .   .   .   'WHILE'(MSTAT(1).NE.0)  <FINNS BREV I N[TK\N
    	C
0119	      .   .   .   .   .   CALL GNDNTW(IOST,MLTYP,2,ERRMES,,IMMED)
0120	      .   .   .   .   .   'IF'(IOST(1).GT.0)
0122	      .   .   .   .   .   .   'CASE' MLTYP
0123	      .   .   .   .   .   .   'WHEN' 1
0125	      .   .   .   .   .   .   .   WRITE(5,1002)ERRMES <ERROR: CONNECT REQUEST
0127	      .   .   .   .   .   .   'WHEN' 2
0129	      .   .   .   .   .   .   .   WRITE(5,1003)ERRMES <ERROR: INTERRUPT MESSAGE
0130	      .   .   .   .   .   .   .   NONET=.TRUE.
0132	      .   .   .   .   .   .   .   'PERFORM' DEACCES
0134	      .   .   .   .   .   .   .   'BREAK'
0136	      .   .   .   .   .   .   'WHEN' 3
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      7
ACCHK            

0138	      .   .   .   .   .   .   .   WRITE(5,1004)ERRMES     <ERROR: USER DISCNCT
0139	      .   .   .   .   .   .   .   NONET=.TRUE.
0141	      .   .   .   .   .   .   .   'PERFORM' DEACCES
0143	      .   .   .   .   .   .   .   'BREAK'
0145	      .   .   .   .   .   .   'WHEN' 4
0147	      .   .   .   .   .   .   .   WRITE(5,1005)ERRMES     <ERROR: USER ABORT
0148	      .   .   .   .   .   .   .   NONET=.TRUE.
0150	      .   .   .   .   .   .   .   'PERFORM' DEACCES
0152	      .   .   .   .   .   .   .   'BREAK'
0154	      .   .   .   .   .   .   'WHEN' 5
0156	      .   .   .   .   .   .   .   WRITE(5,1006)ERRMES     <NETWORK ABORT
0157	      .   .   .   .   .   .   .   NONET=.TRUE.
0159	      .   .   .   .   .   .   .   'PERFORM' DEACCES
0161	      .   .   .   .   .   .   .   'BREAK'
0163	      .   .   .   .   .   .   'ENDCASE'
0165	      .   .   .   .   .   'ELSE'                          <IGNORE
0166	      .   .   .   .   .   .   WRITE(5,1007)IOST(1)    <ERROR IN GNDNT
0167	      .   .   .   .   .   .   NONET=.TRUE.
0169	      .   .   .   .   .   .   'PERFORM' DEACCES
0171	      .   .   .   .   .   .   'BREAK'
0173	      .   .   .   .   .   'ENDIF'
    	C
0174	      .   .   .   .   'ENDDO'
0177	      .   .   .   'ENDIF'
    	C
    	C       -- RECEIVE ORDER OR STOP
    	C
0178	      .   .   .   'IF'(.NOT.INPROC)
0180	      .   .   .   .   FAULT=1
0181	      .   .   .   .   'REPEAT'
0182	      .   .   .   .   .   CALL RCST(,RECBUF,IDS)
0183	      .   .   .   .   'UNTIL'(IDS.NE.2)       <UNSTOPPED WITHOUT LETTER
0186	      .   .   .   .   'QUITIF'(IDS.NE.1)
    	C
    	C       -- PREPARE QUERY BUFFER
    	C
0188	      .   .   .   .   CALL MOVE01(4,RECBUF,TASK)
0189	      .   .   .   .   REC=HOMBUF(26)                  <TERMINAL VDP NUMBER
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      8
ACCHK            

0190	      .   .   .   .   INPROC=.TRUE.                   <TASK NAME SET - REQ. IN PROCESS
    	C
0192	      .   .   .   'ELSE'
0193	      .   .   .   .   'QUITIF'(NONET)         <ALREADY TRIED TO RESTART NETWORK
    	C                                               <DO GO ANSWER
0196	      .   .   .   'ENDIF'
    	C
0197	      .   .   .   'BREAKIF'(NONET)                <NET NOT CONNECTED, TRY CONNECT
    	C
0199	      .   .   .   'IF'(DUMP)
0201	      .   .   .   .   WRITE(5,2000)HOMBUF,HOMBUF
0202	2000  .   .   .   .   FORMAT(1X,26I4/26(1X,A1)/)
0204	      .   .   .   'ENDIF'
    	C
    	C
0205	      .   .   .   CALL SNDNTW(CONLUN,IOST,26,COMBUF)
0206	      .   .   .   'IF'(IOST(1).EQ.1)
    	C
    	C       -- TAKE ANSWER BUFFER
    	C
0208	      .   .   .   .   CALL RECNTW(CONLUN,IOST,320,PG1BUF)
0209	      .   .   .   .   'IF'(IOST(1).NE.1)
0211	      .   .   .   .   .   NONET=.TRUE.
0213	      .   .   .   .   .   'PERFORM' DEACCES
0215	      .   .   .   .   .   'QUIT'          <GO ANSWER
0217	      .   .   .   .   'ENDIF'
    	C
0219	      .   .   .   'ELSE'
0220	      .   .   .   .   NONET=.TRUE.
0222	      .   .   .   .   'PERFORM' DEACCES
0224	      .   .   .   .   'BREAK'         <TRY RECONNECT
0226	      .   .   .   'ENDIF'
    	C
    	C
    	C       -- PREPARE TO ANSWER STARTING TASK
    	C
0227	      .   .   .   IDS=9999
0228	      .   .   .   MESBLK(7)=12
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE      9
ACCHK            

    	C
    	C       WRITE(5,11)MESBLK,REC,IDS,MESBLK,REC,IDS
    	C
0229	      .   .   .   CALL VDPSYS(MESBLK,REC,0,IDS)
    	C
    	C       WRITE(5,11)MESBLK,REC,IDS,MESBLK,REC,IDS
    	C11     FORMAT(1X,10I6/1X,10I6/1X,I4,1X,I4//
    	C       11X,10O7/1X,10O7/1X,O5/1X,O5)
    	C
0230	      .   .   .   FAULT=4
0231	      .   .   .   'QUITIF'(IDS.NE.0)
0233	      .   .   .   FAULT=41
0234	      .   .   .   'QUITIF'(MESBLK(14).NE.1)       <SOME ERROR FROM VDP INTERFACE
0236	      .   .   .   INPROC=.FALSE.
    	C
    	C
0238	      .   .   'ADMIT'
0239	      .   .   .   WRITE(5,1010)FAULT      <ACCHK FAULT OR OTHER FAULT
0240	      .   .   .   RESULT=-1
0241	      .   .   .   'IF'(INPROC)
0243	      .   .   .   .   CALL CHANGE(,' ',PG1BUF,320)
0244	      .   .   .   .   CALL MOVE01(33,'** INGEN KONTAKT MED DATABASEN **',RAD1)
0245	      .   .   .   .   MESBLK(9)=12
0246	      .   .   .   .   CALL VDPSYS(MESBLK,REC,0,IDS)
0247	      .   .   .   .   FAULT=4
0248	      .   .   .   .   'IF'(IDS.NE.0)
0250	      .   .   .   .   .   WRITE(5,1010)FAULT      <ACCHK FAULT
0252	      .   .   .   .   'ENDIF'
0253	      .   .   .   .   INPROC=.FALSE.
0255	      .   .   .   'ENDIF'
0256	      .   .   'ENDPOSIT'
    	C
0257	      .   'ENDDO'
    	C
    	C       - CLOSE NETWORK CONNECTION
    	C
0259	      .   CALL CLSNTW(IOST)
0260	      .   'IF'(IOST(1).NE.1)
META FORTRAN  X08.09		21-OCT-87	02:22:32	PAGE     10
ACCHK            

0262	      .   .   WRITE(5,1008)IOST(1)    <CLOSE FAILED
0264	      .   'ENDIF'
    	C
0265	      .   'BREAKIF'(ABORT)                <NOT USED
    	C
0267	      .   WRITE(5,1020)           <RETRY ESTABLISH DECNET LINKS
    	C
0268	      'ENDDO'
    	C
0270	      WRITE(5,1021)           <ACCHK EXITS
    	C
    	C       - EXIT TASK
    	C
0271	      CALL EXIT
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       #DEACCES                TERMINATE LOGICAL LINK
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
0274	      'SECTION' DEACCES
    	C
    	C       - DISCONNECT ACTIVITY ON LOGICAL LINK
    	C
0275	      .   CALL DSCNTW(CONLUN,IOST)
0276	      .   'IF'(IOST(1).NE.1)
0278	      .   .   WRITE(5,1030)IOST(1)    <DISCONNECT FAILED
0280	      .   'ENDIF'
    	C
0281	      'ENDSECT'
    	C
    	C
0283	      END



ERRORS DETECTED:      0
SC:ACCHK,SC:ACCHK.MLS/-SP=SC:ACCHK