home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / chrchpr2.zip / CSANSWRS.CMD < prev    next >
OS/2 REXX Batch file  |  1987-01-06  |  6KB  |  238 lines
  1. * Program CSANSWRS - Allows entry of Survey answers for everyone in MEMBERSS.
  2. Store d+':MEMBERSS' to MFILE
  3. Select secondary
  4. Use CSURVEY
  5. GOTO 10
  6. Store csanswrsx+' ' to valansw
  7. Select primary
  8. Use &MFILE index &MFILE
  9. Store T to cscontin
  10. Store F to invalcc
  11. DO WHILE CSCONTIN
  12.   If .not. invalcc
  13.   ? 'Enter LAST NAME (3 characters) and FIRST NAME (2 characters) '
  14.   Accept '  Name code ' to INHH
  15.   Store T to invalcc
  16.   Store F to MATCH
  17.   Do while invalcc
  18.     If len(INHH) = 1 .and. !(INHH) = 'Q'
  19.       Store F to invalcc
  20.       Store F to cscontin
  21.     else
  22.       If len(INHH) <> 5
  23.   Accept 'Invalid entry - must be 5 characters. Please re-enter ' to INHH
  24.       else
  25.        Store !($(INHH,1,1))+$(INHH,2,2) to INLN
  26.        Store !($(INHH,4,1))+$(INHH,5,1) to INFN
  27.        Store F to invalcc
  28.       endif
  29.     endif
  30.   enddo
  31.   If CSCONTIN
  32.   ? 'Matching ',trim(INLN),'..., ',trim(INFN),'...'
  33.   Store T to MATCHINGL
  34.   Store T to MATCHING
  35.   FIND &INLN
  36.   If # = 0
  37.     Accept 'No match. Press <retn> to continue. ' to XX
  38.   else
  39.     Do while MATCHING
  40.       Store T to PMATCHING
  41.       Do while PMATCHING *(partial matching)
  42.         Store T to NXTMATCH
  43.         Do while NXTMATCH
  44.           If EOF .or. $(last:name,1,3) <> INLN
  45.             Store F to MATCHINGL
  46.             Store F to MATCHING
  47.             Store F to PMATCHING
  48.             Store F to NXTMATCH
  49.             Store F to MATCH
  50.           else
  51.            Store F to NXTMATCH
  52.           endif
  53.         enddo    * NXTMATCH
  54.         If MATCHINGL
  55.           If $(FIRST:NAME,1,2) = INFN
  56.             Store F to PMATCHING
  57.             Store T to MATCH
  58.           else
  59.              SKIP
  60.           endif
  61.         endif
  62.       enddo  *(PMATCHING)
  63.       If match
  64.        ? 'Name: ',trim(last:name),', ',trim(first:name),'   Phone: ',home:phone
  65.        Accept 'Is this the right name and phone? ' to xx
  66.        If !(xx)='Y'
  67.          Store F to MATCHING
  68.        else
  69.          Store T to MATCHING
  70.          Store F to MATCH
  71.          SKIP
  72.        endif
  73.      endif
  74.    enddo    * (MATCHING)
  75.  endif
  76.  endif
  77.  endif
  78.  If MATCH
  79.  Store $(P.ssscattd,1,20) to CSURV1
  80.  Store $(P.ssscattd,21,20) to CSURV2
  81.  Store $(P.ssscattd,41,19)+' ' to CSURV3
  82.  Store '11' to SET
  83.  Store '1' to II
  84.  Store F to DONE
  85.  Store '  ' to invala
  86.  Store trim(P.last:name)+', '+trim(P.first:name) to xname
  87.  Store '    TEL: '+P.home:phone to tel
  88.  Do while .not.EOF .and. .not.DONE
  89.   Store T to invalansw
  90.   Erase
  91.   Do while invalansw
  92.    If '  '<>invala
  93.     @ 23,0 say 'INVALID ANSWERS :'+invala
  94.    else
  95.     @ 1,26 say 'CHURCH SURVEY PROCESSING            '+CURDATE
  96.     @ 2,0 say xname+tel
  97.     @ 2,66 say MFILE
  98.    endif
  99.    Store 'A' to I
  100.    Store 1 to cl
  101.    Select secondary
  102.    GOTO &SET
  103.    Store val(II)*20-20 to III
  104.    Do while cl<21
  105.     If '  '=invala
  106.       @ cl+2,0 say str(cl+III,2)+'.'
  107.       @ cl+2,8 say csanswrsx+'  '+QU1
  108.       Store $(csurv&II,cl,1) to NN&I
  109.     endif
  110.     @ cl+2,4 get NN&I
  111.     SKIP
  112.     Store cl+1 to cl
  113.     Store chr(rank(I)+1) to I
  114.   enddo
  115.   READ
  116.   If '  '<>valansw
  117.     Store 'A' to I
  118.     Store '  ' to invala
  119.     Store 1 to cl
  120.     Do while cl<21
  121.       If @(NN&I,valansw)=0
  122.         Store invala+str(cl+III,3) to invala
  123.       endif
  124.       Store cl+1 to cl
  125.       Store chr(rank(I)+1) to I
  126.     enddo
  127.     If '  '=invala
  128.       Store F to invalansw
  129.     else
  130.       @ 23,0 say ;
  131. '                                                                             '
  132.     endif
  133.   else
  134.     Store F to invalansw
  135.   endif
  136.   enddo
  137. Accept ;
  138. 'Select: [N]ext screen    [B]ack a screen    [S]ave this record  [Q]uit ' TO ES
  139. Store T to inval2
  140. Do while inval2
  141.   Store F to inval2
  142.   Do CASE
  143.   CASE !(ES)='S'
  144.     STORE NNA+NNB+NNC+NND+NNE+NNF+NNG+NNH+NNI+NNJ+NNK+NNL+NNM+NNN+;
  145.           NNO+NNP+NNQ+NNR+NNS+NNT TO CSURV&II
  146.     Select primary
  147.     Replace ssscattd with csurv1+csurv2+csurv3
  148.     Store T to DONE
  149.   CASE !(ES)='N'
  150.     Store NNA+NNB+NNC+NND+NNE+NNF+NNG+NNH+NNI+NNJ+NNK+NNL+NNM+NNN+NNO to XX
  151.     Store  XX+NNP+NNQ+NNR+NNS+NNT TO CSURV&II
  152.     Select primary
  153.     Replace ssscattd with csurv1+csurv2+csurv3
  154.     If II='3'
  155.       Accept 'Invalid entry - this is the last screen. enter again ' to es
  156.       Store T to inval2
  157.     else
  158.       Store str(val(II)+1,1) to II
  159.       Store str(11+val(II)*20,2) to SET
  160.     endif
  161.   CASE !(ES)='B'
  162.     Store NNA+NNB+NNC+NND+NNE+NNF+NNG+NNH+NNI+NNJ+NNK+NNL+NNM+NNN+NNO to XX
  163.     Store  XX+NNP+NNQ+NNR+NNS+NNT TO CSURV&II
  164.     Select primary
  165.     Replace ssscattd with csurv1+csurv2+csurv3
  166.     If II='1'
  167.       Accept 'Invalid entry - this is the first screen. Enter again ' to es
  168.       Store T to inval2
  169.     else
  170.       Store str(val(II)-1,1) to II
  171.       Store str(11+val(II)*20,2) to SET
  172.     endif
  173.   CASE !(es)='Q'
  174.     Store T to done
  175.     Select primary
  176.   otherwise
  177.     Accept 'Invalid entry. Please enter again [N/B/S/Q] ' to es
  178.     Store T to inval2
  179.   endcase
  180.   enddo
  181.  enddo
  182.  ? 'Record for "',xname,'" is processed.'
  183.  If len(es)=1
  184.    Accept 'Select:  [N]ext name    [A]nother name    [Q]uit ' to ES
  185.  else
  186.    Store $(es,2,1) to ES
  187.  endif
  188.  Store T to inval2
  189.  Do while inval2
  190.   Store F to inval2
  191.   DO CASE
  192.   CASE !(ES)='N'
  193.     SKIP
  194.     If EOF
  195.       Store F to CSCONTIN
  196.     else
  197.       Store T to invalcc
  198.     endif
  199.   CASE !(ES)='A'
  200.     Store F to invalcc
  201.     If EOF
  202.       Store F to CSCONTIN
  203.     endif
  204.   CASE !(ES)='Q'
  205.     USE
  206.     Store F to CSCONTIN
  207.   otherwise
  208.     Accept 'Invalid entry. Please enter again [N/B/Q] ' to ES
  209.     Store T to inval2
  210.   ENDCASE
  211. enddo
  212. else
  213.  If CSCONTIN
  214.   Accept 'No match for this name. Press <retn> ' to xx
  215.  endif
  216. endif
  217. enddo
  218. RETURN
  219.  
  220. tore F to PMATCHING
  221.             Store T to MATCH
  222.           else
  223.              SKIP
  224.           endif
  225.         endif
  226.       enddo  *(PMATCHING)
  227.       If match
  228.        ? 'Name: ',trim(last:name),', ',trim(first:name),'   Phone: ',home:phone
  229.        Accept 'Is this the right name and phone? ' to xx
  230.        If !(xx)='Y'
  231.          Store F to MATCHING
  232.        else
  233.          Store T to MATCHING
  234.          Store F to MATCH
  235.          SKIP
  236.        endif
  237.      endif
  238.    end