bcl99.prg

使用VFP编写的信用社系统专用会计报表系统,可上报,汇总,打印.是一款优秀的信用社会计报表系统

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BCL99.PRG <-- 本文件由 UnFoxAll 创建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


 SET TALK OFF
 SET CONSOLE OFF
 SET EXACT ON
 SET SAFETY OFF
 IF 1 = 0
 SET DEFAULT TO \xbbjs
 MMBZ4 = '4'
 NIAN = '1998'
 YUE = '12'
 ENDIF 
 SET TALK OFF
 SET SAFETY OFF
 SET EXACT ON
 SET CONSOLE OFF
 DO WHILE .T.
 QBAR = 0
 DO FORM .\src\form\bcl99
 IF QBAR = 0
 EXIT 
 ENDIF 
 QBAR = QBAR + 2
 DO ZHCLCASE
 ENDDO 
 RETURN 

PROCEDURE ZHCLCASE
 DO CASE 
 CASE QBAR = 3
 IF VAL(YUE) = 3 .OR. VAL(YUE) = 6 .OR. VAL(YUE) = 9 .OR. VAL(YUE) = 12
 TTN1 = VAL(YUE) - 2
 TTN2 = '2'
 TTN3 = '1'
 TTN4 = 0
 DO ZHCL0
 ELSE 
 WAIT WINDOW '不能生成季报表'
 ENDIF 
 CASE QBAR = 4
 IF VAL(YUE) = 6 .OR. VAL(YUE) = 12
 TTN1 = VAL(YUE) - 5
 TTN2 = '4'
 TTN3 = '1'
 TTN4 = 0
 DO ZHCL0
 ELSE 
 WAIT WINDOW '不能生成半年报表'
 ENDIF 
 CASE QBAR = 5
 IF VAL(YUE) > 8
 TTN1 = 1
 TTN2 = '3'
 TTN3 = '1'
 TTN4 = 0
 DO ZHCL0
 ELSE 
 WAIT WINDOW '不能生成年度报表'
 ENDIF 
 CASE QBAR = 6
 IF VAL(YUE) = 6 .OR. VAL(YUE) = 12
 TTN1 = VAL(YUE) - 2
 TTN2 = '4'
 TTN3 = '2'
 TTN4 = 2
 DO ZHCL0
 ELSE 
 WAIT WINDOW '不能生成半年报表'
 ENDIF 
 CASE QBAR = 7
 IF VAL(YUE) = 12
 TTN1 = VAL(YUE) - 8
 TTN2 = '3'
 TTN3 = '2'
 TTN4 = 2
 DO ZHCL0
 ELSE 
 WAIT WINDOW '不能生成年报表'
 ENDIF 
 CASE QBAR = 8
 IF VAL(YUE) = 12
 TTN1 = VAL(YUE) - 5
 TTN2 = '3'
 TTN3 = '4'
 TTN4 = 5
 DO ZHCL0
 ELSE 
 WAIT WINDOW '不能生成年报表'
 ENDIF 
 ENDCASE 
