bcl7.prg

来自「使用VFP编写的信用社系统专用会计报表系统,可上报,汇总,打印.是一款优秀的信用」· PRG 代码 · 共 518 行

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BCL7.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 
 XSLJ = ''
 XSBM = ''
 XSYK = ''
 XSLX = ''
 XSDQ = ''
 STORE '  ' TO M_BH , M_BM , FF , DD , M_DQMC
 STORE '0' TO M_BLX1 , M_BLX2 , SCWJPD
 M_LX = .F.
 M_LXM = ''
 SELNO = .F.
 CLOSE DATABASES 
 DO WHILE .T.
 SZ1 = 0
 DO FORM .\src\form\bcl7
 IF SZ1 = 0
 EXIT 
 ENDIF 
 IF SZ1 = 3
 DO FORM .\src\form\sblx
 FF = '  '
 DD = 'A'
 DO FORM .\src\form\bcl71
 IF SELNO = .F.
 DO BCL71 WITH SZ1 , FF , DD , M_BLX1
 ELSE 
 EXIT 
 ENDIF 
 ELSE 
 DO SZ
 ENDIF 
 ENDDO 
 CLOSE DATABASES 
 RETURN 

PROCEDURE SZ
 DO WHILE .T.
 M_LX = .F.
 M_BH = '00'
 DO SZBB
 IF M_BH = '00'
 EXIT 
 ENDIF 
 IF M_LX = .T.
 DO WHILE .T.
 M_BLX2 = '0'
 DO SZLX2
 IF M_BLX2 = '0'
 EXIT 
 ENDIF 
 M_BLX1 = '0'
 DO SZLX1
 IF M_BLX1 = '0'
 EXIT 
 ENDIF 
 IF SZ1 = 1
 DO SB
 ELSE 
 DO DSB
 ENDIF 
 ENDDO 
 ELSE 
 M_BLX1 = '0'
 DO SZLX1
 IF M_BLX1 = '0'
 LOOP 
 ENDIF 
 IF SZ1 = 1
 DO SB
 ELSE 
 DO DSB
 ENDIF 
 ENDIF 
 ENDDO 
ENDPROC
*------
PROCEDURE SZBB
 DO FORM .\src\form\GONG2
 IF M_BH = '00'
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 IF  .NOT. USED('BZL')
 USE IN 0 LIB\BZL.DAT
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = M_BH
 M_LX = LX
 M_BM = BM
 USE 
ENDPROC
*------
PROCEDURE SZLX2
 M_LXM = '   '
 M_BLX2 = '0'
 DO FORM .\src\form\BLX
 RETURN 
ENDPROC
*------
PROCEDURE SZLX1
 M_BLX1 = '0'
 DO FORM .\src\form\sblx
 RETURN 
ENDPROC
*------
PROCEDURE SB
 DELPD = 0
 DO WHILE .T.
 FF = '  '
 DD = 'A'
 DO FORM .\src\form\bcl7a
 DD = LEFT(DD,1)
 IF FF = '  '
 EXIT 
 ENDIF 
 WAIT WINDOW NOCLEAR NOWAIT ' 请稍候 ..... '
 WJPD = 0
 DELPD = 0
 DO SBWJPD
 IF WJPD = 1
 EXIT 
 ENDIF 
 DO JLSBWJ
 WAIT WINDOW '上报完毕!!!'
 EXIT 
 ENDDO 
 CLOSE DATABASES 
 DELETE File TMP.IDX
 IF DELPD = 1
 DELETE File HTMP.DBF
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE SBWJPD
 CL_NIAN = RIGHT(NIAN,2)
  HZWJ="dat\H&M_BH&cl_NIAN..dat"
 IF  .NOT. FILE(HZWJ)
 WAIT WINDOW '无汇总数据,不能上报!'
 WJPD = 1
 RETURN 
 ENDIF 
  USE dat\H&M_BH&cl_NIAN..dat
 INDEX ON DQDH TO TMP
 LOCATE FOR  ;
      DQDH = VAL(YUE) AND XMDH = 'dpbz' AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND DA1 = 0
 IF  .NOT. FOUND()
 WAIT WINDOW '无全部地区汇总数据,不能上报!'
 WJPD = 1
 RETURN 
 ENDIF 
 IF SJDW = 0
 WAIT WINDOW '汇总文件不平,不能上报'
 WJPD = 1
 RETURN 
 ENDIF 
