Advertisement
Guest User

qup

a guest
Apr 3rd, 2017
247
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Rexx 20.96 KB | None | 0 0
  1. /*define $Version 1.1.1 */
  2. /*:C#Update Q's via AUTHOR.                                            */
  3. /* ========================= Program History ========================= */
  4. /* What  Who           When      Why                                   */
  5. /* ------------------------------------------------------------------- */
  6. /* Org - P Foster   -  15/01/90                                        *
  7.  * Mod -                                                               */
  8. /* =================================================================== */
  9. /*                                                                     */
  10. parse arg Task Rest;
  11. GoodTask=0;
  12. if Task ^= '' then Upper Task;
  13. if abbrev('ADD',Task,1)    then do;
  14.   GoodTask=1;
  15.   Task='ADD';
  16. end
  17. if abbrev('LIST',Task,1)   then do;
  18.   GoodTask=1;
  19.   Task='LIST';
  20. end
  21. if abbrev('QLIST',Task,1)   then do;
  22.   GoodTask=1;
  23.   Task='QLIST';
  24. end
  25. if abbrev('DELETE',Task,1) then do;
  26.   GoodTask=1;
  27.   Task='DELETE';
  28. end
  29. if abbrev('UPDATE',Task,1) then do;
  30.   GoodTask=1;
  31.   Task='UPDATE';
  32. end
  33. Call AccessDisks;
  34. Call Initialise;
  35. CanAdd=0;
  36. CanDel=0;
  37. Call AuthChk 'A' 'D'
  38.  
  39. do forever;
  40.   if ^GoodTask then Task=GetTask();        /* Get a task if necessary. */
  41.  
  42.   select;
  43.     when Task='ADD'    & CanAdd then Call Add;
  44.     when Task='DELETE' & CanDel then Call Delete;
  45.     when Task='UPDATE' & CanAdd & CanDel then Call Update;
  46.     when Task='LIST'   then Call List;
  47.     when Task='QLIST'  then Call QList;
  48.     otherwise nop;
  49.   end;
  50.   GoodTask=0;                          /* Force point & grunt menu.    */
  51.  
  52. end;
  53.  
  54. exit;
  55.  
  56. Add:
  57. /* Add a new queue                                                     */
  58. if ^CanAdd then return 4;
  59. Call LockFile;                         /* Lock the file.               */
  60. if Result ^= 0 then return;
  61. address PinExec 'EXEC STORIT 16';
  62. address command 'DIMAN QADD PINFORM';
  63. Src=Rc
  64. Call UnLockFile;
  65. if Src^=0 then return 4;
  66. address PinExec 'Refresh';
  67. if Src=0 then Call Respond 'added';
  68. Return;
  69.  
  70. Delete:
  71. if ^CanDel then return 4;
  72. Call GetQName 'D'                      /* Get the Queue name from billy*/
  73. if Result ^= 0 then return;
  74. address PinExec 'Command $LOG Field2Id Qt Queued to';
  75. address PinExec 'Command $LOG Field2Id Id Status';
  76. address PinExec 'Command Open LG';
  77. address PinExec "Command Search ('"Qt]]QName"')" Id]]'OP-';
  78. address PinExec 'Command Extract TotHits';
  79. if TotHits.1 ^= 0 then do;
  80.   if TotHits.1=1 then ss='';
  81.   else ss='s';
  82.   'WClear';
  83.   'WToggle';
  84.   'WPut Unable to delete "'strip(QName)'".'
  85.   'WPut This queue has 'TotHits.1' open log'ss' queued to it.';
  86.   'WToggle';
  87.   'WPut ';
  88.   'WPut Press Enter to continue.';
  89.   'WWait';
  90.   address PinExec 'Return';
  91.   return;
  92. end;
  93. Call LockFile;                         /* Lock the file.               */
  94. if Result ^= 0 then return;
  95. Call DeleteQ;                          /* Get rid of the queue.        */
  96. if Result ^= 0 then return;
  97. Call UnLockFile;                       /* Unlock the file.             */
  98. Call Respond 'deleted';
  99. return
  100.  
  101. Update:
  102. address command 'QERASE $$NEWQ TEMPWORK A';
  103. address command 'QERASE $$QCAT TEMPWORK A';
  104. address command 'QERASE $$QUPD TEMPWORK A';
  105. address command 'QERASE $$QINF TEMPWORK A';
  106. Call GetQName 'U'                      /* Get the Queue name from billy*/
  107. if Result ^= 0 then return;            /* this returns the q in RCD.   */
  108. Call FindRecord QName;                 /* Get the statement number.    */
  109. if Result ^= 0 then return;
  110. Call LockFile;                         /* Lock the sucker.             */
  111. if Result ^= 0 then return;
  112. address command 'GLOBALV SELECT QUPD SET STATEMENT 'Statement;
  113. do i=1 to Rcd.0                        /* Split up the q details.      */
  114.   Parse value Rcd.i with . '"'Content'"' Rest;
  115.   address command 'EXECIO 1 DISKW $$NEWQ TEMPWORK A (STR 'Content;
  116.   select
  117.     when i=3 then do until words(Rest)=0;  /* If more than one rcd,    */
  118.       Parse var Rest '"'Content'"' Rest;  /* put 'em in a workfile.    */
  119.       if strip(Content)^='' then,
  120.       address command 'EXECIO 1 DISKW $$QCAT TEMPWORK A (STR 'Content;
  121.     end
  122.     when i=4 then do until words(Rest)=0;
  123.       Parse var Rest '"'Content'"' Rest;
  124.       if strip(Content)^='' then,
  125.       address command 'EXECIO 1 DISKW $$QUPD TEMPWORK A (STR 'Content;
  126.     end
  127.     when i=5 then do until words(Rest)=0;
  128.       Parse var Rest '"'Content'"' Rest;
  129.       if strip(Content)^='' then,
  130.       address command 'EXECIO 1 DISKW $$QINF TEMPWORK A (STR 'Content;
  131.     end
  132.     otherwise nop
  133.   end;
  134. end;
  135. address command 'FINIS * TEMPWORK A';
  136. address PinExec 'EXEC STORIT 16'
  137. address command 'DIMAN QUPD PINFORM';
  138. Src=Rc
  139. Call UnLockFile;
  140. if Src^=0 then return 4;
  141. Call Respond 'updated';
  142. return
  143.  
  144. QList:
  145. do forever
  146.   Call GetQName 'L';                   /* Get the Queue name from billy*/
  147.   if Result ^= 0 then return;
  148. end;
  149. return;
  150.  
  151. List:
  152. Fm = substr(LqFm,1,1);
  153. address command 'SET CMSTYPE HT';
  154. address command 'CONDACC 'Fm;
  155. address command 'SET CMSTYPE RT';
  156. address command 'EXECIO * DISKR LOGQ NAMES (FINIS STEM LQUEUE.';
  157. if Rc ^= 0 then do
  158.   'WClear';
  159.   'WPut Error 4:'Rc' during list queues.'
  160.   'WPut Contact support.';
  161.   exit;
  162. end;
  163. c=0;
  164. do i=1 to LQueue.0
  165.   Msg='search $authfile(logq) qname('''APost(LQueue.i)''') manager(?)';
  166.   Call AuthCom Msg;
  167.   Reply = translate(AuthCom_Reply,']"',d2c(1)d2c(2));
  168.   Reply = substr(Reply,2,length(Reply)-1);           /* remove ] */
  169.   c=c+1
  170.   parse var Reply x ']' Reply;                     /* get pair */
  171.   parse var x y '"' x
  172.   DLine.c=left(LQueue.i,21)]]x
  173. end;
  174. DLine.0=c
  175. X='DLine';
  176. Y='List of queues.';
  177. Z='Queue Name           Manager';
  178. Call WindMan X , Y , Z;
  179. return;
  180.  
  181. /*                                                                     */
  182. /* Give the punter a list of options to choose from.                   */
  183. /*                                                                     */
  184. GetTask: Procedure Expose CanAdd CanDel;
  185. n=0
  186. do i=1 to 5;
  187.   if i=1 & CanAdd then do;
  188.     n=n+1;
  189.     Page.n='Add a queue.';
  190.     Command.n='ADD';
  191.   end;
  192.   if i=2 & CanDel then do;
  193.     n=n+1;
  194.     Page.n='Delete a queue.';
  195.     Command.n='DELETE';
  196.   end
  197.   if i=3 & CanDel & CanAdd then do;
  198.     n=n+1;
  199.     Page.n='Update a queue.';
  200.     Command.n='UPDATE';
  201.   end
  202.   if i=4 then do;
  203.     n=n+1;
  204.     Page.n='List all the queues.';
  205.     Command.n='LIST';
  206.   end;
  207.   if i=5 then do;
  208.     n=n+1;
  209.     Page.n='List the contents of a queue.';
  210.     Command.n='QLIST';
  211.   end;
  212. end;
  213. Page.0=n;
  214. Page_Title = 'Queue Maintenance.';
  215. Page_Name  = 'an option';
  216. address command 'PAGE';
  217. if Rc^=0 then do;
  218.   address command 'QERASE $$NEWQ TEMPWORK A';
  219.   address command 'QERASE $$QCAT TEMPWORK A';
  220.   address command 'QERASE $$QUPD TEMPWORK A';
  221.   address command 'QERASE $$QINF TEMPWORK A';
  222.   exit;
  223. end;
  224. Return Command.Page_LineNo;
  225.  
  226. AccessDisks: Procedure;
  227. /*                                                                     */
  228. /* Ensure that we have access to the latest version of the necessary   */
  229. /* minidisks.                                                          */
  230. /*                                                                     */
  231. address command 'CONDACC E'
  232. address command 'CONDACC M';
  233. Return;
  234.  
  235. Initialise: Procedure Expose ServerId LqFm;
  236. /* Get necessary disks.                                                */
  237. /*                                                                     */
  238. address command 'EXEC ACE';                /* need access to parm file */
  239. address command 'EXEC GETC Q';                 /* cos its written in C */
  240. address command 'GETPARM AUTHOR AUTHOR_ID';             /* get user id */
  241. if Rc^=0 then Do
  242.   'WPut Unable to access AUTHOR PARMFILE.';
  243.   Call ErrorExit;
  244. end;
  245. pull ServerId;                                    /* save auth user id */
  246. address command 'QSTATE LOGQ NAMES *';
  247. if Rc ^= 0 then do;
  248.   address command 'GETFMADR'
  249.   if Rc ^= 0 then do
  250.     'WClear';
  251.     'WPut Error 1:'Rc' during initialisation.'
  252.     'WPut Contact support.';
  253.     exit;
  254.   end;
  255.   pull . LqFm Cuu;
  256.   address command 'QCP LINK 'ServerId' 400 'Cuu' RR ALL';
  257.   if Rc ^= 0 then do
  258.     'WClear';
  259.     'WPut Error 2:'Rc' during initialisation.'
  260.     'WPut Contact support.';
  261.     exit;
  262.   end;
  263.   address command 'SET CMSTYPE HT';
  264.   address command 'ACCESS 'Cuu LqFm;
  265.   SRc = Rc;
  266.   address command 'SET CMSTYPE RT';
  267.   if SRc ^= 0 then do
  268.     'WClear';
  269.     'WPut Error 3:'Rc' during initialisation.'
  270.     'WPut Contact support.';
  271.     exit;
  272.   end;
  273. end;
  274. else do
  275.   address command 'FEXTRACT LOGQ NAMES *'
  276.   LqFm=substr(Fextract_FileMode,1,1)
  277. end;
  278. return;
  279.  
  280. AuthCom: Procedure Expose ServerId AuthCom_Reply
  281. /*----------------------------------------------------------------*
  282. * Function  - Communicate with AUTHOR machine.                    *
  283. * Input Parameters:                                               *
  284. *      Command line is passed to AUTHOR.                          *
  285. *      AUTHOR_REPLY is set to reply.                              *
  286. * Exits                                                           *
  287. *      rc=0  Normal Return                                        *
  288. *      rc>0  Error communicating with AUTHOR.                     *
  289. *P Foster 02/04/90: Change call for Rename to NewName.            *
  290. *----------------------------------------------------------------*/
  291. parse arg Msg;
  292. address command 'AUTHCOM 'ServerId Msg;
  293. if Rc^=0 then Do
  294.   'WClear';
  295.   'WPut Error communicating with the 'ServerId' server.';
  296.   Call ErrorExit;
  297. end;
  298. return Rc;
  299.  
  300. AuthChk: Procedure Expose ServerId CanAdd CanDel;
  301. arg List , Opt;
  302. ACnt=words(List)
  303. Error=0
  304. do while words(List) ^= 0
  305.   parse var List Type List
  306.   select
  307.     when Type = 'A' then Word = 'add'
  308.     when Type = 'D' then Word = 'delete'
  309.     when Type = 'U' then Word = 'update'
  310.     otherwise Word = 'list';
  311.   end;
  312.   select
  313.     when Type = 'A' then Msg = 'qadd $filename(logq)'
  314.     when Type = 'D' then Msg = 'qdelete $filename(logq)'
  315.     otherwise Msg = 'list';
  316.   end;
  317.   Call AuthCom Msg                                  /* see if authorised */
  318.   if Authcom_Reply = 'Not authorised' then do;
  319.     'WClear';
  320.     'WPut You are not authorised to 'Word' queues.'
  321.     'WPut Press Enter to continue.';
  322.     Error=1;
  323.   end;
  324.   else do
  325.     select
  326.       when Type='A' then CanAdd=1;
  327.       when Type='D' then CanDel=1;
  328.       otherwise nop
  329.     end;
  330.   end;
  331.   'WClear';
  332. end;
  333. if Error then return 4;
  334. return 0;
  335.  
  336. /*----------------------------------------------------------------*
  337. *                              Lock file.                         *
  338. *----------------------------------------------------------------*/
  339. LockFile: Procedure Expose ServerId AuthCom_Reply;
  340. Call AuthCom 'lock $authfile(logq)';
  341. if Authcom_Reply ^= 'OK' then do;
  342.   'WClear';
  343.   'WToggle';
  344.   'WPut Unable to lock Log Queue file.';
  345.   'WToggle';
  346.   'WPut 'AuthCom_Reply;
  347.   'WToggle';
  348.   'WPut Press Enter to continue.';
  349.   'WWait';
  350.   'WClear';
  351.   Return 4;
  352. End;
  353. 'WClear';
  354. Return 0;
  355.  
  356. GetQName: Procedure Expose Statement Rcd. ServerId,
  357.           AuthCom_Reply QName LorD;
  358. arg LorD;
  359. ErrorMsg='';
  360. do forever;
  361.   'WClear';
  362.   if ErrorMsg^='' then 'WPut 'ErrorMsg;  /* Display error, if necessary*/
  363.   ErrorMsg='';
  364.   'WToggle';
  365.   'WPut Enter the name of the queue.           ';
  366.   'WPut Press PF3 to quit.';
  367.   'WRead';
  368.   'WClear';
  369.   if Window_Key = 'PF03' then return 4;
  370.   if Window_Line= '' then ErrorMsg='You didn''t enter a queue name!';
  371.   else do;
  372.     QName = APost(Window_Line);
  373.     Msg = 'search $authfile(logq) qname('''QName''') manager(?)';
  374.     Call AuthCom Msg
  375.     if strip(AuthCom_Reply) = 'Not found' then,
  376.        ErrorMsg='Queue "'space(Window_Line,1)'" does not exist!';
  377.     else do;
  378.       Call Detail QName;
  379.       LorD='';
  380.       return Result
  381.     end
  382.   end
  383. End;
  384.  
  385. Apost: Procedure;
  386. /*Strip " from string and convert ' to ''                             */
  387. Parse Arg String;
  388. String = Space(Translate(String,' ','_'),1);
  389. NewString='';
  390. do i=1 to length(String)
  391.   c=substr(String,i,1);                /* Isolate character            */
  392.   if c^='"' then NewString=NewString]]c;  /* Strip " as C don't like   */
  393.   if c = "'" then NewString = NewString ]] "'";  /* Double up quotes.  */
  394. end;
  395. return space(NewString,1);
  396.  
  397. /*----------------------------------------------------------------*
  398. *             Find the stmt   number of the queue record.         *
  399. *----------------------------------------------------------------*/
  400. FindRecord: Procedure Expose QName ServerId AuthCom_Reply Statement;
  401. parse arg QName;
  402. Msg = 'search $authfile(logq) qname('''QName''') $stmt_no(?)';
  403. Call AuthCom Msg;
  404. if substr(Authcom_Reply ,2, 8) ^= '$STMT_NO' then do;
  405.   Call AuthCom 'unlock $authfile(logq)';     /* unlock file */
  406.   'WClear';
  407.   'WToggle';
  408.   'WPut Unable to find queue "'QName'".';
  409.   'WPut Press Enter to continue.';
  410.   'WWait';
  411.   'WClear';
  412.   Return 4;
  413. End;
  414. 'WClear';
  415. Statement = substr(Authcom_Reply,11,4)+0;      /* get statement number */
  416. Return 0;
  417.  
  418. /*----------------------------------------------------------------*
  419. *                        Now delete statement.                    *
  420. *----------------------------------------------------------------*/
  421. DeleteQ: Procedure Expose QName Statement ServerId AuthCom_Reply;
  422. Call FindRecord QName;
  423. if result ^= 0 then return 4;
  424. Call AuthCom 'delete $authfile(logq) $stmt_number(' Statement ')';
  425. if AuthCom_Reply ^= 'OK' then do;
  426.   Call AuthCom 'unlock $authfile(logq)';     /* unlock file */
  427.   'WClear';
  428.   'WToggle';
  429.   'WPut Unable to delete "'QName'".';
  430.   'WPut Please call the helpdesk.';
  431.   'WPut Press Enter to continue.';
  432.   'WWait';
  433.   'WClear';
  434.   Return 4;
  435. End;
  436. 'WClear';
  437. return 0;
  438.  
  439. /*----------------------------------------------------------------*
  440. *                        unlock the logq file.                    *
  441. *----------------------------------------------------------------*/
  442. UnLockFile: Procedure Expose AuthCom_Reply ServerId;
  443. Call AuthCom 'unlock $authfile(logq)';                  /* unlock file */
  444. if AuthCom_Reply ^= 'OK' then do;
  445.   'WClear';
  446.   'WToggle';
  447.   'WPut Unable to unlock the Log Queue file.';
  448.   'WPut Please inform the helpdesk.';
  449.   'WPut Press Enter to continue.';
  450.   'WWait';
  451.   'WClear';
  452.   Return 4;
  453. End;
  454. 'WClear';
  455. return 0;
  456.  
  457. /* window manager */
  458. WindMan:
  459. parse arg VN , Title , Title2;
  460. interpret 'Lines='VN'.0' ;
  461.  
  462. /* Find longest line */
  463. TL = 0 ;                                /* window width               */
  464. SC = 1 ;                                /* start column               */
  465. Do I = 1 to Lines ;
  466.  interpret 'Text='VN'.'I ;
  467.  If Length(Text) > TL then TL = Length(Text) ;
  468. End ;
  469.  
  470. If Lines > 13 then WL = 13 ;
  471. Else Wl = Lines ;                       /* Window length              */
  472. if Title2^='' then Wl=Wl-1;
  473. If TL    > 56 then WW = 56 ;
  474. Else WW = TL ;                          /* Window width               */
  475. If WW < 38 then WW=38;                  /* ensure room for PFKs       */
  476. Topline = 1 ;                           /* first line to display      */
  477. TTl=Right(Title,Length(Title)%2+(WW%2)) ; /* Centre title             */
  478. Bar=Copies('-',WW) ;                    /* build line of dashes       */
  479.  
  480. Do forever ;
  481.  'WCLEAR' ;                             /* ensure new window          */
  482.  'WPUT' TTl ;                           /* put title                  */
  483.  if Title2^='' then 'WPut 'Title2;
  484.  'WPUT' Bar ;                           /* put title                  */
  485.  'WTOGGLE' ;                            /* toggle to dim              */
  486.  
  487.  Do I = 1 to WL ;                       /* Do each line               */
  488.   J = TopLine+I-1 ;                     /* text line number           */
  489.   If J > Lines then Text = '' ;         /* pad window at botom of win */
  490.   Else interpret 'Text='VN'.'J ;        /* Get text of line           */
  491.   Text=SubStr(Text,SC) ;                /* get right part of text     */
  492.   Text=left(Text,WW) ;                  /* trunc if necessary         */
  493.   'WPUT' Text ;                         /* Put text in window         */
  494.  End ;
  495.  
  496.  If Lines <  14 & TL ^> WW then Return ; /* one panel holds all       */
  497.  PFLine = 'PF3=End' ;
  498.  If SC=1 & TL > 54 then PFLine=PFLine 'PF4=Right' ; /* allow right    */
  499.  Else if SC>1 then PFLine=PFLine 'PF4=Left' ; /* allow left           */
  500.  If Topline > 1 then PFLine=PFLine 'PF7=Prev' ; /* allow prev         */
  501.  If TopLine+14 ^> Lines then PFLine = PFLine 'PF8=Next' ; /* allow ne */
  502.  PFLine = 'PF2=Detail ']] PFLine;
  503.  'WTOGGLE' ;                            /* Bright                     */
  504.  'WPUT' Bar ;                           /* a bar                      */
  505.  'WPUT' PFLine ;                        /* put PFK line               */
  506.  'WWAIT' ;                              /* Wait for Billy             */
  507.  
  508.  Select ;
  509.   When Window_Key = 'PF03' then Leave ; /* PF3                        */
  510.   When Window_Key = 'PF04' then Call RightLeft ; /* Right/Left        */
  511.   When Window_Key = 'PF07' then TopLine=TopLine-13 ; /* prev          */
  512.   When Window_Key = 'PF08' then TopLine=TopLine+13 ; /* next          */
  513.   When Window_Key = 'PF02' then do;
  514.     Call GetWinQ;
  515.     if result=0 then Call Detail QName;
  516.   end;
  517.   Otherwise 'WBeep';
  518.  End ;
  519.  If TopLine < 1 then TopLine = 1 ;
  520.  If TopLine > Lines then TopLine = TopLine-13 ;
  521.  
  522. End ;
  523.  
  524. 'WCLEAR' ;
  525. return ;
  526.  
  527. RightLeft:
  528. /*----------------------------------------------------------------*
  529. *                  Right/Left                                     * ;
  530. *----------------------------------------------------------------*/ ;
  531. If TL<55 then Return ;                  /* all text shown             */
  532. If SC=1 then SC=TL-54+1 ;               /* show right                 */
  533. Else SC=1 ;                             /* Show left                  */
  534. Return ;
  535.  
  536. Respond: Procedure;
  537. parse arg What;
  538. 'WSelect 2';
  539. 'WClear';
  540. 'WToggle';
  541. 'WPut The queue has been successfully 'What'.';
  542. 'WPut Press Enter to continue.';
  543. 'WWait';
  544. 'WClear';
  545. 'WSelect 1';
  546. return
  547.  
  548. /* Come here to exit after an error.                                   */
  549. ErrorExit:
  550. 'WPut Please notify the helpdesk.';
  551. 'WPut Press Enter to continue.';
  552. 'WWait';
  553. exit;
  554.  
  555. Detail:
  556. parse arg QName;
  557. c=0;
  558. /* First get the QName as it exists on AUTHOR.                         */
  559. Msg = 'search $authfile(logq) qname('''QName''') $STMT_NO(?)'
  560. Call AuthCom Msg
  561. if rc=0 then do;
  562.   AuthCom_Reply  = strip(AuthCom_Reply);
  563.   if AuthCom_Reply ^='' & AuthCom_Reply ^= 'Not_found' then do;
  564.     parse var AuthCom_Reply  '01'x . '02'x  Sn;
  565.     Msg = 'search $authfile(logq) $stmt_no('Sn') qname(?)'
  566.     Call AuthCom Msg
  567.     if rc=0 then do;
  568.       AuthCom_Reply  = strip(AuthCom_Reply);
  569.       if AuthCom_Reply ^='' & AuthCom_Reply ^= 'Not found' then,
  570.       parse var AuthCom_Reply  '01'x . '02'x QName;
  571.     end;
  572.   end;
  573. end;
  574. do p=1 to 5                      /* Get the components of the Q  */
  575.   Msg = 'search $authfile(logq) qname('''QName''') '
  576.   select
  577.     when p=1 then Msg=Msg 'manager(?)'
  578.     when p=2 then Msg=Msg 'queuers(?)'
  579.     when p=3 then Msg=Msg 'updaters(?)'
  580.     when p=4 then Msg=Msg 'inform(?)'
  581.     when p=5 then Msg=Msg 'comment(?)'
  582.     otherwise nop;
  583.   end;
  584.   Call AuthCom Msg
  585.   if strip(AuthCom_Reply)='' then do;
  586.     if p=5  then AuthCom_Reply = '01'x 'comment' '02'x '   '
  587.   end;
  588.   if strip(AuthCom_Reply)='Not found' then iterate p;
  589.   Reply = translate(AuthCom_Reply,']"',d2c(1)d2c(2));
  590.   Reply = substr(Reply,2,length(Reply)-1);           /* remove ] */
  591.   do while words(Reply) > 0;
  592.     parse var Reply x ']' Reply;                     /* get pair */
  593.     parse var x y '"' x
  594.     y=strip(y);
  595.     c=c+1;
  596.     Line.c=left(y ]] ':',9);
  597.     do while words(x) > 0;
  598.       parse var x y '"' x;
  599.       y='"' ]] strip(y) ]] '"';
  600.       if length(Line.c) + (length(y)+2) <= 53 then,
  601.          Line.c = Line.c y;
  602.       else do;
  603.         c=c+1;
  604.         Line.c = left(' ',9) y;
  605.       end;
  606.     end;
  607.   end;
  608. end;
  609. 'WClear'
  610. if LorD='U' then do;             /* Update - populate Rcd.       */
  611.   q=1
  612.   Rcd.q='qname "'QName'"';
  613.   do v=1 to c;
  614.     if strip(substr(Line.v,1,10))='' then Rcd.q=Rcd.q Line.v
  615.     else do
  616.       q=q+1;
  617.       Rcd.q=Line.v;
  618.     end;
  619.   end;
  620.   Rcd.0=q;
  621.   return 0;
  622. end;
  623. if LorD='D' then,
  624.    'WPut 'centre('Delete the "'QName'" queue?',52);
  625. else,
  626.    'WPut  'centre('Settings of "'QName'" queue.',52);
  627. 'WToggle';
  628. 'WPut ----------------------------------------------------';
  629. do i=1 to c;
  630.   'WPut 'Line.i
  631. end;
  632. 'WPut ----------------------------------------------------';
  633. 'WToggle';
  634. if LorD='D' then,
  635.    'WPut Enter Y to delete this queue, anything else to quit.';
  636. else do
  637.    'WPut Press Enter to quit.';
  638.    'WWait';
  639.    return 0;
  640. end;
  641. 'WRead';
  642. if Window_Key='PF03' then return 4
  643. Ans=Window_Line;
  644. upper Ans
  645. if abbrev('YES',strip(Ans),1) then return 0;
  646. Return 4;
  647.  
  648. GetWinQ: Procedure Expose QName Window_Cursor;
  649. LineNum=strip(SubWord(Window_Cursor,1,1),'L','0');
  650. if LineNum < 4 ] LineNum > 15 then do
  651.   Call NoQueue;
  652.   return 4;
  653. end;
  654. 'Extract Window';
  655. QName = strip(substr(Window.LineNum,1,21));
  656. if QName ^= '' then return 0;
  657. Call NoQueue;
  658. return 4;
  659.  
  660. NoQueue:
  661. 'WSelect 2'
  662. 'WClear';
  663. 'WPut Put the cursor on a queue, then press PF12.';
  664. 'WPut Press Enter to continue.';
  665. 'WWait'
  666. 'WClear';
  667. 'WSelect 1';
  668. return;
  669.  
  670. 
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement