这个主要程序RPG
Columns . . . : 1 71 Browse DHUG/QRPGSRC
SEU==> SDA04
FMT H .....H........1..CDYI....S..............1.F............................
*************** Beginning of data *************************************
*************** Feigme H.Guo*************************************
0001.00 H Y
0002.00 *
0003.00 FTSDAL UF E K DISK A
0004.00 F TSDAR KRENAMETSDARA
0005.00 *
0006.00 FTSDA04 CF E WORKSTN
0007.00 F @RRN KSFILE SUBFILE
0008.00 *----------------------------------------------------*
0009.00 *< ARRAY AREA > *
0010.00 *----------------------------------------------------*
0011.00 E @MSG 1 50 75 *MESSAGE
0012.00 *----------------------------------------------------*
0013.00 *< KLIST > *
0014.00 *----------------------------------------------------*
0015.00 C L@SDA KLIST
0016.00 C KFLD PNAME
0017.00 *
0018.00 *----------------------------------------------------*
0019.00 *< MAIN > *
0020.00 *----------------------------------------------------*
0021.00 C EXSR #S000
0022.00 C EXSR #ENDPG
0023.00 *
0024.00 *----------------------------------------------------*
0025.00 *< #S000--SCREEN 0 > *
0026.00 *----------------------------------------------------*
0027.00 C #S000 BEGSR
0028.00 *
0029.00 C MOVE @YES @LOOP0
0030.00 C @LOOP0 DOWEQ@YES
0031.00 C EXFMTSCD00
0032.00 C CLEARNOTE
0033.00 *
0034.00 C SELEC
0035.00 C *IN03 WHEQ *ON
0036.00 C EXSR #ENDPG
0037.00 C *IN12 WHEQ *ON
0038.00 C* MOVE @NO @LOOP0
0039.00 C LEAVE
0040.00 C ENDSL
0041.00 *
0042.00 C EXSR #CHK0
0043.00 C ENDDO
0044.00 *
0045.00 C ENDSR
0046.00 *----------------------------------------------------*
0047.00 *< #CHK0--CHECK SCREEN 0 > *
0048.00 *----------------------------------------------------*
0049.00 C #CHK0 BEGSR
0050.00 *
0051.00 C SLID IFGT 4
0052.00 C SLID ORLT 1
0053.00 C SETON 30
0054.00 C MOVEL@MSG,2 NOTE P
0055.00 C ENDIF
0056.00 *
0057.00 C SELEC
0058.00 C SLID WHEQ 1
0059.00 C EXSR #S001
0060.00 C SLID WHEQ 2
0061.00 C EXSR #SOO2
0062.00 C SLID WHEQ 3
0063.00 C EXSR #S003
0064.00 C ENDSL
0065.00 *
0066.00 C ENDSR
0067.00 *----------------------------------------------------*
0068.00 *< #S001--SCREEN 1 > *
0069.00 *----------------------------------------------------*
0070.00 C #S001 BEGSR
0071.00 *
0072.00 C MOVE @YES @LOOP1
0073.00 C @LOOP1 DOWEQ@YES
0074.00 C MOVE @YES @SIGN
0075.00 C EXFMTSCD01
0076.00 C CLEARNOTE
0077.00 *
0078.00 C SELEC
0079.00 C *IN03 WHEQ *ON
0080.00 C EXSR #ENDPG
0081.00 C *IN12 WHEQ *ON
0082.00 C* MOVE @NO @LOOP1
0083.00 C LEAVE
0084.00 C ENDSL
0085.00 *
0086.00 C EXSR #CHK1
0087.00 C @SIGN IFEQ @YES
0088.00 C EXFMTSCD011
0089.00 C EXSR #WRT
0090.00 C ENDIF
0091.00 *
0092.00 C ENDDO
0093.00 *
0094.00 C ENDSR
0095.00 *----------------------------------------------------*
0096.00 *< #CHK1--CHECK SCREEN 1 > *
0097.00 *----------------------------------------------------*
0098.00 C #CHK1 BEGSR
0099.00 *
0100.00 C NAME01 IFEQ *BLANK
0101.00 C SETON 31
0102.00 C MOVE @NO @SIGN
0103.00 C MOVEL@MSG,2 NOTE P
0104.00 C ELSE
0105.00 C MOVELNAME01 PNAME P
0106.00 C L@SDA CHAINTSDARA 60
0107.00 C *IN60 IFEQ *OFF
0108.00 C MOVEL@MSG,4 NOTE P
0109.00 C MOVE @NO @SIGN
0110.00 C ELSE
0111.00 C SETOF 31
0112.00 C MOVE @YES @SIGN P
0113.00 C ENDIF
0114.00 C ENDIF
0115.00 *
0116.00 C AGE01 IFEQ *ZERO
0117.00 C SETON 32
0118.00 C MOVE @NO @SIGN
0119.00 C MOVEL@MSG,2 NOTE P
0120.00 C ELSE
0121.00 C SETOF 32
0122.00 C ENDIF
0123.00 *
0124.00 C ADDR01 IFEQ *BLANK
0125.00 C SETON 33
0126.00 C MOVE @NO @SIGN
0127.00 C ELSE
0128.00 C SETOF 33
0129.00 C ENDIF
0130.00 *
0131.00 C ENDSR
0132.00 *----------------------------------------------------*
0133.00 *< #S002--SCREEN 2 > *
0134.00 *----------------------------------------------------*
0135.00 C #SOO2 BEGSR
0136.00 *
0137.00 C MOVE @YES @LOOP2
0138.00 C @LOOP2 DOWEQ@YES
0139.00 C EXFMTSCD02
0140.00 C CLEARNOTE
0141.00 *
0142.00 C SELEC
0143.00 C *IN03 WHEQ *ON
0144.00 C EXSR #ENDPG
0145.00 C *IN12 WHEQ *ON
0146.00 C* MOVE @NO @LOOP2
0147.00 C LEAVE
0148.00 C *IN06 WHEQ *ON
0149.00 C EXSR #LAST
0150.00 C *IN07 WHEQ *ON
0151.00 C EXSR #NEXT
0152.00 C ENDSL
0153.00 *
0154.00 C EXSR #CHK2
0155.00 C ENDDO
0156.00 *
0157.00 C ENDSR
0158.00 *----------------------------------------------------*
0159.00 *< #CHK2--CHECK SCREEN 2 > *
0160.00 *----------------------------------------------------*
0161.00 C #CHK2 BEGSR
0162.00 *
0163.00 C OP IFEQ *BLANK
0164.00 C OP1 ANDEQ*ZERO
0165.00 C *IN07 ANDEQ*OFF
0166.00 C *IN06 ANDEQ*OFF
0167.00 C MOVEL@MSG,2 NOTE P
0168.00 C ENDIF
0169.00 *
0170.00 C OP IFNE *BLANK
0171.00 C OP1 ANDEQ*ZERO
0172.00 C *IN07 ANDEQ*OFF
0173.00 C *IN06 ANDEQ*OFF
0174.00 C EXSR #SEL
0175.00 C ENDIF
0176.00 *
0177.00 C OP IFEQ *BLANK
0178.00 C OP1 ANDEQ4
0179.00 C *IN06 ANDEQ*OFF
0180.00 C *IN07 ANDEQ*OFF
0181.00 C EXSR #DEL
0182.00 C ENDIF
0183.00 *
0184.00 C ENDSR
0185.00 *----------------------------------------------------*
0186.00 *< #INIPG--INIT PGM > *
0187.00 *----------------------------------------------------*
0188.00 C *INZSR BEGSR
0189.00 *
0190.00 C MOVE *BLANK @LOOP0 1
0191.00 C MOVE *BLANK @LOOP1 1
0192.00 C MOVE *BLANK @LOOP2 1
0193.00 C MOVE *BLANK @LOOP3 1
0194.00 C MOVE *BLANK @SIGN 1
0195.00 C MOVE 'Y' @YES 1
0196.00 C MOVE 'N' @NO 1
0197.00 C Z-ADD0 @RRN 50
0198.00 *
0199.00 C ENDSR