BDMVRL41 ; IHS/CMI/LAB - VIEW PT RECORD CON'T ; 09 Feb 2010 7:42 AM
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51
;
;MOVED VARIOUS SUBROUTINES TO BDMVRL42 TO CONTROL ROUTINE SIZE
;
IEN ;EP;DETERMINE IEN ARRAY DEPENDING ON TYPE OF FOLLOW-UP BEING DONE
K BDM("IEN")
D @BDMFU
Q
RADIEN ;RADIOLOGY IEN
MAM S BDM("FOLLOW-UP TYPE")="MAMMOGRAM"
F Z="BILA","DIAGNOSTI","SCREENIN","UNILA" D
.S XX="MAMMOGRAM "_Z
.S X=XX
.F S X=$O(^RAMIS(71,"B",X)) Q:X=""!(X'[XX) D
..S Y=0
..F S Y=$O(^RAMIS(71,"B",X,Y)) Q:'Y S BDM("IEN",Y)=""
Q
LABIEN ;LAB IENS
N X,Y,Z,XX
PAP S Z="PAP SMEAR"
S BDM("FOLLOW-UP TYPE")="PAP SMEAR"
S (X,XX)="PAP SMEA"
F S X=$O(^LAB(60,"B",X)) Q:X=""!(X'[XX) D
.S Y=$O(^LAB(60,"B",X,0))
.S:Y BDM("IEN",Y)=""
Q
CHOL S BDM("FOLLOW-UP TYPE")="CHOLESTEROL"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
LDL S BDM("FOLLOW-UP TYPE")="LDL"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
HDL S BDM("FOLLOW-UP TYPE")="HDL"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT HDL TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
TRIG S BDM("FOLLOW-UP TYPE")="TRIGLYCERIDE"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT TRIGLYCERIDE TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
CREA S BDM("FOLLOW-UP TYPE")="CREATININE"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT CREATININE TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
HGB S BDM("FOLLOW-UP TYPE")="HGB A1C"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))
S X2=-150
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
LIVR S BDM("FOLLOW-UP TYPE")="SGOT/SGPT"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT LIVER FUNCTION TAX",0))
S BDM("LIVER MEDS TAX")=$O(^ATXAX("B","DM AUDIT LIVER MEDS",0))
S X2=-90
F XX="SGO","SGP" D
.S X=XX
.F S X=$O(^LAB(60,"B",X)) Q:X=""!(X'[XX) D
..S Y=$O(^LAB(60,"B",X,0))
..S:Y BDM("IEN",Y)=""
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
UPRO S BDM("FOLLOW-UP TYPE")="MICROALBUMIN"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
URIN S BDM("FOLLOW-UP TYPE")="UA/Urine Protein"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
S BDMTAX=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
GFR S BDM("FOLLOW-UP TYPE")="ESTIMATED GFR"
S BDMTAX=$O(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
UACR S BDM("FOLLOW-UP TYPE")="A/C RATIO"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT QUANT UACR",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
UPT S BDM("FOLLOW-UP TYPE")="URINE PROTEIN TESTING"
S BDMTAX=$O(^ATXLAB("B","DM AUDIT QUANT UACR",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" D
.S BDM("IEN",X)=""
Q
EKG S BDM("FOLLOW-UP TYPE")="EKG"
Q
EXAMIEN ;EXAM IENS
N X,Y,Z
DENT ;EP;USE V EXAM INSTEAD OF V DENTAL
S BDM("FOLLOW-UP TYPE")="DENTAL EXAM"
S X=$O(^AUTTEXAM("C","30",0))
S:X BDM("IEN",X)=""
Q
RECT S Z="RECTAL EXAM"
D EXAM
Q
BRST F Z="BREAST EXAM","CLINICAL BREAST EXAM" D
.D EXAM
Q
FTEX S Z="FOOT EXAM"
D EXAM
Q
EYE S Z="EYE EXAM"
D EXAM
Q
DEP ;
S Z="DEPRESSION SCR"
D EXAM
Q
EXAM S X=""
F S X=$O(^AUTTEXAM("B",X)) Q:X="" D:X[Z
.S Y=$O(^AUTTEXAM("B",X,0))
.S:Y BDM("IEN",Y)=""
S BDM("FOLLOW-UP TYPE")=Z
Q
IMMIEN ;IMMUNIZATIONS IENS
N X,Y
FLU S (Z,BDM("FOLLOW-UP TYPE"))="INFLUENZA"
D IMM
Q
PNEU S (Z,BDM("FOLLOW-UP TYPE"))="PNEUMO"
S X2=-2160
D IMM
Q
HEPC S (Z,BDM("FOLLOW-UP TYPE"))="HEP C SCREEN"
S X2=-2160
Q
HEPB S (Z,BDM("FOLLOW-UP TYPE"))="HEPB"
Q
TD S BDM("FOLLOW-UP TYPE")="TD",Z="TETANUS"
S X2=-3620
D IMM
Q
IMM S X=""
F S X=$O(^AUTTIMM("B",X)) Q:X="" D:X[Z
.S Y=0
.F S Y=$O(^AUTTIMM("B",X,Y)) Q:'Y S BDM("IEN",Y)=""
Q
HEPA ;EP
S BDM("FOLLOW-UP TYPE")="HEPB",Z="HEPB"
D IMM
Q
SKINIEN ;SKIN TESTS IENS
N X,Y
PPD S (Z,BDM("FOLLOW-UP TYPE"))="PPD"
S X=""
F S X=$O(^AUTTSK("B",X)) Q:X="" D:X[Z
.S Y=0
.F S Y=$O(^AUTTSK("B",X,Y)) Q:'Y S BDM("IEN",Y)=""
Q
EDIEN ;FIND EDUCATION TOPIC IENS
NTED S (Z,BDM("FOLLOW-UP TYPE"))="NUTRITION"
D ED
Q
COMP S (Z,BDM("FOLLOW-UP TYPE"))="COMPLICATIONS"
D ED
Q
DIET S (Z,BDM("FOLLOW-UP TYPE"))="DIET"
D ED
Q
DISE S (Z,BDM("FOLLOW-UP TYPE"))="DISEASE PROCESS"
D ED
Q
EXER S (Z,BDM("FOLLOW-UP TYPE"))="PHYSICAL ACTIVITY"
D ED
Q
GENI S (Z,BDM("FOLLOW-UP TYPE"))="GENERAL INFORMATION"
D ED
Q
LIFE S (Z,BDM("FOLLOW-UP TYPE"))="LIFESYLE CHANGES"
D ED
Q
MEDS S (Z,BDM("FOLLOW-UP TYPE"))="MEDICATIONS"
D ED
Q
FUP S (Z,BDM("FOLLOW-UP TYPE"))="FOLLOW-UP PROCEDURES"
D ED
Q
FTED S (Z,BDM("FOLLOW-UP TYPE"))="FOOT CARE"
D ED
Q
ED S X=$O(^AUTTEDT("B",("DM-"_Z),0))
Q:'X
S BDM("IEN",X)=""
I BDMFU'="NTED",BDMFU'="EXER" F X=1:1:9 S:X'=4 BDM("IEN",X)=""
Q
HTN ;EP;HYPERTENSION FU
K BDMHTN,BDM("IEN")
D HTN1
Q:'$D(BDMHTN)
K BDMMEDS
D HTNMEDS
I $D(BDMMEDS) K BDMMEDS Q
S BDM("FOLLOW-UP TYPE")="HYPERTENSION"
S X="Possible HTN, NO ACE-I or ARB"
D FUOUT^BDMVRL4
Q
HTN1 S BDMTAX=$O(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" S BDM("IEN",X)=""
S BDMTAX=$O(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))
S X=0
F S X=$O(^ATXLAB(+BDMTAX,21,"B",X)) Q:X="" S BDM("IEN",X)=""
F X=1665044,9999382,9999383,9999570 S BDM("IEN",X)=""
S X=0
F S X=$O(BDM("IEN",X)) Q:'X D
.S Y=0
.F S Y=$O(^AUPNVLAB("AA",DFN,X,Y)) Q:'Y D
..S Z=0
..F S Z=$O(^AUPNVLAB("AA",DFN,X,Y,Z)) Q:'Z D
...I $P($G(^AUPNVLAB(Z,0)),U,4)>$P($G(^AUPNVLAB(Z,11)),U,5) S BDMHTN=""
Q:$D(BDMHTN)
HTNMEDS ;CHECK FOR HTN MEDS
K BDM("IEN")
S BDMTAX=$O(^ATXAX("B","DM AUDIT ACE INHIBITORS",0))
Q:'BDMTAX
S X=0
F S X=$O(^ATXAX(+BDMTAX,21,"B",X)) Q:X="" S BDM("IEN",X)=""
S Y=$O(^PS(50.605,"B","CV805",0))
Q:'Y
S X=0
F S X=$O(^PSDRUG("VAC",Y,X)) Q:'X S BDM("IEN",X)=""
S X=0
F S X=$O(^AUPNVMED("AA",DFN,X)) Q:'X D
.S Y=0
.F S Y=$O(^AUPNVMED("AA",DFN,X,Y)) Q:'Y!$D(BDMMEDS) S:$D(BDM("IEN",+$G(^AUPNVMED(Y,0)))) BDMMEDS=""
Q
LPAP ;EP;LAST PAP
S BDM("FOLLOW-UP TYPE")="PAP SMEAR"
S Z=9999999-$$LASTPAP^BDMLPM(DFN)
I $$HYSTER^BDMLPM(DFN) S Z=9999999-DT
D X2
Q
LMAM ;EP;LAST MAMM
S BDM("FOLLOW-UP TYPE")="MAMMOGRAM"
S Z=9999999-$$LASTMAM^BDMLPM(DFN)
I $$MAS^BDMLPM(DFN) S Z=9999999-DT
D X2
Q
APCLEXAM ;EP;LAST EXAM
; FOR EACH OF THESE Z WILL BE RETURNED AS THE DATE OF THE LAST OR NULL IF NONE
I BDMFU="FTEX" D
.S BDM("FOLLOW-UP TYPE")="FOOT EXAM"
.S Z=$$DFE^BDMDG17(DFN,"","","D",1)
I BDMFU="EYE" D
.S BDM("FOLLOW-UP TYPE")="EYE EXAM"
.S Z=$P($$EYE^BDMDG17(DFN,"","","D",1),U,1)
I BDMFU="DENT" D
.S BDM("FOLLOW-UP TYPE")="DENTAL EXAM"
.S Z=$$DENTAL^BDMDG17(DFN,"","","D",1)
I BDMFU="DEP" D
.S BDM("FOLLOW-UP TYPE")="DEPRESSION SCR"
.S Z=$$DEPSCR^BDMDG12(DFN,"","","D",1)
;I BDMFU="EKG" D
;.S BDM("FOLLOW-UP TYPE")="EKG"
;.S Z=$$EKG^BDMDG12(DFN,DT,"D")
I Z="" D FUNO^BDMVRL4 Q ;no test ever
S Z=9999999-Z
X2 ;
I Z=9999999 D FUNO^BDMVRL4 Q
;I $$FMDIFF^XLFDT(DT,Z)<330 D EDONE^BDMVRL4 Q ;no need, is current
K X2
I BDMFU="EKG" S X2=-1795
D FULAST^BDMVRL4
D ENTRY^BDMVRL4
Q
APCLED ;EP;LAST MAMM
I BDMFU="NTED" D
.S BDM("FOLLOW-UP TYPE")="NUTRITION ED"
.S Z=$$DIETEDUC^BDMLPM(DFN,$$FMADD^XLFDT(DT,-(5*365)),DT)
I BDMFU="EXER" D
.S BDM("FOLLOW-UP TYPE")="PHYSICAL ACTIVITY ED"
.S Z=$$EXEDUC^BDMLPM(DFN,$$FMADD^XLFDT(DT,-(5*365)),DT)
I BDMFU="GENI" D
.S BDM("FOLLOW-UP TYPE")="OTHER ED"
.S Z=$$OTHEDUC^BDMLPM(DFN,$$FMADD^XLFDT(DT,-(5*365)),DT)
I Z="" D FUNO^BDMVRL4 Q
S Z=$P(Z,".")
K X2
D FULAST^BDMVRL4
D ENTRY^BDMVRL4
Q
FLUC ;EP
S (Z,BDM("FOLLOW-UP TYPE"))="INFLUENZA"
S Z=$$FLU^BDMDG13(DFN,$$DOB^AUPNPAT(DFN),DT,1,"D")
I Z="" D FUNO^BDMVRL4 Q
S Z=9999999-Z
K X2
D FULAST^BDMVRL4
D ENTRY^BDMVRL4
Q
HEPBC ;EP
S (Z,BDM("FOLLOW-UP TYPE"))="HEP B"
S Z=$$HEP^BDMDG13(DFN,DT,1,"D")
I Z="" D FUNO^BDMVRL4 Q
;S Z=9999999-Z
I $E(Z)=1 Q
I $E(Z)=3 Q ;IMMUNE
S Z=9999999-Z
S X2=20
D FULAST^BDMVRL4
D ENTRY^BDMVRL4
Q
PNEUMOC ;EP
S (Z,BDM("FOLLOW-UP TYPE"))="PNEUMO"
S Z=$$PNEU^BDMDG13(DFN,DT,1,"D")
I Z="" D FUNO^BDMVRL4 Q
S Z=9999999-Z
K X2
S X2=$$FMDIFF^XLFDT($$DOB^AUPNPAT(DFN),DT)
D FULAST^BDMVRL4
D ENTRY^BDMVRL4
Q
HEPCC ;EP
S (Z,BDM("FOLLOW-UP TYPE"))="HEP C SCREENING"
S Z=$$HEPSCR^BDMDG1D(DFN,DT)
I $E(Z,1)=3!($E(Z)=1)!(Z="") S Z="" D EDONE^BDMVRL4 Q
I $E(Z)=2 D FUNO^BDMVRL4 Q
Q
TDC ;EP
S BDM("FOLLOW-UP TYPE")="TD",Z="TETANUS"
S Z=$$TD^BDMVRL7(DFN,DT)
I Z="" D FUNO^BDMVRL4 Q
S Z=9999999-Z
K X2
S X2=-(10*365)
D FULAST^BDMVRL4
D ENTRY^BDMVRL4
Q
BDMVRL41 ; IHS/CMI/LAB - VIEW PT RECORD CON'T ; 09 Feb 2010 7:42 AM
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,5,6,7,8,9,10,11,12**;JUN 14, 2007;Build 51
+2 ;
+3 ;MOVED VARIOUS SUBROUTINES TO BDMVRL42 TO CONTROL ROUTINE SIZE
+4 ;
IEN ;EP;DETERMINE IEN ARRAY DEPENDING ON TYPE OF FOLLOW-UP BEING DONE
+1 KILL BDM("IEN")
+2 DO @BDMFU
+3 QUIT
RADIEN ;RADIOLOGY IEN
MAM SET BDM("FOLLOW-UP TYPE")="MAMMOGRAM"
+1 FOR Z="BILA","DIAGNOSTI","SCREENIN","UNILA"
Begin DoDot:1
+2 SET XX="MAMMOGRAM "_Z
+3 SET X=XX
+4 FOR
SET X=$ORDER(^RAMIS(71,"B",X))
IF X=""!(X'[XX)
QUIT
Begin DoDot:2
+5 SET Y=0
+6 FOR
SET Y=$ORDER(^RAMIS(71,"B",X,Y))
IF 'Y
QUIT
SET BDM("IEN",Y)=""
End DoDot:2
End DoDot:1
+7 QUIT
LABIEN ;LAB IENS
+1 NEW X,Y,Z,XX
PAP SET Z="PAP SMEAR"
+1 SET BDM("FOLLOW-UP TYPE")="PAP SMEAR"
+2 SET (X,XX)="PAP SMEA"
+3 FOR
SET X=$ORDER(^LAB(60,"B",X))
IF X=""!(X'[XX)
QUIT
Begin DoDot:1
+4 SET Y=$ORDER(^LAB(60,"B",X,0))
+5 IF Y
SET BDM("IEN",Y)=""
End DoDot:1
+6 QUIT
CHOL SET BDM("FOLLOW-UP TYPE")="CHOLESTEROL"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT CHOLESTEROL TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
LDL SET BDM("FOLLOW-UP TYPE")="LDL"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
HDL SET BDM("FOLLOW-UP TYPE")="HDL"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT HDL TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
TRIG SET BDM("FOLLOW-UP TYPE")="TRIGLYCERIDE"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT TRIGLYCERIDE TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
CREA SET BDM("FOLLOW-UP TYPE")="CREATININE"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT CREATININE TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
HGB SET BDM("FOLLOW-UP TYPE")="HGB A1C"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT HGB A1C TAX",0))
+2 SET X2=-150
+3 SET X=0
+4 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+5 SET BDM("IEN",X)=""
End DoDot:1
+6 QUIT
LIVR SET BDM("FOLLOW-UP TYPE")="SGOT/SGPT"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT LIVER FUNCTION TAX",0))
+2 SET BDM("LIVER MEDS TAX")=$ORDER(^ATXAX("B","DM AUDIT LIVER MEDS",0))
+3 SET X2=-90
+4 FOR XX="SGO","SGP"
Begin DoDot:1
+5 SET X=XX
+6 FOR
SET X=$ORDER(^LAB(60,"B",X))
IF X=""!(X'[XX)
QUIT
Begin DoDot:2
+7 SET Y=$ORDER(^LAB(60,"B",X,0))
+8 IF Y
SET BDM("IEN",Y)=""
End DoDot:2
End DoDot:1
+9 SET X=0
+10 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+11 SET BDM("IEN",X)=""
End DoDot:1
+12 QUIT
UPRO SET BDM("FOLLOW-UP TYPE")="MICROALBUMIN"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
URIN SET BDM("FOLLOW-UP TYPE")="UA/Urine Protein"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
+6 SET X=0
+7 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+8 SET BDM("IEN",X)=""
End DoDot:1
+9 QUIT
GFR SET BDM("FOLLOW-UP TYPE")="ESTIMATED GFR"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
UACR SET BDM("FOLLOW-UP TYPE")="A/C RATIO"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT QUANT UACR",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
UPT SET BDM("FOLLOW-UP TYPE")="URINE PROTEIN TESTING"
+1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT QUANT UACR",0))
+2 SET X=0
+3 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+4 SET BDM("IEN",X)=""
End DoDot:1
+5 QUIT
EKG SET BDM("FOLLOW-UP TYPE")="EKG"
+1 QUIT
EXAMIEN ;EXAM IENS
+1 NEW X,Y,Z
DENT ;EP;USE V EXAM INSTEAD OF V DENTAL
+1 SET BDM("FOLLOW-UP TYPE")="DENTAL EXAM"
+2 SET X=$ORDER(^AUTTEXAM("C","30",0))
+3 IF X
SET BDM("IEN",X)=""
+4 QUIT
RECT SET Z="RECTAL EXAM"
+1 DO EXAM
+2 QUIT
BRST FOR Z="BREAST EXAM","CLINICAL BREAST EXAM"
Begin DoDot:1
+1 DO EXAM
End DoDot:1
+2 QUIT
FTEX SET Z="FOOT EXAM"
+1 DO EXAM
+2 QUIT
EYE SET Z="EYE EXAM"
+1 DO EXAM
+2 QUIT
DEP ;
+1 SET Z="DEPRESSION SCR"
+2 DO EXAM
+3 QUIT
EXAM SET X=""
+1 FOR
SET X=$ORDER(^AUTTEXAM("B",X))
IF X=""
QUIT
IF X[Z
Begin DoDot:1
+2 SET Y=$ORDER(^AUTTEXAM("B",X,0))
+3 IF Y
SET BDM("IEN",Y)=""
End DoDot:1
+4 SET BDM("FOLLOW-UP TYPE")=Z
+5 QUIT
IMMIEN ;IMMUNIZATIONS IENS
+1 NEW X,Y
FLU SET (Z,BDM("FOLLOW-UP TYPE"))="INFLUENZA"
+1 DO IMM
+2 QUIT
PNEU SET (Z,BDM("FOLLOW-UP TYPE"))="PNEUMO"
+1 SET X2=-2160
+2 DO IMM
+3 QUIT
HEPC SET (Z,BDM("FOLLOW-UP TYPE"))="HEP C SCREEN"
+1 SET X2=-2160
+2 QUIT
HEPB SET (Z,BDM("FOLLOW-UP TYPE"))="HEPB"
+1 QUIT
TD SET BDM("FOLLOW-UP TYPE")="TD"
SET Z="TETANUS"
+1 SET X2=-3620
+2 DO IMM
+3 QUIT
IMM SET X=""
+1 FOR
SET X=$ORDER(^AUTTIMM("B",X))
IF X=""
QUIT
IF X[Z
Begin DoDot:1
+2 SET Y=0
+3 FOR
SET Y=$ORDER(^AUTTIMM("B",X,Y))
IF 'Y
QUIT
SET BDM("IEN",Y)=""
End DoDot:1
+4 QUIT
HEPA ;EP
+1 SET BDM("FOLLOW-UP TYPE")="HEPB"
SET Z="HEPB"
+2 DO IMM
+3 QUIT
SKINIEN ;SKIN TESTS IENS
+1 NEW X,Y
PPD SET (Z,BDM("FOLLOW-UP TYPE"))="PPD"
+1 SET X=""
+2 FOR
SET X=$ORDER(^AUTTSK("B",X))
IF X=""
QUIT
IF X[Z
Begin DoDot:1
+3 SET Y=0
+4 FOR
SET Y=$ORDER(^AUTTSK("B",X,Y))
IF 'Y
QUIT
SET BDM("IEN",Y)=""
End DoDot:1
+5 QUIT
EDIEN ;FIND EDUCATION TOPIC IENS
NTED SET (Z,BDM("FOLLOW-UP TYPE"))="NUTRITION"
+1 DO ED
+2 QUIT
COMP SET (Z,BDM("FOLLOW-UP TYPE"))="COMPLICATIONS"
+1 DO ED
+2 QUIT
DIET SET (Z,BDM("FOLLOW-UP TYPE"))="DIET"
+1 DO ED
+2 QUIT
DISE SET (Z,BDM("FOLLOW-UP TYPE"))="DISEASE PROCESS"
+1 DO ED
+2 QUIT
EXER SET (Z,BDM("FOLLOW-UP TYPE"))="PHYSICAL ACTIVITY"
+1 DO ED
+2 QUIT
GENI SET (Z,BDM("FOLLOW-UP TYPE"))="GENERAL INFORMATION"
+1 DO ED
+2 QUIT
LIFE SET (Z,BDM("FOLLOW-UP TYPE"))="LIFESYLE CHANGES"
+1 DO ED
+2 QUIT
MEDS SET (Z,BDM("FOLLOW-UP TYPE"))="MEDICATIONS"
+1 DO ED
+2 QUIT
FUP SET (Z,BDM("FOLLOW-UP TYPE"))="FOLLOW-UP PROCEDURES"
+1 DO ED
+2 QUIT
FTED SET (Z,BDM("FOLLOW-UP TYPE"))="FOOT CARE"
+1 DO ED
+2 QUIT
ED SET X=$ORDER(^AUTTEDT("B",("DM-"_Z),0))
+1 IF 'X
QUIT
+2 SET BDM("IEN",X)=""
+3 IF BDMFU'="NTED"
IF BDMFU'="EXER"
FOR X=1:1:9
IF X'=4
SET BDM("IEN",X)=""
+4 QUIT
HTN ;EP;HYPERTENSION FU
+1 KILL BDMHTN,BDM("IEN")
+2 DO HTN1
+3 IF '$DATA(BDMHTN)
QUIT
+4 KILL BDMMEDS
+5 DO HTNMEDS
+6 IF $DATA(BDMMEDS)
KILL BDMMEDS
QUIT
+7 SET BDM("FOLLOW-UP TYPE")="HYPERTENSION"
+8 SET X="Possible HTN, NO ACE-I or ARB"
+9 DO FUOUT^BDMVRL4
+10 QUIT
HTN1 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT URINE PROTEIN TAX",0))
+1 SET X=0
+2 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
SET BDM("IEN",X)=""
+3 SET BDMTAX=$ORDER(^ATXLAB("B","DM AUDIT URINALYSIS TAX",0))
+4 SET X=0
+5 FOR
SET X=$ORDER(^ATXLAB(+BDMTAX,21,"B",X))
IF X=""
QUIT
SET BDM("IEN",X)=""
+6 FOR X=1665044,9999382,9999383,9999570
SET BDM("IEN",X)=""
+7 SET X=0
+8 FOR
SET X=$ORDER(BDM("IEN",X))
IF 'X
QUIT
Begin DoDot:1
+9 SET Y=0
+10 FOR
SET Y=$ORDER(^AUPNVLAB("AA",DFN,X,Y))
IF 'Y
QUIT
Begin DoDot:2
+11 SET Z=0
+12 FOR
SET Z=$ORDER(^AUPNVLAB("AA",DFN,X,Y,Z))
IF 'Z
QUIT
Begin DoDot:3
+13 IF $PIECE($GET(^AUPNVLAB(Z,0)),U,4)>$PIECE($GET(^AUPNVLAB(Z,11)),U,5)
SET BDMHTN=""
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF $DATA(BDMHTN)
QUIT
HTNMEDS ;CHECK FOR HTN MEDS
+1 KILL BDM("IEN")
+2 SET BDMTAX=$ORDER(^ATXAX("B","DM AUDIT ACE INHIBITORS",0))
+3 IF 'BDMTAX
QUIT
+4 SET X=0
+5 FOR
SET X=$ORDER(^ATXAX(+BDMTAX,21,"B",X))
IF X=""
QUIT
SET BDM("IEN",X)=""
+6 SET Y=$ORDER(^PS(50.605,"B","CV805",0))
+7 IF 'Y
QUIT
+8 SET X=0
+9 FOR
SET X=$ORDER(^PSDRUG("VAC",Y,X))
IF 'X
QUIT
SET BDM("IEN",X)=""
+10 SET X=0
+11 FOR
SET X=$ORDER(^AUPNVMED("AA",DFN,X))
IF 'X
QUIT
Begin DoDot:1
+12 SET Y=0
+13 FOR
SET Y=$ORDER(^AUPNVMED("AA",DFN,X,Y))
IF 'Y!$DATA(BDMMEDS)
QUIT
IF $DATA(BDM("IEN",+$GET(^AUPNVMED(Y,0))))
SET BDMMEDS=""
End DoDot:1
+14 QUIT
LPAP ;EP;LAST PAP
+1 SET BDM("FOLLOW-UP TYPE")="PAP SMEAR"
+2 SET Z=9999999-$$LASTPAP^BDMLPM(DFN)
+3 IF $$HYSTER^BDMLPM(DFN)
SET Z=9999999-DT
+4 DO X2
+5 QUIT
LMAM ;EP;LAST MAMM
+1 SET BDM("FOLLOW-UP TYPE")="MAMMOGRAM"
+2 SET Z=9999999-$$LASTMAM^BDMLPM(DFN)
+3 IF $$MAS^BDMLPM(DFN)
SET Z=9999999-DT
+4 DO X2
+5 QUIT
APCLEXAM ;EP;LAST EXAM
+1 ; FOR EACH OF THESE Z WILL BE RETURNED AS THE DATE OF THE LAST OR NULL IF NONE
+2 IF BDMFU="FTEX"
Begin DoDot:1
+3 SET BDM("FOLLOW-UP TYPE")="FOOT EXAM"
+4 SET Z=$$DFE^BDMDG17(DFN,"","","D",1)
End DoDot:1
+5 IF BDMFU="EYE"
Begin DoDot:1
+6 SET BDM("FOLLOW-UP TYPE")="EYE EXAM"
+7 SET Z=$PIECE($$EYE^BDMDG17(DFN,"","","D",1),U,1)
End DoDot:1
+8 IF BDMFU="DENT"
Begin DoDot:1
+9 SET BDM("FOLLOW-UP TYPE")="DENTAL EXAM"
+10 SET Z=$$DENTAL^BDMDG17(DFN,"","","D",1)
End DoDot:1
+11 IF BDMFU="DEP"
Begin DoDot:1
+12 SET BDM("FOLLOW-UP TYPE")="DEPRESSION SCR"
+13 SET Z=$$DEPSCR^BDMDG12(DFN,"","","D",1)
End DoDot:1
+14 ;I BDMFU="EKG" D
+15 ;.S BDM("FOLLOW-UP TYPE")="EKG"
+16 ;.S Z=$$EKG^BDMDG12(DFN,DT,"D")
+17 ;no test ever
IF Z=""
DO FUNO^BDMVRL4
QUIT
+18 SET Z=9999999-Z
X2 ;
+1 IF Z=9999999
DO FUNO^BDMVRL4
QUIT
+2 ;I $$FMDIFF^XLFDT(DT,Z)<330 D EDONE^BDMVRL4 Q ;no need, is current
+3 KILL X2
+4 IF BDMFU="EKG"
SET X2=-1795
+5 DO FULAST^BDMVRL4
+6 DO ENTRY^BDMVRL4
+7 QUIT
APCLED ;EP;LAST MAMM
+1 IF BDMFU="NTED"
Begin DoDot:1
+2 SET BDM("FOLLOW-UP TYPE")="NUTRITION ED"
+3 SET Z=$$DIETEDUC^BDMLPM(DFN,$$FMADD^XLFDT(DT,-(5*365)),DT)
End DoDot:1
+4 IF BDMFU="EXER"
Begin DoDot:1
+5 SET BDM("FOLLOW-UP TYPE")="PHYSICAL ACTIVITY ED"
+6 SET Z=$$EXEDUC^BDMLPM(DFN,$$FMADD^XLFDT(DT,-(5*365)),DT)
End DoDot:1
+7 IF BDMFU="GENI"
Begin DoDot:1
+8 SET BDM("FOLLOW-UP TYPE")="OTHER ED"
+9 SET Z=$$OTHEDUC^BDMLPM(DFN,$$FMADD^XLFDT(DT,-(5*365)),DT)
End DoDot:1
+10 IF Z=""
DO FUNO^BDMVRL4
QUIT
+11 SET Z=$PIECE(Z,".")
+12 KILL X2
+13 DO FULAST^BDMVRL4
+14 DO ENTRY^BDMVRL4
+15 QUIT
FLUC ;EP
+1 SET (Z,BDM("FOLLOW-UP TYPE"))="INFLUENZA"
+2 SET Z=$$FLU^BDMDG13(DFN,$$DOB^AUPNPAT(DFN),DT,1,"D")
+3 IF Z=""
DO FUNO^BDMVRL4
QUIT
+4 SET Z=9999999-Z
+5 KILL X2
+6 DO FULAST^BDMVRL4
+7 DO ENTRY^BDMVRL4
+8 QUIT
HEPBC ;EP
+1 SET (Z,BDM("FOLLOW-UP TYPE"))="HEP B"
+2 SET Z=$$HEP^BDMDG13(DFN,DT,1,"D")
+3 IF Z=""
DO FUNO^BDMVRL4
QUIT
+4 ;S Z=9999999-Z
+5 IF $EXTRACT(Z)=1
QUIT
+6 ;IMMUNE
IF $EXTRACT(Z)=3
QUIT
+7 SET Z=9999999-Z
+8 SET X2=20
+9 DO FULAST^BDMVRL4
+10 DO ENTRY^BDMVRL4
+11 QUIT
PNEUMOC ;EP
+1 SET (Z,BDM("FOLLOW-UP TYPE"))="PNEUMO"
+2 SET Z=$$PNEU^BDMDG13(DFN,DT,1,"D")
+3 IF Z=""
DO FUNO^BDMVRL4
QUIT
+4 SET Z=9999999-Z
+5 KILL X2
+6 SET X2=$$FMDIFF^XLFDT($$DOB^AUPNPAT(DFN),DT)
+7 DO FULAST^BDMVRL4
+8 DO ENTRY^BDMVRL4
+9 QUIT
HEPCC ;EP
+1 SET (Z,BDM("FOLLOW-UP TYPE"))="HEP C SCREENING"
+2 SET Z=$$HEPSCR^BDMDG1D(DFN,DT)
+3 IF $EXTRACT(Z,1)=3!($EXTRACT(Z)=1)!(Z="")
SET Z=""
DO EDONE^BDMVRL4
QUIT
+4 IF $EXTRACT(Z)=2
DO FUNO^BDMVRL4
QUIT
+5 QUIT
TDC ;EP
+1 SET BDM("FOLLOW-UP TYPE")="TD"
SET Z="TETANUS"
+2 SET Z=$$TD^BDMVRL7(DFN,DT)
+3 IF Z=""
DO FUNO^BDMVRL4
QUIT
+4 SET Z=9999999-Z
+5 KILL X2
+6 SET X2=-(10*365)
+7 DO FULAST^BDMVRL4
+8 DO ENTRY^BDMVRL4
+9 QUIT
