APCDFOAP ; 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
I APCDMAX=0 S APCDPG=0 D HEAD W !,"No Visits to report!",! G DONE
S APCDGOT=APCDVCNT/APCDMAX S APCDGOT=$J(APCDGOT,$L($P(APCDGOT,".")),0)
S APCDPG=0 D HEAD I '$D(^XTMP("APCDFOA",APCDJOB,APCDBT)) W !,"No visits to report",! G DONE
K APCDQUIT
S APCDVDFN="" F APCDX=1:APCDGOT:APCDVCNT S APCDVDFN=$O(^XTMP("APCDFOA",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-6) D HEAD G:$D(APCDQUIT) DONE
DONE ;
I '$D(APCDQUIT),$E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
W:$D(IOF) @IOF
Q
POV ;
S APCDPOVC=0,APCDPOV="" K APCDPOVA F S APCDPOV=$O(^AUPNVPRC("AD",APCDVDFN,APCDPOV)) Q:APCDPOV="" I $D(^AUPNVPRC(APCDPOV,0)) D POV1
D WRT
Q
POV1 ;
I $D(^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV","ALL")) S APCDPOVC=APCDPOVC+1,APCDPOVA(APCDPOVC)=APCDPOV Q
I $D(^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV","ICDDFN",$P(^AUPNVPRC(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")
;W !!,APCDHRN,?9,APCDDATE S APCDPOVD=APCDPOVA(1) W ?30,$P(^ICD0(+^AUPNVPRC(APCDPOVD,0),0),U)
W !!,APCDHRN,?8,APCDDATE S APCDPOVD=APCDPOVA(1) W ?27,$P($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),,,"I"),U,2),?36,$$VAL^XBDIQ1(9000010.08,APCDPOVD,.22)
;S APCDNQ=$P(^AUPNVPRC(APCDPOVD,0),U,4) W:APCDNQ]"" ?40,$E($P(^AUTNPOV(APCDNQ,0),U),1,43),!?40,"[",$E($P(^ICD0(+^AUPNVPRC(APCDPOVD,0),0),U,4),1,38),"]"
S APCDNQ=$P(^AUPNVPRC(APCDPOVD,0),U,4) W:APCDNQ]"" ?43,$E($P(^AUTNPOV(APCDNQ,0),U),1,33),!?43,"[",$E($P($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),$$VD^APCLV(APCDVDFN),,"I"),U,5),1,33),"]"
D POVW
Q
POVW ;
S APCDPOVN=1 F S APCDPOVN=$O(APCDPOVA(APCDPOVN)) Q:APCDPOVN="" D
.S APCDPOVD=APCDPOVA(APCDPOVN) W !?27,$P($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),,,"I"),U,2),?36,$$VAL^XBDIQ1(9000010.08,APCDPOVD,.22) S APCDNQ=$P(^AUPNVPRC(APCDPOVD,0),U,4) W:APCDNQ]"" ?43,$E($P(^AUTNPOV(APCDNQ,0),U),1,33)
.W !?43,"[",$E($P($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),,,"I"),U,5),1,33),"]"
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 ?25,APCDLHDR,?72,"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 !!?27,"ICD O/P",?36,"ICD-9",?43,"Provider Narrative"
W !?2,"HR#",?9,"Visit Date",?27,"Code",?36,"Code",?43,"[ICD O/P NARRATIVE]"
W !,APCD80D
Q
APCDFOAP ; 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 IF APCDMAX=0
SET APCDPG=0
DO HEAD
WRITE !,"No Visits to report!",!
GOTO DONE
+6 SET APCDGOT=APCDVCNT/APCDMAX
SET APCDGOT=$JUSTIFY(APCDGOT,$LENGTH($PIECE(APCDGOT,".")),0)
+7 SET APCDPG=0
DO HEAD
IF '$DATA(^XTMP("APCDFOA",APCDJOB,APCDBT))
WRITE !,"No visits to report",!
GOTO DONE
+8 KILL APCDQUIT
+9 SET APCDVDFN=""
FOR APCDX=1:APCDGOT:APCDVCNT
SET APCDVDFN=$ORDER(^XTMP("APCDFOA",APCDJOB,APCDBT,"DEQAV",APCDX,""))
IF APCDVDFN=""!($DATA(APCDQUIT))
QUIT
IF $DATA(^AUPNVSIT(APCDVDFN,0))
SET APCDVREC=^(0)
DO POV
+10 IF $DATA(APCDQUIT)
GOTO DONE
+11 IF $Y>(IOSL-6)
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 IF $DATA(IOF)
WRITE @IOF
+3 QUIT
POV ;
+1 SET APCDPOVC=0
SET APCDPOV=""
KILL APCDPOVA
FOR
SET APCDPOV=$ORDER(^AUPNVPRC("AD",APCDVDFN,APCDPOV))
IF APCDPOV=""
QUIT
IF $DATA(^AUPNVPRC(APCDPOV,0))
DO POV1
+2 DO WRT
+3 QUIT
POV1 ;
+1 IF $DATA(^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV","ALL"))
SET APCDPOVC=APCDPOVC+1
SET APCDPOVA(APCDPOVC)=APCDPOV
QUIT
+2 IF $DATA(^XTMP("APCDFOA",APCDJOB,APCDBT,"DEPOV","ICDDFN",$PIECE(^AUPNVPRC(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 SET APCDHRN=$SELECT($DATA(^AUPNPAT(APCDPAT,41,DUZ(2),0)):$PIECE(^AUPNPAT(APCDPAT,41,DUZ(2),0),U,2),1:"NONE")
+5 ;W !!,APCDHRN,?9,APCDDATE S APCDPOVD=APCDPOVA(1) W ?30,$P(^ICD0(+^AUPNVPRC(APCDPOVD,0),0),U)
+6 WRITE !!,APCDHRN,?8,APCDDATE
SET APCDPOVD=APCDPOVA(1)
WRITE ?27,$PIECE($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),,,"I"),U,2),?36,$$VAL^XBDIQ1(9000010.08,APCDPOVD,.22)
+7 ;S APCDNQ=$P(^AUPNVPRC(APCDPOVD,0),U,4) W:APCDNQ]"" ?40,$E($P(^AUTNPOV(APCDNQ,0),U),1,43),!?40,"[",$E($P(^ICD0(+^AUPNVPRC(APCDPOVD,0),0),U,4),1,38),"]"
+8 SET APCDNQ=$PIECE(^AUPNVPRC(APCDPOVD,0),U,4)
IF APCDNQ]""
WRITE ?43,$EXTRACT($PIECE(^AUTNPOV(APCDNQ,0),U),1,33),!?43,"[",$EXTRACT($PIECE($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),$$VD^APCLV(APCDVDFN),,"I"),U,5),1,33),"]"
+9 DO POVW
+10 QUIT
POVW ;
+1 SET APCDPOVN=1
FOR
SET APCDPOVN=$ORDER(APCDPOVA(APCDPOVN))
IF APCDPOVN=""
QUIT
Begin DoDot:1
+2 SET APCDPOVD=APCDPOVA(APCDPOVN)
WRITE !?27,$PIECE($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),,,"I"),U,2),?36,$$VAL^XBDIQ1(9000010.08,APCDPOVD,.22)
SET APCDNQ=$PIECE(^AUPNVPRC(APCDPOVD,0),U,4)
IF APCDNQ]""
WRITE ?43,$EXTRACT($PIECE(^AUTNPOV(APCDNQ,0),U),1,33)
+3 WRITE !?43,"[",$EXTRACT($PIECE($$ICDOP^ICDEX(+^AUPNVPRC(APCDPOVD,0),,,"I"),U,5),1,33),"]"
End DoDot:1
+4 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 ?25,APCDLHDR,?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,"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 !!?27,"ICD O/P",?36,"ICD-9",?43,"Provider Narrative"
+11 WRITE !?2,"HR#",?9,"Visit Date",?27,"Code",?36,"Code",?43,"[ICD O/P NARRATIVE]"
+12 WRITE !,APCD80D
+13 QUIT
