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