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

BDMRMC.m

Go to the documentation of this file. 
  1. BDMRMC ; IHS/CMI/LAB - patients w/o dm on problem list ; 28 Oct 2015  2:08 PM
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
  1.  ;
  1.  ;
  1. START ;
  1.  D INFORM
  1.  D EXIT
  1. GETINFO ;
  1.  K BDMSTAT
  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." S BDMQUIT="" D EXIT Q
  1.  S BDMREG=+Y
  1. PS ;
  1.  K BDMPATS
  1.  S DIR(0)="S^I:Individual Patient Names/HRNs;A:Group of Patients by Attribute",DIR("A")="Select Patients By",DIR("B")="I" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  S BDMPS=Y
  1.  I BDMPS="I" D GETPATS I '$D(BDMPATS) W !!,"No patients selected." G EXIT
  1.  I BDMPS="I" G HS
  1.  D GROUP
  1.  I '$D(BDMPATS) W !!,"No patients selected." G EXIT
  1. HS ;
  1.  I $P(^ACM(41.1,BDMREG,0),U,10)=1 D
  1.  .S DIR(0)="YO",DIR("A")="Include PCC HEALTH SUMMARY",DIR("B")="NO"
  1.  .W !
  1.  .D ^DIR K DIR
  1.  .I Y=1 S ACMMHS="" D SELTYP I ACMSTYP="" W !,"No Health summary will be included.",!
  1. ZIS ;call to XBDBQUE
  1. DEMO ;
  1.  ;D DEMOCHK^BDMUTL(.BDMDEMO)
  1.  ;I BDMDEMO=-1 G R
  1.  ;I BDMTEMP="B" D BROWSE,EXIT Q
  1.  S XBRP="PRINT^BDMRMC",XBRC="",XBRX="EXIT^BDMRMC",XBNS="BDM"
  1.  D ^XBDBQUE
  1.  D EXIT
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^BDMRMC"")"
  1.  S XBRC="",XBRX="EXIT^BDMRMC",XBIOP=0 D ^XBDBQUE
  1.  Q
  1. INFORM ;
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC)
  1.  W !,$$CTR($$USR)
  1.  W !!,$$CTR("DIABETES REGISTER MULTIPLE PATIENTS SUMMARIES",80)
  1.  W !!,"This report will print patient summaries for a selected set of patients."
  1.  W !,"You may select individual patients by name/HRN or you may select a group"
  1.  W !,"of patients by any combination of the following attributes:"
  1.  W ?5,"- Register Status",!
  1.  W ?5,"- Community of Residence",!
  1.  W ?5,"- Case Manager",!
  1.  W ?5,"- Where Followed",!
  1.  W ?5,"- Next Review Date",!
  1.  W !
  1.  Q
  1. EXIT ;clean up and exit
  1.  NEW BDMRDA,BDMREGNM
  1.  D EN^XBVK("BDM")
  1.  D EN^XBVK("ACM")
  1.  K ACMMHS,ACMSTYP
  1.  D ^XBFMK
  1.  D KILL^AUPNPAT
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  ;loop bdmpats and print patient summary and optionally health summary
  1.  S BDMMULTS=1
  1.  S BDMPATX=0 F  S BDMPATX=$O(BDMPATS(BDMPATX)) Q:BDMPATX=""!($D(ACMZQUIT))  D
  1.  .S DFN=BDMPATX
  1.  .S BDMRDA=BDMREG
  1.  .S BDMRPDA=$G(^ACM(41,"AC",BDMPATX,BDMREG))
  1.  .D CS1^BDMVRL
  1.  .;I ACMSTYP S APCHSTYP=ACMSTYP,APCHSPAT=BDMPAT D EN^APCHS
  1.  .I $E(IOST,1,2)="C-" D PAUSE1^ACMPPDTX
  1.  D EXIT
  1.  Q
  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. GETPATS ;
  1.  S BDMSTP=0 K BDMPATS
  1. I1 ;
  1.  K DIC S DIC="^AUPNPAT(",DIC(0)="AEMQ",DIC("S")="I $G(^ACM(41,""AC"",+Y,BDMREG))" D ^DIC K DIC
  1.  I Y=-1,'$D(BDMPATS) W !,"No patients selected" S BDMSTP=1 Q
  1.  I Y=-1 Q
  1.  I '$G(^ACM(41,"AC",+Y,BDMREG)) W !,"That patient is not on the register!" G I1
  1.  S BDMPATS(+Y)=""
  1.  G I1
  1. GROUP ;get register, status, random or not
  1.  S BDMSTP=0
  1.  K BDMPATS
  1.  S BDMSTAT=""
  1.  S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular status",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G GROUP
  1.  I Y=0 G GROUP1
  1.  ;which status
  1.  S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G GROUP
  1.  S BDMSTAT=Y
  1. GROUP1 ;
  1.  ;gather up patients from register in ^XTMP
  1.  K BDMPATS S BDMCNT=0,X=0 F  S X=$O(^ACM(41,"B",BDMREG,X)) Q:X'=+X  D
  1.  .I BDMSTAT]"",$P($G(^ACM(41,X,"DT")),U,1)=BDMSTAT S BDMCNT=BDMCNT+1,BDMPATS($P(^ACM(41,X,0),U,2))="" Q
  1.  .I BDMSTAT="" S BDMCNT=BDMCNT+1,BDMPATS($P(^ACM(41,X,0),U,2))=""
  1.  I '$D(BDMPATS) W !,"No patients with that status in that register!" S BDMSTP=1 G GROUP
  1.  W !!,"There are ",BDMCNT," patients in the ",$P(^ACM(41.1,BDMREG,0),U)," register with a status of ",BDMSTAT,".",!!
  1.  D CM
  1.  I BDMSTP K BDMPATS Q
  1.  D CC
  1.  I BDMSTP K BDMPATS Q
  1.  D WF
  1.  I BDMSTP K BDMPATS Q
  1.  D NRD
  1.  I BDMSTP K BDMPATS Q
  1.  Q
  1. NRD ;NEXT REVIEW DATE RANGE
  1.  S DIR(0)="Y",DIR("A")="Select Patients by Next Review Date",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I 'Y Q
  1.  I $D(DIRUT) Q
  1.  ;
  1. GETDATES ;
  1. BD ;
  1.  W !!!,"Enter the next review date range.",!
  1.  S DIR(0)="D^::EP",DIR("A")="Enter Beginning Next Review Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) S BDMSTP=1 Q
  1.  S BDMBD=Y
  1. ED ;
  1.  S DIR(0)="DA^::EP",DIR("A")="Enter Ending Next Review 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.  ;
  1.  ;LOOP THROUGH AND CHECK NRD
  1.  S P=0 F  S P=$O(BDMPATS(P)) Q:P'=+P  S BDMX=$G(^ACM(41,"AC",P,BDMREG)) D
  1.  .I 'BDMX K BDMPATS(P) Q
  1.  .S X=$$VALI^XBDIQ1(9002241,BDMX,9)
  1.  .I 'X K BDMPATS(P) Q
  1.  .I X<BDMBD K BDMPATS(P) Q
  1.  .I X>BDMED K BDMPATS(P) Q
  1.  S P=0,C=0 F  S P=$O(BDMPATS(P)) Q:P'=+P  S C=C+1
  1.  I 'C W !!,"There are no patients with that case manager." S BDMSTP=1 Q
  1.  W !,"There are ",C," patients selected so far.",!
  1.  Q
  1. CM ;
  1.  K BDMCM
  1.  S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular CASE MANAGER",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S BDMSTP=1 Q
  1.  I Y=0 Q
  1. CM1 ;which status
  1.  K DIC S DIC(0)="AEMQ",DIC=200,DIC("A")="Select "_$S($D(BDMCM):"another ",1:"")_"Case Manager: " D ^DIC K DIC
  1.  I Y=-1,'$D(BDMCM) G CM
  1.  I Y=-1,$D(BDMCM) D  Q
  1.  .;LOOP THROUGH AND CHECK CASE MANAGER
  1.  .S P=0 F  S P=$O(BDMPATS(P)) Q:P'=+P  S BDMX=$G(^ACM(41,"AC",P,BDMREG)) D
  1.  ..I 'BDMX K BDMPATS(P) Q
  1.  ..S X=$$VALI^XBDIQ1(9002241,BDMX,6)
  1.  ..I 'X K BDMPATS(P) Q
  1.  ..I '$D(BDMCM(X)) K BDMPATS(P) Q
  1.  .S P=0,C=0 F  S P=$O(BDMPATS(P)) Q:P'=+P  S C=C+1
  1.  .I 'C W !!,"There are no patients with that case manager." S BDMSTP=1 Q
  1.  .W !,"There are ",C," patients selected so far.",!
  1.  S BDMCM(+Y)=""
  1.  G CM1
  1. WF ;
  1.  K BDMWF
  1.  S DIR(0)="Y",DIR("A")="Do you want to select patients with a particular facility WHERE FOLLOWED",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S BDMSTP=1 Q
  1.  I Y=0 K BDMWF Q
  1. WF1 ;which status
  1.  K DIC S DIC=9999999.06,DIC(0)="AEMQZ",DIC("A")="Select "_$S($D(BDMWF):"another ",1:"")_"WHERE FOLLOWED facility: " D ^DIC K DIC
  1.  I Y=-1,'$D(BDMWF) G WF
  1.  I $D(DIRUT),'$D(BDMWF) G WF
  1.  I Y=-1,$D(BDMWF) D  Q
  1.  .;LOOP THROUGH AND CHECK WHERE FOLLOWED
  1.  .S P=0 F  S P=$O(BDMPATS(P)) Q:P'=+P  S BDMX=$G(^ACM(41,"AC",P,BDMREG)) D
  1.  ..I 'BDMX K BDMPATS(P) Q
  1.  ..S X=$$VALI^XBDIQ1(9002241,BDMX,10)
  1.  ..I 'X K BDMPATS(P) Q
  1.  ..I '$D(BDMWF(X)) K BDMPATS(P) Q
  1.  .S P=0,C=0 F  S P=$O(BDMPATS(P)) Q:P'=+P  S C=C+1
  1.  .I 'C W !!,"There are no patients with that Where Followed Value." H 5 S BDMSTP=1 Q
  1.  .W !,"There are ",C," patients selected so far.",!
  1.  S BDMWF(+Y)=""
  1.  G WF1
  1. CC ;current community
  1.  S BDMSTP=0
  1.  W ! K DIR S DIR(0)="Y",DIR("A")="Limit the patients who live in a particular community ",DIR("B")="N" KILL DA D ^DIR K DIR
  1.  I $D(DIRUT) S BDMSTP=1 Q
  1.  Q:'Y
  1.  K DIC S DIC="^AUTTCOM(",DIC(0)="AEMQ" D ^DIC K DIC
  1.  I Y=-1 G CC
  1.  S BDMCOM=$P(^AUTTCOM(+Y,0),U)
  1.  S X=0 F  S X=$O(BDMPATS(X)) Q:X'=+X  I $P($G(^AUPNPAT(X,11)),U,18)'=BDMCOM K BDMPATS(X)
  1.  S (X,C)=0 F  S X=$O(BDMPATS(X)) Q:X'=+X  S C=C+1
  1.  I 'C W !!,"There are no patients living in that community." H 5 S BDMSTP=1 Q
  1.  W !!,C," patients have been selected so far.",!
  1.  Q
  1. SELTYP ;PEP;TO SELECT HEALTH SUMMARY TYPE
  1.  K DIC
  1.  S DIC="^APCHSCTL(",DIC("A")="Select health summary type: ",DIC(0)="AEQM",DIC("B")="DIABETES STANDARD"
  1.  W !
  1.  D ^DIC
  1.  K DIC,DA,DR
  1.  I Y<0 Q
  1.  S ACMSTYP=+Y
  1.  Q