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

BDMDR5.m

Go to the documentation of this file. 
  1. BDMDR5 ; IHS/CMI/LAB - patients w/o dm on problem list ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,8,9,10**;JUN 14, 2007;Build 12
  1.  ;
  1.  ;
  1. START ;
  1.  D INFORM
  1.  D EXIT
  1. R ;
  1.  S BDMREG=""
  1.  S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC
  1.  I Y=-1 W !,"No register selected." D EXIT Q
  1.  S BDMREG=+Y
  1. STAT ;get status
  1.  W !!,"Select the Patient Status for this report"
  1.  S BDMSTAT=""
  1.  K DIR
  1.  S DIR(0)="S^"_$P(^DD(9002241,1,0),U,3)_";0:All Register Patients",DIR("A")="Which Status",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G R
  1.  I Y=0 S BDMSTAT="" G CLINIC
  1.  S BDMSTAT=Y
  1. CLINIC ;
  1.  W !!,"Enter the list of clinics that you have determined to be primary care clinics."
  1.  W !,"You can enter them 1 at a time or enter a taxonomy using the '[' notation."
  1.  K BDMCLIN
  1.  S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA
  1.  D PEP^AMQQGTX0(+Y,"BDMCLIN(")
  1.  I '$D(BDMCLIN) W !,"NO CLINICS SELECTED" K BDMCLIN G STAT
  1.  I $D(BDMCLIN("*")) W !,"ALL (ANY) CLINIC WILL BE INCLUDED" K BDMCLIN
  1. GETDATES ;
  1. BD ;
  1.  W !!!,"Enter the time frame to look for visits.",! S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) CLINIC
  1.  S BDMBD=Y
  1. ED ;
  1.  S DIR(0)="DA^::EP",DIR("A")="Enter Ending Visit Date:  " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) GETDATES
  1.  I Y<BDMBD W !,"Ending date must be greater than or equal to beginning date!" G ED
  1.  S BDMED=Y
  1.  S X1=BDMBD,X2=-1 D C^%DTC S BDMSD=X
  1. ZIS ;
  1.  S BDMTEMP=""
  1.  S DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen",DIR("A")="Output Type",DIR("B")="P" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G GETDATES
  1.  S BDMTEMP=Y
  1.  ;call to XBDBQUE
  1. DEMO ;
  1.  D DEMOCHK^BDMUTL(.BDMDEMO)
  1.  I BDMDEMO=-1 D EXIT Q
  1.  I BDMTEMP="B" D BROWSE,EXIT Q
  1.  S XBRP="PRINT^BDMDR5",XBRC="PROC^BDMDR5",XBRX="EXIT^BDMDR5",XBNS="BDM"
  1.  D ^XBDBQUE
  1.  D EXIT
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^BDMDR5"")"
  1.  S XBRC="PROC^BDMDR5",XBRX="EXIT^BDMDR5",XBIOP=0 D ^XBDBQUE
  1.  Q
  1. EXIT ;clean up and exit
  1.  I '$D(BDMGUI) D EN^XBVK("BDM")
  1.  D ^XBFMK
  1.  D KILL^AUPNPAT
  1.  Q
  1. INFORM ;
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC)
  1.  W !,$$CTR($$USR)
  1.  W !!,"This report will list patients who are on the diabetes register who have not",!
  1.  W "had a visit to a set of primary care clinics in a date range defined by the ",!,"user.",!
  1.  W "The report provides a way to identify patients who could possibly be inactivated",!
  1.  W "in the register.",!!
  1.  Q
  1. PROC ;EP - called from XBDBQUE
  1.  S BDMJOB=$J,BDMBTH=$H
  1.  K ^XTMP("BDMDR5",BDMJOB,BDMBTH)
  1.  D XTMP^BDMOSUT("BDMDR5","DM ON REGISTER NOT ACTIVE")
  1.  S BDMP=0 F  S BDMP=$O(^ACM(41,"B",BDMREG,BDMP)) Q:BDMP'=+BDMP  D
  1.  .Q:'$D(^ACM(41,BDMP))
  1.  .S BDMPAT=$P(^ACM(41,BDMP,0),U,2)
  1.  .Q:$$DEMO^BDMUTL(BDMPAT,$G(BDMDEMO))
  1.  .I $G(BDMSTAT)]"",$P($G(^ACM(41,BDMP,"DT")),U,1)'=BDMSTAT Q
  1.  .;LOOP VISITS UNTIL FIND ONE THAT FITS DEFINITION
  1.  .K BDMV
  1.  .D ALLV^APCLAPIU(BDMPAT,BDMBD,BDMED,"BDMV")
  1.  .S BDMG=0,BDMX=0
  1.  .F  S BDMX=$O(BDMV(BDMX)) Q:BDMX'=+BDMX!(BDMG)  D
  1.  ..S BDMVST=$P(BDMV(BDMX),U,5)
  1.  ..S BDMC=$$GET1^DIQ(9000010,BDMVST,.08,"I")
  1.  ..Q:'BDMC
  1.  ..I $D(BDMCLIN),'$D(BDMCLIN(BDMC)) Q  ;not a clinic of interest
  1.  ..S BDMG=1
  1.  .I 'BDMG S ^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",$$GET1^DIQ(2,BDMPAT,.01),BDMPAT)=""
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  S BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
  1.  S BDM80D="-------------------------------------------------------------------------------"
  1.  S BDMPG=0 D HEAD
  1.  I '$D(^XTMP("BDMDR5",BDMJOB,BDMBTH)) W !!,"NO PATIENTS TO REPORT" G DONE
  1.  S BDMNAME="" K BDMQ
  1.  F  S BDMNAME=$O(^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME)) Q:BDMNAME=""!($D(BDMQ))  D
  1.  .S DFN="" F  S DFN=$O(^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)) Q:DFN=""!($D(BDMQ))  S BDMX=^XTMP("BDMDR5",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN) D
  1.  ..I $Y>(BDMIOSL-4) D HEAD Q:$D(BDMQ)
  1.  ..W !,$E(BDMNAME,1,20),?22,$$HRN^AUPNPAT(DFN,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?29,$E($$RSTAT(BDMREG,DFN),1,8)
  1.  ..W ?38,$E($$CM(BDMREG,DFN),1,10)
  1.  ..S V=$$LASTV(DFN)
  1.  ..W ?49,$$DATE^BDMS9B1($P(V,U,1))
  1.  ..W ?61,$$LBLK^BDMUTL($$NUMDXS(DFN),5)
  1.  ..W ?68,$$DATE^BDMS9B1($$LASTDMDX(DFN))
  1. DONE ;
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  W:$D(IOF) @IOF
  1.  K ^XTMP("BDMDR5",BDMJOB,BDMBTH),BDMJOB,BDMBTH
  1.  Q
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQ="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S BDMPG=BDMPG+1
  1.  I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"
  1.  W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
  1.  W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!
  1.  W ?(80-$L($P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U))/2),$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),!
  1.  W $$CTR("Patients on the "_$P(^ACM(41.1,BDMREG,0),U)_" Register",80),!
  1.  W $$CTR("without a visit between "_$$FMTE^XLFDT(BDMBD)_" and "_$$FMTE^XLFDT(BDMED),80),!
  1. PIH W !,"PATIENT NAME",?22,"HRN",?29,"STATUS",?38,"CASE ",?49,"LAST VISIT",?61,"# DM",?68,"LAST DM DX",!,?38,"MANAGER",?61,"DXS",!,BDM80D
  1.  Q
  1. NUMDXS(P) ;
  1.  I '$G(P) Q ""
  1.  NEW X,E,BDM,Y
  1.  S Y="BDM("
  1.  S X=P_"^ALL DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
  1.  S (X,Y)=0
  1.  F  S X=$O(BDM(X)) Q:X'=+X  S Y=Y+1
  1.  Q Y
  1. LASTV(P) ;
  1.  NEW X,Y,Z,V,D
  1.  S V=""
  1.  S D=0 F  S D=$O(^AUPNVSIT("AA",P,D)) Q:D'=+D!(V)  D
  1.  .S X=0 F  S X=$O(^AUPNVSIT("AA",P,D,X)) Q:X'=+X!(V)  D
  1.  ..Q:'$D(^AUPNVSIT(X,0))
  1.  ..Q:$P(^AUPNVSIT(X,0),U,11)  ;deleted
  1.  ..Q:'$P(^AUPNVSIT(X,0),U,9)  ;ZERO DEP
  1.  ..Q:"CTNEDX"[$P(^AUPNVSIT(X,0),U,7)
  1.  ..S V=X
  1.  I V="" Q ""
  1.  Q $$GET1^DIQ(9000010,V,.01,"I")_U_$$GET1^DIQ(9000010,V,.08,"I")
  1. LASTDMDX(P) ;
  1.  I '$G(P) Q ""
  1.  NEW X,E,BDM,Y
  1.  S Y="BDM("
  1.  S X=P_"^LAST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
  1.  I $D(BDM(1)) Q $P(BDM(1),U)
  1.  Q ""
  1. CM(REG,PAT) ;
  1.  NEW X
  1.  S X=$G(^ACM(41,"AC",PAT,REG))
  1.  I X="" Q ""
  1.  Q $$GET1^DIQ(9002241,X,6)
  1. RSTAT(REG,PAT) ;
  1.  NEW X
  1.  S X=$G(^ACM(41,"AC",PAT,REG))
  1.  I X="" Q ""
  1.  Q $$GET1^DIQ(9002241,X,1)
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. TEST ;
  1.  D BDMG("R",1,"A")
  1.  Q
  1. BDMG(BDMTR,BDMREG,BDMSTAT,BDMND,BDMLDAT) ;EP - GUI DMS Entry Point
  1.  S BDMND=$G(BDMND)
  1.  S BDMGUI=1
  1.  S BDMLDAT=$G(BDMLDAT)
  1.  NEW BDMNOW,BDMOPT,BDMIEN
  1.  S BDMOPT="Patients w/no Diagnosis of DM on Problem Lis"
  1.  D NOW^%DTC
  1.  S BDMNOW=$G(%)
  1.  K DD,DO,DIC
  1.  S X=DUZ_BDMNOW
  1.  S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$G(BDMOPT)_";.07////R"
  1.  S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003201.4
  1.  D FILE^DICN
  1.  K DIADD,DLAYGO,DIC,DA
  1.  I Y=-1 S BDMIEN=-1 Q
  1.  S BDMIEN=+Y
  1.  S BDMGIEN=BDMIEN  ;cmi/maw added
  1.  D ^XBFMK
  1.  K ZTSAVE S ZTSAVE("*")=""
  1.  ;D GUIEP for interactive testing
  1.  S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMDR5",ZTDESC="GUI DM PTS NO DX PL" D ^%ZTLOAD
  1.  D EXIT
  1.  Q
  1. GUIEP ;EP
  1.  D PROC
  1.  K ^TMP($J,"BDMDR5")
  1.  S IOM=80
  1.  D GUIR^XBLM("PRINT^BDMDR5","^TMP($J,""BDMDR5"",")
  1.   S X=0,C=0 F  S X=$O(^TMP($J,"BDMDR5",X)) Q:X'=+X  D
  1.  .S BDMDATA=^TMP($J,"BDMDR5",X)
  1.  .;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
  1.  .S ^BDMGUI(BDMIEN,11,X,0)=BDMDATA,C=C+1
  1.  S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
  1.  S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK
  1.  D ENDLOG
  1.  K ^TMP($J,"BDMDR5")
  1.  D EXIT
  1.  S ZTREQ="@"
  1.  Q
  1.  ;
  1. ENDLOG ;-- write the end of the log
  1.  D NOW^%DTC
  1.  S BDMNOW=$G(%)
  1.  S DIE="^BDMGUI(",DA=BDMIEN,DR=".04////"_BDMNOW_";.07////C"
  1.  D ^DIE
  1.  K DIE,DR,DA
  1.  Q