ENDPROC
*------
PROCEDURE JLSBWJ
 COPY TO HTMP FOR DQDH = VAL(YUE) AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 USE HTMP
 DO WHILE .T.
 LOCATE FOR  ;
      DQDH = VAL(YUE) AND XMDH = 'dpbz' AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND DA1 <> 0
 IF FOUND()
 DELETE 
 SKIP 
 DO WHILE  .NOT. EOF()
 IF XMDH <> 'dpbz'
 DELETE 
 SKIP 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 PACK 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
  if file("lib\zh&m_bh..dat")
  use lib\zh&m_bh..dat in 0 alia zhwh1
  use lib\zh&M_bh.a.dat in 0 alia zhwh2 
 USE IN 0 lib\bzl.dat
 SELECT BZL
 LOCATE FOR BH = M_BH
 LSH = LS
 SELECT ZHWH1
 SCAN 
 YXMDH = XMDH
 SELECT ZHWH2
 FOR MK = 1 TO LSH
 DH = ALLTRIM(STR(MK))
  ss&dh=0
 ENDFOR 
 SCAN FOR XH = ZHWH1.XH
 FHD = FH
 SELECT HTMP
 LOCATE FOR XMDH = ZHWH2.XMDH
 FOR MK = 1 TO LSH
 DH = ALLTRIM(STR(MK))
  ss&dh=ss&dh.&fhd.da&dh
 ENDFOR 
 IF XMDH <> YXMDH
 DELETE 
 PACK 
 ENDIF 
 ENDSCAN 
 SELECT HTMP
 LOCATE FOR XMDH = YXMDH
 FOR MK = 1 TO LSH
 DH = ALLTRIM(STR(MK))
  repl da&dh with ss&dh
 ENDFOR 
 ENDSCAN 
 ENDIF 
 CL_NIAN = RIGHT(NIAN,2)
  DATWJ="&DD.:S&cl_NIAN&FF&M_BH..dat"
 IF FILE(DATWJ)
 SELECT 0
  USE &DD.:S&cl_NIAN&FF&M_BH..dat
 DELETE FOR DQDH <> VAL(YUE)
 PACK 
 LOCATE FOR DQDH = VAL(YUE) AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 IF FOUND()
 DELETE FOR DQDH = VAL(YUE) AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 PACK 
 ENDIF 
 APPEND FROM HTMP.DBF FOR DQDH = VAL(YUE) AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 ELSE 
 SELECT HTMP
  COPY TO &DD.:S&cl_NIAN&FF&M_BH..dat FOR DQDH=val(YUE) AND BLX1=M_BLX1 AND BLX2=M_BLX2 
 ENDIF 
 SELECT HTMP
 USE 
 DELETE File HTMP.DBF
