bcl88.prg

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

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


 SET TALK OFF
 SET EXACT ON
 SET SAFETY OFF
 YSYML = '.'
 XSYML = '.'
 M_BH = ''
 XNIAN = RIGHT(NIAN,2)
 STORE 0 TO M_BLXA1 , M_BLXA2
 STORE 0 TO M_BLXB1 , M_BLXB2
 STORE 0 TO M_LS1 , M_LS2 , M_LS
 STORE .F. TO FHBZ , FHBZ1 , MDPD
 STORE '  ' TO NIAN1 , YUE1 , NIAN2 , YUE2 , SS , NIAN_S
 STORE 0 TO M_XH , M_BZNIAN , N_NIAN1 , N_NIAN2
 DO WHILE .T.
 STORE .F. TO FHBZ , FHBZ1
 DO YBBSZ
 DO YQTSZ
 IF  .NOT. FHBZ
 DO MRQSZ
 ENDIF 
 IF  .NOT. FHBZ
 DO MBLX1SZ
 ENDIF 
 IF  .NOT. FHBZ
 DO MLSSZ
 ENDIF 
 IF  .NOT. FHBZ
 YN = MESSAGEBOX('请确认(y/n)',4,'提示信息')
 IF YN = 6
 DO FXBCL
 ENDIF 
 ENDIF 
 IF FHBZ1 AND FHBZ
 EXIT 
 ENDIF 
 ENDDO 
 RETURN 

PROCEDURE ybbsz
 SS = '00'
 M_BH = ''
  SET DEFA TO &xsyml
  USE &ysyml.\lib\bzl.dat
  DO FORM &xsyml.\src\form\GONG2   
 SS = M_BH
 SS1 = SS
  USE &ysyml.\lib\bzl.dat
 LOCATE FOR BH = SS
 M_LS = LS
 IF SS = '00'
 STORE .T. TO FHBZ , FHBZ1
 ENDIF 
 IF SS = '99'
 = MESSAGEBOX('此表不能生成分析表!',0,'提示信息')
 STORE .T. TO FHBZ , FHBZ1
 ENDIF 
 SELECT BZL
 USE 
ENDPROC
*------
PROCEDURE yqtsz
 DO WHILE .T.
 IF  .NOT. FHBZ
 DO YRQSZ
 ENDIF 
 IF  .NOT. FHBZ
 DO YBLX1SZ
 ENDIF 
 IF  .NOT. FHBZ
 DO YLSSZ
 ENDIF 
 IF  .NOT. FHBZ
 DO YBLX2SZ
 ENDIF 
 IF FHBZ1 = .T. .OR. FHBZ = .T.
 EXIT 
 ENDIF 
 ENDDO 
ENDPROC
*------
PROCEDURE yrqsz
 MDPD = .F.
 DO WHILE .T.
 STORE XNIAN TO NIAN1 , NIANF , NIANFF
 STORE YUE TO YUE1 , YUEF , YUEFF
  DO FORM &xsyml.\src\form\yrqsz
 NIAN1 = RIGHT(NIANF,2)
 YUE1 = YUEF
 IF NIAN1 = '  ' .OR. YUE1 = '  '
 FHBZ = .T.
 EXIT 
 ENDIF 
 IF YUE1 <> '00' AND NIAN1 <> '  ' AND YUE1 <> '  '
 EXIT 
 ENDIF 
 ENDDO 
ENDPROC
*------
PROCEDURE yblx1sz
 IF YUE1 = '03' .OR. YUE1 = '06' .OR. YUE1 = '09' .OR. YUE1 = '12'
 M_BGLX = 1
  DO FORM &xsyml.\src\form\yblx1sz WITH yue1  
 M_BLXA1 = M_BGLX
 ELSE 
 M_BLXA1 = 1
 ENDIF 
 IF M_BLXA1 = 0
 FHBZ = .T.
 ELSE 
  IF FILE("&ysyml.\dat\B&SS&NIAN1&YUE1..dat")
  USE &ysyml.\dat\b&SS&nian1&yue1..dat 
 LOCATE FOR BLX1 = LTRIM(STR(M_BLXA1))
 IF  .NOT. FOUND()
 FHBZ = .T.
 = MESSAGEBOX('报表类型错误',0,'提示信息')
 USE 
 ENDIF 
 USE 
 ELSE 
 FHBZ = .T.
 = MESSAGEBOX('源数据不存在',0,'提示信息')
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE ylssz
 IF M_LS > 1
 M_LS1 = 0
 LSXZ = M_LS1
  DO FORM &xsyml.\src\form\ylssz  
 M_LS1 = LSXZ
 IF M_LS1 = 0
 FHBZ = .T.
 ENDIF 
 ELSE 
 M_LS1 = 1
 ENDIF 
