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