bcl2.prg

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

 GO TOP
 LOCATE FOR DQDH = DQ
 IF  .NOT. FOUND()
 EXIT 
 ENDIF 
 LOCATE FOR  ;
      ALLTRIM(XMDH) = ALLTRIM(XMDH_Q) AND ALLTRIM(BLX2) = ALLTRIM(YM_BLX2) AND  ;
ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = DQ
 ENDIF 
 DW1 = DAT1(3) - DW_Q
  D2=ROUND(&ls2/10^DW1,2)
  S=round(S&fh_q.D2,2)
 ENDSCAN 
  SELE B&SS&nian_q&yue_q			
 RECCC = RECNO()
 LOCATE REST FOR DQDH = DQ AND BLX1 = M_BLX1 AND BLX2 = MM_BLX2 AND XMDH = DAT1(1)
 IF EOF()
  use dat\B&SS&nian_q&yue_q..dat
 LOCATE NEXT RECCC FOR DQDH = DQ AND BLX1 = M_BLX1 AND BLX2 = MM_BLX2 AND XMDH = DAT1(1)
 ENDIF 
  REPLACE &LS1 WITH S
 RETURN 
ENDPROC
*------
PROCEDURE wjnr1
 PARAMETER BDATNAME , XMKNAME , M_DQDH , M_BLX1 , M_BLX2
 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 M_BLX1 , BLX2 WITH M_BLX2 FOR DQDH = 0
 RETURN 
ENDPROC
*------
PROCEDURE WJ1
 PARAMETER DATNAME , M_BH
 SELECT 0
 USE lib\BLK.dat
 COPY TO t001.tmp STRUCTURE EXTENDED 
 SELECT 0
 USE t001.tmp
 ZAP 
 SELECT FIELD_NAME , FIELD_TYPE , FIELD_LEN , FIELD_DEC WHERE BH = (M_BH) INTO TABLE  ;
      tmp.tmp FROM blk
 SELECT T001
 APPEND FROM tmp.tmp
 USE 
 RENAME T001.TMP TO T001.DBF
  CREATE dat\&datname FROM t001
 USE 
 RENAME T001.DBF TO T001.TMP
  RENAME DAT\&DATNAME..DBF TO DAT\&DATNAME..DAT
 SELECT BLK
 USE 
 DELETE File T001.FPT
 DELETE File T001.TMP
 SCWJ = 1
 RETURN 
ENDPROC
*------
PROCEDURE JCYSJ
 SELECT FZSH1
  dele for bh!="&ss".or. fzbz=.f.
 SCAN 
 DYGX = 1
 SELECT FZSH2
 SCAN FOR XH = FZSH1.XH
 Y_SS = BH
  IF !FILE("dat\B&Y_SS&nian_q&yue_q..dat")	   
 SELECT FZSH1
 DELETE 
 LOOP 
 ENDIF 
  if !used("B&Y_SS&nian_q&yue_q")
  use dat\B&Y_SS&nian_q&yue_q..dat in 0
 ENDIF 
 CZBZ1 = 1
 ENDSCAN 
 ENDSCAN 
 PACK 
ENDPROC
*------
PROCEDURE QS_h
 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 h01&nian_q        
 RECCB = RECNO()
 LOCATE FOR  ;
      ALLTRIM(XMDH) = ALLTRIM(XMDH_Q) AND ALLTRIM(BLX2) = ALLTRIM(YM_BLX2) AND  ;
ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = VAL(YUE)
 IF  .NOT. FOUND()
 GO TOP
 LOCATE FOR  ;
      ALLTRIM(XMDH) = ALLTRIM(XMDH_Q) AND ALLTRIM(BLX2) = ALLTRIM(YM_BLX2) AND  ;
ALLTRIM(BLX1) = ALLTRIM(M_BLX1) AND DQDH = VAL(YUE)
 ENDIF 
 DW1 = DAT1(3) - DW_Q
  D2=ROUND(&ls2/10^DW1,2)
  S=round(S&fh_q.D2,2)
 ENDSCAN 
  SELE h03&nian_q			
 LOCATE FOR DQDH = VAL(YUE) AND BLX1 = M_BLX1 AND BLX2 = '0' AND XMDH = DAT1(1)
  REPLACE &LS1 WITH S
 RETURN 
