/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  
Macro's usage Note: 

The two macro's xwr_create defines an empty control dataset and xwr_change does is fill with content. 

Notes:
 - _WRjbloc (libref) is the location for all control data during the polling.
 
 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

 
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* * * xwr_create defines an empty control dataset.                                        * * * */ 



%macro xwr_create ( wrapploc=,wrdataloc=,jbloc=,jbdata=XWR_workcontrol, dsnno=16, filno=16, jbidno=16, opt= );
  %global batch_create_RC batch_create_msg;

  %let batch_create_RC=0 ;
  options lrecl=32767;

  %if ( %length(&opt) =0 ) %then %let opt=CREATE;
  %if ( not %sysfunc(fileexist(&wrdataloc/&jbloc) ) ) %then %do;
    %let batch_create_RC=-4 ;
    %let batch_create_msg= Error jbloc: &wrdataloc/&jbloc does not exist;
  %end;
  %else %do;
    %if ( &batch_create_RC ge 0 ) %then %do;
      libname  _WRjbloc "&wrdataloc/&jbloc" ; 
    %end;

    %if ( %index(%upcase("&opt") , ARCHIVE ) > 0 & &batch_create_RC ge 0 ) %then %do;
      %if ( %sysfunc(exist(_WRjbloc.&jbdata) ) ) %then %do;
        data _WRjbloc.&jbdata._BCK (genmax=32) ;
          set _WRjbloc.&jbdata ;
        run;
      %end;
    %end;

    %if ( %index(%upcase("&opt") , DELETE ) > 0 & &batch_create_RC ge 0 ) %then %do;
      proc delete data=_WRjbloc.&jbdata. ;
      run;
    %end;

    %if ( %index(%upcase("&opt") , CREATE ) > 0 & &batch_create_RC ge 0 ) %then %do;
      %if ( %sysfunc(exist(_WRjbloc.&jbdata) ) )  %then %do; 
        %let batch_create_RC=-4 ;
        %let batch_create_msg= WR control jbloc: _WRjbloc.&jbdata already exists. Please respond control file is not overwritten.  ;
        libname  _WRjbloc clear ; 
      %end;
    %end;

    %if ( %index(%upcase("&opt") , CREATE ) > 0 & &batch_create_RC ge 0 ) %then %do;
      data  _WRjbloc.&jbdata       
          _WRjbloc.&jbdata._RDY ( keep=jbid jbid_pid jbid_sascc jbstatus jbrun_start jbrun_end  bufno=8 bufsize=32k) 
          ;
        length  jbid    $16   /* unique identification */ 
            source            /* user source code  */
            srcloc            /* location user source code  */
            usrloc    $255    /* location of wanted log/output */
            print   $32       /* additional naming print-file */ 
            sasopt    $64     /* additional sas-options for code */ 

            jbstatus  $1      /* proceeding <space>=defined W=wacht I=initiated S=running E=Ended A=aborted F=erroneous input  */
            jbid_pid 
            jbid_sascc  8 
            jbbron    $255    /* locations of input text file */

            notify    $255     /* mail voor voortgang notify */   
            notify_evnt $8    /* At which status conditions swith to:  W,I,S,E,A,F an email. Status characterss to low-case after notify  W,E only fot time events  */   
            Waitcount         /* Condition when to mail/notify */   
            jbwintype $32     /* Type datetime increade when a roundrobin ..  */

            trgjbid1 - trgjbid&jbidno $255 /* Id's which should have run */ 
            blkjbid1 - blkjbid&jbidno $255 /* Id's which should not have runn */ 
            trgfil1 - trgfil&filno  $128  /* files that should be present */ 
            blkfil1 - blkfil&filno  $128  /* files that should not be present */
            trgdsn1 - trgdsn&dsnno  $64   /* tables that should be present */ 
            blkdsn1 - blkdsn&dsnno  $64   /* tables that should not be present */
            ;
        format  jbwinstart     /* do not start before  ..  */ 
            jbwinend           /* do not start after ..  */
            ntfy_delay         /* send a notify-alert when not started at .. */
            ntfy_running       /* send a notify-alert when still running at ..  */
            jbrun_init         /* Run_status: initial Submitted */
            jbrun_start        /* Run_status: Start time */
            jbrun_end          /* Run_status: ended time */
                     datetime. 
            ;
        informat
            jbwinstart 
            jbwinend   
            ntfy_delay 
            ntfy_running 
            jbrun_init
            jbrun_start  
            jbrun_end   
                     datetime. 
            ;
        delete;   
      run;
      data _null_  ;
          file print ;
          put "xbst_create_create status:&batch_create_RC %sysfunc( putn( %sysfunc( datetime() ) , datetime. ) )";  
          put " Everyting should be correct now, a new control tabel is at: &wrdataloc/&jbloc with the name: &jbdata";  
       run;
    %end;
  %end;

  %if ( &batch_create_RC lt 0 ) %then %do;
    data _null_ ;
      file print notitles ;
      put "xb_createdata status:&batch_create_RC %sysfunc( putn( %sysfunc( datetime() ) , datetime. ) )";  
      put "       &batch_create_msg";  
    run;
  %end;
  %else %do;
    libname  _WRjbloc clear ; 
  %end;
