APCHS11D ; IHS/CMI/LAB - AND VISION EXAM CHECK ;
;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
;
;Checks in both V MEASUREMENT and V EXAM file to see if vision/hearing measurement or exam occurred
;
; ******************** SURVEILLANCE - HARD CODE ********************
VISION ;
I APCHSAGE>15!(APCHSAGE<7) G X1
S APCHSDIS="VISION EXAM"
S APCHS("NO DISPLAY")=0 ;This variable set to one if vision exam occurred based on check of V MEASUREMENT file or V EXAM file
S APCHSEXC="S APCHSIVD=$$LASTMSR^APCHS11B(APCHSPAT,APCHSMSD)" F APCHSMSC="07","08" Q:APCHS("NO DISPLAY") D MEASDFN^APCHS11B I APCHSMSD D PROCESS
I APCHS("NO DISPLAY") G X1
S APCHSEXC="S APCHSIVD=$O(^AUPNVXAM(""AA"",APCHSPAT,APCHSEXD,""""))" F APCHSEXN=19 Q:APCHS("NO DISPLAY") D EXAMDFN^APCHS11 I APCHSEXD D PROCESS
I 'APCHS("NO DISPLAY") S APCHSEXD=$O(^AUTTEXAM("C",19,0)),APCHSDF1=9999999.15 D REFDF^APCHS11,DISPLAY
X1 K APCHS("NO DISPLAY"),APCHSYNG
Q
;
HEARING ;
I APCHSAGE>15!(APCHSAGE<7) G X2
S APCHSDIS="HEARING EXAM"
S APCHS("NO DISPLAY")=0 ;This variable set to one if hearing exam occurred based on check of V MEASUREMENT file or V EXAM file
S APCHSEXC="S APCHSIVD=$$LASTMSR^APCHS11B(APCHSPAT,APCHSMSD)" F APCHSMSC="10","09" Q:APCHS("NO DISPLAY") D MEASDFN^APCHS11B I APCHSMSD D PROCESS
I APCHS("NO DISPLAY") G X2
S APCHSEXC="S APCHSIVD=$O(^AUPNVXAM(""AA"",APCHSPAT,APCHSEXD,""""))" F APCHSEXN=17,23,24 Q:APCHS("NO DISPLAY") D EXAMDFN^APCHS11 I APCHSEXD D PROCESS
I 'APCHS("NO DISPLAY") D
.S APCHSEXD=$O(^AUTTEXAM("C",17,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
.I '$D(APCHSTEX) S APCHSEXD=$O(^AUTTEXAM("C",23,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
.I '$D(APCHSTEX) S APCHSEXD=$O(^AUTTEXAM("C",24,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
.D DISPLAY
X2 K APCHS("NO DISPLAY"),APCHSYNG,APCHSEXC
Q
;
HEARACCL ;
I APCHSAGE>18!(APCHSAGE<1) G X5
S APCHSDIS="HEARING EXAM"
S APCHSEXC="S APCHSIVD=$$LASTMSR^APCHS11B(APCHSPAT,APCHSMSD)" F APCHSMSC="10","09" D MEASDFN^APCHS11B I APCHSMSD D ACCLYR
S APCHSEXC="S APCHSIVD=$O(^AUPNVXAM(""AA"",APCHSPAT,APCHSEXD,""""))" F APCHSEXN=17,23,24 D EXAMDFN^APCHS11 I APCHSEXD D ACCLYR
I '$D(APCHSACL) S APCHSDIS="HEARING EXAM",APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D G X5
.S APCHSEXD=$O(^AUTTEXAM("C",17,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
.I '$D(APCHSTEX) S APCHSEXD=$O(^AUTTEXAM("C",23,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
.I '$D(APCHSTEX) S APCHSEXD=$O(^AUTTEXAM("C",24,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
.D DISPLAY^APCHS11
D PROCACCL
X5 K APCHSEXC,APCHSACL
Q
;
PROCESS ;CHECKS V MEASUREMENT FILE OR V EXAM FILE FOR ENTRIES
X APCHSEXC
I 'APCHSIVD G X3
D PASTAGE^APCHS11
I APCHSOLD<4 S APCHSYNG=$S('$D(APCHSYNG):APCHSIVD,APCHSYNG<APCHSIVD:APCHSYNG,1:APCHSIVD) ;Displays date on health summary of when last hearing/vision meas. occurred
E S APCHS("NO DISPLAY")=1
X3 Q
;
ACCLYR ; PLACE DATES IN ARRAY
X APCHSEXC
I APCHSIVD S APCHSACL(APCHSIVD)=""
K APCHSIVD
Q
;
PROCACCL ;DETERMINE IF HEARING TEST DUE BASED ON ACCELERATED (YEARLY) SCHEDULE
S APCHSIVD=$O(APCHSACL(""))
S APCHSINT=365
S APCHSDIS="HEARING EXAM"
D GETDATE^APCHS11,COMPARE^APCHS11
S APCHSEXD=$O(^AUTTEXAM("C",17,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
I '$D(APCHSTEX) S APCHSEXD=$O(^AUTTEXAM("C",23,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
I '$D(APCHSTEX) S APCHSEXD=$O(^AUTTEXAM("C",24,0)),APCHSDF1=9999999.15 D REFDF^APCHS11
D DISPLAY^APCHS11
Q
;
DISPLAY ;DISPLAY "MAY BE DUE NOW" PROMPT IF APPROPRIATE
I $D(APCHSYNG) S APCHSDUE="MAY BE DUE NOW",APCHSIVD=APCHSYNG D GETDATE^APCHS11,DISPLAY^APCHS11 G X6
S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11
X6 Q
;
APCHS11D ; IHS/CMI/LAB - AND VISION EXAM CHECK ;
+1 ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
+2 ;
+3 ;Checks in both V MEASUREMENT and V EXAM file to see if vision/hearing measurement or exam occurred
+4 ;
+5 ; ******************** SURVEILLANCE - HARD CODE ********************
VISION ;
+1 IF APCHSAGE>15!(APCHSAGE<7)
GOTO X1
+2 SET APCHSDIS="VISION EXAM"
+3 ;This variable set to one if vision exam occurred based on check of V MEASUREMENT file or V EXAM file
SET APCHS("NO DISPLAY")=0
+4 SET APCHSEXC="S APCHSIVD=$$LASTMSR^APCHS11B(APCHSPAT,APCHSMSD)"
FOR APCHSMSC="07","08"
IF APCHS("NO DISPLAY")
QUIT
DO MEASDFN^APCHS11B
IF APCHSMSD
DO PROCESS
+5 IF APCHS("NO DISPLAY")
GOTO X1
+6 SET APCHSEXC="S APCHSIVD=$O(^AUPNVXAM(""AA"",APCHSPAT,APCHSEXD,""""))"
FOR APCHSEXN=19
IF APCHS("NO DISPLAY")
QUIT
DO EXAMDFN^APCHS11
IF APCHSEXD
DO PROCESS
+7 IF 'APCHS("NO DISPLAY")
SET APCHSEXD=$ORDER(^AUTTEXAM("C",19,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
DO DISPLAY
X1 KILL APCHS("NO DISPLAY"),APCHSYNG
+1 QUIT
+2 ;
HEARING ;
+1 IF APCHSAGE>15!(APCHSAGE<7)
GOTO X2
+2 SET APCHSDIS="HEARING EXAM"
+3 ;This variable set to one if hearing exam occurred based on check of V MEASUREMENT file or V EXAM file
SET APCHS("NO DISPLAY")=0
+4 SET APCHSEXC="S APCHSIVD=$$LASTMSR^APCHS11B(APCHSPAT,APCHSMSD)"
FOR APCHSMSC="10","09"
IF APCHS("NO DISPLAY")
QUIT
DO MEASDFN^APCHS11B
IF APCHSMSD
DO PROCESS
+5 IF APCHS("NO DISPLAY")
GOTO X2
+6 SET APCHSEXC="S APCHSIVD=$O(^AUPNVXAM(""AA"",APCHSPAT,APCHSEXD,""""))"
FOR APCHSEXN=17,23,24
IF APCHS("NO DISPLAY")
QUIT
DO EXAMDFN^APCHS11
IF APCHSEXD
DO PROCESS
+7 IF 'APCHS("NO DISPLAY")
Begin DoDot:1
+8 SET APCHSEXD=$ORDER(^AUTTEXAM("C",17,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+9 IF '$DATA(APCHSTEX)
SET APCHSEXD=$ORDER(^AUTTEXAM("C",23,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+10 IF '$DATA(APCHSTEX)
SET APCHSEXD=$ORDER(^AUTTEXAM("C",24,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+11 DO DISPLAY
End DoDot:1
X2 KILL APCHS("NO DISPLAY"),APCHSYNG,APCHSEXC
+1 QUIT
+2 ;
HEARACCL ;
+1 IF APCHSAGE>18!(APCHSAGE<1)
GOTO X5
+2 SET APCHSDIS="HEARING EXAM"
+3 SET APCHSEXC="S APCHSIVD=$$LASTMSR^APCHS11B(APCHSPAT,APCHSMSD)"
FOR APCHSMSC="10","09"
DO MEASDFN^APCHS11B
IF APCHSMSD
DO ACCLYR
+4 SET APCHSEXC="S APCHSIVD=$O(^AUPNVXAM(""AA"",APCHSPAT,APCHSEXD,""""))"
FOR APCHSEXN=17,23,24
DO EXAMDFN^APCHS11
IF APCHSEXD
DO ACCLYR
+5 IF '$DATA(APCHSACL)
SET APCHSDIS="HEARING EXAM"
SET APCHSDUE="MAY BE DUE NOW"
SET APCHSDAT=""
Begin DoDot:1
+6 SET APCHSEXD=$ORDER(^AUTTEXAM("C",17,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+7 IF '$DATA(APCHSTEX)
SET APCHSEXD=$ORDER(^AUTTEXAM("C",23,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+8 IF '$DATA(APCHSTEX)
SET APCHSEXD=$ORDER(^AUTTEXAM("C",24,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+9 DO DISPLAY^APCHS11
End DoDot:1
GOTO X5
+10 DO PROCACCL
X5 KILL APCHSEXC,APCHSACL
+1 QUIT
+2 ;
PROCESS ;CHECKS V MEASUREMENT FILE OR V EXAM FILE FOR ENTRIES
+1 XECUTE APCHSEXC
+2 IF 'APCHSIVD
GOTO X3
+3 DO PASTAGE^APCHS11
+4 ;Displays date on health summary of when last hearing/vision meas. occurred
IF APCHSOLD<4
SET APCHSYNG=$SELECT('$DATA(APCHSYNG):APCHSIVD,APCHSYNG<APCHSIVD:APCHSYNG,1:APCHSIVD)
+5 IF '$TEST
SET APCHS("NO DISPLAY")=1
X3 QUIT
+1 ;
ACCLYR ; PLACE DATES IN ARRAY
+1 XECUTE APCHSEXC
+2 IF APCHSIVD
SET APCHSACL(APCHSIVD)=""
+3 KILL APCHSIVD
+4 QUIT
+5 ;
PROCACCL ;DETERMINE IF HEARING TEST DUE BASED ON ACCELERATED (YEARLY) SCHEDULE
+1 SET APCHSIVD=$ORDER(APCHSACL(""))
+2 SET APCHSINT=365
+3 SET APCHSDIS="HEARING EXAM"
+4 DO GETDATE^APCHS11
DO COMPARE^APCHS11
+5 SET APCHSEXD=$ORDER(^AUTTEXAM("C",17,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+6 IF '$DATA(APCHSTEX)
SET APCHSEXD=$ORDER(^AUTTEXAM("C",23,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+7 IF '$DATA(APCHSTEX)
SET APCHSEXD=$ORDER(^AUTTEXAM("C",24,0))
SET APCHSDF1=9999999.15
DO REFDF^APCHS11
+8 DO DISPLAY^APCHS11
+9 QUIT
+10 ;
DISPLAY ;DISPLAY "MAY BE DUE NOW" PROMPT IF APPROPRIATE
+1 IF $DATA(APCHSYNG)
SET APCHSDUE="MAY BE DUE NOW"
SET APCHSIVD=APCHSYNG
DO GETDATE^APCHS11
DO DISPLAY^APCHS11
GOTO X6
+2 SET APCHSDUE="MAY BE DUE NOW"
SET APCHSDAT=""
DO DISPLAY^APCHS11
X6 QUIT
+1 ;
