APCDCAFG ; IHS/CMI/LAB - ; COMP VISITS W/LAST USER
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
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
DATES K APCDED,APCDBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning REVIEW Date"
D ^DIR G:Y<1 XIT S APCDBD=Y
I APCDBD<$P($G(^APCCCTRL(DUZ(2),0)),U,12) D G DATES
.W !!,"That date is before the EHR/PCC Coding Start Date."
.W !,"Please enter a date on or after "_$$FMTE^XLFDT($P(^APCCCTRL(DUZ(2),0),U,12))
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending REVIEW Date"
D ^DIR G:Y<1 XIT S APCDED=Y
;
I APCDED<APCDBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
;
USER ;
S APCDDEO=""
S DIR(0)="YO",DIR("A")="Report on ALL Operators",DIR("?")="If you wish to include visits reviewd by ALL Operators answer Yes. If you wish to tabulate for only one operator enter NO." D ^DIR K DIR
G:$D(DIRUT) DATES
I Y=1 S APCDDEO="" G SUB
DEC1 ;enter location
S DIC("A")="Which Operator: ",DIC="^VA(200,",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 USER
S APCDDEO=+Y
SUB ;
S APCDVSTD=""
K DIR W ! S DIR(0)="Y",DIR("A")="Do you wish to see a subtotal by REVIEW Date",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G USER
S APCDVSTD=Y
ZIS ;call xbdbque
S XBRC="DRIVER^APCDCAFG",XBRP="PRINT^APCDCAFG",XBRX="XIT^APCDCAFG",XBNS="APCD"
D ^XBDBQUE
D XIT
Q
DRIVER ;EP entry point for taskman
S APCDBT=$H,APCDJOB=$J
K ^XTMP("APCDCAFG",APCDJOB,APCDBT)
S ^XTMP("APCDCAFG",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"CODING QUEUE TALLY"
;loop through all visits in date range and exclude any not reviewed in the date range
D V
S APCDET=$H
Q
V ;
K ^TMP($J,"VISITS")
S APCDODAT=$P(APCDBD,".")-1,APCDODAT=APCDODAT_".9999"
S (APCDRCNT,APCDVCAI)=0 F S APCDODAT=$O(^AUPNVCA("B",APCDODAT)) Q:APCDODAT=""!($P(APCDODAT,".")>$P(APCDED,".")) D
.S APCDVCAI=0 F S APCDVCAI=$O(^AUPNVCA("B",APCDODAT,APCDVCAI)) Q:APCDVCAI'=+APCDVCAI D
..S APCDVIEN=$P(^AUPNVCA(APCDVCAI,0),U,3)
..Q:'APCDVIEN
..Q:'$D(^AUPNVSIT(APCDVIEN,0))
..S APCDV0=$G(^AUPNVSIT(APCDVIEN,0))
..Q:APCDV0=""
..Q:$P($G(^AUPNVSIT(APCDVIEN,11)),U,11)="" ;not reviewed yet
..S ^TMP($J,"VISITS",APCDVIEN)=""
;NOW GO THROUGH AND GET LAST AUPNVCA FOR EACH OF THESE VISITS AND TALLY
S APCDVIEN=0 F S APCDVIEN=$O(^TMP($J,"VISITS",APCDVIEN)) Q:APCDVIEN="" D
.S APCDVCAI=$$LASTVCA(APCDVIEN)
.Q:'APCDVCAI
.S APCDU=$P($G(^AUPNVCA(APCDVCAI,0)),U,5)
.Q:APCDU=""
.I $G(APCDDEO),APCDU'=APCDDEO Q ;want 1 operator and this isn't it
.D SET(APCDU,$P($P(^AUPNVCA(APCDVCAI,0),U),"."),1)
.I $P(^AUPNVCA(APCDVCAI,0),U,4)="R" D SET(APCDU,$P($P(^AUPNVCA(APCDVCAI,0),U),"."),2)
S APCDET=$H
Q
LASTVCA(V) ;
NEW X,Y
S X=0 F S X=$O(^AUPNVCA("AD",APCDVIEN,X)) Q:X'=+X S Y=X
Q Y
SET(R,D,P) ;
S $P(^XTMP("APCDCAFG",APCDJOB,APCDBT,R,D),U,P)=$P($G(^XTMP("APCDCAFG",APCDJOB,APCDBT,R,D)),U,P)+1
S $P(^XTMP("APCDCAFG",APCDJOB,APCDBT,R),U,P)=$P($G(^XTMP("APCDCAFG",APCDJOB,APCDBT,R)),U,P)+1
Q
PRINT ;EP
S APCDQUIT="",APCDPG=0,APCDTOTV=0,APCDTOTR=0 D HDR
I '$D(^XTMP("APCDCAFG",APCDJOB,APCDBT)) D HDR W !!,"NO DATA TO REPORT",! G DONE
S APCDU="" F S APCDU=$O(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU)) Q:APCDU=""!(APCDQUIT) D
. I $Y>(IOSL-3) D HDR Q:APCDQUIT
. W !!,$P(^VA(200,APCDU,0),U),?40,$$C($P(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U),0),?55,$$C($P(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U,2),0)
. S APCDTOTV=APCDTOTV+$P(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U,1),APCDTOTR=APCDTOTR+$P(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U,2)
. Q:'APCDVSTD
. S APCDD=0 F S APCDD=$O(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU,APCDD)) Q:APCDD'=+APCDD!(APCDQUIT) D
.. I $Y>(IOSL-3) D HDR Q:APCDQUIT
.. W !?10,$$FMTE^XLFDT(APCDD),?40,$$C($P(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU,APCDD),U),0),?55,$$C($P(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU,APCDD),U,2),0)
.Q
I APCDQUIT G DONE
I $Y>(IOSL-3) D HDR G:APCDQUIT DONE
W !!,"Total Number of Visits: ",?40,$$C(APCDTOTV,0),?55,$$C(APCDTOTR,0),!
DONE ;
K ^XTMP("APCDCAFG",APCDJOB,APCDBT),APCDJ,APCDBT
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
W:$D(IOF) @IOF
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q $$STRIP^XLFSTR(X," ")
HDR ;EP;HEADER
I 'APCDPG G HDR1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCDQUIT=1 Q
HDR1 ;
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W !,$$FMTE^XLFDT(DT),?70,"Page: ",APCDPG
W !?29,"PCC Data Entry Module"
W !,$$CTR("******************************************************",80)
W !,$$CTR("* COUNT OF VISITS REVIEWED/COMPLETED BY OPERATOR *",80)
W !,$$CTR("* COUNTS LAST REVIEW ONLY *",80)
W !,$$CTR("******************************************************",80)
S X="REVIEW Date Range: "_$$FMTE^XLFDT(APCDBD)_" through "_$$FMTE^XLFDT(APCDED) W !,$$CTR(X,80)
;I APCDLOCT="A" S X="Location of Encounter: All" W !,$$CTR(X,80)
;I APCDLOCT'="A" D
;.S X=0,Y="" F S X=$O(APCDLOCS(X)) Q:X'=+X S Y=Y_$S(Y="":"",1:";")_$P(^AUTTLOC(X,0),U,2)
;.;S X="Locations: "_Y W !,$$CTR(Y,80)
W !!,"Operator",?40,"# of visits",?55,"# of visits marked"
W !?40,"reviewed",?55,"as complete"
W !,$$REPEAT^XLFSTR("-",80)
Q
OPER(V) ;
I '$D(^AUPNVSIT(V,0)) Q ""
I '$D(^AUPNVCA("AD",V)) Q ""
NEW X,G
S G=""
S X=0 F S X=$O(^AUPNVCA("AD",V,X)) Q:X'=+X!(G) D
.Q:'$D(^AUPNVCA(X,0))
.I $P(^AUPNVCA(X,0),U,4)="R" S G=$P(^AUPNVCA(X,0),U,5)_U_$P($P(^AUPNVCA(X,0),U),".") Q
.Q
Q G
;
XIT ;
K DIR
D EN^XBVK("APCD") ;clean up APCD variables
D ^XBFMK ;clean up fileman variables
D KILL^AUPNPAT ;clean up AUPN
D EN^XBVK("AMQQ") ;clean up after qman
Q
;
D(D) ;
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
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 DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="End of report. Press Enter",DIR(0)="E" D ^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")
;----------
INFORM ;inform user what this report is all about
W !,$$CTR($$LOC)
W !!,$$CTR("PCC/EHR CODING AUDIT")
W !!,"This report will produce a tally of visits REVIEWED/COMPLETED"
W !,"by the user who reviewed/completed the visit. PLEASE NOTE: this"
W !,"report will only look at visits that have been reviewed and"
W !,"marked as either REVIEWED/COMPLETE or INCOMPLETE. If a visit has"
W !,"never been reviewed it is not counted in this report. You must"
W !,"enter the REVIEW date range. This is the date range for which visits"
W !,"were reviewed.",!!
W !,"NOTE: Only the LAST user who reviewed the visit by marking it either"
W !,"complete or incomplete will be counted in this report."
W !
Q
OLOC ;one location
S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
I Y=-1 S APCDQ="" Q
S APCDLOCS(+Y)=""
Q
SLOC ;taxonomy of locations
S X="LOCATION OF ENCOUNTER",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,"APCDLOCS(")
I '$D(APCDLOCS) S APCDQ="" Q
I $D(APCDLOCS("*")) S APCDLOCT="A" K APCDLOCS W !!,"**** all locations will be included ****",! Q
Q
INSTALLD(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
; APCDSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW APCDY,DIC,X,Y
S X=$P(APCDSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",22,",X=$P(APCDSTAL,"*",2)
D ^DIC
I Y<1 D IMES Q 0
S DIC=DIC_+Y_",""PAH"",",X=$P(APCDSTAL,"*",3)
D ^DIC
S APCDY=Y
D IMES
Q $S(APCDY<1:0,1:1)
IMES ;
D MES^XPDUTL($$CJ^XLFSTR("Patch """_APCDSTAL_""" is"_$S(Y<1:" *NOT*",1:"")_" installed.",IOM))
Q
INSTDATE(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
; APCDSTAL is the name of the INSTALL. E.g "AG*6.0*11".
;
NEW APCDY,DIC,X,Y,APCDX,APCDZ
S X=$P(APCDSTAL,"*",1)
S DIC="^DIC(9.4,",DIC(0)="FM",D="C"
D IX^DIC
S APCDX=+Y
S DIC=DIC_APCDX_",22,",X=$P(APCDSTAL,"*",2)
D ^DIC
S APCDZ=+Y
S DIC=DIC_APCDZ_",""PAH"",",X=$P(APCDSTAL,"*",3)
D ^DIC
S APCDY=+Y
Q $$FMTE^XLFDT($P(^DIC(9.4,APCDX,22,APCDZ,"PAH",APCDY,0),U,2))
APCDCAFG ; IHS/CMI/LAB - ; COMP VISITS W/LAST USER
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+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
DATES KILL APCDED,APCDBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning REVIEW Date"
+2 DO ^DIR
IF Y<1
GOTO XIT
SET APCDBD=Y
+3 IF APCDBD<$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,12)
Begin DoDot:1
+4 WRITE !!,"That date is before the EHR/PCC Coding Start Date."
+5 WRITE !,"Please enter a date on or after "_$$FMTE^XLFDT($PIECE(^APCCCTRL(DUZ(2),0),U,12))
End DoDot:1
GOTO DATES
+6 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending REVIEW Date"
+7 DO ^DIR
IF Y<1
GOTO XIT
SET APCDED=Y
+8 ;
+9 IF APCDED<APCDBD
Begin DoDot:1
+10 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+11 ;
USER ;
+1 SET APCDDEO=""
+2 SET DIR(0)="YO"
SET DIR("A")="Report on ALL Operators"
SET DIR("?")="If you wish to include visits reviewd by ALL Operators answer Yes. If you wish to tabulate for only one operator enter NO."
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO DATES
+4 IF Y=1
SET APCDDEO=""
GOTO SUB
DEC1 ;enter location
+1 SET DIC("A")="Which Operator: "
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
GOTO USER
+2 SET APCDDEO=+Y
SUB ;
+1 SET APCDVSTD=""
+2 KILL DIR
WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you wish to see a subtotal by REVIEW Date"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO USER
+4 SET APCDVSTD=Y
ZIS ;call xbdbque
+1 SET XBRC="DRIVER^APCDCAFG"
SET XBRP="PRINT^APCDCAFG"
SET XBRX="XIT^APCDCAFG"
SET XBNS="APCD"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
DRIVER ;EP entry point for taskman
+1 SET APCDBT=$HOROLOG
SET APCDJOB=$JOB
+2 KILL ^XTMP("APCDCAFG",APCDJOB,APCDBT)
+3 SET ^XTMP("APCDCAFG",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"CODING QUEUE TALLY"
+4 ;loop through all visits in date range and exclude any not reviewed in the date range
+5 DO V
+6 SET APCDET=$HOROLOG
+7 QUIT
V ;
+1 KILL ^TMP($JOB,"VISITS")
+2 SET APCDODAT=$PIECE(APCDBD,".")-1
SET APCDODAT=APCDODAT_".9999"
+3 SET (APCDRCNT,APCDVCAI)=0
FOR
SET APCDODAT=$ORDER(^AUPNVCA("B",APCDODAT))
IF APCDODAT=""!($PIECE(APCDODAT,".")>$PIECE(APCDED,"."))
QUIT
Begin DoDot:1
+4 SET APCDVCAI=0
FOR
SET APCDVCAI=$ORDER(^AUPNVCA("B",APCDODAT,APCDVCAI))
IF APCDVCAI'=+APCDVCAI
QUIT
Begin DoDot:2
+5 SET APCDVIEN=$PIECE(^AUPNVCA(APCDVCAI,0),U,3)
+6 IF 'APCDVIEN
QUIT
+7 IF '$DATA(^AUPNVSIT(APCDVIEN,0))
QUIT
+8 SET APCDV0=$GET(^AUPNVSIT(APCDVIEN,0))
+9 IF APCDV0=""
QUIT
+10 ;not reviewed yet
IF $PIECE($GET(^AUPNVSIT(APCDVIEN,11)),U,11)=""
QUIT
+11 SET ^TMP($JOB,"VISITS",APCDVIEN)=""
End DoDot:2
End DoDot:1
+12 ;NOW GO THROUGH AND GET LAST AUPNVCA FOR EACH OF THESE VISITS AND TALLY
+13 SET APCDVIEN=0
FOR
SET APCDVIEN=$ORDER(^TMP($JOB,"VISITS",APCDVIEN))
IF APCDVIEN=""
QUIT
Begin DoDot:1
+14 SET APCDVCAI=$$LASTVCA(APCDVIEN)
+15 IF 'APCDVCAI
QUIT
+16 SET APCDU=$PIECE($GET(^AUPNVCA(APCDVCAI,0)),U,5)
+17 IF APCDU=""
QUIT
+18 ;want 1 operator and this isn't it
IF $GET(APCDDEO)
IF APCDU'=APCDDEO
QUIT
+19 DO SET(APCDU,$PIECE($PIECE(^AUPNVCA(APCDVCAI,0),U),"."),1)
+20 IF $PIECE(^AUPNVCA(APCDVCAI,0),U,4)="R"
DO SET(APCDU,$PIECE($PIECE(^AUPNVCA(APCDVCAI,0),U),"."),2)
End DoDot:1
+21 SET APCDET=$HOROLOG
+22 QUIT
LASTVCA(V) ;
+1 NEW X,Y
+2 SET X=0
FOR
SET X=$ORDER(^AUPNVCA("AD",APCDVIEN,X))
IF X'=+X
QUIT
SET Y=X
+3 QUIT Y
SET(R,D,P) ;
+1 SET $PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,R,D),U,P)=$PIECE($GET(^XTMP("APCDCAFG",APCDJOB,APCDBT,R,D)),U,P)+1
+2 SET $PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,R),U,P)=$PIECE($GET(^XTMP("APCDCAFG",APCDJOB,APCDBT,R)),U,P)+1
+3 QUIT
PRINT ;EP
+1 SET APCDQUIT=""
SET APCDPG=0
SET APCDTOTV=0
SET APCDTOTR=0
DO HDR
+2 IF '$DATA(^XTMP("APCDCAFG",APCDJOB,APCDBT))
DO HDR
WRITE !!,"NO DATA TO REPORT",!
GOTO DONE
+3 SET APCDU=""
FOR
SET APCDU=$ORDER(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU))
IF APCDU=""!(APCDQUIT)
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-3)
DO HDR
IF APCDQUIT
QUIT
+5 WRITE !!,$PIECE(^VA(200,APCDU,0),U),?40,$$C($PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U),0),?55,$$C($PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U,2),0)
+6 SET APCDTOTV=APCDTOTV+$PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U,1)
SET APCDTOTR=APCDTOTR+$PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU),U,2)
+7 IF 'APCDVSTD
QUIT
+8 SET APCDD=0
FOR
SET APCDD=$ORDER(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU,APCDD))
IF APCDD'=+APCDD!(APCDQUIT)
QUIT
Begin DoDot:2
+9 IF $Y>(IOSL-3)
DO HDR
IF APCDQUIT
QUIT
+10 WRITE !?10,$$FMTE^XLFDT(APCDD),?40,$$C($PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU,APCDD),U),0),?55,$$C($PIECE(^XTMP("APCDCAFG",APCDJOB,APCDBT,APCDU,APCDD),U,2),0)
End DoDot:2
+11 QUIT
End DoDot:1
+12 IF APCDQUIT
GOTO DONE
+13 IF $Y>(IOSL-3)
DO HDR
IF APCDQUIT
GOTO DONE
+14 WRITE !!,"Total Number of Visits: ",?40,$$C(APCDTOTV,0),?55,$$C(APCDTOTR,0),!
DONE ;
+1 KILL ^XTMP("APCDCAFG",APCDJOB,APCDBT),APCDJ,APCDBT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. PRESS ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT $$STRIP^XLFSTR(X," ")
HDR ;EP;HEADER
+1 IF 'APCDPG
GOTO HDR1
+2 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=1
QUIT
HDR1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE !,$$FMTE^XLFDT(DT),?70,"Page: ",APCDPG
+3 WRITE !?29,"PCC Data Entry Module"
+4 WRITE !,$$CTR("******************************************************",80)
+5 WRITE !,$$CTR("* COUNT OF VISITS REVIEWED/COMPLETED BY OPERATOR *",80)
+6 WRITE !,$$CTR("* COUNTS LAST REVIEW ONLY *",80)
+7 WRITE !,$$CTR("******************************************************",80)
+8 SET X="REVIEW Date Range: "_$$FMTE^XLFDT(APCDBD)_" through "_$$FMTE^XLFDT(APCDED)
WRITE !,$$CTR(X,80)
+9 ;I APCDLOCT="A" S X="Location of Encounter: All" W !,$$CTR(X,80)
+10 ;I APCDLOCT'="A" D
+11 ;.S X=0,Y="" F S X=$O(APCDLOCS(X)) Q:X'=+X S Y=Y_$S(Y="":"",1:";")_$P(^AUTTLOC(X,0),U,2)
+12 ;.;S X="Locations: "_Y W !,$$CTR(Y,80)
+13 WRITE !!,"Operator",?40,"# of visits",?55,"# of visits marked"
+14 WRITE !?40,"reviewed",?55,"as complete"
+15 WRITE !,$$REPEAT^XLFSTR("-",80)
+16 QUIT
OPER(V) ;
+1 IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+2 IF '$DATA(^AUPNVCA("AD",V))
QUIT ""
+3 NEW X,G
+4 SET G=""
+5 SET X=0
FOR
SET X=$ORDER(^AUPNVCA("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+6 IF '$DATA(^AUPNVCA(X,0))
QUIT
+7 IF $PIECE(^AUPNVCA(X,0),U,4)="R"
SET G=$PIECE(^AUPNVCA(X,0),U,5)_U_$PIECE($PIECE(^AUPNVCA(X,0),U),".")
QUIT
+8 QUIT
End DoDot:1
+9 QUIT G
+10 ;
XIT ;
+1 KILL DIR
+2 ;clean up APCD variables
DO EN^XBVK("APCD")
+3 ;clean up fileman variables
DO ^XBFMK
+4 ;clean up AUPN
DO KILL^AUPNPAT
+5 ;clean up after qman
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 - 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 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 - 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 ;----------
INFORM ;inform user what this report is all about
+1 WRITE !,$$CTR($$LOC)
+2 WRITE !!,$$CTR("PCC/EHR CODING AUDIT")
+3 WRITE !!,"This report will produce a tally of visits REVIEWED/COMPLETED"
+4 WRITE !,"by the user who reviewed/completed the visit. PLEASE NOTE: this"
+5 WRITE !,"report will only look at visits that have been reviewed and"
+6 WRITE !,"marked as either REVIEWED/COMPLETE or INCOMPLETE. If a visit has"
+7 WRITE !,"never been reviewed it is not counted in this report. You must"
+8 WRITE !,"enter the REVIEW date range. This is the date range for which visits"
+9 WRITE !,"were reviewed.",!!
+10 WRITE !,"NOTE: Only the LAST user who reviewed the visit by marking it either"
+11 WRITE !,"complete or incomplete will be counted in this report."
+12 WRITE !
+13 QUIT
OLOC ;one location
+1 SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("A")="Which LOCATION: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCDQ=""
QUIT
+3 SET APCDLOCS(+Y)=""
+4 QUIT
SLOC ;taxonomy of locations
+1 SET X="LOCATION OF ENCOUNTER"
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,"APCDLOCS(")
+3 IF '$DATA(APCDLOCS)
SET APCDQ=""
QUIT
+4 IF $DATA(APCDLOCS("*"))
SET APCDLOCT="A"
KILL APCDLOCS
WRITE !!,"**** all locations will be included ****",!
QUIT
+5 QUIT
INSTALLD(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
+1 ; APCDSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW APCDY,DIC,X,Y
+4 SET X=$PIECE(APCDSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 IF Y<1
DO IMES
QUIT 0
+8 SET DIC=DIC_+Y_",22,"
SET X=$PIECE(APCDSTAL,"*",2)
+9 DO ^DIC
+10 IF Y<1
DO IMES
QUIT 0
+11 SET DIC=DIC_+Y_",""PAH"","
SET X=$PIECE(APCDSTAL,"*",3)
+12 DO ^DIC
+13 SET APCDY=Y
+14 DO IMES
+15 QUIT $SELECT(APCDY<1:0,1:1)
IMES ;
+1 DO MES^XPDUTL($$CJ^XLFSTR("Patch """_APCDSTAL_""" is"_$SELECT(Y<1:" *NOT*",1:"")_" installed.",IOM))
+2 QUIT
INSTDATE(APCDSTAL) ;EP - Determine if patch APCDSTAL was installed, where
+1 ; APCDSTAL is the name of the INSTALL. E.g "AG*6.0*11".
+2 ;
+3 NEW APCDY,DIC,X,Y,APCDX,APCDZ
+4 SET X=$PIECE(APCDSTAL,"*",1)
+5 SET DIC="^DIC(9.4,"
SET DIC(0)="FM"
SET D="C"
+6 DO IX^DIC
+7 SET APCDX=+Y
+8 SET DIC=DIC_APCDX_",22,"
SET X=$PIECE(APCDSTAL,"*",2)
+9 DO ^DIC
+10 SET APCDZ=+Y
+11 SET DIC=DIC_APCDZ_",""PAH"","
SET X=$PIECE(APCDSTAL,"*",3)
+12 DO ^DIC
+13 SET APCDY=+Y
+14 QUIT $$FMTE^XLFDT($PIECE(^DIC(9.4,APCDX,22,APCDZ,"PAH",APCDY,0),U,2))
