BGP8D712.m

BGP8D712 ; IHS/CMI/LAB - TOBACCO HF ;

 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 ;IHS/CMI/LAB

TOBHF(P,BDATE,EDATE) ;EP - return DATE^SMOKER CAT^DATE^SMOKELESS CAT^DATE^ETS CATEGORY

 NEW SM,SL,EX,EN,BGPTOB

 S BGPTOB=""

 S SM=$$LASTHF^BGP8D7(P,"TOBACCO (SMOKING)",BDATE,EDATE) K O,D,H

 S SL=$$LASTHF^BGP8D7(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE) K O,D,H

 S EX=$$LASTHF^BGP8D7(P,"TOBACCO (EXPOSURE)",BDATE,EDATE) K O,D,H

 S EN=$$LASTHF^BGP8D7(P,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",BDATE,EDATE) K O,D,H

 I SM]""!(SL]"")!(EX]"")!(EN]"") D TOBHFS Q BGPTOB

 S BGPTOB=$$LASTHF^BGP8D7(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

 I EN]"" S $P(BGPTOB,U,10)=EN

 Q

BGP8D712  ; IHS/CMI/LAB - TOBACCO HF ;

 +1       ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66

 +2       ;IHS/CMI/LAB

TOBHF(P,BDATE,EDATE) ;EP - return DATE^SMOKER CAT^DATE^SMOKELESS CAT^DATE^ETS CATEGORY

 +1        NEW SM,SL,EX,EN,BGPTOB

 +2        SET BGPTOB=""

 +3        SET SM=$$LASTHF^BGP8D7(P,"TOBACCO (SMOKING)",BDATE,EDATE)

           KILL O,D,H

 +4        SET SL=$$LASTHF^BGP8D7(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE)

           KILL O,D,H

 +5        SET EX=$$LASTHF^BGP8D7(P,"TOBACCO (EXPOSURE)",BDATE,EDATE)

           KILL O,D,H

 +6        SET EN=$$LASTHF^BGP8D7(P,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)",BDATE,EDATE)

           KILL O,D,H

 +7        IF SM]""!(SL]"")!(EX]"")!(EN]"")

               DO TOBHFS

               QUIT BGPTOB

 +8        SET BGPTOB=$$LASTHF^BGP8D7(P,"TOBACCO",BDATE,EDATE)

           KILL O,D,H

 +9        IF $PIECE(BGPTOB,U,1)["SMOKELESS"

               SET $PIECE(BGPTOB,U,4)=BGPTOB

 +10       IF $PIECE(BGPTOB,U,1)["ENVIRON"!($PIECE(BGPTOB,U,1)["IN HOME")

               SET $PIECE(BGPTOB,U,7)=BGPTOB

 +11       QUIT BGPTOB

TOBHFS    ;

 +1        IF SM]""

               SET BGPTOB=SM

 +2        IF SL]""

               SET $PIECE(BGPTOB,U,4)=SL

 +3        IF EX]""

               SET $PIECE(BGPTOB,U,7)=EX

 +4        IF EN]""

               SET $PIECE(BGPTOB,U,10)=EN

 +5        QUIT