bcl92.prg

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

* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: BCL92.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 ESCAPE OFF
 SET SAFETY OFF
 CLOSE DATABASES 
 CL_NIAN = RIGHT(NIAN,2)
 DO CL92
 CLOSE DATABASES 
 RETURN 

PROCEDURE CL92
 STORE 0 TO M_DQDH , M_DA1 , JL1
 STORE ' ' TO M_BLX1 , M_BLX2 , M_BLX21 , M_BLX22 , M_LS
 STORE 0 TO M_DQDH1 , M_DQDH2 , SZ1 , SZ2 , M_DQDH
 SZ1 = 0
 DO FORM .\src\form\bcl92b
 IF SZ1 = 0
 RETURN 
 ENDIF 
 USE LIB\BZL.DAT
 M_BH = '00'
 M_LS = 0
 DO FORM .\src\form\bcl92a
 IF M_BH = '00'
 RETURN 
 ENDIF 
 M_BLX1 = 0
 SZ2 = 0
 DO FORM .\src\form\bcl92c
 IF M_BLX1 = 0 .OR. SZ2 = 0
 RETURN 
 ENDIF 
 M_BLX1 = ALLTRIM(STR(M_BLX1))
 DO CASE 
 CASE SZ2 = 4
 DO DQLR
 CASE SZ2 = 1
 CASE SZ2 = 2
 CASE SZ2 = 3
 ENDCASE 
 FHBZ = 0
 IF SZ2 = 4
 USE IN 0 LIB\DQK.DAT
 FOR L = M_DQDH1 TO M_DQDH2
 M_DQDH1 = L
 SELECT DQK
 LOCATE FOR DQDH = M_DQDH1 AND KHBZ = .T.
 IF EOF()
 EXIT 
 ENDIF 
 IF  .NOT. FOUND()
 LOOP 
 ENDIF 
  DATNAME="B&M_BH&cl_NIAN&YUE"
 DO WJPD
 IF FHBZ = 1
 RETURN 
 ENDIF 
 DO HBJS
 MSGTTL = ' 盈亏合并'
 MESSGTXT = '数据处理完成!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 ENDFOR 
 ELSE 
  DATNAME="H&M_BH&cl_NIAN"
 DO WJPD
 IF FHBZ = 1
 RETURN 
 ENDIF 
 DO HBJS
 MSGTTL = ' 盈亏合并'
 MESSGTXT = '数据处理完成!!!'
 = MESSAGEBOX(MESSGTXT,64,MSGTTL)
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE WJPD
 FHBZ = 0
  AA="DAT\&DATNAME..DAT"
 IF  .NOT. FILE(AA)
 MSGTTL = ''
 MESSGTXT = '无本月数据'
 = MESSAGEBOX(MESSGTXT,48,MSGTTL)
 FHBZ = 1
 RETURN 
 ENDIF 
 IF  .NOT. USED(DATNAME)
  USE &AA IN 0
 ENDIF 
ENDPROC
*------
PROCEDURE HBJS
 MDSJ = 0
 DO YSJPD
 IF FHBZ = 1
 RETURN 
 ENDIF 
 DO MSJPD
  IF !USED("XM&M_BH")
  USE LIB\XM&M_BH..DAT IN 0
 ENDIF 
 IF  .NOT. USED('BLK')
 USE IN 0 LIB\BLK.DAT
 ENDIF 
  SELE XM&M_BH
 JL1 = 0
 WAIT WINDOW NOCLEAR NOWAIT '正在生成  '
 SCAN 
 IF SZ2 = 4
 WAIT WINDOW NOWAIT LTRIM(STR(M_DQDH1)) + '地区' + ALLTRIM(XMDH) + '项目'
 ELSE 
 WAIT WINDOW NOWAIT ALLTRIM(XMDH) + '项目'
 ENDIF 
 M_XMDH = XMDH
 DO CASE 
 CASE SZ1 = 1 AND (SZ2 = 1 .OR. SZ2 = 2 .OR. SZ2 = 3)
 JJBZ = '+'
 DO HDATJS
 CASE SZ1 = 1 AND SZ2 = 4
 JJBZ = '+'
 DO DATJS
 CASE (SZ1 = 2 .OR. SZ1 = 3) AND (SZ2 = 1 .OR. SZ2 = 2 .OR. SZ2 = 3)
 JJBZ = '-'
 DO HDATJS
 CASE (SZ1 = 2 .OR. SZ1 = 3) AND SZ2 = 4
 JJBZ = '-'
 DO DATJS
 ENDCASE 
 ENDSCAN 
 RETURN 
