- 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 ;----------
