home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a040 / 2.ddi / SHRWARE4.ARC / MSAREPO.INC < prev    next >
Encoding:
Text File  |  1988-06-03  |  6.8 KB  |  319 lines
  1. <<* MSAREPO.INC *>>
  2.  
  3. <<procedure GenReportBody>>
  4. <<begin>>
  5. PARAMETERS CHOICE_Y
  6. PRIVATE filename,savrecnum,rowPROMPT
  7. rowPROMPT = 23
  8. savrecnum = RECNO()
  9. * ---MAIN LOOP
  10. DO WHILE .T.
  11. DO CASE
  12. CASE CHOICE_Y = 1
  13.       * ---DO DELETE REPORT.
  14.       SET FILTER TO DELETED()
  15.       * ---CHECK THE FILE
  16.     IF RECCOUNT() = 0
  17.       @ 23,0 CLEAR
  18.       @ 23,0 SAY 'No records marked for deletion. '
  19.       WAIT
  20.     ELSE
  21.       SKIP
  22.       SKIP -1
  23.       IF EOF() .AND. BOF()
  24.       @ 23,0 CLEAR
  25.       @ 23,0 SAY 'No records marked for deletion. '
  26.       WAIT
  27.       ELSE
  28.       DO {fileprefix}_BROW
  29.       ENDIF
  30.     ENDIF
  31.       SET FILTER TO
  32.       EXIT
  33. CASE CHOICE_Y = 2
  34. <<GenColor( 0,'SCREEN' )>>
  35. * --- CREATE STATUS BOX
  36. @ 1,49 CLEAR TO 6,75
  37. @ 1,49 TO 6,75
  38. @ 1,59 SAY " STATUS "
  39. @ 2,50 SAY "       FILE:"
  40. @ 3,50 SAY "      INDEX:"
  41. @ 4,50 SAY "   FILTERED:"
  42. @ 5,50 SAY "DESTINATION:"
  43. SAVE SCREEN TO STATUSSCR
  44. * ---Display report forms.
  45. @ 24,0 CLEAR
  46. @ 24,0 SAY 'Loading directory...'
  47. * ---MAKE DIRECTORY AND LOAD INTO MENU
  48. * ---FIND FIRST ENTRY
  49. STORE SYS(2000,{"}{fileprefix}_*.FRM{"}) TO MSG1
  50. IF LEN(MSG1) <> 0
  51.  STORE 2 TO COUNT
  52.  STORE "MSG2" TO MSG
  53.  DO WHILE .T. 
  54.  STORE SYS(2000,{"}{fileprefix}_*.FRM{"},1) TO &MSG
  55.  IF LEN(&MSG) = 0
  56.  EXIT
  57.  ENDIF
  58.  STORE COUNT + 1 TO COUNT
  59.  STORE "MSG"+LTRIM(STR(COUNT)) TO MSG
  60.  ENDDO
  61.  * ---display 
  62. @ 24,0 CLEAR
  63. @ 24,0 SAY 'Select Report File.'
  64.  menuchoice = 0
  65.  DO {fileprefix}_MENU WITH 4,25,COUNT-1,12
  66.  @ 23,0 SAY "         "
  67.  IF menuchoice = 0
  68.  EXIT
  69.  ELSE
  70.  STORE "MSG"+LTRIM(STR(menuchoice)) TO MSG
  71.  STORE &MSG TO filename
  72.  ENDIF 
  73. ELSE
  74.  * ---NO FILES
  75.  @ 24,0 CLEAR
  76.  @ 24,0 SAY 'NO FRM Files found.  Press any key to continue.'
  77.  STORE INKEY(0) TO STOP
  78.  EXIT
  79. ENDIF
  80.  
  81. CASE CHOICE_Y = 3
  82. * ---CREATE REPORT
  83. STORE SPACE(1) TO filename
  84.  
  85. CASE CHOICE_Y = 4
  86. * --- ADD YOUR OWN
  87.  EXIT
  88.  
  89. CASE CHOICE_Y = 5
  90. * --- ADD YOUR OWN
  91.  EXIT
  92. ENDCASE  && CHOICE_Y
  93.  
  94.  
  95.  
  96. * --- CHECK CONDITIONS AND RUN REPORTS
  97.  
  98. IF CHOICE_Y = 2 .OR. CHOICE_Y = 3
  99. * ---If the file does not exist, create it or exit.
  100. @ 24,0 CLEAR
  101.   ?? SYS(2002,1)
  102. IF .NOT. FILE( filename )
  103. filename = "    "
  104. @  24, 0 SAY {"}Enter REPORT FORM filename: {fileprefix}_    .FRM{"}
  105. @  24,32 GET filename PICTURE "@!"
  106. READ
  107. * ---Remove the file extension.
  108. filename = UPPER( filename + "." )
  109. filename = TRIM( SUBSTR( filename,1,AT(".",filename)-1 ) )
  110. IF "" = filename
  111.    EXIT
  112. ENDIF
  113. filename = {"}{fileprefix}_{"} + filename + ".FRM"
  114. IF FILE( filename )
  115. STORE SPACE(1) TO CHECK
  116. @ 24,0 CLEAR
  117. @ 24,0 SAY 'File '+filename+' exists.  Do you wish to overwrite? (Y/N)';
  118.  GET CHECK PICT '!' VALID CHECK$'YN'
  119. READ
  120. IF CHECK = 'N'
  121. EXIT
  122. ENDIF
  123. ENDIF
  124.    CREATE REPORT &filename
  125.    EXIT
  126. ENDIF
  127. RESTORE SCREEN FROM STATUSSCR
  128. * --- PLACE NAME IN STATUS BOX
  129. @ 2,63 SAY filename
  130. SAVE SCREEN TO STATUSSCR
  131. * --- SELECT INDEX
  132. ndxchoice = ' '
  133. <<if ndxtotal > 1>>
  134.    DO {fileprefix}_NDXS WITH rowPROMPT,ndxchoice
  135. <<elseif ndxtotal = 1>>
  136.    * ---Only one index.
  137.    DO SayLine WITH rowPROMPT,"*** ONE INDEX FILE IN USE"
  138.    WAIT
  139. <<elseif ndxtotal = 0>>
  140.    * ---no index.
  141.    DO SayLine WITH rowPROMPT,"*** NO INDEX FILE IN USE"
  142.    WAIT
  143. <<endif>>
  144. <<GenColor( 0,'SCREEN' )>>
  145. RESTORE SCREEN FROM STATUSSCR
  146. * ---UPDATE STATUS
  147. @ 3,63 SAY ndxchoice
  148. SAVE SCREEN TO STATUSSCR
  149. *
  150. * ---Get the FOR <exp>.
  151. expr = ""
  152. notes = ""
  153. choice = " "
  154. @ 24,0 CLEAR
  155. @ 24,0 SAY "Specify a CONDITION on the output? (y/n)" GET choice PICTURE "!"
  156. READ
  157. IF choice = "Y"
  158.   <<select database 8>>  <<*Is SELECT H being used?*>>
  159.   <<if dbfnam>>          <<*Yes, then use old <expr> system...*>>
  160.    DO {fileprefix}_EXPR WITH expr
  161.   <<else>>               <<*No, use new and improved...*>>
  162.    DO {fileprefix}_COND WITH expr,notes
  163.   <<endif>>
  164.    IF "" <> TRIM( expr )
  165.       * ---Check for valid LOGICAL expression.
  166.       IF TYPE( expr ) <> "L"
  167.          expr = ""
  168.       ENDIF
  169.    ENDIF
  170. ENDIF
  171. RESTORE SCREEN FROM STATUSSCR
  172. * --- UP DATE STATUS
  173. IF "" <> TRIM( expr )
  174.  @ 4,63 SAY "Yes"
  175. ELSE
  176.  @ 4,63 SAY "No"
  177. ENDIF 
  178. * ---Screen or printer selection.
  179. menuchoice = 0
  180. MSG1 = "Screen"
  181. MSG2 = "Printer"
  182. MSG3 = "File"
  183. MSG4 = "Abort"
  184. DO {fileprefix}_MENU WITH 6,35,4,8
  185. DO CASE
  186. CASE menuchoice = 4
  187.    EXIT
  188. CASE menuchoice = 3
  189. * ---SENT TO A FILE
  190. * ---UPDATE STATUS
  191. @ 5,63 SAY "File"
  192. * ---CREATE FILE NAME
  193. rptfile = STUFF( filename,len(filename)-2,3,"TXT" )
  194. @ 24,0 CLEAR
  195. @ 24,0 SAY 'Writing '+ rptfile+ ' Report file.'
  196. SET CONSOLE OFF
  197.    IF "" <> TRIM( expr )
  198.       REPORT FORM &filename FOR &expr HEADING notes TO FILE &rptfile
  199.    ELSE
  200.       REPORT FORM &filename TO FILE &rptfile
  201.    ENDIF
  202. SET CONSOLE ON
  203. EXIT
  204. CASE menuchoice = 2
  205. * ---Print the report.
  206. * ---UPDATE STATUS
  207. @ 5,63 SAY "Printer"
  208. * ---CHECK STATUS OF PRINTER
  209. ?? CHR(7)
  210. @ 24,0 CLEAR
  211. @ 24,0 SAY 'Please check printer and press any key to begin or '+;
  212. '<A> to Abort.'
  213. key = 0
  214. DO WHILE KEY = 0 .OR. SYS(13) = 'OFFLINE'
  215. KEY = 0
  216. DO WHILE KEY = 0
  217.  KEY = INKEY()
  218. ENDDO
  219.  IF CHR(KEY) $ "aA"
  220.   EXIT
  221.  ENDIF
  222. ENDDO  
  223. IF CHR(KEY) $ "aA"
  224.  * --- EXIT FROM MAIN LOOP
  225.  EXIT
  226. ENDIF
  227. * ---printer is ready check if special fount needed
  228. menuchoice = 0
  229. MSG1 = "Draft"
  230. MSG2 = "Letter Quality"
  231. MSG3 = "Condensed"
  232. MSG4 = "Expanded"
  233. MSG5 = "Abort"
  234. DO {fileprefix}_MENU WITH 7,45,5,14
  235. ?? CHR(7)
  236. * ---Print the report.
  237.    @ 24,0 CLEAR
  238.    @ 24,0 SAY "Printing report..."
  239.    SET ESCAPE ON
  240.    SET CONSOLE OFF
  241. SET PRINT ON
  242. DO CASE
  243.   CASE menuchoice = 1
  244.    IF INST_L_OFF <> SPACE(30)
  245.    ?? &INST_L_OFF
  246.    ENDIF
  247.   CASE menuchoice = 2
  248.    IF INST_L_ON <> SPACE(30)
  249.    ?? &INST_L_ON
  250.    ENDIF
  251.   CASE menuchoice = 3
  252.    IF INST_C_ON <> SPACE(30)
  253.    ?? &INST_C_ON
  254.    ENDIF
  255.   CASE menuchoice = 4
  256.    IF INST_E_ON <> SPACE(30)
  257.    ?? &INST_E_ON
  258.    ENDIF
  259.   CASE menuchoice = 5
  260.    SET PRINT OFF
  261.    EXIT
  262. ENDCASE
  263. SET PRINT OFF
  264.    IF "" <> TRIM( expr )
  265.       REPORT FORM &filename FOR &expr HEADING notes NOEJECT TO PRINT
  266.    ELSE
  267.       REPORT FORM &filename NOEJECT TO PRINT
  268.    ENDIF
  269.    EJECT
  270.    * --- reset printer
  271.    SET PRINT ON
  272.    DO CASE
  273.      CASE menuchoice = 1
  274.       IF INST_L_OFF <> SPACE(30)
  275.       ?? &INST_L_OFF
  276.       ENDIF
  277.      CASE menuchoice = 2
  278.       IF INST_L_OFF <> SPACE(30)
  279.       ?? &INST_L_OFF
  280.       ENDIF
  281.      CASE menuchoice = 3
  282.       IF INST_C_OFF <> SPACE(30)
  283.       ?? &INST_C_OFF
  284.       ENDIF
  285.      CASE menuchoice = 4
  286.       IF INST_E_OFF <> SPACE(30)
  287.       ?? &INST_E_OFF
  288.       ENDIF
  289.    ENDCASE
  290.    SET PRINT OFF
  291.    SET CONSOLE ON
  292.    SET ESCAPE OFF
  293.    EXIT
  294. OTHERWISE
  295.  * ---output to screen
  296.   <<GenColor( 0,'SCREEN' )>>
  297.    CLEAR
  298.    SET ESCAPE ON
  299.    IF "" <> TRIM( expr )
  300.       REPORT FORM &filename HEADING notes FOR &expr
  301.    ELSE
  302.       REPORT FORM &filename
  303.    ENDIF
  304.    SET ESCAPE OFF
  305.    WAIT
  306.    EXIT
  307. ENDCASE
  308. ENDIF  &&CHOICE = 2 .OR. 3
  309.  
  310. ENDDO
  311. IF savrecnum > 0 .AND. LASTREC <> 0
  312.    GOTO savrecnum
  313. ENDIF
  314.   ?? SYS(2002)
  315.  
  316. <<end>> <<*GenReportBody*>>
  317.  
  318. <<* EOF: MSAREPO.INC *>>
  319.