pdztjs.prg

来自「一个非常好用的财务软件源程序」· PRG 代码 · 共 174 行

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


 CLOSE DATABASES ALL
 ON ERROR do pxz
 USE tmp2
 COUNT FOR  .NOT. EMPTY(FNAME) TO BZTS
 GO TOP
 BNIAN = SUBSTR(BNY,1,4)
 BYUE = IIF(SUBSTR(BNY,5,1) = '0',SUBSTR(BNY,6,1),SUBSTR(BNY,5,2))
 BYUE1 = ALLTRIM(STR(VAL(BYUE) - 1,2))
 CREATE TABLE ksj1 ( FBSH C ( 16 ) , FJER N ( 13 , 2 ) , FJEC N ( 13 , 2 ) , FYE N ( 13 ,  ;
      2 ) , FBNJER N ( 13 , 2 ) , FBNJEC N ( 13 , 2 ) , FYCYE N ( 13 , 2 ) ,  ;
      FNCYE N ( 13 , 2 ) )
 FOR KK = 1 TO BZTS
    SELECT TMP2
    BPATH = BSJWZ + '\C' + ALLTRIM(SUBSTR(FNAME,51,3))
     set path to &bpath
    BZC = 'kzc' + BNIAN
    SELECT 0
     use &bzc alia kzc
    SELECT * FROM kzc INTO TABLE tmp1
    ALTER TABLE tmp1 ADD COLUMN FPZH C ( 10 )
    ALTER TABLE tmp1 ADD COLUMN FSJBM C ( 10 )
    ALTER TABLE tmp1 ADD COLUMN FJC N ( 2 )
    SELECT KZC
    USE 
    IF BWJZ = 1 AND BYEAR = BSYSYEAR AND BMONTH = BSYSMON
       SELECT TMP1
       INDEX ON FBSH TO tmp1
       SELECT FBSH , FCR , FJE FROM kcr WHERE  ;
            FDJH IN(SELECT FDJH FROM kdj WHERE SUBSTR(FDJH,2,6) = BKJQJ AND FJK <> 'G') INTO TABLE tmp3
       SCAN 
          BBSH = FBSH
          BJE = IIF(FCR = 'R',FJE,-FJE)
          BJER = IIF(FCR = 'R',FJE,0)
          BJEC = IIF(FCR = 'C',FJE,0)
          BNAME = 'fjeye' + BYUE
          BNAME1 = 'fjer' + BYUE
          BNAME2 = 'fjec' + BYUE
          SELECT TMP1
          SEEK BBSH
          IF FOUND()
              repl &bname with &bname+bje,&bname1 with &bname1+bjer,&bname2 with &bname2+bjec
          ELSE 
              inse into tmp1 (fbsh,&bname,&bname1,&bname2) value (bbsh,bje,bjer,bjec)
          ENDIF 
          SELECT TMP3
       ENDSCAN 
       SELECT TMP3
       USE 
       SELECT KCR
       USE 
       SELECT KDJ
       USE 
    ENDIF 
    USE kpz
    SET FILTER TO
    SCAN FOR FBZ = 'H'
       BBSH = FBSH
       INSERT INTO tmp1 ( FBSH ) VALUES ( BBSH )
    ENDSCAN 
    SET ORDER TO fbsh
    SELECT TMP1
    SET RELATION TO FBSH INTO KPZ
    REPLACE FPZH WITH KPZ.FPZH , FSJBM WITH KPZ.FSJBM , FJC WITH (KPZ.FJC)
    SET RELATION TO
    SELECT KPZ
    USE 
    SELECT TMP1
    INDEX ON FPZH TO tmp1
    GO BOTTOM
    DO WHILE  .NOT. BOF()
       BREC = RECNO()
       IF  .NOT. EMPTY(FSJBM)
          SCATTER TO BSJ1
          BSJBM = FSJBM
          SEEK BSJBM
          IF  .NOT. EOF()
             SCATTER TO BSJ2
             BJC0 = FJC
             FOR J = 1 TO ALEN(BSJ2)
                IF TYPE('bsj2(j)') = 'N'
                   BSJ2( J ) = BSJ2(J) + BSJ1(J)
                ENDIF 
             ENDFOR 
             REPLACE FROM ARRAY BSJ2
             REPLACE FJC WITH BJC0
          ENDIF 
       ENDIF 
       GO BREC
       SKIP -1
    ENDDO 
    SCAN 
       BBSH = FPZH
       BNAME = 'fjeye' + BYUE
        bjeye=&bname
       BNAME = 'fjer' + BYUE
        bbyjer=&bname
       BNAME = 'fjec' + BYUE
        bbyjec=&bname
       BNAME = 'fjeye' + BYUE1
        bycye=iif(byue="1",fncjeye,&bname)
       BBNJER = 0
       BBNJEC = 0
       FOR I = 1 TO VAL(BYUE)
          BNAME = 'fjer' + ALLTRIM(STR(I,2))
           bbnjer=bbnjer+&bname
          BNAME = 'fjec' + ALLTRIM(STR(I,2))
           bbnjec=bbnjec+&bname
       ENDFOR 
       INSERT INTO ksj1 ( FBSH , FJER , FJEC , FYE , FBNJER , FBNJEC , FYCYE , FNCYE ) VALUES  ;
            ( BBSH , BBYJER , BBYJEC , BJEYE , BBNJER , BBNJEC , BYCYE ,  ;
            TMP1.FNCJEYE )
    ENDSCAN 
    SELECT TMP1
    USE 
    SELECT TMP2
    SKIP 
 ENDFOR 
 SELECT TMP2
 USE 
  set path to &bsjwz1
 SELECT FBSH , SUM(FJER) AS FJER , SUM(FJEC) AS FJEC , SUM(FYE) AS FYE , SUM(FBNJER) AS  ;
      FBNJER , SUM(FBNJEC) AS FBNJEC , SUM(FYCYE) AS FYCYE , SUM(FNCYE) AS  ;
      FNCYE FROM ksj1 GROUP BY FBSH INTO TABLE ksj
 SELECT KSJ1
 USE 
 SELECT KSJ
 INDEX ON FBSH TAG FBSH
 = PUSE('kbb')
 = PUSE('kcell')
 SET ORDER TO fbh
 GO TOP
 BBH = 'XX'
 SCAN 
    IF SUBSTR(FBH,1,2) <> BBH
       BBH = SUBSTR(FBH,1,2)
       SELECT KBB
       LOCATE FOR FBH = BBH
       BSX = ALLTRIM(FSX)
       SELECT KCELL
    ENDIF 
    BLH = VAL(SUBSTR(FBH,6,3))
    IF SUBSTR(BSX,BLH,1) = 'N' AND VAL(SUBSTR(FBH,3,3)) <> 0
       BGS = ALLTRIM(FGS)
       IF  .NOT. EMPTY(BGS)
          SELECT KSJ
           bjg=&bgs
          SELECT KCELL
          REPLACE FSZ WITH BJG
       ENDIF 
    ENDIF 
 ENDSCAN 
 SELECT KCELL
 USE 
 SELECT KBB
 USE 
 SELECT KSJ
 USE 
 ON ERROR do perror with error(),message()
 RETURN 

PROCEDURE pxz
 IF USED('kcell')
    SELECT KCELL
    REPLACE FGS WITH ''
 ENDIF 
 RETURN 
ENDPROC
*------*