APCDFQCP ; IHS/CMI/LAB - PRINT DE QA ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
START ;
S APCD80D="-------------------------------------------------------------------------------"
S Y=APCDBD D DD^%DT S APCDBDD=Y S Y=APCDED D DD^%DT S APCDEDD=Y
I APCDMAX="" S APCDMAX=APCDVCNT
I APCDMAX>APCDVCNT S APCDMAX=APCDVCNT
S APCDPG=0 D HEAD
I APCDMAX=0 S APCDPG=0 W !,"No Visits to report!",! G DONE
S APCDGOT=APCDVCNT/APCDMAX S APCDGOT=$J(APCDGOT,$L($P(APCDGOT,".")),0)
I '$D(^XTMP("APCDFQA",APCDJOB,APCDBT)) W !,"No visits to report",! G DONE
K APCDQUIT
S APCDVDFN="" F APCDX=1:APCDGOT:APCDVCNT S APCDVDFN=$O(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEQAV",APCDX,"")) Q:APCDVDFN=""!($D(APCDQUIT)) I $D(^AUPNVSIT(APCDVDFN,0)) S APCDVREC=^(0) D POV
G:$D(APCDQUIT) DONE
;I $Y>(IOSL-11) D HEAD G:$D(APCDQUIT) DONE
DONE ;
I '$D(APCDQUIT),$E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
K ^XTMP("APCDFQA",APCDJOB,APCDBT)
;W:$D(IOF) @IOF
Q
POV ;
S APCDPOVC=0,APCDPOV="" K APCDPOVA
F S APCDPOV=$O(^AUPNVPOV("AD",APCDVDFN,APCDPOV)) Q:APCDPOV="" I $D(^AUPNVPOV(APCDPOV,0)) D POV1
D WRT
Q
POV1 ;
I $D(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ALL")) S APCDPOVC=APCDPOVC+1,APCDPOVA(APCDPOVC)=APCDPOV Q
I $D(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ICDDFN",$P(^AUPNVPOV(APCDPOV,0),U))) S APCDPOVC=APCDPOVC+1,APCDPOVA(APCDPOVC)=APCDPOV
Q
WRT ;
I $Y>(IOSL-6) D HEAD Q:$D(APCDQUIT)
S Y=+APCDVREC D DD^%DT S APCDDATE=Y
S APCDPAT=$P(APCDVREC,U,5) Q:APCDPAT=""
;S APCDHRN=$S($D(^AUPNPAT(APCDPAT,41,DUZ(2),0)):$P(^AUPNPAT(APCDPAT,41,DUZ(2),0),U,2),1:"NONE")
S APCDHRN=$$HRN^AUPNPAT(APCDPAT,$P(APCDVREC,U,6),2)
I APCDHRN="" S APCDHRN=$$HRN^AUPNPAT(APCDPAT,DUZ(2),2)
I APCDHRN="",$O(^AUPNPAT(APCDPAT,41,0)) S APCDHRN=$$HRN^AUPNPAT(APCDPAT,$O(^AUPNPAT(APCDPAT,41,0)),2)
I APCDHRN="" S APCDHRN="NONE"
W !,APCDHRN,?12,APCDDATE,?31,$E($$CLINIC^APCLV(APCDVDFN,"E"),1,15),?47,$$VALI^XBDIQ1(9000010,APCDVDFN,.07),?52,$$COMPBY(APCDVDFN),!
S APCDPOVN=0 F S APCDPOVN=$O(APCDPOVA(APCDPOVN)) Q:APCDPOVN=""!($D(APCDQUIT)) D
.I $Y>(IOSL-4) D HEAD Q:$D(APCDQUIT)
.S APCDPOVD=APCDPOVA(APCDPOVN)
.W ?1,$P($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,2),?11,$$VAL^XBDIQ1(9000010.07,APCDPOVD,.24),?18,"Last Modified By: ",$E($$VAL^XBDIQ1(9000010.07,APCDPOVD,1219),1,24),!
.S X=$$VAL^XBDIQ1(9000010.07,APCDPOVD,.04)
.K ^UTILITY($J,"W")
. S DIWL=0,DIWR=78
. D ^DIWP
.S APCDUDA="" F S APCDUDA=$O(^UTILITY($J,"W",APCDUDA)) Q:APCDUDA="" D
.. S APCDVDA=0 F S APCDVDA=$O(^UTILITY($J,"W",APCDUDA,APCDVDA)) Q:'APCDVDA!(APCDUDA="") W ?1,$G(^UTILITY($J,"W",APCDUDA,APCDVDA,0)),!
.W ?1,"[",$E($P($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,4),1,75),"]",!
Q
COMPBY(V) ;last one marked reviewed/complete or "Not Yet Marked Complete"
I '$G(V) Q ""
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 D
.Q:'$D(^AUPNVCA(X,0))
.Q:$P(^AUPNVCA(X,0),U,4)'="R"
.S G=$P(^AUPNVCA(X,0),U,5) ;USER
I 'G Q ""
Q $E($P($G(^VA(200,G,0)),U,1),1,27)
;
HEAD I 'APCDPG G HEAD1
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 $$CTR(APCDLHDR,80),?72,"Page ",APCDPG,!
W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
W ?15,APCDPROD_" Dates: "_APCDBDD_" - "_APCDEDD,!
I APCDPROV D
.S APCDLENG=$L($P(^VA(200,APCDPROV,0),U))+19
.W ?(80-APCDLENG)/2,"Data Entry Operator: ",$P(^VA(200,APCDPROV,0),U),!
I 'APCDPROV W $$CTR("All Operators/Coders"),!
W $$CTR("Service Categories: ") D
.I $D(APCDSCT) S X="",C=0 F S X=$O(APCDSCT(X)) Q:X="" S C=C+1 W:C>1 ", " W X
.I '$D(APCDSCT) W "All"
.W !
W $$CTR("Clinic: "_$S(APCDCLN]"":$P(^DIC(40.7,APCDCLN,0),U),1:"ALL")),!
I APCDRVC="R" W $$CTR("Only visit marked reviewed/complete are included"),!
W "Total Visits Found: ",APCDVCNT D
.I $G(APCDRSM)=1 W " Total Number of Random Visits Selected: ",APCDMAX
.W !
W !?2,"HR#",?12,"Visit Date/Time",?31,"Clinic",?47,"SC",?52,"Reviewed/Completed By",!
W ?1,"ICD DX",?11,"ICD-9",!?1,"Provider Narrative [ICD Description]",!
W APCD80D,!
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
APCDFQCP ; IHS/CMI/LAB - PRINT DE QA ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
START ;
+1 SET APCD80D="-------------------------------------------------------------------------------"
+2 SET Y=APCDBD
DO DD^%DT
SET APCDBDD=Y
SET Y=APCDED
DO DD^%DT
SET APCDEDD=Y
+3 IF APCDMAX=""
SET APCDMAX=APCDVCNT
+4 IF APCDMAX>APCDVCNT
SET APCDMAX=APCDVCNT
+5 SET APCDPG=0
DO HEAD
+6 IF APCDMAX=0
SET APCDPG=0
WRITE !,"No Visits to report!",!
GOTO DONE
+7 SET APCDGOT=APCDVCNT/APCDMAX
SET APCDGOT=$JUSTIFY(APCDGOT,$LENGTH($PIECE(APCDGOT,".")),0)
+8 IF '$DATA(^XTMP("APCDFQA",APCDJOB,APCDBT))
WRITE !,"No visits to report",!
GOTO DONE
+9 KILL APCDQUIT
+10 SET APCDVDFN=""
FOR APCDX=1:APCDGOT:APCDVCNT
SET APCDVDFN=$ORDER(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEQAV",APCDX,""))
IF APCDVDFN=""!($DATA(APCDQUIT))
QUIT
IF $DATA(^AUPNVSIT(APCDVDFN,0))
SET APCDVREC=^(0)
DO POV
+11 IF $DATA(APCDQUIT)
GOTO DONE
+12 ;I $Y>(IOSL-11) D HEAD G:$D(APCDQUIT) DONE
DONE ;
+1 IF '$DATA(APCDQUIT)
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+2 KILL ^XTMP("APCDFQA",APCDJOB,APCDBT)
+3 ;W:$D(IOF) @IOF
+4 QUIT
POV ;
+1 SET APCDPOVC=0
SET APCDPOV=""
KILL APCDPOVA
+2 FOR
SET APCDPOV=$ORDER(^AUPNVPOV("AD",APCDVDFN,APCDPOV))
IF APCDPOV=""
QUIT
IF $DATA(^AUPNVPOV(APCDPOV,0))
DO POV1
+3 DO WRT
+4 QUIT
POV1 ;
+1 IF $DATA(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ALL"))
SET APCDPOVC=APCDPOVC+1
SET APCDPOVA(APCDPOVC)=APCDPOV
QUIT
+2 IF $DATA(^XTMP("APCDFQA",APCDJOB,APCDBT,"DEPOV","ICDDFN",$PIECE(^AUPNVPOV(APCDPOV,0),U)))
SET APCDPOVC=APCDPOVC+1
SET APCDPOVA(APCDPOVC)=APCDPOV
+3 QUIT
WRT ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+2 SET Y=+APCDVREC
DO DD^%DT
SET APCDDATE=Y
+3 SET APCDPAT=$PIECE(APCDVREC,U,5)
IF APCDPAT=""
QUIT
+4 ;S APCDHRN=$S($D(^AUPNPAT(APCDPAT,41,DUZ(2),0)):$P(^AUPNPAT(APCDPAT,41,DUZ(2),0),U,2),1:"NONE")
+5 SET APCDHRN=$$HRN^AUPNPAT(APCDPAT,$PIECE(APCDVREC,U,6),2)
+6 IF APCDHRN=""
SET APCDHRN=$$HRN^AUPNPAT(APCDPAT,DUZ(2),2)
+7 IF APCDHRN=""
IF $ORDER(^AUPNPAT(APCDPAT,41,0))
SET APCDHRN=$$HRN^AUPNPAT(APCDPAT,$ORDER(^AUPNPAT(APCDPAT,41,0)),2)
+8 IF APCDHRN=""
SET APCDHRN="NONE"
+9 WRITE !,APCDHRN,?12,APCDDATE,?31,$EXTRACT($$CLINIC^APCLV(APCDVDFN,"E"),1,15),?47,$$VALI^XBDIQ1(9000010,APCDVDFN,.07),?52,$$COMPBY(APCDVDFN),!
+10 SET APCDPOVN=0
FOR
SET APCDPOVN=$ORDER(APCDPOVA(APCDPOVN))
IF APCDPOVN=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+11 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+12 SET APCDPOVD=APCDPOVA(APCDPOVN)
+13 WRITE ?1,$PIECE($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,2),?11,$$VAL^XBDIQ1(9000010.07,APCDPOVD,.24),?18,"Last Modified By: ",$EXTRACT($$VAL^XBDIQ1(9000010.07,APCDPOVD,1219),1,24),!
+14 SET X=$$VAL^XBDIQ1(9000010.07,APCDPOVD,.04)
+15 KILL ^UTILITY($JOB,"W")
+16 SET DIWL=0
SET DIWR=78
+17 DO ^DIWP
+18 SET APCDUDA=""
FOR
SET APCDUDA=$ORDER(^UTILITY($JOB,"W",APCDUDA))
IF APCDUDA=""
QUIT
Begin DoDot:2
+19 SET APCDVDA=0
FOR
SET APCDVDA=$ORDER(^UTILITY($JOB,"W",APCDUDA,APCDVDA))
IF 'APCDVDA!(APCDUDA="")
QUIT
WRITE ?1,$GET(^UTILITY($JOB,"W",APCDUDA,APCDVDA,0)),!
End DoDot:2
+20 WRITE ?1,"[",$EXTRACT($PIECE($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,4),1,75),"]",!
End DoDot:1
+21 QUIT
COMPBY(V) ;last one marked reviewed/complete or "Not Yet Marked Complete"
+1 IF '$GET(V)
QUIT ""
+2 IF '$DATA(^AUPNVSIT(V,0))
QUIT ""
+3 IF '$DATA(^AUPNVCA("AD",V))
QUIT ""
+4 NEW X,G
+5 SET G=""
+6 SET X=0
FOR
SET X=$ORDER(^AUPNVCA("AD",V,X))
IF X'=+X
QUIT
Begin DoDot:1
+7 IF '$DATA(^AUPNVCA(X,0))
QUIT
+8 IF $PIECE(^AUPNVCA(X,0),U,4)'="R"
QUIT
+9 ;USER
SET G=$PIECE(^AUPNVCA(X,0),U,5)
End DoDot:1
+10 IF 'G
QUIT ""
+11 QUIT $EXTRACT($PIECE($GET(^VA(200,G,0)),U,1),1,27)
+12 ;
HEAD IF 'APCDPG
GOTO HEAD1
+1 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 $$CTR(APCDLHDR,80),?72,"Page ",APCDPG,!
+3 WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!
+4 WRITE ?15,APCDPROD_" Dates: "_APCDBDD_" - "_APCDEDD,!
+5 IF APCDPROV
Begin DoDot:1
+6 SET APCDLENG=$LENGTH($PIECE(^VA(200,APCDPROV,0),U))+19
+7 WRITE ?(80-APCDLENG)/2,"Data Entry Operator: ",$PIECE(^VA(200,APCDPROV,0),U),!
End DoDot:1
+8 IF 'APCDPROV
WRITE $$CTR("All Operators/Coders"),!
+9 WRITE $$CTR("Service Categories: ")
Begin DoDot:1
+10 IF $DATA(APCDSCT)
SET X=""
SET C=0
FOR
SET X=$ORDER(APCDSCT(X))
IF X=""
QUIT
SET C=C+1
IF C>1
WRITE ", "
WRITE X
+11 IF '$DATA(APCDSCT)
WRITE "All"
+12 WRITE !
End DoDot:1
+13 WRITE $$CTR("Clinic: "_$SELECT(APCDCLN]"":$PIECE(^DIC(40.7,APCDCLN,0),U),1:"ALL")),!
+14 IF APCDRVC="R"
WRITE $$CTR("Only visit marked reviewed/complete are included"),!
+15 WRITE "Total Visits Found: ",APCDVCNT
Begin DoDot:1
+16 IF $GET(APCDRSM)=1
WRITE " Total Number of Random Visits Selected: ",APCDMAX
+17 WRITE !
End DoDot:1
+18 WRITE !?2,"HR#",?12,"Visit Date/Time",?31,"Clinic",?47,"SC",?52,"Reviewed/Completed By",!
+19 WRITE ?1,"ICD DX",?11,"ICD-9",!?1,"Provider Narrative [ICD Description]",!
+20 WRITE APCD80D,!
+21 QUIT
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 ;----------
