home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 6 / 06.iso / b / b015 / 7.ddi / SJ.PRG < prev    next >
Encoding:
Text File  |  1980-01-13  |  2.7 KB  |  117 lines
  1. *****************
  2. *SJ.PRG,B_4     *
  3. *HZ1_J,HZ1_JB   *
  4. *THKM1,THKM1_B  *
  5. *****************
  6.    clear all
  7.    set talk off
  8.    set safe off
  9.    set stat off
  10.    set scor off
  11.    use thkm1
  12.    copy to ss stru extended
  13.    copy to thkm1_b
  14.    use ss
  15.    go top
  16.    dele all for TRIM(field_name)='bzz'
  17.    pack
  18.    appe blan
  19.    go bott
  20.    repl field_name with'bzz',field_type with'c',field_len with 001
  21.    use thkm1
  22.    zap
  23.    crea thkm1 from ss
  24.    use thkm1
  25.    appe from thkm1_b
  26.    USE THKM1 
  27.    INDEX ON VVKM TO THKM1
  28.    USE THKM1 INDEX THKM1
  29.    GO TOP
  30.    PB='N'
  31.    SET COLOR TO /B
  32.    CLEAR
  33.    set color to w/b,W/R
  34.    do while !EOF()
  35.       svvkm=vvkm
  36.       skkm=kkm
  37.       @5,5 say svvkm
  38.       @7,5 say skkm
  39.       @9,5 SAY '╩╟╖±╬¬└┤╘┤└α(y/n)' GET PB
  40.       READ
  41.          PB=UPPER(PB)
  42.          PB=TRIM(PB)
  43.          PB=LTRIM(PB)
  44.          DO CASE  
  45.             CASE PB='Y'
  46.             REPL BZZ WITH '1' 
  47.             SKIP
  48.             DO WHILE !EOF()
  49.                      IF SVVKM=VVKM
  50.                         REPL BZZ WITH '1'
  51.                         SKIP
  52.                      ELSE
  53.                         EXIT
  54.                      ENDI
  55.           ENDDO
  56.             CASE PB='N'
  57.                  REPL BZZ WITH '0'
  58.                  SKIP
  59.             DO WHILE !EOF()
  60.                IF SVVKM=VVKM
  61.                    REPL BZZ WITH '0'
  62.                    SKIP
  63.                   ELSE
  64.                  EXIT
  65.                  ENDI
  66.            ENDDO
  67.        ENDCASE       
  68.        ENDDO    
  69.       INDEX ON VVKM TO THKM1
  70.       use hz1_j
  71.       COPY TO hz1_jb
  72.       COPY TO S1 STRU EXTE
  73.       use s1
  74.       dele all for TRIM(field_name)='bzz'
  75.       pack
  76.       appe blan
  77.       GO BOTT
  78.       repl field_name with'bzz' ,field_type with'c',field_len with 001
  79.       USE HZ1_J
  80.       ZAP
  81.       crea hz1_j from s1
  82.       use hz1_j
  83.       appe from hz1_jb
  84.       SELE 1
  85.       USE HZ1_J
  86.       INDEX ON VVKM TO HZ1_J
  87.       SELE 2
  88.       USE  THKM1
  89.       SELE 1
  90.       USE HZ1_J INDEX HZ1_J  
  91.       SVVK=' '
  92.       SVVK=LTRIM(KkM)
  93.       SVVK=TRIM(KKM)
  94.       DO while !eof(1)
  95.                DO WHILE !EOF(2)
  96.                          SELE 2
  97.                           IF SVVK=TRIM(KKM)
  98.                              SSs=' '
  99.                              SSs=TRIM(BZZ)
  100.                              SELE 1
  101.                              SSs=LTRIM(SSs)
  102.                              REPL BZZ WITH SSs
  103.                              EXIT
  104.                              ELSE
  105.                              SELE 2
  106.                              SKIP
  107.                              ENDIF
  108.                ENDDO      
  109.       SELE 2
  110.       GO TOP
  111.       SELE 1
  112.       SKIP
  113.              SVVK=TRIM(KKM)
  114.              SVVK=LTRIM(KKM)
  115.      ENDDO
  116.      RETU      ì
  117.