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

APCLCR1.m

Go to the documentation of this file. 
  1. APCLCR1 ; IHS/CMI/LAB - visits by provider ;
  1.  ;;2.0;IHS PCC SUITE;**2**;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!!",!! K APCLSITE Q
  1.  D XIT
  1.  S APCLJOB=$J,APCLBTH=$H
  1.  D INFORM
  1. GETDATES ;
  1. BD ;
  1.  W !!
  1.  S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  S APCLBD=Y D DD^%DT S APCLBDD=Y
  1. ED ;
  1.  S DIR(0)="DA^::EP",DIR("A")="Enter Ending Visit Date:  " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  G:$D(DIRUT) XIT
  1.  I Y<APCLBD W !,"Ending date must be greater than or equal to beginning date!" G ED
  1.  S APCLED=Y
  1.  S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
  1. LOC ;
  1.  K APCLLOCT,APCLLOC,APCLQ
  1.  S DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility;T:A Taxonomy or Set of Locations/Facilities",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"
  1.  S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
  1.  G:$D(DIRUT) GETDATES
  1.  S APCLLOCT=Y
  1.  I APCLLOCT="A" K APCLLOC G CLINIC
  1.  D @APCLLOCT
  1.  G:$D(APCLQ) LOC
  1. CLINIC ;
  1.  S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1.  D PEP^AMQQGTX0(+Y,"APCLCLNT(")
  1.  I '$D(APCLCLNT) G GETDATES
  1.  I $D(APCLCLNT("*")) K APCLCLNT
  1. DISC ;
  1.  S X="DISCIPLINE",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
  1.  D PEP^AMQQGTX0(+Y,"APCLDISP(")
  1.  I '$D(APCLDISP) G CLINIC
  1.  I $D(APCLDISP("*")) K APCLDISP
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G DISC
  1.  S XBRP="PRINT^APCLCR1",XBRC="PROC^APCLCR1",XBRX="XIT^APCLCR1",XBNS="APCL"
  1.  D ^XBDBQUE
  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. XIT ;
  1.  D EN^XBVK("APCL")
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. INFORM ;
  1.  W:$D(IOF) @IOF
  1.  W !,"This report will list a count of all visits to clinics that"
  1.  W !,"are within a taxonony of clinics you identify.  The report"
  1.  W !,"will be a tally of all primary and secondary providers"
  1.  W !,"on those visits.  Only those provider disciplines that are"
  1.  W !,"within the discipline taxonomy you select will be talled."
  1.  Q
  1.  ;
  1. PROC ;EP - called from xbdbque
  1.  S APCLBT=$H
  1.  K ^XTMP("APCLCR1",APCLJOB,APCLBTH)
  1.  D XTMP^APCLOSUT("APCLCR1","PCC VISIT/PROVIDER TALLY")
  1.  S APCLVCNT=0 K APCLPSCT
  1.  ;
  1. V ; Run by visit date
  1.  S APCLODAT=APCLSD_".9999" F  S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED)  D V1
  1.  ;
  1. END ;
  1.  S APCLET=$H
  1.  Q
  1. V1 ;
  1.  ;count only visits with service category of A, O, R, S
  1.  S APCLVDFN="" F  S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN  I $D(^AUPNVSIT(APCLVDFN,0)),$P(^(0),U,9),'$P(^(0),U,11) S APCLVREC=^(0) D PROC1
  1.  Q
  1. PROC1 ;
  1.  ;I $P(APCLVREC,U,6)'=APCLLOC Q  ;not correct location
  1.  S (APCLLOE,L)=$P(APCLVREC,U,6)
  1.  Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
  1.  Q:L=""
  1.  I $D(APCLLOC),'$D(APCLLOC(L)) Q  ;not a facility of interest
  1.  S APCLCLIN=$P(APCLVREC,U,8)
  1.  Q:APCLCLIN=""
  1.  I $D(APCLCLIN),'$D(APCLCLNT(APCLCLIN)) Q
  1.  ;go through all providers
  1.  S APCLX=0 F  S APCLX=$O(^AUPNVPRV("AD",APCLVDFN,APCLX)) Q:APCLX'=+APCLX  D
  1.  .S Y=$P($G(^AUPNVPRV(APCLX,0)),U)
  1.  .Q:Y=""
  1.  .S D=$P($G(^VA(200,Y,"PS")),U,5)
  1.  .Q:D=""
  1.  .I $D(APCLDISP),'$D(APCLDISP(D)) Q
  1.  .S P=$P(^AUPNVPRV(APCLX,0),U,4) I P="" S P="S"
  1.  .S APCLPSCT(P)=$G(APCLPSCT(P))+1
  1.  .S ^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA",P,$P(^VA(200,Y,0),U),Y)=$G(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA",P,$P(^VA(200,Y,0),U),Y))+1
  1.  .S ^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC",P,$P(^VA(200,Y,0),U),Y,APCLLOE)=$G(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC",P,$P(^VA(200,Y,0),U),Y,APCLLOE))+1
  1.  .I $D(^XTMP("APCLCR1",APCLJOB,APCLBTH,"VISITS",APCLVDFN)) Q
  1.  .S APCLVCNT=APCLVCNT+1,^XTMP("APCLCR1",APCLJOB,APCLBTH,"VISITS",APCLVDFN)=""
  1.  .Q
  1.  Q
  1. PRINT ;EP - called from xbdbque
  1.  D COVPAGE
  1.  S APCLPG=0 K APCLQUIT
  1.  D HEAD
  1.  I '$D(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA")) W !!,"No visits to report.",! D DONE Q
  1.  W !!,"Total PCC Primary Provider Workload Count:",?45,$J($G(APCLPSCT("P")),7)
  1.  W !,"Total PCC Secondary Provider Workload Count:",?45,$J($G(APCLPSCT("S")),7)
  1.  W !,"Total PCC Provider Workload Count:",?45,$J(($G(APCLPSCT("P"))+$G(APCLPSCT("S"))),7)
  1.  W !!,"Total Number of Visits: ",?45,$J(APCLVCNT,7)
  1.  W !!,"PRIMARY PROVIDERS",?35,"# OF VISITS",!
  1.  S APCLX="" F  S APCLX=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
  1.  .S APCLY=0 F  S APCLY=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX,APCLY)) Q:APCLY'=+APCLY!($D(APCLQUIT))  D
  1.  ..I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
  1.  ..W !?3,APCLX,?35,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX,APCLY),6)
  1.  ..Q:APCLLOCT="O"
  1.  ..S APCLZ=0 F  S APCLZ=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","P",APCLX,APCLY,APCLZ)) Q:APCLZ'=+APCLZ!($D(APCLQUIT))  D
  1.  ...I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
  1.  ...W !?6,$P(^AUTTLOC(APCLZ,0),U,7),?14,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","P",APCLX,APCLY,APCLZ),6)
  1.  ..Q
  1.  .Q
  1.  W !!,"SECONDARY PROVIDERS",?35,"# OF VISITS",!
  1.  S APCLX="" F  S APCLX=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX)) Q:APCLX=""!($D(APCLQUIT))  D
  1.  .S APCLY=0 F  S APCLY=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX,APCLY)) Q:APCLY'=+APCLY!($D(APCLQUIT))  D
  1.  ..I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
  1.  ..W !?3,APCLX,?35,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX,APCLY),6)
  1.  ..Q:APCLLOCT="O"
  1.  ..S APCLZ=0 F  S APCLZ=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","S",APCLX,APCLY,APCLZ)) Q:APCLZ'=+APCLZ!($D(APCLQUIT))  D
  1.  ...I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
  1.  ...W !?6,$P(^AUTTLOC(APCLZ,0),U,7),?14,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","S",APCLX,APCLY,APCLZ),6)
  1.  ..Q
  1.  .Q
  1. DONE ;
  1.  D DONE^APCLOSUT
  1.  K ^XTMP("APCLCR1",APCLJOB,APCLBTH)
  1.  Q
  1. COVPAGE ;
  1.  W:$D(IOF) @IOF
  1.  W !!,$$CJ^XLFSTR("Tally of Selected Primary and Secondary Providers for selected Clinic Visits",80),!
  1.  W !,$$CJ^XLFSTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
  1.  I '$D(APCLLOC) W !!,"Locations:  ALL"
  1.  I $D(APCLLOC) W !!,"Locations:"
  1.  S X=0 F  S X=$O(APCLLOC(X)) Q:X'=+X  W:$Y>(IOSL-2) @IOF,!,"Cover page (con't)",!! W !?10,$P(^DIC(4,X,0),U)
  1.  I '$D(APCLCLNT) W !!,"Clinics:  ALL"
  1.  I $D(APCLCLNT) W !!,"Clinics:"
  1.  S X=0 F  S X=$O(APCLCLNT(X)) Q:X'=+X  W:$Y>(IOSL-2) @IOF,!,"Cover page (con't)",!! W !?10,$P(^DIC(40.7,X,0),U)
  1.  I '$D(APCLDISP) W !!,"Disciplines:  ALL"
  1.  I $D(APCLDISP) W !!,"Disciplines:"
  1.  S X=0 F  S X=$O(APCLDISP(X)) Q:X'=+X  W:$Y>(IOSL-2) @IOF,!,"Cover page (con't)",!! W !?10,$P(^DIC(7,X,0),U)
  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 !?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
  1.  W $$CJ^XLFSTR("TALLY OF SELECTED PRIMARY AND SECONDARY PROVIDERS FOR SELECTED CLINIC VISITS",80),!
  1.  W $$CJ^XLFSTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
  1.  I '$D(APCLLOC) W $$CJ^XLFSTR("FOR: ALL Locations",80),!
  1.  I APCLLOCT="O" W $$CJ^XLFSTR("FOR: "_$P(^DIC(4,$O(APCLLOC(0)),0),U),80),!
  1.  I APCLLOCT="S" W $$CJ^XLFSTR("FOR: "_$P(^AUTTSU(APCLSU,0),U)_" Service Unit",80),!
  1.  I APCLLOCT="T" W $$CJ^XLFSTR("FOR: A taxonomy or selected set of locations",80),!
  1.  W $$REPEAT^XLFSTR("-",80),!
  1.  Q
  1. O ;
  1.  W ! S DIC("A")="Which Facility: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA I Y<0 S APCLQ=1 Q
  1.  S APCLLOC(+Y)=""
  1.  Q
  1. S ;all communities within APCLSU su
  1.  S DIC="^AUTTSU(",DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05),DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
  1.  I Y=-1 S APCLQ="" Q
  1.  S APCLSU=+Y
  1.  W !!,"Gathering up all the facilities..."
  1.  S X=0 F  S X=$O(^AUTTLOC(X)) Q:X'=+X  I $P(^AUTTLOC(X,0),U,5)=+Y S APCLLOC(X)=""
  1.  Q
  1. T ;taxonomy - call qman interface
  1.  K APCLLOC
  1.  S X="ENCOUNTER LOCATION",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCLQ=1 Q
  1.  D PEP^AMQQGTX0(+Y,"APCLLOC(")
  1.  I '$D(APCLLOC) S APCLQ=1 Q
  1.  I $D(APCLLOC("*")) K APCLLOC W !!,$C(7),$C(7),"ALL locations is NOT an option with this report",! G T
  1.  S X="" F  S X=$O(APCLLOC(X)) Q:X=""  S APCLLOC(X)=""
  1.  Q