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

BGP1D712.m

Go to the documentation of this file.
BGP1D712 ; IHS/CMI/LAB - TOBACCO HF ;
 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
 ;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^BGP1D7(P,"TOBACCO (SMOKING)",BDATE,EDATE) K O,D,H
 S SL=$$LASTHF^BGP1D7(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE) K O,D,H
 S EX=$$LASTHF^BGP1D7(P,"TOBACCO (EXPOSURE)",BDATE,EDATE) K O,D,H
 I SM]""!(SL]"")!(EX]"") D TOBHFS Q BGPTOB
 S BGPTOB=$$LASTHF^BGP1D7(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