BUDCRPTE.m

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