APCLOS ; IHS/CMI/LAB - PCC Operational Summary ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;CMI/TUCSON/LAB - patch 3 fixed FY date calculations
;
START ;
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",! Q
W:$D(IOF) @IOF
W !,"********** PCC OPERATIONS SUMMARY REPORT **********",!
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."
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.",!!
S APCLJOB=$J,APCLBTH=$H
SELTYP K DIC S DIC=9001003.1,DIC("A")="Select operations summary type: ",DIC(0)="AEQM"
D ^DIC I Y<0 G EOJ
S APCLRPT=+Y
;does this contain ambulatory?
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
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_"//"
S DIC="^AUTTSU(",DIC(0)="AEMQZ" W ! D ^DIC K DIC
I X="^" G EOJ
I X="" S (APCLSU,APCLSUF)=B G SUF
G:Y=-1 SUF
S APCLSU=+Y,APCLSUF=$P(^AUTTSU(APCLSU,0),U)
SUF ;
S APCLLOC="" D XTMP^APCLOSUT("APCLSU","PCC OPERATIONS SUMMARY") K APCLQUIT,^XTMP("APCLSU",APCLJOB,APCLBTH)
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"
S DIR("A")="Enter a code indicating what FACILITIES/LOCATIONS are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
G:$D(DIRUT) EOJ
S APCLLOCT=Y
D @APCLLOCT
G:$D(APCLQUIT) SUF
I '$D(^XTMP("APCLSU",APCLJOB,APCLBTH)) W !!,$C(7),$C(7),"No facilities selected.",! G SUF
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.",!
MFY ;MONTH OR FYTODATE
W !!
S DIR(0)="SO^1:A Single Month;2:Fiscal Year;3:Date Range",DIR("A")="Run report for" D ^DIR K DIR W !!
G:$D(DIRUT) SUF
S APCLMFY=Y
G:Y=2 2
G:Y=3 3
1 ;
S %DT="AEP",%DT(0)="-NOW",%DT("A")="Enter the Month/Year: " D ^%DT I $D(DTOUT) G MFY
I X="^" G MFY
I Y=-1 D ERRM G 1
I $E(Y,6,7)'="00" D ERRM G 1
S APCLMON=Y
S APCLFYB=$E(Y,1,5)_"01",APCLFYE=$E(Y,1,5)_"31"
K %DT,Y,X
G EXCL
2 ;
S APCL("FYEND FLAG")=0
D ^APCLFY
;beginning Y2K
;G:Y=-1 MFY ;Y2000
G:APCL("FY")=-1 MFY ;Y2000
;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
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
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
;E W !!?6,"FISCAL Year date range: ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY PRINTABLE EDATE") ;Y2000
S APCLFYB=APCL("FY BEG DATE")
;S APCLFYBY=APCL("FY PRINTABLE BDATE") ;Y2000
S APCLFYBY=$$FMTE^XLFDT(APCL("FY BEG DATE")) ;Y2000
W !
;S:$G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) %DT("B")=APCL("FY TODAY") ;Y2000
;E S %DT("B")=APCL("FY PRINTABLE EDATE") ;Y2000
K %DT S %DT("B")=$S(APCL("FY END DATE")>DT:$$FMTE^XLFDT(DT),1:$$FMTE^XLFDT(APCL("FY END DATE"))) ;Y2000
;end Y2K
;S:$D(APCL("FY PRINTABLE EDATE")) %DT("B")=APCL("FY PRINTABLE EDATE")
S %DT(0)="-NOW",%DT("A")="Enter As-of-Date: ",%DT="AEPX" W ! D ^%DT
I Y=-1 G MFY
I Y<APCL("FY BEG DATE") W !!,"As-of Date cannot be prior to Fiscal Beginning Date!",! H 2 G MFY
S (X1,APCLFYE)=Y,X2=$S(+$E(Y,4,7)>930:0,1:-365) D C^%DTC
G EXCL
3 ;date range
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G MFY
S APCLFYB=Y
ED ;get ending date
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
I $D(DIRUT) G BD
S APCLFYE=Y
;
EXCL ;
I 'APCLAMBS G ZIS
K APCLEXCL,APCLDXT
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.",!
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."
;exclude any diagnoses codes?
S APCLEXCL=""
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
I $D(DIRUT) G MFY
S APCLEXCL=Y
EXCL1 ;which ones to exclude
K APCLDXT
I 'APCLEXCL G ZIS
W !,"Enter the diagnoses to be excluded.",!
DX1 ;
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
D PEP^AMQQGTX0(+Y,"APCLDXT(")
I '$D(APCLDXT) G EXCL
I $D(APCLDXT("*")) K APCLDXT
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G MFY
S Y=DT D DD^%DT S APCLDTP=Y
S Y=APCLFYE D DD^%DT S APCLFYEY=Y
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!",!
S XBRP="^APCLOSP",XBRC="^APCLOS1",XBRX="EOJ^APCLOS",XBNS="APCL"
D ^XBDBQUE
;
EOJ ;ENTRY POINT
D EOJ^APCLOSUT
Q
O ;
W ! S DIC("A")="Which Facility: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA I Y<0 S APCLQUIT=1 Q
S ^XTMP("APCLSU",APCLJOB,APCLBTH,+Y)=""
Q
S ;
W !!,"Gathering up all the facilities..."
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)=""
Q
T ;taxonomy - call qman interface
K APCLLOC
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
D PEP^AMQQGTX0(+Y,"APCLLOC(")
I '$D(APCLLOC) S APCLQUIT=1 Q
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
S X="" F S X=$O(APCLLOC(X)) Q:X="" S ^XTMP("APCLSU",APCLJOB,APCLBTH,X)=""
K APCLLOC
Q
ERRM W !,$C(7),$C(7),"Must be a valid Month/Year. Enter only a Month and a Year!",! Q
APCLOS ; IHS/CMI/LAB - PCC Operational Summary ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;CMI/TUCSON/LAB - patch 3 fixed FY date calculations
+3 ;
START ;
+1 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!
QUIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !,"********** PCC OPERATIONS SUMMARY REPORT **********",!
+4 WRITE !!,"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."
+5 WRITE !!,"When selecting the period for which the report is to be run, consider whether",!,"or not all data has been entered for that period.",!!
+6 SET APCLJOB=$JOB
SET APCLBTH=$HOROLOG
SELTYP KILL DIC
SET DIC=9001003.1
SET DIC("A")="Select operations summary type: "
SET DIC(0)="AEQM"
+1 DO ^DIC
IF Y<0
GOTO EOJ
+2 SET APCLRPT=+Y
+3 ;does this contain ambulatory?
+4 SET Y=$ORDER(^APCLOSC("B","AMBULATORY",0))
SET APCLAMBS=0
SET X=0
FOR
SET X=$ORDER(^APCLOST(APCLRPT,1,X))
IF X'=+X
QUIT
IF $PIECE(^APCLOST(APCLRPT,1,X,0),U,2)=Y
SET APCLAMBS=1
SU SET B=$PIECE(^AUTTLOC(DUZ(2),0),U,5)
IF B
SET S=$PIECE(^AUTTSU(B,0),U)
SET DIC("A")="Please Identify your Service Unit: "_S_"//"
+1 SET DIC="^AUTTSU("
SET DIC(0)="AEMQZ"
WRITE !
DO ^DIC
KILL DIC
+2 IF X="^"
GOTO EOJ
+3 IF X=""
SET (APCLSU,APCLSUF)=B
GOTO SUF
+4 IF Y=-1
GOTO SUF
+5 SET APCLSU=+Y
SET APCLSUF=$PIECE(^AUTTSU(APCLSU,0),U)
SUF ;
+1 SET APCLLOC=""
DO XTMP^APCLOSUT("APCLSU","PCC OPERATIONS SUMMARY")
KILL APCLQUIT,^XTMP("APCLSU",APCLJOB,APCLBTH)
+2 KILL DIR
SET DIR(0)="S^O:ONE Particular Facility/Location;S:All Facilities within the "_$PIECE(^AUTTSU(APCLSU,0),U)_" SERVICE UNIT;T:A TAXONOMY or selected set of Facilities"
+3 SET DIR("A")="Enter a code indicating what FACILITIES/LOCATIONS are of interest"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO EOJ
+5 SET APCLLOCT=Y
+6 DO @APCLLOCT
+7 IF $DATA(APCLQUIT)
GOTO SUF
+8 IF '$DATA(^XTMP("APCLSU",APCLJOB,APCLBTH))
WRITE !!,$CHAR(7),$CHAR(7),"No facilities selected.",!
GOTO SUF
+9 WRITE !!!,"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.",!
MFY ;MONTH OR FYTODATE
+1 WRITE !!
+2 SET DIR(0)="SO^1:A Single Month;2:Fiscal Year;3:Date Range"
SET DIR("A")="Run report for"
DO ^DIR
KILL DIR
WRITE !!
+3 IF $DATA(DIRUT)
GOTO SUF
+4 SET APCLMFY=Y
+5 IF Y=2
GOTO 2
+6 IF Y=3
GOTO 3
1 ;
+1 SET %DT="AEP"
SET %DT(0)="-NOW"
SET %DT("A")="Enter the Month/Year: "
DO ^%DT
IF $DATA(DTOUT)
GOTO MFY
+2 IF X="^"
GOTO MFY
+3 IF Y=-1
DO ERRM
GOTO 1
+4 IF $EXTRACT(Y,6,7)'="00"
DO ERRM
GOTO 1
+5 SET APCLMON=Y
+6 SET APCLFYB=$EXTRACT(Y,1,5)_"01"
SET APCLFYE=$EXTRACT(Y,1,5)_"31"
+7 KILL %DT,Y,X
+8 GOTO EXCL
2 ;
+1 SET APCL("FYEND FLAG")=0
+2 DO ^APCLFY
+3 ;beginning Y2K
+4 ;G:Y=-1 MFY ;Y2000
+5 ;Y2000
IF APCL("FY")=-1
GOTO MFY
+6 ;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
+7 ;Y2000
IF APCL("FY BEG DATE")>DT
WRITE $CHAR(7),$CHAR(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!",!
GOTO 2
+8 ;Y2000
WRITE !!?6,"FISCAL Year date range: ",$$FMTE^XLFDT(APCL("FY BEG DATE"))," - ",$SELECT(APCL("FY END DATE")>DT:$$FMTE^XLFDT(DT),1:$$FMTE^XLFDT(APCL("FY END DATE")))
+9 ;E W !!?6,"FISCAL Year date range: ",APCL("FY PRINTABLE BDATE")," - ",APCL("FY PRINTABLE EDATE") ;Y2000
+10 SET APCLFYB=APCL("FY BEG DATE")
+11 ;S APCLFYBY=APCL("FY PRINTABLE BDATE") ;Y2000
+12 ;Y2000
SET APCLFYBY=$$FMTE^XLFDT(APCL("FY BEG DATE"))
+13 WRITE !
+14 ;S:$G(APCL("FY"))=$E(DT,2,3)&(DT'>APCL("FY END DATE")) %DT("B")=APCL("FY TODAY") ;Y2000
+15 ;E S %DT("B")=APCL("FY PRINTABLE EDATE") ;Y2000
+16 ;Y2000
KILL %DT
SET %DT("B")=$SELECT(APCL("FY END DATE")>DT:$$FMTE^XLFDT(DT),1:$$FMTE^XLFDT(APCL("FY END DATE")))
+17 ;end Y2K
+18 ;S:$D(APCL("FY PRINTABLE EDATE")) %DT("B")=APCL("FY PRINTABLE EDATE")
+19 SET %DT(0)="-NOW"
SET %DT("A")="Enter As-of-Date: "
SET %DT="AEPX"
WRITE !
DO ^%DT
+20 IF Y=-1
GOTO MFY
+21 IF Y<APCL("FY BEG DATE")
WRITE !!,"As-of Date cannot be prior to Fiscal Beginning Date!",!
HANG 2
GOTO MFY
+22 SET (X1,APCLFYE)=Y
SET X2=$SELECT(+$EXTRACT(Y,4,7)>930:0,1:-365)
DO C^%DTC
+23 GOTO EXCL
3 ;date range
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO MFY
+3 SET APCLFYB=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_APCLFYB_":DT:EP"
SET DIR("A")="Enter ending Visit Date: "
SET Y=APCLFYB
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET APCLFYE=Y
+4 ;
EXCL ;
+1 IF 'APCLAMBS
GOTO ZIS
+2 KILL APCLEXCL,APCLDXT
+3 WRITE !!,"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.",!
+4 WRITE !,"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."
+5 ;exclude any diagnoses codes?
+6 SET APCLEXCL=""
+7 SET DIR(0)="Y"
SET DIR("A")="Do you wish to exclude any diagnoses codes from the ambulatory section"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO MFY
+9 SET APCLEXCL=Y
EXCL1 ;which ones to exclude
+1 KILL APCLDXT
+2 IF 'APCLEXCL
GOTO ZIS
+3 WRITE !,"Enter the diagnoses to be excluded.",!
DX1 ;
+1 SET X="DIAGNOSIS"
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"
GOTO EOJ
+2 DO PEP^AMQQGTX0(+Y,"APCLDXT(")
+3 IF '$DATA(APCLDXT)
GOTO EXCL
+4 IF $DATA(APCLDXT("*"))
KILL APCLDXT
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO MFY
+3 SET Y=DT
DO DD^%DT
SET APCLDTP=Y
+4 SET Y=APCLFYE
DO DD^%DT
SET APCLFYEY=Y
+5 WRITE !!!,"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!",!
+6 SET XBRP="^APCLOSP"
SET XBRC="^APCLOS1"
SET XBRX="EOJ^APCLOS"
SET XBNS="APCL"
+7 DO ^XBDBQUE
+8 ;
EOJ ;ENTRY POINT
+1 DO EOJ^APCLOSUT
+2 QUIT
O ;
+1 WRITE !
SET DIC("A")="Which Facility: "
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
SET APCLQUIT=1
QUIT
+2 SET ^XTMP("APCLSU",APCLJOB,APCLBTH,+Y)=""
+3 QUIT
S ;
+1 WRITE !!,"Gathering up all the facilities..."
+2 SET X=0
FOR
SET X=$ORDER(^AUTTLOC(X))
IF X'=+X
QUIT
IF $PIECE(^AUTTLOC(X,0),U,5)=APCLSU
SET ^XTMP("APCLSU",APCLJOB,APCLBTH,X)=""
+3 QUIT
T ;taxonomy - call qman interface
+1 KILL APCLLOC
+2 SET X="ENCOUNTER LOCATION"
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"
SET APCLQUIT=1
QUIT
+3 DO PEP^AMQQGTX0(+Y,"APCLLOC(")
+4 IF '$DATA(APCLLOC)
SET APCLQUIT=1
QUIT
+5 IF $DATA(APCLLOC("*"))
KILL APCLLOC,^XTMP("APCLSU",APCLJOB,APCLBTH)
WRITE !!,$CHAR(7),$CHAR(7),"ALL locations is NOT an option with this report",!
GOTO T
+6 SET X=""
FOR
SET X=$ORDER(APCLLOC(X))
IF X=""
QUIT
SET ^XTMP("APCLSU",APCLJOB,APCLBTH,X)=""
+7 KILL APCLLOC
+8 QUIT
ERRM WRITE !,$CHAR(7),$CHAR(7),"Must be a valid Month/Year. Enter only a Month and a Year!",!
QUIT
