Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCLACG

APCLACG.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !!,$$CTR("Anticoagulation INR Management Report",80)
  1. INTRO ;
  1.  D XIT
  1.  W !,"This will produce a report on anticoagulation therapy for a population you",!,"select."
  1.  W !,"Group definitions:"
  1.  W !,"W - Warfarin Patients = All patients with a prescription for Warfarin during"
  1.  W !,"    the report period.  For the monthly report the time period will be in the"
  1.  W !,"    45 days prior to the report period."
  1.  W !,"A - Anticoagulation Clinic Patients = All patients with a documented visit to"
  1.  W !,"    the anticoagulation clinic  (clinic code D1) in the specifed report date "
  1.  W !,"    range.  For the monthly report the time period will be 45 days."
  1.  W !,"S - Search Template = All patients in a search template you select."
  1.  W !,"I - iCare panel = All patients in an iCare panel you select."
  1.  W !,"E - EHR Personal List = All patients on an EHR Personal list that you select."
  1.  W !
  1. GRP ;
  1.  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
  1.  I $D(DIRUT) D XIT Q
  1.  S APCLGRP=Y
  1.  K APCLPTS
  1.  D @APCLGRP
  1.  I $G(APCLQUIT) W !!,"No GROUP selected." H 2 G INTRO
  1.  I APCLGRP="A" G TP
  1. ACCL ;
  1.  K APCLACCL
  1.  W !!,"The following clinics have beeen identified as Anticoagulation clinics:"
  1.  W !?5,"D1 - Anticoagulation clinic"
  1.  S DIR(0)="Y",DIR("A")="Do you wish to add another clinic(s)",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT)!('Y) S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)="" G TP
  1.  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
  1.  D PEP^AMQQGTX0(+Y,"APCLACCL(")
  1.  I '$D(APCLACCL) G A
  1.  I $D(APCLACCL("*")) W !!,"That is not a valid response, please select certain clinics" K APCLACCL G A
  1.  S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)=""
  1. TP ;
  1.  W !!,"This is a monthly report.  Enter the month and year."
  1.  S APCLRTYP="",(APCLBD,APCLED)=""
  1.  ;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
  1.  ;I $D(DIRUT) G GRP
  1.  S APCLRTYP="MOS"
  1.  S (APCLBD,APCLED)=""
  1.  D @APCLRTYP
  1.  I APCLBD="" G ACCL
  1. LISTS ;any lists with measures?
  1.  I APCLRTYP'="MOS" G COMM  ;lists are only on the monthly report
  1.  K APCLLIST
  1.  W !!,"PATIENT LISTS"
  1.  W !,"The following patient lists are available to be printed with this report."
  1.  W !,"Please select which reports you would like to include with the report."
  1.  W !,"1 - All patients in the population selected."
  1.  W !,"2 - Only patients in INR Goal Range and monitored this month"
  1.  W !,"3 - Only patients in INR Goal Range but NOT monitored this month"
  1.  W !,"4 - Only patients NOT in INR Goal Range but are monitored this month"
  1.  W !,"5 - Only patients NOT in INR Goal Range and are NOT monitored this month"
  1.  K APCLLIST
  1.  S DIR(0)="LO^1:5",DIR("A")="Which population would you like to view/print" KILL DA D ^DIR KILL DIR
  1.  S APCLANS=Y,APCLC="" F APCLI=1:1 S APCLC=$P(APCLANS,",",APCLI) Q:APCLC=""  S APCLLIST(APCLC)=""
  1.  I '$D(APCLLIST) W !!,"No lists selected.  Will print statistics only.",!
  1. COMM ;get community taxonomy for user population
  1.  W !!,"Specify the community taxonomy to determine which patients will be",!
  1.  W "included in the user population/active clinical population.  You should "
  1.  W !,"have created this taxonomy using QMAN.",!
  1.  K APCLTAX
  1.  S APCLTAXI=""
  1.  D ^XBFMK
  1.  S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
  1.  S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
  1.  D ^DIC
  1.  I Y=-1 Q
  1.  S APCLTAXI=+Y
  1.  ;
  1. SUM ;display summary of this report
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("SUMMARY OF ANTICOAGULATION REPORT TO BE GENERATED")
  1.  W !
  1.  W !?5,"Report Period: ",?31,$$FMTE^XLFDT(APCLBD)," to ",?31,$$FMTE^XLFDT(APCLED)
  1.  W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(APCLTAXI,0),U)
  1.  I $D(APCLLIST) W !!,"Patient Lists will be produced.",!
  1. ZIS ;call to XBDBQUE
  1.  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
  1.  I $D(DIRUT) D XIT Q
  1.  S APCLOPT=Y
  1.  I Y="B" D BROWSE,XIT Q
  1.  S XBRP="PRINT^APCLACG",XBRC="PROC^APCLACG",XBRX="XIT^APCLACG",XBNS="APCL"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^APCLACG"")"
  1.  S XBRC="PROC^APCLACG",XBRX="XIT^APCLACG",XBIOP=0 D ^XBDBQUE
  1.  Q
  1.  ;
  1. XIT ;
  1.  ;D ^%ZISC
  1.  D EN^XBVK("APCL") I $D(ZTQUEUED) S ZTREQ="@"
  1.  K DIRUT,DUOUT,DIR,DOD
  1.  K DIADD,DLAYGO
  1.  D KILL^AUPNPAT
  1.  K X,X1,X2,X3,X4,X5,X6
  1.  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
  1.  K N,N1,N2,N3,N4,N5,N6
  1.  K BD,ED
  1.  D KILL^AUPNPAT
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR KILL DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. QUA ;
  1.  S (APCLBD,APCLED,APCLQTR)=""
  1.  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
  1.  I $D(DIRUT) Q
  1.  S APCLQTR=Y
  1.  I APCLQTR'=5 D F
  1.  I APCLPER="" W !,"Year not entered.",! G TP
  1.  I APCLQTR=2 S APCLBD=$E(APCLPER,1,3)_"0101",APCLED=$E(APCLPER,1,3)_"1231"
  1.  I APCLQTR=3 S APCLBD=($E(APCLPER,1,3)-1)_"0401",APCLED=$E(APCLPER,1,3)_"0331"
  1.  I APCLQTR=4 S APCLBD=($E(APCLPER,1,3)-1)_"0701",APCLED=$E(APCLPER,1,3)_"0630"
  1.  I APCLQTR=1 S APCLBD=($E(APCLPER,1,3)-1)_"1001",APCLED=$E(APCLPER,1,3)_"0930"
  1.  I APCLED>DT D  G:APCLDO=1 QUA
  1.  .W !!,"You have selected Current Report period ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
  1.  .W !,"The end date of this report is in the future; your data will not be",!,"complete.",!
  1.  .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
  1.  .I $D(DIRUT) S APCLDO=1 Q
  1.  .I Y S APCLDO=1 Q
  1.  Q
  1. YEAR ;calendar year
  1.  S (APCLPER,APCLVDT)=""
  1.  W !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2009"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter Year"
  1.  S DIR("?")="This report is compiled for a period.  Enter a valid date."
  1.  D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I $D(DUOUT) S DIRUT=1 Q
  1.  S APCLVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G YEAR
  1.  S APCLPER=APCLVDT
  1.  S APCLBD=$E(APCLVDT,1,3)_"0101"
  1.  S APCLBD=$E(APCLVDT,1,3)_"1231"
  1.  W !!,"You chose ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
  1.  S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G YEAR
  1.  I 'Y G YEAR
  1.  Q
  1. S ;get search template
  1.  S APCLQUIT=0
  1.  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
  1.  I Y=-1 S APCLQUIT=1 Q
  1.  S APCLPTS="S"
  1.  S APCLSTMP=+Y
  1.  S X=0,C=0 F  S X=$O(^DIBT(APCLSTMP,1,X)) Q:X'=+X  S C=C+1,APCLPTS(X)=""
  1.  W !!,"There are ",C," patients in that search template that will be reported on."
  1.  Q
  1. E ;EHR PERSONAL LIST
  1.  S APCLQUIT=0
  1.  S APCLPTS="E"
  1.  S APCLDATA=""
  1.  K ^TMP("BQITABLE",$J)
  1.  D TAB^BQIUTB(.APCLDATA,"PERS")
  1.  I $P($G(^TMP("BQITABLE",$J,1)),U,2)="" W !!,"You do not have any EHR Personal Lists defined." S APCLQUIT=1 Q
  1.  S APCLICP=""  ;will set to OWNER^IEN^NAME OF LIST
  1.  D EN^APCLACGI
  1.  I APCLICP="" W !!,"no list selected." S APCLQUIT=1 Q
  1.  W !!,"You have selected EHR Personal List: ",$P(APCLICP,U,3)
  1.  Q
  1. I ;ICARE GROUP
  1.  ; GET THIS USERS LISTS AND PRESENT THEM
  1.  S APCLPTS="I",APCLQUIT=0
  1.  K ^TMP("BQIPLRT",$J)
  1.  ;get list of this users panels in iCare
  1.  S APCLDATA=""
  1.  D LISTS^BQIPLRT(.APCLDATA)
  1.  I $P($G(^TMP("BQIPLRT",$J,1)),U,2)="" W !!,"You do not have any iCare panels defined." S APCLQUIT=1 Q
  1.  S APCLICP=""  ;will set to owner^ien
  1.  D EN^APCLACGI
  1.  I APCLICP="" W !!,"no panel selected." S APCLQUIT=1 Q
  1.  W !!,"You have selected iCare panel: ",$P(APCLICP,U,3)
  1.  Q
  1. A ;ANTICOAGULATION
  1.  S APCLPTS="A",APCLQUIT=0
  1.  K APCLACCL
  1.  W !!,"The following clinics have beeen identified as Anticoagulation clinics:"
  1.  W !?5,"D1 - Anticoagulation clinic"
  1.  S DIR(0)="Y",DIR("A")="Do you wish to add another clinic(s)",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT)!('Y) S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)="" Q
  1.  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
  1.  D PEP^AMQQGTX0(+Y,"APCLACCL(")
  1.  I '$D(APCLACCL) G A
  1.  I $D(APCLACCL("*")) W !!,"That is not a valid response, please select certain clinics" K APCLACCL G A
  1.  S X=$O(^DIC(40.7,"C","D1",0)) I X S APCLACCL(X)=""
  1.  Q
  1. W ;WARFARIN
  1.  S APCLPTS="W",APCLQUIT=0
  1.  Q
  1.  ;
  1. PROC ;
  1.  D PROC^APCLACG1
  1.  Q
  1. PRINT ;
  1.  I APCLRTYP="MOS" D ^APCLACGM
  1.  Q
  1. MOS ;
  1.  S APCLVDT=""
  1.  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
  1.  Q:$D(DIRUT)
  1.  Q:X=""
  1.  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
  1.  K %DT S X=Y,%DT="EP" D ^%DT
  1.  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
  1.  I Y>DT W !!,"No future dates allowed!",! G MOS
  1.  S APCLVDT=Y
  1.  S APCLBD=$E(APCLVDT,1,3)_$E(APCLVDT,4,5)_"01"
  1.  S M=$E(APCLVDT,4,5)
  1.  S D=""
  1.  I M="09"!(M="04")!(M="06")!(M="11") S D=30
  1.  I D="",M'="02" S D=31
  1.  I M="02" S X=$E(APCLVDT,1,3)_"0229",%DT="P" D ^%DT D
  1.  .I Y=-1 S D=28 Q
  1.  .S D=29
  1.  S APCLED=$E(APCLVDT,1,3)_M_D
  1.  W !!,"You chose ",$$FMTE^XLFDT(APCLBD)," through ",$$FMTE^XLFDT(APCLED),"."
  1.  S DIR(0)="Y",DIR("A")="Is this correct",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G MOS
  1.  I 'Y G MOS
  1.  Q
  1. Y ;
  1. F ;calendar year
  1.  S (APCLPER,APCLVDT)=""
  1.  W !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2009"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter Year"
  1.  S DIR("?")="This report is compiled for a period.  Enter a valid date."
  1.  D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I $D(DUOUT) S DIRUT=1 Q
  1.  S APCLVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
  1.  S APCLPER=APCLVDT
  1.  Q