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