- 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 ;
- 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 ;
- +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 ;
