BDMDR4 ; IHS/CMI/LAB - patients w/o TB TX ; 05 Mar 2015 1:11 PM
;;2.0;DIABETES MANAGEMENT SYSTEM;**6,8,9,10**;JUN 14, 2007;Build 12
;
;
START ;
D INFORM
D EXIT
D GETINFO
I $D(BDMQUIT) D EXIT Q
Q
INFORM ;
W:$D(IOF) @IOF
W !,$$CTR($$LOC)
W !,$$CTR($$USR)
W !!,"This report will list patients who have a positive PPD/TB who have",!,"no documentation of treatment being completed."
W !,"Treatment Completed is defined as having Health Factor TB - TX COMPLETE",!,"documented.",!
Q
;
GETINFO ;
S (BDMTR,BDMREG,BDMSTAT,BDMND)=""
S DIR(0)="S^R:Those who are members of a Register;A:All Patients",DIR("A")="List which subset of patients",DIR("B")="R" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S BDMQUIT="" Q
S BDMTR=Y
D @Y
I $D(BDMQUIT) D EXIT Q
D ZIS
Q
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="" Q
S BDMREG=+Y
;get status
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 R
I Y=0 S BDMSTAT="" Q
;which status
S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G R
S BDMSTAT=Y
Q
A ;
Q
ZIS ;
S BDMTEMP=""
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
I $D(DIRUT) D EXIT Q
S BDMTEMP=Y
;call to XBDBQUE
DEMO ;
D DEMOCHK^BDMUTL(.BDMDEMO)
I BDMDEMO=-1 D EXIT Q
I BDMTEMP="B" D BROWSE,EXIT Q
S XBRP="PRINT^BDMDR4",XBRC="PROC^BDMDR4",XBRX="EXIT^BDMDR4",XBNS="BDM"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDR4"")"
S XBRC="PROC^BDMDR4",XBRX="EXIT^BDMDR4",XBIOP=0 D ^XBDBQUE
Q
EXIT ;clean up and exit
I '$D(BDMGUI) D EN^XBVK("BDM")
D ^XBFMK
D KILL^AUPNPAT
Q
PROC ;EP - called from XBDBQUE
S BDMJOB=$J,BDMBTH=$H
K ^XTMP("BDMDR4",BDMJOB,BDMBTH)
D XTMP^BDMOSUT("BDMDR4","DM NOT ON PROBLEM LIST")
I BDMTR="R" D REGPROC Q
I BDMTR="A" D ALLPROC Q
Q
ALLPROC ;
;get last dm dx, if less than last date, Q
;if null Q
;get # of dxs, if less than BDMnd q
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D CHK1SET
Q
CHK1SET ;
Q:$$DEMO^BDMUTL(DFN,$G(BDMDEMO))
Q:$$DOD^AUPNPAT(DFN)]""
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,5)]"" ;IHS/CMI/GRL
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,2)="" ;IHS/CMI/GRL
S BDMTB=$$HASTB(DFN)
Q:$E(BDMTB)'=1
Q:$$HASTBTX(DFN)
S ^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",$P(^DPT(DFN,0),U),DFN)=$P(BDMTB," ",2,999)
Q
HASTB(P) ;
;positive ppd
NEW BDMS,E,X
S BDMS=$P($$PPD^BDMDD18(DFN,DT),"||",2)
Q BDMS
;
HASTBTX(P) ;
I '$G(P) Q ""
NEW X,E,BDM,Y
S Y="BDM("
S X=P_"^LAST HEALTH TX COMPLETE" S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) Q $P(BDM(1),U)
Q ""
;
NUMDXS(P) ;
I '$G(P) Q ""
NEW X,E,BDM,Y
S Y="BDM("
S X=P_"^ALL DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
S (X,Y)=0
F S X=$O(BDM(X)) Q:X'=+X S Y=Y+1
Q Y
;
REGPROC ;
;$o through register, check status, if no DM on problem list
;set xtmp
;gather up patients from register in ^XTMP
S 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 DFN=$P(^ACM(41,X,0),U,2) D CHKSET Q
.I BDMSTAT="" S DFN=$P(^ACM(41,X,0),U,2) D CHKSET Q
.Q
Q
CHKSET ;
Q:$$DOD^AUPNPAT(DFN)]""
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,5)]"" ;IHS/CMI/GRL
Q:$P($G(^AUPNPAT(DFN,41,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0)),U,2)="" ;IHS/CMI/GRL
S BDMTB=$$HASTB(DFN)
Q:$E(BDMTB)'=1
Q:$$HASTBTX(DFN)
S ^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",$P(^DPT(DFN,0),U),DFN)=$P(BDMTB," ",2,999)
Q
PRINT ;EP - called from xbdbque
S BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
S BDM80D="-------------------------------------------------------------------------------"
S BDMPG=0 D HEAD
I '$D(^XTMP("BDMDR4",BDMJOB,BDMBTH)) W !!,"NO PATIENTS TO REPORT" G EXIT
S BDMNAME="" K BDMQ
F S BDMNAME=$O(^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME)) Q:BDMNAME=""!($D(BDMQ)) D
.S DFN="" F S DFN=$O(^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)) Q:DFN=""!($D(BDMQ)) S BDMX=^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN) D
..I $Y>(BDMIOSL-4) D HEAD Q:$D(BDMQ)
..W !,$E(BDMNAME,1,20),?22,$$HRN^AUPNPAT(DFN,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?29,$$DOB^AUPNPAT(DFN,"E"),?43,$P(^DPT(DFN,0),U,2),?47,$$FMTE^XLFDT($$LASTVD^APCLV1(DFN))
..W !?5,"TB Status: ",^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)
..W !?5,"Last Documented TB Health Factor: ",$$LASTHF^BDMSMU(DFN,"TB STATUS","B")
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
W:$D(IOF) @IOF
K ^XTMP("BDMDR4",BDMJOB,BDMBTH),BDMJOB,BDMBTH
Q
HEAD I 'BDMPG G HEAD1
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
HEAD1 ;
W:$D(IOF) @IOF S BDMPG=BDMPG+1
I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"
W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!
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),!
W $$CTR("PATIENTS W/POSITIVE PPD/TB W/O DOCUMENTED TX COMPLETE",80),!
I BDMTR="R" W $$CTR("Patients on the "_$P(^ACM(41.1,BDMREG,0),U)_" Register",80),!
PIH W !,"PATIENT NAME",?22,"HRN",?29,"DOB",?47,"LAST VISIT",!,BDM80D
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")
;----------
TEST ;
D BDMG("R",1,"A")
Q
BDMG(BDMTR,BDMREG,BDMSTAT,BDMDEMO) ;EP - GUI DMS Entry Point
S BDMND=$G(BDMND)
S BDMGUI=1
S BDMLDAT=$G(BDMLDAT)
NEW BDMNOW,BDMOPT,BDMIEN
S BDMOPT="Patients w/POS PPD/TB w/o TX"
D NOW^%DTC
S BDMNOW=$G(%)
K DD,DO,DIC
S X=DUZ_BDMNOW
S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$G(BDMOPT)_";.07////R"
S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003201.4
D FILE^DICN
K DIADD,DLAYGO,DIC,DA
I Y=-1 S BDMIEN=-1 Q
S BDMIEN=+Y
S BDMGIEN=BDMIEN ;cmi/maw added
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
;D GUIEP for interactive testing
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMDR4",ZTDESC="GUI DM PTS TB" D ^%ZTLOAD
D EXIT
Q
GUIEP ;EP
D PROC
K ^TMP($J,"BDMDR4")
S IOM=80
D GUIR^XBLM("PRINT^BDMDR4","^TMP($J,""BDMDR4"",")
S X=0,C=0 F S X=$O(^TMP($J,"BDMDR4",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDR4",X)
.;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
.S ^BDMGUI(BDMIEN,11,X,0)=BDMDATA,C=C+1
S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK
D ENDLOG
K ^TMP($J,"BDMDR4")
D EXIT
S ZTREQ="@"
Q
;
ENDLOG ;-- write the end of the log
D NOW^%DTC
S BDMNOW=$G(%)
S DIE="^BDMGUI(",DA=BDMIEN,DR=".04////"_BDMNOW_";.07////C"
D ^DIE
K DIE,DR,DA
Q
BDMDR4 ; IHS/CMI/LAB - patients w/o TB TX ; 05 Mar 2015 1:11 PM
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**6,8,9,10**;JUN 14, 2007;Build 12
+2 ;
+3 ;
START ;
+1 DO INFORM
+2 DO EXIT
+3 DO GETINFO
+4 IF $DATA(BDMQUIT)
DO EXIT
QUIT
+5 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC)
+3 WRITE !,$$CTR($$USR)
+4 WRITE !!,"This report will list patients who have a positive PPD/TB who have",!,"no documentation of treatment being completed."
+5 WRITE !,"Treatment Completed is defined as having Health Factor TB - TX COMPLETE",!,"documented.",!
+6 QUIT
+7 ;
GETINFO ;
+1 SET (BDMTR,BDMREG,BDMSTAT,BDMND)=""
+2 SET DIR(0)="S^R:Those who are members of a Register;A:All Patients"
SET DIR("A")="List which subset of patients"
SET DIR("B")="R"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
SET BDMQUIT=""
QUIT
+4 SET BDMTR=Y
+5 DO @Y
+6 IF $DATA(BDMQUIT)
DO EXIT
QUIT
+7 DO ZIS
+8 QUIT
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=""
QUIT
+4 SET BDMREG=+Y
+5 ;get status
+6 SET BDMSTAT=""
+7 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
+8 IF $DATA(DIRUT)
GOTO R
+9 IF Y=0
SET BDMSTAT=""
QUIT
+10 ;which status
+11 SET DIR(0)="9002241,1"
SET DIR("A")="Which status"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+12 IF $DATA(DIRUT)
GOTO R
+13 SET BDMSTAT=Y
+14 QUIT
A ;
+1 QUIT
ZIS ;
+1 SET BDMTEMP=""
+2 SET DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen"
SET DIR("A")="Output Type"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 SET BDMTEMP=Y
+5 ;call to XBDBQUE
DEMO ;
+1 DO DEMOCHK^BDMUTL(.BDMDEMO)
+2 IF BDMDEMO=-1
DO EXIT
QUIT
+3 IF BDMTEMP="B"
DO BROWSE
DO EXIT
QUIT
+4 SET XBRP="PRINT^BDMDR4"
SET XBRC="PROC^BDMDR4"
SET XBRX="EXIT^BDMDR4"
SET XBNS="BDM"
+5 DO ^XBDBQUE
+6 DO EXIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMDR4"")"
+2 SET XBRC="PROC^BDMDR4"
SET XBRX="EXIT^BDMDR4"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EXIT ;clean up and exit
+1 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
+2 DO ^XBFMK
+3 DO KILL^AUPNPAT
+4 QUIT
PROC ;EP - called from XBDBQUE
+1 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
+2 KILL ^XTMP("BDMDR4",BDMJOB,BDMBTH)
+3 DO XTMP^BDMOSUT("BDMDR4","DM NOT ON PROBLEM LIST")
+4 IF BDMTR="R"
DO REGPROC
QUIT
+5 IF BDMTR="A"
DO ALLPROC
QUIT
+6 QUIT
ALLPROC ;
+1 ;get last dm dx, if less than last date, Q
+2 ;if null Q
+3 ;get # of dxs, if less than BDMnd q
+4 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
DO CHK1SET
+5 QUIT
CHK1SET ;
+1 IF $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))
QUIT
+2 IF $$DOD^AUPNPAT(DFN)]""
QUIT
+3 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+4 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+5 SET BDMTB=$$HASTB(DFN)
+6 IF $EXTRACT(BDMTB)'=1
QUIT
+7 IF $$HASTBTX(DFN)
QUIT
+8 SET ^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",$PIECE(^DPT(DFN,0),U),DFN)=$PIECE(BDMTB," ",2,999)
+9 QUIT
HASTB(P) ;
+1 ;positive ppd
+2 NEW BDMS,E,X
+3 SET BDMS=$PIECE($$PPD^BDMDD18(DFN,DT),"||",2)
+4 QUIT BDMS
+5 ;
HASTBTX(P) ;
+1 IF '$GET(P)
QUIT ""
+2 NEW X,E,BDM,Y
+3 SET Y="BDM("
+4 SET X=P_"^LAST HEALTH TX COMPLETE"
SET E=$$START1^APCLDF(X,Y)
+5 IF $DATA(BDM(1))
QUIT $PIECE(BDM(1),U)
+6 QUIT ""
+7 ;
NUMDXS(P) ;
+1 IF '$GET(P)
QUIT ""
+2 NEW X,E,BDM,Y
+3 SET Y="BDM("
+4 SET X=P_"^ALL DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,Y)
+5 SET (X,Y)=0
+6 FOR
SET X=$ORDER(BDM(X))
IF X'=+X
QUIT
SET Y=Y+1
+7 QUIT Y
+8 ;
REGPROC ;
+1 ;$o through register, check status, if no DM on problem list
+2 ;set xtmp
+3 ;gather up patients from register in ^XTMP
+4 SET X=0
FOR
SET X=$ORDER(^ACM(41,"B",BDMREG,X))
IF X'=+X
QUIT
Begin DoDot:1
+5 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,X,"DT")),U,1)=BDMSTAT
SET DFN=$PIECE(^ACM(41,X,0),U,2)
DO CHKSET
QUIT
+6 IF BDMSTAT=""
SET DFN=$PIECE(^ACM(41,X,0),U,2)
DO CHKSET
QUIT
+7 QUIT
End DoDot:1
+8 QUIT
CHKSET ;
+1 IF $$DOD^AUPNPAT(DFN)]""
QUIT
+2 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+3 ;IHS/CMI/GRL
IF $PIECE($GET(^AUPNPAT(DFN,41,$SELECT($GET(BDMDUZ2)
QUIT
+4 SET BDMTB=$$HASTB(DFN)
+5 IF $EXTRACT(BDMTB)'=1
QUIT
+6 IF $$HASTBTX(DFN)
QUIT
+7 SET ^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",$PIECE(^DPT(DFN,0),U),DFN)=$PIECE(BDMTB," ",2,999)
+8 QUIT
PRINT ;EP - called from xbdbque
+1 SET BDMIOSL=$SELECT($GET(BDMGUI):55,1:IOSL)
+2 SET BDM80D="-------------------------------------------------------------------------------"
+3 SET BDMPG=0
DO HEAD
+4 IF '$DATA(^XTMP("BDMDR4",BDMJOB,BDMBTH))
WRITE !!,"NO PATIENTS TO REPORT"
GOTO EXIT
+5 SET BDMNAME=""
KILL BDMQ
+6 FOR
SET BDMNAME=$ORDER(^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME))
IF BDMNAME=""!($DATA(BDMQ))
QUIT
Begin DoDot:1
+7 SET DFN=""
FOR
SET DFN=$ORDER(^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN))
IF DFN=""!($DATA(BDMQ))
QUIT
SET BDMX=^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)
Begin DoDot:2
+8 IF $Y>(BDMIOSL-4)
DO HEAD
IF $DATA(BDMQ)
QUIT
+9 WRITE !,$EXTRACT(BDMNAME,1,20),?22,$$HRN^AUPNPAT(DFN,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?29,$$DOB^AUPNPAT(DFN,"E"),?43,$PIECE(^DPT(DFN,0),U,2),?47,$$FMTE^XLFDT($$LASTVD^APCLV1(DFN))
+10 WRITE !?5,"TB Status: ",^XTMP("BDMDR4",BDMJOB,BDMBTH,"PATIENTS",BDMNAME,DFN)
+11 WRITE !?5,"Last Documented TB Health Factor: ",$$LASTHF^BDMSMU(DFN,"TB STATUS","B")
End DoDot:2
End DoDot:1
+12 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+13 IF $DATA(IOF)
WRITE @IOF
+14 KILL ^XTMP("BDMDR4",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+15 QUIT
HEAD IF 'BDMPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDMQ=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BDMPG=BDMPG+1
+2 IF $GET(BDMGUI)
IF BDMPG'=1
WRITE !,"ZZZZZZZ"
+3 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+4 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!
+5 WRITE ?(80-$LENGTH($PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U))/2),$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),!
+6 WRITE $$CTR("PATIENTS W/POSITIVE PPD/TB W/O DOCUMENTED TX COMPLETE",80),!
+7 IF BDMTR="R"
WRITE $$CTR("Patients on the "_$PIECE(^ACM(41.1,BDMREG,0),U)_" Register",80),!
PIH WRITE !,"PATIENT NAME",?22,"HRN",?29,"DOB",?47,"LAST VISIT",!,BDM80D
+1 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 ;----------
TEST ;
+1 DO BDMG("R",1,"A")
+2 QUIT
BDMG(BDMTR,BDMREG,BDMSTAT,BDMDEMO) ;EP - GUI DMS Entry Point
+1 SET BDMND=$GET(BDMND)
+2 SET BDMGUI=1
+3 SET BDMLDAT=$GET(BDMLDAT)
+4 NEW BDMNOW,BDMOPT,BDMIEN
+5 SET BDMOPT="Patients w/POS PPD/TB w/o TX"
+6 DO NOW^%DTC
+7 SET BDMNOW=$GET(%)
+8 KILL DD,DO,DIC
+9 SET X=DUZ_BDMNOW
+10 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$GET(BDMOPT)_";.07////R"
+11 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+12 DO FILE^DICN
+13 KILL DIADD,DLAYGO,DIC,DA
+14 IF Y=-1
SET BDMIEN=-1
QUIT
+15 SET BDMIEN=+Y
+16 ;cmi/maw added
SET BDMGIEN=BDMIEN
+17 DO ^XBFMK
+18 KILL ZTSAVE
SET ZTSAVE("*")=""
+19 ;D GUIEP for interactive testing
+20 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMDR4"
SET ZTDESC="GUI DM PTS TB"
DO ^%ZTLOAD
+21 DO EXIT
+22 QUIT
GUIEP ;EP
+1 DO PROC
+2 KILL ^TMP($JOB,"BDMDR4")
+3 SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMDR4","^TMP($J,""BDMDR4"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDR4",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET BDMDATA=^TMP($JOB,"BDMDR4",X)
+7 ;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
+8 SET ^BDMGUI(BDMIEN,11,X,0)=BDMDATA
SET C=C+1
End DoDot:1
+9 SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+10 SET DA=BDMIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+11 DO ENDLOG
+12 KILL ^TMP($JOB,"BDMDR4")
+13 DO EXIT
+14 SET ZTREQ="@"
+15 QUIT
+16 ;
ENDLOG ;-- write the end of the log
+1 DO NOW^%DTC
+2 SET BDMNOW=$GET(%)
+3 SET DIE="^BDMGUI("
SET DA=BDMIEN
SET DR=".04////"_BDMNOW_";.07////C"
+4 DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