ENDPROC
*------
PROCEDURE DATJS
 STORE 0 TO SJCZ1 , SJCZ2
 SELECT (DATNAME)
 SCAN FOR DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX21 AND XMDH = M_XMDH
 SCATTER MEMVAR 
 SCATTER TO MDAT
 SJCZ1 = 1
 ENDSCAN 
 SCAN FOR DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX22 AND XMDH = M_XMDH
 IF SJCZ1 = 0
 SCATTER MEMVAR 
 ENDIF 
 SCATTER TO MDAT
 SJCZ2 = 1
 ENDSCAN 
 FOR I = 1 TO M_LS
 DALS = LTRIM(STR(I))
 IF SJCZ1 = 0
  STOR 0 TO M.DA&DALS
 ENDIF 
 IF SJCZ2 = 0
 STORE 0 TO MDAT( I + 5 )
 ENDIF 
  IF FSIZE("DA&DALS")<25
  m.DA&DALS=ROUND(M.DA&DALS&JJBZ.MDAT(I+5),2)
 ENDIF 
 ENDFOR 
 M.BLX2 = M_BLX2
 IF MDSJ = 1
 SCAN FOR DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND XMDH = M_XMDH
 GATHER MEMVAR 
 ENDSCAN 
 ELSE 
 GO BOTTOM
 APPEND BLANK
 IF JL1 = 0
 REPLACE DQDH WITH M_DQDH , BLX1 WITH M_BLX1 , BLX2 WITH M_BLX2 , XMDH WITH 'dpbz' , SJDW  ;
      WITH 1
 JL1 = 1
 GO BOTTOM
 APPEND BLANK
 GATHER MEMVAR 
 ELSE 
 GATHER MEMVAR 
 ENDIF 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE HDATJS
 STORE 0 TO SJCZ1 , SJCZ2
 SELECT (DATNAME)
 SCAN FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX21 AND DA1 = M_DA1 AND XMDH = 'dpbz'
 LOCATE FOR DQDH = M_DQDH AND XMDH = M_XMDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX21
 SCATTER MEMVAR 
 SCATTER TO MDAT
 SJCZ1 = 1
 ENDSCAN 
 SCAN FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX22 AND DA1 = M_DA1 AND XMDH = 'dpbz'
 LOCATE FOR DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX22 AND XMDH = M_XMDH
 IF SJCZ1 = 0
 SCATTER MEMVAR 
 ENDIF 
 SCATTER TO MDAT
 SJCZ2 = 1
 ENDSCAN 
 FOR I = 1 TO M_LS
 DALS = LTRIM(STR(I))
 IF SJCZ1 = 0
  STOR 0 TO M.DA&DALS
 ENDIF 
 IF SJCZ2 = 0
 STORE 0 TO MDAT( I + 5 )
 ENDIF 
  if type('M.DA&DALS')='N' or type('M.DA&DALS')='n'
  m.DA&DALS=ROUND(M.DA&DALS&JJBZ.MDAT(I+5),2)
 ENDIF 
 ENDFOR 
 M.BLX2 = M_BLX2
 IF MDSJ = 1
 SCAN FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND DA1 = M_DA1 AND XMDH = 'dpbz'
 LOCATE FOR DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2 AND XMDH = M_XMDH
 IF  .NOT. EOF()
 GATHER MEMVAR 
 ENDIF 
 ENDSCAN 
 ELSE 
 GO BOTTOM
 APPEND BLANK
 IF JL1 = 0
 REPLACE DQDH WITH M_DQDH , BLX1 WITH M_BLX1 , BLX2 WITH M_BLX2 , XMDH WITH 'dpbz' , SJDW  ;
      WITH 1
 JL1 = 1
 GO BOTTOM
 APPEND BLANK
 GATHER MEMVAR 
 ELSE 
 GATHER MEMVAR 
 ENDIF 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE YSJPD
 FHBZ = 0
 SELECT (DATNAME)
 DO CASE 
 CASE (SZ2 = 1 .OR. SZ2 = 4) AND SZ1 = 1
 IF SZ2 = 1
 M_DQDH = VAL(YUE)
 ELSE 
 M_DQDH = M_DQDH1
 ENDIF 
 M_DA1 = 0
 M_BLX21 = '2'
 M_BLX22 = '3'
 CASE (SZ2 = 1 .OR. SZ2 = 4) AND SZ1 = 2
 IF SZ2 = 1
 M_DQDH = VAL(YUE)
 ELSE 
 M_DQDH = M_DQDH1
 ENDIF 
 M_DA1 = 0
 M_BLX21 = '1'
 M_BLX22 = '2'
 CASE (SZ2 = 1 .OR. SZ2 = 4) AND SZ1 = 3
 IF SZ2 = 1
 M_DQDH = VAL(YUE)
 ELSE 
 M_DQDH = M_DQDH1
 ENDIF 
 M_DA1 = 0
 M_BLX21 = '1'
 M_BLX22 = '3'
 CASE SZ2 = 2 AND SZ1 = 1
 M_DQDH = VAL(YUE)
 M_DA1 = 1
 M_BLX21 = '2'
 M_BLX22 = '3'
 CASE SZ2 = 2 AND SZ1 = 2
 M_DQDH = VAL(YUE)
 M_DA1 = 1
 M_BLX21 = '1'
 M_BLX22 = '2'
 CASE SZ2 = 2 AND SZ1 = 3
 M_DQDH = VAL(YUE)
 M_DA1 = 1
 M_BLX21 = '1'
 M_BLX22 = '3'
 CASE SZ2 = 3 AND SZ1 = 1
 M_DQDH = VAL(YUE)
 M_DA1 = 2
 M_BLX21 = '2'
 M_BLX22 = '3'
 CASE SZ2 = 3 AND SZ1 = 2
 M_DQDH = VAL(YUE)
 M_DA1 = 2
 M_BLX21 = '1'
 M_BLX22 = '2'
 CASE SZ2 = 3 AND SZ1 = 3
 M_DQDH = VAL(YUE)
 M_DA1 = 2
 M_BLX21 = '1'
 M_BLX22 = '3'
 ENDCASE 
 LOCATE FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND DA1 = M_DA1 AND  ;
