Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDFC2

APCDFC2.m

Go to the documentation of this file.
APCDFC2 ; IHS/CMI/LAB - COUNT FORMS REPORT ;
 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
 ;
EP ; 
 S APCDSITE="" S:$D(DUZ(2)) APCDSITE=DUZ(2)
 I '$D(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! K APCDSITE Q
 I 'DUZ(2) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER",!! K APCDSITE Q
 D INFORM
GETDATES ;
BD ;get beginning date
 W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Posting Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I $D(DIRUT) G XIT
 S APCDBD=Y
ED ;get ending date
 W ! S DIR(0)="DA^"_APCDBD_":DT:EP",DIR("A")="Enter ending Posting Date: " S Y=APCDBD D DD^%DT S DIR("B")=Y,Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
 I $D(DIRUT) G BD
 S APCDED=Y
 S X1=APCDBD,X2=-1 D C^%DTC S APCDSD=X
 ;
 S APCDDEC=DUZ
SORTA ;
 S DIR(0)="S^1:CLINIC TYPE;2:SERVICE CATEGORY;3:VISIT TYPE;4:INCLUDE ALL VISITS",DIR("A")="Count number of Forms Processed by",DIR("B")="4" D ^DIR K DIR
 I $D(DIRUT) G BD
 S APCDPROC=+Y I APCDPROC=4 S APCDSRT="" G SUB
 S APCDSRT=Y(0)
SUB ;subtotal by visit date
 S APCDSUBV=""
 S DIR(0)="Y",DIR("A")="Subtotal by Visit Date",DIR("B")="N" KILL DA D ^DIR KILL DIR
 G:$D(DIRUT) SORTA
 S APCDSUBV=Y
ZIS W !! S %ZIS="PQM" D ^%ZIS
 I POP G XIT
 I $D(IO("Q")) G TSKMN
DRIVER ; entry point for taskman
 S APCDBT=$H
 S U="^"
 K ^XTMP("APCDFC2",$J)
ZTSK ;
 D P
 S APCDET=$H
 U IO
 D PRINT^APCDFC2
 S:$D(ZTQUEUED) ZTREQ="@"
 D XIT
 Q
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
TSKMN ;
 S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
 I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
 I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
 K ZTSAVE F %="APCDBD","APCDED","APCDSD","APCDBDD","APCDDEC","APCDSITE","APCDSRT","APCDPROC","APCDSUBV" S ZTSAVE(%)=""
 S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^APCDFC2",ZTDTH="",ZTDESC="PCC DE/QA COUNTS" D ^%ZTLOAD D XIT Q
 ;
XIT ;
 D ^%ZISC
 ;I '$D(ZTSK) S IOP=$I D ^%ZIS U IO(0)
 K ^XTMP("APCDFC2",$J)
 K DIC,%DT,IO("Q"),X,Y,POP,DIRUT,ZTSK,APCDH,APCDM,APCDS,APCDTS,ZTIO
 K APCD1,APCD2,APCD80S,APCDAP,APCDBD,APCDBDD,APCDBT,APCDDATE,APCDDEC,APCDDT,APCDED,APCDEDD,APCDET,APCDGOT,APCDFC,APCDVDES,APCDTDES,APCDDESU,APCDX,APCDVDAT,APCDSUBV
 K APCDLENG,APCDODAT,APCDPG,APCDPROC,APCDPROV,APCDSD,APCDSITE,APCDSORT,APCDSRT,APCDSUB,APCDTOT,APCDVDFN,APCDVREC,APCDWDAT,APCDY,APCDC,APCDDFN,APCDAVG,APCDDEC
 Q
 ;
INFORM ;
 W:$D(IOF) @IOF
 W !,"This report will generate a count of visits entered by you for a ",!,"date range that you specify.",!
 W !,"The report can be subtotaled by CLINIC TYPE, SERVICE CATEGORY OR BY VISIT TYPE.",!
 Q
 ;
P ; Run by posting date
 S APCDODAT=APCDSD_".9999" F  S APCDODAT=$O(^APCDFORM("B",APCDODAT)) Q:APCDODAT=""!((APCDODAT\1)>APCDED)  S APCDDFN=$O(^APCDFORM("B",APCDODAT,"")) D V1
 Q
V1 ;
 S APCDC=0 F  S APCDC=$O(^APCDFORM(APCDDFN,11,APCDC)) Q:APCDC'=+APCDC  S APCDVDFN=$P(^APCDFORM(APCDDFN,11,APCDC,0),U) I APCDVDFN]"",$D(^AUPNVSIT(APCDVDFN,0)) D PROC
 Q
PROC ;
 I APCDDEC'=$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2) Q
 Q:$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2)=""
 Q:'$D(^VA(200,$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2),0))
 S APCDAP=$P(^VA(200,$P(^APCDFORM(APCDDFN,11,APCDC,0),U,2),0),U)
 S APCDVREC=^AUPNVSIT(APCDVDFN,0)
 S APCDVDAT=$P($P(APCDVREC,U),".")
 Q:'$P(APCDVREC,U,9)
 Q:$P(APCDVREC,U,11)
 Q:'$D(^AUPNVPOV("AD",APCDVDFN))
 Q:'$D(^AUPNVPRV("AD",APCDVDFN))
 D @APCDPROC
 D DATE
