/*---------------------------------------------------------------------*

Study Number :
Study :
Program Name : DM
Purpose : Craeting Demographic Domain
Author : xxxxxxx
Date of Creation : DDMMM2023
Input Data :
Output : SDTM.DM
Assumptions : Taken from xxx
--------------------------------------------------------------------------
Modification History :
--------------------------------------------------------------------------
Modified By : xxxx
Modification Date :
Modification Description :
---------------------------------------------------------------------------*/

dm "log" clear;

proc datasets lib=work memtype=data kill;

quit;

options validvarname=upcase;

/* To bring Rawdatasets */

libname raw "E:\C DATA\my data DUSKTOP\Desktop\Altryx Solution\A3_8am\Raw

datasets";

/* To store final output dataset*/

libname sdtm "E:\C DATA\my data DUSKTOP\Desktop\Altryx Solution\A3_8am\outputs";

/* Final Variables in Dataset */

%let keepvar = studyid subjid usubjid rfstdtc rfxstdtc rfendtc rfxendtc rficdtc
rfpendtc invnam invid
age ageu sex race ethnic brthdtc dthdtc dthfl country arm
actarm armcd actarmcd dmdtc dmdy
siteid domain;

/* Format Creation */

proc format ;

value $sex_
"Female" = "F"
"Male" = "M"
;

value $race_
"White" = "WHITE"
;

value $ethnic_
"Hispanic" = "HISPANIC OR LATINO"
 "Not Hispanic" = "NOT HISPANIC OR LATINO"
;

run;

/* Usubjid Macro creation */

%macro usubjid (out=,in=);

data &out;
set raw.∈
if subjid ne "" then usubjid = catx("-",project,sitenumber,subjid);
else usubjid = catx("-",project,sitenumber,scrnid);
run;
%mend usubjid;

%usubjid (in=dm, out=dm_);

%usubjid (in=ex, out=ex_);
%usubjid (in=sv, out=sv_);
%usubjid (in=ds_ic, out=ds_ic_);
%usubjid (in=scrfail, out=scrfail_);
%usubjid(out=lb_pts, in=lb_pts);
%usubjid (in=death, out=death_);
%usubjid(out=ae, in=ae);
%usubjid(out=antigs, in=antigs);

/* Sorting macro*/

%macro sort(in=,out=,var=);
proc sort data=&in out = &out;
by &var;
run;
%mend sort;

%sort(in=ex_, out=ex, var=usubjid);

%sort(in=dm_, out=dm, var=usubjid);
%sort(in=sv_, out=sv, var=usubjid);
%sort(in=ds_ic_, out=ds_ic, var=usubjid);
%sort(in=death_, out=death, var=usubjid);
%sort(in=scrfail_, out=scrfail, var=usubjid);

/* assigning or deriving New variables as per SDTMIG */

data dm1(rename=(subjid_=subjid));

length sex $20. subjid_ $10. siteid $4.;

set dm(drop=siteid);
studyid = strip(project);
domain = "DM";
/* brthdtc =
put(input(substr(strip(put(brthdt,datetime22.)),1,9),date9.),is8601da.);*/
brthdtc = put(input(compress(brthdt_raw),date9.),is8601da.);

sex = put(sex, $sex_.);

ethnic = put(ethnic, $ethnic_.);
race = put(race, $race_.);
 if subjid ne "" then subjid_ = subjid;
else subjid_ = scrnid;
/* if subjid eq "" then subjid = scrnid;*/

siteid = strip(sitenumber) ;

dmdtc =
put(input(substr(strip(put(recorddate,datetime22.)),1,9),date9.),is8601da.);

if age ne . then ageu = "YEARS";

country = "USA";

DMSPID=catx('-', sitenumber, scrnid, subjid);

drop subjid ;

run;

/* Deriving RFSTDTC RFXSTDTC RFENDTC RFXENDTC */

%sort(in=ex(where=(exstdtc ne . )), out=ex1, var=usubjid exstdtc exsttmc);

/* For start date and time */

data start(keep=usubjid rfstdtc rfxstdtc);

length rfstdtc $20.;
set ex1;
by usubjid exstdtc exsttmc;

if first.usubjid;

rfstdtc =
put(input(substr(strip(put(exstdtc,datetime22.)),1,9),date9.),is8601da.)||"T"||
strip(exsttmc);
rfxstdtc = rfstdtc;
run;

