pjs.prg

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

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


 ON ERROR do pxz
 CREATE TABLE ksj ( FBSH C ( 16 ) , FJER N ( 13 , 2 ) , FJEC N ( 13 , 2 ) , FYE N ( 13 ,  ;
      2 ) , FBNJER N ( 13 , 2 ) , FBNJEC N ( 13 , 2 ) , FBJJER N ( 13 , 2 ) ,  ;
      FBJJEC N ( 13 , 2 ) , FYCYE N ( 13 , 2 ) , FNCYE N ( 13 , 2 ) )
 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))
 DO CASE 
 CASE VAL(BYUE) <= 3 AND VAL(BYUE) >= 1
    BSTART = 1
    BEND = 3
 CASE VAL(BYUE) <= 6 AND VAL(BYUE) >= 4
    BSTART = 4
    BEND = 6
 CASE VAL(BYUE) <= 9 AND VAL(BYUE) >= 7
    BSTART = 7
    BEND = 9
 CASE VAL(BYUE) <= 12 AND VAL(BYUE) >= 10
    BSTART = 10
    BEND = 12
 ENDCASE 
 BZC = 'kzc' + BNIAN
 SELECT 0
  use &bzc alia kzc excl
 IF FSIZE('fjeye1') <> 13
    FOR Z = 1 TO 12
       BHH1 = 'fjeye' + ALLTRIM(STR(Z,2))
       BHH2 = 'fjec' + ALLTRIM(STR(Z,2))
       BHH3 = 'fjer' + ALLTRIM(STR(Z,2))
        alte tabl kzc alte colu &bhh1 n(13,2)
        alte tabl kzc alte colu &bhh2 n(13,2)
        alte tabl kzc alte colu &bhh3 n(13,2)
       ALTER TABLE kzc ALTER COLUMN FNCJEYE N ( 13 , 2 )
    ENDFOR 
 ENDIF 
 IF FSIZE('fslye1') <> 12
    FOR Z = 1 TO 12
       BHH1 = 'fslye' + ALLTRIM(STR(Z,2))
       BHH2 = 'fslc' + ALLTRIM(STR(Z,2))
       BHH3 = 'fslr' + ALLTRIM(STR(Z,2))
        alte tabl kzc alte colu &bhh1 n(12,4)
        alte tabl kzc alte colu &bhh2 n(12,4)
        alte tabl kzc alte colu &bhh3 n(12,4)
       ALTER TABLE kzc ALTER COLUMN FNCSLYE N ( 12 , 4 )
    ENDFOR 
 ENDIF 
 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 tmp2
    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 TMP2
    ENDSCAN 
    SELECT TMP2
    USE 
    SELECT KCR
    USE 
    SELECT KDJ
    USE 
 ENDIF 
 = PUSE('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
    BBJJER = 0
    BBJJEC = 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 
    FOR I = BSTART TO BEND
       BNAME = 'fjer' + ALLTRIM(STR(I,2))
        bbjjer=bbjjer+&bname
       BNAME = 'fjec' + ALLTRIM(STR(I,2))
        bbjjec=bbjjec+&bname
    ENDFOR 
    INSERT INTO ksj ( FBSH , FJER , FJEC , FYE , FBNJER , FBNJEC , FBJJER , FBJJEC , FYCYE ,  ;
         FNCYE ) VALUES ( BBSH , BBYJER , BBYJEC , BJEYE , BBNJER , BBNJEC ,  ;
         BBJJER , BBJJEC , BYCYE , TMP1.FNCJEYE )
 ENDSCAN 
 SELECT TMP1
 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( ), MESSAGE(1), PROGRAM( ), LINENO( )
 RETURN 

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