AUIBMSYS.m

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