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