APCHS11B ; IHS/CMI/LAB - CONTINUATION OF ROUTINES ;
;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
;
; ******************** SURVEILLANCE - HARD CODE ********************
HEIGHT ;
Q:APCHSAGE>18
S APCHSMSC="01" D MEASDFN
Q:'APCHSMSD
S APCHSDIS="HEIGHT"
;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSMSD,""))
S APCHSIVD=$$LASTMSR(APCHSPAT,APCHSMSD)
I 'APCHSIVD S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11 Q
I APCHSAGE'>.5 S APCHSDUE="MAY BE DUE NOW" D GETDATE^APCHS11,DISPLAY^APCHS11 Q
I APCHSAGE'>1 S APCHSINT=60 D PRINT Q
I APCHSAGE'>6 S APCHSINT=90 D PRINT Q
I APCHSAGE'>16 S APCHSINT=180 S APCHSDD=1 D PRINT K APCHSDD Q
Q
;
WEIGHT ;
S APCHSMSC="02" D MEASDFN
Q:'APCHSMSD
S APCHSDIS="WEIGHT"
;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSMSD,""))
S APCHSIVD=$$LASTMSR(APCHSPAT,APCHSMSD)
I 'APCHSIVD S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11 Q
I APCHSAGE'>.5 S APCHSDUE="MAY BE DUE NOW" D GETDATE^APCHS11,DISPLAY^APCHS11 Q
I APCHSAGE'>1 S APCHSINT=60 D PRINT Q
I APCHSAGE'>6 S APCHSINT=90 D PRINT Q
I APCHSAGE'>16 S APCHSINT=180 S APCHSDD=1 D PRINT K APCHSDD Q
I APCHSAGE>16 S APCHSINT=365 S APCHSDD=1 D PRINT K APCHSDD Q
Q
;
LASTMSR(P,T) ;return date of the last measurement T
NEW X,Y,Z,D
S Z=""
S D=0 F S D=$O(^AUPNVMSR("AA",P,T,D)) Q:D'=+D!(Z]"") D
.S Y=0 F S Y=$O(^AUPNVMSR("AA",P,T,D,Y)) Q:Y'=+Y!(Z]"") D
..Q:$P($G(^AUPNVMSR(Y,2)),U,1) ;entered in error
..S Z=D
Q Z
HEAD ;
Q:APCHSAGE'<(14/12)
S APCHSMSC="06" D MEASDFN
Q:'APCHSMSD
S APCHSDIS="HEAD CIRCUMFERENCE"
;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSMSD,""))
S APCHSIVD=$$LASTMSR(APCHSPAT,APCHSMSD) ;entere in error check
I 'APCHSIVD S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11 Q
I APCHSAGE'>.5 S APCHSDUE="MAY BE DUE NOW" D GETDATE^APCHS11,DISPLAY^APCHS11 Q
I APCHSAGE'>1 S APCHSINT=60 D PRINT Q
I APCHSAGE<(14/12) S APCHSINT=90 D PRINT Q
Q
;
MEASDFN ;ENTRY POINT
S APCHSMSD=$O(^AUTTMSR("C",APCHSMSC,""))
Q
;
BP ;
Q:APCHSAGE'>5
I $D(^ATXAX("B","SURVEILLANCE DIABETES")) S APCHSURD=$O(^ATXAX("B","SURVEILLANCE DIABETES","")) S:$D(^ATXPAT(APCHSURD,11,APCHSPAT)) APCHSYRY=""
I '$D(APCHSYRY),$D(^ATXAX("B","SURVEILLANCE HYPERTENSION")) S APCHSURD=$O(^ATXAX("B","SURVEILLANCE HYPERTENSION","")) S:$D(^ATXPAT(APCHSURD,11,APCHSPAT)) APCHSYRY=""
I '$D(APCHSYRY),$D(^ATXAX("B","SURVEILLANCE OBESITY")) S APCHSURD=$O(^ATXAX("B","SURVEILLANCE OBESITY","")) S:$D(^ATXPAT(APCHSURD,11,APCHSPAT)) APCHSYRY=""
S APCHSBP="BP"
S APCHSDIS="BLOOD PRESSURE"
S APCHSINT=365
S APCHSBP=$O(^AUTTMSR("B",APCHSBP,""))
Q:'APCHSBP&('$D(APCHSYRY))
I 'APCHSBP S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11 Q
;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSBP,""))
S APCHSIVD=$$LASTMSR(APCHSPAT,APCHSBP)
I 'APCHSIVD,APCHSAGE'>10 S X1=APCHSDOB,X2=365*10 D C^%DTC S Y=X X APCHSCVD S APCHSDUE=Y,APCHSDAT="" D DISPLAY^APCHS11 Q
I 'APCHSIVD S APCHSDUE="MAY BE DUE NOW",APCHSDAT="" D DISPLAY^APCHS11 Q
I $D(APCHSYRY) S APCHSDUE="MAY BE DUE NOW" D GETDATE^APCHS11,DISPLAY^APCHS11 Q
D PASTAGE^APCHS11
I APCHSOLD'>5,APCHSAGE'>10 S X1=APCHSDOB,X2=365*10 D C^%DTC S Y=X X APCHSCVD S APCHSDUE=Y D GETDATE^APCHS11,DISPLAY^APCHS11 Q
I APCHSOLD'>5 S APCHSDUE="CHECK NOW" D GETDATE^APCHS11,DISPLAY^APCHS11 Q
I APCHSAGE'<20 D PRINT
Q
;
RECTAL ;
Q:APCHSAGE<45
S APCHSEXN="14"
S APCHSDIS="RECTAL"
S APCHSINT=365
D REGEXAM^APCHS11
Q
;
TONOM ;
Q:APCHSAGE<40
S APCHSEXN=26
S APCHSDIS="TONOMETRY"
S APCHSINT=$S(APCHSAGE<61:365*3,1:365)
D REGEXAM^APCHS11
Q
;
PRINT ;CALL TO GETDATE, COMPARE, AND DISPLAY IN APCHS11
D GETDATE^APCHS11,COMPARE^APCHS11,DISPLAY^APCHS11
Q
;
APCHS11B ; IHS/CMI/LAB - CONTINUATION OF ROUTINES ;
+1 ;;2.0;IHS PCC SUITE;**4**;MAY 14, 2009
+2 ;
+3 ; ******************** SURVEILLANCE - HARD CODE ********************
HEIGHT ;
+1 IF APCHSAGE>18
QUIT
+2 SET APCHSMSC="01"
DO MEASDFN
+3 IF 'APCHSMSD
QUIT
+4 SET APCHSDIS="HEIGHT"
+5 ;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSMSD,""))
+6 SET APCHSIVD=$$LASTMSR(APCHSPAT,APCHSMSD)
+7 IF 'APCHSIVD
SET APCHSDUE="MAY BE DUE NOW"
SET APCHSDAT=""
DO DISPLAY^APCHS11
QUIT
+8 IF APCHSAGE'>.5
SET APCHSDUE="MAY BE DUE NOW"
DO GETDATE^APCHS11
DO DISPLAY^APCHS11
QUIT
+9 IF APCHSAGE'>1
SET APCHSINT=60
DO PRINT
QUIT
+10 IF APCHSAGE'>6
SET APCHSINT=90
DO PRINT
QUIT
+11 IF APCHSAGE'>16
SET APCHSINT=180
SET APCHSDD=1
DO PRINT
KILL APCHSDD
QUIT
+12 QUIT
+13 ;
WEIGHT ;
+1 SET APCHSMSC="02"
DO MEASDFN
+2 IF 'APCHSMSD
QUIT
+3 SET APCHSDIS="WEIGHT"
+4 ;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSMSD,""))
+5 SET APCHSIVD=$$LASTMSR(APCHSPAT,APCHSMSD)
+6 IF 'APCHSIVD
SET APCHSDUE="MAY BE DUE NOW"
SET APCHSDAT=""
DO DISPLAY^APCHS11
QUIT
+7 IF APCHSAGE'>.5
SET APCHSDUE="MAY BE DUE NOW"
DO GETDATE^APCHS11
DO DISPLAY^APCHS11
QUIT
+8 IF APCHSAGE'>1
SET APCHSINT=60
DO PRINT
QUIT
+9 IF APCHSAGE'>6
SET APCHSINT=90
DO PRINT
QUIT
+10 IF APCHSAGE'>16
SET APCHSINT=180
SET APCHSDD=1
DO PRINT
KILL APCHSDD
QUIT
+11 IF APCHSAGE>16
SET APCHSINT=365
SET APCHSDD=1
DO PRINT
KILL APCHSDD
QUIT
+12 QUIT
+13 ;
LASTMSR(P,T) ;return date of the last measurement T
+1 NEW X,Y,Z,D
+2 SET Z=""
+3 SET D=0
FOR
SET D=$ORDER(^AUPNVMSR("AA",P,T,D))
IF D'=+D!(Z]"")
QUIT
Begin DoDot:1
+4 SET Y=0
FOR
SET Y=$ORDER(^AUPNVMSR("AA",P,T,D,Y))
IF Y'=+Y!(Z]"")
QUIT
Begin DoDot:2
+5 ;entered in error
IF $PIECE($GET(^AUPNVMSR(Y,2)),U,1)
QUIT
+6 SET Z=D
End DoDot:2
End DoDot:1
+7 QUIT Z
HEAD ;
+1 IF APCHSAGE'<(14/12)
QUIT
+2 SET APCHSMSC="06"
DO MEASDFN
+3 IF 'APCHSMSD
QUIT
+4 SET APCHSDIS="HEAD CIRCUMFERENCE"
+5 ;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSMSD,""))
+6 ;entere in error check
SET APCHSIVD=$$LASTMSR(APCHSPAT,APCHSMSD)
+7 IF 'APCHSIVD
SET APCHSDUE="MAY BE DUE NOW"
SET APCHSDAT=""
DO DISPLAY^APCHS11
QUIT
+8 IF APCHSAGE'>.5
SET APCHSDUE="MAY BE DUE NOW"
DO GETDATE^APCHS11
DO DISPLAY^APCHS11
QUIT
+9 IF APCHSAGE'>1
SET APCHSINT=60
DO PRINT
QUIT
+10 IF APCHSAGE<(14/12)
SET APCHSINT=90
DO PRINT
QUIT
+11 QUIT
+12 ;
MEASDFN ;ENTRY POINT
+1 SET APCHSMSD=$ORDER(^AUTTMSR("C",APCHSMSC,""))
+2 QUIT
+3 ;
BP ;
+1 IF APCHSAGE'>5
QUIT
+2 IF $DATA(^ATXAX("B","SURVEILLANCE DIABETES"))
SET APCHSURD=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",""))
IF $DATA(^ATXPAT(APCHSURD,11,APCHSPAT))
SET APCHSYRY=""
+3 IF '$DATA(APCHSYRY)
IF $DATA(^ATXAX("B","SURVEILLANCE HYPERTENSION"))
SET APCHSURD=$ORDER(^ATXAX("B","SURVEILLANCE HYPERTENSION",""))
IF $DATA(^ATXPAT(APCHSURD,11,APCHSPAT))
SET APCHSYRY=""
+4 IF '$DATA(APCHSYRY)
IF $DATA(^ATXAX("B","SURVEILLANCE OBESITY"))
SET APCHSURD=$ORDER(^ATXAX("B","SURVEILLANCE OBESITY",""))
IF $DATA(^ATXPAT(APCHSURD,11,APCHSPAT))
SET APCHSYRY=""
+5 SET APCHSBP="BP"
+6 SET APCHSDIS="BLOOD PRESSURE"
+7 SET APCHSINT=365
+8 SET APCHSBP=$ORDER(^AUTTMSR("B",APCHSBP,""))
+9 IF 'APCHSBP&('$DATA(APCHSYRY))
QUIT
+10 IF 'APCHSBP
SET APCHSDUE="MAY BE DUE NOW"
SET APCHSDAT=""
DO DISPLAY^APCHS11
QUIT
+11 ;S APCHSIVD=$O(^AUPNVMSR("AA",APCHSPAT,APCHSBP,""))
+12 SET APCHSIVD=$$LASTMSR(APCHSPAT,APCHSBP)
+13 IF 'APCHSIVD
IF APCHSAGE'>10
SET X1=APCHSDOB
SET X2=365*10
DO C^%DTC
SET Y=X
XECUTE APCHSCVD
SET APCHSDUE=Y
SET APCHSDAT=""
DO DISPLAY^APCHS11
QUIT
+14 IF 'APCHSIVD
SET APCHSDUE="MAY BE DUE NOW"
SET APCHSDAT=""
DO DISPLAY^APCHS11
QUIT
+15 IF $DATA(APCHSYRY)
SET APCHSDUE="MAY BE DUE NOW"
DO GETDATE^APCHS11
DO DISPLAY^APCHS11
QUIT
+16 DO PASTAGE^APCHS11
+17 IF APCHSOLD'>5
IF APCHSAGE'>10
SET X1=APCHSDOB
SET X2=365*10
DO C^%DTC
SET Y=X
XECUTE APCHSCVD
SET APCHSDUE=Y
DO GETDATE^APCHS11
DO DISPLAY^APCHS11
QUIT
+18 IF APCHSOLD'>5
SET APCHSDUE="CHECK NOW"
DO GETDATE^APCHS11
DO DISPLAY^APCHS11
QUIT
+19 IF APCHSAGE'<20
DO PRINT
+20 QUIT
+21 ;
RECTAL ;
+1 IF APCHSAGE<45
QUIT
+2 SET APCHSEXN="14"
+3 SET APCHSDIS="RECTAL"
+4 SET APCHSINT=365
+5 DO REGEXAM^APCHS11
+6 QUIT
+7 ;
TONOM ;
+1 IF APCHSAGE<40
QUIT
+2 SET APCHSEXN=26
+3 SET APCHSDIS="TONOMETRY"
+4 SET APCHSINT=$SELECT(APCHSAGE<61:365*3,1:365)
+5 DO REGEXAM^APCHS11
+6 QUIT
+7 ;
PRINT ;CALL TO GETDATE, COMPARE, AND DISPLAY IN APCHS11
+1 DO GETDATE^APCHS11
DO COMPARE^APCHS11
DO DISPLAY^APCHS11
+2 QUIT
+3 ;
