Ana Sayfa Keşfet Yardım
Giriş Yap
eric
/
Topspeed_JPI
1
0
Çatalla 0
Dosyalar Sorunlar 0 Değişiklik İstekleri 0 Wiki
Dal: master
Dallar Biçim İmleri
Topspeed_JPI
/
TS-V3
/
MODBASE
/
PMIMAINT.LST

PMIMAINT.LST 11 KB
Kalıcı Bağlantı Geçmiş Ham

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316 
  1. Listing:
    2. 

  2. 

  3.     1  IMPLEMENTATION MODULE PMIMaint;
    4. 

  4.     2  (*
    5. 

  5.     3   *  ModBase
    6. 

  6.     4   *  Release 3.0
    7. 

  7.     5   *  (c) Copyright 1986 - 1991 PMI
    8. 

  8.     6   *  P.O. Box 8402
    9. 

  9.     7   *  Green Bay Wi 53308
    10. 

  10.     8   *  All Rights Reserved
    11. 

  11.     9   *  by Ed Ross  
    12. 

  12.    10   *)
    13. 

  13.    11  
    14. 

  14.    12  
    15. 

  15.    13  FROM PMIGlobals IMPORT Config,PMIScreens;
    16. 

  16.    14  FROM NumTypes IMPORT Real8;
    17. 

  17.    15  FROM Numbers IMPORT Max;
    18. 

  18.    16  FROM PosUtils IMPORT Equal;
    19. 

  19.    17  FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,Append,CAPstr,DeleteChar;
    20. 

  20.    18  FROM M2Strings IMPORT Length;
    21. 

  21.    19  FROM LowLevel IMPORT Fill;
    22. 

  22.    20  FROM StringIO IMPORT PrintMessage,ErrorMessage,WriteEol,WriteStr,outp;
    23. 

  23.    21  FROM SmartScreen IMPORT ClearScreen;
    24. 

  24.    22  FROM ScrnUtl1 IMPORT FieldNum;
    25. 

  25.    23  FROM ScrnUtl2 IMPORT CloseDisplayFrame;
    26. 

  26.    24  FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
    27. 

  27.    25  FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName;
    28. 

  28.    26  FROM FramePainter IMPORT ShowDisplayFrame,RedrawField;
    29. 

  29.    27  FROM InputManager IMPORT ControlFrame;
    30. 

  30.    28  FROM FrameManager IMPORT EraseFrame;
    31. 

  31.    29  FROM Prompts IMPORT PromptYN;
    32. 

  32.    30  FROM SYSTEM IMPORT ADR,SIZE,ADDRESS;
    33. 

  33.    31  FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control,ChangeField;
    34. 

  34.    32  FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame;
    35. 

  35.    33  
    36. 

  36.    34  
    37. 

  37.    35  
    38. 

  38.    36  FROM DBFCustomer IMPORT CustomerDBF,MoveCustomerToDBF,MoveCustomerFromDBF,
    39. 

  39.    37       CustomerRec, OpenCustomerDBF,CloseCustomerDBF,PackCustomer;
    40. 

  40.    38  FROM ModBase3 IMPORT ReadDBRec,WriteDBRec,NumberRecords;
    41. 

  41.    39  
    42. 

  42.    40  FROM DBFInvtry IMPORT PackInvtry;
    43. 

  43.    41  FROM DBFInvoice IMPORT PackInvoice;
    44. 

  44.    42  FROM DBFGas IMPORT PackGas;
    45. 

  45.    43  FROM DBFPayments IMPORT PackPayments;
    46. 

  46.    44  FROM DBFOrder IMPORT PackOrder;
    47. 

  47.    45  
    48. 

  48.    46  
    49. 

  49.    47  VAR
    50. 

  50.    48    DF : DisplayFrame;
    51. 

  51.    49    NxtFrame : AFrameName;
    52. 

  52.    50  
    53. 

  53.    51  PROCEDURE PackDatabase();
    54. 

  54.    52  TYPE
    55. 

  55.    53   PackType = (PCust,PPay,PInv,PInvy,PGas,POrder);
    56. 

  56.    54  VAR
    57. 

  57.    55    WhatToPack : SET OF PackType;
    58. 

  58. *****                        ^ not supported yet
    59. 

  59.    56  
    60. 

  60.    57  BEGIN
    61. 

  61.    58    WhatToPack := WhatToPack / WhatToPack;
    62. 

  62. *****    ^ not supported yet
    63. 

  63. *****                  ^ not supported yet
    64. 

  64. *****                               ^ not supported yet
    65. 

  65.    59    IF PromptYN(' Pack Customer ',DF)
    66. 

  66. *****       ^ not supported yet
    67. 

  67. *****                ^ not supported yet
    68. 

  68. *****                                  ^ not supported yet
    69. 

  69.    60      THEN
    70. 

  70.    61        INCL(WhatToPack,PCust);
    71. 

  71. *****        ^ undeclared identifier
    72. 

  72. *****             ^ not supported yet
    73. 

  73. *****                        ^ not supported yet
    74. 

  74.    62      END;
    75. 

  75.    63    IF PromptYN(' Pack Payments ',DF)
    76. 

  76. *****       ^ not supported yet
    77. 

  77. *****                ^ not supported yet
    78. 

  78. *****                                  ^ not supported yet
    79. 

  79.    64      THEN
    80. 

  80.    65        INCL(WhatToPack,PPay);
    81. 

  81. *****        ^ undeclared identifier
    82. 

  82. *****             ^ not supported yet
    83. 

  83. *****                        ^ not supported yet
    84. 

  84.    66      END;
    85. 

  85.    67    IF PromptYN(' Pack Invoices ',DF)
    86. 

  86. *****       ^ not supported yet
    87. 

  87. *****                ^ not supported yet
    88. 

  88. *****                                  ^ not supported yet
    89. 

  89.    68      THEN
    90. 

  90.    69        INCL(WhatToPack,PInv);
    91. 

  91. *****        ^ undeclared identifier
    92. 

  92. *****             ^ not supported yet
    93. 

  93. *****                        ^ not supported yet
    94. 

  94.    70      END;
    95. 

  95.    71    IF PromptYN(' Pack Inventory ',DF)
    96. 

  96. *****       ^ not supported yet
    97. 

  97. *****                ^ not supported yet
    98. 

  98. *****                                   ^ not supported yet
    99. 

  99.    72      THEN
    100. 

  100.    73        INCL(WhatToPack,PInvy);
    101. 

  101. *****        ^ undeclared identifier
    102. 

  102. *****             ^ not supported yet
    103. 

  103. *****                        ^ not supported yet
    104. 

  104.    74      END;
    105. 

  105.    75    IF PromptYN(' Pack Helium ',DF)
    106. 

  106. *****       ^ not supported yet
    107. 

  107. *****                ^ not supported yet
    108. 

  108. *****                                ^ not supported yet
    109. 

  109.    76      THEN
    110. 

  110.    77        INCL(WhatToPack,PGas);
    111. 

  111. *****        ^ undeclared identifier
    112. 

  112. *****             ^ not supported yet
    113. 

  113. *****                        ^ not supported yet
    114. 

  114.    78      END;
    115. 

  115.    79    IF PromptYN(' Pack Orders ',DF)
    116. 

  116. *****       ^ not supported yet
    117. 

  117. *****                ^ not supported yet
    118. 

  118. *****                                ^ not supported yet
    119. 

  119.    80      THEN
    120. 

  120.    81        INCL(WhatToPack,POrder);
    121. 

  121. *****        ^ undeclared identifier
    122. 

  122. *****             ^ not supported yet
    123. 

  123. *****                        ^ not supported yet
    124. 

  124.    82      END;
    125. 

  125.    83    ClearScreen();
    126. 

  126. *****    ^ not supported yet
    127. 

  127. *****                ^ not supported yet
    128. 

  128.    84    IF PPay IN WhatToPack
    129. 

  129. *****       ^ not supported yet
    130. 

  130. *****               ^ not supported yet
    131. 

  131.    85      THEN
    132. 

  132.    86       WriteEol(outp,' Packing Payments database ');
    133. 

  133. *****       ^ not supported yet
    134. 

  134. *****                ^ not supported yet
    135. 

  135. *****                     ^ not supported yet
    136. 

  136.    87       PackPayments();
    137. 

  137. *****       ^ not supported yet
    138. 

  138. *****                    ^ not supported yet
    139. 

  139.    88      END;
    140. 

  140.    89  
    141. 

  141.    90    IF PCust IN WhatToPack
    142. 

  142. *****       ^ not supported yet
    143. 

  143. *****                ^ not supported yet
    144. 

  144.    91      THEN
    145. 

  145.    92        WriteEol(outp,' Packing customer database ');
    146. 

  146. *****        ^ not supported yet
    147. 

  147. *****                 ^ not supported yet
    148. 

  148. *****                      ^ not supported yet
    149. 

  149.    93        PackCustomer();
    150. 

  150. *****        ^ not supported yet
    151. 

  151. *****                     ^ not supported yet
    152. 

  152.    94      END;
    153. 

  153.    95  
    154. 

  154.    96    IF PInv IN WhatToPack
    155. 

  155. *****       ^ not supported yet
    156. 

  156. *****               ^ not supported yet
    157. 

  157.    97      THEN
    158. 

  158.    98         WriteEol(outp,' Packing Invoice database ');
    159. 

  159. *****         ^ not supported yet
    160. 

  160. *****                  ^ not supported yet
    161. 

  161. *****                       ^ not supported yet
    162. 

  162.    99         PackInvoice();
    163. 

  163. *****         ^ not supported yet
    164. 

  164. *****                     ^ not supported yet
    165. 

  165.   100      END;
    166. 

  166.   101  
    167. 

  167.   102    IF PInvy IN WhatToPack
    168. 

  168. *****       ^ not supported yet
    169. 

  169. *****                ^ not supported yet
    170. 

  170.   103      THEN
    171. 

  171.   104        WriteEol(outp,' Packing Inventory database ');
    172. 

  172. *****        ^ not supported yet
    173. 

  173. *****                 ^ not supported yet
    174. 

  174. *****                      ^ not supported yet
    175. 

  175.   105        PackInvtry();
    176. 

  176. *****        ^ not supported yet
    177. 

  177. *****                   ^ not supported yet
    178. 

  178.   106      END;
    179. 

  179.   107  
    180. 

  180.   108   IF PGas IN WhatToPack
    181. 

  181. *****      ^ not supported yet
    182. 

  182. *****              ^ not supported yet
    183. 

  183.   109     THEN
    184. 

  184.   110        WriteEol(outp,' Packing Gas database ');
    185. 

  185. *****        ^ not supported yet
    186. 

  186. *****                 ^ not supported yet
    187. 

  187. *****                      ^ not supported yet
    188. 

  188.   111        PackGas();
    189. 

  189. *****        ^ not supported yet
    190. 

  190. *****                ^ not supported yet
    191. 

  191.   112      END;
    192. 

  192.   113   IF POrder IN WhatToPack
    193. 

  193. *****      ^ not supported yet
    194. 

  194. *****                ^ not supported yet
    195. 

  195.   114     THEN
    196. 

  196.   115       WriteEol(outp,'Packing orderdatabase');
    197. 

  197. *****       ^ not supported yet
    198. 

  198. *****                ^ not supported yet
    199. 

  199. *****                     ^ not supported yet
    200. 

  200.   116       PackOrder();
    201. 

  201. *****       ^ not supported yet
    202. 

  202. *****                 ^ not supported yet
    203. 

  203.   117     END;
    204. 

  204.   118  END PackDatabase;
    205. 

  205. *****      ^ not supported yet
    206. 

  206.   119  
    207. 

  207.   120  PROCEDURE ResetCustYTD();
    208. 

  208.   121  VAR
    209. 

  209.   122    Cust : CustomerRec;
    210. 

  210.   123    LI : LONGINT;
    211. 

  211.   124  BEGIN
    212. 

  212.   125    IF NOT PromptYN(' Reset Customer YTD Purchases? ',DF)
    213. 

  213. *****           ^ not supported yet
    214. 

  214. *****                    ^ not supported yet
    215. 

  215. *****                                                      ^ not supported yet
    216. 

  216.   126      THEN
    217. 

  217.   127        RETURN;
    218. 

  218.   128      END;
    219. 

  219.   129    OpenCustomerDBF(FALSE);
    220. 

  220. *****    ^ not supported yet
    221. 

  221. *****                         ^ not supported yet
    222. 

  222.   130    ClearScreen();
    223. 

  223. *****    ^ not supported yet
    224. 

  224. *****                ^ not supported yet
    225. 

  225.   131    FOR LI := 1 TO NumberRecords(CustomerDBF) DO
    226. 

  226. *****                   ^ not supported yet
    227. 

  227. *****                                 ^ not supported yet
    228. 

  228.   132      ReadDBRec(CustomerDBF,LI);
    229. 

  229. *****      ^ not supported yet
    230. 

  230. *****                ^ not supported yet
    231. 

  231. *****                              ^ not supported yet
    232. 

  232.   133      MoveCustomerFromDBF(Cust);
    233. 

  233. *****      ^ not supported yet
    234. 

  234. *****                          ^ not supported yet
    235. 

  235.   134      WriteStr(outp,' Processing  ');
    236. 

  236. *****      ^ not supported yet
    237. 

  237. *****               ^ not supported yet
    238. 

  238. *****                    ^ not supported yet
    239. 

  239.   135      WriteEol(outp,Cust.NAME);
    240. 

  240. *****      ^ not supported yet
    241. 

  241. *****               ^ not supported yet
    242. 

  242. *****                    ^ not supported yet
    243. 

  243. *****                         ^ not supported yet
    244. 

  244.   136      Cust.YTDPURCH := 0.0;
    245. 

  245. *****      ^ not supported yet
    246. 

  246. *****           ^ not supported yet
    247. 

  247.   137      MoveCustomerToDBF(Cust);
    248. 

  248. *****      ^ not supported yet
    249. 

  249. *****                        ^ not supported yet
    250. 

  250.   138      WriteDBRec(CustomerDBF);
    251. 

  251. *****      ^ not supported yet
    252. 

  252. *****                 ^ not supported yet
    253. 

  253.   139    END;
    254. 

  254.   140    CloseCustomerDBF();
    255. 

  255. *****    ^ not supported yet
    256. 

  256. *****                     ^ not supported yet
    257. 

  257.   141  END ResetCustYTD;
    258. 

  258. *****      ^ not supported yet
    259. 

  259.   142  
    260. 

  260.   143  PROCEDURE Maintain();
    261. 

  261.   144  
    262. 

  262.   145  BEGIN
    263. 

  263.   146    InitDisplayFrame(DF,CurrentWindow);
    264. 

  264. *****    ^ not supported yet
    265. 

  265. *****                     ^ not supported yet
    266. 

  266. *****                        ^ not supported yet
    267. 

  267.   147    ReadDisplayFrame(PMIScreens,DF,'Maint');
    268. 

  268. *****    ^ not supported yet
    269. 

  269. *****                     ^ not supported yet
    270. 

  270. *****                                ^ not supported yet
    271. 

  271. *****                                   ^ not supported yet
    272. 

  272.   148    REPEAT
    273. 

  273.   149      ClearScreen();
    274. 

  274. *****      ^ not supported yet
    275. 

  275. *****                  ^ not supported yet
    276. 

  276.   150      ShowDisplayFrame(DF,0,0,0,0);
    277. 

  277. *****      ^ not supported yet
    278. 

  278. *****                       ^ not supported yet
    279. 

  279. *****                                 ^ not supported yet
    280. 

  280.   151      ControlFrame(DF,1,'',FALSE,NxtFrame);
    281. 

  281. *****      ^ not supported yet
    282. 

  282. *****                   ^ not supported yet
    283. 

  283. *****                                 ^ not supported yet
    284. 

  284.   152      IF Equal(NxtFrame,'PackDB')
    285. 

  285. *****         ^ not supported yet
    286. 

  286. *****               ^ not supported yet
    287. 

  287. *****                        ^ not supported yet
    288. 

  288.   153        THEN PackDatabase();
    289. 

  289. *****             ^ not supported yet
    290. 

  290. *****                          ^ not supported yet
    291. 

  291.   154      ELSIF Equal(NxtFrame,'ResetCust')
    292. 

  292. *****            ^ not supported yet
    293. 

  293. *****                  ^ not supported yet
    294. 

  294. *****                           ^ not supported yet
    295. 

  295.   155        THEN ResetCustYTD();
    296. 

  296. *****             ^ not supported yet
    297. 

  297. *****                          ^ not supported yet
    298. 

  298.   156    END;
    299. 

  299.   157    UNTIL Equal(NxtFrame,'Exit');
    300. 

  300. *****          ^ not supported yet
    301. 

  301. *****                ^ not supported yet
    302. 

  302. *****                         ^ not supported yet
    303. 

  303.   158    CloseDisplayFrame(DF);
    304. 

  304. *****    ^ not supported yet
    305. 

  305. *****                      ^ not supported yet
    306. 

  306.   159  END Maintain;
    307. 

  307. *****      ^ not supported yet
    308. 

  308.   160  
    309. 

  309.   161  
    310. 

  310.   162  
    311. 

  311.   163  END PMIMaint.
    312. 

  312. *****      ^ not supported yet
    313. 

  313. 

  314.   147 errors
    315. 

  315. 

  316.