|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 27154 (0x6a12)
Notes: pts_type(SC)
Names: »ADM6BC.SC«
└─⟦d2cdd233a⟧ Bits:30009674 Philips computer tape "600204"
└─⟦this⟧ »OD-KOM/ADM6BC.SC«
IDENT ADM6BC 831019 EV DDUM KMD08 PDIV ENTRY ADM600 ENTRY SIGNON ENTRY CHNGDK ENTRY STRTRC ENTRY SENDRC ENTRY TERMIN ENTRY SIGNOF ENTRY EXCHAN ENTRY TRNOK ENTRY WJDC ENTRY BCGO ENTRY BCACTV * EXT SPCLRA EXT SPLIN8 EXT SPCLRS EXT SLUTID EXT RAWRIT EXT WRITID EXT LAMPOF EXT ADMRET EXT SPERR EXT CLSVOL EXT LAMPON EXT SOPRD EXT ASGVOL EXT ASGFIL EXT BCKUP EXT RAREAD EXT GETBIT EXT WRITJT EXT ABORT * INCLUDE EQUATE EJECT ADM600 CLEAR SPKEYFLG CMP TTASKNR,CBIN1 MASTER ? BNE ADM06RET NO SET SPPROMPT ADM0604 REPEAT UNTIL CORRECT KEY MOVE GSWBCD2,CSENDNR ATTFMT SNDFRM6 PERF SPCLRA IB SPBINW2,ADM06RET,ADM06RET,ADM0605 B ADM0604 ADM0605 ENTER KEY MOVE SPBINW2,GSWBCD1 CHECK ON VALUE IB SPBINW2,ADM0610,ADM0650 MANUAL/AUTOMATIC B ADM0604 NOT VALID ADM0610 MANUAL CLEAR CBCFLAG MANUAL TEST GTKASSE KASSE OPEN? BNZ ADM0604 YES, NOT ALLOWED CMP CTASKNR,CBIN0 ALL CLOSED? BNE ADM0604 NO TBT CBCSENDF,ADM0604 SENDING? SET CBCWAITF STOP AUTO BATCH SET CCONVFLG STOP OTHER FROM OPEN * MANUAL TRANSMISSION ALLOWED * TEST IF SIGN ON MUST BE DONE TBT CBCACTVF,ADM0615 AUTO BATCH NOT ACTIVE SIGN ON ADM0611 SET SPPROMPT ATTFMT SNDFRM PERF SPCLRS IB SPBINW2,ADM0612,ADM0612,ADM0615 B ADM0611 ADM0612 CLEAR CBCWAITF MAK CLEAR CCONVFLG B ADM0604 ENTER KEY ADM0615 TBT CCONVERT,ADM0613 SUB CRECBCD,=D'1' PERF SLUTID,CPCKBUF,CRECBCD ADD CRECBCD,=D'1' PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR BNOK ADM0612 PERF WRITID,CPCKBUF,CBIN5,CBIN2 SLUTID ON JOURNAL EJECT ADM0613 ************************************************** * BATCH TRANSMISSION * 1) SIGNON * 2) CHANGE DISK * 3) SEND STARTIDENT * 4) SEND TRANSACTIONS AND SLUTID * 5) IN CASE OF ERROR SEND TERMINATE * 6) WHEN ALL TRANSMITTED SEND SIGNOFF ************************************************* SEE IF AUTOMATIC BATCH ACTIVE TBT CBCACTVF,ADM0620 NOT ACTIVE, SEND SIGN-ON PERF SIGNON BNOK ADM0612 LIKE MAK ADM0620 SET OPTION TO STOP AUTOMATIC BATCH MOVE CBCOPT,CBIN2 STOP AUTOMATIC BATCH PERF LAMPOF,=W'2047' ADM0630 PERF CHNGDK CHANGE DISC BNOK ADM6SOFF PERF STRTRC SEND STARTIDENT BNOK ADM0640 IF NOT OK, TRY NEXT PERF SENDRC SEND BATCH BOK ADM0620 IF NOT OK PERF TERMIN SEND TERMINATE ADM0640 PERF LAMPOF,=W'2047' PERF LAMPON,=W'2' LAMP 10, ERROR B ADM0630 ADM6SOFF PERF SIGNOF SEND SIGNOFF CLEAR CCONVFLG CLEAR CBCWAITF ADM06OUT ADM06RET TBT CBCACTVF,ADM06RT PERF LAMPOF,=W'2047' ADM06RT SET SPKEYFLG B ADMRET EJECT ADM0650 AUTOMATIC SET CBCFLAG SELECT IF ALREADY ACTIVE TBT CBCACTVF,ADM0670 NOT ACTIVE ADM0651 SET SPPROMPT ATTFMT SNDFRM ASK FOR PERF SPCLRS BRUGERNAVN,KENDEORD IB SPBINW2,ADM0652,ADM0652,ADM0655 B ADM0651 ADM0652 MAK B ADM0604 ADM0655 ENTER KEY PERF SIGNON BNOK ADM0604 LIKE MAK ADM0660 ATTFMT SNDFRM8 PERF SPCLRA STARF FRA IB SPBINW2,ADM6SOFF,ADM6SOFF,ADM0665 B ADM0660 * ADM0665 MOVE CBCFROM,GSWBCD1 MOVE CBCOPT,CBIN1 SET OPTION START MOVE GSWSTR2,=C'BC' ACTV BCACTV,GSWSTR2 ACTIVATE TASK B ADM06RET RETURN * ADM0670 ALREADY ACTIVE ATTFMT SNDFRM9 PERF SPCLRA GET OPTION IB SPBINW2,ADM06RET,ADM06RET,ADM0675 B ADM0670 ADM0675 TEST IF OPTION 1 OR 2 CBE GSWBCD1,=D'1',ADM0680 CBE GSWBCD1,=D'2',ADM0681 B ADM0670 ADM0680 SET OPTION MOVE CBCOPT,CBIN4 SEND REST B ADM06RET ADM0681 MOVE CBCOPT,CBIN3 INTERRUPT B ADM06RET EJECT ******************************************* * TASK BC - AUTOMATIC BATCH TRANSMISSION STARTS HERE * * ******************************************* BCGO ENTRY POINT EXIT * * * ACTIVATION POINT * BCACTV ACTIVATION POINT SET CBCACTVF SET ACTIVE SET TBCTASK IN TASK BC EDWRT KJTAPE,FFNL EDWRT KJTAPE,FBCACTV * "AUTOMATIC DATATRANSMISSION AKTIVERET" * BC100 TBT CBCSENDF,BC150 NO SENDING GOING ON IB CBCOPT, SELECT ON OPTION C BC210, START C BC220, STOP C BC230, INTERRUPT C BC240 SEND REST * BC200 IDLE LOOP MOVE GSWBIN1,=W'30' 3 SECONDS DELAY GSWBIN1 B BC100 * BC210 START TBT CBCWAITF,BC200 WAIT MOVE GSWBIN1,CRECNR SUB GSWBIN1,CBCFROM SEE IF ENOUGH CBL GSWBIN1,CBCANT,BC200 EDWRT KJTAPE,FBCSTRT PERF STRTRC SEND START IDENT BNOK BC230 SET CBCSENDF SENDING MOVE CBCTO,CBCFROM ADD CBCTO,CBCANT LAST TO SEND B BC100 * BC220 STOP EDWRT KJTAPE,FBCEXIT CLEAR CBCACTVF CLEAR ACTIVE * "AUTOMATISK DATATRANSMISSION STOPPET" EXIT * BC230 INTERRUPT PERF LAMPOF,=W'64' LAMP 5 OFF PERF SIGNOF SEND SIGNOFF MOVE CBCOPT,CBIN2 B BC100 * BC240 SEND REST EDWRT KJTAPE,FBCSTRT PERF STRTRC SEND START IDENT BNOK BC230 SET CBCSENDF SENDING STARTED MOVE CBCTO,CBIN0 SEND ALL B BC100 * * * BC150 SENDING ALREAD RUNNING PERF SENDRC SEND BATCH BOK BC350 PERF TERMIN TERMINATE CLEAR CBCSENDF STOPPED SENDING EDWRT KJTAPE,FBCTERM PERF LAMPOF,=W'64' LAMP 5 OFF MOVE CBCOPT,CBIN2 STOP B BC100 BC350 END OF BATCH MOVE GSWBCD1,CBCFROM MOVE GSWBCD2,CSENDNR EDWRT KJTAPE,FBCTO EDWRT KJTAPE,FBCSTOP MOVE CBCFROM,CSENDNR ADD CBCFROM,CBIN1 PERF LAMPOF,=W'64' LAMP 5 OFF MOVE CBCOPT,CBIN1 CLEAR CBCSENDF B BC100 ******************************************** * * END OF AUTOMATIC BATCH TASK * ******************************************** EJECT ************************************************ * * SIGNON * IF NOT OK CR NOT = 0 * ************************************************ SIGNON PROC MOVE GSWBIN1,=X'40' DSC1 DCOMM,TRPAR,GSWBIN1 MOVE GSWBIN1,CBIN5 MOVE GSWBIN2,=W'50' MOVE CSENDBUF,=C' ' EDIT CSENDBUF,SIGONF * FIND LENGTH MATCH CSENDBUF,GSWBIN1,GSWBIN2,CBLANKS,CBIN0,CBIN2 MOVE GSWBIN2,GSWBIN1 TBT CTESTFLG,SIGON10 PERF EXCHAN EXCHANGE DC BNOK SIGON100 PERF WJDC MOVE GSWSTR20,=C'DFH3504' MOVE GSWBIN1,CBIN0 MATCH CSENDBUF,GSWBIN1,GSWBIN2,GSWSTR20,CBIN0,CBIN7 BNE SIGON100 SIGON10 EDWRT SCREEN,SNDFRM3 CMP CBIN0,CBIN0 RET SIGON100 MOVE GSWBIN1,CBIN0 DSC1 DCOMM,TRPAR,GSWBIN1 MOVE SPBINW4,CBIN21 MOVE GTWBCD2,=D'60' MOVE GSWSTR9,=C'TRANSMIT ' MOVE GTWBCD1,=D'16' PERF SPERR PERF WRITJT,=W'14' CMP CBIN0,CBIN1 RET PEND EJECT ********************************************* * * CHNGDK - CHANGE DISK * STOP SEND PIN 6 * CONTINIUE PIN 5 * ********************************************* * DUMTAB KTAB EORKY1 * CHNGDK PROC CHNG000 PERF CLSVOL,CBIN2 CLOSE REGSET MOVE CSENDNR,CBIN1 MOVE CRECBCD,=D'1' PERF LAMPON,=W'64' LAMP 5 PERF LAMPON,=W'32' LAMP 6 PERF LAMPON,=W'16' LAMP 7 CHNG010 * INPUT FROM SOP OR KEYBOARD EDWRT SCREEN,SNDFRM7 SEND? PERF SPLIN8,CBIN0,CBIN0 .NW CHNG0104 MOVE GSWBIN1,CBIN1 NO WRITING, .NW KI .NW,DSSOPI,SOPINP,DUMTAB,GSWBIN1,GSWBIN2 BNOK CHNG0104 CHNG0105 WAIT MWAIT GSWBIN3,KEYB,DSSOPI IB GSWBIN3, SEE WHO FINISHED FIRST C CHNG0210, KEYBOARD C CHNG0220 SOP B CHNG0105 CHNG0210 KEYBOARD TESTIO DSSOPI BOK CHNG0211 CALL ABORT,DSSOPI CHNG0211 WAIT DSSOPI CHNG0212 HANDLE KEYBOARD ATTFMT SNDFRM10 PERF SPCLRS IB SPBINW2,CHNG010,CHNG010,CHNG0213 B CHNG0212 CHNG0213 MOVE CBCFROM,GSWBCD1 MOVE CBCTO,GSWBCD2 MOVE GSWBIN2,CBIN6 AS SOP 5 B CHNG030 CHNG0220 SOP FINISHED TESTIO KEYB STOP KEYBOARD BOK CHNG0221 CALL ABORT,KEYB CHNG0221 WAIT KEYB MOVE CBCFROM,CBIN1 SEND MOVE CBCTO,CBIN0 ALL B CHNG030 * CHNG030 IB GSWBIN2, C CHSOP10,CHSOP09,CHSOP08,CHSOP07,CHSOP06, C CHSOP05,CHSOP04,CHSOP03,CHSOP02,CHSOP01 CHSOP01 CHSOP02 CHSOP03 CHSOP04 CHSOP08 CHSOP09 B CHNG010 CHSOP10 * ERROR, SIGN ON AGAIN PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'2' LAMP 10 SET SPPROMPT ATTFMT SNDFRM SIGNON FORMAT PERF SPCLRS IB SPBINW2,CH1010,CH1010,CH1020 CH1010 B CHNG000 CH1020 PERF SIGNON BNOK CHNG000 PERF LAMPOF,=W'2047' B CHNG000 CHSOP05 PERF LAMPOF,=W'2047' LAMPS OFF PERF ASGVOL,CBIN2 ASSIGN DISK 2 BOK CHNG050 PERF LAMPON,=W'2' B CHNG000 CHNG050 PERF LAMPON,=W'64' LAMP 5 CMP CBIN0,CBIN0 SET CR RET CHSOP06 SOP 6 PERF LAMPOF,=W'2047' LAMPS OFF PERF BCKUP,=W'1' WITHOUT BACKUP BNOK CHNG000 B CHNG130 CHSOP07 PERF LAMPOF,=W'2047' LAMPS OFF PERF BCKUP,=W'2' WITH BACKUP BNOK CHNG000 B CHNG130 CHNG130 PERF LAMPOF,=W'2047' CMP CBIN0,CBIN1 INDICATE ERROR OR END OF TRANS RET PEND EJECT ****************************************** * * STRTRC - SEND OF STARTIDENT * AND CHECK REPLY * ******************************************* STRTRC PROC PERF LAMPOF,=W'2047' PERF LAMPON,=W'64' MOVE GSWBIN6,CBIN1 MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CDISKBUF,GSWBIN1,GSWBIN6 BNOK STRTRET CBE GTWBCD1,=D'4',STRTRET RECORD DELETED? PERF WRITID,CDISKBUF,CBIN5,CBIN1 MOVE GSWBIN6,CBIN0 MOVE GSWBIN1,=W'40' MOVE GSWSTR20,CBLANKS COPY CDISKBUF,GSWBIN1,CBIN20,GSWSTR20,GSWBIN6 MOVE CSENDBUF,=C' ' EDIT CSENDBUF,SNDFRM2 MOVE GSWBIN2,=W'31' LENGTH PERF EXCHAN EXCHANGE DC BNOK STRTRET PERF TRNOK CHECK IF OK BNOK STRTRET CMP CBIN0,CBIN0 SET CR RET STRTRET CMP CBIN0,CBIN1 RET PEND EJECT ********************************************** * * SENDRC - SEND BATCH UNTIL SLUTID * ********************************************** SENDRC PROC *CBCFROM MUST HAVE BEEN ADJUSTED ???????? CBG CBCFROM,CBIN1,SND000 MOVE CBCFROM,CBIN2 FIRST DATA RECORD SND000 MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CDISKBUF,GSWBIN1,CBCFROM BNOK SNDERR CMP GTWBCD1,=D'4' BE SNDERR TOO FAR * LOOK FOR FIRST PART OF A TRANSACTION '&01' MOVE GSWSTR20,=C'&01' MOVE GSWBIN1,=W'128' MOVE GSWBIN5,CBIN0 MATCH CDISKBUF,GSWBIN5,GSWBIN1,GSWSTR20,CBIN0,CBIN3 BE SND003 MOVE GSWSTR20,=C'SLUTD' MOVE GSWBIN5,CBIN0 MATCH GSWSTR20,GSWBIN5,CBIN5,CDISKBUF,CBIN0,CBIN5 BNE SND002 TRY NEXT MOVE CSENDNR,CBCFROM MOVE GSWBIN3,CBIN0 B SND013 SEND SLUTD SND002 TRY NEXT ADD CBCFROM,CBIN1 B SND000 SND003 TBF TBCTASK,SND004 MOVE GSWBCD1,CBCFROM EDWRT KJTAPE,FBCFROM SND004 PERF WRITID,CDISKBUF,CBIN0,CBIN1 CLEAR TTEORFLG NOT END OF RECORD MOVE CSENDNR,CBCFROM SUB CSENDNR,CBIN1 SND005 MOVE GSWBIN3,CBIN0 PACKPOINTER SND010 TBF TTEORFLG,SND011 END OF RECORD? YES CBE CBCTO,CBIN0,SND011 SEND REST * IF FROM > TO, SEND SLUTD CBNG CSENDNR,CBCTO,SND011 SEND MORE MOVE CDISKBUF,=C'SLUTD00000 ' MOVE GSWBIN1,CSENDNR SUB GSWBIN1,CBCFROM ADD GSWBIN1,CBIN1 MOVE GSWBCD3,GSWBIN1 PERF SLUTID,CDISKBUF,GSWBCD3 B SNDSLUT SND011 ADD CSENDNR,CBIN1 MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CDISKBUF,GSWBIN1,CSENDNR BNOK SNDERR CMP GTWBCD1,=D'4' BNE SND012 MOVE CDISKBUF,=C'SLUTD00000 ' SND012 MOVE GSWSTR20,=C'SLUTD' MOVE GSWBIN5,CBIN0 MATCH GSWSTR20,GSWBIN5,CBIN5,CDISKBUF,CBIN0,CBIN5 BNE SND014 SND013 MOVE GSWBIN1,CSENDNR SUB GSWBIN1,CBCFROM MOVE GSWBCD3,GSWBIN1 PERF SLUTID,CDISKBUF,GSWBCD3 SUB CSENDNR,CBIN1 MOVE CBCOPT,CBIN2 STOP B SNDSLUT SND014 SET TTEORFLG END OF RECORD MOVE GSWSTR9,=X'7F' FIND LENGTH SND015 MOVE GSWBIN4,CBIN0 MOVE GSWBIN5,=W'128' MATCH CDISKBUF,GSWBIN4,GSWBIN5,GSWSTR9,CBIN0,CBIN1 BE SND020 CLEAR TTEORFLG NOT END OF RECORD MOVE GSWSTR9,=X'21' B SND015 SND020 ADD GSWBIN4,GSWBIN3 SEE IF MORE SPACE CBNG GSWBIN4,=W'500',SND030 SUB CSENDNR,CBIN1 NO MORE SPACE B SND040 SEND BUFFER SND030 SUB GSWBIN4,GSWBIN3 RESTORE ADD GSWBIN4,CBIN1 FILL WITH X'00' CBE GSWBIN4,=W'128',SND037 MOVE GSWSTR20,=X'00' MOVE GSWBIN5,=W'128' SUB GSWBIN5,GSWBIN4 REMAINING TO FILL SND035 CBL GSWBIN5,CBIN20,SND036 INSRT CDISKBUF,GSWBIN4,CBIN20,GSWSTR20,CBIN0 SUB GSWBIN5,CBIN20 B SND035 SND036 INSRT CDISKBUF,GSWBIN4,GSWBIN5,GSWSTR20,CBIN0 SND037 EDSUB CSENDBUF,GSWBIN3,SNDFRM5 INSERT RECORD B SND010 READ NEXT SND040 MOVE GSWBIN2,GSWBIN3 TBT TBCTASK,SND042 MANUAL MOVE GTWBCD2,CSENDNR PERF SPLIN8,CBIN10,CBIN3 B SND044 SND042 AUTOMATIC IB CBCOPT, CHECK ON OPTION C SND0421, START C SND0422, STOP C SND0423, INTERRUPT C SND0424 SEND REST SND0421 B SND044 SND0422 SND0423 B SNDERR SND0424 SEND REST MOVE CBCTO,CBIN0 SND044 END OF CHECK * PERF EXCHAN BNOK SNDERR PERF TRNOK BNOK SNDERR B SND005 SNDSLUT CBE GSWBIN3,CBIN0,SND090 REQ.LGTH.=0 ? MOVE GSWBIN2,GSWBIN3 PERF EXCHAN EXCHANGE DC BNOK SNDERR PERF TRNOK BNOK SNDERR SND090 MOVE GSWBIN3,CBIN0 MOVE CSENDBUF,=C' ' EDSUB CSENDBUF,GSWBIN3,SNDFRM5 MOVE GSWBIN2,CBIN18 PERF EXCHAN BNOK SNDERR PERF WRITID,CDISKBUF,CBIN5,CBIN2 PERF WJDC PRINT ANSWER TBT CTESTFLG,SNDSL10 MOVE GSWSTR9,=C'0002' MOVE GSWBIN1,CBIN0 MOVE GSWBIN2,=W'52' MATCH CSENDBUF,GSWBIN1,GSWBIN2,GSWSTR9,CBIN0,CBIN4 BNE SNDERR SNDSL10 CMP CBIN0,CBIN0 RET SNDERR CMP CBIN1,CBIN0 RET PEND EJECT ******************************************** * * TERMIN - TERMINATE TRANSMISSION IN CASE OF ERROR * ******************************************** TERMIN PROC MOVE GSWBIN3,CBIN0 MOVE CSENDBUF,=C' ' MOVE CDISKBUF,=C'TERMINATE ' MOVE GSWBIN3,CBIN0 EDSUB CSENDBUF,GSWBIN3,SNDFRM2 MOVE GSWBIN2,CBIN14 PERF EXCHAN EXCHANGE DC BNOK TERMRET PERF WJDC TERMRET MOVE GSWBIN1,CBIN0 DSC1 DCOMM,TRPAR,GSWBIN1 RET PEND EJECT ********************************************* * * SIGNOFF * ********************************************* SIGNOF PROC MOVE GSWBIN3,CBIN0 MOVE CSENDBUF,=C' ' MOVE CDISKBUF,=C'CSSF ' EDSUB CSENDBUF,GSWBIN3,SNDFRM2 MOVE GSWBIN2,CBIN9 PERF EXCHAN BNOK SIGOFRET MOVE GSWBIN1,CBIN0 DSC1 DCOMM,TRPAR,GSWBIN1 TBT CTESTFLG,SIGOFRT1 PERF WJDC PRINT ANSWER SIGOFRET RET SIGOFRT1 CMP CBIN0,CBIN0 RET PEND EJECT ********************************************* * EXCHAN - EXCHANGE DC * IN CASE OF ERROR ERRORMESSAGE * IS SHOWN ON SCREEN AND JOURNAL ********************************************* EXCHAN PROC TBT CTESTFLG,EXCHTEST EXCH10 MOVE GSWBIN5,CBIN1 MOVE GSWBIN1,=W'504' DCREAD DCOMM,CDUMBUF,GSWBIN1,GSWBIN5 BOK EXCH10 IF ANYTIBNG RCVD, THROW AWAY MOVE GSWBIN5,=W'900' TIMEOUT DCWRITE DCOMM,CSENDBUF,GSWBIN2,GSWBIN5 BNOK EXCHNOK MOVE GSWBIN2,=W'504' MOVE GSWBIN5,=W'900' TIMEOUT DCREAD DCOMM,CSENDBUF,GSWBIN2,GSWBIN5 BOK EXCHRET EXCHNOK PERF GETBIT,DCOMM FETCH ERRORCODE MOVE SPBINW4,CBIN21 MOVE GTWBCD2,=D'60' MOVE GSWSTR9,=C'TRANSMIT ' PERF SPERR PERF WRITJT,=W'14' CMP CBIN0,CBIN1 RET EXCHTEST MOVE CSENDBUF,=X'1B3543' DELAY CBIN20 EXCHRET CMP CBIN0,CBIN0 RET PEND EJECT ********************************************* * * TRNOK - CHECK IF MESSAGE CORRECT RECIEVED * ********************************************* TRNOK PROC MOVE GSWBIN3,CBIN0 MOVE GSWSTR9,=X'1B3543' =EBCDIC 27F5C3 MATCH CSENDBUF,GSWBIN3,GSWBIN2,GSWSTR9,CBIN0,CBIN3 BNE TRNERR MOVE GSWBIN2,CBIN0 MOVE CSENDBUF,=C' ' CMP CBIN0,CBIN0 RET TRNERR PERF WJDC PRINT WRONG RESPONSE MOVE GTWBCD2,=D'60' MOVE GSWSTR9,=C'TRANSMIT ' MOVE GTWBCD1,=D'50' PERF SPERR PERF WRITJT,=W'14' CMP CBIN0,CBIN1 RET PEND EJECT ************************************************* * * WJDC - PRINT RECEIVED MESSAGE ON JOURNAL * ************************************************* WJDC PROC TBT TBCTASK,WJDC000 WAIT KTALLY WJDC000 CBL GSWBIN2,CBIN1,WJDCRET CBG GSWBIN2,=W'504',WJDCRET MOVE GSWSTR9,=C'DFH' MOVE GSWBIN1,CBIN0 MATCH CSENDBUF,GSWBIN1,GSWBIN2,GSWSTR9,CBIN0,CBIN3 BE WJDC100 CICS MESSAGE * * APLICATION MESSAGE * MOVE GSWSTR9,=X'11' MOVE GSWBIN1,CBIN0 MATCH CSENDBUF,GSWBIN1,GSWBIN2,GSWSTR9,CBIN0,CBIN1 BNE WJDCRET * GSWBIN1=START ADD GSWBIN1,CBIN3 BYPASS SBA SEQUENSE MOVE GSWBIN4,GSWBIN1 SUB GSWBIN2,GSWBIN4 ADJUST LENGTH CBL GSWBIN2,CBIN1,WJDCRET WJDC005 MOVE CDISKBUF,=X'00' MATCH CSENDBUF,GSWBIN4,GSWBIN2,GSWSTR9,CBIN0,CBIN1 BNE WJDC010 SUB GSWBIN4,GSWBIN1 GSWBIN4 = LENGTH CBNG GSWBIN4,=W'52',WJDC007 MOVE GSWBIN4,=W'52' MAX 52 CHARS COPY CDISKBUF,CBIN0,GSWBIN4,CSENDBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM B WJDC008 WJDC007 COPY CDISKBUF,CBIN0,GSWBIN4,CSENDBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM ADD GSWBIN4,CBIN3 WJDC008 SUB GSWBIN2,GSWBIN4 ADD GSWBIN4,GSWBIN1 MOVE GSWBIN1,GSWBIN4 CBG GSWBIN2,CBIN3,WJDC005 B WJDCRET WJDC010 B WJDC200 WJDCRET RET * WJDC100 SUB GSWBIN2,GSWBIN1 CBL GSWBIN2,=W'52',WJDC200 MOVE GSWBIN4,=W'30' FIND BLANK ADD GSWBIN4,GSWBIN1 MATCH CSENDBUF,GSWBIN4,CBIN22,CBLANKS,CBIN0,CBIN1 BNE WJDC200 MOVE CDISKBUF,=X'00' SUB GSWBIN4,GSWBIN1 COPY CDISKBUF,CBIN0,GSWBIN4,CSENDBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM SUB GSWBIN2,GSWBIN4 ADD GSWBIN1,GSWBIN4 WJDC200 MOVE CDISKBUF,=X'00' CBL GSWBIN2,=W'52',WJDC210 MOVE GSWBIN2,=W'52' WJDC210 COPY CDISKBUF,CBIN0,GSWBIN2,CSENDBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM RET PEND EJECT ************************************************ * * FORMATS USED * ************************************************ * SNDFRM FRMT FSL FLINK SNDAUTO FNL FTEXT 'BRUGERNAVN' FKI 12,MINL=1,MAXL=13,ME FMEL 'AAAAAAAAAAAAAAAAAAA9',CBRUGNR FNL FTEXT 'KENDEORD' FKI 12,MINL=1,MAXL=4,ME FMEL 'TTT9',CKENDNR FMEND * SIGONF FRMT FILLR ' ',2 FCOPY =X'272020' FTEXT 'CSSN PS=' FMEL '9999',CKENDNR FTEXT ',NAME=' FMEL 'AAAAAAAAAAAAAAAAAAA9',CBRUGNR FMEND * SNDAUTO FRMT FBT CBCFLAG,FRMAUTO FCOPY =C'MANUEL ' FB FRMOUT FRMAUTO FCOPY =C'AUTOMATISK ' FRMOUT FCOPY =C'DATATRANSMISSION ' FMEND * SNDFRM2 FRMT FILLR ' ',2 FCOPY =X'272020' FCOPY CDISKBUF FMEND * SNDFRM3 FRMT FILLR '1',2 FCOPY =C'DATATRANSMISSION ' FMEND * SNDFRM5 FRMT FBNZ GSWBIN3,SNDLAB10 FILLR ' ',2 FCOPY =X'272020' SNDLAB10 FCOPY =X'112020' FCOPY CDISKBUF FMEND * SNDFRM6 FRMT FSL FCOPY ='DATATRANSMISSION ' FILLR '?',1 FKI 20,MAXL=1,ME FMEL '9',GSWBCD1 FNL FNL FTEXT '1: ' FCOPY =C'MANUEL ' FNL FTEXT '2: ' FCOPY =C'AUTOMATISK ' FBF CBCACTVF,FRM6020 FBT CBCSENDF,FRM6010 FTEXT '(ER AKTIV)' FB FRM6015 FRM6010 FTEXT '(SENDER)' FRM6015 FILLR ' ',4 FMEL 'ZZZZ9',GSWBCD2 FRM6020 FMEND * * SNDFRM7 FRMT FILLR '1',2 FLINK SNDAUTO FNL FNL FTEXT 'SEND FRA DENNE DISK? ' FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * SNDFRM8 FRMT FSL FLINK SNDAUTO FNL FNL FTEXT 'START ' FCOPY =C'FRA: ' FKI 12,MAXL=5 FMEL 'ZZZZ9',GSWBCD1 FMEND * SNDFRM9 FRMT FSL FLINK SNDAUTO FNL FNL FILLR ' ',3 FTEXT 'V[LG: ' FKI 9,MAXL=1 FMEL '9',GSWBCD1 FNL FTEXT '1: SEND RESTEN ' FNL FTEXT '2: AFBRYD SENDING ' FMEND * SNDFRM10 FRMT FSL FLINK SNDAUTO FNL FNL FTEXT 'SEND FRA: ' FKI 11,MAXL=5 FMEL 'ZZZZ9',GSWBCD1 FNL FILLR ' ',5 FTEXT 'TIL: ' FKI 11,MAXL=5 FMEL 'ZZZZ9',GSWBCD2 FMEND * WJDCFRM FRMT FNL FCOPY CDISKBUF FNL FMEND EJECT FBCACTV FRMT BC ACTIVATED FNL FLINK SNDAUTO FCOPY =C'AKTIVERET ' FMEL '99V99V99',CMASKDAT FLINK FSKIP FMEND * FBCSTRT FRMT START BATCH FNL FLINK SNDAUTO FCOPY ='BATCH SENDES' FNL FMEND * FBCEXIT FRMT EXIT BC TASK FNL FLINK SNDAUTO FCOPY =C'AFSLUTTET' FLINK FSKIP FMEND * FBCSTOP FRMT END OF BATCH FNL FLINK SNDAUTO FCOPY =C'BATCH SENDT' FLINK FSKIP FMEND * FSKIP FRMT SKIP LINES FNL FNL FNL FNL FNL FNL FNL FNL FMEND * FFNL FRMT FNL FMEND * FBCTERM FRMT FNL FLINK SNDAUTO FCOPY =C'AFBRUDT' FNL FMEND * FBCFROM FRMT FNL FCOPY =C'FRA: ' FMEL 'ZZZZZ9',GSWBCD1 FNL FMEND * FBCTO FRMT FNL FCOPY =C'FRA: ' FMEL 'ZZZZZ9',GSWBCD1 FILLR ' ',5 FCOPY =C'TIL: ' FMEL 'ZZZZZ9',GSWBCD2 FNL FMEND * * END