ENDPROC
*------
PROCEDURE wjnr1_h
 PARAMETER BDATNAME , XMKNAME , M_DQDH , M_BLX1 , M_BLX2
  if !used("&bdatname")
  use dat\&bdatname..dat in 0
 ENDIF 
 SELECT (BDATNAME)
 APPEND BLANK
 REPLACE XMDH WITH 'dpbz' , SJDW WITH 0
  APPEND FROM LIB\&xmkname..DAT FIELDS xmdh,sjdw
 SELECT (BDATNAME)
 REPLACE DQDH WITH VAL(YUE) , BLX1 WITH M_BLX1 , BLX2 WITH M_BLX2 , SJDW WITH 0 FOR  ;
      DQDH = 0
 RETURN 
ENDPROC
*------
PROCEDURE WJ1_h
 PARAMETER DATNAME , M_BH
 SELECT 0
 USE lib\BLK.dat
 COPY TO t001.tmp STRUCTURE EXTENDED 
 SELECT 0
 USE t001.tmp
 ZAP 
 SELECT FIELD_NAME , FIELD_TYPE , FIELD_LEN , FIELD_DEC WHERE BH = (M_BH) INTO TABLE  ;
      tmp.tmp FROM blk
 SELECT T001
 APPEND FROM tmp.tmp
 USE 
 RENAME T001.TMP TO T001.DBF
  CREATE dat\&datname FROM t001
 USE 
 RENAME T001.DBF TO T001.TMP
  RENAME DAT\&DATNAME..DBF TO DAT\&DATNAME..DAT
 SELECT BLK
 USE 
 DELETE File T001.FPT
 DELETE File T001.TMP
 SCWJ = 1
 RETURN 
ENDPROC
*------
PROCEDURE JCYSJ_H
 SELECT FZSH1
  dele for bh!="&ss".or. fzbz=.f.
 SCAN 
 DYGX = 1
 SELECT FZSH2
 SCAN FOR XH = FZSH1.XH
 Y_SS = BH
  IF !FILE("dat\h01&nian_q..dat")	   
 SELECT FZSH1
 DELETE 
 LOOP 
 ENDIF 
  if !used("h01&nian_q")
  use dat\h01&nian_q..dat in 0
 ENDIF 
 CZBZ1 = 1
 ENDSCAN 
 ENDSCAN 
 PACK 
ENDPROC
*------
PROCEDURE DPCL_H
 CLOSE DATABASES 
 M_LS = 2
 M_BH = '03'
 M_BLX2 = '0'
 M_DQDH = VAL(YUE)
 PCL_NIAN = RIGHT(NIAN,2)
 BDATNAME = 'H03' + PCL_NIAN
 XMKNAME = 'XM' + M_BH
  USE LIB\DP&M_BH..DAT IN 0
  USE LIB\DP&M_BH.A.DAT IN 0
  if !used("h03&pcl_nian")
  use dat\h03&pcl_nian..dat in 0
 ENDIF 
 DIMENSION HJXDA1( M_LS )
 DIMENSION QZXHJ( M_LS )
 STORE 1 TO LIN
 STORE 0 TO COL
 M_DPBZ = 1
 DPGSXH = ''
 SELECT (BDATNAME)
 COPY TO DPTMP FOR DQDH = M_DQDH
 SELECT 0
 USE DPTMP
 INDEX ON XMDH TO DPTMP
  SELE DP&M_BH 
 SCAN 
  STORE DP&M_BH->FH TO DSFH                  
 HJXMDH = '  '
 STORE 0 TO HJXDA1
 DO DPLJS
  SELE DP&M_BH.A
  COPY TO DPGSR FOR XH=DP&M_BH->XH
 SELECT 0
 USE DPGSR
 STORE 0 TO QZXHJ
 DO DPRJS
 FOR I = 1 TO M_LS
  IF DP&M_BH->LS#0 AND DP&M_BH->LS # I
 LOOP 
 ENDIF 
 SELECT DPTMP
 IF FSIZE('DA' + LTRIM(STR(I))) > 6 AND UPPER(TYPE('DA' + LTRIM(STR(I)))) = 'N' AND  ;
