Listing of file='ids2327u' on disk='vmedia/701-2725B.wvd.zip'
# Sector 468, program filename = 'ids2327u' 3500 DEFFN'75(E3$()) : MAT REDIM E3$(24)83 : STR(E3$(),1921)=" " 3502 N=1 : IF #PART<>3THEN N=#TERM+1 : REM - Reset station number if not partition # 3 3504 REM % IDS2327U : REM - This module represents the interface between an IDEAS-2 application : REM program and a 3270 telecommunication link to process unformatted : REM data only. 3506 H=1 : REM - Set PASS/FAIL flag to "PASS" 3508 E9$=" " : REM - Set current file name for indirect field operations to blanks 3510 E6$="T" : REM - Set return flag to "TRANSMIT" 3512 IF E3$()="\C0\D2\C5\C3\C5\C9\D6\C5"THEN E6$="R" : REM - Set return flag to "RECEIVE" if reception is selected 3514 REM % **** Attach station and test for TC ready state 3516 SELECT @PART"3270UNIV" : ERRORGOSUB '74(83," ") : REM - Select the 3270 universal global partition. Branch to the error : REM routine if the partition does not exist. 3518 IF STR(@A$,40,1)="L"OR @C$=" "THEN GOSUB '74(84," ") : REM - Branch to error routine if TC board is inactive 3520 REM % Set and select TC board address 3522 F3$="0"&STR(@Z$,25) : REM - Set F3$ (3-byte IDEAS-2 variable normally used as file pointer) to : REM the address of the 3270 TC board as indicated in universal global 3524 IF VER(F3$,"01A")<3THEN GOSUB '74(85,F3$) : REM - Branch to error routine if TC board address is an invalid format 3526 SELECT #6<F3$> : REM - Select the TC board as device # 6 3528 IF STR(@A$,40,1)<>"A"THEN GOSUB '74(86," ") : REM - Branch to error routine if TC line is inactive 3530 REM % Set releative station number 3532 N=1 : REM - Station number 3534 IF #PART<>3THEN N=#TERM+1 : REM - Reset station number if not partition # 3 3536 REM % Set attachment variables 3538 BIN(STR(@A$,N+12,1))=#PART+48 : REM - Station's partition # 3540 BIN(STR(@A$,N+24,1))=#TERM+48 : REM - Station's terminal # 3542 STR(@A$,N*3+38,2)=STR(@C$,N*3+38,2) : REM - Terminal stream 3544 STR(@D$(N),2)=HEX(80) : REM - Attachment flag for station 3546 @T$(N)=HEX(03) : REM - Set transfer flag to "status update pending" 3548 REM % Display message for operator 3550 IF E6$="T"THEN E$="Waiting to send to host" : ELSE E$="Waiting for response from host" 3552 PRINT AT(23,0,80);E$; 3554 GOSUB 3642 : REM - Check for operator cancellation and read transfer status flag 3556 IF F6$=HEX(03)THEN 3554 : REM - Branch back and wait for 3270 response if status unchanged 3558 REM % **** DLP Interaction 3560 GOSUB 3642 : REM - Check for operator cancellation and read transfer status flag 3562 IF F6$=HEX(00)AND E6$<>"X"THEN 3570 : REM - Branch if status is "CLEAR" 3564 IF F6$<HEX(10)THEN 3560 : REM - Branch if no new status from universal global 3566 ON VAL(F6$)-16GOTO 3580,3598,3614,3618 : REM - Branch to appropriate process : REM 11 = DLP wants the transmit buffer : REM 12 = DLP has a receive buffer : REM 13 = DLP has acknowledged RESET : REM 14 = AID pending 3568 REM % **** Status is "CLEAR" 3570 IF E6$="R"THEN GOSUB '74(88," ") : REM - Branch to error routine if attempting to receive and there is no : REM received message in the DLP buffer 3572 REM % **** Send transmit buffer to the host 3574 @T$(N)=HEX(02) : REM - Set transfer status flag to "AID PENDING" 3576 GOTO 3560 3578 REM % **** DLP wants the transmit buffer 3580 IF E6$="R"THEN GOSUB '74(89," ") : REM - Branch to error routine if trying to receive and the DLP expects : REM a transmission to the host 3582 E8$=@D$(N)&HEX(0001)&ALL(00) 3584 E3$()=E3$()&ALL(00) 3586 $OPEN #6 3588 $GIO#6(4005 4210 4020 4000 4240 4230 40FE A000,E8$)E3$()<,1920> 3590 $CLOSE#6 3592 @T$(N)=HEX(10) 3594 GOTO 3668 3596 REM % **** DLP has a receive buffer for the terminal 3598 IF E6$="T"THEN GOSUB '74(90," ") : REM - Branch to error routine if trying to transmit and the DLP has a : REM receive buffer for the terminal 3600 E3$()=" " 3602 $OPEN #6 3604 $BREAK 3606 $GIO#6(8700 8701 8704 8703 8702 C340,E8$)E3$()<,1920> : ERRORIF F6$>HEX(00)THEN 3606 : GOSUB '74(91," ") 3608 $CLOSE#6 3610 GOTO 3668 3612 REM % **** "RESET" acknowledged by the DLP 3614 O=87 : RETURN CLEAR : GOSUB 3656 3616 REM % **** "AID PENDING" buffer requested by the DLP 3618 IF E6$="R"THEN GOSUB '74(89," ") : REM - Branch to error routine if trying to receive and the DLP expects : REM a transmission to the host 3620 E8$=STR(@D$(N),,1)&HEX(3D)&HEX(0001) : REM - AID byte (2) is "ENTER" 3622 E3$()=E3$()&ALL(00) 3624 $OPEN #6 3626 $GIO#6(4005 4210 4220 4000 4240 4230 40FE A000,E8$)E3$()<,1920> 3628 $CLOSE#6 3630 @T$(N)=HEX(10) 3632 REM % NOTE - For automatic RCV after XMT, set E6$="R" and branch to 3538 here 3634 GOTO 3668 3636 STOP # 3638 REM % **** Check for operator cancellation and read transfer status flag 3640 PRINT HEX(07); 3642 $BREAK 3644 E$=" " 3646 KEYIN E$,3640,3652 3648 F6$=@T$(N) 3650 RETURN 3652 IF F6$(11)="N"OR E$<>HEX(1F)THEN 3640 : @T$(N)=HEX(01) : H=0 : E6$="X" : GOTO 3560 3654 REM % **** Error routine and exit 3656 DEFFN'74(O,E8$) : REM - O = System error message number : REM E8$ = Variable (if any) to be displayed as part of error message 3658 RETURN CLEAR 3660 IF H=0OR H>10OR E6$="T"THEN 3662 : H=H+1 : @T$(N)=HEX(03) : GOTO 3560 3662 STR(@A$,24+N,1),STR(@A$,12+N,1),STR(@A$,38+3*N,3)=" " : STR(@D$(N),2),@T$(N)=HEX(00) : IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : ELSE SELECT @PART" " : REM - Reselect IDEAS global subroutines (if any) 3664 GOSUB '38(O,E8$) : REM - Issue system error message : RETURN 3666 REM % **** Exit from TC module 3668 STR(@A$,24+N,1),STR(@A$,12+N,1),STR(@A$,38+3*N,3)=" " : STR(@D$(N),2),@T$(N)=HEX(00) : IF F6$(17)<"^"THEN SELECT @PART"IDS2SUBM" : ELSE SELECT @PART" " : REM - Reselect IDEAS global subroutines (if any) 3670 PRINT AT(23,0,80); : $TRAN(E3$(),HEX(2000))R 3672 RETURN