BUDCRPTE ; IHS/CMI/LAB - UDS REPORT PROCESSOR 03 Feb 2015 1:15 PM ; 23 Jan 2015 10:19 AM
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
PROC ;EP - called from xbdbque
S BUDJ=$J,BUDH=$H
K ^TMP($J)
S ^XTMP("BUDCRPT1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"UDS REPORT"
S ^XTMP("BUDCRP6B",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^UDS TABLE 6B LISTS"
S ^XTMP("BUDCRP7",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 7 LISTS"
S ^XTMP("BUDARP9DEL",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 9 DELIMINTED FILE"
;TABLE 3A
K BUDTOT F X=1:1:39 S $P(BUDTOT("M"),U,X)=0,$P(BUDTOT("F"),U,X)=0,$P(BUDTOT("ALL"),U,X)=0,BUDTOT("U")=0 ;3A
S BUD019("M")="",BUD019("F")="",BUD019("ALL")=""
;TABLE 5
F X=1:1:6 S BUDTAB5(X)="0^0"
F X=7:1:38 S BUDTAB5(X)="0^0"
F X="9A","9B","20A","20A1","20A2","20B","20C","22A","22B","22C","22D","29A","10A","27a","27b","30A","30B","30C" S BUDTAB5(X)="0^0"
;TABLE 3B
K BUDRACET
;S BUDRACET(LINE)=LINE NUMBER^LABEL^HISP/LATINO^NOT HISPANIC^UNREP^TOTAL^LINE LABEL 2^LINE LABEL 3"
S BUDRACET(1)="1.^Asian^0^0^0^0"
S BUDRACET("2A")="2a.^Native Hawaiian^0^0^0^0"
S BUDRACET("2B")="2b.^Other Pacific^0^0^0^0^Islander"
S BUDRACET(2)="2.^Total Hawaiian/^0^0^0^0^Pacific Islander^(Sum Lines 2a+2b)"
S BUDRACET(3)="3.^Black/African^0^0^0^0^American"
S BUDRACET(4)="4.^American Indian/^0^0^0^0^Alaska Native"
S BUDRACET(5)="5.^White^0^0^0^0"
S BUDRACET(6)="6.^More than one^0^0^0^0^race"
S BUDRACET(7)="7.^Unreported/^0^0^0^0^Refused to Report"
S BUDRACET(8)="8.^Total Patients^0^0^0^0^(Sum Lines 1+2^+ 3 to 7)"
K BUDLANG
S BUDLANG(12)="12.^Patients Best Served in a Language Other Than^0^English"
;TABLE 6
F X=1:1:26 S $P(BUDT6("V"),U,X)=0,$P(BUDT6("P"),U,X)=0
;TABLE 4
K BUDT4V
F X=1:1:6 S BUDT4V(X)=0
F X=7,"8a","8b",8,9,"9a","10a","10b",10,11,12 S BUDT4V(X)="0^0"
F X=14:1:26 S BUDT4V(X)=0
;TABLE 9 DELIMITED
S BUDT9C=0
;TABLE 9D
K BUDT9TC
F X=1,"2a","2b",3,4,"5a","5b",6,7,"8a","8b",9,10,"11a","11b",12,13,14 S BUDT9(X)="0^0" ;COLUMN A & B
Q
PT ;EP
S (BUDROT,BUDDELT,BUDDELF)=""
W !!,"Please choose an output type. For an explanation of the delimited",!,"file please see the user manual.",!
S DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel)",DIR("A")="Select an Output Option",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
S BUDROT=Y
Q:BUDROT="P"
S BUDDELF="",BUDDELT=""
W !!,"You have selected to create a delimited output file. You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"
W !,"you can do a file capture. Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!
S DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to an output file",DIR("A")="Select output type",DIR("B")="S" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PT
S BUDDELT=Y
Q:BUDDELT="S"
PT1 S DIR(0)="F^1:40",DIR("A")="Enter a filename for the delimited output (no more than 40 characters)" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PT
I Y["/" W !!!,"Your filename cannot contain a '/'." H 2 G PT1
S BUDDELF=Y
W !!,"When the report is finished your delimited output will be found in the",!,$$GETDEDIR()," directory."
Q
GETDEDIR() ;EP - get default directory
NEW D
S D=""
S D=$P($G(^AUTTSITE(1,1)),"^",2)
I D]"" Q D
S D=$P($G(^XTV(8989.3,1,"DEV")),"^",1)
I D]"" Q D
I $P(^AUTTSITE(1,0),U,21)=1 S D="/usr/spool/uucppublic/"
Q D
BUDCRPTE ; IHS/CMI/LAB - UDS REPORT PROCESSOR 03 Feb 2015 1:15 PM ; 23 Jan 2015 10:19 AM
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
PROC ;EP - called from xbdbque
+1 SET BUDJ=$JOB
SET BUDH=$HOROLOG
+2 KILL ^TMP($JOB)
+3 SET ^XTMP("BUDCRPT1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"UDS REPORT"
+4 SET ^XTMP("BUDCRP6B",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^UDS TABLE 6B LISTS"
+5 SET ^XTMP("BUDCRP7",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 7 LISTS"
+6 SET ^XTMP("BUDARP9DEL",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 9 DELIMINTED FILE"
+7 ;TABLE 3A
+8 ;3A
KILL BUDTOT
FOR X=1:1:39
SET $PIECE(BUDTOT("M"),U,X)=0
SET $PIECE(BUDTOT("F"),U,X)=0
SET $PIECE(BUDTOT("ALL"),U,X)=0
SET BUDTOT("U")=0
+9 SET BUD019("M")=""
SET BUD019("F")=""
SET BUD019("ALL")=""
+10 ;TABLE 5
+11 FOR X=1:1:6
SET BUDTAB5(X)="0^0"
+12 FOR X=7:1:38
SET BUDTAB5(X)="0^0"
+13 FOR X="9A","9B","20A","20A1","20A2","20B","20C","22A","22B","22C","22D","29A","10A","27a","27b","30A","30B","30C"
SET BUDTAB5(X)="0^0"
+14 ;TABLE 3B
+15 KILL BUDRACET
+16 ;S BUDRACET(LINE)=LINE NUMBER^LABEL^HISP/LATINO^NOT HISPANIC^UNREP^TOTAL^LINE LABEL 2^LINE LABEL 3"
+17 SET BUDRACET(1)="1.^Asian^0^0^0^0"
+18 SET BUDRACET("2A")="2a.^Native Hawaiian^0^0^0^0"
+19 SET BUDRACET("2B")="2b.^Other Pacific^0^0^0^0^Islander"
+20 SET BUDRACET(2)="2.^Total Hawaiian/^0^0^0^0^Pacific Islander^(Sum Lines 2a+2b)"
+21 SET BUDRACET(3)="3.^Black/African^0^0^0^0^American"
+22 SET BUDRACET(4)="4.^American Indian/^0^0^0^0^Alaska Native"
+23 SET BUDRACET(5)="5.^White^0^0^0^0"
+24 SET BUDRACET(6)="6.^More than one^0^0^0^0^race"
+25 SET BUDRACET(7)="7.^Unreported/^0^0^0^0^Refused to Report"
+26 SET BUDRACET(8)="8.^Total Patients^0^0^0^0^(Sum Lines 1+2^+ 3 to 7)"
+27 KILL BUDLANG
+28 SET BUDLANG(12)="12.^Patients Best Served in a Language Other Than^0^English"
+29 ;TABLE 6
+30 FOR X=1:1:26
SET $PIECE(BUDT6("V"),U,X)=0
SET $PIECE(BUDT6("P"),U,X)=0
+31 ;TABLE 4
+32 KILL BUDT4V
+33 FOR X=1:1:6
SET BUDT4V(X)=0
+34 FOR X=7,"8a","8b",8,9,"9a","10a","10b",10,11,12
SET BUDT4V(X)="0^0"
+35 FOR X=14:1:26
SET BUDT4V(X)=0
+36 ;TABLE 9 DELIMITED
+37 SET BUDT9C=0
+38 ;TABLE 9D
+39 KILL BUDT9TC
+40 ;COLUMN A & B
FOR X=1,"2a","2b",3,4,"5a","5b",6,7,"8a","8b",9,10,"11a","11b",12,13,14
SET BUDT9(X)="0^0"
+41 QUIT
PT ;EP
+1 SET (BUDROT,BUDDELT,BUDDELF)=""
+2 WRITE !!,"Please choose an output type. For an explanation of the delimited",!,"file please see the user manual.",!
+3 SET DIR(0)="S^P:Print Report on Printer or Screen;D:Create Delimited output file (for use in Excel)"
SET DIR("A")="Select an Output Option"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 SET BUDROT=Y
+6 IF BUDROT="P"
QUIT
+7 SET BUDDELF=""
SET BUDDELT=""
+8 WRITE !!,"You have selected to create a delimited output file. You can have this",!,"output file created as a text file in the pub directory, ",!,"OR you can have the delimited output display on your screen so that"
+9 WRITE !,"you can do a file capture. Keep in mind that if you choose to",!,"do a screen capture you CANNOT Queue your report to run in the background!!",!!
+10 SET DIR(0)="S^S:SCREEN - delimited output will display on screen for capture;F:FILE - delimited output will be written to an output file"
SET DIR("A")="Select output type"
SET DIR("B")="S"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
GOTO PT
+12 SET BUDDELT=Y
+13 IF BUDDELT="S"
QUIT
PT1 SET DIR(0)="F^1:40"
SET DIR("A")="Enter a filename for the delimited output (no more than 40 characters)"
KILL DA
DO ^DIR
KILL DIR
+1 IF $DATA(DIRUT)
GOTO PT
+2 IF Y["/"
WRITE !!!,"Your filename cannot contain a '/'."
HANG 2
GOTO PT1
+3 SET BUDDELF=Y
+4 WRITE !!,"When the report is finished your delimited output will be found in the",!,$$GETDEDIR()," directory."
+5 QUIT
GETDEDIR() ;EP - get default directory
+1 NEW D
+2 SET D=""
+3 SET D=$PIECE($GET(^AUTTSITE(1,1)),"^",2)
+4 IF D]""
QUIT D
+5 SET D=$PIECE($GET(^XTV(8989.3,1,"DEV")),"^",1)
+6 IF D]""
QUIT D
+7 IF $PIECE(^AUTTSITE(1,0),U,21)=1
SET D="/usr/spool/uucppublic/"
+8 QUIT D
