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

APCLAP1.m

Go to the documentation of this file.
  1. APCLAP1 ; 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. I '$D(APCLRPT) W !,$C(7),$C(7),"REPORT TYPE MISSING!! NOTIFY PROGRAMMER",! K APCLSITE Q
  1. D GETINFO^APCLAP0 G:$D(APCLQUIT) XIT
  1. S APCLJOB=$J,APCLBTH=$H
  1. D INFORM
  1. CHECK ;
  1. I APCLRPT'="P"&(APCLRPT'="DIS") G GETDATES
  1. S DIR(0)="SO^P:Primary Provider Only;A:All Providers (Primary and Secondary)",DIR("A")="Report should include"
  1. S DIR("?")="If you wish to count only the primary provider of service enter a 'P'. To include ALL providers enter an 'A'." D ^DIR K DIR
  1. G:$D(DIRUT) XIT
  1. I Y="A" S APCLRPT=$S(APCLRPT="DIS":"ALLDISC",1:"ALLP")
  1. I Y="P" S APCLRPT=$S(APCLRPT="P":"PROV",1:"DISC")
  1. D GETINFO^APCLAP0
  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 XIT
  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 I APCLRPT="LOS" S APCLLOC=0 G DEF
  1. S APCLLOC=$$GETLOC^APCLOCCK
  1. I APCLLOC=-1 G BD
  1. DEF S X=25,DIC(0)="M",DIC="^DIC(40.7," D ^DIC K DIC,X I Y=-1 W !!,"CLINIC CODE 25 - OTHER MISSING FROM FILE - NOTIFY YOUR SITE MANAGER!!" G XIT
  1. S APCLOTHC=+Y
  1. S X=39,DIC(0)="M",DIC="^DIC(40.7," D ^DIC K DIC I Y=-1 W !!,"PHARMACY CLINIC CODE 39 NOT IN FILE - NOTIFY SITE MANAGER!!" G XIT
  1. S APCLRXCL=+Y
  1. DEMO ;
  1. D DEMOCHK^APCLUTL(.APCLDEMO)
  1. I APCLDEMO=-1 G LOC
  1. ZIS ;call to XBDBQUE
  1. S XBRP="^APCLAP1P",XBRC="^APCLAP11",XBRX="XIT^APCLAP1",XBNS="APCL"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. XIT ;
  1. K APCLSITE,APCLRPT,APCLINFO,APCLSORT,APCLPROC,APCLINF,APCLBD,APCLED,APCLSD,APCLDT,APCLLOC,APCLODAT,APCLVDFN,APCLVLOC,APCLVREC,APCLCLIN,APCLSKIP,APCL1,APCL2,APCLAP,APCLDISC,APCLPPOV,APCLX,APCLHIGH,APCLDATE,APCLPRNT,APCLJOB,APCLAPCC
  1. K APCLDX,APCLLOW,APCLICD,APCLDA1,APCLDA2,APCLY,APCLTITL,APCL80S,APCLEDD,APCLHD1,APCLHD2,APCLLENG,APCLLOCT,APCLPG,APCLSRT2,APCLTOT,APCLBDD,APCLPROV,APCLSEC,APCLZ,APCLADIS,APCLQUIT,APCLLOCC,APCLBT,APCLBTH
  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 !,"***** APC VISIT COUNTS BY ",APCLTITL," *****",!
  1. W !,"This report will generate a count of visits by ",APCLINF,!,"for a date range that you specify.",!
  1. W "The only visits included in this report are those that are considered",!,"APC workload reportable.",!
  1. Q
  1. ;