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

APCLCP6.m

Go to the documentation of this file.
  1. APCLCP6 ; IHS/CMI/LAB - activity report print ;
  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. I APCLSORV="APCLAP" S APCLSORT="PROVIDER",APCLNSP="APCLCP6"
  1. I APCLSORV="APCLSU" S APCLSORT="SERVICE UNIT",APCLNSP="APCLCP7"
  1. D INFORM
  1. GETGROUP ;
  1. S DIC="^APCLACTG(",DIC("A")="Enter the Provider Discipline Group you wish to report on: ",DIC(0)="AEMQ" D ^DIC K DIC
  1. I Y=-1 W !,"Bye ... " G XIT
  1. S APCLACTG=+Y
  1. W !!,"You have selected the ",$P(Y,U,2)," discipline group.",!
  1. S DIC="^APCLACTG(",DA=+Y D EN^DIQ K DIC,DA
  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 GETGROUP
  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. LOC ;get location
  1. K APCLLOC
  1. S DIR(0)="S^O:One Location;T:Taxonomy of or Selected Set of Locations;A:All Locations"
  1. S DIR("A")="Include visits from which set of locations",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1. G:$D(DIRUT) BD
  1. I Y="A" K APCLLOC G CLINIC
  1. I Y="O" D O^APCLCP1 G:$D(APCLQ) LOC
  1. I Y="T" D T^APCLCP1 G:$D(APCLQ) LOC
  1. CLINIC ;
  1. K APCLCLN
  1. S DIR(0)="S^O:One Clinic;T:Taxonomy of or Selected Set of Clinics;A:All Clinics"
  1. S DIR("A")="Include visits from which set of clinics",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1. G:$D(DIRUT) LOC
  1. I Y="A" K APCLCLN G ZIS
  1. I Y="O" D OC^APCLCP1 G:$D(APCLQ) CLINIC
  1. I Y="T" D TC^APCLCP1 G:$D(APCLQ) CLINIC
  1. ZIS ;
  1. DEMO ;
  1. D DEMOCHK^APCLUTL(.APCLDEMO)
  1. I APCLDEMO=-1 G CLINIC
  1. S XBRP="^APCLCP6P",XBRC="^APCLCP61",XBRX="XIT^APCLCP6",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. I '$D(ZTQUEUED) S IOP="HOME" D ^%ZIS U IO(0)
  1. K APCL80S,APCLBDD,APCLBT,APCLDT,APCLED,APCLEDD,APCLLENG,APCLLOC,APCLPG,APCLQUIT,APCL1,APCL2,APCLAP,APCLDISC,APCLODAT,APCLSD,APCLSKIP,APCLVACT,APCLVDFN,APCLVLOC,APCLVREC,APCLVTM,APCLVTT,APCLX,APCLY,APCLPRIM,APCLSITE,APCLBD
  1. K APCLACTG,APCLJOB
  1. K X,X1,X2,IO("Q"),%,Y,DIRUT,POP,ZTSK,ZTQUEUED,T,S,M,TS,H,DIR,DUOUT,DTOUT,DUOUT,DLOUT,APCLVAL,APCLVALP,APCLNSP,APCLSORT,APCLSORV,APCLAP,APCLSU
  1. Q
  1. ;
  1. INFORM ;
  1. W:$D(IOF) @IOF
  1. W !,"Number of Individuals Seen by ",APCLSORT," for staff members in the discipline",!,"group that you select.",!
  1. W !,"This report displays, by location of encounter, the number of individuals",!,"seen by each provider with a discipline in the discipline group that you select."
  1. W !
  1. Q
  1. ;
  1. ;
  1. O ;EP one location
  1. K APCLQ
  1. S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Which LOCATION: " D ^DIC K DIC
  1. I Y=-1 S APCLQ="" Q
  1. S APCLLOC(+Y)=""
  1. Q
  1. T ;EP taxonomy
  1. K APCLQ
  1. S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=9999999.06" D ^DIC K DIC
  1. I Y=-1 S APCLQ="" Q
  1. S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLLOC(X)=""
  1. Q
  1. OC ;EP one location
  1. K APCLQ
  1. S DIC="^DIC(40.7,",DIC(0)="AEMQ",DIC("A")="Which CLINIC: " D ^DIC K DIC
  1. I Y=-1 S APCLQ="" Q
  1. S APCLCLN(+Y)=""
  1. Q
  1. TC ;EP taxonomy
  1. K APCLQ
  1. S DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Which TAXONOMY: ",DIC("S")="I $P(^(0),U,15)=40.7" D ^DIC K DIC
  1. I Y=-1 S APCLQ="" Q
  1. S X=0 F S X=$O(^ATXAX(+Y,21,"B",X)) Q:X="" S APCLCLN(X)=""
  1. Q