/**********************************************************************/
data fitness;
stop;
set &master; /* original data entry data set */
run;
proc fsedit data=fitness
screen=&dd..mycat.fitness2.screen;
run;
/**********************************************************************/
/*******************************************************/
/* VERIFICATION SCL - (for 2nd entry of data.) */
/* Assumptions: Data have no deleted records. */
/* No deletions are allowed. */
/* No duplications are allowed. */
/* Data are accessible by obs number. */
/* Edited data set is initially empty. */
/*******************************************************/
FSEINIT:
control always label;
length command $8;
master=symget('master');
link DDEFINIT;
link JRNFINIT;
return;
JRNFINIT:
/*******************************************************/
/* The four macro variables, USERNAME, JOURNAL, */
/* MASTER, and KEY1 are created external to the */
/* FSEDIT session */
/*******************************************************/
length datetime 8 lastcode $2;
userid=symget('userid'); /* get user making changes */
/* open data set for update */
journal=open(symget('journal'),'u');
call set(journal); /* map SCL vars to data set */
/* data vector (DSDV) */
/* create CHANGES data set by using MASTER as model. */
/* Open both temporary data sets for update. */
/* */
/* For dual data entry, the OLD_RECS data set will */
/* be the MASTER, which is referenced in DDE_INIT. */
call new('changes',master,1,'n');
dsid_chg=open('changes','u');
call set(dsid_chg);
/* number of vars in data set */
_nvar=attrn(dde_id,'nvars');
rc=fetchobs(dde_id,1); /* Read first record */
rc=fetchobs(dsid_chg,1);
num_chng=varnum(journal,'varchng');
num_oldc=varnum(journal,'oldvaluc');
num_oldn=varnum(journal,'oldvalun');
num_newc=varnum(journal,'newvaluc');
num_newn=varnum(journal,'newvalun');
num_key=varnum(journal,'key');
num_code=varnum(journal,'code');
numokey=varnum(dde_id,symget("key1"));
return;
DDEFINIT:
dde_id=open(master,'U');
if dde_id=0 then do;
alarm;
_msg_='ERROR: Data verification cannot be '
|| 'performed due to error during open of '
|| 'master data.';
verify=0;
return;
end;
maxobs=attrn(dde_id,'nobs');
/* no call set */
/* set up vars for varnum functions: */
num_age=varnum(dde_id,'age');
num_wei=varnum(dde_id,'weight');
num_runt=varnum(dde_id,'runtime');
num_rstp=varnum(dde_id,'rstpulse');
num_runp=varnum(dde_id,'runpulse');
num_maxp=varnum(dde_id,'maxpulse');
num_oxy=varnum(dde_id,'oxygen');
num_grp=varnum(dde_id,'group');
lastobs=1; /* Obs to be fetched from */
/* verification data set. */
return;
/**********************************************************************/
MAIN:
command=word(1,'L');
/**********************************************************************/
if _status_='C' then do;
erroroff _all_;
return;
end;
if verify=99 then do;
_msg_='ERROR: Added record exceeds maximum in '
|| 'verification data set. PLEASE CANCEL!';
alarm;
return;
end;
/**********************************************************************/
if substr(command,1,3)='dup' then do;
call nextcmd();
alarm;
_msg_='The DUP command is not allowed in '
|| 'dual data entry.';
return;
end;
if substr(command,1,3)='del' then do;
call nextcmd();
alarm;
_msg_='No deletions are allowed in '
|| 'dual data entry.';
return;
end;
return;
/**********************************************************************/
INIT:
link DDE_INIT;
return;
/**********************************************************************/
DDE_INIT:
/* Verify which obs user is on in edited data set. */
/* Fetch corresponding obs in MASTER. */
verify=1;
/**********************************************************************/
if command='add' then do;
curobs=lastobs;
lastobs+1;
end;
else curobs=curobs();
if curobs=. then do;
verify=0;
return;
end;
else if curobs > maxobs then do;
/* error - too many records */
_msg_='ERROR: Added record exceeds maximum in '
|| 'verification data set. PLEASE CANCEL!';
alarm;
verify=99;
erroron _all_;
return;
end;
/**********************************************************************/
rc=fetchobs(dde_id,curobs);
if rc>0 then do;
_msg_='WARNING: Data cannot be verified due to '
|| 'error retrieving record.';
alarm;
verify=0;
end;
return;
/**********************************************************************/
PATIENT:
if verify=1 then do;
/* get var from work copy and compare */
orig_c=getvarc(dde_id,numokey);
if patient¬=orig_c then do;
call wregion(1,34,12,47);
call display('error.program',patient,orig_c);
end;
end;
return;
/**********************************************************************/
entry newval oldval $8;
INIT:
control enter;
return;
MAIN:
/****************************************************/
/* If the field is modified, then use its */
/* new value. Otherwise, if user positions */
/* cursor on field but does not modify it, */
/* then that field will be the correct value. */
/****************************************************/
if modified(newval) then;
else if modified(oldval) then newval=oldval;
else
select(curfld());
when('NEWVAL');
when('OLDVAL') newval=oldval;
otherwise return;
end; /* select statement */
_status_='H';
return;
TERM:
return;
/**********************************************************************/
entry newval oldval 8;
/**********************************************************************/
AGE:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_age);
if age¬=original then do;
call wregion(2,34,12,47);
call display('errorn.program',age,original);
end;
end;
return;
WEIGHT:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_wei);
if weight¬=original then do;
call wregion(3,34,9,47);
call display('errorn.program',weight,original);
end;
end;
return;
RUNTIME:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_runt);
if runtime¬=original then do;
call wregion(4,34,9,47);
call display('errorn.program',runtime,original);
end;
end;
return;
RSTPULSE:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_rstp);
if rstpulse¬=original then do;
call wregion(5,34,9,47);
call display('errorn.program',rstpulse,original);
end;
end;
return;
RUNPULSE:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_runp);
if runpulse¬=original then do;
call wregion(6,34,9,47);
call display('errorn.program',runpulse,original);
end;
end;
return;
MAXPULSE:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_maxp);
if maxpulse¬=original then do;
call wregion(7,34,9,47);
call display('errorn.program',maxpulse,original);
end;
end;
return;
OXYGEN:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_oxy);
if oxygen¬=original then do;
call wregion(8,34,9,47);
call display('errorn.program',oxygen,original);
end;
end;
return;
GROUP:
if verify=1 then do;
/* get var from work copy and compare */
original=getvarn(dde_id,num_grp);
if group¬=original then do;
call wregion(9,34,9,47);
call display('errorn.program',group,original);
end;
end;
return;
/**********************************************************************/
TERM:
if _status_='C' then return;
if verify=99 then _status_='R';
link JRN_TERM;
return;
/**********************************************************************/
JRN_TERM:
code='2 '; /* signifies change from dual data entry */
/* update the journal file */
rc=update(dsid_chg);
/* update with current window values */
datetime=datetime();
do _i=1 to _nvar;
if vartype(dde_id,_i)='N' then do;
_num1=getvarn(dde_id,_i);
_num2=getvarn(dsid_chg,_i);
/* let code reflect numeric change */
substr(code,2,1)='N';
end;
else do;
_char1=getvarc(dde_id,_i);
_char2=getvarc(dsid_chg,_i);
/* let code reflect character change */
substr(code,2,1)='C';
end;
if (_char1¬=_char2) or (_num1¬=_num2) then do;
rc=append(journal);
/* put the variable that changed */
call putvarc(journal,num_chng,varname(dde_id,_i));
if _char1¬=_char2 then do;
/* save old value */
call putvarc(journal,num_oldc,_char1);
/* save new value */
call putvarc(journal,num_newc,_char2);
/* update master to reflect change */
call putvarc(dde_id,_i,_char2);
_char1=' '; _char2=' ';
end;
else do;
/* save old value */
call putvarn(journal,num_oldn,_num1);
/* save new value */
call putvarn(journal,num_newn,_num2);
/* update master to reflect change */
call putvarn(dde_id,_i,_num2);
_num1=.; _num2=.;
end;
/* add other variables that are not in changes */
if substr(code,1,1)='A' then
/* get key from changes */
key1=getvarc(dsid_chg,numokey);
else key1=getvarc(dde_id,numokey);
call putvarc(journal,num_key,key1);
call putvarc(journal,num_code,code);
rc=update(journal);
rc=update(dde_id);
end;
end;
return;
/**********************************************************************/
FSETERM:
link DDEFTERM;
link JRNFTERM;
return;
/**********************************************************************/
DDEFTERM:
if dde_id>0 then dde_id=close(dde_id);
return;
/**********************************************************************/
JRNFTERM:
/* close files, FSEDIT terminates */
rc=close(journal);
rc=close(dsid_chg);
rc=delete('changes');
return;
/**********************************************************************/