bcl1.prg

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

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BCL1.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 = ''
 BSCWJ = 0
 M_ABLX1 = 0
 M_ABLX2 = 0
 M_BBLX1 = 0
 M_BBLX2 = 0
 M_LS1 = 0
 M_LS2 = 0
 M_BM = ''
 SS = '00'
 DO WHILE .T.
 DO WHILE .T.
 SS = '00'
 M_BH = ''
 CLOSE DATABASES 
 DO FORM .\src\form\gong2
 SS = M_BH
 SS1 = SS
 IF SS = '00'
 CLOSE DATABASES 
 RETURN 
 ENDIF 
 IF  .NOT. USED('BZL')
 USE .\LIB\BZL.dat
 ENDIF 
 SELECT BZL
 LOCATE FOR BH = M_BH
 LOCATE FOR BH = SS
 IF  .NOT. YZHB
 MSGTTL = '余额转换'
 MESSGTXT = '此表无余额转换功能!!!'
  MESSAGEBOX(MESSGTXT,64,MSGTTL)
 SELECT BZL
 USE 
 ELSE 
 EXIT 
 ENDIF 
 ENDDO 
 USE 
 CAPBZ = 2
 DO WHILE .T.
 DQ1 = 0
 DQ2 = 0
 DO FORM .\src\form\bcl1a
 IF DQ1 = 0 .OR. DQ2 = 0
 RETURN 
 ENDIF 
 IF DQ2 >= DQ1 AND DQ1 <> 0
 EXIT 
 ENDIF 
 ENDDO 
 NIAN1 = '  '
 YUE1 = '  '
 NIAN2 = '  '
 YUE2 = ' '
 L_ISFOR = 1
 DO FORM .\src\form\bcl1b
 IF L_ISFOR = 1
 EXIT 
 ENDIF 
 IF L_ISFOR = 2
 RETURN 
 ENDIF 
 ENDDO 
 M_BZ01 = .F.
 M_BZ02 = .F.
 YUE11 = YUE1
 IF M_BH = '01' AND M_LS1 = 2 AND M_LS2 = 1 AND (NIAN1 <> NIAN2)
 MSGTTL = '转余额'
 MESSGTXT =  ;
      '源数据是否取之' + NIAN1 + '年12月的' + CHR(13) + CHR(13) + '结转科目余额表?'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 6
 M_BZ01 = .T.
 YUE11 = '12'
 SS1 = '98'
 SELECT 0
 CLNIAN1 = RIGHT(NIAN1,2)
  USE dat\b&SS&clnian1&yue1..dat ALIAS B03         
  IF FILE("dat\B&SS1&clNIAN1&YUE11..dat")
 SELECT 0
  USE dat\b&SS1&clnian1&yue11..dat 
 LOCATE FOR BLX1 = LTRIM(STR(M_ABLX1))
 IF EOF()
 USE 
 MSGTTL = '转余额'
 MESSGTXT = '源数据中无此类型数据'
  MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 
 USE 
 ELSE 
 MSGTTL = '转余额'
 MESSGTXT = '源数据不存在'
  MESSAGEBOX(MESSGTXT,64,MSGTTL)
 RETURN 
 ENDIF 
 USE 
 ENDIF 
 ENDIF 
 IF M_BH <> '01' AND NIAN1 <> NIAN2
  if file("lib\zb&m_bh.b.dat")
 SELECT 0
  use lib\zb&m_bh.b.dat alias z01
 IF RECCOUNT() > 0
 MSGTTL = '转余额'
 MESSGTXT = '本表是否调科目结转关系? '
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 6
 M_BZ02 = .T.
 ENDIF 
 ENDIF 
 USE 
 ENDIF 
 ENDIF 
 CLNIAN2 = RIGHT(NIAN2,2)
 CLNIAN1 = RIGHT(NIAN1,2)
  IF !FILE("dat\B&SS&clNIAN2&YUE2..dat")      
 SELECT 0
  USE dat\B&SS&clNIAN1&YUE1..dat ALIAS B01
  COPY STRU TO dat\B&SS&clNIAN2&YUE2..dat     
 USE 
 ENDIF 
 SELECT 0
  USE dat\B&SS&clNIAN2&YUE2..dat ALIAS B02
  IF USED("B&SS1&clNIAN1&YUE11")
  select "B&SS1&clNIAN1&YUE11"
 USE 
 ENDIF 
 SELECT 0
  USE dat\B&SS1&clNIAN1&YUE11..dat ALIAS B01
 FOR I = DQ1 TO DQ2
 SELECT B01
 LOCATE FOR DQDH = I AND VAL(BLX1) = M_ABLX1 AND VAL(BLX2) = M_ABLX2
 IF EOF()
 MSGTTL = '转余额'
 MESSGTXT = '无' + LTRIM(STR(I)) + '地区数据'
 LOOP 
 ENDIF 
 SELECT B02
 LOCATE FOR DQDH = I AND VAL(BLX1) = M_BBLX1 AND VAL(BLX2) = M_BBLX2
 IF EOF()
 WAIT WINDOW NOCLEAR NOWAIT '正在转 ' + LTRIM(STR(I)) + ' 地区数据...'
 DO P3
 WAIT CLEAR
 LOOP 
 ENDIF 
 IF  .NOT. USED('bzl')
 SELECT 0
 USE lib\BZL.dat
 ENDIF 
 SELECT B02
 MSGTTL = '转余额'
 MESSGTXT = LTRIM(STR(I)) + '地区数据己存在,覆盖吗?'
 IF MESSAGEBOX(MESSGTXT,292,MSGTTL) = 6
 BSCWJ = 1
 WAIT WINDOW NOCLEAR NOWAIT '正在转' + LTRIM(STR(I)) + ' 地区数据'
 DO P3
 WAIT CLEAR
 ENDIF 
 ENDFOR 
 MSGTTL = '转余额'
 MESSGTXT = '数据转换完毕'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 SELECT 1
 USE 
 SELECT 2
 USE 
 CLOSE DATABASES 

