BDMDM2.m

BDMDM2 ; IHS/CMI/LAB -IHS -CONTINUATION OF ROUTINE TO FETCH DATA ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 ;IHS/CMI/LAB - patch 4 y2k and mammography screening

EN ; - EP - from CLINICAL^BDMDM1

 ;

 F BDMI=1:1 Q:$T(@BDMI)=""  K BDMX S BDMY="BDM(" D @BDMI K BDM

 ;

 Q

1 ;

FOOT ;

 S BDMX=BDMPD_"^LAST EXAM DIABETIC FOOT EXAM"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY) S ^TMP("BDM",$J,11)=$S($D(BDM(1)):"YES",1:"NO")

 ;

X1 I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,11)="YES":1,1:0),BDMSUB=19 D CUML^BDMDM1

 Q

2 ;

EYE ;

 S BDMX=BDMPD_"^LAST EXAM DIABETIC EYE EXAM"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY)  S ^TMP("BDM",$J,12)=$S($D(BDM(1)):"YES",1:"NO")

 ;

X5 I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,12)="YES":1,1:0),BDMSUB=20 D CUML^BDMDM1

 Q

3 ;

DENTAL S BDMX=BDMPD_"^LAST ADA [DM AUDIT DENTAL EXAM ADA CODES"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY)

 I BDMER S ^TMP("BDM",$J,13)="*** SCRIPT ERROR IN DENTAL^BDMDM2.  CONTACT SITE MANAGER" G X11

 S ^TMP("BDM",$J,13)=$S($D(BDM(1)):"YES",1:"NO")

 I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,13)="YES":1,1:0),BDMSUB=21 D CUML^BDMDM1

X11 Q

4 ;

RECTAL I ^TMP("BDM",$J,503)<40 S ^TMP("BDM",$J,14)="N/A" G X ; age <40

 E  S BDMX=BDMPD_"^LAST EXAM RECTAL"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY) S ^TMP("BDM",$J,14)=$S($D(BDM(1)):"YES",1:"NO")

 I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,14)="YES":1,1:0),BDMSUB=22 D CUML^BDMDM1

X Q

5 ;

PAP I ^TMP("BDM",$J,502)="M" S ^TMP("BDM",$J,28)="N/A" G X2

 S BDMX=BDMPD_"^LAST LAB [DM AUDIT PAP SMEAR TAX"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY) S ^TMP("BDM",$J,28)=$S($D(BDM(1)):"YES",1:"NO")

 I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,28)="YES":1,1:0),BDMSUB=23 D CUML^BDMDM1

X2 Q

6 ;

BREAST I ^TMP("BDM",$J,502)="M" S ^TMP("BDM",$J,16)="N/A" G X3

 S BDMX=BDMPD_"^LAST EXAM BREAST"_BDMDATE S BDMER=$$START1^APCLDF(BDMX,BDMY) S ^TMP("BDM",$J,16)=$S($D(BDM(1)):"YES",1:"NO")

 I BDMCUML S BDMGOT1=$S(^TMP("BDM",$J,16)="YES":1,1:0),BDMSUB=41 D CUML^BDMDM1

X3 Q

7 ;