%mend;


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* * * xwr_change fills the control dataset.                                               * * * */ 


%macro xwr_change (wrapploc=,wrdataloc=,jbloc=,jbdata=XWR_workcontrol,srcloc=,usrloc=,txtloc=,dsnno=16, filno=16, jbidno=16, opt=);

%global batch_create_RC ;
%let batch_create_RC=0 ;

options lrecl=32767;
%if ( %length(&opt) =0 ) %then %let opt=Replace;

%if ( %length(&txtloc) =0 ) %then %let txtloc=&jbloc;
%if ( not %sysfunc(fileexist(&wrdataloc/&jbloc) ) ) %then %do;
   %let batch_create_RC=-4 ;
   %let batch_create_msg= Error jbloc: &wrdataloc/&jbloc bestaat niet;
%end;
%if ( not %sysfunc(fileexist(&wrdataloc/&txtloc/&jbdata_txt..txt) ) ) %then %do;
   %let batch_create_RC=-4 ;
   %let batch_create_msg= Error jbloc: &wrdataloc/&txtloc/&jbdata_txt..txt bestaat niet;
%end;

%if ( &batch_create_RC ge 0 ) %then %do;
  libname  _WRjbloc "&wrdataloc/&jbloc" ; 
  Filename  xbtxtloc "&wrdataloc/&txtloc" ; 
  options obs=max linesize=max;
%end;

%if ( %index(%upcase("&opt") , REPLACE ) > 0 & &batch_create_RC ge 0 ) %then %do;

data work.dummy;  
  jbid_pid=. ; jbstatus="f" ;            
run;
 
%put having definde lay out control dataset replace content using a ext file  ;  

