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

BDMVRL42.m

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