MAMMOG  ;IHS/CMI/LAB - patch 4 added mammogram screening

 S BDMMAM="",BDMMAMD="" I ^TMP("BDM",$J,502)="M"!(^(503)<40) S ^TMP("BDM",$J,17)="N/A" G X4

 S BDMX=BDMPD_"^LAST RAD MAMMOGRAM BILAT"_";DURING JAN 01,1901-"_BDMEDT

 ;begin Y2K

 ;S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4  I $D(BDM(1)) S ^TMP("BDM",$J,17)="YES",(BDMMAM,BDMMAMD)=$P(BDM(1),U),^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_$E(BDMMAM,2,3) ;Y2000

 S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4  I $D(BDM(1)) S ^TMP("BDM",$J,17)="YES",(BDMMAM,BDMMAMD)=$P(BDM(1),U),^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_(1700+($E(BDMMAM,1,3))) ;Y2000

 ;end Y2K

 S BDMX=BDMPD_"^LAST RAD MAMMOGRAM UNILAT"_";DURING JAN 01,1901-"_BDMEDT

 ;begin Y2k

 ;S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4  I $D(BDM(1)) S ^TMP("BDM",$J,17)="YES",BDMMAM=$P(BDM(1),U) I BDMMAM>BDMMAMD S ^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_$E(BDMMAM,2,3),BDMMAMD=BDMMAM ;Y2000

 S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4  I $D(BDM(1)) S ^TMP("BDM",$J,17)="YES",BDMMAM=$P(BDM(1),U) I BDMMAM>BDMMAMD S ^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_(1700+($E(BDMMAM,1,3))),BDMMAMD=BDMMAM ;Y2000

 ;end Y2K

 S BDMX=BDMPD_"^LAST RAD SCREENING MAMMOGRAM"_";DURING JAN 01,1901-"_BDMEDT

 ;begin Y2K

 ;S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4

 ;S ^TMP("BDM",$J,17)=$S($D(BDM(1)):"YES",1:"NO") I $D(BDM(1)) S BDMMAM=$P(BDM(1),U) I BDMMAM>BDMMAMD S ^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_$E(BDMMAM,2,3),BDMMAMD=BDMMAM

 S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4 ;Y2000

 S ^TMP("BDM",$J,17)=$S($D(BDM(1)):"YES",1:"NO") I $D(BDM(1)) S BDMMAM=$P(BDM(1),U) I BDMMAM>BDMMAMD S ^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_(1700+($E(BDMMAM,1,3))),BDMMAMD=BDMMAM ;Y2000

 ;end Y2K

RCUM  D

 .S BDMMAM=BDMMAMD

 .I BDMCUML,BDMMAM]"" S BDMGOT1=1,BDMSUB=83 D CUML^BDMDM1

 .I BDMCUML,BDMMAM="" S BDMGOT1=0,BDMSUB=83 D CUML^BDMDM1

 .S D=$$FMDIFF^XLFDT(BDMED,BDMMAM),M=D/30.44

 .S A=^TMP("BDM",$J,503)

 .I M<25&(A>39)&(A<50)!(M<13&(A>49)) S ^TMP("BDM",$J,17.2)="YES" Q:'BDMCUML  S BDMGOT1=1,BDMSUB=24 D CUML^BDMDM1 Q

 .S ^TMP("BDM",$J,17.2)="NO" I BDMCUML S BDMGOT1=0,BDMSUB=24 D CUML^BDMDM1

 .Q

X4 I BDMER S ^TMP("BDM",$J,502)="***SCRIPT ERROR IN MAMMOG^BDMDM2.  CONTACT SITE MANAGER"

 Q

 ;

BDMDM2    ; IHS/CMI/LAB -IHS -CONTINUATION OF ROUTINE TO FETCH DATA ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 +2       ;IHS/CMI/LAB - patch 4 y2k and mammography screening

EN        ; - EP - from CLINICAL^BDMDM1

 +1       ;

 +2        FOR BDMI=1:1

               IF $TEXT(@BDMI)=""

                   QUIT 

               KILL BDMX

               SET BDMY="BDM("

               DO @BDMI

               KILL BDM

 +3       ;

 +4        QUIT 

1         ;

FOOT      ;

 +1        SET BDMX=BDMPD_"^LAST EXAM DIABETIC FOOT EXAM"_BDMDATE

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

           SET ^TMP("BDM",$JOB,11)=$SELECT($DATA(BDM(1)):"YES",1:"NO")

 +2       ;

X1         IF BDMCUML

               SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,11)="YES":1,1:0)

               SET BDMSUB=19

               DO CUML^BDMDM1

 +1        QUIT 

2         ;

EYE       ;

 +1        SET BDMX=BDMPD_"^LAST EXAM DIABETIC EYE EXAM"_BDMDATE

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

           SET ^TMP("BDM",$JOB,12)=$SELECT($DATA(BDM(1)):"YES",1:"NO")

 +2       ;

