image of READY prompt

Wang2200.org

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