bcl2.prg

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

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


 SET TALK OFF
 SET CONSOLE OFF
 SET EXACT ON
 SET ESCAPE OFF
 SET SAFETY OFF
 IF 1 = 0
 SET DEFAULT TO \xbbjs
 MMBZ4 = '4'
 NIAN = '1998'
 YUE = '12'
 ENDIF 
 XSLJ = ''
 XSBM = ''
 XSYK = ''
 XSLX = ''
 XSDQ = ''
 CLOSE DATABASES 
 DO WHILE .T.
 SS = '00'
 M_BH = '00'
 DO FORM .\src\form\GONG2
 SS = M_BH
 IF SS = '00'
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 IF SS = '01'
 MSGTTL = '相关表取数'
 MESSGTXT = '此表不能取数'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 QBDQ = 1
 MDQ = 0
 NIAN_Q = RIGHT(NIAN,2)
 YUE_Q = YUE
 M_BLX1 = 0
 MM_BLX2 = 0
 Q_QUIT = .F.
 DO FORM .\src\form\bcl2a
 IF Q_QUIT
 RETURN 
 ENDIF 
 IF TYPE('MM_BLX2') = 'N'
 MM_BLX2 = ALLTRIM(STR(MM_BLX2))
 ENDIF 
 IF TYPE('M_BLX1') = 'N'
 M_BLX1 = ALLTRIM(STR(M_BLX1))
 ENDIF 
 CLOSE DATABASES 
 IF  .NOT. USED('bzl')
 USE IN 0 .\lib\bzl.dat
 ENDIF 
 IF  .NOT. FILE('LIB\FZSH1.DAT') .OR.  .NOT. FILE('LIB\FZSH2.DAT')
 MSGTTL = '相关表取数'
 MESSGTXT = '  复制审核库不存在!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 
 COPY File lib\fzsh1.dat TO lib\fzsh11.dat
 COPY File lib\fzsh2.dat TO lib\fzsh21.dat
 USE IN 0 LIB\FZSH11.DAT ALIAS FZSH1
 USE IN 0 lib\FZSH21.dat ALIAS FZSH2
 WAIT WINDOW NOCLEAR NOWAIT ' 文件检查......'
 IF QBDQ = 3
 STORE 0 TO DYGX , CZBZ1
 DO JCYSJ_H
 IF DYGX = 0
 MSGTTL = '相关表取数'
 MESSGTXT = '复制库中无此表对应关系!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 CLOSE DATABASES 
 WAIT CLEAR
 RETURN 
 ENDIF 
 IF CZBZ1 = 0
 MSGTTL = '相关表取数'
 MESSGTXT = '源数据不存在!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 CLOSE DATABASES 
 WAIT CLEAR
 RETURN 
 ENDIF 
 SCWJ = 0
  IF !FILE("dat\h03&nian_q..dat")	        
  DO WJ1_h WITH "h03&nian_q","03"		
 ENDIF 
  IF !USED("h03&nian_q")
  USE dat\h03&nian_q..dat IN 0
 ENDIF 
 DQPD = 0
  SELE h03&nian_q			
 LOCATE FOR DQDH = VAL(YUE) AND BLX1 = M_BLX1 AND BLX2 = MM_BLX2
 IF EOF()
  DO WJNR1_h WITH "h03&nian_q", "XM03",val(YUE),M_BLX1,MM_BLX2		
 ENDIF 
 SELECT FZSH1
 XGLS = LS
 FOR TT = 1 TO XGLS
 KKW = 'DA' + ALLTRIM(STR(TT))
  if !used("h03&nian_q")
  use dat\h03&nian_q..dat in 0
 ENDIF 
  SELE h03&nian_q
  REPLACE &kkw WITH 0 for dqdh=val(YUE)
 ENDFOR 
 SELECT FZSH1
 SCAN 
 SCATTER TO DAT1 FIELDS XMDH , LS , DW
 LS1 = 'DA' + LTRIM(STR(DAT1(2)))
 WAIT WINDOW NOCLEAR NOWAIT  ;
      '正在从相关表取数据,请稍候...' + CHR(13) + '项目:' + XMDH + CHR(13) + '第 ' +  ;
