FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 001 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C FILE NAME SERVER C 0001 PROGRAM SERVER C C C FUNKTION: C DETTA [R RADIOSYSTEMETS N[TVERKSPROGRAM F\R UTK\RNINGSBEVAKNINGEN. C DESS UPPGIFT [R ATT UPPR[TTH]LLA EN L[NK TILL HK::ACCITY F\R UTV[XLING C AV DATA OCH ATT FR]GA DUTACC EFTER UPPGIFTER UR RADIODATABASEN SAMT ATT C GE UPPGIFTER TILL ...QUE OM MEDDELANDEN ATT L[GGA UPP I K\N. C C TASKET COMMUNICERAR MED "HK"::ACCITY OCH SERVAR DESS REQUEST. C AVKODAR INFORMATIONEN SAMT S[NDER FR]GOR OCH TAR EMOT SVAR FR]N C DUTACC SAMT S[NDER ORDER TILL ...QUE (RADIOSYSTEMETS ALLTS]) C C KVITTENSER SAMT SVAR S[NDS TILLBAKA TILL ACCITY. C C UNDER TIDEN DEN V[NTAR P] ORDER G\R DEN WAITNT C C HISTORIK: C DATUM NAMN ORSAK C 860128 B-E TAPPER URUPPF\RANDE C 860129 B-E TAPPER MERA JOBB C 860131 B-E TAPPER MERA JOBB C 860201 B-E TAPPER F[RDIGT C 860207 B-E TAPPER FLAGQUE =56 + UTSKRIFTER C 860214 B-E TAPPER BUGGAR R[TTADE C 860217 B-E TAPPER NY KOMMUNIKATION MED DUTACC C 860220 B-E TAPPER DRIFTSS[TTNING C 860502 JBdk & BTA REQ.TYPE 8 -> 11 TO QUE C 861213 BTA TILL UBABJBDK C 870923 BTA LARM VID N[TAVBROTT C 870928 BTA CIO TRYCKER UT C 871007 BTA kan s{tta car active C 871015 BTA GENOMG]NGET C 871102 BTA SJ[LVUPPL\SANDE OM UR SYNK MED C DUTACC C 880213 BTA T\MNING AV RECEIVE-BUFFER VID C ABORT FEL C 880213 BTA B[TTRE MODULARISERING. C 880330 BTA CANCEL MARKTIME + H[NGSKYDD C C C KOM IH]G: COMBUF(2) MODIFIERAS I DOIT (SHIFTLEFT) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C DEFINITION OF MAPPED COMMON AREA SPECOM C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C 0002 INTEGER SPECOM(3842) FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 002 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0003 COMMON/SPECOM/SPECOM C 0004 INTEGER SPICOM(170) 0005 EQUIVALENCE(SPECOM(1),SPICOM(1)) C SPECOM 000000-R C 0006 INTEGER QELMTS 0007 EQUIVALENCE(SPECOM(171),QELMTS) C QELMTS 000524-R C 0008 INTEGER QLENGT 0009 EQUIVALENCE(SPECOM(172),QLENGT) C QLENGT 000526-R C 0010 INTEGER QHHEAD(3) 0011 EQUIVALENCE(SPECOM(173),QHHEAD(1)) C QHHEAD 000530-R C 0012 INTEGER QLHEAD(3) 0013 EQUIVALENCE(SPECOM(176),QLHEAD(1)) C QLHEAD 000536-R C 0014 INTEGER QUECOM(1764) 0015 EQUIVALENCE(SPECOM(179),QUECOM(1)) C QUECOM 000544-R C 0016 INTEGER QPRES(36) 0017 EQUIVALENCE(SPECOM(1943),QPRES(1)) C QPRES 007454-R C 0018 INTEGER UBABCO(76) 0019 EQUIVALENCE(SPECOM(1979),UBABCO(1)) C UBABCO 007564-R C 0020 INTEGER SCARCO(26) 0021 EQUIVALENCE(SPECOM(2055),SCARCO(1)) C SCARCO 010014-R C 0022 INTEGER LATECO(103) 0023 EQUIVALENCE(SPECOM(2081),LATECO(1)) C LATECO 010100-R C 0024 INTEGER NODUCO(113) 0025 EQUIVALENCE(SPECOM(2184),NODUCO(1)) C NODUCO 010416-R C 0026 INTEGER BUSCO(61) 0027 EQUIVALENCE(SPECOM(2297),BUSCO(1)) C BUSCO 010760-R C 0028 INTEGER XTRCO(151) 0029 EQUIVALENCE(SPECOM(2358),XTRCO(1)) C XTRCO 011152-R C FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 003 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0030 INTEGER OPRCO(189) 0031 EQUIVALENCE(SPECOM(2509),OPRCO(1)) C OPRCO 011630-R C 0032 INTEGER STACO(9) 0033 EQUIVALENCE(SPECOM(2698),STACO(1)) C STACO 012422-R C 0034 INTEGER RADCO(1110) 0035 EQUIVALENCE(SPECOM(2707),RADCO(1)) C RADCO 012444-R C 0036 INTEGER NQDCO(3) 0037 EQUIVALENCE(SPECOM(3817),NQDCO(1)) C NQDCO 016720-R C 0038 INTEGER RESCO(20) 0039 EQUIVALENCE(SPECOM(3820),RESCO(1)) C RESCO 016726-R C 0040 INTEGER PSTCO(3) 0041 EQUIVALENCE(SPECOM(3840),PSTCO(1)) C PSTCO 016776-R C C C C Task image size : 3872. words C Task address limits: 000000 017003 C R/W mem limits: 000000 017003 017004 07684. C C SPECOM:(RW,D,GBL,REL,OVR) 000000 017004 07684. C 000000 017004 07684. SPECOM DATOPROLB.OLB;12 C SPECOM 000000-R C QELMTS 000524-R C QLENGT 000526-R C QHHEAD 000530-R C QLHEAD 000536-R C QUECOM 000544-R C QPRES 007454-R C UBABCO 007564-R C SCARCO 010014-R C LATECO 010100-R C NODUCO 010416-R C BUSCO 010760-R C XTRCO 011152-R C OPRCO 011630-R C STACO 012422-R C RADCO 012444-R C NQDCO 016720-R C RESCO 016726-R C PSTCO 016776-R C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 004 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER C COPYTEXTER (SUBCOMMONS) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C C* SC:[361,15]UBABCOM.CPY CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C FILE NAME UBAB:[361,15]UBABCOM.CPY C FILE NAME VT:[200,143]UBABCOM.CPY C C THIS COPYTEXT DEFINES UBABCO PART OF SPECOM C C C C C; ************************************************************ C; THIS COMMON COMMON AREA IS USED FOR UBABVAR. C; WHEN THE SYSTEM IS INITIATED, A PROMGRAM READS THE CRF11 FILE C; UBABVAR.REG INTO THIS COMMON AREA. C; C; THE PASCAL DEFINITION IS DESCRIBED IN [361,10] UBABPNT.PAS C; -------------------- CUBABPT:: C 0042 INTEGER UBABPT(76) C C .WORD 0,0,0 ;VERSION DATE DISPLAYED 0043 INTEGER UDATE(3) 0044 EQUIVALENCE(UBABPT(1),UDATE(1)) C C .WORD 0 ;DAYTYPE TODAY 0045 INTEGER UDAG1TYP 0046 EQUIVALENCE(UBABPT(4),UDAG1TYP) C C .BYTE 40,40,40,40,40,40,40,40 ;DAYNAME TODAY 0047 BYTE UDAG1NAMN(8) 0048 EQUIVALENCE(UBABPT(5),UDAG1NAMN(1)) C C .WORD -1 ;DAYTYPE TOMORROW 0049 INTEGER UDAG2TYP 0050 EQUIVALENCE(UBABPT(9),UDAG2TYP) C C .BYTE 40,40,40,40,40,40,40,40 ;DAYNAME TOMORROW 0051 BYTE UDAG2NAMN(8) 0052 EQUIVALENCE(UBABPT(10),UDAG2NAMN(1)) C C .WORD -1 ;DAYTYPE NEXT DAY 0053 INTEGER UDAG3TYP 0054 EQUIVALENCE(UBABPT(14),UDAG3TYP) C C .BYTE 40,40,40,40,40,40,40,40 ;DAYNAME NEXT DAY 0055 BYTE UDAG3NAMN(8) 0056 EQUIVALENCE(UBABPT(15),UDAG3NAMN(1)) C FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 005 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER C .WORD 0 ;PLANFLAG (1 IF PLANNED TODAY) 0057 INTEGER UPLAN 0058 EQUIVALENCE(UBABPT(19),UPLAN) C C .WORD 30. ;CIO: MINUTER ATT GODTA F\RE C ;PLANERAD UTK\RNING 0059 INTEGER UCIO1TID 0060 EQUIVALENCE(UBABPT(20),UCIO1TID) C C .WORD 20. ;CIO: MINUTER ATT GODTA F\RE C ;PLANERAD INK\RNING 0061 INTEGER UCIO2TID 0062 EQUIVALENCE(UBABPT(21),UCIO2TID) C C .WORD 7. ;PIO: MINUTER ATT GODTA F\RE C ;VARNING P] EJ PLACERAD 0063 INTEGER UPIOTID 0064 EQUIVALENCE(UBABPT(22),UPIOTID) C C .WORD 0 ;DUMMY WORD 0065 INTEGER UDUMMY 0066 EQUIVALENCE(UBABPT(23),UDUMMY) C C .WORD 0 ;AKTUELLT REFERENCE NUMBER 0067 INTEGER UREFNO 0068 EQUIVALENCE(UBABPT(24),UREFNO) C C .WORD 0 ;DAYSHIFT (N[R DYGNSKIFT P]G]R) 0069 INTEGER UDAYSHIF 0070 EQUIVALENCE(UBABPT(25),UDAYSHIF) C C .ASCII 'M]NDAG ' ;DAYNAMES C .ASCII 'TISDAG ' ; C .ASCII 'ONSDAG ' ; C .ASCII 'TORSDAG ' ; C .ASCII 'FREDAG ' ; C .ASCII 'L\RDAG ' ; C .ASCII 'S\NDAG ' ; C .ASCII 'SPECIAL ' ; 0071 INTEGER UDUMTXT(32) 0072 EQUIVALENCE(UBABPT(26),UDUMTXT(1)) C C .WORD 0 ;Protocol initialization 0073 INTEGER UPRTINI 0074 EQUIVALENCE(UBABPT(58),UPRTINI) C C .BLKW 18. ;DUMMIES 0075 INTEGER UDUMBLW(18) 0076 EQUIVALENCE(UBABPT(59),UDUMBLW(1)) C C C .ENDR C C* END OF COPY TEXT FILE FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 006 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0077 EQUIVALENCE(UBABPT(1),UBABCO(1)) C C* SC:[361,15]PSTCOM.CPY &=X CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C FILE NAME UBAB:[361,15]PSTCOM.CPY C FILE NAME VT:[200,143]PSTCOM.CPY C C THIS COPYTEXT DEFINES PSTCOM PART OF SPECOM C C C The pascal definitions is described in [375,10]PRTKLTYP.PAS C ------------------- C C C CPSTCO:: C 0078 INTEGER XPSTPT(3) C C .WORD 0 0079 INTEGER XPSO1 0080 EQUIVALENCE(XPSTPT(1),XPSO1) C .WORD 0 ;PSEUDO OPERATOR 2 0081 INTEGER XPSO2 0082 EQUIVALENCE(XPSTPT(2),XPSO2) C .WORD 0 ;PSEUDO OPERATOR 3 0083 INTEGER XPSO3 0084 EQUIVALENCE(XPSTPT(3),XPSO3) C C .ENDR C C* END OF COPY TEXT FILE 0085 EQUIVALENCE(XPSTPT(1),PSTCO(1)) C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C INTERNA VARIABLER C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 0086 INTEGER QUEBUF(13) 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 FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 007 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0087 INTEGER RECBUF(15) C 0088 INTEGER COMBUF(13) C 0089 INTEGER NETBUF(13) C 0090 INTEGER SNDBUF(13) C C WORD 1 REQUEST FOR SERVER 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 SERVER 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 C FOR 6 WORD 2-4 TIME FOR PSO-OPERATOR 1-3 C WORD 5-13 spare C 0091 INTEGER FAULT C 0092 INTEGER MLTYP C 0093 INTEGER IDS C 0094 BYTE MLBX(98) C 0095 BYTE ERRMES(2) C 0096 INTEGER IESB(8) C 0097 INTEGER INDEX C OF WAITNT:s STATUS BLOCKS THAT COMPLETED C 0098 INTEGER IOST(2) 0099 INTEGER IOSTG(2) 0100 INTEGER IOSTR(2) 0101 INTEGER IOSTS(2) FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 008 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER C 0102 INTEGER MSTAT(3) C 0103 INTEGER COUNT C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C KONSTANTER C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 0104 REAL QUE 0105 DATA QUE/6R...QUE/ C 0106 INTEGER FLAGQUE 0107 DATA FLAGQUE/56/ C 0108 INTEGER FLAGDUT 0109 DATA FLAGDUT/47/ C C 0110 REAL DUTACC 0111 DATA DUTACC/6RDUTACC/ C C 0112 INTEGER OPNLUN 0113 DATA OPNLUN/1/ C 0114 INTEGER CONLUN 0115 DATA CONLUN/2/ C 0116 INTEGER LRP 0117 DATA LRP/0/ C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C FORMATSATSER C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C 0118 999 FORMAT(1X,'SERVER: CONNECTED TO HK::ACCITY') 0119 1000 FORMAT('$** SERVER ERROR: ') 0120 1001 FORMAT('+NETWORK CONNECT FAILED. IOST(1)=',I4) 0121 998 FORMAT(1X,'SERVER: CONNECT REQ. RECEIVED.') 0122 1003 FORMAT('+INTERRUPT MES. RECEIVED. MES=',2I5) 0123 1004 FORMAT('+USER DISCONNECT. MES=',2I5) 0124 1005 FORMAT('+USER ABORT. MES=',2I5) 0125 1006 FORMAT('+NETWORK ABORT. MES=',2I5) 0126 1007 FORMAT('+IN GNDNT. IOSTG=',2I5) 0127 1008 FORMAT('+IN CLSNTW. IOST=',2I5) 0128 1009 FORMAT('+NETWORK DECLARE FAILED. IOST=',2I5) FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 009 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0129 1010 FORMAT('+FAULT=',I5) 0130 1011 FORMAT('+NO LETTER IN MAILBOX') 0131 1012 FORMAT('+OTHER MESS. MES=',2I5) 0132 1013 FORMAT('+IN SNDNT. IOSTS=',2I5) 0133 1014 FORMAT('+IN RECNT. IOSTR=',2I5) C 0134 1020 FORMAT(1X,'SERVER RETRIES NETWORK CONNECT.') 0135 1021 FORMAT(1X,'SERVER EXITS AS ORDERED.') C 0136 1030 FORMAT('+NETWORK DISCONNECT FAILED. * IOST=',2I5) C 0137 2000 FORMAT('+MESSAGE TO QUE FAILED. IDS=',I5) 0138 2001 FORMAT('+MESSAGE TO DUTACC FAILED. IDS=',I5) 0139 2002 FORMAT('+UNSTOP AND REQUEST DUTACC FAILED. IDS=',I5) 0140 2003 FORMAT('+WAITFR DUTACC FAILED. IDS=',I5) 0141 2004 FORMAT('+RECEIVE FROM DUTACC FAILED. IDS=',I5) 0142 2005 FORMAT('+RECEIVE FROM DUTACC WRONG. ABORTED.') 0143 2006 FORMAT('+COMM. WITH DUTACC RETRIED. IDS=',I5) 0144 2007 FORMAT('+MARK TIME DUTACC FAILED. IDS=',I5) C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C STYRSEKTION C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 0145 CONTINUE C 0146 IOSTS(1)=1 C C -- DECLARE AS DECNET TASK C 0147 FAULT=1 0148 CALL OPNNTW(OPNLUN,IOST,MSTAT,0,LRP) 0149 IF(.NOT.(IOST(1).NE.1))GOTO 30016 0151 WRITE(5,1000) 0152 WRITE(5,1009)IOST 0153 CALL EXIT 0154 GOTO 30079 0155 30016 IF(.NOT.(MSTAT(1).EQ.0))GOTO 30017 0157 WRITE(5,1000) 0158 WRITE(5,1011) 0159 GOTO 29000 0160 30017 CONTINUE 0161 30079 CONTINUE C C - GET DATA FROM NETWORK QUE C 0162 CALL GNDNT(IOSTG,MLTYP,98,MLBX) C FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 010 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER C - LOOP C 0163 20000 IF(.NOT.(.TRUE.))GOTO 20001 C 0165 CALL WAITNT(INDEX,IOSTG,IOSTR) C 0166 IF(.NOT.(IOSTG(1).GT.0))GOTO 30080 0168 FAULT=MLTYP 0169 CONTINUE 0170 IF (MLTYP.NE.1)GOTO 40001 0172 CALL ACCNTW(CONLUN,IOST,MLBX) 0173 WRITE(5,998) 0174 IF(.NOT.(IOST(1).NE.1))GOTO 30144 0176 WRITE(5,1000) 0177 WRITE(5,1001)IOST 0178 GOTO 29000 0179 GOTO 30207 0180 30144 CONTINUE 0181 CALL RECNT(CONLUN,IOSTR,26,NETBUF) 0182 CALL GNDNT(IOSTG,MLTYP,98,MLBX) 0183 CALL CHANGE(,0,COMBUF,26) 0184 COMBUF(1)=8 0185 ASSIGN 26000 TO M00000 0186 GOTO 27000 0187 26000 CONTINUE 0188 WRITE(5,999) 0189 30206 CONTINUE 0190 30207 CONTINUE 0191 GOTO 40063 0192 40001 IF (MLTYP.NE.2)GOTO 40002 0194 WRITE(5,1000) 0195 WRITE(5,1003)ERRMES 0196 GOTO 29000 0197 GOTO 40063 0198 40002 IF (MLTYP.NE.3)GOTO 40003 0200 WRITE(5,1000) 0201 WRITE(5,1004)ERRMES 0202 GOTO 29000 0203 GOTO 40063 0204 40003 IF (MLTYP.NE.4)GOTO 40004 0206 WRITE(5,1000) 0207 WRITE(5,1005)ERRMES 0208 GOTO 29000 0209 GOTO 40063 0210 40004 IF (MLTYP.NE.5)GOTO 40005 0212 WRITE(5,1000) 0213 WRITE(5,1006)ERRMES 0214 GOTO 29000 0215 GOTO 40063 0216 40005 CONTINUE 0217 WRITE(5,1000) 0218 WRITE(5,1012)ERRMES 0219 GOTO 29000 0220 40062 CONTINUE FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 011 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0221 40063 CONTINUE 0222 GOTO 30143 0223 30080 IF(.NOT.(IOSTG(1).LT.0))GOTO 30081 0225 WRITE(5,1000) 0226 WRITE(5,1007)IOSTG 0227 FAULT=6 0228 CALL XMINT(CONLUN,IOST,2,'GD') 0229 GOTO 29000 0230 GOTO 30143 0231 30081 CONTINUE 0232 CONTINUE 0233 30142 CONTINUE 0234 30143 CONTINUE C C C 0235 IF(.NOT.(IOSTR(1).EQ.1))GOTO 30208 C 0237 FAULT=0 0238 IF (NETBUF(1).EQ.0) GOTO 29000 0240 CALL MOVE01(26,NETBUF,COMBUF) 0241 CALL RECNT(CONLUN,IOSTR,26,NETBUF) 0242 ASSIGN 26001 TO M00000 0243 GOTO 27000 0244 26001 CONTINUE 0245 IF(.NOT.(COMBUF(1).EQ.1 .OR. COMBUF(1).EQ.2 .OR. * COMBUF(1).EQ.6))GOTO 30272 0247 IF(.NOT.(IOSTS(1).NE.1))GOTO 30336 0249 WRITE(5,1000) 0250 WRITE(5,1013)IOSTS 0251 CALL XMINT(CONLUN,IOST,2,'SN') 0252 GOTO 29000 0253 30336 CONTINUE 0254 30399 CONTINUE 0255 CALL MOVE01(26,COMBUF,SNDBUF) 0256 CALL SNDNT(CONLUN,IOSTS,26,SNDBUF) 0257 30272 CONTINUE 0258 30335 CONTINUE C 0259 GOTO 30271 0260 30208 IF(.NOT.(IOSTR(1).NE.0))GOTO 30209 C 0262 CALL XMINT(CONLUN,IOST,2,'RD') 0263 WRITE(5,1000) 0264 WRITE(5,1014)IOSTR 0265 GOTO 29000 0266 GOTO 30271 0267 30209 CONTINUE 0268 CONTINUE 0269 30270 CONTINUE 0270 30271 CONTINUE C C 0271 GOTO 20000 FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 012 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0272 20001 CONTINUE C 0273 GOTO 29001 0274 29000 CONTINUE C 0275 WRITE(5,1000) 0276 WRITE(5,1010)FAULT C C - DISCONNECT ACTIVITY ON LOGICAL LINK C 0277 CALL DSCNTW(CONLUN,IOST) 0278 IF(.NOT.(IOST(1).NE.1))GOTO 30400 0280 WRITE(5,1000) 0281 WRITE(5,1030)IOST(1) 0282 30400 CONTINUE 0283 30463 CONTINUE C C - CLOSE NETWORK CONNECTION C 0284 CALL CLSNTW(IOST) 0285 IF(.NOT.(IOST(1).NE.1))GOTO 30464 0287 WRITE(5,1000) 0288 WRITE(5,1008)IOST(1) 0289 30464 CONTINUE 0290 30527 CONTINUE C C 0291 29001 CONTINUE C 0292 CALL CHANGE(,0,COMBUF,26) 0293 COMBUF(1)=9 0294 ASSIGN 26002 TO M00000 0295 GOTO 27000 0296 26002 CONTINUE 0297 WRITE(5,1021) C C - EXIT TASK C 0298 CALL EXIT C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C #DOIT - SENDS DATA TO ...QUE OR LOOKS AT SPECOM OR READS DUTYTABLE C OR SOME COMBINATION C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C 0299 27999 CONTINUE 0300 GOTO 28000 0301 27000 CONTINUE C C FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 013 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0302 CONTINUE 0303 IF (COMBUF(1).NE.1)GOTO 40065 0305 COMBUF(7)=UDAG1TYP+1 0306 GOTO 40127 0307 40065 IF (COMBUF(1).NE.2)GOTO 40066 C C 0309 CALL SHIFTL(6,COMBUF(2)) 0310 IF(.NOT.(ICOMPA(6,COMBUF(2),' ').NE.0 .AND. * ICOMPA(6,COMBUF(2),'VET EJ').NE.0))GOTO 30528 0312 ASSIGN 26003 TO M00001 0313 GOTO 27001 0314 26003 CONTINUE 0315 30528 CONTINUE 0316 30591 CONTINUE C 0317 GOTO 40127 0318 40066 IF (COMBUF(1).NE.6)GOTO 40067 C 0320 CALL MOVE01(6,XPSO1,COMBUF(2)) C C 0321 GOTO 40127 0322 40067 CONTINUE C C C COMBUF C WORD 1 REQUEST FOR SERVER C 3 = PLEASE ALERT NO ARRIV C 4 = PLEASE ALERT LATE ARRIV C 5 = PLEASE ALERT STRNGE ARRIV C 8 = SYSTEM UP C 9 = SYSTEM DOWN 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 C QUEBUF C WORD 1 11 C WORD 2 BUSS NUMBER C WORD 3 0 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 C WORD 13 SPARE C C -- IF BUSS = 0 TA REDA P] DET (<>0 REDAN GJORT) C FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 014 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0323 IF(.NOT.(COMBUF(1).LT.7))GOTO 30592 0325 CALL SHIFTL(6,COMBUF(2)) 0326 IF(.NOT.(COMBUF(5).EQ.0))GOTO 30656 0328 IF(.NOT.(ICOMPA(6,COMBUF(2),' ').NE.0 .AND. * ICOMPA(6,COMBUF(2),'VET EJ').NE.0))GOTO 30720 0330 ASSIGN 26004 TO M00001 0331 GOTO 27001 0332 26004 CONTINUE 0333 30720 CONTINUE 0334 30783 CONTINUE 0335 30656 CONTINUE 0336 30719 CONTINUE 0337 GOTO 30655 0338 30592 CONTINUE 0339 CALL MOVE01(6,'*DATA*',COMBUF(2)) 0340 COMBUF(5)=0 0341 CALL MOVE01(6,'DATAHK',COMBUF(9)) 0342 COMBUF(12)=0 0343 30654 CONTINUE 0344 30655 CONTINUE C C -- SET UP QUEBUF C 0345 CALL CHANGE(,0,QUEBUF,26) 0346 QUEBUF(1)=11 0347 QUEBUF(2)=COMBUF(5) C 0348 IF(.NOT.(COMBUF(1).EQ.3))GOTO 30784 0350 QUEBUF(4)=95 0351 GOTO 30847 0352 30784 IF(.NOT.(COMBUF(1).EQ.4))GOTO 30785 0354 QUEBUF(4)=96 0355 GOTO 30847 0356 30785 IF(.NOT.(COMBUF(1).EQ.5))GOTO 30786 0358 QUEBUF(4)=97 0359 GOTO 30847 0360 30786 IF(.NOT.(COMBUF(1).EQ.8))GOTO 30787 0362 QUEBUF(4)=98 0363 GOTO 30847 0364 30787 CONTINUE 0365 QUEBUF(4)=99 0366 30846 CONTINUE 0367 30847 CONTINUE C 0368 CALL MOVE01(6,COMBUF(2),QUEBUF(5)) 0369 QUEBUF(8)=COMBUF(8) 0370 CALL MOVE01(6,COMBUF(9),QUEBUF(9)) 0371 QUEBUF(12)=(COMBUF(12)/100*60)+MOD(COMBUF(12),100) C C 0372 CALL SEND(QUE,QUEBUF,FLAGQUE,IDS) 0373 IF(.NOT.(IDS.NE.1))GOTO 30848 0375 WRITE(5,1000) 0376 WRITE(5,2000)IDS FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 015 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0377 CALL XMINT(CONLUN,IOST,2,'SQ') 0378 30848 CONTINUE 0379 30911 CONTINUE C C 0380 40126 CONTINUE 0381 40127 CONTINUE C C 0382 GOTO M00000 0383 28000 CONTINUE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C #ACCESS - COLLECTS DATA FROM DUTYTABLE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 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 C 0384 GOTO 28001 0385 27001 CONTINUE C 0386 COUNT=0 0387 IDS=9999 0388 20002 IF(.NOT.(IDS.NE.1 .AND. COUNT.LE.3))GOTO 20003 0390 IF(.NOT.(IDS.NE.9999))GOTO 30912 0392 CALL XMINT(CONLUN,IOST,2,'RT') 0393 WRITE(5,1000) 0394 WRITE(5,2006)IDS 0395 COUNT=COUNT+1 0396 30912 CONTINUE 0397 30975 CONTINUE C 0398 CALL MARK( FLAGDUT, 6, 2, IDS ) C 0399 IF(.NOT.(IDS.NE.1))GOTO 30976 C 0401 WRITE(5,1000) 0402 WRITE(5,2007)IDS 0403 GOTO 20002 C 0404 30976 CONTINUE 0405 31039 CONTINUE FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 016 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER C 0406 CALL SEND(DUTACC,COMBUF,,IDS) 0407 IF(.NOT.(IDS.NE.1))GOTO 31040 0409 WRITE(5,1000) 0410 WRITE(5,2001)IDS 0411 CALL XMINT(CONLUN,IOST,2,'SC') 0412 GOTO 20002 0413 31040 CONTINUE 0414 31103 CONTINUE C 0415 CALL USTP(DUTACC,IDS) 0416 IF(.NOT.(IDS.NE.1))GOTO 31104 0418 CALL REQUES(DUTACC,,IDS) 0419 IF(.NOT.(IDS.NE.1))GOTO 31168 0421 CALL XMINT(CONLUN,IOST,2,'UP') 0422 WRITE(5,1000) 0423 WRITE(5,2002)IDS 0424 GOTO 20002 0425 31168 CONTINUE 0426 31231 CONTINUE 0427 31104 CONTINUE 0428 31167 CONTINUE C 0429 CALL WAITFR(FLAGDUT,IDS) 0430 IF(.NOT.(IDS.NE.1))GOTO 31232 0432 CALL XMINT(CONLUN,IOST,2,'WF') 0433 WRITE(5,1000) 0434 WRITE(5,2003)IDS 0435 GOTO 20002 0436 31232 CONTINUE 0437 31295 CONTINUE C 0438 CALL CANMT( FLAGDUT) C 0439 20004 IF(.NOT.(COUNT.LE.4))GOTO 20005 0441 CALL RECEIV(,RECBUF,,IDS) 0442 IF(.NOT.(IDS.EQ.-8 .AND. COUNT.LE.3))GOTO 31296 0444 COUNT=COUNT+1 0445 CALL WAIT(4,2) 0446 GOTO 31359 0447 31296 IF(.NOT.(IDS.NE.1))GOTO 31297 0449 CALL XMINT(CONLUN,IOST,2,'RC') 0450 WRITE(5,1000) 0451 WRITE(5,2004)IDS 0452 GOTO 20005 0453 GOTO 31359 0454 31297 CONTINUE 0455 IF(.NOT.(ICOMPA(6,COMBUF(2),RECBUF(4)).EQ.0))GOTO 31360 0457 CALL MOVE01(26,RECBUF(3),COMBUF) 0458 GOTO 20005 0459 GOTO 31423 0460 31360 CONTINUE 0461 CALL XMINT(CONLUN,IOST,2,'AB') 0462 WRITE(5,1000) FORTRAN IV V02.5-11 WED 30-MAR-88 00:27:26 PAGE 017 SC:SERVER,SC:SERVER.FLS/LI:3/-SP=SC:SERVER 0463 WRITE(5,2005) C