PROCEDURE P3
 DO CASE 
 CASE SS = '01' .OR. SS = '19' .OR. SS = '20'
 IF M_BZ01 = .T.
 DO Z11
 ELSE 
 DO Z1
 ENDIF 
 OTHERWISE 
 IF M_BZ02 = .T.
 DO Z2
 DO Z22
 ELSE 
 DO Z2
 ENDIF 
 ENDCASE 
ENDPROC
*------
PROCEDURE Z1
 M_BLX2 = '0'
 IF BSCWJ = 0
  DO WJNR WITH "B02","xm&ss",I,"&M_BLX1"
 ENDIF 
 DO CASE 
 CASE M_LS1 = 1 AND M_LS2 = 1
 SELECT B01
 SCAN FOR VAL(BLX1) = M_ABLX1 AND DQDH = I
 SELECT B02
 REPLACE DA1 WITH B01.DA1 , DA2 WITH B01.DA2 , BLX1 WITH LTRIM(STR(M_BBLX1)) , BLX2 WITH  ;
      M_BLX2 FOR DQDH = B01.DQDH AND XMDH = B01.XMDH
 ENDSCAN 
 CASE M_LS1 = 1 AND M_LS2 = 2
 SELECT B01
 SCAN FOR VAL(BLX1) = M_ABLX1 AND DQDH = I
 SELECT B02
 REPLACE DA5 WITH B01.DA1 , DA6 WITH B01.DA2 , BLX1 WITH LTRIM(STR(M_BBLX1)) , BLX2 WITH  ;
      M_BLX2 FOR DQDH = B01.DQDH AND XMDH = B01.XMDH
 ENDSCAN 
 CASE M_LS1 = 2 AND M_LS2 = 1
 SELECT B01
 SCAN FOR VAL(BLX1) = M_ABLX1 AND DQDH = I
 SELECT B02
 REPLACE DA1 WITH B01.DA5 , DA2 WITH B01.DA6 , BLX1 WITH LTRIM(STR(M_BBLX1)) , BLX2 WITH  ;
      M_BLX2 FOR DQDH = B01.DQDH AND XMDH = B01.XMDH
 ENDSCAN 
 CASE M_LS1 = 2 AND M_LS2 = 2
 SELECT B01
 SCAN FOR VAL(BLX1) = M_ABLX1 AND DQDH = I
 SELECT B02
 REPLACE DA5 WITH B01.DA5 , DA6 WITH B01.DA6 , BLX1 WITH LTRIM(STR(M_BBLX1)) , BLX2 WITH  ;
      M_BLX2 FOR DQDH = B01.DQDH AND XMDH = B01.XMDH
 ENDSCAN 
 ENDCASE 
