APCDFCP ; IHS/CMI/LAB - print apc report by prov disc ;
;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
;
START ;
K APCDSUM
S APCD80S="-------------------------------------------------------------------------------",APCDPG=0
S Y=APCDBD D DD^%DT S APCDBDD=Y S Y=APCDED D DD^%DT S APCDEDD=Y
S (APCDTOT,APCDPROV,APCDTDES)=0
K APCDQUIT
I '$D(^XTMP("APCDFC",$J)) S APCDPROV="NONE TO REPORT" D HEAD G DONE
F S APCDPROV=$O(^XTMP("APCDFC",$J,APCDPROV)) Q:APCDPROV=""!($D(APCDQUIT)) D HEAD Q:$D(APCDQUIT) D SORT
G:$D(APCDQUIT) DONE
I $Y>(IOSL-5) D HEAD G:$D(APCDQUIT) DONE
W !?42,"------",?52,"-------",?65,"------",!
W ?5,"Grand Total for ALL Operators:",?42,$J(APCDTOT,6),?52,$J(APCDTDES,7) S APCDAVG=APCDTDES/APCDTOT W ?65,$J(APCDAVG,6,1)
D SUMMPAGE
DONE I $D(APCDET) S APCDTS=(86400*($P(APCDET,",")-$P(APCDBT,",")))+($P(APCDET,",",2)-$P(APCDBT,",",2)),APCDH=$P(APCDTS/3600,".") S:APCDH="" APCDH=0
S APCDTS=APCDTS-(APCDH*3600),APCDM=$P(APCDTS/60,".") S:APCDM="" APCDM=0 S APCDTS=APCDTS-(APCDM*60),APCDS=APCDTS W !!,"RUN TIME (H.M.S): ",APCDH,".",APCDM,".",APCDS
I $E(IOST)="C",IO=IO(0) S DIR(0)="E" D ^DIR K DIR
W:$D(IOF) @IOF
Q
SORT ;
S (APCDSUB,APCDDESU)=0,APCDFC("DAYS",APCDPROV)=0
S APCDSORT="" F S APCDSORT=$O(^XTMP("APCDFC",$J,APCDPROV,APCDSORT)) Q:APCDSORT=""!($D(APCDQUIT)) D SORT1
W !?42,"------",?52,"-------",?65,"------",!
W ?5,"Totals for ",APCDPROV,?42,$J(APCDSUB,6),?52,$J(APCDDESU,7) W:APCDSUB ?65,$J((APCDDESU/APCDSUB),6,1)
S APCDFC("FORMS",APCDPROV)=APCDSUB
S APCDFC("AVG DEC",APCDPROV)=$J((APCDDESU/APCDSUB),6,1)
Q
SORT1 ;
I $Y>(IOSL-6) D HEAD Q:$D(APCDQUIT)
W !,$S(APCDSRT]"":APCDSORT,1:"")
S APCDDATE=0 F S APCDDATE=$O(^XTMP("APCDFC",$J,APCDPROV,APCDSORT,APCDDATE)) Q:APCDDATE'=+APCDDATE!($D(APCDQUIT)) D WRITE
Q
;
WRITE ;
S APCDSUM(APCDPROV,"#DAYS")=$G(APCDSUM(APCDPROV,"#DAYS"))+1
S Y=APCDDATE D DD^%DT S APCDWDAT=Y
I $Y>(IOSL-5) D HEAD Q:$D(APCDQUIT)
S APCDVDES=^XTMP("APCDFC",$J,APCDPROV,APCDSORT,"DEP COUNT",APCDDATE),APCDAVG=(APCDVDES/^XTMP("APCDFC",$J,APCDPROV,APCDSORT,APCDDATE))\1
S APCDSUM(APCDPROV,"#DEC")=$G(APCDSUM(APCDPROV,"#DEC"))+APCDVDES
W !?25,APCDWDAT,?42,$J(^XTMP("APCDFC",$J,APCDPROV,APCDSORT,APCDDATE),6),?52,$J(APCDVDES,7),?65,$J(APCDAVG,6)
S APCDSUM(APCDPROV,"#FORMS")=$G(APCDSUM(APCDPROV,"#FORMS"))+^XTMP("APCDFC",$J,APCDPROV,APCDSORT,APCDDATE)
I APCDSUBV D
. W !?27,"Visit Dates Processed:"
. S APCDVDAT=0 F S APCDVDAT=$O(^XTMP("APCDFC",$J,APCDPROV,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT)) Q:APCDVDAT'=+APCDVDAT!($D(APCDQUIT)) D
.. I $Y>(IOSL-5) D HEAD Q:$D(APCDQUIT)
.. W !?27,$$FMTE^XLFDT(APCDVDAT),?42,$J(^XTMP("APCDFC",$J,APCDPROV,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT),6)
.. Q
Q:$D(APCDQUIT)
S APCDSUB=APCDSUB+^XTMP("APCDFC",$J,APCDPROV,APCDSORT,APCDDATE),APCDTOT=APCDTOT+^XTMP("APCDFC",$J,APCDPROV,APCDSORT,APCDDATE),APCDDESU=APCDDESU+APCDVDES,APCDTDES=APCDTDES+APCDVDES
S APCDFC("DAYS",APCDPROV)=APCDFC("DAYS",APCDPROV)+1
Q
SUMMPAGE ;
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
W:$D(IOF) @IOF S APCDPG=APCDPG+1
W !?55,$$FMTE^XLFDT(DT),?70,"Page ",APCDPG
W !?20,"SUMMARY OF FORMS KEYED BY ALL OPERATORS"
W !?15,"VISIT POSTING DATES: ",APCDBDD," TO ",APCDEDD,!
W ?22,"# days",?29,"# of",?36,"%",?45,"Avg #",?56,"Avg # dep",?68,"Avg # dep"
W !?5,"Operator",?22,"of D/E",?29,"forms",?36,"workload",?45,"forms/day",?56,"ent/day",?68,"ent/form"
W !,APCD80S
;S X="" F S X=$O(APCDFC("FORMS",X)) Q:X="" W !,X,?32,$J(APCDFC("FORMS",X),8),?40,$J((APCDFC("FORMS",X)/APCDFC("DAYS",X)),8,1),?51,$J(((APCDFC("FORMS",X)/APCDTOT)*100),8,1),?67,APCDFC("AVG DEC",X)
S X=0 F S X=$O(APCDSUM(X)) Q:X="" W !,$E(X,1,20),?22,$J(APCDSUM(X,"#DAYS"),6),?29,$J(APCDSUM(X,"#FORMS"),6),?36,$J(((APCDSUM(X,"#FORMS")/APCDTOT)*100),8,1) D
.W ?45,$J((APCDSUM(X,"#FORMS")/APCDSUM(X,"#DAYS")),8,1)
.W ?56,$J((APCDSUM(X,"#DEC")/APCDSUM(X,"#DAYS")),8,1)
.W ?67,$J((APCDSUM(X,"#DEC")/APCDSUM(X,"#FORMS")),8,1)
W !?29,"--------",!?27,$J(APCDTOT,8)
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 @IOF S APCDPG=APCDPG+1
W !?55,$$FMTE^XLFDT(DT),?70,"Page ",APCDPG,!
S APCDLENG=$L($P(^DIC(4,DUZ(2),0),U))
W ?((80-APCDLENG)/2),$P(^DIC(4,DUZ(2),0),U),!
S APCDLENG=37+$L(APCDSRT)
I APCDSRT]"" W ?((80-APCDLENG)/2),"NUMBER OF FORMS KEYED SUBTOTALED BY ",APCDSRT,!
I APCDSRT="" W ?29,"NUMBER OF FORMS KEYED",!
S APCDLENG=21+$L(APCDPROV)
W ?((80-APCDLENG)/2),"DATE ENTRY OPERATOR: ",APCDPROV,!
W ?15,"VISIT POSTING DATES: ",APCDBDD," TO ",APCDEDD,!
W !,APCDSRT,?25,"POSTING DATE",?40,"# FORMS",?50,"# DEP ENT",?63,"AVG # DEP ENT",!
W APCD80S,!
Q
APCDFCP ; IHS/CMI/LAB - print apc report by prov disc ;
+1 ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
+2 ;
START ;
+1 KILL APCDSUM
+2 SET APCD80S="-------------------------------------------------------------------------------"
SET APCDPG=0
+3 SET Y=APCDBD
DO DD^%DT
SET APCDBDD=Y
SET Y=APCDED
DO DD^%DT
SET APCDEDD=Y
+4 SET (APCDTOT,APCDPROV,APCDTDES)=0
+5 KILL APCDQUIT
+6 IF '$DATA(^XTMP("APCDFC",$JOB))
SET APCDPROV="NONE TO REPORT"
DO HEAD
GOTO DONE
+7 FOR
SET APCDPROV=$ORDER(^XTMP("APCDFC",$JOB,APCDPROV))
IF APCDPROV=""!($DATA(APCDQUIT))
QUIT
DO HEAD
IF $DATA(APCDQUIT)
QUIT
DO SORT
+8 IF $DATA(APCDQUIT)
GOTO DONE
+9 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCDQUIT)
GOTO DONE
+10 WRITE !?42,"------",?52,"-------",?65,"------",!
+11 WRITE ?5,"Grand Total for ALL Operators:",?42,$JUSTIFY(APCDTOT,6),?52,$JUSTIFY(APCDTDES,7)
SET APCDAVG=APCDTDES/APCDTOT
WRITE ?65,$JUSTIFY(APCDAVG,6,1)
+12 DO SUMMPAGE
DONE IF $DATA(APCDET)
SET APCDTS=(86400*($PIECE(APCDET,",")-$PIECE(APCDBT,",")))+($PIECE(APCDET,",",2)-$PIECE(APCDBT,",",2))
SET APCDH=$PIECE(APCDTS/3600,".")
IF APCDH=""
SET APCDH=0
+1 SET APCDTS=APCDTS-(APCDH*3600)
SET APCDM=$PIECE(APCDTS/60,".")
IF APCDM=""
SET APCDM=0
SET APCDTS=APCDTS-(APCDM*60)
SET APCDS=APCDTS
WRITE !!,"RUN TIME (H.M.S): ",APCDH,".",APCDM,".",APCDS
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 IF $DATA(IOF)
WRITE @IOF
+4 QUIT
SORT ;
+1 SET (APCDSUB,APCDDESU)=0
SET APCDFC("DAYS",APCDPROV)=0
+2 SET APCDSORT=""
FOR
SET APCDSORT=$ORDER(^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT))
IF APCDSORT=""!($DATA(APCDQUIT))
QUIT
DO SORT1
+3 WRITE !?42,"------",?52,"-------",?65,"------",!
+4 WRITE ?5,"Totals for ",APCDPROV,?42,$JUSTIFY(APCDSUB,6),?52,$JUSTIFY(APCDDESU,7)
IF APCDSUB
WRITE ?65,$JUSTIFY((APCDDESU/APCDSUB),6,1)
+5 SET APCDFC("FORMS",APCDPROV)=APCDSUB
+6 SET APCDFC("AVG DEC",APCDPROV)=$JUSTIFY((APCDDESU/APCDSUB),6,1)
+7 QUIT
SORT1 ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+2 WRITE !,$SELECT(APCDSRT]"":APCDSORT,1:"")
+3 SET APCDDATE=0
FOR
SET APCDDATE=$ORDER(^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,APCDDATE))
IF APCDDATE'=+APCDDATE!($DATA(APCDQUIT))
QUIT
DO WRITE
+4 QUIT
+5 ;
WRITE ;
+1 SET APCDSUM(APCDPROV,"#DAYS")=$GET(APCDSUM(APCDPROV,"#DAYS"))+1
+2 SET Y=APCDDATE
DO DD^%DT
SET APCDWDAT=Y
+3 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+4 SET APCDVDES=^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,"DEP COUNT",APCDDATE)
SET APCDAVG=(APCDVDES/^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,APCDDATE))\1
+5 SET APCDSUM(APCDPROV,"#DEC")=$GET(APCDSUM(APCDPROV,"#DEC"))+APCDVDES
+6 WRITE !?25,APCDWDAT,?42,$JUSTIFY(^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,APCDDATE),6),?52,$JUSTIFY(APCDVDES,7),?65,$JUSTIFY(APCDAVG,6)
+7 SET APCDSUM(APCDPROV,"#FORMS")=$GET(APCDSUM(APCDPROV,"#FORMS"))+^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,APCDDATE)
+8 IF APCDSUBV
Begin DoDot:1
+9 WRITE !?27,"Visit Dates Processed:"
+10 SET APCDVDAT=0
FOR
SET APCDVDAT=$ORDER(^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT))
IF APCDVDAT'=+APCDVDAT!($DATA(APCDQUIT))
QUIT
Begin DoDot:2
+11 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCDQUIT)
QUIT
+12 WRITE !?27,$$FMTE^XLFDT(APCDVDAT),?42,$JUSTIFY(^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT),6)
+13 QUIT
End DoDot:2
End DoDot:1
+14 IF $DATA(APCDQUIT)
QUIT
+15 SET APCDSUB=APCDSUB+^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,APCDDATE)
SET APCDTOT=APCDTOT+^XTMP("APCDFC",$JOB,APCDPROV,APCDSORT,APCDDATE)
SET APCDDESU=APCDDESU+APCDVDES
SET APCDTDES=APCDTDES+APCDVDES
+16 SET APCDFC("DAYS",APCDPROV)=APCDFC("DAYS",APCDPROV)+1
+17 QUIT
SUMMPAGE ;
+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
+2 IF $DATA(IOF)
WRITE @IOF
SET APCDPG=APCDPG+1
+3 WRITE !?55,$$FMTE^XLFDT(DT),?70,"Page ",APCDPG
+4 WRITE !?20,"SUMMARY OF FORMS KEYED BY ALL OPERATORS"
+5 WRITE !?15,"VISIT POSTING DATES: ",APCDBDD," TO ",APCDEDD,!
+6 WRITE ?22,"# days",?29,"# of",?36,"%",?45,"Avg #",?56,"Avg # dep",?68,"Avg # dep"
+7 WRITE !?5,"Operator",?22,"of D/E",?29,"forms",?36,"workload",?45,"forms/day",?56,"ent/day",?68,"ent/form"
+8 WRITE !,APCD80S
+9 ;S X="" F S X=$O(APCDFC("FORMS",X)) Q:X="" W !,X,?32,$J(APCDFC("FORMS",X),8),?40,$J((APCDFC("FORMS",X)/APCDFC("DAYS",X)),8,1),?51,$J(((APCDFC("FORMS",X)/APCDTOT)*100),8,1),?67,APCDFC("AVG DEC",X)
+10 SET X=0
FOR
SET X=$ORDER(APCDSUM(X))
IF X=""
QUIT
WRITE !,$EXTRACT(X,1,20),?22,$JUSTIFY(APCDSUM(X,"#DAYS"),6),?29,$JUSTIFY(APCDSUM(X,"#FORMS"),6),?36,$JUSTIFY(((APCDSUM(X,"#FORMS")/APCDTOT)*100),8,1)
Begin DoDot:1
+11 WRITE ?45,$JUSTIFY((APCDSUM(X,"#FORMS")/APCDSUM(X,"#DAYS")),8,1)
+12 WRITE ?56,$JUSTIFY((APCDSUM(X,"#DEC")/APCDSUM(X,"#DAYS")),8,1)
+13 WRITE ?67,$JUSTIFY((APCDSUM(X,"#DEC")/APCDSUM(X,"#FORMS")),8,1)
End DoDot:1
+14 WRITE !?29,"--------",!?27,$JUSTIFY(APCDTOT,8)
+15 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 WRITE @IOF
SET APCDPG=APCDPG+1
+2 WRITE !?55,$$FMTE^XLFDT(DT),?70,"Page ",APCDPG,!
+3 SET APCDLENG=$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))
+4 WRITE ?((80-APCDLENG)/2),$PIECE(^DIC(4,DUZ(2),0),U),!
+5 SET APCDLENG=37+$LENGTH(APCDSRT)
+6 IF APCDSRT]""
WRITE ?((80-APCDLENG)/2),"NUMBER OF FORMS KEYED SUBTOTALED BY ",APCDSRT,!
+7 IF APCDSRT=""
WRITE ?29,"NUMBER OF FORMS KEYED",!
+8 SET APCDLENG=21+$LENGTH(APCDPROV)
+9 WRITE ?((80-APCDLENG)/2),"DATE ENTRY OPERATOR: ",APCDPROV,!
+10 WRITE ?15,"VISIT POSTING DATES: ",APCDBDD," TO ",APCDEDD,!
+11 WRITE !,APCDSRT,?25,"POSTING DATE",?40,"# FORMS",?50,"# DEP ENT",?63,"AVG # DEP ENT",!
+12 WRITE APCD80S,!
+13 QUIT
