zhywsbzh.prg

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

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


 CLOSE ALL
 SET TALK OFF
 SET SAFETY OFF
 SET PROCEDURE TO zhywsbzh
 SET COLOR OF SCHEME 2 TO  GR+/BG,W+/BG,GR/BG,GR/BG,GR+/B,GR+/B
 DEFINE WINDOW ZH FROM 10 , 20 TO 16 , 60 COLOR SCHEME 2 SHADOW DOUBLE
 DEFINE WINDOW WRONG FROM 19 , 15 TO 21 , 65 COLOR SCHEME 2 SHADOW DOUBLE
 XSLJ = ''
 XSBM = ''
 XSYK = ''
 XSLX = ''
 XSDQ = ''
 ACTTC = 1
 DO ACTZHP

PROCEDURE ACTZHP
 YEAR_A = INT(VAL(NIAN))
 MONTH_A = INT(VAL(YUE))
 DO FORM src\form\actrq
 CL_YEAR = RIGHT(YEAR_A,2)
 DO FORM src\form\dqxz
 TT = WEI
 N = AT('.',TT)
 M_DQDH = SUBSTR(TT,1,N - 1)
 IF LEN(ALLTRIM(M_DQDH)) = 1
 M_DQDH = '0' + LTRIM(TRIM(M_DQDH))
 ENDIF 
 PA = ''
 DO FORM src\form\actdrv
 IF ACTTC = 0
 PA = LEFT(PA,1)
  IF ! FILE("&pa.:SB&cl_YEAR&M_DQDH.01.DAT")
  WAIT WINDOW "会计报表数据不存在，请拷入&pa.盘"
 ELSE 
 DO ZHSJ
 ENDIF 
 ENDIF 
 WAIT CLEAR