%sort(in=ex(where=(exstdtc ne . )), out=ex1, var=usubjid exstdtc exentmc);

/* For end date and time */

data end(keep=usubjid rfendtc rfxendtc);

length rfendtc $20.;
set ex1;
by usubjid exstdtc exentmc;

if last.usubjid;

rfendtc =
put(input(substr(strip(put(exstdtc,datetime22.)),1,9),date9.),is8601da.)||"T"||
strip(exentmc);
rfxendtc = rfendtc;
run;

/* Deriving DTHDTC and DTHFL */

data death1;
set death;

dthdtc = put(input(compress(deathdt_raw),date9.),is8601da.);
dthfl = "Y";

drop siteid;
run;

/* Deriving RFICDTC */

data ds_ic1;
set ds_ic;

rficdtc = put(input(compress(s_icdt_raw),date9.),is8601da.);
drop siteid;

run;

/* Deriving RFPENDTC */

%macro rep (in, out, var);

data &out(keep=usubjid repdtc);
set ∈
repdtc = strip(&var);
run;
%mend rep;

%rep(ae,ae1,aestdt_raw);
%rep(ae,ae2,aeendt_raw);
%rep(antigs,antigs1,GSTM_RAW);
%rep(death,death_,DEATHDT_RAW);
%rep(ds_ic1,ds_ic2,S_PVERDT_RAW);
%rep(ex,ex_,EXSTDTC_RAW);
%rep(lb_pts,lb_pts1,LBDT_RAW);
%rep(sv,sv1,SVSTDT_RAW);

data rep(keep= usubjid rfpendtc);

length rfpendtc $20.;

set ae1 ae2 antigs1 death_ ds_ic2 ex_ lb_pts1 sv1;

rfpendtc = compress(repdtc,"- /");

if (compress(rfpendtc,"","kd")="") then rfpendtc = "";

if index(rfpendtc,"UNK")>0 then rfpendtc =

substr(rfpendtc,index(rfpendtc,"UNK")+3);
else if rfpendtc=:"UN" then rfpendtc = substr(rfpendtc,3);

if length(rfpendtc) = 8 then rfpendtc = "0"||rfpendtc;

if length(rfpendtc) <= 7 then delete;

if rfpendtc ne "" then rfpendtc = put(input(rfpendtc,date9.),yymmdd10.);

run;
proc sort data = rep;
by usubjid rfpendtc;
run;

data rep;
set rep;
by usubjid rfpendtc;

if last.usubjid ;
run;

/* Merge All datasets */

data dm2;
merge dm1(in=a) start end death1 ds_ic1 rep;
by usubjid;
if a;
run;

/*proc sort data=dm2; */

/* by siteid;*/
/*run;*/

%sort(in=dm2, out=dm2 , var=siteid );

/* Deriving INVID and INVNAM */

%sort(in=raw.inv_list(keep=PI_Name Sponsor_Site__ rename=(Sponsor_Site__=siteid )),

out=inv_list nodupkey, var=siteid PI_Name);

/* Merging both DM2 and INV datasets */

data dm3;
merge dm2(in=a) inv_list;
by siteid;
if a;
invid = siteid;
rename pi_name = invnam;
run;

%sort(in=dm3, out=dm3 , var=usubjid );

/* Screenfailure Information */

%sort(in=scrfail_, out=scrfail(drop=siteid), var=usubjid);

/* Deriving ARM ACTARM ARMCD ACTARMCD */

data dm4;
length armcd actarmcd $8. arm actarm $50. ;
merge dm3(in=a) scrfail(in=b);
by usubjid;

if a then do;

armcd = "1";
 arm = "GS-6624";
actarmcd = "1";
actarm = "GS-6624";
end;

if b then do;
armcd = "SCRNFAIL";
arm = "Screen Failure";
actarmcd = "SCRNFAIL";
actarm = "Screen Failure";
end;

run;

/* DMDY */

data dm5(rename=(studyid_=studyid));
length studyid_ $20.;
set dm4;

rfstdtc_n = input(scan(rfstdtc,1,"T"),yymmdd10.);
dmdtc_n = input(dmdtc,yymmdd10.);

if rfstdtc_n ne . and dmdtc_n ne . then do;

if dmdtc_n >= rfstdtc_n then dmdy = (dmdtc_n - rfstdtc_n)+1;
else if dmdtc_n < rfstdtc_n then dmdy = dmdtc_n - rfstdtc_n;
end;

