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

APCLOS.m

Go to the documentation of this file. 
  1. APCLOS ; IHS/CMI/LAB - PCC Operational Summary ;
  1.  ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
  1.  ;CMI/TUCSON/LAB - patch 3 fixed FY date calculations
  1.  ;
  1. START ;
  1.  I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",! Q
  1.  W:$D(IOF) @IOF
  1.  W !,"**********          PCC OPERATIONS SUMMARY REPORT          **********",!
  1.  W !!,"This report displays data for a single month or for FY-to-Date for a specific",!,"facility or for the entire SU if all data for the SU is processed on this",!,"computer."
  1.  W !!,"When selecting the period for which the report is to be run, consider whether",!,"or not all data has been entered for that period.",!!
  1.  S APCLJOB=$J,APCLBTH=$H
  1. SELTYP K DIC S DIC=9001003.1,DIC("A")="Select operations summary type: ",DIC(0)="AEQM"
  1.  D ^DIC I Y<0 G EOJ
  1.  S APCLRPT=+Y
  1.  ;does this contain ambulatory?
  1.  S Y=$O(^APCLOSC("B","AMBULATORY",0)),APCLAMBS=0,X=0 F  S X=$O(^APCLOST(APCLRPT,1,X)) Q:X'=+X  I $P(^APCLOST(APCLRPT,1,X,0),U,2)=Y S APCLAMBS=1
  1. SU S B=$P(^AUTTLOC(DUZ(2),0),U,5) I B S S=$P(^AUTTSU(B,0),U),DIC("A")="Please Identify your Service Unit: "_S_"//"
  1.  S DIC="^AUTTSU(",DIC(0)="AEMQZ" W ! D ^DIC K DIC
  1.  I X="^" G EOJ
  1.  I X="" S (APCLSU,APCLSUF)=B G SUF
  1.  G:Y=-1 SUF
  1.  S APCLSU=+Y,APCLSUF=$P(^AUTTSU(APCLSU,0),U)
  1. SUF ;
  1.  S APCLLOC="" D XTMP^APCLOSUT("APCLSU","PCC OPERATIONS SUMMARY") K APCLQUIT,^XTMP("APCLSU",APCLJOB,APCLBTH)
  1.  K DIR S DIR(0)="S^O:ONE Particular Facility/Location;S:All Facilities within the "_$P(^AUTTSU(APCLSU,0),U)_" SERVICE UNIT;T:A TAXONOMY or selected set of Facilities"
  1.  S DIR("A")="Enter a code indicating what FACILITIES/LOCATIONS are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
  1.  G:$D(DIRUT) EOJ
  1.  S APCLLOCT=Y
  1.  D @APCLLOCT
  1.  G:$D(APCLQUIT) SUF
  1.  I '$D(^XTMP("APCLSU",APCLJOB,APCLBTH)) W !!,$C(7),$C(7),"No facilities selected.",! G SUF
  1.  W !!!,"Only patients who have charts at the facilities you selected will be included",!,"in this report.  Also, only visits to these locations will be counted in the ",!,"visit sections.",!
  1. MFY ;MONTH OR FYTODATE
  1.  W !!
  1.  S DIR(0)="SO^1:A Single Month;2:Fiscal Year;3:Date Range",DIR("A")="Run report for" D ^DIR K DIR W !!
  1.  G:$D(DIRUT) SUF
  1.  S APCLMFY=Y
  1.  G:Y=2 2
  1.  G:Y=3 3
  1. 1 ;
  1.  S %DT="AEP",%DT(0)="-NOW",%DT("A")="Enter the Month/Year: " D ^%DT I $D(DTOUT) G MFY
  1.  I X="^" G MFY
  1.  I Y=-1 D ERRM G 1
  1.  I $E(Y,6,7)'="00" D ERRM G 1
  1.  S APCLMON=Y
  1.  S APCLFYB=$E(Y,1,5)_"01",APCLFYE=$E(Y,1,5)_"31"
  1.  K %DT,Y,X
  1.  G EXCL
  1. 2 ;
  1.  S APCL("FYEND FLAG")=0
  1.  D ^APCLFY
  1.  ;beginning Y2K
  1.  ;G:Y=-1 MFY ;Y2000
  1.  G:APCL("FY")=-1 MFY ;Y2000
  1.  ;I $G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) W !!?6,"Current FISCAL Year date range:  ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY TODAY") ;Y2000
  1.  I APCL("FY BEG DATE")>DT W $C(7),$C(7),!!?6,"You have selected a FY with a beginning date that is in the future!!",!,?6,$$FMTE^XLFDT(APCL("FY BEG DATE")),"  Select again!",! G 2 ;Y2000
  1.  W !!?6,"FISCAL Year date range: ",$$FMTE^XLFDT(APCL("FY BEG DATE"))," - ",$S(APCL("FY END DATE")>DT:$$FMTE^XLFDT(DT),1:$$FMTE^XLFDT(APCL("FY END DATE"))) ;Y2000
  1.  ;E  W !!?6,"FISCAL Year date range:  ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY PRINTABLE EDATE") ;Y2000
  1.  S APCLFYB=APCL("FY BEG DATE")
  1.  ;S APCLFYBY=APCL("FY PRINTABLE BDATE") ;Y2000
  1.  S APCLFYBY=$$FMTE^XLFDT(APCL("FY BEG DATE")) ;Y2000
  1.  W !
  1.  ;S:$G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) %DT("B")=APCL("FY TODAY") ;Y2000
  1.  ;E  S %DT("B")=APCL("FY PRINTABLE EDATE") ;Y2000
  1.  K %DT S %DT("B")=$S(APCL("FY END DATE")>DT:$$FMTE^XLFDT(DT),1:$$FMTE^XLFDT(APCL("FY END DATE"))) ;Y2000
  1.  ;end Y2K
  1.  ;S:$D(APCL("FY PRINTABLE EDATE")) %DT("B")=APCL("FY PRINTABLE EDATE")
  1.  S %DT(0)="-NOW",%DT("A")="Enter As-of-Date: ",%DT="AEPX" W ! D ^%DT
  1.  I Y=-1 G MFY
  1.  I Y<APCL("FY BEG DATE") W !!,"As-of Date cannot be prior to Fiscal Beginning Date!",! H 2 G MFY
  1.  S (X1,APCLFYE)=Y,X2=$S(+$E(Y,4,7)>930:0,1:-365) D C^%DTC
  1.  G EXCL
  1. 3 ;date range
  1. BD ;get beginning date
  1.  W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G MFY
  1.  S APCLFYB=Y
  1. ED ;get ending date
  1.  W ! S DIR(0)="DA^"_APCLFYB_":DT:EP",DIR("A")="Enter ending Visit Date:  " S Y=APCLFYB D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G BD
  1.  S APCLFYE=Y
  1.  ;
  1. EXCL ;
  1.  I 'APCLAMBS G ZIS
  1.  K APCLEXCL,APCLDXT
  1.  W !!,"Because you have chosen an operations summary type that contains the ambulatory",!,"section, you have the option of excluding certain ICD diagnoses from the",!,"list of top ten diagnoses for ambulatory visits.",!
  1.  W !,"For example, to eliminate Pharmacy refill diagnoses, you need to exclude",!,"ICD-9 code V68.1 and ICD-10 code Z76.0 from this report."
  1.  ;exclude any diagnoses codes?
  1.  S APCLEXCL=""
  1.  S DIR(0)="Y",DIR("A")="Do you wish to exclude any diagnoses codes from the ambulatory section",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G MFY
  1.  S APCLEXCL=Y
  1. EXCL1 ;which ones to exclude
  1.  K APCLDXT
  1.  I 'APCLEXCL G ZIS
  1.  W !,"Enter the diagnoses to be excluded.",!
  1. DX1 ;
  1.  S X="DIAGNOSIS",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" G EOJ
  1.  D PEP^AMQQGTX0(+Y,"APCLDXT(")
  1.  I '$D(APCLDXT) G EXCL
  1.  I $D(APCLDXT("*")) K APCLDXT
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G MFY
  1.  S Y=DT D DD^%DT S APCLDTP=Y
  1.  S Y=APCLFYE D DD^%DT S APCLFYEY=Y
  1.  W !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT FILE!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!
  1.  S XBRP="^APCLOSP",XBRC="^APCLOS1",XBRX="EOJ^APCLOS",XBNS="APCL"
  1.  D ^XBDBQUE
  1.  ;
  1. EOJ ;ENTRY POINT
  1.  D EOJ^APCLOSUT
  1.  Q
  1. O ;
  1.  W ! S DIC("A")="Which Facility: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA I Y<0 S APCLQUIT=1 Q
  1.  S ^XTMP("APCLSU",APCLJOB,APCLBTH,+Y)=""
  1.  Q
  1. S ;
  1.  W !!,"Gathering up all the facilities..."
  1.  S X=0 F  S X=$O(^AUTTLOC(X)) Q:X'=+X  I $P(^AUTTLOC(X,0),U,5)=APCLSU S ^XTMP("APCLSU",APCLJOB,APCLBTH,X)=""
  1.  Q
  1. T ;taxonomy - call qman interface
  1.  K APCLLOC
  1.  S X="ENCOUNTER LOCATION",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" S APCLQUIT=1 Q
  1.  D PEP^AMQQGTX0(+Y,"APCLLOC(")
  1.  I '$D(APCLLOC) S APCLQUIT=1 Q
  1.  I $D(APCLLOC("*")) K APCLLOC,^XTMP("APCLSU",APCLJOB,APCLBTH) W !!,$C(7),$C(7),"ALL locations is NOT an option with this report",! G T
  1.  S X="" F  S X=$O(APCLLOC(X)) Q:X=""  S ^XTMP("APCLSU",APCLJOB,APCLBTH,X)=""
  1.  K APCLLOC
  1.  Q
  1. ERRM W !,$C(7),$C(7),"Must be a valid Month/Year.  Enter only a Month and a Year!",! Q