- APCLFPRP ; IHS/CMI/LAB - cont. of top ten ;
- ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- ;
- ;cmi/anch/maw 9/10/2007 code set versioning in PPRC
- ;
- PRINT ;EP
- COVPAGE ;EP
- W:$D(IOF) @IOF
- W !?20,"********** FREQUENCY OF PROCEDURES REPORT **********"
- W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
- W !!,"The following report contains a ",$S(APCLPTVS="V":"PCC Visit",1:"Patient")," report based on the",!,"following criteria:",!
- SHOW ;
- W !,$S(APCLPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
- W:APCLTYPE="D" !!?6,"Encounter Date range: ",APCLBDD," to ",APCLEDD,!
- W:APCLTYPE="S" !!?6,"Search Template: ",$P(^DIBT(APCLSEAT,0),U),!
- I '$D(^APCLVRPT(APCLRPT,11)) W !!,"ALL VISITS IN DATE RANGE SELECTED." G COUNT
- S APCLI=0 F S APCLI=$O(^APCLVRPT(APCLRPT,11,APCLI)) Q:APCLI'=+APCLI D
- .I $Y>(IOSL-5) D PAUSE^APCLVL01 W @IOF
- .W !?6,$P(^APCLVSTS(APCLI,0),U),": "
- .K APCLQ S APCLY="",C=0 K APCLQ F S APCLY=$O(^APCLVRPT(APCLRPT,11,APCLI,11,"B",APCLY)) S C=C+1 W:C'=1&(APCLY'="") " ; " Q:APCLY=""!($D(APCLQ)) S X=APCLY X:$D(^APCLVSTS(APCLI,2)) ^(2) W X
- K APCLQ
- COUNT ;if COUNTING entries only
- I $Y>(IOSL-5) D PAUSE^APCLVL01 W:$D(IOF) @IOF
- W:$D(APCLVTOT) !!!,"Total COUNT of ",$S(APCLPTVS="P":"Patients",1:"Visits"),": ",APCLVTOT
- D PAUSE^APCLVL01
- W:$D(IOF) @IOF
- W !?20,"********** FREQUENCY OF PROCEDURES REPORT **********"
- PPRC I $E(IOST)="C",IO=IO(0),$Y>(IOSL-4) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
- I $Y>(IOSL-4) W:$D(IOF) @IOF
- S %="^XTMP(""APCLFPR"",APCLJOB,APCLBT,",APCLA=%_"""PRC"",APCLPRC)",APCLF=%_"3)"
- W !!,"No. VISITs: ",APCLVTOT,?20,"No. PRCs: ",APCLTOT,?40,"PRC/VISIT ratio: ",$S(APCLVTOT>0:$J((APCLTOT/APCLVTOT),1,2),1:0)," (min. std. > 1.6)" S APCLLINO=APCLLINO+2
- W !!!,"TOP ",APCLLNO," PRC's =>" S APCLLINO=APCLLINO+3
- ;F I=1:1 Q:'$D(@APCLF@(I)) S APCLPRC=@APCLF@(I) W !?3,I,".",?7,$P(^ICD0(APCLPRC,0),U),?15,$P(^ICD0(APCLPRC,0),U,4)," (",@APCLA,")" S APCLLINO=APCLLINO+1 I $Y>(IOSL-8) D FF I $D(X),X=U G PEXIT ;cmi/anch/maw 9/12/2007 orig line
- F I=1:1 Q:'$D(@APCLF@(I)) S APCLPRC=@APCLF@(I) W !?3,I,".",?7,$P($$ICDOP^ICDEX(APCLPRC,,,"I"),U,2),?15,$P($$ICDOP^ICDEX(APCLPRC,,,"I"),U,5)," (",@APCLA,")" S APCLLINO=APCLLINO+1 I $Y>(IOSL-8) D FF I $D(X),X=U G PEXIT
- F %=1:1:2 W ! S APCLLINO=APCLLINO+1 I $Y>(IOSL-5) D FF I $D(X),X=U G PEXIT
- PEXIT ;
- D DONE^APCLOSUT
- K ^XTMP("APCLFPR",APCLJOB,APCLBT) Q
- FF I IOST["P-" W:$D(IOF) @IOF Q
- I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S X="^"
- W:$D(IOF) @IOF
- Q
- ;
- APCLFPRP ; IHS/CMI/LAB - cont. of top ten ;
- +1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- +2 ;
- +3 ;cmi/anch/maw 9/10/2007 code set versioning in PPRC
- +4 ;
- PRINT ;EP
- COVPAGE ;EP
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !?20,"********** FREQUENCY OF PROCEDURES REPORT **********"
- +3 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
- +4 WRITE !!,"The following report contains a ",$SELECT(APCLPTVS="V":"PCC Visit",1:"Patient")," report based on the",!,"following criteria:",!
- SHOW ;
- +1 WRITE !,$SELECT(APCLPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
- +2 IF APCLTYPE="D"
- WRITE !!?6,"Encounter Date range: ",APCLBDD," to ",APCLEDD,!
- +3 IF APCLTYPE="S"
- WRITE !!?6,"Search Template: ",$PIECE(^DIBT(APCLSEAT,0),U),!
- +4 IF '$DATA(^APCLVRPT(APCLRPT,11))
- WRITE !!,"ALL VISITS IN DATE RANGE SELECTED."
- GOTO COUNT
- +5 SET APCLI=0
- FOR
- SET APCLI=$ORDER(^APCLVRPT(APCLRPT,11,APCLI))
- IF APCLI'=+APCLI
- QUIT
- Begin DoDot:1
- +6 IF $Y>(IOSL-5)
- DO PAUSE^APCLVL01
- WRITE @IOF
- +7 WRITE !?6,$PIECE(^APCLVSTS(APCLI,0),U),": "
- +8 KILL APCLQ
- SET APCLY=""
- SET C=0
- KILL APCLQ
- FOR
- SET APCLY=$ORDER(^APCLVRPT(APCLRPT,11,APCLI,11,"B",APCLY))
- SET C=C+1
- IF C'=1&(APCLY'="")
- WRITE " ; "
- IF APCLY=""!($DATA(APCLQ))
- QUIT
- SET X=APCLY
- IF $DATA(^APCLVSTS(APCLI,2))
- XECUTE ^(2)
- WRITE X
- End DoDot:1
- +9 KILL APCLQ
- COUNT ;if COUNTING entries only
- +1 IF $Y>(IOSL-5)
- DO PAUSE^APCLVL01
- IF $DATA(IOF)
- WRITE @IOF
- +2 IF $DATA(APCLVTOT)
- WRITE !!!,"Total COUNT of ",$SELECT(APCLPTVS="P":"Patients",1:"Visits"),": ",APCLVTOT
- +3 DO PAUSE^APCLVL01
- +4 IF $DATA(IOF)
- WRITE @IOF
- +5 WRITE !?20,"********** FREQUENCY OF PROCEDURES REPORT **********"
- PPRC IF $EXTRACT(IOST)="C"
- IF IO=IO(0)
- IF $Y>(IOSL-4)
- WRITE !
- SET DIR(0)="EO"
- DO ^DIR
- KILL DIR
- IF Y=0!(Y="^")!($DATA(DTOUT))
- SET APCLQUIT=""
- QUIT
- +1 IF $Y>(IOSL-4)
- IF $DATA(IOF)
- WRITE @IOF
- +2 SET %="^XTMP(""APCLFPR"",APCLJOB,APCLBT,"
- SET APCLA=%_"""PRC"",APCLPRC)"
- SET APCLF=%_"3)"
- +3 WRITE !!,"No. VISITs: ",APCLVTOT,?20,"No. PRCs: ",APCLTOT,?40,"PRC/VISIT ratio: ",$SELECT(APCLVTOT>0:$JUSTIFY((APCLTOT/APCLVTOT),1,2),1:0)," (min. std. > 1.6)"
- SET APCLLINO=APCLLINO+2
- +4 WRITE !!!,"TOP ",APCLLNO," PRC's =>"
- SET APCLLINO=APCLLINO+3
- +5 ;F I=1:1 Q:'$D(@APCLF@(I)) S APCLPRC=@APCLF@(I) W !?3,I,".",?7,$P(^ICD0(APCLPRC,0),U),?15,$P(^ICD0(APCLPRC,0),U,4)," (",@APCLA,")" S APCLLINO=APCLLINO+1 I $Y>(IOSL-8) D FF I $D(X),X=U G PEXIT ;cmi/anch/maw 9/12/2007 orig line
- +6 FOR I=1:1
- IF '$DATA(@APCLF@(I))
- QUIT
- SET APCLPRC=@APCLF@(I)
- WRITE !?3,I,".",?7,$PIECE($$ICDOP^ICDEX(APCLPRC,,,"I"),U,2),?15,$PIECE($$ICDOP^ICDEX(APCLPRC,,,"I"),U,5)," (",@APCLA,")"
- SET APCLLINO=APCLLINO+1
- IF $Y>(IOSL-8)
- DO FF
- IF $DATA(X)
- IF X=U
- GOTO PEXIT
- +7 FOR %=1:1:2
- WRITE !
- SET APCLLINO=APCLLINO+1
- IF $Y>(IOSL-5)
- DO FF
- IF $DATA(X)
- IF X=U
- GOTO PEXIT
- PEXIT ;
- +1 DO DONE^APCLOSUT
- +2 KILL ^XTMP("APCLFPR",APCLJOB,APCLBT)
- QUIT
- FF IF IOST["P-"
- IF $DATA(IOF)
- WRITE @IOF
- QUIT
- +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 X="^"
- +2 IF $DATA(IOF)
- WRITE @IOF
- +3 QUIT
- +4 ;
