String mit Zoned-Repräsentation in packed umwandeln

[dschroeder]

Warum immer so kompliziert?
Die klassische MOVE-Anweisung regelt das automatisch und bei fehlerhaften Ziffern einfach ein Monitor drumrum:
...
Der Move überträgt rechtsbündig in das Zielfeld. Ziffern werden konvertiert und vom rechten Zeichen wird die linke Tetrade (C, D, E, F) als Vorzeichen und die Rechte Tetrade (0-9) als Ziffer.
So haben wir seit gefühlten 100 Jahren konvertiert.
Die Kommaausrichtung kann dann wie gehabt erfolgen.

Der MOVE hat einem wirklich oft aus der Patsche geholfen bei Konvertierung und so. Aber im fully free format sind keine fixed form Anweisungen mehr möglich. Der MOVE scheidet in ganz neuen Programmen deshalb (leider) aus. Bei dem Beispiel von Rainer Ross scheint es sich allerdings nur um "total free" (und nicht "fully free") zu handeln. Da ginge der MOVE tatsächlich noch.

[Rainer Ross]

Ich werfe aufgrund der Anregung von Baldur noch eine Idee für "total" und "fully" free in den Hut

               ctl-opt main(main) dftactgrp(*no) option(*nounref);                                                            
      //------------------------------------------------------------------//                                            
      //                                                                  //                                            
      // Convert Zoned to Packed from String                              //                                            
      //                                                                  //                                            
      //-----------------                                                 //                                            
      // R.Ross 06.2017 *                                                 //                                            
      //------------------------------------------------------------------//                                            
      // Main                                                             //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc Main;                                                                                                 
                                                                                                                        
         dcl-s   LocString   varchar(30);             // String                                                         
         dcl-s   LocNumber   packed(11:2);            // Number                                                         
                                                                                                                        
           LocString = '000005843M';                                                                                    
           LocNumber = cvtZonedToPacked(LocString:2);                                                                   
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//                                            
      // Convert Zoned to Packed from String                              //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc cvtZonedToPacked;                                                                                     
         dcl-pi *n           like(LocNumber);                                                                           
                 PiString    varchar(30) const options(*varsize:*trim);                                                 
                 PiDecimals  uns(5)      const options(*nopass);                                                        
         end-pi;                                                                                                        
                                                                                                                        
         dcl-ds  PsString    qualified;                                                                                 
                  String     char(30);                                                                                  
                  Number     zoned(30) pos(01);                                                                         
         end-ds;                                                                                                        
                                                                                                                        
         dcl-s   LocNumber   packed(30:9);            // Number                                                         
                                                                                                                        
           evalr PsString.String = PiString;                                                                            
           LocNumber = PsString.Number;                                                                                 
                                                                                                                        
           if %parms >= %parmnum(PiDecimals);         // Decimals                                                       
              LocNumber /= 10 ** PiDecimals;          // Decimals                                                       
           endif;                                                                                                       
                                                                                                                        
           return LocNumber;                          // Number                                                         
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//

[dschroeder]

Ich werfe aufgrund der Anregung von Baldur noch eine Idee für "total" und "fully" free in den Hut

               ctl-opt main(main) dftactgrp(*no) option(*nounref);                                                            
      //------------------------------------------------------------------//                                            
      //                                                                  //                                            
      // Convert Zoned to Packed from String                              //                                            
      //                                                                  //                                            
      //-----------------                                                 //                                            
      // R.Ross 06.2017 *                                                 //                                            
      //------------------------------------------------------------------//                                            
      // Main                                                             //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc Main;                                                                                                 
                                                                                                                        
         dcl-s   LocString   varchar(30);             // String                                                         
         dcl-s   LocNumber   packed(11:2);            // Number                                                         
                                                                                                                        
           LocString = '000005843M';                                                                                    
           LocNumber = cvtZonedToPacked(LocString:2);                                                                   
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//                                            
      // Convert Zoned to Packed from String                              //                                            
      //------------------------------------------------------------------//                                            
         dcl-proc cvtZonedToPacked;                                                                                     
         dcl-pi *n           like(LocNumber);                                                                           
                 PiString    varchar(30) const options(*varsize:*trim);                                                 
                 PiDecimals  uns(5)      const options(*nopass);                                                        
         end-pi;                                                                                                        
                                                                                                                        
         dcl-ds  PsString    qualified;                                                                                 
                  String     char(30);                                                                                  
                  Number     zoned(30) pos(01);                                                                         
         end-ds;                                                                                                        
                                                                                                                        
         dcl-s   LocNumber   packed(30:9);            // Number                                                         
                                                                                                                        
           evalr PsString.String = PiString;                                                                            
           LocNumber = PsString.Number;                                                                                 
                                                                                                                        
           if %parms >= %parmnum(PiDecimals);         // Decimals                                                       
              LocNumber /= 10 ** PiDecimals;          // Decimals                                                       
           endif;                                                                                                       
                                                                                                                        
           return LocNumber;                          // Number                                                         
                                                                                                                        
         end-proc;                                                                                                      
      //------------------------------------------------------------------//

Bist du sicher, dass das geht? Wenn dein varying - Input-Parameter kürzer als 30 Zeichen ist, würden in der Datenstruktur doch zunächst Leerzeichen und am Ende deine gezonte Ziffernfolge stehen, oder? Wird das dann zu einer 30 Stelligen-Zahl? Der evalr würde doch das Feld zunächst mit Blanks initialisieren und dann rechtsbündig deinen (ggf. kürzeren) String reinpacken. Müssen da keine Vornullen rein?

[Rainer Ross]

Hallo Dieter,
ich habe es getestet, es funktioniert.

Rainer

[Pikachu]

Beim MOVEL steht genaueres (bei Feldern gleicher Länge):

If factor 2 is character and the result field is numeric, a minus zone is moved into the rightmost position of the result field if the zone from the rightmost position of factor 2 is a hexadecimal D (minus zone). However, if the zone from the rightmost position of factor 2 is not a hexadecimal D, a positive zone is moved into the rightmost position of the result field. Digit portions are converted to their corresponding numeric characters. If the digit portions are not valid digits, a data exception error occurs.

Und hier der Zeichensatz EBCDIC 273 (deutsch).