ENDPROC
*------
PROCEDURE Z11
 M_BLX2 = '0'
 IF BSCWJ = 0
  DO WJNR WITH "B02","xm&ss",I,"&M_BLX1"
 ENDIF 
 SELECT B03
 SCAN FOR VAL(BLX1) = M_ABLX1 AND DQDH = I
 SELECT B02
 REPLACE DA1 WITH B03.DA5 , DA2 WITH B03.DA6 , BLX1 WITH LTRIM(STR(M_BBLX1)) , BLX2 WITH  ;
      M_BLX2 FOR DQDH = B03.DQDH AND XMDH = B03.XMDH
 ENDSCAN 
 SELECT B01
 SCAN FOR VAL(BLX1) = M_ABLX1 AND DQDH = I
 SELECT B02
 REPLACE DA1 WITH B01.DA1 , DA2 WITH B01.DA2 , BLX1 WITH LTRIM(STR(M_BBLX1)) , BLX2 WITH  ;
      M_BLX2 FOR DQDH = B01.DQDH AND XMDH = B01.XMDH
 ENDSCAN 
ENDPROC
*------
PROCEDURE Z2
 DO CASE 
 CASE M_LS1 = 1 AND M_LS2 = 1
 SELECT B01
 SCAN FOR DQDH = I AND VAL(BLX1) = M_ABLX1 AND VAL(BLX2) = M_ABLX2
 IF BSCWJ = 0
 SELECT B02
 APPEND BLANK
 REPLACE DQDH WITH B01.DQDH , XMDH WITH B01.XMDH , DA1 WITH B01.DA1 , BLX2 WITH  ;
      ALLTRIM(STR(M_BBLX2)) , BLX1 WITH ALLTRIM(STR(M_BBLX1))
 SELECT B01
 ELSE 
 SELECT B02
 LOCATE FOR DQDH = I AND VAL(BLX1) = M_BBLX1 AND VAL(BLX2) = M_BBLX2
 REPLACE DA1 WITH B01.DA1
 SELECT B01
 ENDIF 
 ENDSCAN 
 CASE M_LS1 = 1 AND M_LS2 = 2
 SELECT B01
 SCAN FOR DQDH = I AND VAL(BLX1) = M_ABLX1 AND VAL(BLX2) = M_ABLX2
 IF BSCWJ = 0
 SELECT B02
 APPEND BLANK
 REPLACE DQDH WITH B01.DQDH , XMDH WITH B01.XMDH , DA2 WITH B01.DA1 , BLX2 WITH  ;
      ALLTRIM(STR(M_BBLX2)) , BLX1 WITH ALLTRIM(STR(M_BBLX1))
 SELECT B01
 ELSE 
 SELECT B02
 LOCATE FOR DQDH = I AND VAL(BLX1) = M_BBLX1 AND VAL(BLX2) = M_BBLX2
 REPLACE DA2 WITH B01.DA1
 SELECT B01
 ENDIF 
 ENDSCAN 
 CASE M_LS1 = 2 AND M_LS2 = 1
 SELECT B01
 SCAN FOR DQDH = I AND VAL(BLX1) = M_ABLX1 AND VAL(BLX2) = M_ABLX2
 IF BSCWJ = 0
 SELECT B02
 APPEND BLANK
 REPLACE DQDH WITH B01.DQDH , XMDH WITH B01.XMDH , DA1 WITH B01.DA2 , BLX2 WITH  ;
      ALLTRIM(STR(M_BBLX2)) , BLX1 WITH ALLTRIM(STR(M_BBLX1))
 SELECT B01
 ELSE 
 SELECT B02
 LOCATE FOR DQDH = I AND VAL(BLX1) = M_BBLX1 AND VAL(BLX2) = M_BBLX2
 REPLACE DA1 WITH B01.DA2
 SELECT B01
 ENDIF 
 ENDSCAN 
 CASE M_LS1 = 2 AND M_LS2 = 2
 SELECT B01
 SCAN FOR DQDH = I AND VAL(BLX1) = M_ABLX1 AND VAL(BLX2) = M_ABLX2
 IF BSCWJ = 0
 SELECT B02
 APPEND BLANK
 REPLACE DQDH WITH B01.DQDH , XMDH WITH B01.XMDH , DA2 WITH B01.DA2 , BLX2 WITH  ;
      ALLTRIM(STR(M_BBLX2)) , BLX1 WITH ALLTRIM(STR(M_BBLX1))
 SELECT B01
 ELSE 
 SELECT B02
 LOCATE FOR DQDH = I AND VAL(BLX1) = M_BBLX1 AND VAL(BLX2) = M_BBLX2
 REPLACE DA2 WITH B01.DA2
 SELECT B01
 ENDIF 
 ENDSCAN 
 ENDCASE 
