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

BUDCRPTS.m

Go to the documentation of this file.
  1. BUDCRPTS ; IHS/CMI/LAB - UDS REPORT DRIVER 12 Dec 2015 8:11 AM ;
  1. ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
  1. ;
  1. ;
  1. Q ;not at top
  1. ;
  1. EN ;EP
  1. D EOJ
  1. W !!,"SEARCH TEMPLATE CREATION FOR PATIENTS INCLUDED IN TABLE 3A.",!
  1. D GENI
  1. ;D T3AI
  1. EN1 ;
  1. S BUDSITE=""
  1. S DIC="^BUDCSITE(",DIC(0)="AEMQ",DIC("A")="Enter your site: " D ^DIC
  1. I Y=-1 D EOJ Q
  1. S BUDSITE=+Y
  1. I '$O(^BUDCSITE(BUDSITE,11,0)) W !!,"Warning: There are no locations defined in the site parameter file for this",!,"site. Report will not be accurate!" G EN
  1. D TAXCHK^BUDCXTCH
  1. D YEAR
  1. I BUDYEAR="" W !!,"Year not entered.",! D EOJ Q
  1. D QUARTER ;get time period
  1. I BUDQTR="" W !,"Time period not entered." D EOJ Q
  1. ;get indian or not
  1. S BUDCEN=""
  1. S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"
  1. S DIR("B")="1" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) G EN1
  1. S BUDCEN=Y
  1. TEMP ;
  1. S BUDSTMP=""
  1. D EN^BUDCSTMP
  1. I BUDSTMP="" G EN
  1. ZIS ;call to XBDBQUE
  1. S BUDT3A=1
  1. K IOP,%ZIS
  1. W !! S %ZIS="PQM" D ^%ZIS
  1. I POP D EOJ Q
  1. ZIS1 ;
  1. I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1. D PROC^BUDCRPTC
  1. U IO
  1. D PRINTCP
  1. D PRINT^BUDCRPTP
  1. D ^%ZISC
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. D EOJ
  1. Q
  1. TSKMN ;EP ENTRY POINT FROM TASKMAN
  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 S ZTSAVE("BUD*")=""
  1. S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BUDCRPTS",ZTDTH="",ZTDESC="UDS 15 REPORT SEARCH TEMPLATE" D ^%ZTLOAD D EOJ Q
  1. Q
  1. PRINTCP ;
  1. W !
  1. S X=$$CTR($P(^DIC(4,BUDSITE,0),U),60),$E(X,3)=$P(^VA(200,DUZ,0),U,2),$E(X,10)="UDS 2015",$E(X,70)="Cover Page" W !,X
  1. W !,"UDS No. ",$P(^BUDCSITE(BUDSITE,0),U,2),?50,"Date Run: ",$$FMTE^XLFDT(DT)
  1. W !,"Reporting Period: ",$$FMTE^XLFDT(BUDBD)," through ",$$FMTE^XLFDT(BUDED)
  1. W !
  1. S X=$$REPEAT^XLFSTR("-",79) W X,!
  1. W !!,"Search Template ",$P(^DIBT(BUDSTMP,0),U,1)," successfully created.",!
  1. S BUDFNP=1
  1. Q
  1. T3AI ;intro for table 3A
  1. W !!,"TABLE 3A: USERS BY AGE AND GENDER WITH SEARCH TEMPLATE CREATION"
  1. W !,"This report will produce UDS Table 3A, an itemization of users (patients) by age"
  1. W !,"and gender. Users must have at least one visit during the selected time period.",!,"as defined above. Age is calculated as of June 30th of the year you select.",!
  1. W !,"The patients included in this table will be stored in a search template"
  1. W !,"for you to use in other applications (QMAN, PGEN) to assist you in"
  1. W !,"completing UDS tables not produced the the IHS/RPMS UDS System."
  1. Q
  1. QUARTER ;
  1. S BUDQTR=""
  1. S DIR("?",1)="Select the quarter you want to report on"
  1. S DIR("?",2)=" 1 January 1 - March 31"
  1. S DIR("?",3)=" 2 April 1 - June 30"
  1. S DIR("?",4)=" 3 July 1 - September 30"
  1. S DIR("?",5)=" 4 October 1 - December 31"
  1. S DIR("?",6)=" F Full Calender Year January 1 - December 31"
  1. S DIR(0)="S^1:1st Quarter (January 1 - March 31);2:2nd Quarter (April 1 - June 30);3:3rd Quarter (July 1 - September 30);4:4th Quarter (October 1 - December 31);F:Full Calendar Year (January 1 - December 31)"
  1. S DIR("A")="Choose the time period to report on",DIR("B")="F" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT)!(Y="") S BUDQUIT="" Q
  1. S BUDQTR=Y
  1. I Y=1 S BUDBD=$E(BUDYEAR,1,3)_"0101",BUDED=$E(BUDYEAR,1,3)_"0331"
  1. I Y=2 S BUDBD=$E(BUDYEAR,1,3)_"0401",BUDED=$E(BUDYEAR,1,3)_"0630"
  1. I Y=3 S BUDBD=$E(BUDYEAR,1,3)_"0701",BUDED=$E(BUDYEAR,1,3)_"0930"
  1. I Y=4 S BUDBD=$E(BUDYEAR,1,3)_"1001",BUDED=$E(BUDYEAR,1,3)_"1231"
  1. I Y="F" S BUDBD=$E(BUDYEAR,1,3)_"0101",BUDED=$E(BUDYEAR,1,3)_"1231"
  1. W !!,"Your report will be run for the time period: ",$$FMTE^XLFDT(BUDBD)," to ",$$FMTE^XLFDT(BUDED)
  1. Q
  1. YEAR ;
  1. S BUDYEAR=""
  1. W !
  1. W !,"Enter the Calendar Year. Use a 4 digit year, e.g. 2015"
  1. S DIR(0)="D^::EP"
  1. S DIR("A")="Enter Calendar Year"
  1. S DIR("?")="This report is compiled for a period. Enter a valid date."
  1. D ^DIR KILL DIR
  1. K DIC
  1. I $D(DUOUT) S DIRUT=1 Q
  1. I $D(DIRUT) Q
  1. I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G YEAR
  1. S BUDYEAR=Y,BUDBD=$E(BUDYEAR,1,3)_"0101",BUDED=$E(BUDYEAR,1,3)_"1231"
  1. S BUDCAD=$E(BUDYEAR,1,3)_"0630"
  1. Q
  1. EOJ ;
  1. D EN^XBVK("BUD")
  1. Q
  1. GENI ;general introductions
  1. W:$D(IOF) @(IOF)
  1. W !!,$$CTR($$LOC,80),!,$$CTR("UDS 2015",80),!
  1. W !,"UDS searches your database to find all visits and related patients"
  1. W !,"during the time period selected. Based on the UDS definition, to be considered"
  1. W !,"a patient the patient must have had at least one visit meeting the following"
  1. W !,"criteria:"
  1. W !?4,"- must be to a location specified in your visit location setup"
  1. W !?4,"- must be to Service Category Ambulatory (A), Hospitalization (H), Day"
  1. W !?6,"Surgery (S), Observation (O), Telemedicine (M), Nursing home visit (R), "
  1. W !?6,"or In-Hospital (I) visit"
  1. W !?4,"- must NOT have an excluded clinic code (see User Manual for a list)"
  1. W !?4,"- must have a primary provider and a coded purpose of visit"
  1. W !?4,"- the patient must NOT have a gender of 'Unknown'"
  1. W !
  1. D PAUSE
  1. W !,"TABLE 3A: PATIENTS BY AGE AND GENDER WITH SEARCH TEMPLATE CREATION"
  1. W !!,"This option will create a search template of all patients who meet"
  1. W !,"the definition of a patient above and who are included in UDS Table 3A."
  1. W !,"You may use this search template in other applications (QMAN, PGEN)"
  1. W !,"to assist you in completing UDS tables not produced by the IHS/RPMS UDS"
  1. W !,"application."
  1. W !!,"Patients must have at least one visit during the selected time period,"
  1. W !,"as defined above. Age is calculated as of June 30th of the year you"
  1. W !,"select."
  1. W !
  1. W !,"This option will also produce UDS Table 3A, an itemization of users"
  1. W !,"(patients) by age and gender."
  1. W !
  1. Q
  1. ;
  1. PAUSE ;
  1. K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
  1. Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------
  1. NRY ;
  1. W !!,"not developed yet....." H 3
  1. Q
  1. STEMP ;EP
  1. S X=0 F S X=$O(^XTMP("BUDCRPT1",BUDJ,BUDH,"3ATEMP",X)) Q:X'=+X S ^DIBT(BUDSTMP,1,X)=""
  1. Q