LTRIM(STR(LS)) + ' 栏'
 DO QS_H
 ENDSCAN 
 WAIT CLEAR
 IF SS = '03'
  SELE h01&nian_q
 LOCATE FOR  ;
      ALLTRIM(XMDH) = '03' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND  ;
DQDH = VAL(YUE)
 NC_CHE = DA1 - DA2
 NM_CHE = DA5 - DA6
  SELE h03&nian_q
 IF NC_CHE > 0
 REPLACE DA1 WITH ABS(NC_CHE) FOR  ;
      XMDH = '06' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND  ;
DQDH = VAL(YUE)
 ELSE 
 REPLACE DA1 WITH ABS(NC_CHE) FOR  ;
      XMDH = '46' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND  ;
DQDH = VAL(YUE)
 ENDIF 
 IF NM_CHE > 0
 REPLACE DA2 WITH ABS(NM_CHE) FOR  ;
      XMDH = '06' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND  ;
DQDH = VAL(YUE)
 ELSE 
 REPLACE DA2 WITH ABS(NM_CHE) FOR  ;
      XMDH = '46' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND  ;
DQDH = VAL(YUE)
 ENDIF 
 ENDIF 
 CLOSE DATABASES 
 IF SCWJ = 1
 DELETE File tmp.tmp
 DELETE File t001.tmp
 ENDIF 
 WAIT CLEAR
 DO DPCL_H
 DO DPCL_H
 MSGTTL = '相关表取数'
 MESSGTXT = ' 相关取数完成 !!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ELSE 
 STORE 0 TO DYGX , CZBZ1
 DO JCYSJ
 IF DYGX = 0
 MSGTTL = '相关表取数'
 MESSGTXT = '复制库中无此表对应关系!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 CLOSE DATABASES 
 WAIT CLEAR
 RETURN 
 ENDIF 
 IF CZBZ1 = 0
 MSGTTL = '相关表取数'
 MESSGTXT = '源数据不存在!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 CLOSE DATABASES 
 WAIT CLEAR
 RETURN 
 ENDIF 
 SCWJ = 0
  IF !FILE("dat\B&SS&nian_q&yue_q..dat")	        
  DO WJ1 WITH "B&SS&nian_q&yue_q","&SS"		
 ENDIF 
  IF !USED("B&SS&nian_q&yue_q")
  USE dat\B&SS&nian_q&yue_q..dat IN 0
 ENDIF 
 IF QBDQ = 1
 USE IN 0 LIB\DQK.DAT
 SELECT DQK
 SCAN FOR KHBZ = .T.
 DQ = DQDH
 DQPD = 0
  SELE B&SS&nian_q&yue_q			
 LOCATE FOR DQDH = DQ AND BLX1 = M_BLX1 AND BLX2 = MM_BLX2
 IF EOF()
  DO WJNR1 WITH "B&SS&nian_q&yue_q", "XM&SS",DQ,M_BLX1,MM_BLX2		
 ENDIF 
 SELECT FZSH1
 XGLS = LS
 FOR TT = 1 TO XGLS
 KKW = 'DA' + ALLTRIM(STR(TT))
  SELE B&SS&nian_q&yue_q
  REPLACE &kkw WITH 0 for dqdh=dq
 ENDFOR 
 SELECT FZSH1
 SCAN 
 SCATTER TO DAT1 FIELDS XMDH , LS , DW
 LS1 = 'DA' + LTRIM(STR(DAT1(2)))
 WAIT WINDOW NOCLEAR NOWAIT  ;
      '正在从相关表取数据,请稍候...' + CHR(13) + LTRIM(STR(DQ)) + ' 地区' + CHR(13) +  ;
'项目:' + XMDH + CHR(13) + '第 ' + LTRIM(STR(LS)) + ' 栏'
 DO QS
 ENDSCAN 
 WAIT CLEAR
 IF SS = '03'
  SELE B01&nian_q&yue_q
 LOCATE FOR  ;
      ALLTRIM(XMDH) = '03' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND  ;
