- 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
