APCDFQAP ; 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)) D HEAD 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-(APCDPOVC+5)) 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 S APCDPOVD=APCDPOVA(1) W ?31,$P($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,2),?40,$$VAL^XBDIQ1(9000010.07,APCDPOVD,.24)
S APCDNQ=$$VAL^XBDIQ1(9000010.07,APCDPOVD,.04) W:APCDNQ]"" ?47,$E(APCDNQ,1,30),!?47,"[",$E($P($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,4),1,30),"]"
D POVW
Q
POVW ;
S APCDPOVN=1 F S APCDPOVN=$O(APCDPOVA(APCDPOVN)) Q:APCDPOVN=""!($D(APCDQUIT)) D
.I $Y>(IOSL-3) D HEAD Q:$D(APCDQUIT)
.S APCDPOVD=APCDPOVA(APCDPOVN) W !?31,$P($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,2),?40,$$VAL^XBDIQ1(9000010.07,APCDPOVD,.24) S APCDNQ=$$VAL^XBDIQ1(9000010.07,APCDPOVD,.04) W:APCDNQ]"" ?47,$E(APCDNQ,1,34)
.W !?47,"[",$E($P($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,4),1,30),"]"
Q
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 ?32,APCDLHDR,?74,"Page ",APCDPG,!
W ?(80-$L($P(^DIC(4,DUZ(2),0),U))/2),$P(^DIC(4,DUZ(2),0),U),!
W ?15,"Visit POSTING Dates: "_APCDBDD_" and "_APCDEDD,!
S APCDLENG=$L($P(^VA(200,APCDPROV,0),U))+19
W ?(80-APCDLENG)/2,"Data Entry Operator: ",$P(^VA(200,APCDPROV,0),U),!
S APCDLENG=$S(APCDCLN]"":$L($P(^DIC(40.7,APCDCLN,0),U)),1:3)+9
W ?(80-APCDLENG)/2,"Clinic: ",$S(APCDCLN]"":$P(^DIC(40.7,APCDCLN,0),U),1:"ALL")
W !,"Total Visits Found: ",APCDVCNT I $G(APCDRSM)=1 W " Total Number of Random Visits Selected: ",APCDMAX
W !!?2,"HR#",?12,"Visit Date",?31,"ICD",?40,"ICD-9",?47,"Provider Narrative"
W !,APCD80D
Q
APCDFQAP ; 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))
DO HEAD
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 IF $Y>(IOSL-11)
DO HEAD
IF $DATA(APCDQUIT)
GOTO 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 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
POV ;
+1 SET APCDPOVC=0
SET APCDPOV=""
KILL APCDPOVA
FOR
SET APCDPOV=$ORDER(^AUPNVPOV("AD",APCDVDFN,APCDPOV))
IF APCDPOV=""
QUIT
IF $DATA(^AUPNVPOV(APCDPOV,0))
DO POV1
+2 DO WRT
+3 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-(APCDPOVC+5))
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
SET APCDPOVD=APCDPOVA(1)
WRITE ?31,$PIECE($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,2),?40,$$VAL^XBDIQ1(9000010.07,APCDPOVD,.24)
+10 SET APCDNQ=$$VAL^XBDIQ1(9000010.07,APCDPOVD,.04)
IF APCDNQ]""
WRITE ?47,$EXTRACT(APCDNQ,1,30),!?47,"[",$EXTRACT($PIECE($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,4),1,30),"]"
+11 DO POVW
+12 QUIT
POVW ;
+1 SET APCDPOVN=1
FOR
SET APCDPOVN=$ORDER(APCDPOVA(APCDPOVN))
IF APCDPOVN=""!($DATA(APCDQUIT))
QUIT
Begin DoDot:1
+2 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+3 SET APCDPOVD=APCDPOVA(APCDPOVN)
WRITE !?31,$PIECE($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,2),?40,$$VAL^XBDIQ1(9000010.07,APCDPOVD,.24)
SET APCDNQ=$$VAL^XBDIQ1(9000010.07,APCDPOVD,.04)
IF APCDNQ]""
WRITE ?47,$EXTRACT(APCDNQ,1,34)
+4 WRITE !?47,"[",$EXTRACT($PIECE($$ICDDX^ICDEX(+^AUPNVPOV(APCDPOVD,0),$$VD^APCLV(APCDVDFN)),U,4),1,30),"]"
End DoDot:1
+5 QUIT
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 ?32,APCDLHDR,?74,"Page ",APCDPG,!
+3 WRITE ?(80-$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))/2),$PIECE(^DIC(4,DUZ(2),0),U),!
+4 WRITE ?15,"Visit POSTING Dates: "_APCDBDD_" and "_APCDEDD,!
+5 SET APCDLENG=$LENGTH($PIECE(^VA(200,APCDPROV,0),U))+19
+6 WRITE ?(80-APCDLENG)/2,"Data Entry Operator: ",$PIECE(^VA(200,APCDPROV,0),U),!
+7 SET APCDLENG=$SELECT(APCDCLN]"":$LENGTH($PIECE(^DIC(40.7,APCDCLN,0),U)),1:3)+9
+8 WRITE ?(80-APCDLENG)/2,"Clinic: ",$SELECT(APCDCLN]"":$PIECE(^DIC(40.7,APCDCLN,0),U),1:"ALL")
+9 WRITE !,"Total Visits Found: ",APCDVCNT
IF $GET(APCDRSM)=1
WRITE " Total Number of Random Visits Selected: ",APCDMAX
+10 WRITE !!?2,"HR#",?12,"Visit Date",?31,"ICD",?40,"ICD-9",?47,"Provider Narrative"
+11 WRITE !,APCD80D
+12 QUIT
