home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pds.zip / PDSRGSTR.CMD < prev    next >
OS/2 REXX Batch file  |  1994-06-19  |  18KB  |  691 lines
  1. /*REXX*/
  2.  
  3.   /***
  4.   signal on HALT    name HaltExit
  5.   signal on ERROR   name ErrorExit
  6.   signal on FAILURE name FailureExit
  7.   signal on SYNTAX  name SyntaxExit
  8.   ***/
  9.  
  10. main:
  11. parse arg p1
  12.   sGlobal.fDebug  = 'N'
  13.   sGlobal.sFileSpec = 'PDSRGSTR.TXT'
  14.   sGlobal.iBSFctr= 15.00
  15.   sGlobal.iRXFctr= 5.00
  16.   sGlobal.iHLFctr= 10.00
  17.   fDebugQ  = sGlobal.fDebug
  18.   fDispStax= 'N'
  19.   fDispHelp= 'N'
  20.   fFlSpecQ = 'N'
  21.   sFlSpec = sGlobal.sFileSpec
  22.  
  23.   CALL rParseParms p1
  24.  
  25.   if fDebugQ = 'Y' then
  26.    do
  27.     trace ?r
  28.    end
  29.  
  30.   if fDispStax = 'Y' then
  31.    do
  32.     CALL rDispSyntax 0, 0
  33.    end
  34.  
  35.   if fDispHelp = 'Y' then
  36.    do
  37.     CALL rDispSyntax 1, 0
  38.    end
  39.  
  40.   /* Actual routine */
  41.   rc   = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
  42.   if rc <> 0 then
  43.    do
  44.     Call rSiren 1, 1
  45.     say 'PDSRGSTR - Unable to initialize the "RXPD" subsystem'
  46.     exit 8
  47.    end
  48.  
  49.   sGlobal.fModifiedQ = 'N'
  50.   sGlobal.sCursorFld='sName'
  51.   sGlobal.iCursorNdx=0
  52.   sGlobal.fDebug=fDebugQ
  53.   sGlobal.fDebug  = fDebugQ
  54.   sGlobal.sFileSpec = TRANSLATE(sFlSpec)
  55.  
  56.   sName = ''
  57.   sAddr1 = ''
  58.   sAddr2 = ''
  59.   sAddr3 = ''
  60.   sCity = ''
  61.   sState = ''
  62.   sCountry = ''
  63.   sZip = ''
  64.   sEMail = ''
  65.   sHowAcquired = ''
  66.   iBS = 0
  67.   iRX = 0
  68.   iHL = 0
  69.   iTBS = 0
  70.   iTRX = 0
  71.   iTHL = 0
  72.   iTotal = 0
  73.  
  74.   sGlobal.zBid = rxPDInit('PDSRGSTR','GREENHI','YELLOWHI','LBLUEHI',,43,80)
  75.   if sGlobal.zBid = x2c(00000000) then
  76.    do
  77.     Call rSiren 2, 3
  78.     say 'PDSRGSTR - Error to initializing the "RXPD" subsystem'
  79.     exit 8
  80.    end
  81.  
  82.   Call rxPDZVarDefine
  83.   iNumAttr = ZVTYPE_LONG+ZVTYPE_RIGHTADJUST
  84.   iDblAttr = ZVTYPE_DOUBLE+ZVTYPE_RIGHTADJUST
  85.   rc = rxPDVarDefine(sGlobal.zBid, 'iBS', iNumAttr, 0)
  86.   rc = rxPDVarDefine(sGlobal.zBid, 'iRX', iNumAttr, 0)
  87.   rc = rxPDVarDefine(sGlobal.zBid, 'iHL', iNumAttr, 0)
  88.   rc = rxPDVarDefine(sGlobal.zBid, 'iTBS', iDblAttr, 2)
  89.   rc = rxPDVarDefine(sGlobal.zBid, 'iTRX', iDblAttr, 2)
  90.   rc = rxPDVarDefine(sGlobal.zBid, 'iTHL', iDblAttr, 2)
  91.   rc = rxPDVarDefine(sGlobal.zBid, 'sGlobal.iBSFctr', iDblAttr, 2)
  92.   rc = rxPDVarDefine(sGlobal.zBid, 'sGlobal.iRXFctr', iDblAttr, 2)
  93.   rc = rxPDVarDefine(sGlobal.zBid, 'sGlobal.iHLFctr', iDblAttr, 2)
  94.   rc = rxPDVarDefine(sGlobal.zBid, 'iTotal', iDblAttr, 2)
  95.  
  96.   akey = rxPDDisplay(sGlobal.zBid,'PANEL000')
  97.   do while 0 = rDoEdit(sGlobal.zBid)
  98.   end /* do while 0 = rDoEdit() */
  99.  
  100.   /* Save the file */
  101.   if sGlobal.fModifiedQ = 'Y' then
  102.    do
  103.     Call rDoSAVE
  104.    end
  105.  
  106.   rc = rxPDTerm(sGlobal.zBid)
  107.  
  108.   exit 0
  109.  
  110. /**********************************************************************\
  111.  rDoEdit:
  112.   This routine displays a dialog panel for the file.
  113. \**********************************************************************/
  114. rDoEdit:
  115. parse arg sGlobal.zBid
  116.   DROP sFlRecs.
  117.   Call rLoadFileStem
  118.   Call rLoadPDStem
  119.  
  120.   do FOREVER
  121.  
  122.    akey = ZESC
  123.    ZCMD = ''
  124.    ZAMT = 'CSR'
  125.  
  126.    do while akey = ZESC
  127.     akey = rxPDDisplay(sGlobal.zBid, 'PANEL001', sGlobal.sCursorFld, sGlobal.iCursorNdx)
  128.     parse var ZCurVar ziCol zFld
  129.     sGlobal.sCursorFld = zFld
  130.     sGlobal.iCursorNdx = ziCol
  131.     if aKey = ZESC then
  132.      do
  133.       Call rLoadPDStem
  134.      end
  135.    end /*do while akey = ZESC*/
  136.  
  137.    sGlobal.iMDTCnt = rxPDQueryMDT(sGlobal.zBid,'PANEL001')
  138.    if sGlobal.iMDTCnt > 0 then
  139.     do
  140.      sGlobal.fModifiedQ = 'Y'
  141.     end
  142.  
  143.    select
  144.     when akey = ZENTER then
  145.      do
  146.       Call rDoENTER
  147.      end
  148.     when akey = Z_S_A then
  149.      do
  150.       Call rDoSAVE
  151.      end
  152.     when akey = Z_C_A then
  153.      do
  154.       Call rDoCLEAR
  155.      end
  156.     when akey = ZF3_A then
  157.      do
  158.       sGlobal.fModifiedQ = 'N'
  159.       return 8
  160.      end
  161.     when akey = ZF4_A then
  162.      do
  163.       return 8
  164.      end
  165.     otherwise
  166.      do
  167.       Call rSiren 4,3
  168.       sGlobal.sCursorFld='ZCMD'
  169.       sGlobal.iCursorNdx=0
  170.      end
  171.    end /* select */
  172.  
  173.   end /*do FOREVER */
  174.  
  175.   return 0;
  176.  
  177. /**********************************************************************\
  178.  rDoENTER
  179.   Routine to handle ENTER
  180. \**********************************************************************/
  181. rDoENTER:
  182.   if sGlobal.iMDTCnt = 0 then
  183.    do
  184.     return 0
  185.    end
  186.   select
  187.    when sGlobal.sCursorFld = 'sName' then
  188.     do
  189.      sGlobal.sCursorFld = 'sAddr1'
  190.      sGlobal.iCursorNdx = 0
  191.     end
  192.    when sGlobal.sCursorFld = 'sAddr1' then
  193.     do
  194.      sGlobal.sCursorFld = 'sAddr2'
  195.      sGlobal.iCursorNdx = 0
  196.     end
  197.    when sGlobal.sCursorFld = 'sAddr2' then
  198.     do
  199.      sGlobal.sCursorFld = 'sAddr3'
  200.      sGlobal.iCursorNdx = 0
  201.     end
  202.    when sGlobal.sCursorFld = 'sAddr3' then
  203.     do
  204.      sGlobal.sCursorFld = 'sCity'
  205.      sGlobal.iCursorNdx = 0
  206.     end
  207.    when sGlobal.sCursorFld = 'sCity' then
  208.     do
  209.      sGlobal.sCursorFld = 'sState'
  210.      sGlobal.iCursorNdx = 0
  211.     end
  212.    when sGlobal.sCursorFld = 'sState' then
  213.     do
  214.      sGlobal.sCursorFld = 'sCountry'
  215.      sGlobal.iCursorNdx = 0
  216.     end
  217.    when sGlobal.sCursorFld = 'sCountry' then
  218.     do
  219.      sGlobal.sCursorFld = 'sZip'
  220.      sGlobal.iCursorNdx = 0
  221.     end
  222.    when sGlobal.sCursorFld = 'sZip' then
  223.     do
  224.      sGlobal.sCursorFld = 'sEMail'
  225.      sGlobal.iCursorNdx = 0
  226.     end
  227.    when sGlobal.sCursorFld = 'sEMail' then
  228.     do
  229.      sGlobal.sCursorFld = 'iBS'
  230.      sGlobal.iCursorNdx = 0
  231.     end
  232.    when sGlobal.sCursorFld = 'iBS' then
  233.     do
  234.      sGlobal.sCursorFld = 'iRX'
  235.      sGlobal.iCursorNdx = 0
  236.     end
  237.    when sGlobal.sCursorFld = 'iRX' then
  238.     do
  239.      sGlobal.sCursorFld = 'iHL'
  240.      sGlobal.iCursorNdx = 0
  241.     end
  242.    when sGlobal.sCursorFld = 'iHL' then
  243.     do
  244.      sGlobal.sCursorFld = 'sHowAcquired'
  245.      sGlobal.iCursorNdx = 0
  246.     end
  247.    otherwise
  248.     do
  249.      sGlobal.sCursorFld = 'sName'
  250.      sGlobal.iCursorNdx = 0
  251.     end
  252.   end /*select*/
  253.   Call rDoCOMPUTE
  254.   return
  255.  
  256. /**********************************************************************\
  257.  rDoSAVE
  258.   Routine to handle SAVE
  259. \**********************************************************************/
  260. rDoSAVE:
  261.   sGlobal.fModifiedQ = 'N'
  262.   return rStoreFileStem()
  263.  
  264. /**********************************************************************\
  265.  rDoCLEAR
  266.   Routine to handle CLEAR
  267. \**********************************************************************/
  268. rDoCLEAR:
  269.   sGlobal.fModifiedQ = 'Y'
  270.   sName = ''
  271.   sAddr1 = ''
  272.   sAddr2 = ''
  273.   sAddr3 = ''
  274.   sCity = ''
  275.   sState = ''
  276.   sCountry = ''
  277.   sZip = ''
  278.   sEMail = ''
  279.   sHowAcquired = ''
  280.   iBS = 0
  281.   iRX = 0
  282.   iHL = 0
  283.   Call rDoCOMPUTE
  284.   return 0
  285.  
  286. /**********************************************************************\
  287.  rDoCOMPUTE
  288.   Routine to handle COMPUTE
  289. \**********************************************************************/
  290. rDoCOMPUTE:
  291.   iTBS = FORMAT(iBS * sGlobal.iBSFctr,6,2)
  292.   iTRX = FORMAT(iRX * sGlobal.iRXFctr,6,2)
  293.   iTHL = FORMAT(iHL * sGlobal.iHLFctr,6,2)
  294.   iTotal = iTBS + iTRX + iTHL
  295.   iTotal = FORMAT(iTotal,6,2)
  296.   return 0
  297.  
  298. /**********************************************************************\
  299.  rLoadPDStem:
  300.   This routine loads the display variables from the file stem.
  301. \**********************************************************************/
  302. rLoadPDStem:
  303.   if sGlobal.fDebug = 'RLOADPDSTEM' then
  304.    do
  305.     Call Trace ?r
  306.    end
  307.   iAddr = 0
  308.   do i = 1 to sFlRecs.0
  309.    parse var sFlRecs.i sFld': 'sVal
  310.    select
  311.     when 'Name .' = LEFT(sFld,6) then
  312.      do
  313.       sName = sVal
  314.      end
  315.     when 'Address .' = LEFT(sFld,9) then
  316.      do
  317.       iAddr  = 1
  318.       sAddr1 = sVal
  319.      end
  320.     when '' = sFld then
  321.      do
  322.       if iAddr > 0 & iAddr < 3 then
  323.        do
  324.         iAddr  = iAddr + 1
  325.         INTERPRET 'sAddr'iAddr' = sVal'
  326.        end
  327.      end
  328.     when 'City .' = LEFT(sFld,6) then
  329.      do
  330.       sCity = sVal
  331.      end
  332.     when 'State .' = LEFT(sFld,7) then
  333.      do
  334.       sState = sVal
  335.      end
  336.     when 'Country .' = LEFT(sFld,9) then
  337.      do
  338.       sCountry = sVal
  339.      end
  340.     when 'Zip/Post' = LEFT(sFld,8) then
  341.      do
  342.       sZip = sVal
  343.      end
  344.     when 'EMail ID' = LEFT(sFld,8) then
  345.      do
  346.       sEMail = sVal
  347.      end
  348.     when 'PDS Base' = LEFT(sFld,8) then
  349.      do
  350.       iBS = STRIP(WORD(sVal,1))
  351.       if DATATYPE(iBS) <> 'NUM' then
  352.        do
  353.         iBS = 0
  354.        end
  355.      end
  356.     when 'PDS REXX' = LEFT(sFld,8) then
  357.      do
  358.       iRX = STRIP(WORD(sVal,1))
  359.       if DATATYPE(iRX) <> 'NUM' then
  360.        do
  361.         iRX = 0
  362.        end
  363.      end
  364.     when 'PDS HLL ' = LEFT(sFld,8) then
  365.      do
  366.       iHL = STRIP(WORD(sVal,1))
  367.       if DATATYPE(iHL) <> 'NUM' then
  368.        do
  369.         iHL = 0
  370.        end
  371.      end
  372.     when 'Acquired' = LEFT(sFld,8) then
  373.      do
  374.       sHowAcquired = sVal
  375.      end
  376.     otherwise
  377.      do
  378.      end
  379.    end /*select*/
  380.   end /*do i = 1 to sFlRecs.0*/
  381.   Call rDoCOMPUTE
  382.   return 0;
  383.  
  384. /**********************************************************************\
  385.  rLoadFileStem:
  386.   This routine loads the file stem variable.
  387. \**********************************************************************/
  388. rLoadFileStem:
  389.   if sGlobal.fDebug = 'RLOADFILESTEM' then
  390.    do
  391.     Call Trace ?r
  392.    end
  393.   DROP sFlRecs.
  394.   i = 0
  395.   sFlRecs.0 = i
  396.   if sGlobal.sFileSpec <> '' then
  397.    do
  398.     state = stream(sGlobal.sFileSpec,'c','query exists')
  399.     if state <> '' then
  400.      do
  401.       sGlobal.sFileSpec = state        /* Fully qualified file name */
  402.       rc = rOpenFlSpec(sGlobal.sFileSpec)
  403.       if rc <> 0 then
  404.        do
  405.         return 8
  406.        end
  407.       sEOF='EOF>>'||sGlobal.sFileSpec||'<<EOF'
  408.       sRec = rGetFileRec(sGlobal.sFileSpec,sEOF)
  409.       do while sRec <> sEOF
  410.        if 0 < POS(':',sRec) then
  411.         do
  412.          i = i + 1
  413.          sFlRecs.i = STRIP(sRec)
  414.         end
  415.        sRec = rGetFileRec(sGlobal.sFileSpec,sEOF)
  416.       end /*do while sRec <> sEOF*/
  417.       rc = rCloseFlSpec(sGlobal.sFileSpec)
  418.      end
  419.    end
  420.   sFlRecs.0 = i
  421.   return 0
  422.  
  423. rGetFileRec: Procedure
  424. parse arg sGetFile, sEOF
  425.   if 0 = lines(sGetFile) then
  426.    return sEOF
  427.   rec = linein(sGetFile)
  428.   do while '' = rec
  429.    if 0 = lines(sGetFile) then
  430.     return sEOF
  431.    rec = linein(sGetFile)
  432.   end
  433.   return rec
  434.  
  435. /**********************************************************************\
  436.  rStoreFileStem:
  437.   This routine store the file stem variable.
  438. \**********************************************************************/
  439. rStoreFileStem:
  440.   if sGlobal.fDebug = 'RSTOREFILESTEM' then
  441.    do
  442.     Call Trace ?r
  443.    end
  444.   i = 1
  445.   if sGlobal.sFileSpec = '' then
  446.    do
  447.     Call BEEP 882, 40
  448.     return 4
  449.    end
  450.   rc = rOpenFlSpec(sGlobal.sFileSpec,'REPL')
  451.   if rc <> 0 then
  452.    do
  453.     return 8
  454.    end
  455.   rc = rWriteForm(sGlobal.sFileSpec)
  456.   rc = rCloseFlSpec(sGlobal.sFileSpec)
  457.   return 0
  458.  
  459. /**********************************************************************\
  460.  rWriteForm:
  461.   This routine writes the form to disk
  462. \**********************************************************************/
  463. rWriteForm:
  464. parse arg sFS
  465.   iBS=FORMAT(iBS,4)
  466.   iBSF=FORMAT(sGlobal.iBSFctr,2,2)
  467.   iRX=FORMAT(iRX,4)
  468.   iRXF=FORMAT(sGlobal.iRXFctr,2,2)
  469.   iHL=FORMAT(iHL,4)
  470.   iHLF=FORMAT(sGlobal.iHLFctr,2,2)
  471.   Call rWriteFlSpec sFS,''
  472.   Call rWriteFlSpec sFS,''
  473.   Call rWriteFlSpec sFS,'                                Rick W. Hodgson'
  474.   Call rWriteFlSpec sFS,'                             1635 Village Glen Dr.'
  475.   Call rWriteFlSpec sFS,'                              Raleigh, NC  27612'
  476.   Call rWriteFlSpec sFS,'                                CIS: 76450,3137'
  477.   Call rWriteFlSpec sFS,''
  478.   Call rWriteFlSpec sFS,''
  479.   Call rWriteFlSpec sFS,'     Registration Form for the HSS Panel Display System V1.05:'
  480.   Call rWriteFlSpec sFS,''
  481.   Call rWriteFlSpec sFS,''
  482.   Call rWriteFlSpec sFS,'     Name ..........: 'sName
  483.   Call rWriteFlSpec sFS,'     Address .......: 'sAddr1
  484.   Call rWriteFlSpec sFS,'                    : 'sAddr2
  485.   Call rWriteFlSpec sFS,'                    : 'sAddr3
  486.   Call rWriteFlSpec sFS,'     City ..........: 'sCity
  487.   Call rWriteFlSpec sFS,'     State .........: 'sState
  488.   Call rWriteFlSpec sFS,'     Country .......: 'sCountry
  489.   Call rWriteFlSpec sFS,'     Zip/Postal Code: 'sZip
  490.   Call rWriteFlSpec sFS,''
  491.   Call rWriteFlSpec sFS,'     EMail ID ......: 'sEMail
  492.   Call rWriteFlSpec sFS,''
  493.   Call rWriteFlSpec sFS,''
  494.   Call rWriteFlSpec sFS,'                   Component          Count               Total'
  495.   Call rWriteFlSpec sFS,''
  496.   Call rWriteFlSpec sFS,'                 PDS Base system ...: 'iBS ' X $'iBSF'  'iTBS
  497.   Call rWriteFlSpec sFS,''
  498.   Call rWriteFlSpec sFS,'                 PDS REXX API ......: 'iRX ' X $'iRXF'  'iTRX
  499.   Call rWriteFlSpec sFS,''
  500.   Call rWriteFlSpec sFS,'                 PDS HLL API .......: 'iHL ' X $'iHLF'  'iTHL
  501.   Call rWriteFlSpec sFS,''
  502.   Call rWriteFlSpec sFS,''
  503.   Call rWriteFlSpec sFS,'                                          Total ...:  'iTotal
  504.   Call rWriteFlSpec sFS,''
  505.   Call rWriteFlSpec sFS,''
  506.   Call rWriteFlSpec sFS,'     In order to get a better idea of how to distribute shareware, I would'
  507.   Call rWriteFlSpec sFS,'     appreciate knowing the how you acquired this package. I.E. Compuserve,'
  508.   Call rWriteFlSpec sFS,'     Internet, OS/2 User''s Group, etc..'
  509.   Call rWriteFlSpec sFS,''
  510.   Call rWriteFlSpec sFS,'     Acquired via ..: 'sHowAcquired
  511.   Call rWriteFlSpec sFS,''
  512.   return 0
  513.  
  514. /**********************************************************************\
  515.  rOpenFlSpec:
  516.   This routine opens the file for processing and inits the pointer
  517. \**********************************************************************/
  518. rOpenFlSpec: Procedure Expose sGlobal.
  519. parse arg sFlSpec, sRepl
  520.   state = stream(sFlSpec,'c','open')
  521.   if state <> 'READY:' then
  522.    do
  523.     svid = rxPDSaveScreen(sGlobal.zBid)
  524.     rc = rxPDDisplay(sGlobal.zBid,'PUPOPENERR')
  525.     rc = rxPDRestoreScreen(sGlobal.zBid,svid)
  526.     return 8
  527.    end
  528.   if TRANSLATE(sRepl) = 'REPL' then
  529.    do
  530.     rc = LINEIN(sFlSpec,1,0)
  531.    end
  532.   return 0
  533.  
  534. /**********************************************************************\
  535.  rCloseFlSpec:
  536.   This routine closes the TSD
  537. \**********************************************************************/
  538. rCloseFlSpec:
  539. parse arg sFlSpec
  540.   state = stream(sFlSpec,'c','close')
  541.   return 0
  542.  
  543. /**********************************************************************\
  544.  rWriteFlSpec:
  545.   This routine sequentially writes the file
  546. \**********************************************************************/
  547. rWriteFlSpec:
  548. parse arg sFlSpec, sRec
  549.   err = lineout(sFlSpec,sRec)
  550.   if err <> 0 then
  551.    do
  552.     svid = rxPDSaveScreen(sGlobal.zBid)
  553.     rc = rxPDDisplay(sGlobal.zBid,'PUPWRITEERR')
  554.     rc = rxPDRestoreScreen(sGlobal.zBid,svid)
  555.     rc = rxPDTerm(sGlobal.zBid)
  556.     exit 256
  557.    end
  558.   return 0
  559.  
  560. HaltExit:
  561.   Call BEEP 882, 40
  562.   Call BEEP 882, 40
  563.   say 'PDSRGSTR processing halted by request;'
  564.   exit 0
  565.  
  566. ErrorExit:
  567.   Call BEEP 882, 40
  568.   Call BEEP 882, 40
  569.   say 'PDSRGSTR processing failed due to unknown error;'
  570.   exit 24
  571.  
  572. FailureExit:
  573.   Call BEEP 882, 40
  574.   Call BEEP 882, 40
  575.   say 'PDSRGSTR processing failed due to unknown failure;'
  576.   exit 32
  577.  
  578. SyntaxExit:
  579.   Call BEEP 882, 40
  580.   Call BEEP 882, 40
  581.   say 'PDSRGSTR processing failed due to syntax error;'
  582.   exit 64
  583.  
  584. rParseParms:
  585. parse arg p1
  586.  
  587.   do Forever
  588.    w1 = word(p1,1)
  589.    parse var w1 with "/" f1 ":" v1
  590.    select
  591.     when (w1 = '') then
  592.      do
  593.       return 0
  594.      end
  595.     when TRANSLATE(w1) = '/DEBUG' then
  596.      do
  597.       fDebugQ='Y'
  598.       p1 = SUBWORD(p1,2)
  599.      end
  600.     when TRANSLATE(f1) = 'D' then
  601.      do
  602.       fDebugQ = TRANSLATE(v1)
  603.       p1 = SUBWORD(p1,2)
  604.      end
  605.     when TRANSLATE(f1) = '?' then
  606.      do
  607.       fDispStax='Y'
  608.       fDispHelp='N'
  609.       p1 = SUBWORD(p1,2)
  610.      end
  611.     when TRANSLATE(f1) = 'H' then
  612.      do
  613.       fDispStax='N'
  614.       fDispHelp='Y'
  615.       p1 = SUBWORD(p1,2)
  616.      end
  617.     otherwise
  618.      do
  619.       select
  620.        when fFlSpecQ <> 'Y' then
  621.         do
  622.          fFlSpecQ = 'Y'
  623.          sFlSpec = w1
  624.          p1 = SUBWORD(p1,2)
  625.         end
  626.        otherwise
  627.         do
  628.          Call rSiren 8, 1
  629.          say 'PDSRGSTR - Too many parms specified; Parm "'w1'" unknown;'
  630.          CALL rDispSyntax 0 8
  631.         end
  632.       end /*select*/
  633.      end
  634.    end
  635.   end
  636.  
  637.   return 0
  638.  
  639. rDispSyntax: Procedure
  640. parse upper arg iHelp iExit
  641.  
  642.   say ' Syntax  : PDSRGSTR {<options>} {filespec}'
  643.   say '           PDSRGSTR {/?|/h}'
  644.   if iHelp > 0 then
  645.    do
  646.     CALL rDispHelp
  647.    end
  648.  
  649.   exit iExit
  650.  
  651. rDispHelp: Procedure
  652.  
  653.   say ' Parms   : filespec   - Alternate file name for the registration form.'
  654.   say ''
  655.   say ' Options : /?         - Display command syntax.'
  656.   say '           /h         - Display this help info.'
  657.   say ' Examples:'
  658.   say '    PDSRGSTR /h'
  659.   say ' '
  660.   say '    PDSRGSTR config.sys'
  661.  
  662.   return ''
  663.  
  664. /* rSiren: does the siren bit by running the scale based upon a       */
  665. /*    frequency specified by the caller.                              */
  666. rSiren: Procedure
  667.    Parse Arg freq, cycle
  668.    note.1 = 262 * freq /* middle C */
  669.    note.2 = 294 * freq /* D */
  670.    note.3 = 330 * freq /* E */
  671.    note.4 = 349 * freq /* F */
  672.    note.5 = 392 * freq /* G */
  673.    note.6 = 440 * freq /* A */
  674.    note.7 = 494 * freq /* B */
  675.    note.8 = 524 * freq /* C */
  676.    do j = 1 to cycle
  677.     call beep note.8,250 /* hold each note for a 1/4 second */
  678.     call beep note.1,250 /* hold each note for a 1/4 second */
  679.    end j
  680.    Return
  681.  
  682. rLoadFuncs:
  683. parse arg sREP, sDll, sRtn
  684.   rxrc = RxFuncAdd(sREP, sDll, sRtn)
  685.   signal on syntax name xLoadFuncs
  686.   interpret 'Call 'sRtn
  687.   return 0
  688.  
  689. xLoadFuncs:
  690.   return 127
  691.