APCHS11E.m

APCHS11E ; IHS/CMI/LAB - HEALTH SUMMARY SURVEILLANCE ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;

 ; ******************** SURVEILLANCE - HARD CODE ********************

HH ;HCT/HGB

 Q:APCHSAGE'<18&(APCHSEX="M")

 Q:APCHSAGE'<45&(APCHSEX="F")

 K APCHSLDT

 S APCHSLAB="HCT" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 S APCHSLAB="HGB" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 S APCHSLAB="CBC" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 Q:'APCHSLBD

 S APCHSDIS="HCT/HGB"

 S APCHSIVD=$O(APCHSLDT(""))

 I 'APCHSIVD,APCHSAGE'<1 S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11 Q

 I 'APCHSIVD,APCHSAGE'>1 S X1=APCHSDOB,X2=365 D C^%DTC S Y=X X APCHSCVD S APCHSDUE=Y,APCHSDAT="" D DISPLAY^APCHS11 Q

 D PASTAGE^APCHS11

 I APCHSAGE'>1,APCHSOLD'>(9/12) S X1=APCHSDOB,X2=365*12 D C^%DTC S Y=X X APCHSCVD S APCHSDUE=Y D GETDATE^APCHS11,DISPLAY^APCHS11 Q

 I APCHSAGE'>4,APCHSOLD'>3 S X1=APCHSDOB,X2=365*4 D C^%DTC S Y=X X APCHSCVD S APCHSDUE=Y D GETDATE^APCHS11,DISPLAY^APCHS11 Q

 I APCHSAGE'>12,APCHSOLD'>10 S X1=APCHSDOB,X2=365*12 D C^%DTC S Y=X X APCHSCVD S APCHSDUE=Y D GETDATE^APCHS11,DISPLAY^APCHS11 Q

 I APCHSAGE>16,APCHSEX="F" I APCHSOLD'>15 S APCHSDUE="MAY BE DUE NOW" D GETDATE^APCHS11,DISPLAY^APCHS11 Q

 I APCHSAGE>16,APCHSEX="F" S APCHSINT=365 D GETDATE^APCHS11,COMPARE^APCHS11,DISPLAY^APCHS11

 Q

 ;

CHOL ;

 K APCHSEXD,APCHSDF1,APCHSTEX

 Q:APCHSAGE>65

 I APCHSEX="M",APCHSAGE<35 Q

 I APCHSEX="F",APCHSAGE<45 Q  ;do not display for women under 45

 S APCHSLAB="CHOLESTEROL"

 D LABDFN^APCHS11

 Q:'APCHSLBD

 S APCHSDIS="CHOLESTEROL"

 S APCHSINT=365*5

 D REGLAB^APCHS11

 Q

 ;

OCCULT ;EP to do occult blood maintanence item

 Q:APCHSAGE<50  ;do not display if patient is under 50 yrs old

 K APCHSLDT

 S APCHSLAB="FECAL OCCULT BLOOD" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 S APCHSLAB="GUAIAC" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 S APCHSLAB="OCCULT BLOOD" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 S APCHSLAB="HEMOCCULT" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 S APCHSLAB="FECULT" D LABDFN^APCHS11 D:APCHSLBD MULTLAB^APCHS11

 S APCHSDIS="FECAL OCCULT BLOOD"

 S APCHSIVD=$O(APCHSLDT(""))

 I 'APCHSIVD S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11 Q

 S APCHSINT=365

 D GETDATE^APCHS11

 D COMPARE^APCHS11,DISPLAY^APCHS11 I 1

 E  D DISPLAY^APCHS11

 Q

APCHS11E  ; IHS/CMI/LAB - HEALTH SUMMARY SURVEILLANCE ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

 +3       ; ******************** SURVEILLANCE - HARD CODE ********************