ENDPROC
*------
PROCEDURE DSB
 DO WHILE .T.
 M_DEMC = ''
 WJPD = 0
 SCWJPD = 0
 DD = 'A'
 DO SBDQPD
 IF WJPD = 1
 EXIT 
 ENDIF 
 WAIT WINDOW NOCLEAR NOWAIT ' 请稍候...... '
 WJPD = 0
 DO DSBWJPD
 IF WJPD = 1
 EXIT 
 ENDIF 
 DO LXXG
 WJPD = 0
 SCWJPD = 0
 CL_NIAN = RIGHT(NIAN,2)
  IF !FILE("dat\B&M_BH&cl_NIAN&YUE..dat")
  DO WJ2 WITH "B&M_BH&cl_NIAN&YUE","&M_BH"
 ENDIF 
 DO DSBWJ
 IF WJPD = 1
 EXIT 
 ENDIF 
  IF !USED("B&M_BH&cl_NIAN&YUE")
  USE dat\B&M_BH&cl_NIAN&YUE..dat IN 0
 ENDIF 
  SELE B&M_BH&cl_NIAN&YUE
  use lib\xm&M_bh..dat in 99
 SELECT STMP
 LOCATE FOR XMDH = 'dpbz'
  SELE B&M_BH&cl_NIAN&YUE
 APPEND FROM dat\stmp.dat FOR XMDH = 'dpbz'
 GO TOP
 SELECT 99
 COUNT TO S99
 GO TOP
 FOR I = 1 TO S99
 XMDHXMH = XMDH
 SELECT STMP
 LOCATE FOR XMDH = XMDHXMH
 IF XMDH = XMDHXMH
  SELE B&M_BH&cl_NIAN&YUE
 APPEND FROM dat\stmp.dat FOR XMDH = XMDHXMH
 ELSE 
  SELE B&M_BH&cl_NIAN&YUE
  appe from lib\xm&M_BH..dat for xmdh=xmdhxmh
 SELECT STMP
 GO 2
  SELE B&M_BH&cl_NIAN&YUE
 REPLACE DQDH WITH STMP.DQDH , BLX1 WITH STMP.BLX1 , BLX2 WITH STMP.BLX2 , SJDW WITH  ;
      STMP.SJDW
 ENDIF 
 SELECT 99
 SKIP 
 ENDFOR 
 SELECT STMP
 USE 
 SELECT 99
 USE 
 WAIT WINDOW ' 上报读取完毕  '
 CLOSE DATABASES 
 DELETE File dat\stmp.dat
 DELETE File tmp.IDX
 EXIT 
 ENDDO 
 CLOSE DATABASES 
 IF SCWJPD = 1
 DELETE File tmp.tmp
 DELETE File t001.dbf
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE WJ2
 PARAMETER DATNAME , M_BH
 SCWJPD = 1
 IF  .NOT. USED('blk')
 USE IN 0 lib\BLK.dat
 ENDIF 
 SELECT BLK
 COPY TO t001 STRUCTURE EXTENDED 
 SELECT 0
 USE t001
 ZAP 
 SELECT FIELD_NAME , FIELD_TYPE , FIELD_LEN , FIELD_DEC WHERE BH = (M_BH) INTO TABLE  ;
      tmp.tmp FROM blk
 SELECT T001
 APPEND FROM tmp.tmp
  CREATE dat\&datname FROM t001
 USE 
  RENAME DAT\&DATNAME..DBF TO DAT\&DATNAME..DAT
 SELECT BLK
 USE 
 SELECT TMP
 USE 
 RETURN 
ENDPROC
*------
PROCEDURE SBDQPD
 FF = '  '
 DO FORM .\src\form\bcl7a
 DD = LEFT(DD,1)
 SELECT 0
 USE LIB\DQK.DAT
 LOCATE FOR DQDH = VAL(FF) AND KHBZ = .T.
 IF  .NOT. FOUND()
 WAIT WINDOW '    无此地区代号      '
 WJPD = 1
 RETURN 
 ENDIF 
 M_DQMC = DQMC
ENDPROC
*------
PROCEDURE DSBWJPD
 CL_NIAN = RIGHT(NIAN,2)
  IF !FILES("&DD.:S&cl_NIAN&FF&M_BH..dat")
 WAIT WINDOW '上报数据不存在    '
 WJPD = 1
 RETURN 
 ENDIF 
 SELECT 0
  USE &DD.:S&cl_NIAN&FF&M_BH..DAT 
 COPY TO dat\stmp.dat FOR BLX1 = M_BLX1 AND BLX2 = M_BLX2
 SELECT 0
 USE dat\stmp.dat
 SELECT STMP
 IF EOF()
 WAIT WINDOW '    上报数据不存在    '
 WJPD = 1
 USE 
 DELETE File dat\stmp.dat
 RETURN 
 ENDIF 
  IF DQDH#&YUE
 WAIT WINDOW '上报文件非本月数据'
 WJPD = 1
 USE 
 DELETE File dat\stmp.dat
 RETURN 
 ENDIF 
  REPLACE ALL DQDH WITH &FF			
