Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDMVRL41

BDMVRL41.m

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