(BLX2 = M_BLX21 .OR. BLX2 = M_BLX22) AND XMDH = 'dpbz'
 IF  .NOT. FOUND()
 DO DISP1
 ELSE 
 SCAN FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND DA1 = M_DA1 AND BLX2 = M_BLX21 AND XMDH = 'dpbz'
 DO DISP2
 ENDSCAN 
 ENDIF 
ENDPROC
*------
PROCEDURE MSJPD
 SELECT (DATNAME)
 DO CASE 
 CASE (SZ2 = 1 .OR. SZ2 = 4) AND SZ1 = 1
 IF SZ2 = 1
 M_DQDH = VAL(YUE)
 ELSE 
 M_DQDH = M_DQDH1
 ENDIF 
 M_DA1 = 0
 M_BLX2 = '1'
 CASE (SZ2 = 1 .OR. SZ2 = 4) AND SZ1 = 2
 IF SZ2 = 1
 M_DQDH = VAL(YUE)
 ELSE 
 M_DQDH = M_DQDH1
 ENDIF 
 M_DA1 = 0
 M_BLX2 = '3'
 CASE (SZ2 = 1 .OR. SZ2 = 4) AND SZ1 = 3
 IF SZ2 = 1
 M_DQDH = VAL(YUE)
 ELSE 
 M_DQDH = M_DQDH1
 ENDIF 
 M_DA1 = 0
 M_BLX2 = '2'
 CASE SZ2 = 2 AND SZ1 = 1
 M_DQDH = VAL(YUE)
 M_DA1 = 1
 M_BLX2 = '1'
 CASE SZ2 = 2 AND SZ1 = 2
 M_DQDH = VAL(YUE)
 M_DA1 = 1
 M_BLX2 = '3'
 CASE SZ2 = 2 AND SZ1 = 3
 M_DQDH = VAL(YUE)
 M_DA1 = 1
 M_BLX2 = '2'
 CASE SZ2 = 3 AND SZ1 = 1
 M_DQDH = VAL(YUE)
 M_DA1 = 2
 M_BLX21 = '1'
 CASE SZ2 = 3 AND SZ1 = 2
 M_DQDH = VAL(YUE)
 M_DA1 = 2
 M_BLX2 = '3'
 CASE SZ2 = 3 AND SZ1 = 3
 M_DQDH = VAL(YUE)
 M_DA1 = 2
 M_BLX2 = '2'
 ENDCASE 
 LOCATE FOR  ;
      DQDH = M_DQDH AND BLX1 = M_BLX1 AND DA1 = M_DA1 AND BLX2 = M_BLX2 AND XMDH = 'dpbz'
 IF FOUND()
 MDSJ = 1
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE DQLR
 CAPBZ = 1
 DO WHILE .T.
 STORE 0 TO M_DQDH1 , M_DQDH2
 DQ1 = 0
 DQ2 = 0
 DO FORM .\src\form\bcl1a
 M_DQDH1 = DQ1
 M_DQDH2 = DQ2
 IF DQ1 = 0 .OR. DQ2 = 0
 RETURN 
 ENDIF 
 IF DQ2 >= DQ1 AND DQ1 <> 0
 EXIT 
 ENDIF 
 ENDDO 
ENDPROC
*------
PROCEDURE DISP1
 DO CASE 
 CASE SZ2 = 4
 WAIT WINDOW ALLTRIM(STR(M_DQDH1)) + '地区数据不存在'
 CASE SZ2 = 1
 WAIT WINDOW '全部地区汇总数据不存在'
 CASE SZ2 = 2
 WAIT WINDOW '单列地区汇总数据不存在'
 CASE SZ2 = 3
 WAIT WINDOW '非单列地区汇总数据不存在'
 ENDCASE 
 FHBZ = 1
ENDPROC
*------
PROCEDURE DISP2
 IF SJDW = 0
 DO CASE 
 CASE SZ2 = 4
 WAIT WINDOW LTRIM(STR(M_DQDH1)) + ' 地区数据不平'
 CASE SZ2 = 1
 WAIT WINDOW '全部地区汇总数据不平'
 CASE SZ2 = 2
 WAIT WINDOW '单列地区汇总数据不平'
 CASE SZ2 = 3
 WAIT WINDOW '非单列地区汇总数据不平'
 ENDCASE 
 FHBZ = 1
 ENDIF 
ENDPROC
*------*