ENDPROC
*------
PROCEDURE LXXG
 DO WHILE .T.
 MSGTTL = '上报数据类型修改'
 SELECT STMP
 GO TOP
  Messgtxt = M_BM + "&NIAN" +"年"+"&YUE" +"月" + chr(13) + "地区代号:"	+ "&FF" + M_DQMC + "报表类型:"
 DO CASE 
 CASE BLX1 = '1'
 MESSGTXT = MESSGTXT + '月  报'
 CASE BLX1 = '2'
 MESSGTXT = MESSGTXT + '季  报'
 CASE BLX1 = '3'
 MESSGTXT = MESSGTXT + '年  报'
 ENDCASE 
 MESSGTXT = MESSGTXT + CHR(13) + '盈亏类型:'
 M_BLX2 = BLX2
 DO SZLX2A
 MESSGTXT = MESSGTXT + M_LXM + CHR(13) + CHR(13) + '是否修改?'
 IF MESSAGEBOX(MESSGTXT,36,MSGTTL) = 6
 DO SZLX
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
ENDPROC
*------
PROCEDURE SZLX
 MYWORD = ' '
 MYWORD1 = ' '
 SEL = 1
 DO X1
 SELECT STMP
 REPLACE BLX1 WITH (MYWORD)
 SELECT 0
 IF M_LX = .T.
 M_BLX2 = '0'
 DO SZLX2B
 SELECT STMP
 REPLACE BLX2 WITH (MYWORD1)
 ENDIF 
ENDPROC
*------
PROCEDURE X1
 SEL = 0
 DO FORM .\src\form\bcl7b
 MYWORD = LTRIM(STR(SEL))
 RETURN 
ENDPROC
*------
PROCEDURE x2
 DIMENSION OP( 4 )
 OP( 1 ) = '1.合并表'
 OP( 2 ) = '2.盈余表'
 OP( 3 ) = '3.亏损表'
 OP( 4 ) = '4.联社表'
 @ 8 , 28 MENU OP , 4 , 4 TITLE '类型选择'
 READ MENU TO SEL1
 MYWORD1 = LTRIM(STR(SEL1))
 RETURN 
ENDPROC
*------
PROCEDURE DSBWJ
 CL_NIAN = RIGHT(NIAN,2)
  USE dat\B&M_BH&cl_NIAN&YUE..dat IN 0
  SELE B&M_BH&cl_NIAN&YUE
 INDEX ON XMDH TO TMP
  LOCATE FOR DQDH=&FF .AND. BLX1=STMP->BLX1 AND BLX2=STMP->BLX2	
 IF FOUND()
 MSGTTL = '上报数据'
 MESSGTXT = '此地区数据己存在,是否覆盖?'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 7
 CLOSE DATABASES 
 DELETE File dat\stmp.dat
 DELETE File tmp.IDX
 WJPD = 1
 WAIT CLEAR
 RETURN 
 ELSE 
  DELE FOR DQDH=&FF .AND. BLX1=STMP->BLX1 AND BLX2=STMP->BLX2	
 PACK 
 ENDIF 
 ELSE 
 MSGTTL = '上报数据'
 MESSGTXT = '是否读入上报数据?'
 IF MESSAGEBOX(MESSGTXT,36,MSGTTL) = 7
 CLOSE DATABASES 
 DELETE File dat\stmp.dat
 DELETE File tmp.IDX
 WAIT CLEAR
 WJPD = 1
 RETURN 
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE SZLX2A
 M_LXM = '   '
 SELECT 0
 USE lib\blx.dat
 LOCATE FOR BH = M_BH AND DH = VAL(M_BLX2)
 M_LXM = MC
 SELECT BLX
 USE 
 RETURN 
ENDPROC
*------
PROCEDURE SZLX2B
 M_LXM = '   '
 M_BLX2 = '0'
 DO FORM .\src\form\BLX
 MYWORD1 = M_BLX2
 IF USED('blx')
 SELECT BLX
 USE 
 ENDIF 
 RETURN 
ENDPROC
*------*