RPGIV @ Work

A unique site for RPG and System i Lovers

Welcome!

Hi, this site will provide all what you need in System i and RPG developments.

My Name is Chamara Withanachchi, System i Expert and RPG Developer. And in the field for last 11 years.

I hope you will find lot of valuable information from this site

Side by side Label Printing Print E-mail
User Rating: / 0
PoorBest 
Written by Chamara Withanachchi   
  Hdatedit(*ymd)
  H option(*NODEBUGIO)
   *-------------------------------------------------------------------------
   *
   *         Application      :  Salary Payouts
   *         Program Id       :  SAL1053
   *         Title            :  File creation for Salary Payouts
   *         Description      :  Read not extracetd records from PMTDTL
   *                             and EMPMAS and write those to IFS file.
   *
   *         Author           :  Chamara Withanachchi
   *         Date             :  28/01/2008
   *         Version          :  V 1.0
   *
   *-------------------------------------------------------------------------
   * Modifications
   *
   *-------------------------------------------------------------------------
   /TITLE               ..... File specifications .....
   *-------------------------------------------------------------------------
   *
   * Payment Header...
  FPYHDRL02  UF   E           K DISK    PREFIX(Ph)
  F                                     RENAME(PYHDRR:FILE1REC)
   *

   * Payment Detail...
  FPYDTLL01  UF   E           K DISK    PREFIX(Pd)
  F                                     RENAME(PYDTLR:FILE2REC)
   *
   * Employee Master file...
  FEMMASL02  IF   E           K DISK    PREFIX(Em)
	 F                                     RENAME(EMMASR:FILE3REC)
	  *
	  * Printer file to print labels
	 FPRINFILE  O    E             PRINTER INFDS(@FP1) USROPN
	  *
   *-------------------------------------------------------------------
				  
	  *-------------------------------------------------------------------
	  /TITLE Arrays Tables & data structures                          *
   *-------------------------------------------------------------------
	  * Printer file information data structure
	 D @FP1            DS
   * Printer file name
	 D  P1@NAM                83     92
   * Overflow line number
	 D  P1@OvFlow            188    189B 0
	  * Current Report Line
	 D  P1@Line              367    368B 0
	  * Current Report Page
  D  P1@Page              369    372B 0
		 
   *  Program status information data structure .....
  D                SDS
	 D  S@PGM            *PROC
	 D  S@USER               254    263
	 
	  *---------------------------------------------------------------------
  D #linCnt         S              6S 0
	 D #rCount         S              6S 0
  D #YerMon         S              6A
 				 
   *
  D K@BatcId        S                   like(PdWSBATID )
  D K@SpnrId        S                   like(EmSPNID   )
  D K@EmpnId        S                   like(EmEMPID   )
  D #SPNID          S             10A
  D #STFID          S             20A
  D #ENGNAM         S             80A
  D #NETPMT         S             13A
  D #EPCARD         S             16A
				 
   *
  D #TRDRFN         S              9
  D #cnt            S              6
  D #Year           S              4
  D #month          S              2
				 
	 D TABA            S              2    DIM(12) CTDATA PERRCD(1)
  D TABB            S              9    DIM(12) ALT(TABA)
				 
  D #prtArr         S            160    DIM(3)
  D #Idx            S              2  0
				 
  D #YRIFSC         S             11A
	 D #Amount         S             14A
				 
	 DQCMDEXC          PR                  EXTPGM('QCMDEXC')
	 DCMD                           110
	 DCMDLEN                         15  5
  DCMD              S            110
	 DCMDLEN           S             15  5
				 
  D #Chars          C                   '~`@#$%¢&*()_-+=|\{¬}¦":;<,>?!.'
  D #Space          C                   '                              '

				 
   *-----------------------------------------------------------------
  C     *Entry        Plist
  C                   Parm                    BatchId           9
  C                   Parm                    P@count           6
  C                   Parm                    P@msg            80
		 
  C     K@PmtDtll01   Klist
  C                   kfld                    K@BatcId
			 
	 C     K@PmtHdrl02   Klist
  C                   kfld                    K@BatcId
				 
	 C     K@EmpMasl02   Klist
  C                   kfld                    K@SpnrId
	 C                   kfld                    K@EmpnId
				 
   *-----------------------------------------------------------------
	  /free
	    #linCnt = 0;
	    #idx    = 1;
	    exsr SB_INI;
	    exsr SB_Process;
	    If #linCnt = 0;
 	      p@Msg = 'Transactions not found.';
 	    p@count  = '000000';
 	    Exsr SB_Exit;
 	EndIF;
	    if #linCnt > 0;
 	     eval P@msg = 'Labels printed sucessfully.';
 	else;
 		    eval P@msg = 'Labels not printed.';
 	endif;
	    Exsr SB_Exit;
   /end-free
				  
  C*--------------------------------------------------------------------
   *       End program
  C*--------------------------------------------------------------------
   /free
      Begsr SB_Exit;
 	      close PRINFILE;
 	      Eval *INLR = *ON ;
 	      Return;
      Endsr ;
   /end-free
				  
	 C*--------------------------------------------------------------------
   *       Inizalize
  C*--------------------------------------------------------------------
	 C     SB_INI        begsr
   * Override PRTF file, printer device and spool attributes...
  C                   eval      CMD = 'OVRPRTF FILE(PRINFILE) '
  C                   eval      CMD = %trim(CMD)+' PAGESIZE(88 160) '+
  C                             'LPI(8) CPI(20) OVRFLW(88) PAGRTT(0)'+
  C                             ' COPIES(1)'
  C                   eval      CMDLEN=%len(%trim(CMD))
  C                   callp     QCMDEXC(CMD:CMDLEN)
  C                   open      PRINFILE
  C                   eval      P1@Line = P1@OvFlow
  C                   endsr
				 
  C*--------------------------------------------------------------------
   *       Process records - Read necessary files
  C*--------------------------------------------------------------------
	  /free
 	    Begsr SB_Process;
				  
 		      eval K@BatcId = %dec(BatchId:9:0);
			      Setll K@PmtDtll01 File2Rec;
 		      Reade K@PmtDtll01 File2Rec;
 		      dow not %EOF(PMTDTLL01);
			         eval #idx = 0;
 		         eval #prtArr(1) = *blanks;
 	            eval #prtArr(2) = *blanks;
 		         eval #prtArr(3) = *blanks;
 		         dow not %EOF(PMTDTLL01) and #idx < 3;
 		         if PdNETPMT <> *zeros;
 		            eval #idx = #idx + 1;
		             // get data from Employee master...
 			        eval K@SpnrId = PdSPNID;
 		            eval K@EmpnId = PdEMPID;
							
			            setll K@EmpMasl02 File3Rec;
 		           reade K@EmpMasl02 File3Rec;
 		            if not %EOF(EMPMASL02);
 		               // Add to Array
 		               eval #month  = %editc(PdMONTH:'X');
 		               eval #Year   = %editc(PdYEAR :'X');
 		               eval #YerMon = #Year + #month ;
   /end-free
  C     #month        LOOKUP    TABA          TABB                     50
   /free
 		               eval EmENGNAM = %xlate(',':' ':EmENGNAM);
  	                  if #idx <= 3;
 				          eval #SPNID = PdSPNID;
 				          eval #STFID = EmSTFID;
 				          eval #ENGNAM= EmENGNAM;
 				          eval #NETPMT= %editc(PdNETPMT:'3');
			                  eval #EPCARD= EmCARDNO;
			                  eval #prtArr(#idx) = #SPNID + #STFID + #ENGNAM +
			                                       #NETPMT +
			                                       (TABB) + '-' + #Year +
			                                       #EPCARD ;
	                  endif;
 		            endif;
 		            // Update the record as Printed
 		            eval PdWSPRTSTS = 'Y';
 		            Update File2Rec;
		         endif;
 	         Reade K@PmtDtll01 File2Rec;
	         enddo;
	         if #idx > 0;
             exsr SB_WriteUpdate;
             eval #idx = 0;
          endif;
      enddo;
					  
      Setll K@PmtHdrl02 File1Rec;
      Chain K@PmtHdrl02 File1Rec;
      if %found(PMTHDRL02);
          eval PhWSPRTSTS = 'Y';
          Update File1Rec;
      endif;
    Endsr ;
					
   /end-free
				 
	 C*--------------------------------------------------------------------
   *     Update transaction file and write output file
  C*--------------------------------------------------------------------
   /free
      Begsr SB_WriteUpdate;
	    
		   if #prtArr(1) <> *blanks ;
 		          eval $PSPNCD1 = %subst(#prtArr(1):  1:10);
 		          eval $PSTFID1 = %subst(#prtArr(1): 11:20);
 		          eval $YRMONT1 = %subst(#prtArr(1):124:14);
 		          eval $EPCARDN1= %subst(#prtArr(1):138:16);
 		          eval $PESALR1 = %dec(%subst(#prtArr(1):111:13):10:3);
 		          if %len(%trim(%subst(#prtArr(1): 31:80))) > 40;
 		             eval $PENAME1 = %subst(#prtArr(1): 31:40);
 		             eval $PENAME_1= '-' + %subst(#prtArr(1): 72:40);
 		          else;
 		             eval $PENAME1 = %subst(#prtArr(1): 31:80);
 		          endif;
 		       else;
 		          eval $PSPNCD1  = *blanks;
 		          eval $PSTFID1  = *blanks;
 		          eval $PESALR1  = *zeros;
 		          eval $YRMONT1  = *blanks;
 		          eval $PENAME1  = *blanks;
 		          eval $PENAME_1 = *blanks;
 		          eval $EPCARDN1 = *blanks;
 	       endif;
					
	         if #prtArr(2) <> *blanks;
			          eval $PSPNCD2 = %subst(#prtArr(2):  1:10);
			          eval $PSTFID2 = %subst(#prtArr(2): 11:20);
			          eval $PESALR2 = %dec(%subst(#prtArr(2):111:13):10:3);
			          eval $YRMONT2 = %subst(#prtArr(2):124:14);
			          eval $EPCARDN2= %subst(#prtArr(2):138:16);
			          if %len(%trim(%subst(#prtArr(2): 31:80))) > 40;
			              eval $PENAME2 = %subst(#prtArr(2): 31:40);
 	                 eval $PENAME_2= '-' + %subst(#prtArr(2): 72:40);
			          else;
			              eval $PENAME2 = %subst(#prtArr(2): 31:80);
			          endif;
         else;
			          eval $PSPNCD2  = *blanks;
			          eval $PSTFID2  = *blanks;
			          eval $PESALR2  = *zeros;
			          eval $YRMONT2  = *blanks;
			          eval $PENAME2  = *blanks;
	             eval $PENAME_2 = *blanks;
 		          eval $EPCARDN2 = *blanks;
	       endif;
					
	       if #prtArr(3) <> *blanks;
 		          eval $PSPNCD3 = %subst(#prtArr(3):  1:10);
			          eval $PSTFID3 = %subst(#prtArr(3): 11:20);
			          eval $PESALR3 = %dec(%subst(#prtArr(3):111:13):10:3);
			          eval $YRMONT3 = %subst(#prtArr(3):124:14);
			          eval $EPCARDN3= %subst(#prtArr(3):138:16);
  	             if %len(%trim(%subst(#prtArr(3): 31:80))) > 40;
 		             eval $PENAME3 = %subst(#prtArr(3): 31:40);
 		             eval $PENAME_3= '-' + %subst(#prtArr(3): 72:40);
 		          else;
 		             eval $PENAME3 = %subst(#prtArr(3): 31:80);
 		          endif;
        else;
 	          eval $PSPNCD3  = *blanks;
 	          eval $PSTFID3  = *blanks;
 	          eval $PESALR3  = *zeros;
  	            eval $YRMONT3  = *blanks;
		          eval $PENAME3  = *blanks;
		          eval $PENAME_3 = *blanks;
		          eval $EPCARDN3 = *blanks;
       endif;
					   
       if P1@OvFlow <= P1@Line + 8 ;
		          exsr SB_WtrHead;
       endif;
       write LBL_DTL ;
       // eval P1@Line +=8;
       eval #linCnt = #linCnt + 1;
    Endsr ;
				  
  /end-free
				  
 C*--------------------------------------------------------------------
  *     Print report Header      MOD004
 C*--------------------------------------------------------------------
  /free
     begsr SB_WtrHead;
	        write LBL_HDR;
	        // eval P1@Line +=2;
     endsr ;
  /end-free
				  
**
01January
02February
03March
04April
05May
06June
07July
08August
09September
10October
11November
12December

Printer File

 A*%%***********************************************************************
  A*%%TS  RD  20080210  195125  CHAMARA     REL-V5R3M0  5722-WDS
  A*%%***********************************************************************
  A* Header Format 
  A          R LBL_HDR
  A*%%***********************************************************************
  A*%%RI 00000
  A*%%FS 002
  A*%%***********************************************************************
  A                                      SKIPB(001)
  A                                      SPACEB(002)
  A            $$DUMMY        1A  O     3
  A*%%***********************************************************************
  A*%%SS
  A*%%***********************************************************************
  A          R LBL_DTL
  A*%%***********************************************************************
  A*%%RI 00000
  A*%%***********************************************************************
  A                                      SPACEB(001)
  A                                      SPACEA(002)
  A            $PSPNCD1      10A  O     1
  A                                    +2
  A                                      'E Card No.'
  A            $EPCARDN1     16A  O    +1
  A            $PSPNCD2      10A  O    55
  A                                    +2
  A                                      'E Card No.'
  A            $EPCARDN2     16A  O    +1
  A            $PSPNCD3      10A  O   110
  A                                    +2
  A                                      'E Card No.'
  A            $EPCARDN3     16A  O    +1
  A                                     1
  A                                      'Staff ID :'
  A                                      SPACEB(001)
  A            $PSTFID1      16A  O    12
  A                                      HIGHLIGHT
  A                                    55
  A                                      'Staff ID :'
  A            $PSTFID2      16A  O    66
  A                                      HIGHLIGHT
  A                                   110
  A                                      'Staff ID :'
  A            $PSTFID3      16A  O   121
  A                                      HIGHLIGHT
  A            $PENAME1      40A  O     1
  A                                      SPACEB(001)
  A            $PENAME2      40A  O    55
  A            $PENAME3      40A  O   110
  A            $PENAME_1     40A  O     1
  A                                      SPACEB(001)
  A            $PENAME_2     40A  O    55
  A            $PENAME_3     40A  O   110
  A                                     1
  A                                      'Dhs.'
  A                                      SPACEB(001)
  A            $PESALR1      10S 3O     6
  A                                      EDTCDE(4)
  A                                      HIGHLIGHT
  A                                    55
  A                                      'Dhs.'
  A            $PESALR2      10S 3O    60
  A                                      EDTCDE(4)
  A                                      HIGHLIGHT
  A                                   110
  A                                      'Dhs.'
  A            $PESALR3      10S 3O   115
  A                                      EDTCDE(4)
  A                                      HIGHLIGHT
  A            $YRMONT1      14A  O     1
  A                                      SPACEB(001)
  A            $YRMONT2      14A  O    55
  A            $YRMONT3      14A  O   110
 
 

User Comments

Please login or register to add comments

<Previous   Next>