data    
  _WRjbloc.&jbdata ( drop=opttype i jbid_next mailto dtbase dtbgnfx timeshift ) 
  _WRjbloc.&jbdata._RDY (keep=jbid jbstatus jbbron jbwinstart jbwinend source jbid_pid jbid_sascc  jbrun_start jbrun_end  bufno=8 bufsize=32k) 
 ;
  set _WRjbloc.&jbdata (where=(jbbron ne "&txtloc/&jbdata_txt")) 
    work.dummy (in=dummy1) 
  ;
  length opttype jbid_next $16 mailto $255 dtbgnfx $32 ;
  retain i 0 jbid jbid_next  mailto dtbase dtbgnfx timeshift ;  
  informat dtbase datetime.  ;
  format   dtbase datetime.  ;
  file print notitles ;
  Infile xbtxtloc("&jbdata_txt..txt") dsd missover end=enddata filename=filename ; 
  if ( dummy1 ne 1 ) then do; 
     output _WRjbloc.&jbdata ;
  end;   
  else do; /* first record is lay-out detection */
    jbbron = "&txtloc/&jbdata_txt" ; jbrun_start=datetime();
    Do while ( not enddata & i < 9999 ) ; 
     i + 1 ;
     input jbid_next @ ;  
     opttype=scan(jbid_next,1," ") ; 
     if ( opttype =: "*" | opttype =: ";" | opttype =: "#" | opttype =: "/*" | _infile_ = " " ) then do;
        input ;  put _infile_  ;  /* skip line for commenting */
     end ;   
     else do;      
        input opttype @ ;
        if ( jbid_next eq " " & upcase(opttype) ne "JBID" ) then jbid_next=jbid ;  
        if ( ( jbid ne jbid_next | ( jbid_next eq "" & upcase(opttype) eq "JBID") ) & 
             ( source ne " " | jbwintype ne " " | jbstatus ne " " ) ) then do ;   
          jbbron = "&txtloc/&jbdata_txt" ;
          output _WRjbloc.&jbdata ;  jbid=jbid_next ;  
          
          Call missing( source, srcloc, usrloc, print, jbwinstart, jbwinend,     jbrun_init, jbrun_start, jbrun_end , 
              notify_evnt, notify,  waitcount,  ntfy_delay, ntfy_running,     jbwintype, 
              jbstatus, jbid_pid, jbid_sascc,        sasopt, 
              trgjbid1, trgjbid2, trgjbid3, trgjbid4 ,       blkjbid1 , blkjbid2, blkjbid2 , blkjbid4  ,
              trgfil1 , trgfil2 ,trgfil3 , trgfil4 ,         blkfil1 , blkfil2 , blkfil3 , blkfil4 ,  
              trgdsn1 , trgdsn2 ,trgdsn3 , trgdsn4 ,         blkdsn1 , blkdsn2,  blkdsn3 , blkdsn4 );                  
              
        end;
        Select;  
        when ( opttype="") input ;
        when ( upcase(opttype)="DTBASE") do;
          input dtbase dtbgnfx ; timeshift= . ;  
          if ( dtbase ne .  ) then do;
            if ( dtbgnfx eq " " ) then timeshift = datetime() - dtbase  ;
            else timeshift=intnx( dtbgnfx ,datetime(), 0, 'B' ) - intnx( dtbgnfx ,dtbase , 0, 'B' )  ;
          end;
          put "xbst_change timehsift basis " dtbase datetime. "   met fix " dtbgnfx $32. "  waarde hh:mmm:ss " timeshift time12.;  
        end;
        when ( upcase(opttype)="MAILTO") do; 
          input mailto  ;
          put "xbst_change standaard mail naar: " mailto ;  
        end;
        when ( upcase(opttype)="JBID")  do;
          jbid=jbid_next ;  
          input source print jbwinstart jbwinend jbstatus trgjbid1 notify_evnt srcloc usrloc  ;
          if ( srcloc="" ) then srcloc="&srcloc";          
          if ( usrloc="" ) then usrloc="&usrloc";
          notify=mailto ;           
          if ( timeshift ne . ) then do;
          if ( jbwinstart ne . ) then jbwinstart= jbwinstart +  timeshift ;
          if ( jbwinend   ne . ) then jbwinend  = jbwinend   +  timeshift ;
          end; 
        end;
        when ( upcase(opttype)="CLNDR")    input jbwintype ;
        when ( upcase(opttype)="NTFY")   do;
          input notify_evnt notify  ntfy_delay ntfy_running ;
          if ( notify="" ) then notify=mailto ;
          if ( timeshift ne . ) then do;
          if ( ntfy_delay   ne . ) then ntfy_delay   = ntfy_delay + timeshift ;
          if ( ntfy_running ne . ) then ntfy_running = ntfy_running   + timeshift ;
          end; 
        end;
        when ( upcase(opttype)="OPT")      input sasopt ;
        when ( upcase(opttype)="TRGJBID")  input trgjbid1 - trgjbid&jbidno ;
        when ( upcase(opttype)="BLKJBID")  input blkjbid1 - blkjbid&jbidno ;
        when ( upcase(opttype)="TRGFIL")   input trgfil1 - trgfil&filno ;
        when ( upcase(opttype)="BLKFIL")   input blkfil1 - blkfil&filno ;
        when ( upcase(opttype)="TRGDSN")   input trgdsn1 - trgdsn&dsnno ;
        when ( upcase(opttype)="BLKDSN")   input blkdsn1 - blkdsn&dsnno ;
        Otherwise do; 
          input ;
          put "Unknown opt in datalines" _infile_ ;  
        end;
        end;
     end;  
     if ( enddata & ( source ne " " | jbwintype ne " " ) ) then do;
        output _WRjbloc.&jbdata ;           
        PUT " WR Control: data  at &wrdataloc/&jbloc    &jbdata replaced.  data location: &wrdataloc/&srcloc    &sysuserid  %sysfunc( putn( %sysfunc( datetime() ) , datetime. ) )  " ;
     end;   
    end;  
  end;  
run;

%put sort data by namings ;  
 proc sort data=_WRjbloc.&jbdata       ; by jbid jbbron ; run;
 proc print data=_WRjbloc.&jbdata (where=(jbbron eq "&txtloc/&jbdata_txt")) ; run;
%end;

%if ( &batch_create_RC lt 0 ) %then %do;
  data _null_ ;
    file print ;
    put "xb_change:&batch_create_RC %sysfunc( putn( %sysfunc( datetime() ) , datetime. ) )";  
    put "       &batch_create_msg";  
  run;
%end;

%mend;