* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * "If it's squinky, then you know it's BrilligWare!" * * * * * * * * Source available at http://pando.org/downloads * * * * Brillig Enterprises (aka Chris Pando) (C)2007 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * This work is licensed under a Creative Commons * * * * Attribution-NonCommercial-ShareAlike License: * * * * http://creativecommons.org/licenses/by-nc-sa/2.0/legalcode * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * The author disclaims all warranties with regard to this * * * * software, including all implied warranties of merchantability * * * * and fitness. In no event shall the author be liable for any * * * * special, indirect or consequential damages or any damages * * * * whatsoever resulting from loss of use, data or profits, * * * * whether in an action of contract, negligence or other * * * * tortious action, arising out of or in connection with the use * * * * or performance of this software. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * This software remains the property of Brillig Enterprises * * * * (aka Chris Pando) and can be used or copied only in * * * * accordance with the terms of the agreement. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Swap User Profile * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * hactgrp(*caller) dftactgrp(*no) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... procedure interfaces ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... entry interfaces ... * * * d entryParms pr ExtPgm('CP1500R') d profile 10a d entryParms pi d profile 10a * * * ... internal procedures ... * * * d process pr * * * ... external programs ... * * * d getHandle pr ExtPgm('QSYGETPH') d 10a Const d 10a Const d 12a d 256a d swapProfile pr ExtPgm('QWTSETP') d 12a Const d 256a d releaseHandle pr ExtPgm('QSYRLSPH') d 12a Const d 256a * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... data structures ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d errDS DS d errPrv 10u 0 Inz(%Size(errDS)) d errAvl 10u 0 Inz(0) d errMSGID 7a d 1a Inz(x'00') d errDta 240a * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Mainline * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /free *InLR = *On; process(); Return; /end-free * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Procedures * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * process * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * pprocess b d pi d pwd s 10 Inz('*NOPWD') d handle s 12a /free getHandle( profile : pwd : handle : errDS ); swapProfile( handle : errDS ); releaseHandle( handle : errDS ); Return; /end-free pprocess e