ENDPROC
*------
PROCEDURE yblx2sz
  USE &ysyml.\lib\BZL.dat
  LOCATE FOR BH="&SS"
 IF LX
  DO FORM &xsyml.\src\form\yblx2sz
 IF M_BLXA2 = 0
 FHBZ = .T.
 ELSE 
 FHBZ1 = .T.
 ENDIF 
 ELSE 
 FHBZ1 = .T.
 ENDIF 
 USE 
ENDPROC
*------
PROCEDURE mrqsz
 FHBZ1 = .F.
 MDPD = .T.
 DO WHILE .T.
 STORE LEFT(NIAN,2) + NIAN1 TO NIAN2 , NIANF , NIANFF
 STORE 1 TO YUEF , YUEFF
  DO FORM &xsyml.\src\form\yrqsz 
 NIAN2 = RIGHT(NIANF,2)
 YUE2 = YUEF
 IF VAL(NIAN2) = 0 .OR. VAL(YUE2) = 0
 FHBZ = .T.
 EXIT 
 ENDIF 
 IF VAL(NIAN1) > 50
 N_NIAN1 = VAL('19' + NIAN1)
 ELSE 
 N_NIAN1 = VAL('20' + NIAN1)
 ENDIF 
 IF VAL(NIAN2) > 50
 N_NIAN2 = VAL('19' + NIAN2)
 ELSE 
 N_NIAN2 = VAL('20' + NIAN2)
 ENDIF 
 IF (N_NIAN2 < N_NIAN1) .OR. (N_NIAN2 = N_NIAN1 AND VAL(YUE2) <= VAL(YUE1))
 EXIT 
 ELSE 
 = MESSAGEBOX('目的表年月必须在于源表年月前',0,'提示信息')
 ENDIF 
 ENDDO 
ENDPROC
*------
PROCEDURE mblx1sz
 IF YUE2 = '03' .OR. YUE2 = '06' .OR. YUE2 = '09' .OR. YUE2 = '12'
 M_BGLX = 1
  DO FORM &xsyml.\src\form\yblx1sz WITH yue2  
 M_BLXB1 = M_BGLX
 ELSE 
 M_BLXB1 = 1
 ENDIF 
 IF M_BLXB1 = 0
 FHBZ = .T.
 ENDIF 
ENDPROC
*------
PROCEDURE mlssz
 PUBLIC LSXZ
 IF M_LS > 1
 M_LS2 = 0
 LSXZ = M_LS2
  DO FORM &xsyml.\src\form\ylssz 
 M_LS2 = LSXZ
 IF M_LS2 = 0
 FHBZ = .T.
 ENDIF 
 ELSE 
 M_LS2 = 1
 ENDIF 
ENDPROC
*------
PROCEDURE fxbcl
 WAIT WINDOW NOCLEAR NOWAIT '正在生成分析报表,请稍候……'
 STORE .F. TO SJZT , SJZT1 , SJZT2 , SJZT3
 YUE_S = '  '
 DO WJDK
 SELECT 9
 SCAN FOR KHBZ = .T.
 SELECT 6
 SCAN 
 SELECT 2
  SCAN FOR xmdh==xm&ss->xmdh and blx1=ALLT(STR(m_blxa1)) and blx2=ALLT(STR(m_blxa2)) and dqdh=dqk->dqdh    
 SJ = 'da' + ALLTRIM(STR(M_LS1))
 M_DA1 = 0
  m_da1=&sj
 SELECT 1
 GO TOP
  LOCA FOR xmdh==xm&ss->xmdh and blx1==ALLT(STR(m_blxa1)) and blx2==ALLT(STR(m_blxa2)) and dqdh==b&ss&nian1&yue1->dqdh  and ls=m_ls1 and rq==VAL(yue1)  
 IF  .NOT. FOUND()
 APPEND BLANK
 SJ = 'da' + ALLTRIM(STR(M_LS1))
  REPL xmdh WITH xm&ss->xmdh , blx1 WITH ALLT(STR(m_blxa1)),blx2 WITH ALLT(STR(m_blxa2)), dqdh WITH b&ss&nian1&yue1->dqdh,ls WITH m_ls1, rq WITH VAL(yue1)
 ENDIF 
 REPLACE DA1 WITH M_DA1
 STORE 0 TO M_DA2 , M_DA3 , M_DA4 , M_DA5 , M_DA6 , M_DA7
 DO YCSJ
 DO TQSJ
 DO SHQSJ
 SELECT 1
 REPLACE DA2 WITH M_DA2 , DA3 WITH M_DA3 , DA4 WITH M_DA4 , DA5 WITH M_DA5 , DA6 WITH  ;
      M_DA6 , DA7 WITH M_DA7
 ENDSCAN 
 ENDSCAN 
 ENDSCAN 
 DO HZSJ
 WAIT CLEAR
ENDPROC
*------
PROCEDURE wjdk
  IF FILE("&YSYML.\dat\fx&ss&nian1..dat")
 SELECT 1
  USE &ysyml.\dat\fx&ss&nian1..dat
 ZAP 
 ELSE 
  CREA DBF &ysyml.\dat\fx&ss&nian1..dat ( rq n(2) ,dqdh n(2),xmdh c(6), blx1 c(1),blx2 c(1),ls n(1),da1 n(16,2),da2 n(14,2),da3 n(8,2),da4 n(14,2),da5 n(8,2),da6 n(14,2),da7 n(8,2))
 ENDIF 
 SELECT 2
  USE &ysyml.\dat\b&ss&nian1&yue1..dat
 IF NIAN1 <> NIAN2 .OR. YUE1 <> YUE2
  IF FILE("&ysyml.\dat\b&ss&nian2&yue2..dat")
 SJZT1 = .T.
 SELECT 3
  USE &ysyml.\dat\b&ss&nian2&yue2..dat
 ENDIF 
 ENDIF 
 NIAN_S = IIF(NIAN1 = '00','99',ALLTRIM(STR(VAL(NIAN1) - 1)))
  IF FILE("&ysyml.\dat\b&ss&nian_s&yue1..dat")
 SJZT2 = .T.
  IF not USED("&ysyml.\b&ss&nian_s&yue1")
 SELECT 4
  USE &ysyml.\dat\b&ss&nian_s&yue1..dat
 ENDIF 
 ENDIF 
 IF (YUE1 <> '01' AND M_BLXA1 <> 3 AND M_BLXA1 <> 4) .OR. (M_BLXA1 = 4 AND YUE1 = '12')
 DO CASE 
 CASE M_BLXA1 = 1
 YUE_S = ALLTRIM(STR(VAL(YUE1) - 1))
 CASE M_BLXA1 = 2
 YUE_S = ALLTRIM(STR(VAL(YUE1) - 3))
 CASE M_BLXA1 = 4
 IF YEU1 = '12'
 YUE_S = '6'
 ENDIF 
 ENDCASE 
 IF VAL(YUE1) < 10
 YUE_S = '0' + YUE_S
 ENDIF 
  IF FILE("&ysyml.\dat\b&ss&nian1&yue_s..dat")
 SJZT3 = .T.
  IF not USED("&ysyml.\b&ss&nian1&yue_s")
 SELECT 5
  USE &ysyml.\dat\b&ss&nian1&yue_s..dat
 ENDIF 
 ENDIF 
 ENDIF 
 SELECT 6
  USE &ysyml.\lib\xm&ss..dat
  IF FILE("&ysyml.\fxlib\zb&ss..dat") and FILE("&ysyml.\fxlib\zb&ss.a.dat")
 SJZT = .T.
 SELECT 7
  USE &ysyml.\fxlib\zb&ss..dat
 SELECT 8
  USE &ysyml.\fxlib\zb&ss.a.dat
 ENDIF 
 SELECT 9
  USE &ysyml.\lib\dqk.dat
