BDMVRL42 ; IHS/CMI/LAB - VIEW PT RECORD CON'T ; 09 Nov 2017 3:26 PM
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51
;MOVED VARIOUS SUBROUTINES INTO BDMVRL42
;
;
FUHEAD ;EP;TO SET UP HEADER
N BDMP,X,Y,Z,XX,YY,ZZ
S VALMCNT=0
D FUH1
S A=""
F S A=$O(^TMP("BDMTMP",$J,A)) Q:A="" D
.Q:A="FUL"
.S Y=""
.F S Y=$O(^TMP("BDMTMP",$J,A,Y)) Q:Y="" D
..S DFN=$G(^TMP("BDMTMP",$J,A,Y))
..S BDMP=""
..F S BDMP=$O(^TMP("BDMTMP",$J,A,Y,BDMP)) Q:BDMP="" D
...S BDM=""
...F S BDM=$O(^TMP("BDMTMP",$J,A,Y,BDMP,BDM)) Q:BDM="" D
....S BDMX=$G(^TMP("BDMTMP",$J,A,Y,BDMP,BDM))
....Q:BDMX=""
....S X=$E(A,1,16)
....S $E(X,17)=$E(Y,1,24)
....S $E(X,41)=$P(BDMX,U,2)
....S $E(X,48)=$P(BDMX,U)
....D Z(X)
..I $D(BDMFUAPP) D APP^BDMVRL6(DFN,BDMBEGIN,BDMEND)
Q
FUH1 ;EP;
S:'$G(BDMPAGE) BDMPAGE=1
I $G(BDMGUI),BDMPAGE'=1 D
. S X="ZZZZZZZ"
. D Z(X)
K X,Z
S Z=BDM("STATUS")
S Z=$S(Z="A":"Active",Z="I":"Inactive",Z="T":"Transient",Z="U":"Unreviewed",Z="D":"Deceased",Z="N":"Non-IHS",Z="NON":"Noncompliant",Z="Z":"All Register Patients",1:"")
S $E(X,6)=BDMREGNM_" Register - "_Z_" Patients"
D Z(X)
K X
S $E(X,6)="Follow-up Report: "_$S($D(BDM("FOLLOW-UP TYPE HEAD")):BDM("FOLLOW-UP TYPE HEAD"),'$D(BDM("ALL")):BDM("FOLLOW-UP TYPE"),1:"ALL FOLLOW-UP NEEDS")
S $E(X,65)="Page: "_BDMPAGE
D Z(X)
I $G(BDM("DM DIAGNOSIS"))]"" D
.K X
.S $E(X,6)="(For ** "_BDM("DM DIAGNOSIS")_" ** Diabetics Only.)"
.D Z(X)
K X
S $E(X,6)="(For Patients due now or within the next 30 days)"
D Z(X)
I '$D(BDM("ALL")),BDM("FOLLOW-UP TYPE")["SGOT/SGPT" D
.S X=""
.S $E(X,28)="(Patient on REZULIN or METFORMIN without"
.D Z(X)
.S X=""
.S $E(X,29)="SGOT or SGPT in past 4 months.)"
.D Z(X)
S Y=DT
X ^DD("DD")
S X=" REPORT DATE: "_Y
D Z(X)
S X=""
D Z(X)
I BDMK["WHER" D
.S X="WHERE"
.D Z(X)
S X=$S(BDMK["COMM":"COMMUNITY",BDMK["PROV":"PROVIDER ",1:"FOLLOWED")
S X=X_" PATIENT HRN STATUS"
D Z(X)
S X="--------------- ----------------------- ------ --------------------"
D Z(X)
Q
APPT ;EP;TO INCLUDE PATIENT APPOINTMENTS ON THE FOLLOW-UP REPORT
S DIR(0)="YO"
S DIR("A",1)="Include list of patient's"
S DIR("A")="upcoming appointments"
S DIR("B")="NO"
W !
D DIR^BDMFDIC
I Y<1 K BDMQUIT Q
D ^BDMDATE
I '$G(BDMBEGIN)!'$G(BDMEND) D Q
.W !,"The beginning and/or ending date for the appointments was not indicated."
.W !,"Upcoming patient appointments will not be included."
S BDMFUAPP=""
Q
PROTO ;EP;TO PRINT PROTOCOL
S (ZTRTN,BDMRTN)="P1^BDMVRL42"
D ^BDMFZIS
Q
P1 ;EP;TO PRINT PROTOCOL LISTING
S VALMCNT=0
I IO'=IO(0) D Q
.W @IOF
.D PHEAD
.D P11
S BDMVALM="BDM FOLLOW-UP PROTOCOL"
D VALM^BDMVRL(BDMVALM)
Q
PINIT ;
D PHEAD
D P11
Q
PHEAD ;PROTOCOL HEADER
K X
S $E(X,5)="DMS Follow-up Protocol Listing"
D Z(X)
Q
P11 S X="Foot Exam Annually"
D Z(X)
S X="Eye Exam Annually"
D Z(X)
S X="Rectal Exam Annually"
D Z(X)
S X="Depression Screening Annually"
D Z(X)
S X="Breast Exam Annually"
D Z(X)
S X="Mammography Annually"
D Z(X)
S X="Hypertension Annually"
D Z(X)
S X="Nutrition Possible Hypertension, No Ace Inhibitors or ARB"
D Z(X)
S X="Physical Activity Annually"
D Z(X)
S X="General Info Annually"
D Z(X)
S X="Flu Shot Annually"
D Z(X)
S X="Pneumococcal Every 6 years"
D Z(X)
S X="Td Every 10 years"
D Z(X)
S X="PPD Annually unless PPD positive or Hx of TB treatment"
D Z(X)
S X="LDL Cholesterol xxxxxxxx"
D Z(X)
S X="HDL Cholesterol xxxxxxxx"
D Z(X)
S X="Cholesterol xxxxxxxx"
D Z(X)
S X="Triglyceride xxxxxxxx"
D Z(X)
S X="Creatinine xxxxxxxx"
D Z(X)
S X="Hemoglobin A1c xxxxxxxx"
D Z(X)
S X="Liver Function xxxxxxxx"
D Z(X)
S X="Hepatitis C Screening Born 1945-1965 once"
D Z(X)
S X="Estimated GFR xxxxxxxx"
D Z(X)
S X="A/C Ratio xxxxxxxx"
D Z(X)
Q
Z(X) ;SET TMP NODE
I IO'=IO(0) W !,X Q
S VALMCNT=VALMCNT+1
S ^TMP("BDMVR",$J,VALMCNT,0)=X
Q
ZZ(X) ;SET TMP NODE
S VALMCNT=VALMCNT+1
S ^TMP("BDMVR",$J,VALMCNT,0)=X
Q
;MOVED VARIOUS SUBROUTINES INTO BDMVRL42
SCREEN ;EP;LIST FU REPORT CHOICES
N I,J,K,X,Y,Z
F I=1:1:4 D
.S X=$T(@("S"_I)+1)
.S Y=$P(X,";",2)
.S Z=$P(X,";",3)
.S BDM("REPORT",Y)=$P(X,";",4)
.W !?8
.W Y,?$X+6,Z
.S L=65-$X
.F K=1:1:L W "-"
.F J=2:1 S X=$T(@("S"_I)+J) Q:$P(X,";",2)="" D
..S Y=$P(X,";",2)
..S Z=$P(X,";",3)
..S BDM("REPORT",Y)=$P(X,";",4)
..W:J#2 ?40
..W:'(J#2) !?10
..W ?$X,Y,?$X+3,Z
Q
SSET ;EP;SCREEN SET
N I,J,K,X,Y,Z
F I=1:1:4 D
.S X=$T(@("S"_I)+1)
.S Y=$P(X,";",2)
.S Z=$P(X,";",3)
.S BDM("REPORT",Y)=$P(X,";",4)
.F J=2:1 S X=$T(@("S"_I)+J) Q:$P(X,";",2)="" D
..S Y=$P(X,";",2)
..S Z=$P(X,";",3)
..S BDM("REPORT",Y)=$P(X,";",4)
D ALL
D PARSE
S BDMLET=2
S:$G(BDMK)="" BDMK="COMM"
D FUGET^BDMVRL4
K BDMLET
Q
ALL ;EP;ALL Patients requiring Follow-up
S BDM("ALL")=""
S Y=""
S Y="11,12,14,18,21,22,23,31,32,33,34,35,41,42,43,44,45,46,47,48,49"
S BDMY=Y
Q
PARSE ;EP;TO PARSE ENTRIES
F J=1:1:$L(BDMY,",") D
.S X=$P(BDMY,",",J)
.I X=1!(X=2)!(X=3)!(X=4) D Q
..S:X=1 BDM("FOLLOW-UP TYPE HEAD")="ALL Exams/Procedures"
..S:X=2 BDM("FOLLOW-UP TYPE HEAD")="ALL Patient Education"
..S:X=3 BDM("FOLLOW-UP TYPE HEAD")="ALL Immunizations/Vaccines"
..S:X=4 BDM("FOLLOW-UP TYPE HEAD")="ALL Lab Tests"
..S A=(X_0)
..S B=(X+1)_0
..F K=A:1:B I $D(BDM("REPORT",K)) S BDM("PARSE",K)=""
.I X,X'["-",$D(BDM("REPORT",X)) S BDM("PARSE",X)="" Q
.S A=$P(X,"-")
.S B=$P(X,"-",2)
.F K=A:1:B I $D(BDM("REPORT",K)) S BDM("PARSE",K)=""
Q
FURESULT ;EP;FIND LAST VISIT AND RESULT OF FU
K BDM("VISIT"),BDMQUIT,BDMNOGO
S Z=999999999
F S Z=$O(@BDMGBL@("AC",DFN,Z),-1) Q:'Z!$D(BDMQUIT) I $D(BDM("IEN",+$G(@BDMGBL@(Z,0)))) S BDMV0=^(0),BDMVDA=$P(BDMV0,U,3) D:BDMVDA
.S BDMVDATE=$P($P($G(^AUPNVSIT(BDMVDA,0)),U),".")
.Q:'BDMVDATE
.I BDMFU="PPD" D Q:BDMVDATE=9999999
..S BDM("PPD")=$P($G(^AUPNVSK(Z,0)),U,4,5)
..I $P(BDM("PPD"),U)="P"!($P(BDM("PPD"),U,2)>9) S BDMVDATE=9999999,BDMQUIT=""
.I BDMFU="UPRO" D Q:BDMVDATE=9999999
..I "Pp"[$E($P(BDMV0,U,4)) S BDMVDATE=9999999
..I $P(BDMV0,U,4),$P($G(^AUPNVLAB(Z,11)),U,4),$P(BDMV0,U,4)>$P(^(11),U,4) S BDMVDATE=9999999
..S ZZ=Z
..F S ZZ=$O(^AUPNVLAB("AC",DFN,ZZ)) Q:'ZZ!$D(BDMQUIT) D
...S BDMV0=$G(^AUPNVLAB(ZZ,0))
...I "^1665044^9999382^9999383^9999570^"[(U_+BDMV0_U) D
....S BDMVDA=$P(BDMV0,U,3)
....S BDMVDATE=$P($P($G(^AUPNVSIT(BDMVDA,0)),U),".")
.S BDMVDATE=9999999-BDMVDATE
.I BDMVDATE S BDM("VISIT",BDMVDATE)="",BDMQUIT=""
Q:$G(BDMVDATE)=9999999
S BDMDOA=$$DODX^BDMDG16(DFN,BDMRDA,"I")
S Z=$O(BDM("VISIT",0)) I Z S Z=9999999-Z I Z>BDMDOA S BDMQUIT="" Q
K BDMQUIT
S Z=$O(BDM("VISIT",0))
Q
S1 ;;
;1;ALL Exams/Procedures;ALL EXAMS
;11;Foot Exam;FTEX
;12;Eye Exam;EYE
;14;Depression Screening;DEP
;18;Dental Exam;DENT
;;
;
S2 ;;
;2;ALL Patient Education;ALL EDUCATION
;21;Nutrition;NTED
;22;Physical Activity;EXER
;23;General Info;GENI
;;
;
S3 ;;
;3;ALL Immunizations/Vaccines;ALL VACCINES
;31;Seasonal Flu Shot;FLU
;32;Pneumococcal;PNEU
;33;Td/Tdap;TD
;34;TB Test;PPD
;35;Hepatitis B;HEPB
;
S4 ;;
;4;ALL Lab Tests;ALL LAB TESTS
;41;LDL Cholesterol;LDL
;42;HDL Cholesterol;HDL
;43;Cholesterol;CHOL
;44;Triglyceride;TRIG
;45;Creatinine;CREA
;46;Hemoglobin A1c;HGB
;47;Estimated GFR;GFR
;48;A/C Ratio;UACR
;49;Hepatitis C Screening;HEPC
;
BDMVRL42 ; IHS/CMI/LAB - VIEW PT RECORD CON'T ; 09 Nov 2017 3:26 PM
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51
+2 ;MOVED VARIOUS SUBROUTINES INTO BDMVRL42
+3 ;
+4 ;
FUHEAD ;EP;TO SET UP HEADER
+1 NEW BDMP,X,Y,Z,XX,YY,ZZ
+2 SET VALMCNT=0
+3 DO FUH1
+4 SET A=""
+5 FOR
SET A=$ORDER(^TMP("BDMTMP",$JOB,A))
IF A=""
QUIT
Begin DoDot:1
+6 IF A="FUL"
QUIT
+7 SET Y=""
+8 FOR
SET Y=$ORDER(^TMP("BDMTMP",$JOB,A,Y))
IF Y=""
QUIT
Begin DoDot:2
+9 SET DFN=$GET(^TMP("BDMTMP",$JOB,A,Y))
+10 SET BDMP=""
+11 FOR
SET BDMP=$ORDER(^TMP("BDMTMP",$JOB,A,Y,BDMP))
IF BDMP=""
QUIT
Begin DoDot:3
+12 SET BDM=""
+13 FOR
SET BDM=$ORDER(^TMP("BDMTMP",$JOB,A,Y,BDMP,BDM))
IF BDM=""
QUIT
Begin DoDot:4
+14 SET BDMX=$GET(^TMP("BDMTMP",$JOB,A,Y,BDMP,BDM))
+15 IF BDMX=""
QUIT
+16 SET X=$EXTRACT(A,1,16)
+17 SET $EXTRACT(X,17)=$EXTRACT(Y,1,24)
+18 SET $EXTRACT(X,41)=$PIECE(BDMX,U,2)
+19 SET $EXTRACT(X,48)=$PIECE(BDMX,U)
+20 DO Z(X)
End DoDot:4
End DoDot:3
+21 IF $DATA(BDMFUAPP)
DO APP^BDMVRL6(DFN,BDMBEGIN,BDMEND)
End DoDot:2
End DoDot:1
+22 QUIT
FUH1 ;EP;
+1 IF '$GET(BDMPAGE)
SET BDMPAGE=1
+2 IF $GET(BDMGUI)
IF BDMPAGE'=1
Begin DoDot:1
+3 SET X="ZZZZZZZ"
+4 DO Z(X)
End DoDot:1
+5 KILL X,Z
+6 SET Z=BDM("STATUS")
+7 SET Z=$SELECT(Z="A":"Active",Z="I":"Inactive",Z="T":"Transient",Z="U":"Unreviewed",Z="D":"Deceased",Z="N":"Non-IHS",Z="NON":"Noncompliant",Z="Z":"All Register Patients",1:"")
+8 SET $EXTRACT(X,6)=BDMREGNM_" Register - "_Z_" Patients"
+9 DO Z(X)
+10 KILL X
+11 SET $EXTRACT(X,6)="Follow-up Report: "_$SELECT($DATA(BDM("FOLLOW-UP TYPE HEAD")):BDM("FOLLOW-UP TYPE HEAD"),'$DATA(BDM("ALL")):BDM("FOLLOW-UP TYPE"),1:"ALL FOLLOW-UP NEEDS")
+12 SET $EXTRACT(X,65)="Page: "_BDMPAGE
+13 DO Z(X)
+14 IF $GET(BDM("DM DIAGNOSIS"))]""
Begin DoDot:1
+15 KILL X
+16 SET $EXTRACT(X,6)="(For ** "_BDM("DM DIAGNOSIS")_" ** Diabetics Only.)"
+17 DO Z(X)
End DoDot:1
+18 KILL X
+19 SET $EXTRACT(X,6)="(For Patients due now or within the next 30 days)"
+20 DO Z(X)
+21 IF '$DATA(BDM("ALL"))
IF BDM("FOLLOW-UP TYPE")["SGOT/SGPT"
Begin DoDot:1
+22 SET X=""
+23 SET $EXTRACT(X,28)="(Patient on REZULIN or METFORMIN without"
+24 DO Z(X)
+25 SET X=""
+26 SET $EXTRACT(X,29)="SGOT or SGPT in past 4 months.)"
+27 DO Z(X)
End DoDot:1
+28 SET Y=DT
+29 XECUTE ^DD("DD")
+30 SET X=" REPORT DATE: "_Y
+31 DO Z(X)
+32 SET X=""
+33 DO Z(X)
+34 IF BDMK["WHER"
Begin DoDot:1
+35 SET X="WHERE"
+36 DO Z(X)
End DoDot:1
+37 SET X=$SELECT(BDMK["COMM":"COMMUNITY",BDMK["PROV":"PROVIDER ",1:"FOLLOWED")
+38 SET X=X_" PATIENT HRN STATUS"
+39 DO Z(X)
+40 SET X="--------------- ----------------------- ------ --------------------"
+41 DO Z(X)
+42 QUIT
APPT ;EP;TO INCLUDE PATIENT APPOINTMENTS ON THE FOLLOW-UP REPORT
+1 SET DIR(0)="YO"
+2 SET DIR("A",1)="Include list of patient's"
+3 SET DIR("A")="upcoming appointments"
+4 SET DIR("B")="NO"
+5 WRITE !
+6 DO DIR^BDMFDIC
+7 IF Y<1
KILL BDMQUIT
QUIT
+8 DO ^BDMDATE
+9 IF '$GET(BDMBEGIN)!'$GET(BDMEND)
Begin DoDot:1
+10 WRITE !,"The beginning and/or ending date for the appointments was not indicated."
+11 WRITE !,"Upcoming patient appointments will not be included."
End DoDot:1
QUIT
+12 SET BDMFUAPP=""
+13 QUIT
PROTO ;EP;TO PRINT PROTOCOL
+1 SET (ZTRTN,BDMRTN)="P1^BDMVRL42"
+2 DO ^BDMFZIS
+3 QUIT
P1 ;EP;TO PRINT PROTOCOL LISTING
+1 SET VALMCNT=0
+2 IF IO'=IO(0)
Begin DoDot:1
+3 WRITE @IOF
+4 DO PHEAD
+5 DO P11
End DoDot:1
QUIT
+6 SET BDMVALM="BDM FOLLOW-UP PROTOCOL"
+7 DO VALM^BDMVRL(BDMVALM)
+8 QUIT
PINIT ;
+1 DO PHEAD
+2 DO P11
+3 QUIT
PHEAD ;PROTOCOL HEADER
+1 KILL X
+2 SET $EXTRACT(X,5)="DMS Follow-up Protocol Listing"
+3 DO Z(X)
+4 QUIT
P11 SET X="Foot Exam Annually"
+1 DO Z(X)
+2 SET X="Eye Exam Annually"
+3 DO Z(X)
+4 SET X="Rectal Exam Annually"
+5 DO Z(X)
+6 SET X="Depression Screening Annually"
+7 DO Z(X)
+8 SET X="Breast Exam Annually"
+9 DO Z(X)
+10 SET X="Mammography Annually"
+11 DO Z(X)
+12 SET X="Hypertension Annually"
+13 DO Z(X)
+14 SET X="Nutrition Possible Hypertension, No Ace Inhibitors or ARB"
+15 DO Z(X)
+16 SET X="Physical Activity Annually"
+17 DO Z(X)
+18 SET X="General Info Annually"
+19 DO Z(X)
+20 SET X="Flu Shot Annually"
+21 DO Z(X)
+22 SET X="Pneumococcal Every 6 years"
+23 DO Z(X)
+24 SET X="Td Every 10 years"
+25 DO Z(X)
+26 SET X="PPD Annually unless PPD positive or Hx of TB treatment"
+27 DO Z(X)
+28 SET X="LDL Cholesterol xxxxxxxx"
+29 DO Z(X)
+30 SET X="HDL Cholesterol xxxxxxxx"
+31 DO Z(X)
+32 SET X="Cholesterol xxxxxxxx"
+33 DO Z(X)
+34 SET X="Triglyceride xxxxxxxx"
+35 DO Z(X)
+36 SET X="Creatinine xxxxxxxx"
+37 DO Z(X)
+38 SET X="Hemoglobin A1c xxxxxxxx"
+39 DO Z(X)
+40 SET X="Liver Function xxxxxxxx"
+41 DO Z(X)
+42 SET X="Hepatitis C Screening Born 1945-1965 once"
+43 DO Z(X)
+44 SET X="Estimated GFR xxxxxxxx"
+45 DO Z(X)
+46 SET X="A/C Ratio xxxxxxxx"
+47 DO Z(X)
+48 QUIT
Z(X) ;SET TMP NODE
+1 IF IO'=IO(0)
WRITE !,X
QUIT
+2 SET VALMCNT=VALMCNT+1
+3 SET ^TMP("BDMVR",$JOB,VALMCNT,0)=X
+4 QUIT
ZZ(X) ;SET TMP NODE
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("BDMVR",$JOB,VALMCNT,0)=X
+3 QUIT
+4 ;MOVED VARIOUS SUBROUTINES INTO BDMVRL42
SCREEN ;EP;LIST FU REPORT CHOICES
+1 NEW I,J,K,X,Y,Z
+2 FOR I=1:1:4
Begin DoDot:1
+3 SET X=$TEXT(@("S"_I)+1)
+4 SET Y=$PIECE(X,";",2)
+5 SET Z=$PIECE(X,";",3)
+6 SET BDM("REPORT",Y)=$PIECE(X,";",4)
+7 WRITE !?8
+8 WRITE Y,?$X+6,Z
+9 SET L=65-$X
+10 FOR K=1:1:L
WRITE "-"
+11 FOR J=2:1
SET X=$TEXT(@("S"_I)+J)
IF $PIECE(X,";",2)=""
QUIT
Begin DoDot:2
+12 SET Y=$PIECE(X,";",2)
+13 SET Z=$PIECE(X,";",3)
+14 SET BDM("REPORT",Y)=$PIECE(X,";",4)
+15 IF J#2
WRITE ?40
+16 IF '(J#2)
WRITE !?10
+17 WRITE ?$X,Y,?$X+3,Z
End DoDot:2
End DoDot:1
+18 QUIT
SSET ;EP;SCREEN SET
+1 NEW I,J,K,X,Y,Z
+2 FOR I=1:1:4
Begin DoDot:1
+3 SET X=$TEXT(@("S"_I)+1)
+4 SET Y=$PIECE(X,";",2)
+5 SET Z=$PIECE(X,";",3)
+6 SET BDM("REPORT",Y)=$PIECE(X,";",4)
+7 FOR J=2:1
SET X=$TEXT(@("S"_I)+J)
IF $PIECE(X,";",2)=""
QUIT
Begin DoDot:2
+8 SET Y=$PIECE(X,";",2)
+9 SET Z=$PIECE(X,";",3)
+10 SET BDM("REPORT",Y)=$PIECE(X,";",4)
End DoDot:2
End DoDot:1
+11 DO ALL
+12 DO PARSE
+13 SET BDMLET=2
+14 IF $GET(BDMK)=""
SET BDMK="COMM"
+15 DO FUGET^BDMVRL4
+16 KILL BDMLET
+17 QUIT
ALL ;EP;ALL Patients requiring Follow-up
+1 SET BDM("ALL")=""
+2 SET Y=""
+3 SET Y="11,12,14,18,21,22,23,31,32,33,34,35,41,42,43,44,45,46,47,48,49"
+4 SET BDMY=Y
+5 QUIT
PARSE ;EP;TO PARSE ENTRIES
+1 FOR J=1:1:$LENGTH(BDMY,",")
Begin DoDot:1
+2 SET X=$PIECE(BDMY,",",J)
+3 IF X=1!(X=2)!(X=3)!(X=4)
Begin DoDot:2
+4 IF X=1
SET BDM("FOLLOW-UP TYPE HEAD")="ALL Exams/Procedures"
+5 IF X=2
SET BDM("FOLLOW-UP TYPE HEAD")="ALL Patient Education"
+6 IF X=3
SET BDM("FOLLOW-UP TYPE HEAD")="ALL Immunizations/Vaccines"
+7 IF X=4
SET BDM("FOLLOW-UP TYPE HEAD")="ALL Lab Tests"
+8 SET A=(X_0)
+9 SET B=(X+1)_0
+10 FOR K=A:1:B
IF $DATA(BDM("REPORT",K))
SET BDM("PARSE",K)=""
End DoDot:2
QUIT
+11 IF X
IF X'["-"
IF $DATA(BDM("REPORT",X))
SET BDM("PARSE",X)=""
QUIT
+12 SET A=$PIECE(X,"-")
+13 SET B=$PIECE(X,"-",2)
+14 FOR K=A:1:B
IF $DATA(BDM("REPORT",K))
SET BDM("PARSE",K)=""
End DoDot:1
+15 QUIT
FURESULT ;EP;FIND LAST VISIT AND RESULT OF FU
+1 KILL BDM("VISIT"),BDMQUIT,BDMNOGO
+2 SET Z=999999999
+3 FOR
SET Z=$ORDER(@BDMGBL@("AC",DFN,Z),-1)
IF 'Z!$DATA(BDMQUIT)
QUIT
IF $DATA(BDM("IEN",+$GET(@BDMGBL@(Z,0))))
SET BDMV0=^(0)
SET BDMVDA=$PIECE(BDMV0,U,3)
IF BDMVDA
Begin DoDot:1
+4 SET BDMVDATE=$PIECE($PIECE($GET(^AUPNVSIT(BDMVDA,0)),U),".")
+5 IF 'BDMVDATE
QUIT
+6 IF BDMFU="PPD"
Begin DoDot:2
+7 SET BDM("PPD")=$PIECE($GET(^AUPNVSK(Z,0)),U,4,5)
+8 IF $PIECE(BDM("PPD"),U)="P"!($PIECE(BDM("PPD"),U,2)>9)
SET BDMVDATE=9999999
SET BDMQUIT=""
End DoDot:2
IF BDMVDATE=9999999
QUIT
+9 IF BDMFU="UPRO"
Begin DoDot:2
+10 IF "Pp"[$EXTRACT($PIECE(BDMV0,U,4))
SET BDMVDATE=9999999
+11 IF $PIECE(BDMV0,U,4)
IF $PIECE($GET(^AUPNVLAB(Z,11)),U,4)
IF $PIECE(BDMV0,U,4)>$PIECE(^(11),U,4)
SET BDMVDATE=9999999
+12 SET ZZ=Z
+13 FOR
SET ZZ=$ORDER(^AUPNVLAB("AC",DFN,ZZ))
IF 'ZZ!$DATA(BDMQUIT)
QUIT
Begin DoDot:3
+14 SET BDMV0=$GET(^AUPNVLAB(ZZ,0))
+15 IF "^1665044^9999382^9999383^9999570^"[(U_+BDMV0_U)
Begin DoDot:4
+16 SET BDMVDA=$PIECE(BDMV0,U,3)
+17 SET BDMVDATE=$PIECE($PIECE($GET(^AUPNVSIT(BDMVDA,0)),U),".")
End DoDot:4
End DoDot:3
End DoDot:2
IF BDMVDATE=9999999
QUIT
+18 SET BDMVDATE=9999999-BDMVDATE
+19 IF BDMVDATE
SET BDM("VISIT",BDMVDATE)=""
SET BDMQUIT=""
End DoDot:1
+20 IF $GET(BDMVDATE)=9999999
QUIT
+21 SET BDMDOA=$$DODX^BDMDG16(DFN,BDMRDA,"I")
+22 SET Z=$ORDER(BDM("VISIT",0))
IF Z
SET Z=9999999-Z
IF Z>BDMDOA
SET BDMQUIT=""
QUIT
+23 KILL BDMQUIT
+24 SET Z=$ORDER(BDM("VISIT",0))
+25 QUIT
S1 ;;
+1 ;1;ALL Exams/Procedures;ALL EXAMS
+2 ;11;Foot Exam;FTEX
+3 ;12;Eye Exam;EYE
+4 ;14;Depression Screening;DEP
+5 ;18;Dental Exam;DENT
+6 ;;
+7 ;
S2 ;;
+1 ;2;ALL Patient Education;ALL EDUCATION
+2 ;21;Nutrition;NTED
+3 ;22;Physical Activity;EXER
+4 ;23;General Info;GENI
+5 ;;
+6 ;
S3 ;;
+1 ;3;ALL Immunizations/Vaccines;ALL VACCINES
+2 ;31;Seasonal Flu Shot;FLU
+3 ;32;Pneumococcal;PNEU
+4 ;33;Td/Tdap;TD
+5 ;34;TB Test;PPD
+6 ;35;Hepatitis B;HEPB
+7 ;
S4 ;;
+1 ;4;ALL Lab Tests;ALL LAB TESTS
+2 ;41;LDL Cholesterol;LDL
+3 ;42;HDL Cholesterol;HDL
+4 ;43;Cholesterol;CHOL
+5 ;44;Triglyceride;TRIG
+6 ;45;Creatinine;CREA
+7 ;46;Hemoglobin A1c;HGB
+8 ;47;Estimated GFR;GFR
+9 ;48;A/C Ratio;UACR
+10 ;49;Hepatitis C Screening;HEPC
+11 ;
