- 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