ENDPROC
*------
PROCEDURE ZHCL0
 QNIAN = VAL(NIAN)
 QYUE = VAL(YUE)
 NIAN1 = '  '
 YUE1 = '  '
 TTN5 = 0
 TTN6A = ' '
 TTN6B = ' '
 DO FORM .\src\form\getrq TO NIAN1 WITH '生成数据'
 YUE1 = RIGHT(NIAN1,2)
 NIAN1 = LEFT(NIAN1,4)
 CL_NIAN1 = RIGHT(NIAN1,2)
 TTN5 = 0
 TTN6 = 0
 Q_QUIT = .F.
 DO FORM .\src\form\bcl99a
 IF Q_QUIT
 RETURN 
 ENDIF 
 IF TTN5 = 0 .OR. TTN6 = 0
 RETURN 
 ENDIF 
 II = TIME(3)
 WAIT WINDOW NOCLEAR NOWAIT '系统正在计算数据,请稍候!'
 CL_NIAN = RIGHT(NIAN,2)
  IF !FILE("DAT\B01&cl_NIAN&YUE..DAT")
  WAIT  "&NIAN" + " 年 "+ "&YUE" + "月会计报表数据文件不存在!" wind
 RETURN 
 ELSE 
  USE dat\B01&cl_NIAN&YUE..dat
 LOCATE FOR BLX1 = TTN2 AND BLX2 = '0'
 IF  .NOT. EOF()
 MSGTTL = '数据生成'
 MESSGTXT = '数据已存在，覆盖?'
 IF MESSAGEBOX(MESSGTXT,36,MSGTTL) = 7
 USE 
 WAIT CLEAR
 RETURN 
 ELSE 
 WAIT WINDOW NOCLEAR NOWAIT '系统正在计算数据,请稍候!'
 DELETE FOR BLX1 = TTN2 AND BLX2 = '0'
 PACK 
 ENDIF 
 ENDIF 
 ENDIF 
 SCAN FOR ALLTRIM(XMDH) = 'dpbz' AND BLX1 = TTN3
 IF SJDW = 0
  WAIT "&NIAN" + "年" + "&YUE" + "月"+allt(str(dqdh))+"地区会计报表数据文件不平!  " wind
 USE 
 RETURN 
 ENDIF 
 ENDSCAN 
 USE 
 FOR HKL = TTN1 TO VAL(YUE) - 1
 KLL = ALLTRIM(STR(HKL))
 IF LEN(KLL) = 1
 KLL = '0' + KLL
 ENDIF 
  IF !FILE("DAT\B01&cl_NIAN&KLL..DAT")
  WAIT  "&NIAN" + "年" + "&kll" + "月会计报表数据文件不存在!" wind
 RETURN 
 ELSE 
  USE dat\B01&cl_NIAN&KLL..dat
 SCAN FOR ALLTRIM(XMDH) = 'dpbz' AND BLX1 = TTN3
 IF SJDW = 0
  WAIT "&NIAN" + "年" + kll + "月"+allt(str(dqdh))+"地区会计报表数据文件不平! " wind
 USE 
 RETURN 
 ENDIF 
 ENDSCAN 
 USE 
 DO ZHCL2
 ENDIF 
 HKL = HKL + TTN4
 ENDFOR 
 SELECT 1
 USE 
  USE dat\B01&cl_NIAN&YUE..dat
 APPEND FROM LIB\B01-1.dat
 USE 
 II1 = TIME(3)
 WAIT CLEAR
 MSGTTL = '提示'
 MESSGTXT = '数据处理完毕'
  MESSAGEBOX(MESSGTXT,64,MSGTTL)
ENDPROC
*------
PROCEDURE ZHCL2
 IF HKL = TTN1
  SELECT  *  FROM  dat\B01&cl_NIAN&YUE..dat  INTO TABLE LIB\B01-1.dat WHERE blx1=TTN3  AND BLX2="0"
 INDEX ON XMDH TO LIB\B01-1.IDX
 USE 
 USE IN 1 LIB\B01-1.dat INDEX LIB\B01-1.IDX
 SELECT 1
 REPLACE BLX1 WITH (TTN2)
 REPLACE BLX2 WITH ('0')
 REPLACE DA1 WITH 0 FOR XMDH <> 'dpbz'
 REPLACE DA2 WITH 0 FOR XMDH <> 'dpbz'
 GO TOP
  USE dat\B01&cl_nian1&yue1..dat  IN 2
 SELECT 2
 SCAN FOR BLX1 = ALLTRIM(STR(TTN5)) AND BLX2 = '0'
 SELECT 1
 SEEK B.XMDH
 SCAN FOR XMDH = B.XMDH AND DQDH = B.DQDH
  REPL DA1 WITH B->&ttn6a  
  REPL DA2 WITH B->&ttn6b
 EXIT 
 ENDSCAN 
 SELECT 2
 ENDSCAN 
 SELECT 2
 USE 
 ENDIF 
  USE dat\B01&cl_NIAN&KLL..dat  IN 2
 SELECT 2
 SCAN FOR BLX1 = TTN3 AND BLX2 = '0'
 SELECT 1
 SEEK B.XMDH
 SCAN FOR XMDH = B.XMDH AND DQDH = B.DQDH
 REPLACE DA3 WITH B.DA3 + DA3
 REPLACE DA4 WITH B.DA4 + DA4
 EXIT 
 ENDSCAN 
 SELECT 2
 ENDSCAN 
 SELECT 2
 USE 
ENDPROC
*------*