ENDPROC
*------
PROCEDURE ZHSJ
 SBTMP = 'tmp\sbtmp.dat'
 IF FILE(SBTMP)
 DELETE File (SBTMP)
 ELSE 
 ENDIF 
 CREATE TABLE (SBTMP) ( DQDH C ( 4 ) , BLX1 C ( 4 ) , SBDH C ( 6 ) , XMDH C ( 6 ) , DA1  ;
      N ( 18 , 2 ) , DA2 N ( 18 , 2 ) , DA3 N ( 18 , 2 ) , DA4 N ( 18 , 2 ) ,  ;
      DA5 N ( 18 , 2 ) , DA6 N ( 18 , 2 ) )
 USE 
 USE IN 1 (SBTMP) ALIAS SBTMP_C
 SELECT SBTMP_C
 ZAP 
  APPE FROM &pa.:SB&cl_YEAR&M_DQDH.01.DAT type delimited with character ";"
 M_BLX1 = '0'
 DO FORM src\form\zhywzh1
 DO CASE 
 CASE M_BLX1 = '1'
 M_BLX1_1 = '月'
 CASE M_BLX1 = '2'
 IF MONTH_A = '03'
 M_BLX1_1 = '一'
 ELSE 
 IF MONTH_A = '06'
 M_BLX1_1 = '二'
 ELSE 
 IF MONTH_A = '09'
 M_BLX1_1 = '三'
 ELSE 
 IF MONTH_A = '12'
 M_BLX1_1 = '四'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无季报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ENDIF 
 ENDIF 
 ENDIF 
 CASE M_BLX1 = '4'
 IF MONTH_A = '06'
 M_BLX1_1 = '前'
 ELSE 
 IF MONTH_A = '12'
 M_BLX1_1 = '后'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无半年报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ENDIF 
 CASE M_BLX1 = '3'
 IF MONTH_A = '12'
 M_BLX1_1 = '年'
 ELSE 
  MESSAGEBOX(MONTH_A - '月份无年报,请检查后重新操作!',160,'错误信息提示')
 RETURN 
 ENDIF 
 ENDCASE 
  IF FILE("DAT\B01&cl_YEAR&MONTH_a..DAT") 
  USE DAT\B01&cl_YEAR&MONTH_a..DAT in 2 ALIA B01  excl
 SELECT B01
 LOCATE FOR DQDH = VAL(M_DQDH) AND BLX1 = M_BLX1
 IF FOUND()
 IF MESSAGEBOX('目的数据已存在! 覆盖吗 ? ( Y / N) ',36,'提示') = 7
 USE 
 RETURN 
 ELSE 
 ENDIF 
 ENDIF 
 ELSE 
  do wj with "B01&cl_YEAR&MONTH_a","01"
  USE DAT\B01&cl_YEAR&MONTH_a..DAT in 2 ALIA B01  excl
 ENDIF 
 SELECT SBTMP_C
 GO TOP
 LOCATE FOR XMDH = '1011'
 IF BLX1 = M_BLX1_1
 ELSE 
  MESSAGEBOX(YEAR_A - '年' - MONTH_A - '月份' - M_BLX1_1 -  ;
'报上报数据不存在,转换上报文件失败!!!',320,'信息提示')
 RETURN 
 ENDIF 
 GO TOP
 IF SBDH = MONTH_A AND BLX1 = YEAR_A
 ELSE 
  MESSAGEBOX(YEAR_A - '年' - MONTH_A - '月份上报数据不存在,转换上报文件失败!!!',320,'信息提示')
 RETURN 
 ENDIF 
 LOCATE FOR XMDH = '1000'
 IF BLX1 = '月'
 BLX1_C = '1'
 BLX1_LB = BLX1
 ELSE 
 IF BLX1 = '一' .OR. BLX1 = '二' .OR. BLX1 = '三' .OR. BLX1 = '四'
 BLX1_C = '2'
 BLX1_LB = BLX1
 ELSE 
 IF BLX1 = '前' .OR. BLX1 = '后'
 BLX1_LB = BLX1
 BLX1_C = '4'
 ELSE 
 IF BLX1 = '年'
 BLX1_C = '3'
 BLX1_LB = BLX1
 ELSE 
  MESSAGEBOX('上报数据类型错误,#' - BLX1 - '#,转换上报文件失败!!!',320,'错误信息提示')
 RETURN 
 ENDIF 
 ENDIF 
 ENDIF 
 ENDIF 
 IF SUBSTR(SBDH,2,2) = M_DQDH
 ELSE 
  MESSAGEBOX(YEAR_A - '年' - MONTH_A - '月份不存在' - M_DQDH - '数据,转换上报文件中断!!!',320,'错误信息提示')
 RETURN 
 ENDIF 
 USE IN 3 LIB\XM01.DAT ALIAS XM01
 USE IN 4 LIB\DQK.DAT ALIAS DQK
 SELECT DQK
 CLEAR 
 LOCATE FOR DQDH = VAL(M_DQDH)
 IF FOUND()
 SELECT B01
 DELETE FOR DQDH = VAL(M_DQDH) AND BLX1 = BLX1_C
 PACK 
 ELSE 
 ENDIF 
 JLS = RECCOUNT() + 1
 APPEND BLANK
 REPLACE DQDH WITH VAL(M_DQDH) , BLX1 WITH BLX1_C , BLX2 WITH '0'
 REPLACE XMDH WITH 'dpbz'
 REPLACE SJDW WITH 1
 SELECT XM01
 DO WHILE  .NOT. EOF()
 XMDH_C = XMDH
 SELECT B01
 APPEND BLANK
 REPLACE DQDH WITH VAL(M_DQDH) , XMDH WITH XMDH_C , BLX1 WITH BLX1_C , BLX2 WITH '0' ,  ;
      SJDW WITH 3
 SELECT XM01
 IF  .NOT. EOF()
 SKIP 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 SELECT SBTMP_C
 SCAN FOR XMDH = '99'
 REPLACE DA1 WITH MAX(DA1,DA2) , DA2 WITH 0 , DA3 WITH 0 , DA4 WITH 0 , DA5 WITH  ;
      MAX(DA5,DA6) , DA6 WITH 0
 ENDSCAN 
 DA1_9971 = 0
 DA5_9971 = 0
 DA1_9973 = 0
 DA5_9973 = 0
 DA1_9978 = 0
 DA5_9978 = 0
 SELECT SBTMP_C
 GO TOP
 LOCATE FOR XMDH = '9971'
 DA1_9971 = DA1
 DA5_9971 = DA5
 LOCATE FOR XMDH = '9972'
 IF FOUND()
 IF DA1_9971 <= DA1 AND DA5_9971 <= DA5
 REPLACE DA1 WITH DA1 - DA1_9971 , DA5 WITH DA5 - DA5_9971
 ELSE 
 ENDIF 
 ELSE 
 ENDIF 
 LOCATE FOR XMDH = '9973'
 DA1_9973 = DA1
 DA5_9973 = DA5
 LOCATE FOR XMDH = '9974'
 IF FOUND()
 IF DA1_9973 <= DA1 AND DA5_9973 <= DA5
 REPLACE DA1 WITH DA1 - DA1_9973 , DA5 WITH DA5 - DA5_9973
 ELSE 
 ENDIF 
 ELSE 
 ENDIF 
 LOCATE FOR XMDH = '9978'
 DA1_9978 = DA1
 DA5_9978 = DA5
 LOCATE FOR XMDH = '9979'
 IF FOUND()
 IF DA1_9978 <= DA1 AND DA5_9978 <= DA5
 REPLACE DA1 WITH DA1 - DA1_9978 , DA5 WITH DA5 - DA5_9978
 ELSE 
 ENDIF 
 ELSE 
 ENDIF 
 GO TOP
 SCAN FOR SUBSTR(SBDH,2,2) = M_DQDH AND BLX1 = BLX1_LB
 WAIT WINDOW NOCLEAR NOWAIT  ;
      '正在转换 ' + ALLTRIM(XMDH) + ' 科目  ' + BLX1_LB + '表数据'
 SELECT B01
 LOCATE FOR XMDH = SBTMP_C.XMDH AND DQDH = VAL(M_DQDH) AND BLX1 = BLX1_C
 REPLACE DA1 WITH SBTMP_C.DA1 , DA2 WITH SBTMP_C.DA2 , DA3 WITH SBTMP_C.DA3 , DA4 WITH  ;
      SBTMP_C.DA4 , DA5 WITH SBTMP_C.DA5 , DA6 WITH SBTMP_C.DA6
 SELECT SBTMP_C
 ENDSCAN 
  MESSAGEBOX(MONTH_A - '月份' - M_DQDH - '地区读入业务状况表完毕！',64,'完成信息提示')
 CLOSE DATABASES 
ENDPROC
*------*