APCLDMSM ; IHS/CMI/LAB - print Self Monitoring Pts for dm patients ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
;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 APCLREG=""
W ! S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC
I Y=-1 S APCLREG="" W !,"No Register Selected." G EOJ
S APCLREG=+Y
;get status
S APCLSTAT=""
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 APCLSTAT="" 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 APCLSTAT=Y
REPORT ;
S APCLRPT=""
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 APCLRPT=Y
ENDDATE ;
S APCLED=""
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 APCLED=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 APCLSORT=Y
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G SORTED
S XBRP="PRINT^APCLDMSM",XBRC="PROC^APCLDMSM",XBRX="EOJ^APCLDMSM",XBNS="APCL"
D ^XBDBQUE
Q
EOJ ;
D ^XBFMK
K DIC,DIR
D EN^XBVK("APCL")
Q
;
PROC ;
K ^XTMP("APCLDMSM")
S APCLJ=$J,APCLH=$H
S ^XTMP("APCLDMSM",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH SELF MONITORING"
S APCLDMX=0 F S APCLDMX=$O(^ACM(41,"B",APCLREG,APCLDMX)) Q:APCLDMX'=+APCLDMX D
.;check to see if patient has Self Monitoring or not
.;check register status
.I APCLSTAT]"",$P($G(^ACM(41,APCLDMX,"DT")),U,1)'=APCLSTAT Q
.S DFN=$P(^ACM(41,APCLDMX,0),U,2)
.Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
.Q:$$DOD^AUPNPAT(DFN)]"" ;don't display deceased patients
.S APCLHF=$$LASTHF(DFN,"DIABETES SELF MONITORING",$$FMADD^XLFDT(APCLED,-365),"B")
.I APCLHF["YES" S APCLHFG=1
.I APCLHF="" S APCLHFG=""
.I APCLHF["NO" S APCLHFG=0
.I APCLHF["REFUSE" S APCLHFG=0
.K APCLMED
.S X=DFN_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_$$FMADD^XLFDT(APCLED,-365)_"-"_APCLED S E=$$START1^APCLDF(X,"APCLMED(")
.I $D(APCLMED(1)) S APCLMEDG=1
.I '$D(APCLMED(1)) S APCLMEDG=0
.D SETVAL
.I APCLRPT="Y",APCLVAL="N" Q
.I APCLRPT="N",APCLVAL="Y" Q
.S ^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",$$SORT(DFN,APCLSORT),DFN)=APCLHF_"||"_$G(APCLMED(1))_"||"_APCLVAL
.Q
Q
SORT(P,APCLSORT) ;
NEW X S X=""
I APCLSORT="H" S X=$$HRN^AUPNPAT(P,DUZ(2))
I APCLSORT="P" S X=$P(^DPT(P,0),U)
I APCLSORT="C" S X=$$COMMRES^AUPNPAT(P)
I X="" S X="----"
Q X
SETVAL ;
S APCLVAL=""
I APCLMEDG=1,APCLHFG=1 S APCLVAL="Y" Q
I APCLMEDG=1,APCLHFG="" S APCLVAL="Y" Q
I APCLMEDG=1,APCLHFG=0 S APCLVAL="M" Q
I APCLHFG=1 S APCLVAL="Y" Q
I APCLHFG=0 S APCLVAL="N" Q
I APCLHFG="" S APCLVAL="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 APCLTS,APCLS,APCLM,APCLET
K ^XTMP("APCLDMSM",APCLJ,APCLH),APCLJ,APCLH
Q
;
PRINT ;EP - called from xbdbque
K APCLQ S APCLPG=0 D HEADER
I '$D(^XTMP("APCLDMSM",APCLJ,APCLH)) W !!,"NO DATA TO REPORT",! G DONE
S APCLSV="" F S APCLSV=$O(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV)) Q:APCLSV=""!($D(APCLQ)) D
.S DFN=0 F S DFN=$O(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN)) Q:DFN'=+DFN!($D(APCLQ)) D
..I $Y>(IOSL-4) D HEADER Q:$D(APCLQ)
..I APCLRPT="Y" W !
..W !,$$HRN^AUPNPAT(DFN,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 APCLVAL=$P(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",3)
..S APCLMED=$P(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",2)
..S APCLHF=$P(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",1)
..S X="",APCLLHF="",APCLLMED=""
..I APCLVAL="Y" S X="Yes"
..I APCLVAL="N" S X="No"
..I APCLVAL="M" S X="Maybe"
..;I APCLHF="",APCLMED="" S APCLLHF="Not documented" G PRINT1
..S APCLLHF=APCLHF
..S APCLLMED=$P(APCLMED,U,2)_$S($P(APCLMED,U,2)]"":" on ",1:"")_$$FMTE^XLFDT($P(APCLMED,U),2)
PRINT1 ..W ?75,X
..I APCLLHF]"" W !?3,"Health Factor: ",APCLLHF
..I APCLLMED]"" W !?3,"Medication Dispensed: ",APCLLMED
D DONE
Q
G:'APCLPG 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 APCLQ="" Q
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
W !,$$CTR("PATIENTS ON THE "_$P(^ACM(41.1,APCLREG,0),U)_" REGISTER - BLOOD GLUCOSE SELF MONITORING",80),!
I APCLRPT="Y" W $$CTR("Patients Doing Self Monitoring",80),!
I APCLRPT="N" W $$CTR("Patients NOT Doing Self Monitoring",80),!
I APCLRPT="B" W $$CTR("List of Patients w/Self Monitoring of Blood Glucose Status",80),!
S X="End Date: "_$$FMTE^XLFDT(APCLED) 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("APCL M MAIN DM MENU","APCL DM REG APPT CLN","APCL")
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
APCLDMSM ; IHS/CMI/LAB - print Self Monitoring Pts for dm patients ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+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 APCLREG=""
+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 APCLREG=""
WRITE !,"No Register Selected."
GOTO EOJ
+4 SET APCLREG=+Y
+5 ;get status
+6 SET APCLSTAT=""
+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 APCLSTAT=""
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 APCLSTAT=Y
REPORT ;
+1 SET APCLRPT=""
+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 APCLRPT=Y
ENDDATE ;
+1 SET APCLED=""
+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 APCLED=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 APCLSORT=Y
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO SORTED
+3 SET XBRP="PRINT^APCLDMSM"
SET XBRC="PROC^APCLDMSM"
SET XBRX="EOJ^APCLDMSM"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 QUIT
EOJ ;
+1 DO ^XBFMK
+2 KILL DIC,DIR
+3 DO EN^XBVK("APCL")
+4 QUIT
+5 ;
PROC ;
+1 KILL ^XTMP("APCLDMSM")
+2 SET APCLJ=$JOB
SET APCLH=$HOROLOG
+3 SET ^XTMP("APCLDMSM",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH SELF MONITORING"
+4 SET APCLDMX=0
FOR
SET APCLDMX=$ORDER(^ACM(41,"B",APCLREG,APCLDMX))
IF APCLDMX'=+APCLDMX
QUIT
Begin DoDot:1
+5 ;check to see if patient has Self Monitoring or not
+6 ;check register status
+7 IF APCLSTAT]""
IF $PIECE($GET(^ACM(41,APCLDMX,"DT")),U,1)'=APCLSTAT
QUIT
+8 SET DFN=$PIECE(^ACM(41,APCLDMX,0),U,2)
+9 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+10 ;don't display deceased patients
IF $$DOD^AUPNPAT(DFN)]""
QUIT
+11 SET APCLHF=$$LASTHF(DFN,"DIABETES SELF MONITORING",$$FMADD^XLFDT(APCLED,-365),"B")
+12 IF APCLHF["YES"
SET APCLHFG=1
+13 IF APCLHF=""
SET APCLHFG=""
+14 IF APCLHF["NO"
SET APCLHFG=0
+15 IF APCLHF["REFUSE"
SET APCLHFG=0
+16 KILL APCLMED
+17 SET X=DFN_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_$$FMADD^XLFDT(APCLED,-365)_"-"_APCLED
SET E=$$START1^APCLDF(X,"APCLMED(")
+18 IF $DATA(APCLMED(1))
SET APCLMEDG=1
+19 IF '$DATA(APCLMED(1))
SET APCLMEDG=0
+20 DO SETVAL
+21 IF APCLRPT="Y"
IF APCLVAL="N"
QUIT
+22 IF APCLRPT="N"
IF APCLVAL="Y"
QUIT
+23 SET ^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",$$SORT(DFN,APCLSORT),DFN)=APCLHF_"||"_$GET(APCLMED(1))_"||"_APCLVAL
+24 QUIT
End DoDot:1
+25 QUIT
SORT(P,APCLSORT) ;
+1 NEW X
SET X=""
+2 IF APCLSORT="H"
SET X=$$HRN^AUPNPAT(P,DUZ(2))
+3 IF APCLSORT="P"
SET X=$PIECE(^DPT(P,0),U)
+4 IF APCLSORT="C"
SET X=$$COMMRES^AUPNPAT(P)
+5 IF X=""
SET X="----"
+6 QUIT X
SETVAL ;
+1 SET APCLVAL=""
+2 IF APCLMEDG=1
IF APCLHFG=1
SET APCLVAL="Y"
QUIT
+3 IF APCLMEDG=1
IF APCLHFG=""
SET APCLVAL="Y"
QUIT
+4 IF APCLMEDG=1
IF APCLHFG=0
SET APCLVAL="M"
QUIT
+5 IF APCLHFG=1
SET APCLVAL="Y"
QUIT
+6 IF APCLHFG=0
SET APCLVAL="N"
QUIT
+7 IF APCLHFG=""
SET APCLVAL="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 APCLTS,APCLS,APCLM,APCLET
+4 KILL ^XTMP("APCLDMSM",APCLJ,APCLH),APCLJ,APCLH
+5 QUIT
+6 ;
PRINT ;EP - called from xbdbque
+1 KILL APCLQ
SET APCLPG=0
DO HEADER
+2 IF '$DATA(^XTMP("APCLDMSM",APCLJ,APCLH))
WRITE !!,"NO DATA TO REPORT",!
GOTO DONE
+3 SET APCLSV=""
FOR
SET APCLSV=$ORDER(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV))
IF APCLSV=""!($DATA(APCLQ))
QUIT
Begin DoDot:1
+4 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN))
IF DFN'=+DFN!($DATA(APCLQ))
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-4)
DO HEADER
IF $DATA(APCLQ)
QUIT
+6 IF APCLRPT="Y"
WRITE !
+7 WRITE !,$$HRN^AUPNPAT(DFN,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 APCLVAL=$PIECE(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",3)
+9 SET APCLMED=$PIECE(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",2)
+10 SET APCLHF=$PIECE(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",1)
+11 SET X=""
SET APCLLHF=""
SET APCLLMED=""
+12 IF APCLVAL="Y"
SET X="Yes"
+13 IF APCLVAL="N"
SET X="No"
+14 IF APCLVAL="M"
SET X="Maybe"
+15 ;I APCLHF="",APCLMED="" S APCLLHF="Not documented" G PRINT1
+16 SET APCLLHF=APCLHF
+17 SET APCLLMED=$PIECE(APCLMED,U,2)_$SELECT($PIECE(APCLMED,U,2)]"":" on ",1:"")_$$FMTE^XLFDT($PIECE(APCLMED,U),2)
PRINT1 WRITE ?75,X
+1 IF APCLLHF]""
WRITE !?3,"Health Factor: ",APCLLHF
+2 IF APCLLMED]""
WRITE !?3,"Medication Dispensed: ",APCLLMED
End DoDot:2
End DoDot:1
+3 DO DONE
+4 QUIT
+1 IF 'APCLPG
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 APCLQ=""
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
+3 WRITE !,$$CTR("PATIENTS ON THE "_$PIECE(^ACM(41.1,APCLREG,0),U)_" REGISTER - BLOOD GLUCOSE SELF MONITORING",80),!
+4 IF APCLRPT="Y"
WRITE $$CTR("Patients Doing Self Monitoring",80),!
+5 IF APCLRPT="N"
WRITE $$CTR("Patients NOT Doing Self Monitoring",80),!
+6 IF APCLRPT="B"
WRITE $$CTR("List of Patients w/Self Monitoring of Blood Glucose Status",80),!
+7 SET X="End Date: "_$$FMTE^XLFDT(APCLED)
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("APCL M MAIN DM MENU","APCL DM REG APPT CLN","APCL")
+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
