 CLP (OPP010CL)
/* */
/* |~~~~~~~~~~~~~~~~~~~~~~~~~~~|~~~~~~~~~~~~~~~~~~~~~~|~~~~~~~~~~~~| */
/* | PROGRAM ID .... OPP010CL | JOB TYPE .... INTER. | | */
/* | | | | */
/* |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~| */
/* | PROGRAMMER ....... T.KAKEFUDA | */
/* | CREATION ......... / / | */
/* | MODIFIED ......... / / BY XXXXXXXXXXXX | */
/* |_______________________________________________________________| */
/* */
PGM (&FILE &MBR &HI &DBL)
/* |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~| */
/* | DECLARE VARIABLES AND A FILE | */
/* |_______________________________________________________________| */
DCL &FILE *CHAR 10
DCL &MBR *CHAR 10
DCL &HI *CHAR 1
DCL &DBL *CHAR 1
MONMSG CPF0000 *N GOTO END
CHKOBJ OPRLIB/&FILE *FILE MBR(&MBR)
/* |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~| */
/* | CALL MAIN PROGRAM | */
/* |_______________________________________________________________| */
IF (&DBL='Y') OVRPRTF QPRT198 SPLFNAME(&MBR) RPLUNPRT(*NO)
ELSE OVRPRTF QPRT198 SPLFNAME(&MBR)
OVRDBF XXXXX OPRLIB/&FILE MBR(&MBR) NBRRCDS(100) SEQONLY(*YES 100)
CALL OPP010 (&HI &DBL)
DLTOVR *ALL
RETURN
END:
RETURN
ENDPGM
RPG (OPP010)
H Y/ 1
F******************************************************
F* D E F I N E F I L E S *
F******************************************************
FXXXXX IF F 102 DISK
F KINFDS DSINFO
FQPRT198 O F 198 PRINTER
E****************************************************
E* A R R A Y T A B L E *
E****************************************************
E LN 90 1 ;
E UL 90 1 ;
E UP 90 1 ;
E HI 90 1 ;
E* ;
E LN2 66 90 ;
E HI2 66 90 ;
E UL2 66 90 ;
E UP2 66 90 ;
I******************************************************
I* D E F I N E I N P U T F I E L D *
I******************************************************
IXXXXX AA 01
I 13 102 TXTSRC
I******************************************************
I* D E F I N E C O N S T A N T *
I******************************************************
I 'Y' C #YES
I ' ' C #NO
I X'2BFD04022020' C #DBLON
I X'2BFD04021010' C #DBLOF
I X'2BFD04020808' C #HLFON
I X'2BFD04021010' C #HLFOF
I*
I 'QUSRMBRD' C #PGMBR
I******************************************************
I* D E F I N E D A T A - S T R U C T U R E *
I******************************************************
IDSINFO DS
I 83 102 DSFLLB
I 83 92 DSFILE
I 93 102 DSFLIB
I 129 138 DSMBR
IDSLN DS
I 1 90 LN
IDSUL DS
I 1 90 UL
IDSUP DS
I 1 90 UP
IDSHI DS
I 1 90 HI
I DS
I B 1 40LENDTA
I B 5 80STRPOS
I B 9 120LENRCV
IMBD200 DS
I 73 78 DSMDAT
I 85 134 DSMTXT
C******************************************************
C* DEFINITION MODULE ( PLIST FIELD KLIST ) *
C******************************************************
C* ;
C* DEFINE ENTRY ;
C* ;
C *ENTRY PLIST ;
C PARM PIHI 1 ;濃くY/N
C PARM PIDBL 1 ;タイトル4倍角
C******************************************************
C* M A I N - R O U T I N E
C******************************************************
B001 C *IN90 DOUEQ*ON ;
001 C READ XXXXX 90;
B002 C *IN90 IFEQ *ON ;
002 C LEAVE ;
+002 C ELSE ;
002 C* ;
002 C MOVELTXTSRC W1NEW 5 ;
B003 C W1NEW IFEQ '/*NEW' ;改ページ予約語
003 C Z-ADDW1LINS LL :
+003 C ELSE ;
003 C* ;
003 C ADD 1 LL :
B004 C LL IFGT W1LINS ;
004 C EXSR @HED ;
004 C EXSR @TXT ;
004 C EXSR @FTR ;
004 C Z-ADD60 W1LINS :
004 C Z-ADD1 LL ;
004 C MOVE *OFF *IN89 ;
E004 C END ;
003 C* ;
003 C EXSR @ARY ;
003 C MOVE *ON *IN89 ;
E003 C END ;
E002 C END ;
E001 C END ;
C* ;
B001 C *IN89 IFEQ *ON ;
001 C EXSR @HED ;
001 C EXSR @TXT ;
001 C EXSR @FTR ;
E001 C END ;
C* ;
C MOVE *ON *INLR ;
C RETRN ;
C******************************************************
C* S U B - R O U T I N E
C******************************************************
C*----------------------------------------------------*
C *INZSR BEGSR :
C*----------------------------------------------------*
C PIHI COMP 'Y' 83;濃くY/N
C PIDBL COMP 'Y' 84;タイトル4倍角
C* :
C Z-ADD0 W1PAGE 30 :
C Z-ADD58 W1LINS 30 :
C Z-ADD0 LL 30 ;
C* :
C MOVE *BLANK O1SRCF 45 :
C DSFLIB CAT '/':0 O1SRCF :
C CAT DSFILE:0 O1SRCF :
C CAT '(':1 O1SRCF :
C CAT DSMBR:0 O1SRCF :
C CAT ')':0 O1SRCF :
C* :
C CALL #PGMBR :
C PARM MBD200 :
C PARM 230 LENRCV :
C PARM 'MBRD0200'MBR200 8 :
C PARM DSFLLB :
C PARM DSMBR :
C PARM *OFF OVRRID 1 :
C* :
B001 C *IN84 IFEQ *ON :
001 C* :
001 C MOVE *BLANK O1HDR 50 :
001 C MOVE *BLANK POLTR :
001 C MOVE *BLANK PILTR :
001 C CALL '#SRRGHT' :
001 C PARM DSMTXT POLTR :
001 C PARM 50 POLEN :
001 C O1HDR PARM PILTR :
001 C* :
001 C MOVE *BLANK POLTR :
001 C MOVE *BLANK PILTR :
001 C CALL '#SRCEN' :
001 C PARM DSMTXT POLTR :
001 C PARM 50 POLEN :
001 C DSMTXT PARM PILTR :
001 C* :
+001 C ELSE :
001 C* :
B002 C DSMTXT IFNE *BLANK :
002 C MOVE *BLANK O1MTXT 58 :
002 C MOVEL'§' O1MTXT :
002 C CAT DSMTXT:0 O1MTXT :
002 C CAT '§':0 O1MTXT :
E002 C END :
001 C* :
001 C MOVE *BLANK POLTR :
001 C MOVE *BLANK PILTR :
001 C CALL '#SRCEN' :
001 C PARM O1MTXT POLTR 200 :
001 C PARM 58 POLEN 30 :
001 C O1MTXT PARM PILTR 200 :
E001 C END :
C* :
C MOVE DSMDAT O1MDAT 60 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @HED BEGSR :
C*----------------------------------------------------*
C EXCPT#HED :
C MOVE *ON *IN82 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @FTR BEGSR :
C*----------------------------------------------------*
C ADD 1 W1PAGE :
C MOVE *BLANK O1PAGE 16 :
C* :
C SELEC :
C W1PAGE WHLT 10 :
C MOVE W1PAGE W1PAG1 1 :
C CAT DSMBR:0 O1PAGE :
C CAT '-':1 O1PAGE :
C CAT W1PAG1:0 O1PAGE :
C CAT '-':0 O1PAGE :
C W1PAGE WHLT 100 :
C MOVE W1PAGE W1PAG2 2 :
C CAT DSMBR:0 O1PAGE :
C CAT '-':1 O1PAGE :
C CAT W1PAG2:0 O1PAGE :
C CAT '-':0 O1PAGE :
C W1PAGE WHLT 1000 :
C MOVE W1PAGE W1PAG3 3 :
C CAT DSMBR:0 O1PAGE :
C CAT '-':1 O1PAGE :
C CAT W1PAG3:0 O1PAGE :
C CAT '-':0 O1PAGE :
C END :
C* :
C EXCPT#FTR :
C MOVE *ON *IN81 :
C* :
C ENDSR :
C*----------------------------------------------------*
C @ARY BEGSR :
C*----------------------------------------------------*
C MOVE TXTSRC DSLN :
C MOVE *BLANK DSHI :
C MOVE *BLANK DSUP :
C MOVE *BLANK DSUL :
C* ;
C* 一ライン作成 :
C* ;
B001 C 1 DO 90 JJ 30 ;
001 C* ;
001 C MOVE LN,JJ W1BYTE 1 ;
001 C* ;
B002 C W1BYTE IFLT X'20' ;
*002 C W1BYTE ANDNEX'0E' ;
*002 C W1BYTE ANDNEX'0F' ;
002 C MOVE #NO LN,JJ ;
E002 C END ;
001 C* ;
B002 C W1BYTE IFGE X'20' ;
*002 C W1BYTE ANDLTX'40' ;
B003 C #RICTL IFEQ #YES ;
003 C MOVE '|' UP,JJ ;
E003 C END ;
002 C MOVE #NO NONDSP ;
002 C MOVE #NO #HICTL ;
002 C MOVE #NO #ULCTL ;
002 C MOVE #NO #RICTL ;
E002 C END ;
001 C* ;
B002 C JJ IFGE 5 :
*002 C JJ ANDLE84 :
B003 C NONDSP IFEQ #YES ;
003 C MOVE #NO LN,JJ ;
E003 C END ;
B003 C #HICTL IFEQ #YES ;
003 C MOVE LN,JJ HI,JJ ;
E003 C END ;
B003 C #ULCTL IFEQ #YES ;
003 C MOVE '_' UL,JJ ;
E003 C END ;
B003 C #RICTL IFEQ #YES ;
003 C MOVE '~' UP,JJ ;
003 C MOVE '_' UL,JJ ;
E003 C END ;
E002 C END ;
001 C* ;
001 C EXSR @CHK ;
001 C* :
E001 C END ;
C* ;
C MOVE DSLN LN2,LL :
C MOVE DSHI HI2,LL :
C MOVE DSUL UL2,LL :
C MOVE DSUP UP2,LL :
C* ;
C ENDSR :
C*----------------------------------------------------*
C @TXT BEGSR :
C*----------------------------------------------------*
B001 C 1 DO W1LINS LL :
001 C MOVEA'000' *IN,85 :
001 C HI2,LL COMP *BLANK 8585 :
001 C UL2,LL COMP *BLANK 8686 :
001 C UP2,LL COMP *BLANK 8787 :
001 C EXCPT#DTL :
001 C EXCPT#DMY :
E001 C END :
C* ;
C MOVE *BLANK LN2 :
C MOVE *BLANK HI2 :
C MOVE *BLANK UP2 :
C MOVE *BLANK UL2 :
C* ;
C ENDSR :
C*----------------------------------------------------*
C @CHK BEGSR :ここは固定情報
C*----------------------------------------------------*と比較した方がいい
C MOVEA'0000' *IN,71 :このプログラム古いのです
C* :
B001 C W1BYTE IFGE X'20' :
*001 C W1BYTE ANDLEX'3F' :
001 C* :
001 C TESTB'567' W1BYTE 71:
001 C N71 TESTB'4567' W1BYTE 71:
001 C 71 MOVE #YES NONDSP 1 :
001 C* :
B002 C NONDSP IFNE #YES :
002 C TESTB'6' W1BYTE 72:HI
002 C N72 TESTB'67' W1BYTE 72:HI
002 C N72 TESTB'56' W1BYTE 72:HI
002 C N72 TESTB'46' W1BYTE 72:HI
002 C N72 TESTB'467' W1BYTE 72:HI
002 C N72 TESTB'456' W1BYTE 72:HI
002 C* :
002 C TESTB'5' W1BYTE 73:UL
002 C N73 TESTB'57' W1BYTE 73:UL
002 C N73 TESTB'56' W1BYTE 73:UL
002 C N73 TESTB'45' W1BYTE 73:UL
002 C N73 TESTB'457' W1BYTE 73:UL
002 C N73 TESTB'456' W1BYTE 73:UL
002 C* :
002 C TESTB'7' W1BYTE 74:RI
002 C N74 TESTB'67' W1BYTE 74:RI
002 C N74 TESTB'57' W1BYTE 74:RI
002 C N74 TESTB'47' W1BYTE 74:RI
002 C N74 TESTB'467' W1BYTE 74:RI
002 C N74 TESTB'457' W1BYTE 74:RI
E002 C END :
001 C* :
001 C MOVE #NO LN,JJ :
E001 C END :
C* :
B001 C *IN72 IFEQ *ON :
001 C MOVE #YES #HICTL 1 :
E001 C END :
B001 C *IN73 IFEQ *ON :
001 C MOVE #YES #ULCTL 1 :
E001 C END :
B001 C *IN74 IFEQ *ON :
001 C MOVE #YES #RICTL 1 :
001 C MOVE '|' UP,JJ :
E001 C END :
C* :
C ENDSR :
O******************************************************
O* O U T P U T M O D U L E *
O******************************************************
OQPRT198 E 0101 N84 #HED
O O1MDAT ' / / '
O '版'
O E 00 N84N82 #HED
O O1MTXT 80
O E 02 N84N82 #HED
O O1MTXT B 80
O*
O E 03 84N82 #HED
O #DBLON
O DSMTXT B 60
O #DBLOF
O E 0101 84 82 #HED
O #HLFON 80
O O1HDR
O O1MDAT ' . . '
O #HLFOF
O*
O E 01 #DMY
O*
O E 00 #DTL
O LN2,LL 107
O E 00 85 #DTL
O HI2,LL 107
O E 00 85 83 #DTL
O HI2,LL 107
O E 00 86 #DTL
O UL2,LL 107
O E 00 87 #DTL
O UP2,LL 107
O*
O E 0062 #FTR
O O1PAGE 109
O N81 84 #HLFON
O N81 84 O1MDAT ' . . '
O N81 84 #HLFOF
|
