BDMDMSM ; IHS/CMI/LAB - print Self Monitoring Pts for dm patients ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3**;JUN 14, 2007
;
;
;this routine will go through the Diabetes Register
;and then see if the patient has an Self Monitoring Glucose Health Factor
;
EP ;EP - called from option interactive
D EOJ
W:$D(IOF) @IOF
W !!,"This option will provide a list of patients on a register"
W !,"(e.g. IHS Diabetes) that either are doing Self Monitoring of"
W !,"Glucose or who are not doing Self Monitoring of Glucose."
W !,"The following definitions/logic is used:"
W !?5,"Yes, Doing self monitoring:"
W !?7,"- the last health factor documented in the 365 days prior to the"
W !?7,"end date is SELF MONITORING BLOOD GLUCOSE-YES"
W !?7,"- the patient has had strips dispensed through pharmacy in "
W !?7,"the 365 days prior to the end date."
W !?5,"No, not doing self monitoring"
W !?7,"- the last health factor documented in the 365 days prior to"
W !?7,"the end date is SELF MONITORING BLOOD GLUCOSE-NO or SELF MONITORING"
W !?7,"BLOOD GLUCOSE-REFUSED"
W !?7,"- the patient has had no strips dispensed through pharmacy"
W !?7,"- the patient has had neither strips dispensed nor a health"
W !?7,"factor documented in the 365 days prior to the end date"
W !!,"In the case of the following conflict: the patient's last"
W !,"health factor states NO or REFUSED but they have had strips"
W !,"dispensed they will show up on each report with a status of"
W !,"Maybe."
;W !!,"This option will print a list of all patients on a register"
;W !,"(e.g. Diabetes Register) who have a Health Factor "
;W !,"for SELF MONITORING BLOOD GLUCOSE.",!!
;W "You will be asked to enter the name of the register & the date range of the"
;W !,"Visits. The Report will Display YES or NO or REFUSED Self Monitoring",!
REGISTER ;get register name
S BDMREG=""
W ! S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC
I Y=-1 S BDMREG="" W !,"No Register Selected." G EOJ
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 REGISTER
I Y=0 S BDMSTAT="" G REPORT
;which status
S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G REGISTER
S BDMSTAT=Y
REPORT ;
S BDMRPT=""
S DIR(0)="S^Y:YES, Doing Self Monitoring;N:NO, Not doing Self Monitoring;B:Both",DIR("A")="What list of patients do you want",DIR("B")="N" K DA D ^DIR KILL DIR
I $D(DIRUT) G REGISTER
S BDMRPT=Y
ENDDATE ;
S BDMED=""
W !!,"Enter the end date to use in calculating the 365 day time period."
S DIR(0)="D^::EPX",DIR("A")="Enter the End Date" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G REPORT
S BDMED=Y
SORTED ;
K DIR S DIR(0)="SO^H:HRN;P:PATIENT NAME;C:COMMUNITY OF RESIDENCE",DIR("A")="How would you like the report sorted",DIR("B")="H" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G ENDDATE
S BDMSORT=Y
ZIS ;
DEMO ;
D DEMOCHK^BDMUTL(.BDMDEMO)
I BDMDEMO=-1 G SORTED
S XBRP="PRINT^BDMDMSM",XBRC="PROC^BDMDMSM",XBRX="EOJ^BDMDMSM",XBNS="BDM"
D ^XBDBQUE
Q
EOJ ;
D ^XBFMK
K DIC,DIR
I '$D(BDMGUI) D EN^XBVK("BDM")
Q
;
PROC ;
K ^XTMP("BDMDMSM")
S BDMJ=$J,BDMH=$H
S ^XTMP("BDMDMSM",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH SELF MONITORING"
S BDMDMX=0 F S BDMDMX=$O(^ACM(41,"B",BDMREG,BDMDMX)) Q:BDMDMX'=+BDMDMX D
.;check to see if patient has Self Monitoring or not
.;check register status
.I BDMSTAT]"",$P($G(^ACM(41,BDMDMX,"DT")),U,1)'=BDMSTAT Q
.S DFN=$P(^ACM(41,BDMDMX,0),U,2)
.Q:$$DEMO^BDMUTL(DFN,$G(BDMDEMO))
.Q:$$DOD^AUPNPAT(DFN)]"" ;don't display deceased patients
.S BDMHF=$$LASTHF(DFN,"DIABETES SELF MONITORING",$$FMADD^XLFDT(BDMED,-365),"B")
.I BDMHF["YES" S BDMHFG=1
.I BDMHF="" S BDMHFG=""
.I BDMHF["NO" S BDMHFG=0
.I BDMHF["REFUSE" S BDMHFG=0
.K BDMMED
.S X=DFN_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_$$FMADD^XLFDT(BDMED,-365)_"-"_BDMED S E=$$START1^APCLDF(X,"BDMMED(")
.I $D(BDMMED(1)) S BDMMEDG=1
.I '$D(BDMMED(1)) S BDMMEDG=0
.D SETVAL
.I BDMRPT="Y",BDMVAL="N" Q
.I BDMRPT="N",BDMVAL="Y" Q
.S ^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",$$SORT(DFN,BDMSORT),DFN)=BDMHF_"||"_$G(BDMMED(1))_"||"_BDMVAL
.Q
Q
SORT(P,BDMSORT) ;
NEW X S X=""
I BDMSORT="H" S X=$$HRN^AUPNPAT(P,DUZ(2))
I BDMSORT="P" S X=$P(^DPT(P,0),U)
I BDMSORT="C" S X=$$COMMRES^AUPNPAT(P)
I X="" S X="----"
Q X
SETVAL ;
S BDMVAL=""
I BDMMEDG=1,BDMHFG=1 S BDMVAL="Y" Q
I BDMMEDG=1,BDMHFG="" S BDMVAL="Y" Q
I BDMMEDG=1,BDMHFG=0 S BDMVAL="M" Q
I BDMHFG=1 S BDMVAL="Y" Q
I BDMHFG=0 S BDMVAL="N" Q
I BDMHFG="" S BDMVAL="N" Q
Q
DONE ;
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
K BDMTS,BDMS,BDMM,BDMET
K ^XTMP("BDMDMSM",BDMJ,BDMH),BDMJ,BDMH
Q
;
PRINT ;EP - called from xbdbque
K BDMQ S BDMPG=0 D HEADER
I '$D(^XTMP("BDMDMSM",BDMJ,BDMH)) W !!,"NO DATA TO REPORT",! G DONE
S BDMSV="" F S BDMSV=$O(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV)) Q:BDMSV=""!($D(BDMQ)) D
.S DFN=0 F S DFN=$O(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN)) Q:DFN'=+DFN!($D(BDMQ)) D
..I $Y>(IOSL-4) D HEADER Q:$D(BDMQ)
..I BDMRPT="Y" W !
..W !,$$HRN^AUPNPAT(DFN,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?7,$E($P(^DPT(DFN,0),U),1,28),?38,$E($$COMMRES^AUPNPAT(DFN,"E"),1,15),?54,$$LASTVD^APCLV1(DFN,"E")
..S BDMVAL=$P(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",3)
..S BDMMED=$P(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",2)
..S BDMHF=$P(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",1)
..S X="",BDMLHF="",BDMLMED=""
..I BDMVAL="Y" S X="Yes"
..I BDMVAL="N" S X="No"
..I BDMVAL="M" S X="Maybe"
..;I BDMHF="",BDMMED="" S BDMLHF="Not documented" G PRINT1
..S BDMLHF=BDMHF
..S BDMLMED=$P(BDMMED,U,2)_$S($P(BDMMED,U,2)]"":" on ",1:"")_$$FMTE^XLFDT($P(BDMMED,U),2)
PRINT1 ..W ?75,X
..I BDMLHF]"" W !?3,"Health Factor: ",BDMLHF
..I BDMLMED]"" W !?3,"Medication Dispensed: ",BDMLMED
D DONE
Q
G:'BDMPG HEADER1
K DIR 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
W:$D(IOF) @IOF S BDMPG=BDMPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BDMPG,!
W !,$$CTR("PATIENTS ON THE "_$P(^ACM(41.1,BDMREG,0),U)_" REGISTER - BLOOD GLUCOSE SELF MONITORING",80),!
I BDMRPT="Y" W $$CTR("Patients Doing Self Monitoring",80),!
I BDMRPT="N" W $$CTR("Patients NOT Doing Self Monitoring",80),!
I BDMRPT="B" W $$CTR("List of Patients w/Self Monitoring of Blood Glucose Status",80),!
S X="End Date: "_$$FMTE^XLFDT(BDMED) W $$CTR(X,80),!
W !,"HRN",?7,"PATIENT NAME",?38,"COMMUNITY",?54,"LAST VISIT",?75,"SMBG?"
W !,$TR($J("",80)," ","-")
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("A")="End of report. Press Enter",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")
;----------
POST ;
NEW X
S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM REG APPT CLN","BDM")
I 'X W "Attempt to new appt list of reg pats failed.." H 3
Q
LASTHF(P,C,BDATE,F) ;EP - get last factor in category C for patient P
I '$G(P) Q ""
I $G(C)="" Q ""
I $G(F)="" S F=""
S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
I '$G(C) Q ""
NEW H,D,O S H=0 K O
F S H=$O(^AUTTHF("AC",C,H)) Q:'+H D
. Q:'$D(^AUPNVHF("AA",P,H))
. S D=$O(^AUPNVHF("AA",P,H,""))
. Q:'D
. Q:(9999999-D)<BDATE
. S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
. Q
S D=$O(O(0))
I D="" Q D
I F="N" Q $$VAL^XBDIQ1(9000010.23,O(D),.01)
I F="S" Q $P($G(^AUPNVHF(O(D),0)),U,6)
I F="B" Q $$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$FMTE^XLFDT((9999999-D),2)
Q 9999999-D
BDMDMSM ; IHS/CMI/LAB - print Self Monitoring Pts for dm patients ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3**;JUN 14, 2007
+2 ;
+3 ;
+4 ;this routine will go through the Diabetes Register
+5 ;and then see if the patient has an Self Monitoring Glucose Health Factor
+6 ;
EP ;EP - called from option interactive
+1 DO EOJ
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"This option will provide a list of patients on a register"
+4 WRITE !,"(e.g. IHS Diabetes) that either are doing Self Monitoring of"
+5 WRITE !,"Glucose or who are not doing Self Monitoring of Glucose."
+6 WRITE !,"The following definitions/logic is used:"
+7 WRITE !?5,"Yes, Doing self monitoring:"
+8 WRITE !?7,"- the last health factor documented in the 365 days prior to the"
+9 WRITE !?7,"end date is SELF MONITORING BLOOD GLUCOSE-YES"
+10 WRITE !?7,"- the patient has had strips dispensed through pharmacy in "
+11 WRITE !?7,"the 365 days prior to the end date."
+12 WRITE !?5,"No, not doing self monitoring"
+13 WRITE !?7,"- the last health factor documented in the 365 days prior to"
+14 WRITE !?7,"the end date is SELF MONITORING BLOOD GLUCOSE-NO or SELF MONITORING"
+15 WRITE !?7,"BLOOD GLUCOSE-REFUSED"
+16 WRITE !?7,"- the patient has had no strips dispensed through pharmacy"
+17 WRITE !?7,"- the patient has had neither strips dispensed nor a health"
+18 WRITE !?7,"factor documented in the 365 days prior to the end date"
+19 WRITE !!,"In the case of the following conflict: the patient's last"
+20 WRITE !,"health factor states NO or REFUSED but they have had strips"
+21 WRITE !,"dispensed they will show up on each report with a status of"
+22 WRITE !,"Maybe."
+23 ;W !!,"This option will print a list of all patients on a register"
+24 ;W !,"(e.g. Diabetes Register) who have a Health Factor "
+25 ;W !,"for SELF MONITORING BLOOD GLUCOSE.",!!
+26 ;W "You will be asked to enter the name of the register & the date range of the"
+27 ;W !,"Visits. The Report will Display YES or NO or REFUSED Self Monitoring",!
REGISTER ;get register name
+1 SET BDMREG=""
+2 WRITE !
SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Register: "
DO ^DIC
+3 IF Y=-1
SET BDMREG=""
WRITE !,"No Register Selected."
GOTO EOJ
+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 REGISTER
+9 IF Y=0
SET BDMSTAT=""
GOTO REPORT
+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 REGISTER
+13 SET BDMSTAT=Y
REPORT ;
+1 SET BDMRPT=""
+2 SET DIR(0)="S^Y:YES, Doing Self Monitoring;N:NO, Not doing Self Monitoring;B:Both"
SET DIR("A")="What list of patients do you want"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO REGISTER
+4 SET BDMRPT=Y
ENDDATE ;
+1 SET BDMED=""
+2 WRITE !!,"Enter the end date to use in calculating the 365 day time period."
+3 SET DIR(0)="D^::EPX"
SET DIR("A")="Enter the End Date"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO REPORT
+5 SET BDMED=Y
SORTED ;
+1 KILL DIR
SET DIR(0)="SO^H:HRN;P:PATIENT NAME;C:COMMUNITY OF RESIDENCE"
SET DIR("A")="How would you like the report sorted"
SET DIR("B")="H"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO ENDDATE
+3 SET BDMSORT=Y
ZIS ;
DEMO ;
+1 DO DEMOCHK^BDMUTL(.BDMDEMO)
+2 IF BDMDEMO=-1
GOTO SORTED
+3 SET XBRP="PRINT^BDMDMSM"
SET XBRC="PROC^BDMDMSM"
SET XBRX="EOJ^BDMDMSM"
SET XBNS="BDM"
+4 DO ^XBDBQUE
+5 QUIT
EOJ ;
+1 DO ^XBFMK
+2 KILL DIC,DIR
+3 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
+4 QUIT
+5 ;
PROC ;
+1 KILL ^XTMP("BDMDMSM")
+2 SET BDMJ=$JOB
SET BDMH=$HOROLOG
+3 SET ^XTMP("BDMDMSM",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH SELF MONITORING"
+4 SET BDMDMX=0
FOR
SET BDMDMX=$ORDER(^ACM(41,"B",BDMREG,BDMDMX))
IF BDMDMX'=+BDMDMX
QUIT
Begin DoDot:1
+5 ;check to see if patient has Self Monitoring or not
+6 ;check register status
+7 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,BDMDMX,"DT")),U,1)'=BDMSTAT
QUIT
+8 SET DFN=$PIECE(^ACM(41,BDMDMX,0),U,2)
+9 IF $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))
QUIT
+10 ;don't display deceased patients
IF $$DOD^AUPNPAT(DFN)]""
QUIT
+11 SET BDMHF=$$LASTHF(DFN,"DIABETES SELF MONITORING",$$FMADD^XLFDT(BDMED,-365),"B")
+12 IF BDMHF["YES"
SET BDMHFG=1
+13 IF BDMHF=""
SET BDMHFG=""
+14 IF BDMHF["NO"
SET BDMHFG=0
+15 IF BDMHF["REFUSE"
SET BDMHFG=0
+16 KILL BDMMED
+17 SET X=DFN_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_$$FMADD^XLFDT(BDMED,-365)_"-"_BDMED
SET E=$$START1^APCLDF(X,"BDMMED(")
+18 IF $DATA(BDMMED(1))
SET BDMMEDG=1
+19 IF '$DATA(BDMMED(1))
SET BDMMEDG=0
+20 DO SETVAL
+21 IF BDMRPT="Y"
IF BDMVAL="N"
QUIT
+22 IF BDMRPT="N"
IF BDMVAL="Y"
QUIT
+23 SET ^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",$$SORT(DFN,BDMSORT),DFN)=BDMHF_"||"_$GET(BDMMED(1))_"||"_BDMVAL
+24 QUIT
End DoDot:1
+25 QUIT
SORT(P,BDMSORT) ;
+1 NEW X
SET X=""
+2 IF BDMSORT="H"
SET X=$$HRN^AUPNPAT(P,DUZ(2))
+3 IF BDMSORT="P"
SET X=$PIECE(^DPT(P,0),U)
+4 IF BDMSORT="C"
SET X=$$COMMRES^AUPNPAT(P)
+5 IF X=""
SET X="----"
+6 QUIT X
SETVAL ;
+1 SET BDMVAL=""
+2 IF BDMMEDG=1
IF BDMHFG=1
SET BDMVAL="Y"
QUIT
+3 IF BDMMEDG=1
IF BDMHFG=""
SET BDMVAL="Y"
QUIT
+4 IF BDMMEDG=1
IF BDMHFG=0
SET BDMVAL="M"
QUIT
+5 IF BDMHFG=1
SET BDMVAL="Y"
QUIT
+6 IF BDMHFG=0
SET BDMVAL="N"
QUIT
+7 IF BDMHFG=""
SET BDMVAL="N"
QUIT
+8 QUIT
DONE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. PRESS ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(IOF)
WRITE @IOF
+3 KILL BDMTS,BDMS,BDMM,BDMET
+4 KILL ^XTMP("BDMDMSM",BDMJ,BDMH),BDMJ,BDMH
+5 QUIT
+6 ;
PRINT ;EP - called from xbdbque
+1 KILL BDMQ
SET BDMPG=0
DO HEADER
+2 IF '$DATA(^XTMP("BDMDMSM",BDMJ,BDMH))
WRITE !!,"NO DATA TO REPORT",!
GOTO DONE
+3 SET BDMSV=""
FOR
SET BDMSV=$ORDER(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV))
IF BDMSV=""!($DATA(BDMQ))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN))
IF DFN'=+DFN!($DATA(BDMQ))
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(BDMQ)
QUIT
+6 IF BDMRPT="Y"
WRITE !
+7 WRITE !,$$HRN^AUPNPAT(DFN,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?7,$EXTRACT($PIECE(^DPT(DFN,0),U),1,28),?38,$EXTRACT($$COMMRES^AUPNPAT(DFN,"E"),1,15),?54,$$LASTVD^APCLV1(DFN,"E")
+8 SET BDMVAL=$PIECE(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",3)
+9 SET BDMMED=$PIECE(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",2)
+10 SET BDMHF=$PIECE(^XTMP("BDMDMSM",BDMJ,BDMH,"SELF",BDMSV,DFN),"||",1)
+11 SET X=""
SET BDMLHF=""
SET BDMLMED=""
+12 IF BDMVAL="Y"
SET X="Yes"
+13 IF BDMVAL="N"
SET X="No"
+14 IF BDMVAL="M"
SET X="Maybe"
+15 ;I BDMHF="",BDMMED="" S BDMLHF="Not documented" G PRINT1
+16 SET BDMLHF=BDMHF
+17 SET BDMLMED=$PIECE(BDMMED,U,2)_$SELECT($PIECE(BDMMED,U,2)]"":" on ",1:"")_$$FMTE^XLFDT($PIECE(BDMMED,U),2)
PRINT1 WRITE ?75,X
+1 IF BDMLHF]""
WRITE !?3,"Health Factor: ",BDMLHF
+2 IF BDMLMED]""
WRITE !?3,"Medication Dispensed: ",BDMLMED
End DoDot:2
End DoDot:1
+3 DO DONE
+4 QUIT
+1 IF 'BDMPG
GOTO HEADER1
+2 KILL DIR
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
+1 IF $DATA(IOF)
WRITE @IOF
SET BDMPG=BDMPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BDMPG,!
+3 WRITE !,$$CTR("PATIENTS ON THE "_$PIECE(^ACM(41.1,BDMREG,0),U)_" REGISTER - BLOOD GLUCOSE SELF MONITORING",80),!
+4 IF BDMRPT="Y"
WRITE $$CTR("Patients Doing Self Monitoring",80),!
+5 IF BDMRPT="N"
WRITE $$CTR("Patients NOT Doing Self Monitoring",80),!
+6 IF BDMRPT="B"
WRITE $$CTR("List of Patients w/Self Monitoring of Blood Glucose Status",80),!
+7 SET X="End Date: "_$$FMTE^XLFDT(BDMED)
WRITE $$CTR(X,80),!
+8 WRITE !,"HRN",?7,"PATIENT NAME",?38,"COMMUNITY",?54,"LAST VISIT",?75,"SMBG?"
+9 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+10 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("A")="End of report. Press Enter"
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 ;----------
POST ;
+1 NEW X
+2 SET X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM REG APPT CLN","BDM")
+3 IF 'X
WRITE "Attempt to new appt list of reg pats failed.."
HANG 3
+4 QUIT
LASTHF(P,C,BDATE,F) ;EP - get last factor in category C for patient P
+1 IF '$GET(P)
QUIT ""
+2 IF $GET(C)=""
QUIT ""
+3 IF $GET(F)=""
SET F=""
+4 ;ien of category passed
SET C=$ORDER(^AUTTHF("B",C,0))
+5 IF '$GET(C)
QUIT ""
+6 NEW H,D,O
SET H=0
KILL O
+7 FOR
SET H=$ORDER(^AUTTHF("AC",C,H))
IF '+H
QUIT
Begin DoDot:1
+8 IF '$DATA(^AUPNVHF("AA",P,H))
QUIT
+9 SET D=$ORDER(^AUPNVHF("AA",P,H,""))
+10 IF 'D
QUIT
+11 IF (9999999-D)<BDATE
QUIT
+12 SET O(D)=$ORDER(^AUPNVHF("AA",P,H,D,""))
+13 QUIT
End DoDot:1
+14 SET D=$ORDER(O(0))
+15 IF D=""
QUIT D
+16 IF F="N"
QUIT $$VAL^XBDIQ1(9000010.23,O(D),.01)
+17 IF F="S"
QUIT $PIECE($GET(^AUPNVHF(O(D),0)),U,6)
+18 IF F="B"
QUIT $$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$FMTE^XLFDT((9999999-D),2)
+19 QUIT 9999999-D