X5         IF BDMCUML

               SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,12)="YES":1,1:0)

               SET BDMSUB=20

               DO CUML^BDMDM1

 +1        QUIT 

3         ;

DENTAL     SET BDMX=BDMPD_"^LAST ADA [DM AUDIT DENTAL EXAM ADA CODES"_BDMDATE

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

 +1        IF BDMER

               SET ^TMP("BDM",$JOB,13)="*** SCRIPT ERROR IN DENTAL^BDMDM2.  CONTACT SITE MANAGER"

               GOTO X11

 +2        SET ^TMP("BDM",$JOB,13)=$SELECT($DATA(BDM(1)):"YES",1:"NO")

 +3        IF BDMCUML

               SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,13)="YES":1,1:0)

               SET BDMSUB=21

               DO CUML^BDMDM1

X11        QUIT 

4         ;

RECTAL    ; age <40

           IF ^TMP("BDM",$JOB,503)<40

               SET ^TMP("BDM",$JOB,14)="N/A"

               GOTO X

 +1       IF '$TEST

               SET BDMX=BDMPD_"^LAST EXAM RECTAL"_BDMDATE

               SET BDMER=$$START1^APCLDF(BDMX,BDMY)

               SET ^TMP("BDM",$JOB,14)=$SELECT($DATA(BDM(1)):"YES",1:"NO")

 +2        IF BDMCUML

               SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,14)="YES":1,1:0)

               SET BDMSUB=22

               DO CUML^BDMDM1

X          QUIT 

5         ;

PAP        IF ^TMP("BDM",$JOB,502)="M"

               SET ^TMP("BDM",$JOB,28)="N/A"

               GOTO X2

 +1        SET BDMX=BDMPD_"^LAST LAB [DM AUDIT PAP SMEAR TAX"_BDMDATE

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

           SET ^TMP("BDM",$JOB,28)=$SELECT($DATA(BDM(1)):"YES",1:"NO")

 +2        IF BDMCUML

               SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,28)="YES":1,1:0)

               SET BDMSUB=23

               DO CUML^BDMDM1

X2         QUIT 

6         ;

BREAST     IF ^TMP("BDM",$JOB,502)="M"

               SET ^TMP("BDM",$JOB,16)="N/A"

               GOTO X3

 +1        SET BDMX=BDMPD_"^LAST EXAM BREAST"_BDMDATE

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

           SET ^TMP("BDM",$JOB,16)=$SELECT($DATA(BDM(1)):"YES",1:"NO")

 +2        IF BDMCUML

               SET BDMGOT1=$SELECT(^TMP("BDM",$JOB,16)="YES":1,1:0)

               SET BDMSUB=41

               DO CUML^BDMDM1

X3         QUIT 

7         ;

