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

APCLVPVC.m

Go to the documentation of this file. 
  1. APCLVPVC ; IHS/CMI/LAB - APC visit counts by selected vars ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1. START ; 
  1.  I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! Q
  1.  S APCLSITE=DUZ(2)
  1.  S APCLJOB=$J,APCLBTH=$H
  1.  D INFORM
  1.  S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
  1.  I Y=-1 G XIT
  1.  S APCLSEAT=+Y
  1.  ;
  1. CP ;
  1.  S APCLCP=""
  1.  S DIR(0)="S^P:Provider;C:Clinic",DIR("A")="Tally which of the above",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G XIT
  1.  S APCLCP=Y
  1. GETDATES ;
  1. BD ;get beginning date
  1.  W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date for Search" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G CP
  1.  S APCLBD=Y
  1. ED ;get ending date
  1.  W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Visit Date for Search:  " S Y=APCLBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G BD
  1.  S APCLED=Y
  1.  S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
  1.  ;
  1. ZIS ;call to XBDBQUE
  1.  S XBRP="PRINT^APCLVPVC",XBRC="PROCESS^APCLVPVC",XBRX="XIT^APCLVPVC",XBNS="APCL"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. XIT ;
  1.  K APCLDX,APCLCP,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLTITL,APCL80S,APCLEDD,APCLHD1,APCLHD2,APCLLENG,APCLLOCT,APCLPG,APCLSRT2,APCLTOT,APCLBDD,APCLPROV,APCLSEC,APCLZ,APCLADIS,APCLQUIT,APCLLOCC,APCLBT,APCLBTH,APCLCLN,APCLCLNC
  1.  K APCLDT,APCLPDFN,APCLPRNT,APCLSEAT,APCLSITE,APCLSORT,C,D,E,F,A,B,Z,X,I,J
  1.  K APCLJOB,APCLRXCL,APCLOTHC
  1.  K X,X1,X2,IO("Q"),%,Y,POP,DIRUT,ZTSK,ZTQUEUED,H,S,TS,M
  1.  Q
  1. INFORM ;
  1.  W:$D(IOF) @IOF
  1.  W !!,?10,"****PROVIDER OR CLINIC VISIT COUNTS FROM A TEMPLATE OF PATIENTS****",!!
  1.  W !!,"This report will tally the number of times a certain pre-defined set of ",!,"patients (within a Template) were seen by various providers",!,"or went to various clinics.",!!
  1.  W "The Template of Patients must first be created prior to running this report!",!!
  1.  Q
  1. PROCESS ;
  1.  S APCLBT=$H
  1.  K ^TMP("APCLVPVC",APCLJOB,APCLBTH)
  1.  D XTMP^APCLOSUT("APCLVPVC","PCC REPORT OF VISITS")
  1.  ;
  1.  ;
  1. S ;
  1.  S DFN=0 F  S DFN=$O(^DIBT(APCLSEAT,1,DFN)) Q:DFN'=+DFN  D @APCLCP
  1. END ;
  1.  S APCLET=$H
  1.  D EOJ
  1.  Q
  1. C ;clinic
  1.  S APCLPDFN=0 F  S APCLPDFN=$O(^AUPNVSIT("AC",DFN,APCLPDFN)) Q:APCLPDFN'=+APCLPDFN  I $P(^AUPNVSIT(APCLPDFN,0),U,8)]"" D C1
  1.  Q
  1. C1 ;
  1.  S D=$P($P(^AUPNVSIT(APCLPDFN,0),U),".")
  1.  Q:D<APCLBD
  1.  Q:D>APCLED
  1.  S APCLCLN=$P(^DIC(40.7,$P(^AUPNVSIT(APCLPDFN,0),U,8),0),U)
  1.  S APCLCLNC=$S($P(^DIC(40.7,$P(^AUPNVSIT(APCLPDFN,0),U,8),0),U,2)]"":$P(^DIC(40.7,$P(^AUPNVSIT(APCLPDFN,0),U,8),0),U,2),1:"???")
  1.  S ^(APCLCLNC)=$S($D(^TMP("APCLVPVC",APCLJOB,APCLBTH,APCLCLN,APCLCLNC)):^(APCLCLNC)+1,1:1)
  1.  Q
  1. P ;
  1.  S APCLPDFN="" F  S APCLPDFN=$O(^AUPNVPRV("AC",DFN,APCLPDFN)) Q:APCLPDFN'=+APCLPDFN  I $D(^AUPNVPRV(APCLPDFN,0)) S APCLVREC=^(0) D P1,EOJ
  1.  Q
  1. P1 ;
  1.  S D=$P(^AUPNVPRV(APCLPDFN,0),U,3)
  1.  Q:D=""
  1.  Q:'$D(^AUPNVSIT(D,0))
  1.  S D=$P($P(^AUPNVSIT(D,0),U),".")
  1.  Q:D<APCLBD
  1.  Q:D>APCLED
  1.  S APCLAP=$P(APCLVREC,U),APCLNAME=$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLAP,0),U),1:$P(^DIC(16,APCLAP,0),U))
  1.  S APCLDISC="" D CHKDISC
  1.  Q:$D(APCLSKIP)
  1.  S ^(APCLDISC)=$S($D(^TMP("APCLVPVC",APCLJOB,APCLBTH,APCLNAME,APCLDISC)):^(APCLDISC)+1,1:1)
  1.  Q
  1. EOJ K APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLSRT2,APCLDATE,APCLPROV,APCLSEC,APCLZ,APCLLOCC
  1.  Q
  1.  ;
  1. CHKDISC ;
  1.  I $P(^DD(9000010.06,.01,0),U,2)[200 D CHKDISC2 Q  ;FILE 200 CONV
  1.  S APCLY=$P(^DIC(6,APCLAP,0),U,4)
  1.  I APCLY="" S APCLDISC="??" Q
  1.  S APCLDISC=$P(^DIC(7,APCLY,0),U) I APCLDISC="" S APCLDISC="??" Q
  1.  Q
  1.  ;
  1.  ;
  1. CHKDISC2 ;CHECK DISC IF CONVERTED TO FILE 200
  1.  I '$D(^VA(200,APCLAP)) S APCLSKIP=1 Q
  1.  S APCLDPTR=$$PROVCLS^XBFUNC1(APCLAP,"I") I APCLDPTR=""!(APCLDPTR="UNKNOWN") S APCLDISC="???" Q
  1.  S APCLDISC=$$PROVCLSC^XBFUNC1(APCLAP) I APCLDISC="" S APCLDISC="UNKNOWN"
  1.  Q
  1.  ;
  1. PRINT ;
  1.  S APCL80S="*******************************************************************************"
  1.  S APCLDT=$$FMTE^XLFDT(DT)
  1.  S (APCLTOT,APCLPG)=0 D HEAD
  1.  S APCLSORT=0 K APCLQUIT
  1.  F I=0:0 S APCLSORT=$O(^TMP("APCLVPVC",APCLJOB,APCLBTH,APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT))  D PRINT1
  1.  G:$D(APCLQUIT) DONE
  1.  I $Y>(IOSL-5) D HEAD G:$D(APCLQUIT) DONE
  1.  W !?61,"-------",!
  1.  W ?52,"Total:",?60,$J(APCLTOT,8),!
  1. DONE ;
  1.  D DONE^APCLOSUT
  1.  K ^TMP("APCLVPVC",APCLJOB,APCLBTH)
  1.  Q
  1. PRINT1 ;
  1.  I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
  1.  S APCLSRT2=$O(^TMP("APCLVPVC",APCLJOB,APCLBTH,APCLSORT,""))
  1.  S APCLPRNT=APCLSORT
  1.  W !?5,$E(APCLPRNT,1,25),?35,$E(APCLSRT2,1,20),?60,$J(^TMP("APCLVPVC",APCLJOB,APCLBTH,APCLSORT,APCLSRT2),8)
  1.  S APCLTOT=APCLTOT+^TMP("APCLVPVC",APCLJOB,APCLBTH,APCLSORT,APCLSRT2)
  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 APCLQUIT="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1.  W APCL80S,!
  1.  W "*",?3,$P(^DIC(4,APCLSITE,0),U),?58,APCLDT,?72,"Page ",APCLPG,?78,"*",!
  1.  W "*",?78,"*",!
  1.  S APCLLENG=26
  1.  W "*",?((80-APCLLENG)/2),"NUMBER OF VISITS BY PROVIDER",?78,"*",!
  1.  W "*",?26,"SEARCH TEMPLATE: ",$P(^DIBT(APCLSEAT,0),U),?78,"*",!
  1.  W APCL80S,!
  1.  W !!
  1.  W ?5,"PROVIDER",?35,"CLASS",?60,"# VISITS",!
  1.  Q