- APCLDM2 ; IHS/CMI/LAB -IHS -CONTINUATION OF ROUTINE TO FETCH DATA ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;IHS/CMI/LAB - patch 4 y2k and mammography screening
- EN ; - EP - from CLINICAL^APCLDM1
- ;
- F APCLI=1:1 Q:$T(@APCLI)="" K APCLX S APCLY="APCL(" D @APCLI K APCL
- ;
- Q
- 1 ;
- S APCLX=APCLPD_"^LAST EXAM DIABETIC FOOT EXAM"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) S ^TMP("APCL",$J,11)=$S($D(APCL(1)):"YES",1:"NO")
- ;
- X1 I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,11)="YES":1,1:0),APCLSUB=19 D CUML^APCLDM1
- Q
- 2 ;
- EYE ;
- S APCLX=APCLPD_"^LAST EXAM DIABETIC EYE EXAM"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) S ^TMP("APCL",$J,12)=$S($D(APCL(1)):"YES",1:"NO")
- ;
- X5 I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,12)="YES":1,1:0),APCLSUB=20 D CUML^APCLDM1
- Q
- 3 ;
- DENTAL S APCLX=APCLPD_"^LAST ADA [DM AUDIT DENTAL EXAM ADA CODES"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY)
- I APCLER S ^TMP("APCL",$J,13)="*** SCRIPT ERROR IN DENTAL^APCLDM2. CONTACT SITE MANAGER" G X11
- S ^TMP("APCL",$J,13)=$S($D(APCL(1)):"YES",1:"NO")
- I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,13)="YES":1,1:0),APCLSUB=21 D CUML^APCLDM1
- X11 Q
- 4 ;
- RECTAL I ^TMP("APCL",$J,503)<40 S ^TMP("APCL",$J,14)="N/A" G X ; age <40
- E S APCLX=APCLPD_"^LAST EXAM RECTAL"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) S ^TMP("APCL",$J,14)=$S($D(APCL(1)):"YES",1:"NO")
- I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,14)="YES":1,1:0),APCLSUB=22 D CUML^APCLDM1
- X Q
- 5 ;
- PAP I ^TMP("APCL",$J,502)="M" S ^TMP("APCL",$J,28)="N/A" G X2
- S APCLX=APCLPD_"^LAST LAB [DM AUDIT PAP SMEAR TAX"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) S ^TMP("APCL",$J,28)=$S($D(APCL(1)):"YES",1:"NO")
- I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,28)="YES":1,1:0),APCLSUB=23 D CUML^APCLDM1
- X2 Q
- 6 ;
- BREAST I ^TMP("APCL",$J,502)="M" S ^TMP("APCL",$J,16)="N/A" G X3
- S APCLX=APCLPD_"^LAST EXAM BREAST"_APCLDATE S APCLER=$$START1^APCLDF(APCLX,APCLY) S ^TMP("APCL",$J,16)=$S($D(APCL(1)):"YES",1:"NO")
- I APCLCUML S APCLGOT1=$S(^TMP("APCL",$J,16)="YES":1,1:0),APCLSUB=41 D CUML^APCLDM1
- X3 Q
- 7 ;
- MAMMOG ;IHS/CMI/LAB - patch 4 added mammogram screening
- S APCLMAM="",APCLMAMD="" I ^TMP("APCL",$J,502)="M"!(^(503)<40) S ^TMP("APCL",$J,17)="N/A" G X4
- S APCLX=APCLPD_"^LAST RAD MAMMOGRAM BILAT"_";DURING JAN 01,1901-"_APCLEDT
- ;begin Y2K
- ;S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4 I $D(APCL(1)) S ^TMP("APCL",$J,17)="YES",(APCLMAM,APCLMAMD)=$P(APCL(1),U),^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_$E(APCLMAM,2,3) ;Y2000
- S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4 I $D(APCL(1)) S ^TMP("APCL",$J,17)="YES",(APCLMAM,APCLMAMD)=$P(APCL(1),U),^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_(1700+($E(APCLMAM,1,3))) ;Y2000
- ;end Y2K
- S APCLX=APCLPD_"^LAST RAD MAMMOGRAM UNILAT"_";DURING JAN 01,1901-"_APCLEDT
- ;begin Y2k
- ;S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4 I $D(APCL(1)) S ^TMP("APCL",$J,17)="YES",APCLMAM=$P(APCL(1),U) I APCLMAM>APCLMAMD S ^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_$E(APCLMAM,2,3),APCLMAMD=APCLMAM ;Y2000
- S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4 I $D(APCL(1)) S ^TMP("APCL",$J,17)="YES",APCLMAM=$P(APCL(1),U) I APCLMAM>APCLMAMD S ^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_(1700+($E(APCLMAM,1,3))),APCLMAMD=APCLMAM ;Y2000
- ;end Y2K
- S APCLX=APCLPD_"^LAST RAD SCREENING MAMMOGRAM"_";DURING JAN 01,1901-"_APCLEDT
- ;begin Y2K
- ;S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4
- ;S ^TMP("APCL",$J,17)=$S($D(APCL(1)):"YES",1:"NO") I $D(APCL(1)) S APCLMAM=$P(APCL(1),U) I APCLMAM>APCLMAMD S ^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_$E(APCLMAM,2,3),APCLMAMD=APCLMAM
- S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4 ;Y2000
- S ^TMP("APCL",$J,17)=$S($D(APCL(1)):"YES",1:"NO") I $D(APCL(1)) S APCLMAM=$P(APCL(1),U) I APCLMAM>APCLMAMD S ^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_(1700+($E(APCLMAM,1,3))),APCLMAMD=APCLMAM ;Y2000
- ;end Y2K
- RCUM D
- .S APCLMAM=APCLMAMD
- .I APCLCUML,APCLMAM]"" S APCLGOT1=1,APCLSUB=83 D CUML^APCLDM1
- .I APCLCUML,APCLMAM="" S APCLGOT1=0,APCLSUB=83 D CUML^APCLDM1
- .S D=$$FMDIFF^XLFDT(APCLED,APCLMAM),M=D/30.44
- .S A=^TMP("APCL",$J,503)
- .I M<25&(A>39)&(A<50)!(M<13&(A>49)) S ^TMP("APCL",$J,17.2)="YES" Q:'APCLCUML S APCLGOT1=1,APCLSUB=24 D CUML^APCLDM1 Q
- .S ^TMP("APCL",$J,17.2)="NO" I APCLCUML S APCLGOT1=0,APCLSUB=24 D CUML^APCLDM1
- .Q
- X4 I APCLER S ^TMP("APCL",$J,502)="***SCRIPT ERROR IN MAMMOG^APCLDM2. CONTACT SITE MANAGER"
- Q
- ;
- APCLDM2 ; IHS/CMI/LAB -IHS -CONTINUATION OF ROUTINE TO FETCH DATA ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;IHS/CMI/LAB - patch 4 y2k and mammography screening
- EN ; - EP - from CLINICAL^APCLDM1
- +1 ;
- +2 FOR APCLI=1:1
- IF $TEXT(@APCLI)=""
- QUIT
- KILL APCLX
- SET APCLY="APCL("
- DO @APCLI
- KILL APCL
- +3 ;
- +4 QUIT
- 1 ;
- +1 SET APCLX=APCLPD_"^LAST EXAM DIABETIC FOOT EXAM"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- SET ^TMP("APCL",$JOB,11)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- +2 ;
- X1 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,11)="YES":1,1:0)
- SET APCLSUB=19
- DO CUML^APCLDM1
- +1 QUIT
- 2 ;
- EYE ;
- +1 SET APCLX=APCLPD_"^LAST EXAM DIABETIC EYE EXAM"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- SET ^TMP("APCL",$JOB,12)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- +2 ;
- X5 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,12)="YES":1,1:0)
- SET APCLSUB=20
- DO CUML^APCLDM1
- +1 QUIT
- 3 ;
- DENTAL SET APCLX=APCLPD_"^LAST ADA [DM AUDIT DENTAL EXAM ADA CODES"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- +1 IF APCLER
- SET ^TMP("APCL",$JOB,13)="*** SCRIPT ERROR IN DENTAL^APCLDM2. CONTACT SITE MANAGER"
- GOTO X11
- +2 SET ^TMP("APCL",$JOB,13)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- +3 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,13)="YES":1,1:0)
- SET APCLSUB=21
- DO CUML^APCLDM1
- X11 QUIT
- 4 ;
- RECTAL ; age <40
- IF ^TMP("APCL",$JOB,503)<40
- SET ^TMP("APCL",$JOB,14)="N/A"
- GOTO X
- +1 IF '$TEST
- SET APCLX=APCLPD_"^LAST EXAM RECTAL"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- SET ^TMP("APCL",$JOB,14)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- +2 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,14)="YES":1,1:0)
- SET APCLSUB=22
- DO CUML^APCLDM1
- X QUIT
- 5 ;
- PAP IF ^TMP("APCL",$JOB,502)="M"
- SET ^TMP("APCL",$JOB,28)="N/A"
- GOTO X2
- +1 SET APCLX=APCLPD_"^LAST LAB [DM AUDIT PAP SMEAR TAX"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- SET ^TMP("APCL",$JOB,28)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- +2 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,28)="YES":1,1:0)
- SET APCLSUB=23
- DO CUML^APCLDM1
- X2 QUIT
- 6 ;
- BREAST IF ^TMP("APCL",$JOB,502)="M"
- SET ^TMP("APCL",$JOB,16)="N/A"
- GOTO X3
- +1 SET APCLX=APCLPD_"^LAST EXAM BREAST"_APCLDATE
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- SET ^TMP("APCL",$JOB,16)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- +2 IF APCLCUML
- SET APCLGOT1=$SELECT(^TMP("APCL",$JOB,16)="YES":1,1:0)
- SET APCLSUB=41
- DO CUML^APCLDM1
- X3 QUIT
- 7 ;
- MAMMOG ;IHS/CMI/LAB - patch 4 added mammogram screening
- +1 SET APCLMAM=""
- SET APCLMAMD=""
- IF ^TMP("APCL",$JOB,502)="M"!(^(503)<40)
- SET ^TMP("APCL",$JOB,17)="N/A"
- GOTO X4
- +2 SET APCLX=APCLPD_"^LAST RAD MAMMOGRAM BILAT"_";DURING JAN 01,1901-"_APCLEDT
- +3 ;begin Y2K
- +4 ;S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4 I $D(APCL(1)) S ^TMP("APCL",$J,17)="YES",(APCLMAM,APCLMAMD)=$P(APCL(1),U),^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_$E(APCLMAM,2,3) ;Y2000
- +5 ;Y2000
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- IF APCLER
- GOTO X4
- IF $DATA(APCL(1))
- SET ^TMP("APCL",$JOB,17)="YES"
- SET (APCLMAM,APCLMAMD)=$PIECE(APCL(1),U)
- SET ^TMP("APCL",$JOB,17.1)=$EXTRACT(APCLMAM,4,5)_"/"_$EXTRACT(APCLMAM,6,7)_"/"_(1700+($EXTRACT(APCLMAM,1,3)))
- +6 ;end Y2K
- +7 SET APCLX=APCLPD_"^LAST RAD MAMMOGRAM UNILAT"_";DURING JAN 01,1901-"_APCLEDT
- +8 ;begin Y2k
- +9 ;S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4 I $D(APCL(1)) S ^TMP("APCL",$J,17)="YES",APCLMAM=$P(APCL(1),U) I APCLMAM>APCLMAMD S ^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_$E(APCLMAM,2,3),APCLMAMD=APCLMAM ;Y2000
- +10 ;Y2000
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- IF APCLER
- GOTO X4
- IF $DATA(APCL(1))
- SET ^TMP("APCL",$JOB,17)="YES"
- SET APCLMAM=$PIECE(APCL(1),U)
- IF APCLMAM>APCLMAMD
- SET ^TMP("APCL",$JOB,17.1)=$EXTRACT(APCLMAM,4,5)_"/"_$EXTRACT(APCLMAM,6,7)_"/"_(1700+($EXTRACT(APCLMAM,1,3)))
- SET APCLMAMD=APCLMAM
- +11 ;end Y2K
- +12 SET APCLX=APCLPD_"^LAST RAD SCREENING MAMMOGRAM"_";DURING JAN 01,1901-"_APCLEDT
- +13 ;begin Y2K
- +14 ;S APCLER=$$START1^APCLDF(APCLX,APCLY) G:APCLER X4
- +15 ;S ^TMP("APCL",$J,17)=$S($D(APCL(1)):"YES",1:"NO") I $D(APCL(1)) S APCLMAM=$P(APCL(1),U) I APCLMAM>APCLMAMD S ^TMP("APCL",$J,17.1)=$E(APCLMAM,4,5)_"/"_$E(APCLMAM,6,7)_"/"_$E(APCLMAM,2,3),APCLMAMD=APCLMAM
- +16 ;Y2000
- SET APCLER=$$START1^APCLDF(APCLX,APCLY)
- IF APCLER
- GOTO X4
- +17 ;Y2000
- SET ^TMP("APCL",$JOB,17)=$SELECT($DATA(APCL(1)):"YES",1:"NO")
- IF $DATA(APCL(1))
- SET APCLMAM=$PIECE(APCL(1),U)
- IF APCLMAM>APCLMAMD
- SET ^TMP("APCL",$JOB,17.1)=$EXTRACT(APCLMAM,4,5)_"/"_$EXTRACT(APCLMAM,6,7)_"/"_(1700+($EXTRACT(APCLMAM,1,3)))
- SET APCLMAMD=APCLMAM
- +18 ;end Y2K
- RCUM Begin DoDot:1
- +1 SET APCLMAM=APCLMAMD
- +2 IF APCLCUML
- IF APCLMAM]""
- SET APCLGOT1=1
- SET APCLSUB=83
- DO CUML^APCLDM1
- +3 IF APCLCUML
- IF APCLMAM=""
- SET APCLGOT1=0
- SET APCLSUB=83
- DO CUML^APCLDM1
- +4 SET D=$$FMDIFF^XLFDT(APCLED,APCLMAM)
- SET M=D/30.44
- +5 SET A=^TMP("APCL",$JOB,503)
- +6 IF M<25&(A>39)&(A<50)!(M<13&(A>49))
- SET ^TMP("APCL",$JOB,17.2)="YES"
- IF 'APCLCUML
- QUIT
- SET APCLGOT1=1
- SET APCLSUB=24
- DO CUML^APCLDM1
- QUIT
- +7 SET ^TMP("APCL",$JOB,17.2)="NO"
- IF APCLCUML
- SET APCLGOT1=0
- SET APCLSUB=24
- DO CUML^APCLDM1
- +8 QUIT
- End DoDot:1
- X4 IF APCLER
- SET ^TMP("APCL",$JOB,502)="***SCRIPT ERROR IN MAMMOG^APCLDM2. CONTACT SITE MANAGER"
- +1 QUIT
- +2 ;
