************
* PCEDCALC *
************
USE &calcdat INDEX &calcdat
FIND &cur:prod
*
* Van recordvariabelen naar geheugenvariabelen
*
STORE $(werk:tek,1,15) TO wrk:lev
STORE $(werk:tek,17,8) TO wrk:opd
STORE VAL($(werk:tek,26,10)) TO wrk:kst
*
STORE $(zetwerk,1,15) TO ztw:lev
STORE $(zetwerk,17,8) TO ztw:opd
STORE VAL($(zetwerk,26,10)) TO ztw:kst
*
STORE $(lithos,1,15) TO lth:lev
STORE $(lithos,17,8) TO lth:opd
STORE VAL($(lithos,26,10)) TO lth:kst
*
STORE $(fotos,1,15) TO fot:lev
STORE $(fotos,17,8) TO fot:opd
STORE VAL($(fotos,26,10)) TO fot:kst
*
STORE $(drukker,1,15) TO drk:lev
STORE $(drukker,17,8) TO drk:opd
STORE VAL($(drukker,26,10)) TO drk:kst
*
STORE $(papier,1,15) TO pap:lev
STORE $(papier,17,8) TO pap:opd
STORE VAL($(papier,26,10)) TO pap:kst
*
STORE $(nabewerk,1,15) TO nab:lev
STORE $(nabewerk,17,8) TO nab:opd
STORE VAL($(nabewerk,26,10)) TO nab:kst
*
STORE $(afwerk,1,15) TO afw:lev
STORE $(afwerk,17,8) TO afw:opd
STORE VAL($(afwerk,26,10)) TO afw:kst
*
STORE $(bijzond,1,15) TO bijz:lev
STORE $(bijzond,17,8) TO bijz:opd
STORE VAL($(bijzond,26,10)) TO bijz:kst
ERASE
STORE "." TO akk
DO WHILE .NOT. (akk $ "jJ")
   STORE "." TO akk
   @  1,10 SAY "--READER'S DIGEST PRODUCTION ADMINISTRATION CONTROL SYSTEM--"
   @  2,10 SAY "------------------ WIJZIGEN KOSTENGEGEVENS -----------------"
   @  4, 0 SAY "PRODUKTIENUMMER"
   @  4,16 SAY $(prod:nr,1,2) + "/" + $(prod:nr,3,5)
   @  6,22 SAY "---LEVERANCIER---"
   @  6,42 SAY "-OPDRACHT-"
   @  6,55 SAY "---KOSTEN---"
   @  7, 6 SAY "WERKTEKENING"
   @  7,22 GET wrk:lev PICTURE "XXXXXXXXXXXXXXX"
   @  7,42 GET wrk:opd PICTURE "##/##/##"
   @  7,55 GET wrk:kst PICTURE "#######.##"
   @  8,11 SAY "ZETWERK"
   @  8,22 GET ztw:lev PICTURE "XXXXXXXXXXXXXXX"
   @  8,42 GET ztw:opd PICTURE "##/##/##"
   @  8,55 GET ztw:kst PICTURE "#######.##"
   @ 10,11 SAY "LITHO'S"
   @ 10,22 GET lth:lev PICTURE "XXXXXXXXXXXXXXX"
   @ 10,42 GET lth:opd PICTURE "##/##/##"
   @ 10,55 GET lth:kst PICTURE "#######.##"
   @ 11,12 SAY "FOTO'S"
   @ 11,22 GET fot:lev PICTURE "XXXXXXXXXXXXXXX"
   @ 11,42 GET fot:opd PICTURE "##/##/##"
   @ 11,55 GET fot:kst PICTURE "#######.##"
   @ 13,11 SAY "DRUKKER"
   @ 13,22 GET drk:lev PICTURE "XXXXXXXXXXXXXXX"
   @ 13,42 GET drk:opd PICTURE "##/##/##"
   @ 13,55 GET drk:kst PICTURE "#######.##"
   @ 14,12 SAY "PAPIER"
   @ 14,22 GET pap:lev PICTURE "XXXXXXXXXXXXXXX"
   @ 14,42 GET pap:opd PICTURE "##/##/##"
   @ 14,55 GET pap:kst PICTURE "#######.##"
   @ 16, 8 SAY "NABEWERKER"
   @ 16,22 GET nab:lev PICTURE "XXXXXXXXXXXXXXX"
   @ 16,42 GET nab:opd PICTURE "##/##/##"
   @ 16,55 GET nab:kst PICTURE "#######.##"
   @ 17, 9 SAY "AFWERKING"
   @ 17,22 GET afw:lev PICTURE "XXXXXXXXXXXXXXX"
   @ 17,42 GET afw:opd PICTURE "##/##/##"
   @ 17,55 GET afw:kst PICTURE "#######.##"
   @ 19, 4 SAY "BIJZONDERHEDEN"
   @ 19,22 GET bijz:lev PICTURE "XXXXXXXXXXXXXXX"
   @ 19,42 GET bijz:opd PICTURE "##/##/##"
   @ 19,55 GET bijz:kst PICTURE "#######.##"
   @ 20,68 SAY "AKKOORD"
   @ 20,76 GET akk PICTURE "!"
   @ 22,58 SAY "HUIDIGE DATUM"
   @ 22,72 SAY sysdate
   READ
   CLEAR GETS
   DO WHILE .NOT. (akk $ "jJnN")
      STORE "." TO akk
      @ 20,76 GET akk PICTURE "!"
      READ
      CLEAR GETS
   ENDDO
ENDDO
*
* Van geheugenvariabelen naar recordvariabelen
*
REPLACE werk:tek WITH wrk:lev + ":" + wrk:opd + ":" + STR(wrk:kst,10,2), zetwerk WITH ztw:lev + ":" + ztw:opd + ":" + STR(ztw:kst,10,2), lithos WITH lth:lev + ":" + lth:opd + ":" + STR(lth:kst,10,2)
REPLACE fotos WITH fot:lev + ":" + fot:opd + ":" + STR(fot:kst,10,2), drukker WITH drk:lev + ":" + drk:opd + ":" + STR(drk:kst,10,2), papier WITH pap:lev + ":" + pap:opd + ":" + STR(pap:kst,10,2)
REPLACE nabewerk WITH nab:lev + ":" + nab:opd + ":" + STR(nab:kst,10,2), afwerk WITH afw:lev + ":" + afw:opd + ":" + STR(afw:kst,10,2), bijzond WITH bijz:lev + ":" + bijz:opd + ":" + STR(bijz:kst,10,2)
USE
*
* Geef geheugenvariabelen vrij
*
RELEASE wrk:lev,wrk:opd,wrk:kst,ztw:lev,ztw:opd,ztw:kst,lth:lev,lth:opd,lth:kst
RELEASE fot:lev,fot:opd,fot:kst,drk:lev,drk:opd,drk:kst,pap:lev,pap:opd,pap:kst
RELEASE nab:lev,nab:opd,nab:kst,afw:lev,afw:opd,afw:kst,bijz:lev,bijz:opd,bijz:kst
*
RETURN
*
* EINDE PROGRAMMA
*