HH        ;HCT/HGB

 +1        IF APCHSAGE'<18&(APCHSEX="M")

               QUIT 

 +2        IF APCHSAGE'<45&(APCHSEX="F")

               QUIT 

 +3        KILL APCHSLDT

 +4        SET APCHSLAB="HCT"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +5        SET APCHSLAB="HGB"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +6        SET APCHSLAB="CBC"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +7        IF 'APCHSLBD

               QUIT 

 +8        SET APCHSDIS="HCT/HGB"

 +9        SET APCHSIVD=$ORDER(APCHSLDT(""))

 +10       IF 'APCHSIVD

               IF APCHSAGE'<1

                   SET APCHSDUE="MAY BE DUE NOW"

                   SET APCHSDAT=""

                   DO DISPLAY^APCHS11

                   QUIT 

 +11       IF 'APCHSIVD

               IF APCHSAGE'>1

                   SET X1=APCHSDOB

                   SET X2=365

                   DO C^%DTC

                   SET Y=X

                   XECUTE APCHSCVD

                   SET APCHSDUE=Y

                   SET APCHSDAT=""

                   DO DISPLAY^APCHS11

                   QUIT 

 +12       DO PASTAGE^APCHS11

 +13       IF APCHSAGE'>1

               IF APCHSOLD'>(9/12)

                   SET X1=APCHSDOB

                   SET X2=365*12

                   DO C^%DTC

                   SET Y=X

                   XECUTE APCHSCVD

                   SET APCHSDUE=Y

                   DO GETDATE^APCHS11

                   DO DISPLAY^APCHS11

                   QUIT 

 +14       IF APCHSAGE'>4

               IF APCHSOLD'>3

                   SET X1=APCHSDOB

                   SET X2=365*4

                   DO C^%DTC

                   SET Y=X

                   XECUTE APCHSCVD

                   SET APCHSDUE=Y

                   DO GETDATE^APCHS11

                   DO DISPLAY^APCHS11

                   QUIT 

 +15       IF APCHSAGE'>12

               IF APCHSOLD'>10

                   SET X1=APCHSDOB

                   SET X2=365*12

                   DO C^%DTC

                   SET Y=X

                   XECUTE APCHSCVD

                   SET APCHSDUE=Y

                   DO GETDATE^APCHS11

                   DO DISPLAY^APCHS11

                   QUIT 

 +16       IF APCHSAGE>16

               IF APCHSEX="F"

                   IF APCHSOLD'>15

                       SET APCHSDUE="MAY BE DUE NOW"

                       DO GETDATE^APCHS11

                       DO DISPLAY^APCHS11

                       QUIT 

 +17       IF APCHSAGE>16

               IF APCHSEX="F"

                   SET APCHSINT=365

                   DO GETDATE^APCHS11

                   DO COMPARE^APCHS11

                   DO DISPLAY^APCHS11

 +18       QUIT 

 +19      ;

CHOL      ;

 +1        KILL APCHSEXD,APCHSDF1,APCHSTEX

 +2        IF APCHSAGE>65

               QUIT 

 +3        IF APCHSEX="M"

               IF APCHSAGE<35

                   QUIT 

 +4       ;do not display for women under 45

           IF APCHSEX="F"

               IF APCHSAGE<45

                   QUIT 

 +5        SET APCHSLAB="CHOLESTEROL"

 +6        DO LABDFN^APCHS11

 +7        IF 'APCHSLBD

               QUIT 

 +8        SET APCHSDIS="CHOLESTEROL"

 +9        SET APCHSINT=365*5

 +10       DO REGLAB^APCHS11

 +11       QUIT 

 +12      ;

OCCULT    ;EP to do occult blood maintanence item

 +1       ;do not display if patient is under 50 yrs old

           IF APCHSAGE<50

               QUIT 

 +2        KILL APCHSLDT

 +3        SET APCHSLAB="FECAL OCCULT BLOOD"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +4        SET APCHSLAB="GUAIAC"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +5        SET APCHSLAB="OCCULT BLOOD"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +6        SET APCHSLAB="HEMOCCULT"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +7        SET APCHSLAB="FECULT"

           DO LABDFN^APCHS11

           IF APCHSLBD

               DO MULTLAB^APCHS11

 +8        SET APCHSDIS="FECAL OCCULT BLOOD"

 +9        SET APCHSIVD=$ORDER(APCHSLDT(""))

 +10       IF 'APCHSIVD

               SET APCHSDUE="MAY BE DUE NOW"

               SET APCHSDAT=""

               DO DISPLAY^APCHS11

               QUIT 

 +11       SET APCHSINT=365

 +12       DO GETDATE^APCHS11

 +13       DO COMPARE^APCHS11

           DO DISPLAY^APCHS11

           IF 1

 +14      IF '$TEST

               DO DISPLAY^APCHS11

 +15       QUIT