Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP6D712

BGP6D712.m

Go to the documentation of this file.
BGP6D712 ; IHS/CMI/LAB - TOBACCO HF ;
 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
 ;IHS/CMI/LAB
TOBHF(P,BDATE,EDATE) ;EP - return DATE^SMOKER CAT^DATE^SMOKELESS CAT^DATE^ETS CATEGORY
 NEW SM,SL,EX,BGPTOB
 S BGPTOB=""
 S SM=$$LASTHF^BGP6D7(P,"TOBACCO (SMOKING)",BDATE,EDATE) K O,D,H
 S SL=$$LASTHF^BGP6D7(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE) K O,D,H
 S EX=$$LASTHF^BGP6D7(P,"TOBACCO (EXPOSURE)",BDATE,EDATE) K O,D,H
 I SM]""!(SL]"")!(EX]"") D TOBHFS Q BGPTOB
 S BGPTOB=$$LASTHF^BGP6D7(P,"TOBACCO",BDATE,EDATE) K O,D,H
 I $P(BGPTOB,U,1)["SMOKELESS" S $P(BGPTOB,U,4)=BGPTOB
 I $P(BGPTOB,U,1)["ENVIRON"!($P(BGPTOB,U,1)["IN HOME") S $P(BGPTOB,U,7)=BGPTOB
 Q BGPTOB
TOBHFS ;
 I SM]"" S BGPTOB=SM
 I SL]"" S $P(BGPTOB,U,4)=SL
 I EX]"" S $P(BGPTOB,U,7)=EX
 Q