ENDPROC
*------
PROCEDURE ycsj
 IF SJZT1
 SJZT4 = .F.
 IF SJZT AND VAL(NIAN2) < VAL(NIAN1)
 DO ZHCX
 ENDIF 
 SELECT 3
 GO TOP
 M_DAT = 0
 IF SJZT4
 SELECT 8
 SCAN FOR XH = M_XH
 SELECT 3
  LOCA FOR xmdh==zb&ss.a->xmdh and blx1=ALLT(STR(m_blxb1)) and blx2=ALLT(STR(m_blxa2)) and dqdh==dqk->dqdh  
 SJ = 'da' + ALLTRIM(STR(M_LS2))
  m_dat=M_dat + &sj
 ENDSCAN 
 ELSE 
  LOCA FOR xmdh==xm&ss->xmdh and blx1=ALLT(STR(m_blxb1)) and blx2=ALLT(STR(m_blxa2)) and dqdh==dqk->dqdh  
 SJ = 'da' + ALLTRIM(STR(M_LS2))
  m_dat=&sj
 ENDIF 
 IF M_DAT <> 0
 M_DA2 = M_DA1 - M_DAT
 M_DA3 = ABS((M_DA2 / M_DAT) * 100)
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE tqsj
 IF SJZT2
 SJZT4 = .F.
 IF SJZT
 DO ZHCX
 ENDIF 
  SELE b&ss&nian_s&yue1
 GO TOP
 M_DAT = 0
 IF SJZT4
 SELECT 8
 SCAN FOR XH = M_XH
  SELE b&ss&nian_s&yue1
  LOCA FOR xmdh==zb&ss.a->xmdh and blx1=ALLT(STR(m_blxa1)) and blx2=ALLT(STR(m_blxa2)) and dqdh==dqk->dqdh  
 SJ = 'da' + ALLTRIM(STR(M_LS1))
  m_dat=m_dat + &sj
 ENDSCAN 
 ELSE 
  LOCA FOR xmdh==xm&ss->xmdh and blx1=ALLT(STR(m_blxa1)) and blx2=ALLT(STR(m_blxa2)) and dqdh==dqk->dqdh  
 SJ = 'da' + ALLTRIM(STR(M_LS1))
  m_dat = &sj
 ENDIF 
 IF M_DAT <> 0
 M_DA4 = M_DA1 - M_DAT
 M_DA5 = ABS((M_DA4 / M_DAT) * 100)
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE shqsj
 IF SJZT3
  SELE b&ss&nian1&yue_s
 GO TOP
  LOCA FOR xmdh==xm&ss->xmdh and blx1=ALLT(STR(m_blxa1)) and blx2=ALLT(STR(m_blxa2)) and dqdh==dqk->dqdh  
 SJ = 'da' + ALLTRIM(STR(M_LS1))
  IF &sj # 0
  m_da6=m_da1 - &sj  
  m_da7=ABS((m_da6/&sj) * 100)
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE zhcx
 SELECT 7
 GO TOP
  LOCA FOR rq==ALLT(STR(n_nian1)) and xmdh==xm&ss->xmdh
 IF FOUND()
 M_XH = XH
 M_XMDH = XMDH
 II = 0
 SCAN FOR XH = M_XH AND RQ == ALLTRIM(STR(N_NIAN1))
 II = II + 1
 ENDSCAN 
 IF II = 1
 SJZT4 = .T.
 ENDIF 
 ENDIF 
ENDPROC
*------
PROCEDURE hzsj
  IF FILE("&ysyml.\dat\fxhz&ss&nian1..dat")
 SELECT 0
  USE &ysyml.\dat\fxhz&ss&nian1..dat
 ZAP 
 DELETE FOR  ;
      RQ = VAL(YUE1) AND BLX1 = ALLTRIM(STR(M_BLXA1)) AND BLX2 = ALLTRIM(STR(M_BLXA2)) AND  ;
LS = M_LS1
 PACK 
 ELSE 
  CREA DBF &ysyml.\dat\fxhz&ss&nian1..dat ( rq n(2) ,xmdh c(6), blx1 c(1),blx2 c(1),ls n(1),da1 n(16,2),da2 n(14,2),da3 n(8,2),da4 n(14,2),da5 n(8,2),da6 n(14,2),da7 n(8,2))
 ENDIF 
 SELECT 6
 SCAN 
 SELECT 1
 STORE 0 TO M_DA1 , M_DA2 , M_DA4 , M_DA6
  SUM da1,da2,da4,da6 FOR rq=VAL(yue1) and xmdh==xm&ss->xmdh and blx1=ALLT(STR(m_blxa1)) and blx2=ALLT(STR(m_blxa2)) and ls = m_ls1 TO M_da1,m_da2,m_da4,m_da6
  SELE fxhz&ss&nian1
 APPEND BLANK
  REPL rq WITH VAL(yue1), xmdh WITH xm&ss->xmdh,blx1 WITH ALLT(STR(m_blxa1)), blx2 WITH ALLT(STR(m_blxa2)),ls WITH m_ls1,da1 WITH m_da1,da2 WITH M_da2,da4 WITH m_da4,da6 WITH M_da6
 STORE 0 TO M_DA3 , M_DA5 , M_DA7
 IF (M_DA1 - M_DA2) <> 0
 M_DA3 = ABS((M_DA2 / (M_DA1 - M_DA2)) * 100)
 ENDIF 
 IF (M_DA1 - M_DA4) <> 0
 M_DA5 = ABS((M_DA4 / (M_DA1 - M_DA4)) * 100)
 ENDIF 
 IF (M_DA1 - M_DA6) <> 0
 M_DA7 = ABS((M_DA6 / (M_DA1 - M_DA6)) * 100)
 ENDIF 
 REPLACE DA3 WITH M_DA3 , DA5 WITH M_DA5 , DA7 WITH M_DA7
 ENDSCAN 
ENDPROC
*------*