APCLACG ; IHS/CMI/LAB - IHS GPRA 09 SELECTED REPORT DRIVER 21 May 2008 12:10 PM ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;
W:$D(IOF) @IOF
W !!,$$CTR("Anticoagulation INR Management Report",80)
INTRO ;
D XIT
W !,"This will produce a report on anticoagulation therapy for a population you",!,"select."
W !,"Group definitions:"
W !,"W - Warfarin Patients = All patients with a prescription for Warfarin during"
W !," the report period. For the monthly report the time period will be in the"
W !," 45 days prior to the report period."
W !,"A - Anticoagulation Clinic Patients = All patients with a documented visit to"
W !," the anticoagulation clinic (clinic code D1) in the specifed report date "
W !," range. For the monthly report the time period will be 45 days."
W !,"S - Search Template = All patients in a search template you select."
W !,"I - iCare panel = All patients in an iCare panel you select."
W !,"E - EHR Personal List = All patients on an EHR Personal list that you select."
W !
GRP ;
S DIR(0)="S^W:Warfarin Patients;A:Anticoagulation Clinic Patients;S:Search Template of Patients;I:iCare Panel;E:EHR Personal List",DIR("A")="Which group of patients do you wish to report on" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S APCLGRP=Y
K APCLPTS
D @APCLGRP
I $G(APCLQUIT) W !!,"No GROUP selected." H 2 G INTRO
I APCLGRP="A" G TP
ACCL ;
K APCLACCL
W !!,"The following clinics have beeen identified as Anticoagulation clinics:"
W !?5,"D1 - Anticoagulation clinic"
S DIR(0)="Y",DIR("A")="Do you wish to add another clinic(s)",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT)!('Y) S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)="" G TP
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" Q
D PEP^AMQQGTX0(+Y,"APCLACCL(")
I '$D(APCLACCL) G A
I $D(APCLACCL("*")) W !!,"That is not a valid response, please select certain clinics" K APCLACCL G A
S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)=""
TP ;
W !!,"This is a monthly report. Enter the month and year."
S APCLRTYP="",(APCLBD,APCLED)=""
;S DIR(0)="S^MOS:Monthly Report;QUA:Quarterly Report;YEAR:Calendar Year Report",DIR("A")="Report Date Option",DIR("B")="MOS" KILL DA D ^DIR KILL DIR
;I $D(DIRUT) G GRP
S APCLRTYP="MOS"
S (APCLBD,APCLED)=""
D @APCLRTYP
I APCLBD="" G ACCL
LISTS ;any lists with measures?
I APCLRTYP'="MOS" G COMM ;lists are only on the monthly report
K APCLLIST
W !!,"PATIENT LISTS"
W !,"The following patient lists are available to be printed with this report."
W !,"Please select which reports you would like to include with the report."
W !,"1 - All patients in the population selected."
W !,"2 - Only patients in INR Goal Range and monitored this month"
W !,"3 - Only patients in INR Goal Range but NOT monitored this month"
W !,"4 - Only patients NOT in INR Goal Range but are monitored this month"
W !,"5 - Only patients NOT in INR Goal Range and are NOT monitored this month"
K APCLLIST
S DIR(0)="LO^1:5",DIR("A")="Which population would you like to view/print" KILL DA D ^DIR KILL DIR
S APCLANS=Y,APCLC="" F APCLI=1:1 S APCLC=$P(APCLANS,",",APCLI) Q:APCLC="" S APCLLIST(APCLC)=""
I '$D(APCLLIST) W !!,"No lists selected. Will print statistics only.",!
COMM ;get community taxonomy for user population
W !!,"Specify the community taxonomy to determine which patients will be",!
W "included in the user population/active clinical population. You should "
W !,"have created this taxonomy using QMAN.",!
K APCLTAX
S APCLTAXI=""
D ^XBFMK
S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
D ^DIC
I Y=-1 Q
S APCLTAXI=+Y
;
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF ANTICOAGULATION REPORT TO BE GENERATED")
W !
W !?5,"Report Period: ",?31,$$FMTE^XLFDT(APCLBD)," to ",?31,$$FMTE^XLFDT(APCLED)
W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(APCLTAXI,0),U)
I $D(APCLLIST) W !!,"Patient Lists will be produced.",!
ZIS ;call to XBDBQUE
W ! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D XIT Q
S APCLOPT=Y
I Y="B" D BROWSE,XIT Q
S XBRP="PRINT^APCLACG",XBRC="PROC^APCLACG",XBRX="XIT^APCLACG",XBNS="APCL"
D ^XBDBQUE
D XIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCLACG"")"
S XBRC="PROC^APCLACG",XBRX="XIT^APCLACG",XBIOP=0 D ^XBDBQUE
Q
;
XIT ;
;D ^%ZISC
D EN^XBVK("APCL") I $D(ZTQUEUED) S ZTREQ="@"
K DIRUT,DUOUT,DIR,DOD
K DIADD,DLAYGO
D KILL^AUPNPAT
K X,X1,X2,X3,X4,X5,X6
K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
K N,N1,N2,N3,N4,N5,N6
K BD,ED
D KILL^AUPNPAT
D ^XBFMK
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 DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR KILL 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")
;----------
QUA ;
S (APCLBD,APCLED,APCLQTR)=""
S DIR(0)="S^1:October 1 - September 30;2:january 1 - December 31;3:April 1 - March 31;4:July 1 - June 30",DIR("A")="Enter the quarter for your report" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S APCLQTR=Y
I APCLQTR'=5 D F
I APCLPER="" W !,"Year not entered.",! G TP
I APCLQTR=2 S APCLBD=$E(APCLPER,1,3)_"0101",APCLED=$E(APCLPER,1,3)_"1231"
I APCLQTR=3 S APCLBD=($E(APCLPER,1,3)-1)_"0401",APCLED=$E(APCLPER,1,3)_"0331"
I APCLQTR=4 S APCLBD=($E(APCLPER,1,3)-1)_"0701",APCLED=$E(APCLPER,1,3)_"0630"
I APCLQTR=1 S APCLBD=($E(APCLPER,1,3)-1)_"1001",APCLED=$E(APCLPER,1,3)_"0930"
I APCLED>DT D G:APCLDO=1 QUA
.W !!,"You have selected Current Report period ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
.W !,"The end date of this report is in the future; your data will not be",!,"complete.",!
.K DIR S APCLDO=0 S DIR(0)="Y",DIR("A")="Do you want to change your Current Report Dates",DIR("B")="Y" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCLDO=1 Q
.I Y S APCLDO=1 Q
Q
YEAR ;calendar year
S (APCLPER,APCLVDT)=""
W !!,"Enter the Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2009"
S DIR(0)="D^::EP"
S DIR("A")="Enter Year"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR KILL DIR
I $D(DIRUT) Q
I $D(DUOUT) S DIRUT=1 Q
S APCLVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G YEAR
S APCLPER=APCLVDT
S APCLBD=$E(APCLVDT,1,3)_"0101"
S APCLBD=$E(APCLVDT,1,3)_"1231"
W !!,"You chose ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G YEAR
I 'Y G YEAR
Q
S ;get search template
S APCLQUIT=0
S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 S APCLQUIT=1 Q
S APCLPTS="S"
S APCLSTMP=+Y
S X=0,C=0 F S X=$O(^DIBT(APCLSTMP,1,X)) Q:X'=+X S C=C+1,APCLPTS(X)=""
W !!,"There are ",C," patients in that search template that will be reported on."
Q
E ;EHR PERSONAL LIST
S APCLQUIT=0
S APCLPTS="E"
S APCLDATA=""
K ^TMP("BQITABLE",$J)
D TAB^BQIUTB(.APCLDATA,"PERS")
I $P($G(^TMP("BQITABLE",$J,1)),U,2)="" W !!,"You do not have any EHR Personal Lists defined." S APCLQUIT=1 Q
S APCLICP="" ;will set to OWNER^IEN^NAME OF LIST
D EN^APCLACGI
I APCLICP="" W !!,"no list selected." S APCLQUIT=1 Q
W !!,"You have selected EHR Personal List: ",$P(APCLICP,U,3)
Q
I ;ICARE GROUP
; GET THIS USERS LISTS AND PRESENT THEM
S APCLPTS="I",APCLQUIT=0
K ^TMP("BQIPLRT",$J)
;get list of this users panels in iCare
S APCLDATA=""
D LISTS^BQIPLRT(.APCLDATA)
I $P($G(^TMP("BQIPLRT",$J,1)),U,2)="" W !!,"You do not have any iCare panels defined." S APCLQUIT=1 Q
S APCLICP="" ;will set to owner^ien
D EN^APCLACGI
I APCLICP="" W !!,"no panel selected." S APCLQUIT=1 Q
W !!,"You have selected iCare panel: ",$P(APCLICP,U,3)
Q
A ;ANTICOAGULATION
S APCLPTS="A",APCLQUIT=0
K APCLACCL
W !!,"The following clinics have beeen identified as Anticoagulation clinics:"
W !?5,"D1 - Anticoagulation clinic"
S DIR(0)="Y",DIR("A")="Do you wish to add another clinic(s)",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT)!('Y) S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)="" Q
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" Q
D PEP^AMQQGTX0(+Y,"APCLACCL(")
I '$D(APCLACCL) G A
I $D(APCLACCL("*")) W !!,"That is not a valid response, please select certain clinics" K APCLACCL G A
S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)=""
Q
W ;WARFARIN
S APCLPTS="W",APCLQUIT=0
Q
;
PROC ;
D PROC^APCLACG1
Q
PRINT ;
I APCLRTYP="MOS" D ^APCLACGM
Q
MOS ;
S APCLVDT=""
S DIR(0)="FO^6:7",DIR("A")="Enter Month (e.g. 1/1999)",DIR("?")="Enter a month and 4 digit year in the following format: 1/1999, 01/2000. The slash is required between the month and year. Date must be in the past." KILL DA D ^DIR KILL DIR
Q:$D(DIRUT)
Q:X=""
I Y'?1.2N1"/"4N W !,"Enter the month/4 digit year in the format 1/1999. Slash is required and ",!,"4 digit year is required.",! G MOS
K %DT S X=Y,%DT="EP" D ^%DT
I Y=-1 W !!,"Enter a month and 4 digit year. Date must be in the past. E.g. 04/1999 or 01/2000." G MOS
I Y>DT W !!,"No future dates allowed!",! G MOS
S APCLVDT=Y
S APCLBD=$E(APCLVDT,1,3)_$E(APCLVDT,4,5)_"01"
S M=$E(APCLVDT,4,5)
S D=""
I M="09"!(M="04")!(M="06")!(M="11") S D=30
I D="",M'="02" S D=31
I M="02" S X=$E(APCLVDT,1,3)_"0229",%DT="P" D ^%DT D
.I Y=-1 S D=28 Q
.S D=29
S APCLED=$E(APCLVDT,1,3)_M_D
W !!,"You chose ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G MOS
I 'Y G MOS
Q
Y ;
F ;calendar year
S (APCLPER,APCLVDT)=""
W !!,"Enter the Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2009"
S DIR(0)="D^::EP"
S DIR("A")="Enter Year"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR KILL DIR
I $D(DIRUT) Q
I $D(DUOUT) S DIRUT=1 Q
S APCLVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
S APCLPER=APCLVDT
Q
APCLACG ; IHS/CMI/LAB - IHS GPRA 09 SELECTED REPORT DRIVER 21 May 2008 12:10 PM ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,$$CTR("Anticoagulation INR Management Report",80)
INTRO ;
+1 DO XIT
+2 WRITE !,"This will produce a report on anticoagulation therapy for a population you",!,"select."
+3 WRITE !,"Group definitions:"
+4 WRITE !,"W - Warfarin Patients = All patients with a prescription for Warfarin during"
+5 WRITE !," the report period. For the monthly report the time period will be in the"
+6 WRITE !," 45 days prior to the report period."
+7 WRITE !,"A - Anticoagulation Clinic Patients = All patients with a documented visit to"
+8 WRITE !," the anticoagulation clinic (clinic code D1) in the specifed report date "
+9 WRITE !," range. For the monthly report the time period will be 45 days."
+10 WRITE !,"S - Search Template = All patients in a search template you select."
+11 WRITE !,"I - iCare panel = All patients in an iCare panel you select."
+12 WRITE !,"E - EHR Personal List = All patients on an EHR Personal list that you select."
+13 WRITE !
GRP ;
+1 SET DIR(0)="S^W:Warfarin Patients;A:Anticoagulation Clinic Patients;S:Search Template of Patients;I:iCare Panel;E:EHR Personal List"
SET DIR("A")="Which group of patients do you wish to report on"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO XIT
QUIT
+3 SET APCLGRP=Y
+4 KILL APCLPTS
+5 DO @APCLGRP
+6 IF $GET(APCLQUIT)
WRITE !!,"No GROUP selected."
HANG 2
GOTO INTRO
+7 IF APCLGRP="A"
GOTO TP
ACCL ;
+1 KILL APCLACCL
+2 WRITE !!,"The following clinics have beeen identified as Anticoagulation clinics:"
+3 WRITE !?5,"D1 - Anticoagulation clinic"
+4 SET DIR(0)="Y"
SET DIR("A")="Do you wish to add another clinic(s)"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)!('Y)
SET X=$ORDER(^DIC(40.7,"C","D1",0))
IF X
SET APCLACCL(X)=""
GOTO TP
+6 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
QUIT
+7 DO PEP^AMQQGTX0(+Y,"APCLACCL(")
+8 IF '$DATA(APCLACCL)
GOTO A
+9 IF $DATA(APCLACCL("*"))
WRITE !!,"That is not a valid response, please select certain clinics"
KILL APCLACCL
GOTO A
+10 SET X=$ORDER(^DIC(40.7,"C","D1",0))
IF X
SET APCLACCL(X)=""
TP ;
+1 WRITE !!,"This is a monthly report. Enter the month and year."
+2 SET APCLRTYP=""
SET (APCLBD,APCLED)=""
+3 ;S DIR(0)="S^MOS:Monthly Report;QUA:Quarterly Report;YEAR:Calendar Year Report",DIR("A")="Report Date Option",DIR("B")="MOS" KILL DA D ^DIR KILL DIR
+4 ;I $D(DIRUT) G GRP
+5 SET APCLRTYP="MOS"
+6 SET (APCLBD,APCLED)=""
+7 DO @APCLRTYP
+8 IF APCLBD=""
GOTO ACCL
LISTS ;any lists with measures?
+1 ;lists are only on the monthly report
IF APCLRTYP'="MOS"
GOTO COMM
+2 KILL APCLLIST
+3 WRITE !!,"PATIENT LISTS"
+4 WRITE !,"The following patient lists are available to be printed with this report."
+5 WRITE !,"Please select which reports you would like to include with the report."
+6 WRITE !,"1 - All patients in the population selected."
+7 WRITE !,"2 - Only patients in INR Goal Range and monitored this month"
+8 WRITE !,"3 - Only patients in INR Goal Range but NOT monitored this month"
+9 WRITE !,"4 - Only patients NOT in INR Goal Range but are monitored this month"
+10 WRITE !,"5 - Only patients NOT in INR Goal Range and are NOT monitored this month"
+11 KILL APCLLIST
+12 SET DIR(0)="LO^1:5"
SET DIR("A")="Which population would you like to view/print"
KILL DA
DO ^DIR
KILL DIR
+13 SET APCLANS=Y
SET APCLC=""
FOR APCLI=1:1
SET APCLC=$PIECE(APCLANS,",",APCLI)
IF APCLC=""
QUIT
SET APCLLIST(APCLC)=""
+14 IF '$DATA(APCLLIST)
WRITE !!,"No lists selected. Will print statistics only.",!
COMM ;get community taxonomy for user population
+1 WRITE !!,"Specify the community taxonomy to determine which patients will be",!
+2 WRITE "included in the user population/active clinical population. You should "
+3 WRITE !,"have created this taxonomy using QMAN.",!
+4 KILL APCLTAX
+5 SET APCLTAXI=""
+6 DO ^XBFMK
+7 SET DIC("S")="I $P(^(0),U,15)=9999999.05"
SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Community Taxonomy: "
+8 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+9 DO ^DIC
+10 IF Y=-1
QUIT
+11 SET APCLTAXI=+Y
+12 ;
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF ANTICOAGULATION REPORT TO BE GENERATED")
+3 WRITE !
+4 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(APCLBD)," to ",?31,$$FMTE^XLFDT(APCLED)
+5 WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(APCLTAXI,0),U)
+6 IF $DATA(APCLLIST)
WRITE !!,"Patient Lists will be produced.",!
ZIS ;call to XBDBQUE
+1 WRITE !
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO XIT
QUIT
+3 SET APCLOPT=Y
+4 IF Y="B"
DO BROWSE
DO XIT
QUIT
+5 SET XBRP="PRINT^APCLACG"
SET XBRC="PROC^APCLACG"
SET XBRX="XIT^APCLACG"
SET XBNS="APCL"
+6 DO ^XBDBQUE
+7 DO XIT
+8 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCLACG"")"
+2 SET XBRC="PROC^APCLACG"
SET XBRX="XIT^APCLACG"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
XIT ;
+1 ;D ^%ZISC
+2 DO EN^XBVK("APCL")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL DIRUT,DUOUT,DIR,DOD
+4 KILL DIADD,DLAYGO
+5 DO KILL^AUPNPAT
+6 KILL X,X1,X2,X3,X4,X5,X6
+7 KILL A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
+8 KILL N,N1,N2,N3,N4,N5,N6
+9 KILL BD,ED
+10 DO KILL^AUPNPAT
+11 DO ^XBFMK
+12 QUIT
+13 ;
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 DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
KILL 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 ;----------
QUA ;
+1 SET (APCLBD,APCLED,APCLQTR)=""
+2 SET DIR(0)="S^1:October 1 - September 30;2:january 1 - December 31;3:April 1 - March 31;4:July 1 - June 30"
SET DIR("A")="Enter the quarter for your report"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 SET APCLQTR=Y
+5 IF APCLQTR'=5
DO F
+6 IF APCLPER=""
WRITE !,"Year not entered.",!
GOTO TP
+7 IF APCLQTR=2
SET APCLBD=$EXTRACT(APCLPER,1,3)_"0101"
SET APCLED=$EXTRACT(APCLPER,1,3)_"1231"
+8 IF APCLQTR=3
SET APCLBD=($EXTRACT(APCLPER,1,3)-1)_"0401"
SET APCLED=$EXTRACT(APCLPER,1,3)_"0331"
+9 IF APCLQTR=4
SET APCLBD=($EXTRACT(APCLPER,1,3)-1)_"0701"
SET APCLED=$EXTRACT(APCLPER,1,3)_"0630"
+10 IF APCLQTR=1
SET APCLBD=($EXTRACT(APCLPER,1,3)-1)_"1001"
SET APCLED=$EXTRACT(APCLPER,1,3)_"0930"
+11 IF APCLED>DT
Begin DoDot:1
+12 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
+13 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
+14 KILL DIR
SET APCLDO=0
SET DIR(0)="Y"
SET DIR("A")="Do you want to change your Current Report Dates"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)
SET APCLDO=1
QUIT
+16 IF Y
SET APCLDO=1
QUIT
End DoDot:1
IF APCLDO=1
GOTO QUA
+17 QUIT
YEAR ;calendar year
+1 SET (APCLPER,APCLVDT)=""
+2 WRITE !!,"Enter the Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2009"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter Year"
+5 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF $DATA(DUOUT)
SET DIRUT=1
QUIT
+9 SET APCLVDT=Y
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO YEAR
+11 SET APCLPER=APCLVDT
+12 SET APCLBD=$EXTRACT(APCLVDT,1,3)_"0101"
+13 SET APCLBD=$EXTRACT(APCLVDT,1,3)_"1231"
+14 WRITE !!,"You chose ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
+15 SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+16 IF $DATA(DIRUT)
GOTO YEAR
+17 IF 'Y
GOTO YEAR
+18 QUIT
S ;get search template
+1 SET APCLQUIT=0
+2 SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
SET DIC="^DIBT("
SET DIC("A")="Enter SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+3 IF Y=-1
SET APCLQUIT=1
QUIT
+4 SET APCLPTS="S"
+5 SET APCLSTMP=+Y
+6 SET X=0
SET C=0
FOR
SET X=$ORDER(^DIBT(APCLSTMP,1,X))
IF X'=+X
QUIT
SET C=C+1
SET APCLPTS(X)=""
+7 WRITE !!,"There are ",C," patients in that search template that will be reported on."
+8 QUIT
E ;EHR PERSONAL LIST
+1 SET APCLQUIT=0
+2 SET APCLPTS="E"
+3 SET APCLDATA=""
+4 KILL ^TMP("BQITABLE",$JOB)
+5 DO TAB^BQIUTB(.APCLDATA,"PERS")
+6 IF $PIECE($GET(^TMP("BQITABLE",$JOB,1)),U,2)=""
WRITE !!,"You do not have any EHR Personal Lists defined."
SET APCLQUIT=1
QUIT
+7 ;will set to OWNER^IEN^NAME OF LIST
SET APCLICP=""
+8 DO EN^APCLACGI
+9 IF APCLICP=""
WRITE !!,"no list selected."
SET APCLQUIT=1
QUIT
+10 WRITE !!,"You have selected EHR Personal List: ",$PIECE(APCLICP,U,3)
+11 QUIT
I ;ICARE GROUP
+1 ; GET THIS USERS LISTS AND PRESENT THEM
+2 SET APCLPTS="I"
SET APCLQUIT=0
+3 KILL ^TMP("BQIPLRT",$JOB)
+4 ;get list of this users panels in iCare
+5 SET APCLDATA=""
+6 DO LISTS^BQIPLRT(.APCLDATA)
+7 IF $PIECE($GET(^TMP("BQIPLRT",$JOB,1)),U,2)=""
WRITE !!,"You do not have any iCare panels defined."
SET APCLQUIT=1
QUIT
+8 ;will set to owner^ien
SET APCLICP=""
+9 DO EN^APCLACGI
+10 IF APCLICP=""
WRITE !!,"no panel selected."
SET APCLQUIT=1
QUIT
+11 WRITE !!,"You have selected iCare panel: ",$PIECE(APCLICP,U,3)
+12 QUIT
A ;ANTICOAGULATION
+1 SET APCLPTS="A"
SET APCLQUIT=0
+2 KILL APCLACCL
+3 WRITE !!,"The following clinics have beeen identified as Anticoagulation clinics:"
+4 WRITE !?5,"D1 - Anticoagulation clinic"
+5 SET DIR(0)="Y"
SET DIR("A")="Do you wish to add another clinic(s)"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)!('Y)
SET X=$ORDER(^DIC(40.7,"C","D1",0))
IF X
SET APCLACCL(X)=""
QUIT
+7 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
QUIT
+8 DO PEP^AMQQGTX0(+Y,"APCLACCL(")
+9 IF '$DATA(APCLACCL)
GOTO A
+10 IF $DATA(APCLACCL("*"))
WRITE !!,"That is not a valid response, please select certain clinics"
KILL APCLACCL
GOTO A
+11 SET X=$ORDER(^DIC(40.7,"C","D1",0))
IF X
SET APCLACCL(X)=""
+12 QUIT
W ;WARFARIN
+1 SET APCLPTS="W"
SET APCLQUIT=0
+2 QUIT
+3 ;
PROC ;
+1 DO PROC^APCLACG1
+2 QUIT
PRINT ;
+1 IF APCLRTYP="MOS"
DO ^APCLACGM
+2 QUIT
MOS ;
+1 SET APCLVDT=""
+2 SET DIR(0)="FO^6:7"
SET DIR("A")="Enter Month (e.g. 1/1999)"
SET DIR("?")="Enter a month and 4 digit year in the following format: 1/1999, 01/2000. The slash is required between the month and year. Date must be in the past."
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF X=""
QUIT
+5 IF Y'?1.2N1"/"4N
WRITE !,"Enter the month/4 digit year in the format 1/1999. Slash is required and ",!,"4 digit year is required.",!
GOTO MOS
+6 KILL %DT
SET X=Y
SET %DT="EP"
DO ^%DT
+7 IF Y=-1
WRITE !!,"Enter a month and 4 digit year. Date must be in the past. E.g. 04/1999 or 01/2000."
GOTO MOS
+8 IF Y>DT
WRITE !!,"No future dates allowed!",!
GOTO MOS
+9 SET APCLVDT=Y
+10 SET APCLBD=$EXTRACT(APCLVDT,1,3)_$EXTRACT(APCLVDT,4,5)_"01"
+11 SET M=$EXTRACT(APCLVDT,4,5)
+12 SET D=""
+13 IF M="09"!(M="04")!(M="06")!(M="11")
SET D=30
+14 IF D=""
IF M'="02"
SET D=31
+15 IF M="02"
SET X=$EXTRACT(APCLVDT,1,3)_"0229"
SET %DT="P"
DO ^%DT
Begin DoDot:1
+16 IF Y=-1
SET D=28
QUIT
+17 SET D=29
End DoDot:1
+18 SET APCLED=$EXTRACT(APCLVDT,1,3)_M_D
+19 WRITE !!,"You chose ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
+20 SET DIR(0)="Y"
SET DIR("A")="Is this correct"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+21 IF $DATA(DIRUT)
GOTO MOS
+22 IF 'Y
GOTO MOS
+23 QUIT
Y ;
F ;calendar year
+1 SET (APCLPER,APCLVDT)=""
+2 WRITE !!,"Enter the Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2009"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter Year"
+5 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
QUIT
+8 IF $DATA(DUOUT)
SET DIRUT=1
QUIT
+9 SET APCLVDT=Y
+10 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO F
+11 SET APCLPER=APCLVDT
+12 QUIT
