APCDCAFK ; IHS/CMI/LAB - ; 19 Dec 2014 2:06 PM
;;2.0;IHS PCC SUITE;**2,5,11,16**;MAY 14, 2009;Build 9
;
START ;
D XIT
I '$D(IOF) D HOME^%ZIS
D TERM^VALM0
W @(IOF),!!
D INFORM
I $P(^APCCCTRL(DUZ(2),0),U,12)="" W !!,"The EHR/PCC Coding Audit Start Date has not been set",!,"in the PCC Master Control file." D D XIT Q
.W !!,"Please see your Clinical Coordinator or PCC Manager."
.S DIR(0)="E",DIR("A")="Press Enter" KILL DA D ^DIR KILL DIR
.Q
;
VD ;
S (APCDBD,APCDED)=""
S DIR(0)="S^A:All Visits;S:Visits in a Date Range",DIR("A")="What Visit date range should be included",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G XIT
I Y="A" G FAC
DATES ;K APCDED,APCDBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR G:Y<1 VD S APCDBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
D ^DIR G:Y<1 VD S APCDED=Y
;
I APCDED<APCDBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
;
FAC ;
K APCDQ
W !!,$G(IORVON)_"Please enter which FACILITY visits will be included in the list."_$G(IORVOFF),!
S APCDLOCT=""
K APCDLOCS
S DIR(0)="S^A:ALL Locations/Facilities;S:Selected set or Taxonomy of Locations;O:ONE Location/Facility",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"
S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
G:$D(DIRUT) XIT
S APCDLOCT=Y
I APCDLOCT="A" G HOSPLOC
D @(APCDLOCT_"LOC")
G:$D(APCDQ) FAC
HOSPLOC ;
K APCDQ
W !!,$G(IORVON)_"Please enter which HOSPITAL LOCATIONS will be included in the list."_$G(IORVOFF),!
S APCDHLT=""
K APCDHLS
S DIR(0)="S^A:ALL Hospital Locations;S:Selected set of Hospital Locations;O:ONE Hospital Location",DIR("A")="Include Visits to Which Hospital Locations",DIR("B")="A"
S DIR("A")="Enter a code indicating what HOSPITAL LOCATIONS are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
G:$D(DIRUT) FAC
S APCDHLT=Y
I APCDHLT="A" G CLINIC
D @(APCDHLT_"HL")
G:$D(APCDQ) HOSPLOC
CLINIC ;
K APCDQ
W !!,$G(IORVON)_"Please enter which CLINIC (IHS clinic codes) visits will be included",!,"in the list."_$G(IORVOFF),!
S APCDCLNT=""
K APCDCLNS
K DIR S DIR(0)="S^A:ALL Clinics;S:Selected set or Taxonomy of Clinics;O:ONE Clinic",DIR("A")="Include Visits to Which Clinics",DIR("B")="A"
S DIR("A")="Enter a code indicating what CLINICS (IHS clinic code) are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
G:$D(DIRUT) HOSPLOC
S APCDCLNT=Y
I APCDCLNT="A" G SC
D @(APCDCLNT_"CLN")
G:$D(APCDQ) CLINIC
SC ;
K APCDQ
W !!,$G(IORVON)_"Please enter which SERVICE CATEGORIES will be included",!,"in the list."_$G(IORVOFF),!
S APCDSCT=""
K APCDSCS
K DIR S DIR(0)="S^A:ALL Service Categories;S:Selected set or Taxonomy of Service Categories;O:One Service Category",DIR("A")="Include Visits to Which Service Categories",DIR("B")="A"
S DIR("A")="Enter a code indicating what SERVICE CATEGORIES are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
G:$D(DIRUT) CLINIC
S APCDSCT=Y
I APCDSCT="A" G PROV
D @(APCDSCT_"SC")
G:$D(APCDQ) SC
PROV ;
K APCDQ
S APCDPRVT=""
K APCDPRVS
S DIR(0)="S^A:ALL Providers;S:Selected set or Taxonomy of Providers;O:ONE Provider",DIR("A")="Include Which Providers",DIR("B")="A"
S DIR("A")="Enter a code indicating which providers are of interest",DIR("B")="A" K DA D ^DIR K DIR,DA
G:$D(DIRUT) SC
S APCDPRVT=Y
I APCDPRVT="A" G PROCESS
D @(APCDPRVT_"PRV")
G:$D(APCDQ) PROV
PROCESS ;
W:$D(IOF) @IOF W !!
W !!,"I will display provider deficiencies that meet the following criteria:"
W !!,"LOCATION OF ENCOUNTER: " D
.I '$D(APCDLOCS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDLOCS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^DIC(4,Y,0),U),1,15)
W !!,"HOSPITAL LOCATIONS: " D
.I '$D(APCDHLS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDHLS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^SC(Y,0),U),1,15)
W !!,"CLINICS: " D
.I '$D(APCDCLNS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDCLNS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^DIC(40.7,Y,0),U),1,15)
W !!,"SERVICE CATEGORIES: " D
.I '$D(APCDSCS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDSCS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$$EXTSET^XBFUNC(9000010,.07,Y)
W !!,"PROVIDERS: " D
.I '$D(APCDPRVS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDPRVS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^VA(200,Y,0),U),1,15)
RTYPE ;how to sort list of visits
S APCDRTYP=""
S DIR(0)="S^1:Individual Provider Listings Only;2:Summary Page Only;3:Both",DIR("A")="Select Report Type",DIR("B")="3" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PROV
S APCDRTYP=Y
I APCDRTYP=2 G ZIS
PAGE ;
S APCDSPAG=0
S DIR(0)="Y",DIR("A")="Do you want each provider's listing on a separate page",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G RTYPE
S APCDSPAG=Y
ZIS ;call xbdbque
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) G RTYPE
I $G(Y)="B" D BROWSE,XIT Q
S XBRC="DRIVER^APCDCAFK",XBRP="PRINT^APCDCAFK",XBRX="XIT^APCDCAFK",XBNS="APCD"
D ^XBDBQUE
D XIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCDCAFK"")"
S XBNS="APCD",XBRC="DRIVER^APCDCAFK",XBRX="XIT^APCDCAFK",XBIOP=0 D ^XBDBQUE
Q
;
DRIVER ;EP entry point for taskman
S APCDBT=$H,APCDJOB=$J
K ^XTMP("APCDCAFK",APCDJOB,APCDBT)
S APCDPROV=0
F S APCDPROV=$O(^AUPNCANT("APEND",APCDPROV)) Q:APCDPROV'=+APCDPROV D
.I $D(APCDPRVS),'$D(APCDPRVS(APCDPROV)) Q ;not a PROV we want
.S APCDV=0 F S APCDV=$O(^AUPNCANT("APEND",APCDPROV,APCDV)) Q:APCDV'=+APCDV D
..S APCDV0=^AUPNVSIT(APCDV,0)
..Q:'$P(APCDV0,U,9) ;NO DEP ENTRIES
..Q:$P(APCDV0,U,11) ;DELETED
..I APCDBD,$$VD^APCLV(APCDV)<APCDBD Q
..I APCDED,$$VD^APCLV(APCDV)>APCDED Q
..S APCDVLOC=$P(APCDV0,U,6)
..Q:APCDVLOC=""
..I $D(APCDLOCS),'$D(APCDLOCS(APCDVLOC)) Q ;not a location we want
..S X=$P(APCDV0,U,7)
..Q:X="" ;no sc
..I $D(APCDSCS),'$D(APCDSCS(X)) Q ;not a sc we want
..S APCDVCLN=$P(APCDV0,U,8)
..I APCDVCLN="",$D(APCDCLNS) Q ;clinic blank and want certain clinics
..I $D(APCDCLNS),'$D(APCDCLNS(APCDVCLN)) Q ;not a CLINIC we want
..S APCDVHL=$P(APCDV0,U,22)
..I APCDVHL="",$D(APCDHLS) Q ;HOSP LOC blank and want certain HOSP LOCS
..I $D(APCDHLS),'$D(APCDHLS(APCDVHL)) Q ;not a HOSP LOC we want
..S $P(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV),U,1)=$P($G(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV)),U,1)+1
..S D=$$FMDIFF^XLFDT(DT,$$VD^APCLV(APCDV))
..S E=$P($G(^APCDSITE(DUZ(2),0)),U,38) S:E="" E=3 I D>E S $P(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV),U,2)=$P($G(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV)),U,2)+1
..;NOW STORE EACH DEFICIENCY
..S APCDI=0 F S APCDI=$O(^AUPNCANT("APEND",APCDPROV,APCDV,APCDI)) Q:APCDI'=+APCDI D
...S ^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDPROV,$$VD^APCLV(APCDV),APCDV,APCDI)=""
...;SUMMARY INFO
...S X=$P(^AUPNCANT(APCDV,12,APCDI,0),U,2)
...S ^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDPROV,X)=$G(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDPROV,X))+1
S APCDET=$H
Q
XIT ;
K DIR
D EN^XBVK("APCD")
D ^XBFMK
D KILL^AUPNPAT
D EN^XBVK("AMQQ")
Q
;
D(D) ;
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
CTR(X,Y) ;EP
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
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
INFORM ;
W !,$$CTR($$LOC)
W !!,$$CTR("PCC/EHR CODING AUDIT")
W !!,"This report will list all PENDING deficiencies for a selected"
W !,"set of providers."
Q
OLOC ;one location
D OLOC^APCDCAFD
Q
SLOC ;
D SLOC^APCDCAFD
Q
;
OCLN ;one clinic
D OCLN^APCDCAFD
Q
SCLN ;taxonomy of clinics
D SCLN^APCDCAFD
Q
;
OHL ;
S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Which HOSPITAL LOCATION: " D ^DIC K DIC
I Y=-1 S APCDQ="" Q
S APCDHLS(+Y)=""
Q
SHL ;
S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Which HOSPITAL LOCATION: " D ^DIC K DIC
I X="" Q
I Y=-1 S APCDQ="" Q
S APCDHLS(+Y)=""
G SHL
Q
OPRV ;one clinic
S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Which PROVIDER: " D ^DIC K DIC
I Y=-1 S APCDQ="" Q
S APCDPRVS(+Y)=""
Q
SPRV ;
S X="PRIMARY PROVIDER",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 XIT
D PEP^AMQQGTX0(+Y,"APCDPRVS(")
I '$D(APCDPRVS) S APCDQ="" Q
I $D(APCDPRVS("*")) S APCDPRVT="A" K APCDPRVS W !!,"**** all PROVIDERS will be included ****",! Q
Q
;
SSC ;
S X="SERVICE CATEGORY",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 FAC
D PEP^AMQQGTX0(+Y,"APCDSCS(")
I '$D(APCDSCS) S APCDQ="" Q
I $D(APCDSCS("*")) S APCDSCT="A" K APCDSCS W !!,"**** all Services Categories will be included ****",! Q
Q
OSC ;
K DIR S DIR(0)="9000010,.07",DIR("A")="Enter SERVICE CATEGORY" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S APCDQ="" Q
S APCDSCS(Y)=""
Q
;----------
PRINT ;EP - called from xbdbque
S APCD80S="-------------------------------------------------------------------------------"
S APCDPG=0
K APCDQUIT
D COVPAGE
D PRINT1
DONE ;
I $D(APCDQUIT) G XIT1
I $E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
W:$D(IOF) @IOF
XIT1 ; Clean up and exit
K ^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV")
D EN^XBVK("APCD")
Q
SH ;
W !!?10,"Incomplete Charts for ",$$GET1^DIQ(200,APCDS,.01)
Q
PRINT1 ;
K APCDQUIT
I APCDRTYP=2 G SUMPAGE
I 'APCDSPAG D HEAD
I '$D(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV")) W !!,"There are no pending deficiencies that meet the report criteria." Q
S APCDS="" F S APCDS=$O(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS)) Q:APCDS'=+APCDS!($D(APCDQUIT)) D
.I APCDSPAG D HEAD Q:$D(APCDQUIT)
.D SH
.S APCDDATE=0 F S APCDDATE=$O(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS,APCDDATE)) Q:APCDDATE'=+APCDDATE!($D(APCDQUIT)) D
..S APCDV="" F S APCDV=$O(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS,APCDDATE,APCDV)) Q:APCDV=""!($D(APCDQUIT)) D
...I $Y>(IOSL-5) D HEAD Q:$D(APCDQUIT) D SH
...W !,$E($$VAL^XBDIQ1(9000010,APCDV,.05),1,21)
...S APCDVR=^AUPNVSIT(APCDV,0) S:'$P(APCDVR,U,6) $P(APCDVR,U,6)=0
...S DFN=$P(APCDVR,U,5)
...S APCDHRN="" S APCDHRN=$$HRN^AUPNPAT(DFN,$P(APCDVR,U,6),2)
...S APCDHRN="" S APCDHRN=$$HRN^AUPNPAT(DFN,DUZ(2))
...W ?22,APCDHRN
...W ?29,$$DATE(APCDDATE),?40,$P(APCDVR,U,7)
...S APCDC=0 S APCDI=0 F S APCDI=$O(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS,APCDDATE,APCDV,APCDI)) Q:APCDI'=+APCDI!($D(APCDQUIT)) D
....S APCDC=APCDC+1
....I $Y>(IOSL-3) D HEAD Q:$D(APCDQUIT) D SH
....I APCDC>1 W !
....S APCDIENS=APCDI_","_APCDV W ?43,$$GET1^DIQ(9000095.12,APCDIENS,.02)
....W ?76,$$FMDIFF^XLFDT(DT,$$VD^APCLV(APCDV))
....I $$GET1^DIQ(9000095.12,APCDIENS,.1)]"" W !?2,"Comment: ",$$GET1^DIQ(9000095.12,APCDIENS,.1)
...I $O(^AUPNCANT(APCDV,11,0)) D
....I $Y>(IOSL-3) D HEAD Q:$D(APCDQUIT) D SH
....W !?2,"Chart Audit Notes:"
....K ^UTILITY($J,"W")
....S DIWR=70,DIWL=0 S Y=0 S Y=$O(^AUPNCANT(APCDV,11,Y)) Q:Y'=+Y S X=^AUPNCANT(APCDV,11,Y,0) D ^DIWP
....S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
.....I $Y>(IOSL-2) D HEAD Q:$D(APCDQUIT) D SH
.....W !?2,^UTILITY($J,"W",DIWL,Z,0)
...K DIWL,DIWR,DIWF,Z
...K ^UTILITY($J,"W")
I APCDRTYP=1 Q
I $D(APCDQUIT) Q
D SUMPAGE
Q
DATE(D) ;EP
I D="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))
HEAD ;EP;HEADER
I 'APCDPG G HEAD1
HEAD2 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W !,$$FMTE^XLFDT($$NOW^XLFDT),?40,$P(^VA(200,DUZ,0),U,2),?70,"Page: ",APCDPG
W !,$$CTR("Confidential Patient Data Covered by Privacy Act",80)
W !,$$CTR("Incomplete Charts by Provider and Deficiency",80)
I $G(APCDSUM) W !,$$CTR("SUMMARY PAGE",80)
W !,$TR($J(" ",80)," ","-")
I '$G(APCDSUM) W !!,"Patient",?22,"HRCN",?29,"Visit Date",?40,"SC",?43,"Deficiencies",?76,"Days"
I $G(APCDSUM) W !!,"PROVIDER",?26,"INCOMP",?33,"DELINQ",?40,"DEFICIENCIES"
I $G(APCDSUM) W !?26,"CHARTS",?33,"CHARTS"
W !,APCD80S
Q
COVPAGE ;
W !,$$FMTE^XLFDT($$NOW^XLFDT()),?40,$P(^VA(200,DUZ,0),U,2)," Confidential Patient Data Covered by Privacy Act" ;,?70,"Page: ",APCDPG
W !,$$CTR("***********************************",80)
W !,$$CTR("* PROVIDER CHART DEFICIENCIES *",80)
W !,$$CTR("***********************************",80)
W !!,"PROVIDERS: " D
.I '$D(APCDPRV) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDPRVS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^VA(200,Y,0),U),1,15)
W !!,$$CTR("VISIT DEFICIENCY CRITERIA",80)
W !!,"LOCATION OF ENCOUNTER: " D
.I '$D(APCDLOCS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDLOCS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^DIC(4,Y,0),U),1,15)
W !!,"HOSPITAL LOCATIONS: " D
.I '$D(APCDHLS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDHLS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^SC(Y,0),U),1,15)
W !!,"CLINICS: " D
.I '$D(APCDCLNS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDCLNS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$E($P(^DIC(40.7,Y,0),U),1,15)
W !!,"SERVICE CATEGORIES: " D
.I '$D(APCDSCS) W "All" Q
.S Y=0,C=0 F S Y=$O(APCDSCS(Y)) Q:Y'=+Y S C=C+1 W:C>1 ";" W ?24,$$EXTSET^XBFUNC(9000010,.07,Y)
Q
SUMPAGE ;
S APCDSUM=1
D HEAD
I '$D(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV")) W !!,"There are no pending deficiencies that meet the report criteria." Q
S APCDS=0 F S APCDS=$O(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDS)) Q:APCDS'=+APCDS D
.I $Y>(IOSL-4) D HEAD Q:$D(APCDQUIT)
.S S=^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDS)
.W !,$E($P(^VA(200,APCDS,0),U),1,25),?27,+$P(S,U,1),?33,+$P(S,U,2)
.;deficiencies
.S APCDDEF=""
.S APCDI=0 F S APCDI=$O(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDS,APCDI)) Q:APCDI'=+APCDI D
..S:APCDDEF]"" APCDDEF=APCDDEF_", "
..S APCDDEF=APCDDEF_$P(^AUTTCDR(APCDI,0),U,1)_" ("_^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDS,APCDI)_")"
.K ^UTILITY($J,"W") S X=APCDDEF,DIWL=0,DIWR=40 D ^DIWP
.W ?40,$G(^UTILITY($J,"W",0,1,0))
.I $O(^UTILITY($J,"W",0,1)) D
..S X=1 S X=$O(^UTILITY($J,"W",0,X)) Q:X'=+X W !?40,^UTILITY($J,"W",0,X,0)
.W !
.K ^UTILITY($J,"W")
Q
APCDCAFK ; IHS/CMI/LAB - ; 19 Dec 2014 2:06 PM
+1 ;;2.0;IHS PCC SUITE;**2,5,11,16**;MAY 14, 2009;Build 9
+2 ;
START ;
+1 DO XIT
+2 IF '$DATA(IOF)
DO HOME^%ZIS
+3 DO TERM^VALM0
+4 WRITE @(IOF),!!
+5 DO INFORM
+6 IF $PIECE(^APCCCTRL(DUZ(2),0),U,12)=""
WRITE !!,"The EHR/PCC Coding Audit Start Date has not been set",!,"in the PCC Master Control file."
Begin DoDot:1
+7 WRITE !!,"Please see your Clinical Coordinator or PCC Manager."
+8 SET DIR(0)="E"
SET DIR("A")="Press Enter"
KILL DA
DO ^DIR
KILL DIR
+9 QUIT
End DoDot:1
DO XIT
QUIT
+10 ;
VD ;
+1 SET (APCDBD,APCDED)=""
+2 SET DIR(0)="S^A:All Visits;S:Visits in a Date Range"
SET DIR("A")="What Visit date range should be included"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO XIT
+4 IF Y="A"
GOTO FAC
DATES ;K APCDED,APCDBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit Date"
+2 DO ^DIR
IF Y<1
GOTO VD
SET APCDBD=Y
+3 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Visit Date"
+4 DO ^DIR
IF Y<1
GOTO VD
SET APCDED=Y
+5 ;
+6 IF APCDED<APCDBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+8 ;
FAC ;
+1 KILL APCDQ
+2 WRITE !!,$GET(IORVON)_"Please enter which FACILITY visits will be included in the list."_$GET(IORVOFF),!
+3 SET APCDLOCT=""
+4 KILL APCDLOCS
+5 SET DIR(0)="S^A:ALL Locations/Facilities;S:Selected set or Taxonomy of Locations;O:ONE Location/Facility"
SET DIR("A")="Include Visits to Which Location/Facilities"
SET DIR("B")="A"
+6 SET DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR,DA
+7 IF $DATA(DIRUT)
GOTO XIT
+8 SET APCDLOCT=Y
+9 IF APCDLOCT="A"
GOTO HOSPLOC
+10 DO @(APCDLOCT_"LOC")
+11 IF $DATA(APCDQ)
GOTO FAC
HOSPLOC ;
+1 KILL APCDQ
+2 WRITE !!,$GET(IORVON)_"Please enter which HOSPITAL LOCATIONS will be included in the list."_$GET(IORVOFF),!
+3 SET APCDHLT=""
+4 KILL APCDHLS
+5 SET DIR(0)="S^A:ALL Hospital Locations;S:Selected set of Hospital Locations;O:ONE Hospital Location"
SET DIR("A")="Include Visits to Which Hospital Locations"
SET DIR("B")="A"
+6 SET DIR("A")="Enter a code indicating what HOSPITAL LOCATIONS are of interest"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR,DA
+7 IF $DATA(DIRUT)
GOTO FAC
+8 SET APCDHLT=Y
+9 IF APCDHLT="A"
GOTO CLINIC
+10 DO @(APCDHLT_"HL")
+11 IF $DATA(APCDQ)
GOTO HOSPLOC
CLINIC ;
+1 KILL APCDQ
+2 WRITE !!,$GET(IORVON)_"Please enter which CLINIC (IHS clinic codes) visits will be included",!,"in the list."_$GET(IORVOFF),!
+3 SET APCDCLNT=""
+4 KILL APCDCLNS
+5 KILL DIR
SET DIR(0)="S^A:ALL Clinics;S:Selected set or Taxonomy of Clinics;O:ONE Clinic"
SET DIR("A")="Include Visits to Which Clinics"
SET DIR("B")="A"
+6 SET DIR("A")="Enter a code indicating what CLINICS (IHS clinic code) are of interest"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR,DA
+7 IF $DATA(DIRUT)
GOTO HOSPLOC
+8 SET APCDCLNT=Y
+9 IF APCDCLNT="A"
GOTO SC
+10 DO @(APCDCLNT_"CLN")
+11 IF $DATA(APCDQ)
GOTO CLINIC
SC ;
+1 KILL APCDQ
+2 WRITE !!,$GET(IORVON)_"Please enter which SERVICE CATEGORIES will be included",!,"in the list."_$GET(IORVOFF),!
+3 SET APCDSCT=""
+4 KILL APCDSCS
+5 KILL DIR
SET DIR(0)="S^A:ALL Service Categories;S:Selected set or Taxonomy of Service Categories;O:One Service Category"
SET DIR("A")="Include Visits to Which Service Categories"
SET DIR("B")="A"
+6 SET DIR("A")="Enter a code indicating what SERVICE CATEGORIES are of interest"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR,DA
+7 IF $DATA(DIRUT)
GOTO CLINIC
+8 SET APCDSCT=Y
+9 IF APCDSCT="A"
GOTO PROV
+10 DO @(APCDSCT_"SC")
+11 IF $DATA(APCDQ)
GOTO SC
PROV ;
+1 KILL APCDQ
+2 SET APCDPRVT=""
+3 KILL APCDPRVS
+4 SET DIR(0)="S^A:ALL Providers;S:Selected set or Taxonomy of Providers;O:ONE Provider"
SET DIR("A")="Include Which Providers"
SET DIR("B")="A"
+5 SET DIR("A")="Enter a code indicating which providers are of interest"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR,DA
+6 IF $DATA(DIRUT)
GOTO SC
+7 SET APCDPRVT=Y
+8 IF APCDPRVT="A"
GOTO PROCESS
+9 DO @(APCDPRVT_"PRV")
+10 IF $DATA(APCDQ)
GOTO PROV
PROCESS ;
+1 IF $DATA(IOF)
WRITE @IOF
WRITE !!
+2 WRITE !!,"I will display provider deficiencies that meet the following criteria:"
+3 WRITE !!,"LOCATION OF ENCOUNTER: "
Begin DoDot:1
+4 IF '$DATA(APCDLOCS)
WRITE "All"
QUIT
+5 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDLOCS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^DIC(4,Y,0),U),1,15)
End DoDot:1
+6 WRITE !!,"HOSPITAL LOCATIONS: "
Begin DoDot:1
+7 IF '$DATA(APCDHLS)
WRITE "All"
QUIT
+8 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDHLS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^SC(Y,0),U),1,15)
End DoDot:1
+9 WRITE !!,"CLINICS: "
Begin DoDot:1
+10 IF '$DATA(APCDCLNS)
WRITE "All"
QUIT
+11 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDCLNS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^DIC(40.7,Y,0),U),1,15)
End DoDot:1
+12 WRITE !!,"SERVICE CATEGORIES: "
Begin DoDot:1
+13 IF '$DATA(APCDSCS)
WRITE "All"
QUIT
+14 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDSCS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$$EXTSET^XBFUNC(9000010,.07,Y)
End DoDot:1
+15 WRITE !!,"PROVIDERS: "
Begin DoDot:1
+16 IF '$DATA(APCDPRVS)
WRITE "All"
QUIT
+17 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDPRVS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^VA(200,Y,0),U),1,15)
End DoDot:1
RTYPE ;how to sort list of visits
+1 SET APCDRTYP=""
+2 SET DIR(0)="S^1:Individual Provider Listings Only;2:Summary Page Only;3:Both"
SET DIR("A")="Select Report Type"
SET DIR("B")="3"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO PROV
+4 SET APCDRTYP=Y
+5 IF APCDRTYP=2
GOTO ZIS
PAGE ;
+1 SET APCDSPAG=0
+2 SET DIR(0)="Y"
SET DIR("A")="Do you want each provider's listing on a separate page"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO RTYPE
+4 SET APCDSPAG=Y
ZIS ;call xbdbque
+1 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)
GOTO RTYPE
+3 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+4 SET XBRC="DRIVER^APCDCAFK"
SET XBRP="PRINT^APCDCAFK"
SET XBRX="XIT^APCDCAFK"
SET XBNS="APCD"
+5 DO ^XBDBQUE
+6 DO XIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCDCAFK"")"
+2 SET XBNS="APCD"
SET XBRC="DRIVER^APCDCAFK"
SET XBRX="XIT^APCDCAFK"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
DRIVER ;EP entry point for taskman
+1 SET APCDBT=$HOROLOG
SET APCDJOB=$JOB
+2 KILL ^XTMP("APCDCAFK",APCDJOB,APCDBT)
+3 SET APCDPROV=0
+4 FOR
SET APCDPROV=$ORDER(^AUPNCANT("APEND",APCDPROV))
IF APCDPROV'=+APCDPROV
QUIT
Begin DoDot:1
+5 ;not a PROV we want
IF $DATA(APCDPRVS)
IF '$DATA(APCDPRVS(APCDPROV))
QUIT
+6 SET APCDV=0
FOR
SET APCDV=$ORDER(^AUPNCANT("APEND",APCDPROV,APCDV))
IF APCDV'=+APCDV
QUIT
Begin DoDot:2
+7 SET APCDV0=^AUPNVSIT(APCDV,0)
+8 ;NO DEP ENTRIES
IF '$PIECE(APCDV0,U,9)
QUIT
+9 ;DELETED
IF $PIECE(APCDV0,U,11)
QUIT
+10 IF APCDBD
IF $$VD^APCLV(APCDV)<APCDBD
QUIT
+11 IF APCDED
IF $$VD^APCLV(APCDV)>APCDED
QUIT
+12 SET APCDVLOC=$PIECE(APCDV0,U,6)
+13 IF APCDVLOC=""
QUIT
+14 ;not a location we want
IF $DATA(APCDLOCS)
IF '$DATA(APCDLOCS(APCDVLOC))
QUIT
+15 SET X=$PIECE(APCDV0,U,7)
+16 ;no sc
IF X=""
QUIT
+17 ;not a sc we want
IF $DATA(APCDSCS)
IF '$DATA(APCDSCS(X))
QUIT
+18 SET APCDVCLN=$PIECE(APCDV0,U,8)
+19 ;clinic blank and want certain clinics
IF APCDVCLN=""
IF $DATA(APCDCLNS)
QUIT
+20 ;not a CLINIC we want
IF $DATA(APCDCLNS)
IF '$DATA(APCDCLNS(APCDVCLN))
QUIT
+21 SET APCDVHL=$PIECE(APCDV0,U,22)
+22 ;HOSP LOC blank and want certain HOSP LOCS
IF APCDVHL=""
IF $DATA(APCDHLS)
QUIT
+23 ;not a HOSP LOC we want
IF $DATA(APCDHLS)
IF '$DATA(APCDHLS(APCDVHL))
QUIT
+24 SET $PIECE(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV),U,1)=$PIECE($GET(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV)),U,1)+1
+25 SET D=$$FMDIFF^XLFDT(DT,$$VD^APCLV(APCDV))
+26 SET E=$PIECE($GET(^APCDSITE(DUZ(2),0)),U,38)
IF E=""
SET E=3
IF D>E
SET $PIECE(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV),U,2)=$PIECE($GET(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDPROV)),U,2)+1
+27 ;NOW STORE EACH DEFICIENCY
+28 SET APCDI=0
FOR
SET APCDI=$ORDER(^AUPNCANT("APEND",APCDPROV,APCDV,APCDI))
IF APCDI'=+APCDI
QUIT
Begin DoDot:3
+29 SET ^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDPROV,$$VD^APCLV(APCDV),APCDV,APCDI)=""
+30 ;SUMMARY INFO
+31 SET X=$PIECE(^AUPNCANT(APCDV,12,APCDI,0),U,2)
+32 SET ^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDPROV,X)=$GET(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDPROV,X))+1
End DoDot:3
End DoDot:2
End DoDot:1
+33 SET APCDET=$HOROLOG
+34 QUIT
XIT ;
+1 KILL DIR
+2 DO EN^XBVK("APCD")
+3 DO ^XBFMK
+4 DO KILL^AUPNPAT
+5 DO EN^XBVK("AMQQ")
+6 QUIT
+7 ;
D(D) ;
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
CTR(X,Y) ;EP
+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
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP
+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 ;----------
INFORM ;
+1 WRITE !,$$CTR($$LOC)
+2 WRITE !!,$$CTR("PCC/EHR CODING AUDIT")
+3 WRITE !!,"This report will list all PENDING deficiencies for a selected"
+4 WRITE !,"set of providers."
+5 QUIT
OLOC ;one location
+1 DO OLOC^APCDCAFD
+2 QUIT
SLOC ;
+1 DO SLOC^APCDCAFD
+2 QUIT
+3 ;
OCLN ;one clinic
+1 DO OCLN^APCDCAFD
+2 QUIT
SCLN ;taxonomy of clinics
+1 DO SCLN^APCDCAFD
+2 QUIT
+3 ;
OHL ;
+1 SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which HOSPITAL LOCATION: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCDQ=""
QUIT
+3 SET APCDHLS(+Y)=""
+4 QUIT
SHL ;
+1 SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which HOSPITAL LOCATION: "
DO ^DIC
KILL DIC
+2 IF X=""
QUIT
+3 IF Y=-1
SET APCDQ=""
QUIT
+4 SET APCDHLS(+Y)=""
+5 GOTO SHL
+6 QUIT
OPRV ;one clinic
+1 SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Which PROVIDER: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCDQ=""
QUIT
+3 SET APCDPRVS(+Y)=""
+4 QUIT
SPRV ;
+1 SET X="PRIMARY PROVIDER"
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 XIT
+2 DO PEP^AMQQGTX0(+Y,"APCDPRVS(")
+3 IF '$DATA(APCDPRVS)
SET APCDQ=""
QUIT
+4 IF $DATA(APCDPRVS("*"))
SET APCDPRVT="A"
KILL APCDPRVS
WRITE !!,"**** all PROVIDERS will be included ****",!
QUIT
+5 QUIT
+6 ;
SSC ;
+1 SET X="SERVICE CATEGORY"
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 FAC
+2 DO PEP^AMQQGTX0(+Y,"APCDSCS(")
+3 IF '$DATA(APCDSCS)
SET APCDQ=""
QUIT
+4 IF $DATA(APCDSCS("*"))
SET APCDSCT="A"
KILL APCDSCS
WRITE !!,"**** all Services Categories will be included ****",!
QUIT
+5 QUIT
OSC ;
+1 KILL DIR
SET DIR(0)="9000010,.07"
SET DIR("A")="Enter SERVICE CATEGORY"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
SET APCDQ=""
QUIT
+3 SET APCDSCS(Y)=""
+4 QUIT
+5 ;----------
PRINT ;EP - called from xbdbque
+1 SET APCD80S="-------------------------------------------------------------------------------"
+2 SET APCDPG=0
+3 KILL APCDQUIT
+4 DO COVPAGE
+5 DO PRINT1
DONE ;
+1 IF $DATA(APCDQUIT)
GOTO XIT1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF $DATA(IOF)
WRITE @IOF
XIT1 ; Clean up and exit
+1 KILL ^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV")
+2 DO EN^XBVK("APCD")
+3 QUIT
SH ;
+1 WRITE !!?10,"Incomplete Charts for ",$$GET1^DIQ(200,APCDS,.01)
+2 QUIT
PRINT1 ;
+1 KILL APCDQUIT
+2 IF APCDRTYP=2
GOTO SUMPAGE
+3 IF 'APCDSPAG
DO HEAD
+4 IF '$DATA(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV"))
WRITE !!,"There are no pending deficiencies that meet the report criteria."
QUIT
+5 SET APCDS=""
FOR
SET APCDS=$ORDER(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS))
IF APCDS'=+APCDS!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+6 IF APCDSPAG
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+7 DO SH
+8 SET APCDDATE=0
FOR
SET APCDDATE=$ORDER(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS,APCDDATE))
IF APCDDATE'=+APCDDATE!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+9 SET APCDV=""
FOR
SET APCDV=$ORDER(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS,APCDDATE,APCDV))
IF APCDV=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:3
+10 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
DO SH
+11 WRITE !,$EXTRACT($$VAL^XBDIQ1(9000010,APCDV,.05),1,21)
+12 SET APCDVR=^AUPNVSIT(APCDV,0)
IF '$PIECE(APCDVR,U,6)
SET $PIECE(APCDVR,U,6)=0
+13 SET DFN=$PIECE(APCDVR,U,5)
+14 SET APCDHRN=""
SET APCDHRN=$$HRN^AUPNPAT(DFN,$PIECE(APCDVR,U,6),2)
+15 SET APCDHRN=""
SET APCDHRN=$$HRN^AUPNPAT(DFN,DUZ(2))
+16 WRITE ?22,APCDHRN
+17 WRITE ?29,$$DATE(APCDDATE),?40,$PIECE(APCDVR,U,7)
+18 SET APCDC=0
SET APCDI=0
FOR
SET APCDI=$ORDER(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV",APCDS,APCDDATE,APCDV,APCDI))
IF APCDI'=+APCDI!($DATA(APCDQUIT))
QUIT
Begin DoDot:4
+19 SET APCDC=APCDC+1
+20 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
DO SH
+21 IF APCDC>1
WRITE !
+22 SET APCDIENS=APCDI_","_APCDV
WRITE ?43,$$GET1^DIQ(9000095.12,APCDIENS,.02)
+23 WRITE ?76,$$FMDIFF^XLFDT(DT,$$VD^APCLV(APCDV))
+24 IF $$GET1^DIQ(9000095.12,APCDIENS,.1)]""
WRITE !?2,"Comment: ",$$GET1^DIQ(9000095.12,APCDIENS,.1)
End DoDot:4
+25 IF $ORDER(^AUPNCANT(APCDV,11,0))
Begin DoDot:4
+26 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
DO SH
+27 WRITE !?2,"Chart Audit Notes:"
+28 KILL ^UTILITY($JOB,"W")
+29 SET DIWR=70
SET DIWL=0
SET Y=0
SET Y=$ORDER(^AUPNCANT(APCDV,11,Y))
IF Y'=+Y
QUIT
SET X=^AUPNCANT(APCDV,11,Y,0)
DO ^DIWP
+30 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
Begin DoDot:5
+31 IF $Y>(IOSL-2)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
DO SH
+32 WRITE !?2,^UTILITY($JOB,"W",DIWL,Z,0)
End DoDot:5
End DoDot:4
+33 KILL DIWL,DIWR,DIWF,Z
+34 KILL ^UTILITY($JOB,"W")
End DoDot:3
End DoDot:2
End DoDot:1
+35 IF APCDRTYP=1
QUIT
+36 IF $DATA(APCDQUIT)
QUIT
+37 DO SUMPAGE
+38 QUIT
DATE(D) ;EP
+1 IF D=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_(1700+$EXTRACT(D,1,3))
HEAD ;EP;HEADER
+1 IF 'APCDPG
GOTO HEAD1
HEAD2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCDQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE !,$$FMTE^XLFDT($$NOW^XLFDT),?40,$PIECE(^VA(200,DUZ,0),U,2),?70,"Page: ",APCDPG
+3 WRITE !,$$CTR("Confidential Patient Data Covered by Privacy Act",80)
+4 WRITE !,$$CTR("Incomplete Charts by Provider and Deficiency",80)
+5 IF $GET(APCDSUM)
WRITE !,$$CTR("SUMMARY PAGE",80)
+6 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+7 IF '$GET(APCDSUM)
WRITE !!,"Patient",?22,"HRCN",?29,"Visit Date",?40,"SC",?43,"Deficiencies",?76,"Days"
+8 IF $GET(APCDSUM)
WRITE !!,"PROVIDER",?26,"INCOMP",?33,"DELINQ",?40,"DEFICIENCIES"
+9 IF $GET(APCDSUM)
WRITE !?26,"CHARTS",?33,"CHARTS"
+10 WRITE !,APCD80S
+11 QUIT
COVPAGE ;
+1 ;,?70,"Page: ",APCDPG
WRITE !,$$FMTE^XLFDT($$NOW^XLFDT()),?40,$PIECE(^VA(200,DUZ,0),U,2)," Confidential Patient Data Covered by Privacy Act"
+2 WRITE !,$$CTR("***********************************",80)
+3 WRITE !,$$CTR("* PROVIDER CHART DEFICIENCIES *",80)
+4 WRITE !,$$CTR("***********************************",80)
+5 WRITE !!,"PROVIDERS: "
Begin DoDot:1
+6 IF '$DATA(APCDPRV)
WRITE "All"
QUIT
+7 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDPRVS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^VA(200,Y,0),U),1,15)
End DoDot:1
+8 WRITE !!,$$CTR("VISIT DEFICIENCY CRITERIA",80)
+9 WRITE !!,"LOCATION OF ENCOUNTER: "
Begin DoDot:1
+10 IF '$DATA(APCDLOCS)
WRITE "All"
QUIT
+11 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDLOCS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^DIC(4,Y,0),U),1,15)
End DoDot:1
+12 WRITE !!,"HOSPITAL LOCATIONS: "
Begin DoDot:1
+13 IF '$DATA(APCDHLS)
WRITE "All"
QUIT
+14 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDHLS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^SC(Y,0),U),1,15)
End DoDot:1
+15 WRITE !!,"CLINICS: "
Begin DoDot:1
+16 IF '$DATA(APCDCLNS)
WRITE "All"
QUIT
+17 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDCLNS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$EXTRACT($PIECE(^DIC(40.7,Y,0),U),1,15)
End DoDot:1
+18 WRITE !!,"SERVICE CATEGORIES: "
Begin DoDot:1
+19 IF '$DATA(APCDSCS)
WRITE "All"
QUIT
+20 SET Y=0
SET C=0
FOR
SET Y=$ORDER(APCDSCS(Y))
IF Y'=+Y
QUIT
SET C=C+1
IF C>1
WRITE ";"
WRITE ?24,$$EXTSET^XBFUNC(9000010,.07,Y)
End DoDot:1
+21 QUIT
SUMPAGE ;
+1 SET APCDSUM=1
+2 DO HEAD
+3 IF '$DATA(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV"))
WRITE !!,"There are no pending deficiencies that meet the report criteria."
QUIT
+4 SET APCDS=0
FOR
SET APCDS=$ORDER(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDS))
IF APCDS'=+APCDS
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+6 SET S=^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","SUMMARY",APCDS)
+7 WRITE !,$EXTRACT($PIECE(^VA(200,APCDS,0),U),1,25),?27,+$PIECE(S,U,1),?33,+$PIECE(S,U,2)
+8 ;deficiencies
+9 SET APCDDEF=""
+10 SET APCDI=0
FOR
SET APCDI=$ORDER(^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDS,APCDI))
IF APCDI'=+APCDI
QUIT
Begin DoDot:2
+11 IF APCDDEF]""
SET APCDDEF=APCDDEF_", "
+12 SET APCDDEF=APCDDEF_$PIECE(^AUTTCDR(APCDI,0),U,1)_" ("_^XTMP("APCDCAFK",APCDJOB,APCDBT,"PROV","CDR",APCDS,APCDI)_")"
End DoDot:2
+13 KILL ^UTILITY($JOB,"W")
SET X=APCDDEF
SET DIWL=0
SET DIWR=40
DO ^DIWP
+14 WRITE ?40,$GET(^UTILITY($JOB,"W",0,1,0))
+15 IF $ORDER(^UTILITY($JOB,"W",0,1))
Begin DoDot:2
+16 SET X=1
SET X=$ORDER(^UTILITY($JOB,"W",0,X))
IF X'=+X
QUIT
WRITE !?40,^UTILITY($JOB,"W",0,X,0)
End DoDot:2
+17 WRITE !
+18 KILL ^UTILITY($JOB,"W")
End DoDot:1
+19 QUIT
