AUIBMSYS ;IBM SYSTEM INTERFACE [ 05/16/85 2:56 PM ]
;TOM FISHER
S %RECORD=0,%HT=1,%ER=0,%PT=80
S $ZE="ERROR^IBMSYS"
S %ERRMSG="TRANSMISSION ERROR HAS OCCURED"
U %PORT:(0::::5),0:(0::::5) B 0
TMEPLX ; WAKEUP TIMEPLEX PORT
S %RESP=""
S FUNCT=">>>"
D PROCIO
TMPLXOK ; WAKEUP COMTEN
S %RESP="COMTEN"
S FUNCT="CONNECT COMPLETE"
D PROCIO
CMTENOK ; WAKEUP CICS
H %HT
U %PORT
W *13
S %RESP=""
S FUNCT="invalid-sw-chars"
D PROCIO
; INTERACT WITH CICS
S %RESP="CICS"
S FUNCT="INDIAN HEALTH SERVICE "
D PROCIO
IBMRDY ; MAKE SURE IBM CICS READY
S %RESP=""
S FUNCT="READY"
D PROCIO
TRNSRDY ; SIGNON TO MAINFRAME
S %RESP="CSSN PS=TPSM,NAME=FISHER"
S FUNCT="SIGN-ON IS COMPLETE"
D PROCIO
STRTTRN ; START TRANSACTION
S %RESP="PCXT"
S FUNCT="PCXT CONNECT"
D PROCIO
SEQPCXT ; SEQUENCE SYSTEM WITH REMOTE SYSTEM
S %RESP="START"
S FUNCT="PCXT READY"
D PROCIO
PCXTPRO S %X="" F I=0:0 S %X=$O(^RGTXDATA(%X)) G:%X="" GLOBEND S %DATA=^RGTXDATA(%X) S %CRC(0)=0 S %CRC=%DATA D CALCRC S %RECORD=%RECORD+1 S %RESP="^D^"_%CRC(0)_%DATA S FUNCT="CRC" D PROCIO U 0
CALCRC ; CALCULATE CRC FOR DATA LINE
F %CRC(1)=1:1:$L(%DATA) S %CRC(0)=%CRC(0)+$A(%CRC,%CRC(1))
Q
GLOBEND U 0 W !!,"TOTAL RECORDS SENT ",%RECORD
K %RECORD
ENDPCXT ; END TRANSACTION POCISSING
S %RESP="^*END*^"
S FUNCT="^STP^"
D PROCIO
G LOGOFF
; WRITE RECORD NUMBER OF ERROR
EXIT W !!,"TRANSMISSION EROR HAS OCCURED",*7,*7,*7,*7
W !!,"TRANMISSION MUST BE RESTARTED"
W !!,"RECORD COUNT SENT BEFORE FAILURE ",%RECORD
LOGOFF ; LOGOFF IBM SYSTEM
S %RESP="CSSF LOGOFF"
S FUNCT="SIGN-OFF IS COMPLETE"
S %ERRMSG="SIGNOFF TO IBM FAILED"
S %ER=1
D PROCIO
G EXIT^AUTRANS
ERROR U 0 W !!,*7,"DISCONNECT FROM SYSTEM"
G EXIT^AUTRANS
PROCIO ; GENERAL I/O TO PORT
S %XS="" F L=1:1:700
S %RT=0
I %PT>79 W ! S %PT=0
U 0 W "." S %PT=%PT+1
U %PORT W:$L(%RESP) %RESP W *13
PORTIO ;
U %PORT R %Y:0 S %CR=$ZB
S %XS=%XS_%Y
G:%RT=3000 PORTERR S %RT=%RT+1
G:%XS[FUNCT PORTOK
G PORTIO:$L(%RESP),PORTIO:$L(%Y) G PORTIO
PORTOK Q
; TIMEOUT ERROR ENTER THIS ROUTINE IF NO RESPONSE
; FROM COMMUNICATIONS PORT
PORTERR U 0 W !,%ERRMSG,%XS G:%ER EXIT^AUTRANS G EXIT
END ; END OF ROUTINE
AUIBMSYS ;IBM SYSTEM INTERFACE [ 05/16/85 2:56 PM ]
+1 ;TOM FISHER
+2 SET %RECORD=0
SET %HT=1
SET %ER=0
SET %PT=80
+3 SET $ZE="ERROR^IBMSYS"
+4 SET %ERRMSG="TRANSMISSION ERROR HAS OCCURED"
+5 USE %PORT:(0::::5),0:(0::::5)
BREAK 0
TMEPLX ; WAKEUP TIMEPLEX PORT
+1 SET %RESP=""
+2 SET FUNCT=">>>"
+3 DO PROCIO
TMPLXOK ; WAKEUP COMTEN
+1 SET %RESP="COMTEN"
+2 SET FUNCT="CONNECT COMPLETE"
+3 DO PROCIO
CMTENOK ; WAKEUP CICS
+1 HANG %HT
+2 USE %PORT
+3 WRITE *13
+4 SET %RESP=""
+5 SET FUNCT="invalid-sw-chars"
+6 DO PROCIO
+7 ; INTERACT WITH CICS
+8 SET %RESP="CICS"
+9 SET FUNCT="INDIAN HEALTH SERVICE "
+10 DO PROCIO
IBMRDY ; MAKE SURE IBM CICS READY
+1 SET %RESP=""
+2 SET FUNCT="READY"
+3 DO PROCIO
TRNSRDY ; SIGNON TO MAINFRAME
+1 SET %RESP="CSSN PS=TPSM,NAME=FISHER"
+2 SET FUNCT="SIGN-ON IS COMPLETE"
+3 DO PROCIO
STRTTRN ; START TRANSACTION
+1 SET %RESP="PCXT"
+2 SET FUNCT="PCXT CONNECT"
+3 DO PROCIO
SEQPCXT ; SEQUENCE SYSTEM WITH REMOTE SYSTEM
+1 SET %RESP="START"
+2 SET FUNCT="PCXT READY"
+3 DO PROCIO
PCXTPRO SET %X=""
FOR I=0:0
SET %X=$ORDER(^RGTXDATA(%X))
IF %X=""
GOTO GLOBEND
SET %DATA=^RGTXDATA(%X)
SET %CRC(0)=0
SET %CRC=%DATA
DO CALCRC
SET %RECORD=%RECORD+1
SET %RESP="^D^"_%CRC(0)_%DATA
SET FUNCT="CRC"
DO PROCIO
USE 0
CALCRC ; CALCULATE CRC FOR DATA LINE
+1 FOR %CRC(1)=1:1:$LENGTH(%DATA)
SET %CRC(0)=%CRC(0)+$ASCII(%CRC,%CRC(1))
+2 QUIT
GLOBEND USE 0
WRITE !!,"TOTAL RECORDS SENT ",%RECORD
+1 KILL %RECORD
ENDPCXT ; END TRANSACTION POCISSING
+1 SET %RESP="^*END*^"
+2 SET FUNCT="^STP^"
+3 DO PROCIO
+4 GOTO LOGOFF
+5 ; WRITE RECORD NUMBER OF ERROR
EXIT WRITE !!,"TRANSMISSION EROR HAS OCCURED",*7,*7,*7,*7
+1 WRITE !!,"TRANMISSION MUST BE RESTARTED"
+2 WRITE !!,"RECORD COUNT SENT BEFORE FAILURE ",%RECORD
LOGOFF ; LOGOFF IBM SYSTEM
+1 SET %RESP="CSSF LOGOFF"
+2 SET FUNCT="SIGN-OFF IS COMPLETE"
+3 SET %ERRMSG="SIGNOFF TO IBM FAILED"
+4 SET %ER=1
+5 DO PROCIO
+6 GOTO EXIT^AUTRANS
ERROR USE 0
WRITE !!,*7,"DISCONNECT FROM SYSTEM"
+1 GOTO EXIT^AUTRANS
PROCIO ; GENERAL I/O TO PORT
+1 SET %XS=""
FOR L=1:1:700
+2 SET %RT=0
+3 IF %PT>79
WRITE !
SET %PT=0
+4 USE 0
WRITE "."
SET %PT=%PT+1
+5 USE %PORT
IF $LENGTH(%RESP)
WRITE %RESP
WRITE *13
PORTIO ;
+1 USE %PORT
READ %Y:0
SET %CR=$ZB
+2 SET %XS=%XS_%Y
+3 IF %RT=3000
GOTO PORTERR
SET %RT=%RT+1
+4 IF %XS[FUNCT
GOTO PORTOK
+5 IF $LENGTH(%RESP)
GOTO PORTIO
IF $LENGTH(%Y)
GOTO PORTIO
GOTO PORTIO
PORTOK QUIT
+1 ; TIMEOUT ERROR ENTER THIS ROUTINE IF NO RESPONSE
+2 ; FROM COMMUNICATIONS PORT
PORTERR USE 0
WRITE !,%ERRMSG,%XS
IF %ER
GOTO EXIT^AUTRANS
GOTO EXIT
END ; END OF ROUTINE