SET S ^(APCDDATE)=$S($D(^XTMP("APCDFC2",$J,APCDAP,APCDSORT,APCDDATE)):^(APCDDATE)+1,1:1)
 S ^(APCDDATE)=$S($D(^XTMP("APCDFC2",$J,APCDAP,APCDSORT,"DEP COUNT",APCDDATE)):^(APCDDATE)+APCDVDES,1:APCDVDES)
 Q:'APCDSUBV
 S ^(APCDVDAT)=$S($D(^XTMP("APCDFC2",$J,APCDAP,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT)):^(APCDVDAT)+1,1:1)
 Q
EOJ ; clean up and exit
 K APCDVREC,APCDCLIN,APCDSKIP,APCD1,APCD2,APCDAP,APCDX,APCDY,APCDVDES,APCDDATE,APCDPROV,APCDSEC,APCDZ
 Q
 ;
1 ;
 S APCDCLIN=$P(APCDVREC,U,8) I APCDCLIN="" S APCDSORT="NO CLINIC ENTERED" Q
 S APCDSORT=$P(^DIC(40.7,APCDCLIN,0),U)
 Q
 ;
2 ;
 K ^UTILITY("DIQ1",$J)
 K DIQ,DIC,DA,DR
 S DIC="^AUPNVSIT(",DR=".07",DA=APCDVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
 S APCDSORT=^UTILITY("DIQ1",$J,9000010,APCDVDFN,.07,"E")
 K ^UTILITY("DIQ1",$J)
 Q
 ;
4 ;
 S APCDSORT="NONE"
 Q
3 ;TYPE
 K ^UTILITY("DIQ1",$J)
 K DIQ,DIC,DA,DR
 S DIC="^AUPNVSIT(",DR=".03",DA=APCDVDFN,DIQ(0)="E" D EN^DIQ1 K DIC,DA,DR,DIQ
 S APCDSORT=^UTILITY("DIQ1",$J,9000010,APCDVDFN,.03,"E")
 K ^UTILITY("DIQ1",$J)
 Q
 ;
DATE ;
 S APCDDATE=$P(APCDODAT,".")
CALDEC ;
 S APCDVDES=0
 S APCDVFLE=9000010 F APCDFL=0:0 S APCDVFLE=$O(^DIC(APCDVFLE)) Q:APCDVFLE>9000010.99!(APCDVFLE'=+APCDVFLE)  D
 .Q:APCDVFLE=9000010.09
 .Q:APCDVFLE=9000010.14
 .Q:APCDVFLE=9000010.22
 .Q:APCDVFLE=9000010.24
 .Q:APCDVFLE=9000010.25
 .Q:APCDVFLE=9000010.31
 .Q:APCDVFLE=9000010.99
 .S APCDVDG=^DIC(APCDVFLE,0,"GL"),APCDVIGR=APCDVDG_"""AD"",APCDVDFN,APCDEDFN)"
 .S APCDEDFN="" F APCDEL=1:1 S APCDEDFN=$O(@APCDVIGR) Q:APCDEDFN'=+APCDEDFN  S APCDVDES=APCDVDES+1
 .Q
 Q
PRINT ;EP
 K APCDSUM
 S APCD80S="-------------------------------------------------------------------------------",APCDPG=0
 S APCDEDD=$$FMTE^XLFDT(APCDED),APCDBDD=$$FMTE^XLFDT(APCDBD)
 S (APCDTOT,APCDPROV,APCDTDES)=0
 K APCDQUIT
 I '$D(^XTMP("APCDFC2",$J)) S APCDPROV="NONE TO REPORT" D HEAD G DONE
 F  S APCDPROV=$O(^XTMP("APCDFC2",$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("APCDFC2",$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),?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("APCDFC2",$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("APCDFC2",$J,APCDPROV,APCDSORT,"DEP COUNT",APCDDATE),APCDAVG=(APCDVDES/^XTMP("APCDFC2",$J,APCDPROV,APCDSORT,APCDDATE))\1
 S APCDSUM(APCDPROV,"#DEC")=$G(APCDSUM(APCDPROV,"#DEC"))+APCDVDES
 W !?25,APCDWDAT,?42,$J(^XTMP("APCDFC2",$J,APCDPROV,APCDSORT,APCDDATE),6),?52,$J(APCDVDES,7),?65,$J(APCDAVG,6)
 S APCDSUM(APCDPROV,"#FORMS")=$G(APCDSUM(APCDPROV,"#FORMS"))+^XTMP("APCDFC2",$J,APCDPROV,APCDSORT,APCDDATE)
 I APCDSUBV D
 . W !?27,"Visit Dates Processed:"
 . S APCDVDAT=0 F  S APCDVDAT=$O(^XTMP("APCDFC2",$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("APCDFC2",$J,APCDPROV,APCDSORT,"VISIT DATE",APCDDATE,APCDVDAT),6)
 .. Q
 Q:$D(APCDQUIT)
 S APCDSUB=APCDSUB+^XTMP("APCDFC2",$J,APCDPROV,APCDSORT,APCDDATE),APCDTOT=APCDTOT+^XTMP("APCDFC2",$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
 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