ENDPROC
*------
PROCEDURE Z22
 SELECT 0
  USE LIB\ZB&M_BH..dat ALIAS ZB01
 SELECT 0
  USE LIB\ZB&M_BH.A.dat ALIAS ZB02
 SELECT ZB01
 SCAN 
 M_XM = XMDH
 M_XH = XH
 M_XMDHA = ''
 M_DA1 = 0
 M_DA2 = 0
 SELECT ZB02
 SCAN FOR XH = M_XH
 M_XMDHA = XMDH
 M_FH = FH
 SELECT B01
 LOCATE FOR DQDH = I AND XMDH = M_XMDHA AND VAL(BLX1) = M_ABLX1 AND VAL(BLX2) = M_ABLX2
 IF M_FH = '+'
 M_DA1 = M_DA1 + DA1
 M_DA2 = M_DA2 + DA2
 ELSE 
 M_DA1 = M_DA1 - DA1
 M_DA2 = M_DA2 - DA2
 ENDIF 
 SELECT ZB02
 ENDSCAN 
 DO CASE 
 CASE M_LS1 = 1 AND M_LS2 = 1
 SELECT B02
 LOCATE FOR  ;
      DQDH = I AND XMDH = M_XM AND BLX2 = ALLTRIM(STR(M_BBLX2)) AND  ;
BLX1 = ALLTRIM(STR(M_BBLX1))
 REPLACE DA1 WITH M_DA1
 CASE M_LS1 = 1 AND M_LS2 = 2
 SELECT B02
 LOCATE FOR  ;
      DQDH = I AND XMDH = M_XM AND BLX2 = ALLTRIM(STR(M_BBLX2)) AND  ;
BLX1 = ALLTRIM(STR(M_BBLX1))
 REPLACE DA2 WITH M_DA1
 CASE M_LS1 = 2 AND M_LS2 = 1
 SELECT B02
 LOCATE FOR  ;
      DQDH = I AND XMDH = M_XM AND BLX2 = ALLTRIM(STR(M_BBLX2)) AND  ;
BLX1 = ALLTRIM(STR(M_BBLX1))
 REPLACE DA1 WITH M_DA2
 CASE M_LS1 = 2 AND M_LS2 = 2
 SELECT B02
 LOCATE FOR  ;
      DQDH = I AND XMDH = M_XM AND BLX2 = ALLTRIM(STR(M_BBLX2)) AND  ;
BLX1 = ALLTRIM(STR(M_BBLX1))
 REPLACE DA2 WITH M_DA2
 ENDCASE 
 SELECT ZB01
 ENDSCAN 
 SELECT ZB01
 USE 
 SELECT ZB02
 USE 
ENDPROC
*------
PROCEDURE wjnr
 PARAMETER BDATNAME , XMKNAME , M_DQDH , M_BLX1
 SELECT (BDATNAME)
 APPEND BLANK
 REPLACE XMDH WITH 'dpbz' , SJDW WITH 0
  APPEND FROM lib\&xmkname..dat FIELDS xmdh,sjdw
 SELECT (BDATNAME)
 REPLACE DQDH WITH M_DQDH , BLX1 WITH LTRIM(STR(M_BBLX1)) , BLX2 WITH M_BLX2 FOR DQDH = 0
 RETURN 
ENDPROC
*------*