- BUDCRPTS ; IHS/CMI/LAB - UDS REPORT DRIVER 12 Dec 2015 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="^BUDCSITE(",DIC(0)="AEMQ",DIC("A")="Enter your site: " D ^DIC
- I Y=-1 D EOJ Q
- S BUDSITE=+Y
- 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
- D TAXCHK^BUDCXTCH
- 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
- ;get indian or not
- S BUDCEN=""
- 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"
- S DIR("B")="1" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) G EN1
- S BUDCEN=Y
- TEMP ;
- S BUDSTMP=""
- D EN^BUDCSTMP
- 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^BUDCRPTC
- U IO
- D PRINTCP
- D PRINT^BUDCRPTP
- 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^BUDCRPTS",ZTDTH="",ZTDESC="UDS 15 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 2015",$E(X,70)="Cover Page" W !,X
- W !,"UDS No. ",$P(^BUDCSITE(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. 2015"
- 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 2015",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 !?4,"- the patient must NOT have a gender of 'Unknown'"
- 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("BUDCRPT1",BUDJ,BUDH,"3ATEMP",X)) Q:X'=+X S ^DIBT(BUDSTMP,1,X)=""
- Q
- 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
- +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="^BUDCSITE("
- 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(^BUDCSITE(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^BUDCXTCH
- +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
- +11 ;get indian or not
- +12 SET BUDCEN=""
- +13 SET 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)"
- SET DIR("A")="Select Beneficiary Population to include in this report"
- +14 SET DIR("B")="1"
- KILL DA
- DO ^DIR
- KILL DIR
- +15 IF $DATA(DIRUT)
- GOTO EN1
- +16 SET BUDCEN=Y
- TEMP ;
- +1 SET BUDSTMP=""
- +2 DO EN^BUDCSTMP
- +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^BUDCRPTC
- +2 USE IO
- +3 DO PRINTCP
- +4 DO PRINT^BUDCRPTP
- +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^BUDCRPTS"
- SET ZTDTH=""
- SET ZTDESC="UDS 15 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 2015"
- SET $EXTRACT(X,70)="Cover Page"
- WRITE !,X
- +3 WRITE !,"UDS No. ",$PIECE(^BUDCSITE(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. 2015"
- +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 2015",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 !?4,"- the patient must NOT have a gender of 'Unknown'"
- +14 WRITE !
- +15 DO PAUSE
- +16 WRITE !,"TABLE 3A: PATIENTS BY AGE AND GENDER WITH SEARCH TEMPLATE CREATION"
- +17 WRITE !!,"This option will create a search template of all patients who meet"
- +18 WRITE !,"the definition of a patient above and who are included in UDS Table 3A."
- +19 WRITE !,"You may use this search template in other applications (QMAN, PGEN)"
- +20 WRITE !,"to assist you in completing UDS tables not produced by the IHS/RPMS UDS"
- +21 WRITE !,"application."
- +22 WRITE !!,"Patients must have at least one visit during the selected time period,"
- +23 WRITE !,"as defined above. Age is calculated as of June 30th of the year you"
- +24 WRITE !,"select."
- +25 WRITE !
- +26 WRITE !,"This option will also produce UDS Table 3A, an itemization of users"
- +27 WRITE !,"(patients) by age and gender."
- +28 WRITE !
- +29 QUIT
- +30 ;
- 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("BUDCRPT1",BUDJ,BUDH,"3ATEMP",X))
- IF X'=+X
- QUIT
- SET ^DIBT(BUDSTMP,1,X)=""
- +2 QUIT