这个主要程序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
0200.00 *----------------------------------------------------*
0201.00 *< #ENDPG--END PGM > *
0202.00 *----------------------------------------------------*
0203.00 C #ENDPG BEGSR
0204.00 *
0205.00 C SETON LR
0206.00 C RETRN
0207.00 *
0208.00 C ENDSR
0209.00 *----------------------------------------------------*
0210.00 *< #WRT--WRITE INFO TO LF > *
0211.00 *----------------------------------------------------*
0212.00 C #WRT BEGSR
0213.00 *
0214.00 C CLEARNOTE
0215.00 C MOVELNAME01 PNAME P
0216.00 C Z-ADDAGE01 PAGE
0217.00 C MOVELADDR01 PADDR P
0218.00 *
0219.00 C WRITETSDARA
0220.00 C CLEARTSDARA
0221.00 C MOVEL@MSG,1 NOTE P
0222.00 *
0223.00 C CLEARNAME01
0224.00 C CLEARAGE01
0225.00 C CLEARADDR01
0226.00 *
0227.00 C ENDSR
0228.00 *----------------------------------------------------*
0229.00 *< #SEL--SELECT FROM LF > *
0230.00 *----------------------------------------------------*
0231.00 C #SEL BEGSR
0232.00 *
0233.00 C CLEARNOTE
0234.00 C MOVELOP PNAME P
0235.00 C L@SDA CHAINTSDARA 60
0236.00 C *IN60 IFEQ *OFF
0237.00 C MOVELPNAME NAME02 P
0238.00 C Z-ADDPAGE AGE02
0239.00 C MOVELPADDR ADDR02 P
0240.00 C ELSE
0241.00 C MOVEL@MSG,3 NOTE P
0242.00 C ENDIF
0243.00 *
0244.00 C ENDSR
0245.00 *----------------------------------------------------*
0246.00 *< #DEL--DELETE RECORD FROM LF > *
0247.00 *----------------------------------------------------*
0248.00 C #DEL BEGSR
0249.00 *
0250.00 C CLEARNOTE
0251.00 C MOVELNAME02 PNAME P
0252.00 C L@SDA CHAINTSDARA 61
0253.00 C *IN61 IFEQ *OFF
0254.00 C DELETTSDARA
0255.00 C CLEARNAME02
0256.00 C CLEARAGE02
0257.00 C CLEARADDR02
0258.00 C MOVEL@MSG,5 NOTE P
0259.00 C ELSE
0260.00 C MOVEL@MSG,4 NOTE P
0261.00 C ENDIF
0262.00 *
0263.00 C ENDSR
0264.00 *----------------------------------------------------*
0265.00 *< #NEXT--TO SELECT NEXT RECORD > *
0266.00 *----------------------------------------------------*
0267.00 C #NEXT BEGSR
0268.00 *
0269.00 C NAME02 IFEQ *BLANK
0270.00 C *LOVAL SETLLTSDARA
0271.00 C READ TSDARA 70
0272.00 C ELSE
0273.00 C MOVELNAME02 PNAME P
0274.00 C L@SDA SETGTTSDARA
0275.00 C READ TSDARA 70
0276.00 C ENDIF
0277.00 C *IN70 IFEQ *OFF
0278.00 C MOVELPNAME NAME02 P
0279.00 C Z-ADDPAGE AGE02
0280.00 C MOVELPADDR ADDR02 P
0281.00 C ELSE
0282.00 C MOVEL@MSG,6 NOTE P
0283.00 C ENDIF
0284.00 *
0285.00 C ENDSR
0286.00 *----------------------------------------------------*
0287.00 *< #LAST > *
0288.00 *----------------------------------------------------*
0289.00 C #LAST BEGSR
0290.00 *
0291.00 C NAME02 IFEQ *BLANK
0292.00 C *HIVAL SETGTTSDARA
0293.00 C READPTSDARA 71
0294.00 C ELSE
0295.00 C MOVELNAME02 PNAME
0296.00 C L@SDA SETLLTSDARA
0297.00 C READPTSDARA 71
0298.00 C ENDIF
0299.00 C *IN71 IFEQ *OFF
0300.00 C MOVELPNAME NAME02 P
0301.00 C Z-ADDPAGE AGE02
0302.00 C MOVELPADDR ADDR02 P
0303.00 C ELSE
0304.00 C MOVEL@MSG,7 NOTE P
0305.00 C ENDIF
0306.00 *
0307.00 C ENDSR
0308.00 *----------------------------------------------------*
0309.00 *< #S003 -- SCREEN 03 > *
0310.00 *----------------------------------------------------*
0311.00 C #S003 BEGSR
0312.00 *
0313.00 C MOVE @YES @LOOP3
0314.00 C @LOOP3 DOWEQ@YES
0315.00 C WRITEFOOT1
0316.00 C WRITEHEAD
0317.00 C* EXFMTPROMPT
0318.00 *
0319.00 C SELEC
0320.00 C *IN03 WHEQ *ON
0321.00 C EXSR #ENDPG
0322.00 C *IN12 WHEQ *ON
0323.00 C LEAVE
0324.00 C ENDSL
0325.00 *
0326.00 C EXSR #CHK03
0327.00 C ENDDO
0328.00 *
0329.00 C ENDSR
0330.00 *----------------------------------------------------*
0331.00 *< #CHK03 -- CHECK SCREEN 03 > *
0332.00 *----------------------------------------------------*
0333.00 C #CHK03 BEGSR
0334.00 *
0335.00 C* *LOVAL SETLLTSDARA
0336.00 C EXSR #SFPRC
0337.00 *
0338.00 C ENDSR
0339.00 *----------------------------------------------------*
0340.00 *< #SFCLR > *
0341.00 *----------------------------------------------------*
0342.00 C #SFCLR BEGSR
0343.00 *
0344.00 C SETON 55
0345.00 C WRITESUBCTL
0346.00 C SETOF 55
0347.00 C SETOF 21
0348.00 C Z-ADD0 @RRN
0349.00 *
0350.00 C ENDSR
0351.00 *----------------------------------------------------*
0352.00 *< #SFPRC > *
0353.00 *----------------------------------------------------*
0354.00 C #SFPRC BEGSR
0355.00 *
0356.00 C EXSR #SFCLR
0357.00 C EXSR #SFRED
0358.00 *
0359.00 C WRITEFOOT1
0360.00 C WRITEHEAD
0361.00 C EXFMTSUBCTL
0362.00 C EXSR #CHK04
0363.00 *
0364.00 C ENDSR
0365.00 *----------------------------------------------------*
0366.00 *< #SFRED > *
0367.00 *----------------------------------------------------*
0368.00 C #SFRED BEGSR
0369.00 *
0370.00 C *LOVAL SETLLTSDARA
0371.00 C *IN21 DOWEQ*OFF
0372.00 C READ TSDARA 71
0373.00 C *IN71 IFEQ *ON
0374.00 C Z-ADD@RRN NUMB
0375.00 C SETON 44
0376.00 C MOVE '1' *IN21
0377.00 C ELSE
0378.00 C @RRN ADD 1 ID03
0379.00 C MOVELPNAME NAME03 P
0380.00 C Z-ADDPAGE AGE03
0381.00 C MOVELPADDR ADDR03 P
0382.00 C ADD 1 @RRN
0383.00 C MOVE *BLANK OP3
0384.00 C WRITESUBFILE
0385.00 C ENDIF
0386.00 C ENDDO
0387.00 *
0388.00 C ENDSR
0389.00 *----------------------------------------------------*
0390.00 *< #CHK04 > *
0391.00 *----------------------------------------------------*
0392.00 C #CHK04 BEGSR
0393.00 *
0394.00 C READCSUBFILE 98
0395.00 C *IN98 IFEQ *OFF
0396.00 C MOVELNAME03 PNAME P
0397.00 C L@SDA CHAINTSDARA 71
0398.00 C *IN71 IFEQ *OFF
0399.00 C MOVELPNAME NAME04 P
0400.00 C Z-ADDPAGE AGE04
0401.00 C MOVELPADDR ADDR04 P
0402.00 C EXFMTSCD04
0403.00 C ENDIF
0404.00 C ENDIF
0405.00 *
0406.00 C ENDSR
0407.00 *
0408.00 ** MESSAGE DESC **
0409.00 THE WRITE SUCCESS! 1
0410.00 INVALID INPUT! 2
0411.00 RECORD NOT EXIST! 3
0412.00 THE NAME IS EXIST! 4
0413.00 THE RECORD HAS DELETE! 5
0414.00 BOTTOM 6
0415.00 TOP 7
****************** End of data ***********************
这类格式及方法我设计了很久,觉得还不错
扫一扫
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
