- 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