studyid_ = studyid;
drop studyid;

run;

/* Final Dataset with attribs */

data fin(label="Demographics");

attrib STUDYID label ='Study Identifier' length = $14

DOMAIN label ='Domain Abbreviation' length = $2
USUBJID label ='Unique Subject Identifier' length = $30
SUBJID label ='Subject Identifier for the Study' length = $10
RFSTDTC label ='Subject Reference Start Date/Time' length = $20
RFENDTC label ='Subject Reference End Date/Time' length = $20
RFXSTDTC label ='Date/Time of First Study Treatment ' length = $20
RFXENDTC label ='Date/Time of Last Study Treatment' length = $20
RFICDTC label ='Date/Time of Informed Consent' length = $20
RFPENDTC label ='Date/Time of End of Participation' length = $20
DTHDTC label ='Date/Time of Death' length = $20
DTHFL label ='Subject Death Flag' length = $1
SITEID label ='Study Site Identifier' length = $4
INVNAM label ='Investigator Name' length = $100
BRTHDTC label ='Date/Time of Birth' length = $20
AGE label ='Age ' length = 8
AGEU label ='Age Units' length = $6
SEX label ='Sex' length = $1
RACE label ='Race' length = $100
ETHNIC label ='Ethnicity' length = $40
ARMCD label ='Planned Arm Code' length = $8
 ARM label ='Description of Planned Arm' length = $50
ACTARMCD label ='Actual Arm Code' length = $8
ACTARM label ='Description of Actual Arm' length = $50
COUNTRY label ='Country' length = $3
DMDTC label ='Date/Time of Collection' length = $20
DMDY label ='Study Day of Collection' length = 8;

set dm5;
keep &keepvar.;
run;

data sdtm.dm;
set fin;
run;

/* Convert final dataset into xpt format */

libname xpt xport "E:\C DATA\my data DUSKTOP\Desktop\Altryx Solution\A3_8am\xpt\

dm.xpt";

proc copy in = sdtm out = xpt memtype=data;

select dm;
run;

/* SUPPDM Domain Creation */

%let keepsupp = studyid usubjid rdomain idvar idvarval qnam qlabel qval qeval
qorig;

data supp;
length qnam $8. qlabel qorig $40. qval $200.;
set dm5;

rdomain = "DM";
idvar = "";
idvarval = "";

/* RACEOTH*/

QNAM = "RACEOTH";
qlabel = "Other race";
qval = strip(raceoth);
qorig = "CRF Page";
qeval = "";
if raceoth ne "" then output;

/* DEATHCAU*/

QNAM = "DEATHCAU";
qlabel = "Immediate Cause of Death";
qval = strip(deathcau);
qorig = "CRF Page";
qeval = "";
if qval ne "" then output;

/* SPONSOR ID*/
 QNAM = "DMSPID";
qlabel = "Sponsor Identifier";
qval = strip(dmspid);
qorig = "Derived";
qeval = "";
if qval ne "" then output;

run;

/* Final SUPP dataset Creation */

data sdtm.suppdm(label= "Supplemental Qualifiers for Demographics");

retain studyid usubjid rdomain idvar idvarval qnam qlabel qval qorig qeval;

attrib
STUDYID label ='Study Identifier' length = $14
RDOMAIN label ='Related Domain Abbreviation' length = $2
USUBJID label ='Unique Subject Identifier' length = $30
IDVAR label ='Identifying Variable' length = $8
IDVARVAL label ='Identifying Variable Value' length = $200
QNAM label ='Qualifier Variable Name' length = $8
QLABEL label ='Qualifier Variable Label' length = $40
QVAL label ='Data Value' length = $200
QORIG label ='Origin' length = $40
QEVAL label ='Evaluator' length = $40;
;

set supp;
keep &keepsupp.;
run;

/* Convert final dataset into xpt format */

libname xpt xport"E:\C DATA\my data DUSKTOP\Desktop\Altryx Solution\A3_8am\xpt\

suppdm.xpt";

proc copy in = sdtm out = xpt memtype=data;

select suppdm;
run;

/*proc printto log = "E:\C DATA\my data DUSKTOP\Desktop\Altryx Solution\A3_8am\log\

dmlog.txt" new;*/

********************** End of Program ******************************;