MAMMOG    ;IHS/CMI/LAB - patch 4 added mammogram screening

 +1        SET BDMMAM=""

           SET BDMMAMD=""

           IF ^TMP("BDM",$JOB,502)="M"!(^(503)<40)

               SET ^TMP("BDM",$JOB,17)="N/A"

               GOTO X4

 +2        SET BDMX=BDMPD_"^LAST RAD MAMMOGRAM BILAT"_";DURING JAN 01,1901-"_BDMEDT

 +3       ;begin Y2K

 +4       ;S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4  I $D(BDM(1)) S ^TMP("BDM",$J,17)="YES",(BDMMAM,BDMMAMD)=$P(BDM(1),U),^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_$E(BDMMAM,2,3) ;Y2000

 +5       ;Y2000

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

           IF BDMER

               GOTO X4

           IF $DATA(BDM(1))

               SET ^TMP("BDM",$JOB,17)="YES"

               SET (BDMMAM,BDMMAMD)=$PIECE(BDM(1),U)

               SET ^TMP("BDM",$JOB,17.1)=$EXTRACT(BDMMAM,4,5)_"/"_$EXTRACT(BDMMAM,6,7)_"/"_(1700+($EXTRACT(BDMMAM,1,3)))

 +6       ;end Y2K

 +7        SET BDMX=BDMPD_"^LAST RAD MAMMOGRAM UNILAT"_";DURING JAN 01,1901-"_BDMEDT

 +8       ;begin Y2k

 +9       ;S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4  I $D(BDM(1)) S ^TMP("BDM",$J,17)="YES",BDMMAM=$P(BDM(1),U) I BDMMAM>BDMMAMD S ^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_$E(BDMMAM,2,3),BDMMAMD=BDMMAM ;Y2000

 +10      ;Y2000

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

           IF BDMER

               GOTO X4

           IF $DATA(BDM(1))

               SET ^TMP("BDM",$JOB,17)="YES"

               SET BDMMAM=$PIECE(BDM(1),U)

               IF BDMMAM>BDMMAMD

                   SET ^TMP("BDM",$JOB,17.1)=$EXTRACT(BDMMAM,4,5)_"/"_$EXTRACT(BDMMAM,6,7)_"/"_(1700+($EXTRACT(BDMMAM,1,3)))

                   SET BDMMAMD=BDMMAM

 +11      ;end Y2K

 +12       SET BDMX=BDMPD_"^LAST RAD SCREENING MAMMOGRAM"_";DURING JAN 01,1901-"_BDMEDT

 +13      ;begin Y2K

 +14      ;S BDMER=$$START1^APCLDF(BDMX,BDMY) G:BDMER X4

 +15      ;S ^TMP("BDM",$J,17)=$S($D(BDM(1)):"YES",1:"NO") I $D(BDM(1)) S BDMMAM=$P(BDM(1),U) I BDMMAM>BDMMAMD S ^TMP("BDM",$J,17.1)=$E(BDMMAM,4,5)_"/"_$E(BDMMAM,6,7)_"/"_$E(BDMMAM,2,3),BDMMAMD=BDMMAM

 +16      ;Y2000

           SET BDMER=$$START1^APCLDF(BDMX,BDMY)

           IF BDMER

               GOTO X4

 +17      ;Y2000

           SET ^TMP("BDM",$JOB,17)=$SELECT($DATA(BDM(1)):"YES",1:"NO")

           IF $DATA(BDM(1))

               SET BDMMAM=$PIECE(BDM(1),U)

               IF BDMMAM>BDMMAMD

                   SET ^TMP("BDM",$JOB,17.1)=$EXTRACT(BDMMAM,4,5)_"/"_$EXTRACT(BDMMAM,6,7)_"/"_(1700+($EXTRACT(BDMMAM,1,3)))

                   SET BDMMAMD=BDMMAM

 +18      ;end Y2K

RCUM       Begin DoDot:1

 +1            SET BDMMAM=BDMMAMD

 +2            IF BDMCUML

                   IF BDMMAM]""

                       SET BDMGOT1=1

                       SET BDMSUB=83

                       DO CUML^BDMDM1

 +3            IF BDMCUML

                   IF BDMMAM=""

                       SET BDMGOT1=0

                       SET BDMSUB=83

                       DO CUML^BDMDM1

 +4            SET D=$$FMDIFF^XLFDT(BDMED,BDMMAM)

               SET M=D/30.44

 +5            SET A=^TMP("BDM",$JOB,503)

 +6            IF M<25&(A>39)&(A<50)!(M<13&(A>49))

                   SET ^TMP("BDM",$JOB,17.2)="YES"

                   IF 'BDMCUML

                       QUIT 

                   SET BDMGOT1=1

                   SET BDMSUB=24

                   DO CUML^BDMDM1

                   QUIT 

 +7            SET ^TMP("BDM",$JOB,17.2)="NO"

               IF BDMCUML

                   SET BDMGOT1=0

                   SET BDMSUB=24

                   DO CUML^BDMDM1

 +8            QUIT 

           End DoDot:1

X4         IF BDMER

               SET ^TMP("BDM",$JOB,502)="***SCRIPT ERROR IN MAMMOG^BDMDM2.  CONTACT SITE MANAGER"

 +1        QUIT 

 +2       ;