BMCFREQP ; IHS/PHXAO/TMJ - cont. of top ten ;
;;4.0;REFERRED CARE INFO SYSTEM;**3**;JAN 09, 2006;Build 101
;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
;
;
;
PRINT ;EP
COVPAGE ;EP
W:$D(IOF) @IOF
W !?20,"********** FREQUENCY OF RCIS PROCEDURES REPORT **********"
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
W !!,"The following report contains a ",$S(BMCPTVS="V":"PCC Visit",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
W !,$S(BMCPTVS="P":"PATIENT",1:"REFERRAL")," Selection Criteria"
W:BMCTYPE="D" !!?6,"Encounter Date range: ",BMCBDD," to ",BMCEDD,!
W:BMCTYPE="S" !!?6,"Search Template: ",$P(^DIBT(BMCSEAT,0),U),!
I '$D(^BMCRTMP(BMCRPT,11)) W !!,"ALL REFERRALS IN DATE RANGE SELECTED." G COUNT
S BMCI=0 F S BMCI=$O(^BMCRTMP(BMCRPT,11,BMCI)) Q:BMCI'=+BMCI D
.I $Y>(IOSL-5) D PAUSE^BMCRL01 W @IOF
.W !?6,$P(^BMCTSORT(BMCI,0),U),": "
.K BMCQ S BMCY="",C=0 K BMCQ F S BMCY=$O(^BMCRTMP(BMCRPT,11,BMCI,11,"B",BMCY)) S C=C+1 W:C'=1&(BMCY'="") " ; " Q:BMCY=""!($D(BMCQ)) S X=BMCY X:$D(^BMCTSORT(BMCI,2)) ^(2) W X
K BMCQ
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^BMCRL01 W:$D(IOF) @IOF
W:$D(BMCVTOT) !!!,"Total COUNT of ",$S(BMCPTVS="P":"Patients",1:"Referrals"),": ",BMCVTOT
D PAUSE^BMCRL01
W:$D(IOF) @IOF
W !?20,"********** FREQUENCY OF RCIS 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 BMCQUIT="" Q
I $Y>(IOSL-4) W:$D(IOF) @IOF
S %="^XTMP(""BMCFPR"",BMCJOB,BMCBT,",BMCA=%_"""PRC"",BMCPRC)",BMCF=%_"3)"
W !!,"No. REFERRALs: ",BMCVTOT,?20,"No. PRCs: ",BMCTOT,?40,"PRC/REFERRAL ratio: ",$S(BMCVTOT>0:$J((BMCTOT/BMCVTOT),1,2),1:0)," (min. std. > 1.6)" S BMCLINO=BMCLINO+2
W !!!,"TOP ",BMCLNO," PRC's =>" S BMCLINO=BMCLINO+3
;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
;F I=1:1 Q:'$D(@BMCF@(I)) S BMCPRC=@BMCF@(I) W !?3,I,".",?7,$P(^ICPT(BMCPRC,0),U),?15,$P(^ICPT(BMCPRC,0),U,2)," (",@BMCA,")" S BMCLINO=BMCLINO+1 I $Y>(IOSL-8) D FF I $D(X),X=U G PEXIT
F I=1:1 Q:'$D(@BMCF@(I)) S BMCPRC=@BMCF@(I) W !?3,I,".",?7,$P($$CPT^ICPTCOD(BMCPRC,0),U,2),?15,$P($$CPT^ICPTCOD(BMCPRC,0),U,3)," (",@BMCA,")" S BMCLINO=BMCLINO+1 I $Y>(IOSL-8) D FF I $D(X),X=U G PEXIT
F %=1:1:2 W ! S BMCLINO=BMCLINO+1 I $Y>(IOSL-5) D FF I $D(X),X=U G PEXIT
PEXIT ;
D DONE^BMCOSUT
K ^XTMP("BMCFPR",BMCJOB,BMCBT) 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
;
BMCFREQP ; IHS/PHXAO/TMJ - cont. of top ten ;
+1 ;;4.0;REFERRED CARE INFO SYSTEM;**3**;JAN 09, 2006;Build 101
+2 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
+3 ;
+4 ;
+5 ;
PRINT ;EP
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?20,"********** FREQUENCY OF RCIS PROCEDURES REPORT **********"
+3 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
+4 WRITE !!,"The following report contains a ",$SELECT(BMCPTVS="V":"PCC Visit",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
+1 WRITE !,$SELECT(BMCPTVS="P":"PATIENT",1:"REFERRAL")," Selection Criteria"
+2 IF BMCTYPE="D"
WRITE !!?6,"Encounter Date range: ",BMCBDD," to ",BMCEDD,!
+3 IF BMCTYPE="S"
WRITE !!?6,"Search Template: ",$PIECE(^DIBT(BMCSEAT,0),U),!
+4 IF '$DATA(^BMCRTMP(BMCRPT,11))
WRITE !!,"ALL REFERRALS IN DATE RANGE SELECTED."
GOTO COUNT
+5 SET BMCI=0
FOR
SET BMCI=$ORDER(^BMCRTMP(BMCRPT,11,BMCI))
IF BMCI'=+BMCI
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-5)
DO PAUSE^BMCRL01
WRITE @IOF
+7 WRITE !?6,$PIECE(^BMCTSORT(BMCI,0),U),": "
+8 KILL BMCQ
SET BMCY=""
SET C=0
KILL BMCQ
FOR
SET BMCY=$ORDER(^BMCRTMP(BMCRPT,11,BMCI,11,"B",BMCY))
SET C=C+1
IF C'=1&(BMCY'="")
WRITE " ; "
IF BMCY=""!($DATA(BMCQ))
QUIT
SET X=BMCY
IF $DATA(^BMCTSORT(BMCI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
+9 KILL BMCQ
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^BMCRL01
IF $DATA(IOF)
WRITE @IOF
+2 IF $DATA(BMCVTOT)
WRITE !!!,"Total COUNT of ",$SELECT(BMCPTVS="P":"Patients",1:"Referrals"),": ",BMCVTOT
+3 DO PAUSE^BMCRL01
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !?20,"********** FREQUENCY OF RCIS 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 BMCQUIT=""
QUIT
+1 IF $Y>(IOSL-4)
IF $DATA(IOF)
WRITE @IOF
+2 SET %="^XTMP(""BMCFPR"",BMCJOB,BMCBT,"
SET BMCA=%_"""PRC"",BMCPRC)"
SET BMCF=%_"3)"
+3 WRITE !!,"No. REFERRALs: ",BMCVTOT,?20,"No. PRCs: ",BMCTOT,?40,"PRC/REFERRAL ratio: ",$SELECT(BMCVTOT>0:$JUSTIFY((BMCTOT/BMCVTOT),1,2),1:0)," (min. std. > 1.6)"
SET BMCLINO=BMCLINO+2
+4 WRITE !!!,"TOP ",BMCLNO," PRC's =>"
SET BMCLINO=BMCLINO+3
+5 ;4.0*3 10.30.2007 IHS/OIT/FCJ ADDED CSV CHANGES
+6 ;F I=1:1 Q:'$D(@BMCF@(I)) S BMCPRC=@BMCF@(I) W !?3,I,".",?7,$P(^ICPT(BMCPRC,0),U),?15,$P(^ICPT(BMCPRC,0),U,2)," (",@BMCA,")" S BMCLINO=BMCLINO+1 I $Y>(IOSL-8) D FF I $D(X),X=U G PEXIT
+7 FOR I=1:1
IF '$DATA(@BMCF@(I))
QUIT
SET BMCPRC=@BMCF@(I)
WRITE !?3,I,".",?7,$PIECE($$CPT^ICPTCOD(BMCPRC,0),U,2),?15,$PIECE($$CPT^ICPTCOD(BMCPRC,0),U,3)," (",@BMCA,")"
SET BMCLINO=BMCLINO+1
IF $Y>(IOSL-8)
DO FF
IF $DATA(X)
IF X=U
GOTO PEXIT
+8 FOR %=1:1:2
WRITE !
SET BMCLINO=BMCLINO+1
IF $Y>(IOSL-5)
DO FF
IF $DATA(X)
IF X=U
GOTO PEXIT
PEXIT ;
+1 DO DONE^BMCOSUT
+2 KILL ^XTMP("BMCFPR",BMCJOB,BMCBT)
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 ;
