- 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