META FORTRAN  X08.09		14-OCT-87	17:22:24	PAGE      1
DUTTEST          

    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C FILE NAME DUTTEST
    	C
0001	      PROGRAM DUTTEST
    	C
    	C
    	C       FUNKTION:
    	C       SIMULERAR SERVER GENOM ATT S[NDA TILL DUTACC
    	C       INSTALLERAS SOM SERVER !!!
    	C
    	C       HISTORIK:
    	C       DATUM           NAMN                    ORSAK
    	C       871014          B-E TAPPER              URUPPF\RANDE
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       INTERNA VARIABLER
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C
0002	      INTEGER         QUEBUF(13)      <BUFFER FOR MESSAGE TO QUE
    	C
    	C                       WORD 1          11      REQUEST TYPE (FORMER 8)
    	C                       WORD 2          BUSS NUMBER
    	C                       WORD 3          0       PORT NUMBER
    	C                       WORD 4          MESSAGE TYPE 95--99
    	C                       WORD 5-7        DUTY
    	C                       WORD 8          PNR
    	C                       WORD 9-11       LINRUN
    	C                       WORD 12         TIME (MINUTER EFTER MIDNATT)
    	C                       WORD 13         SPARE
    	C
0003	      INTEGER         RECBUF(15)      <RECEIVE DATA BUFFER
    	C
0004	      INTEGER         COMBUF(13)      <COMMUNICATIONS BUFFER
    	C
0005	      INTEGER         NETBUF(13)      <COMMUNICATIONS BUFFER FOR NETWORK
META FORTRAN  X08.09		14-OCT-87	17:22:24	PAGE      2
DUTTEST          

    	C
    	C                       WORD 1          REQUEST FOR DUTTEST
    	C                                       *       1 = PLEASE GIVE DAYTYPE
    	C                                       *       2 = PLEASE GIVE BUSS + PLAC
    	C                                               3 = PLEASE ALERT NO ARRIV
    	C                                               4 = PLEASE ALERT LATE ARRIV
    	C                                               5 = PLEASE ALERT STRNGE ARRIV
    	C                                       *       6 = PLEASE SHOW ACTIVE PSO-CALLS
    	C                                               7 = spare
    	C                                               8 = SYSTEM-UP-MESSAGE
    	C                                               9 = SYSTEM DOWN MESSAGE
    	C                                               0 = PLEASE EXIT DUTTEST
    	C
    	C                                       * = ANSWER EXPECTED
    	C
    	C               FOR 0-5 WORD 2-4        DUTYID
    	C                       WORD 5          BUSS NUMBER
    	C                       WORD 6          PLAC.
    	C                       WORD 7          DAYTYPE
    	C                       WORD 8          PNR OF OFFENDING PERSON
    	C                       WORD 9-11       LINJE/KURS
    	C                       WORD 12         TIME (INTEGER HHMM)
    	C                       WORD 13         for 2-5: 1=mark as active if possible
    	C                       WORD 13         for 0 and 1: spare
    	C
0006	      INTEGER         FAULT           <TRACE-BACK FAULT CODE
    	C
0007	      INTEGER         MLTYP           <MESSAGE TYPE CODE IN GNDNT
    	C
0008	      INTEGER         IDS             <DIRECTIVE STATUS RETURN CODE
    	C
0009	      BYTE            MLBX(98)        <MAILBOX
    	C
0010	      BYTE            ERRMES(2)       <ERRMES CODE
    	C
0011	      INTEGER         IESB(8)         <EXIT STATUS BLOCK
    	C
0012	      INTEGER         INDEX           <MESSAGE TYPE TO INDICATE WHICH ONE
META FORTRAN  X08.09		14-OCT-87	17:22:24	PAGE      3
DUTTEST          

    	C                                       OF WAITNT:s STATUS BLOCKS THAT COMPLETED
    	C
0013	      INTEGER         IOST(2)         <IO-STATUS BLOCK
0014	      INTEGER         IOSTG(2)        <IO-STATUS BLOCK FOR GNDNT
0015	      INTEGER         IOSTR(2)        <IO-STATUS BLOCK FOR RECNT
    	C
0016	      INTEGER         MSTAT(3)        <M-STATUS BLOCK
    	C
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       KONSTANTER
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C
0017	      REAL            QUE             <CALLING TASK RADIX-50 NAME
0018	      DATA    QUE/6R...QUE/
    	C
0019	      INTEGER         FLAGQUE         <GLOBAL EVENTFLAG FOR ...QUE SYNC
0020	      DATA    FLAGQUE/56/             <FLAGQUE FROM [361,10]FLAGQUE.PAS
    	C
0021	      INTEGER         FLAGDUT         <GLOBAL EVENTFLAG FOR DUTACC SYNC
0022	      DATA    FLAGDUT/47/             <EX SPEDUMP FROM [361,10]FLAGCON.PAS
    	C
    	C
0023	      REAL            DUTACC          <CALLING TASK RADIX-50 NAME
0024	      DATA    DUTACC/6RDUTACC/
    	C
    	C
0025	      INTEGER         OPNLUN          <OPEN LUN
0026	      DATA    OPNLUN/1/
    	C
0027	      INTEGER         CONLUN          <CONNECT LUN
0028	      DATA    CONLUN/2/
    	C
0029	      INTEGER         LRP             <LINK RECOVERY PERIOD
0030	      DATA    LRP/1/                  <1 minut
META FORTRAN  X08.09		14-OCT-87	17:22:24	PAGE      4
DUTTEST          

    	C
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C       FORMATSATSER
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
0031	1000  FORMAT(1X,'** DUTTEST ERROR NETWORK CONNECT FAILED. IOST(1)=',I4)
0032	1001  FORMAT(1X,'DUTTEST CONNECTED TO HK::ACCITY')
0033	1002  FORMAT(1X,'DUTTEST CONNECT REQ. RECEIVED.')
0034	1003  FORMAT(1X,'** DUTTEST ERROR INTERRUPT MES. RECEIVED. MES=',2I5)
0035	1004  FORMAT(1X,'** DUTTEST ERROR USER DISCONNECT. MES=',2I5)
0036	1005  FORMAT(1X,'** DUTTEST ERROR USER ABORT. MES=',2I5)
0037	1006  FORMAT(1X,'** DUTTEST ERROR NETWORK ABORT. MES=',2I5)
0038	1007  FORMAT(1X,'** DUTTEST ERROR IN GNDNTW. IOST(1)=',2I5)
0039	1008  FORMAT(1X,'** DUTTEST ERROR IN CLSNTW. IOST(1)=',2I5)
0040	1009  FORMAT(1X,'** DUTTEST ERROR NETWORK DECLARE FAILED. IOST(1)=',I4)
0041	1010  FORMAT(1X,'** DUTTEST FAULT=',I5)
0042	1011  FORMAT(1X,'** DUTTEST ERROR NO LETTER IN MAILBOX')
0043	1012  FORMAT(1X,'** DUTTEST ERROR OTHER MESS. MES=',2I5)
    	C
0044	1020  FORMAT(1X,'DUTTEST RETRIES NETWORK CONNECT.')
0045	1021  FORMAT(1X,'DUTTEST EXITS AS ORDERED.')
    	C
0046	1030  FORMAT(1X,'** DUTTEST ERROR NETWORK DISCONNECT FAILED.
    	     *IOST(1)=',I4)
    	C
0047	2000  FORMAT(1X,'** DUTTEST ERROR MESSAGE TO QUE FAILED. IDS=',I5)
0048	2001  FORMAT(1X,'** DUTTEST ERROR MESSAGE TO DUTACC FAILED. IDS=',I5)
0049	2002  FORMAT(1X,'** DUTTEST ERROR UNSTOP DUTACC FAILED. IDS=',I5)
0050	2003  FORMAT(1X,'** DUTTEST ERROR WAITFR DUTACC FAILED. IDS=',I5)
0051	2004  FORMAT(1X,'** DUTTEST ERROR RECEIVE FROM DUTACC FAILED. IDS=',I5)
0052	2005  FORMAT(1X,'** DUTTEST ERROR DUTACC FAILED TO START AT ALL. IDS=',I5)
    	C
    	C
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
META FORTRAN  X08.09		14-OCT-87	17:22:24	PAGE      5
DUTTEST          

    	C
    	C       STYRSEKTION
    	C
    	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
    	C
    	C
0053	      CALL CHANGE(,0,COMBUF,26)
    	C
0054	      COMBUF(1)=2
0055	      WRITE(5,1)
0056	1     FORMAT('$GE BUSSTJ[NST (3A2):')
0057	      READ(5,2)(COMBUF(I),I=2,4)
0058	2     FORMAT(3A2)
    	C%%%    CALL MOVE01(6,'0.1   ',COMBUF(2))
0059	      CALL SHIFTL(6,COMBUF(2))
0060	      COMBUF(13)=1
    	C
0061	      CALL CLREF(FLAGDUT)      <CLEAR COMMUNICATIONS FLAG
0062	      CALL SEND(DUTACC,COMBUF,,IDS) <SEND LETTER TO DUTACC
0063	      'IF'(IDS.NE.1)
0065	      .   WRITE(5,2001)IDS        <SEND MES TO DUTACC FAILED
0067	      'ENDIF'
    	C
0068	      CALL USTP(DUTACC,IDS)
    	C
0069	      'IF'(IDS.NE.1)  <NOT ACTIVE
0071	      .   CALL REQUES(DUTACC,,IDS)        <REQUEST DUTACC
0072	      .   'IF'(IDS.NE.1)
0074	      .   .   WRITE(5,2002)IDS        <UNSTOP DUTACC FAILED
0076	      .   'ENDIF'
0078	      'ENDIF'
    	C
0079	      'IF'(IDS.EQ.1)
0081	      .   CALL WAITFR(FLAGDUT,IDS)
0082	      .   'IF'(IDS.NE.1)
0084	      .   .   WRITE(5,2003)IDS        <WAITFR ERROR
0086	      .   'ENDIF'
0087	      .   CALL RECEIV(,RECBUF,,IDS)
META FORTRAN  X08.09		14-OCT-87	17:22:24	PAGE      6
DUTTEST          

0088	      .   'IF'(IDS.NE.1)
0090	      .   .   WRITE(5,2004)IDS <REC MES FROM DUTACC FAILED
0092	      .   'ENDIF'
0094	      'ELSE'                  <DUTACC FAILED COMPLETELY
0095	      .   WRITE(5,2005)IDS
0097	      'ENDIF'
    	C
0098	      WRITE(5,10)RECBUF(3)            <REQUEST
0099	10    FORMAT(1X,'REQUEST=',I3)
0100	      WRITE(5,11)(RECBUF(I),I=4,6)    <DUTY
0101	11    FORMAT(1X,'DUTY=',3A2)
0102	      WRITE(5,12)RECBUF(7),RECBUF(8)  <BUSS,DAGTYP
0103	12    FORMAT(1X,'BUSS=',I3,' DAGTYP(O)=',O4)
0104	      WRITE(5,13)(RECBUF(I),I=11,13)  <L/K
0105	13    FORMAT(1X,'L/K=',3A2)
0106	      WRITE(5,14)RECBUF(14)           <TID
0107	14    FORMAT(1X,'TID=',I4)
0108	      WRITE(5,15)RECBUF(15)           <0123
0109	15    FORMAT(1X,'UTK\RD=',I1)
    	C
    	C                       WORD 2-4        DUTYID
    	C                       WORD 5          BUSS NUMBER
    	C                       WORD 6          PLAC.
    	C                       WORD 7          DAYTYPE
    	C                       WORD 8          PNR OF OFFENDING PERSON
    	C                       WORD 9-11       LINJE/KURS
    	C                       WORD 12         TIME (INTEGER HHMM)
    	C                       WORD 13         1: mark as active
    	C                       WORD 13         2: (returned) success
    	C
    	C
0110	      END



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