DQDH = DQ
 NC_CHE = DA1 - DA2
 NM_CHE = DA5 - DA6
  SELE B03&nian_q&yue_q
 IF NC_CHE > 0
 REPLACE DA1 WITH ABS(NC_CHE) FOR  ;
      XMDH = '06' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ELSE 
 REPLACE DA1 WITH ABS(NC_CHE) FOR  ;
      XMDH = '46' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ENDIF 
 IF NM_CHE > 0
 REPLACE DA2 WITH ABS(NM_CHE) FOR  ;
      XMDH = '06' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ELSE 
 REPLACE DA2 WITH ABS(NM_CHE) FOR  ;
      XMDH = '46' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ENDIF 
 ENDIF 
 ENDSCAN 
 ELSE 
 DQ = MDQ
 DQPD = 0
  SELE B&SS&nian_q&yue_q			
 LOCATE FOR DQDH = DQ AND BLX1 = M_BLX1 AND BLX2 = MM_BLX2
 IF EOF()
  DO WJNR1 WITH "B&SS&nian_q&yue_q", "XM&SS",DQ,M_BLX1,MM_BLX2		
 ENDIF 
 SELECT FZSH1
 XGLS = LS
 FOR TT = 1 TO XGLS
 KKW = 'DA' + ALLTRIM(STR(TT))
  SELE B&SS&nian_q&yue_q
  REPLACE &kkw WITH 0 for dqdh=dq
 ENDFOR 
 SELECT FZSH1
 SCAN 
 SCATTER TO DAT1 FIELDS XMDH , LS , DW
 LS1 = 'DA' + LTRIM(STR(DAT1(2)))
 WAIT WINDOW NOCLEAR NOWAIT  ;
      '正在从相关表取数据,请稍候...' + CHR(13) + LTRIM(STR(DQ)) + ' 地区' + CHR(13) +  ;
'项目:' + XMDH + CHR(13) + '第 ' + LTRIM(STR(LS)) + ' 栏'
 DO QS
 ENDSCAN 
 WAIT CLEAR
 IF SS = '03'
  SELE B01&nian_q&yue_q
 LOCATE FOR  ;
      ALLTRIM(XMDH) = '03' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND  ;
DQDH = DQ
 NC_CHE = DA1 - DA2
 NM_CHE = DA5 - DA6
  SELE B03&nian_q&yue_q
 IF NC_CHE > 0
 REPLACE DA1 WITH ABS(NC_CHE) FOR  ;
      XMDH = '06' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ELSE 
 REPLACE DA1 WITH ABS(NC_CHE) FOR  ;
      XMDH = '46' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ENDIF 
 IF NM_CHE > 0
 REPLACE DA2 WITH ABS(NM_CHE) FOR  ;
      XMDH = '06' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ELSE 
 REPLACE DA2 WITH ABS(NM_CHE) FOR  ;
      XMDH = '46' AND ALLTRIM(BLX2) = '0' AND ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ENDIF 
 ENDIF 
 ENDIF 
 CLOSE DATABASES 
 IF SCWJ = 1
 DELETE File tmp.tmp
 DELETE File t001.tmp
 ENDIF 
 WAIT CLEAR
 MSGTTL = '相关表取数'
 MESSGTXT = ' 相关取数完成 !!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 

PROCEDURE QS
 SELECT FZSH2
 STORE 0 TO S , DW1 , D2
 SCAN FOR XH = FZSH1.XH
 D2 = 0
 BH_Q = BH
 XMDH_Q = XMDH
 FH_Q = FH
 DW_Q = DW
 LS2 = 'DA' + LTRIM(STR(LS))
 Y_SS = BH
 SELECT BZL
 LOCATE FOR BH = Y_SS
 IF  .NOT. LX
 YM_BLX2 = '0'
 ELSE 
 IF MM_BLX2 = '0'
 YM_BLX2 = '1'
 ELSE 
 YM_BLX2 = MM_BLX2
 ENDIF 
 ENDIF 
  SELE B&Y_ss&nian_q&yue_q        
 RECCB = RECNO()
 LOCATE FOR  ;
      ALLTRIM(XMDH) = ALLTRIM(XMDH_Q) AND ALLTRIM(BLX2) = ALLTRIM(YM_BLX2) AND  ;
ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 IF  .NOT. FOUND()