(MMBZ3 = .T. .OR. HJXDA1(I) = 0)
 DO HJJS
 ELSE 
  IF FSIZE("DA"+LTRI(STR(I))) > 6  AND UPPE(TYPE("DA"+LTRI(STR(I))))="N" AND HJXDA1(I)!&DSFH.QZXHJ(I)
 CHASHU = ROUND(HJXDA1(I) - QZXHJ(I),2)
 IF HJXDA1(I) > QZXHJ(I)
 STORE '多' TO DUOSHAO
 ELSE 
 STORE '少' TO DUOSHAO
 ENDIF 
 ?? CHR(7)
 IF LIN > 13
 LIN = 1
 ENDIF 
 LIN = LIN + 1
 M_DPBZ = 0
 ENDIF 
 ENDIF 
 ENDFOR 
 SELECT DPGSR
 USE 
 ENDSCAN 
 SELECT (BDATNAME)
 REPLACE SJDW WITH M_DPBZ FOR  ;
      XMDH = 'dpbz' AND DQDH = M_DQDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 ?? CHR(7)
 ?? CHR(7)
 IF M_DPBZ = 1
 ELSE 
 ENDIF 
  SELE DP&M_BH
 USE 
  SELE DP&M_BH.A
 USE 
 SELECT DPTMP
 USE 
 RETURN 
ENDPROC
*------
PROCEDURE DPLJS
 SELECT DPTMP
  SEEK DP&M_BH->XMDH
  SCAN FOR XMDH=DP&M_BH->XMDH AND BLX1=M_BLX1 AND BLX2=M_BLX2
 STORE XMDH TO HJXMDH
  store str(dp&m_bh->xh,5) to dpgsxh       
 SCATTER MEMVAR 
 FOR I = 1 TO M_LS
  IF DP&M_BH->LS # 0 AND DP&M_BH->LS # I
 LOOP 
 ENDIF 
 IF FSIZE('DA' + LTRIM(STR(I))) > 6 AND UPPER(TYPE('DA' + LTRIM(STR(I)))) = 'N'
 AA = 'M.DA' + LTRIM(STR(I))
  HJXDA1(I)=&AA
 ENDIF 
 ENDFOR 
 EXIT 
 ENDSCAN 
ENDPROC
*------
PROCEDURE DPRJS
 SCAN 
 SELECT DPTMP
 SEEK DPGSR.XMDH
 SCAN FOR XMDH = DPGSR.XMDH AND BLX1 = M_BLX1 AND BLX2 = M_BLX2
 SCATTER MEMVAR 
 FOR I = 1 TO M_LS
  IF DP&M_BH->LS # 0 AND DP&M_BH->LS # I
 LOOP 
 ENDIF 
 IF FSIZE('DA' + LTRIM(STR(I))) > 6 AND UPPER(TYPE('DA' + LTRIM(STR(I)))) = 'N'
 DO CASE 
 CASE DPGSR.FH = '+'
 AA = 'M.DA' + LTRIM(STR(I))
  QZXHJ(I)=ROUND(QZXHJ(I)+&AA,2) 
 CASE DPGSR.FH = '-'
 AA = 'M.DA' + LTRIM(STR(I))
  QZXHJ(I)=ROUND(QZXHJ(I)-&AA,2)
 ENDCASE 
 ENDIF 
 ENDFOR 
 EXIT 
 ENDSCAN 
 ENDSCAN 
 RETURN 
ENDPROC
*------
PROCEDURE HJJS
 SELECT (BDATNAME)
 DATX = 'DA' + LTRIM(STR(I))
  REPL (DATX) WITH QZXHJ(I)  FOR XMDH=DP&M_BH->XMDH  AND  DQDH=M_DQDH AND  BLX1=M_BLX1  AND  BLX2=M_BLX2
 SELECT DPTMP
  REPL (DATX) WITH QZXHJ(I)  FOR XMDH=DP&M_BH->XMDH  AND  DQDH=M_DQDH AND  BLX1=M_BLX1  AND  BLX2=M_BLX2
 RETURN 
ENDPROC
*------*