BUDERPTE ;IHS/CMI/LAB - UDS REPORT PROCESS;
;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75
;
;
PROC ;EP - called from xbdbque
S BUDJ=$J,BUDH=$H
K ^TMP($J)
;SET DIAG LIST FOR TABLE 6A
K ^BUDETSC("AC")
S BUD1=0 F S BUD1=$O(^BUDETSC(BUD1)) Q:BUD1'=+BUD1 D
.S T=$P(^BUDETSC(BUD1,0),U,4)
.Q:T=""
.K ^BUDETSC(BUD1,7)
.K BUDTAX
.D BLDTAX^ATXAPI(T,"BUDTAX",$O(^ATXAX("B",T,0)),"")
.S X=0,C=0 F S X=$O(BUDTAX(X)) Q:X'=+X D
..S C=C+1
..S ^BUDETSC(BUD1,7,C,0)=$P(BUDTAX(X),U,1)_U_X_U_$P(BUDTAX(X),U,3)
.S ^BUDETSC(BUD1,7,0)="^90669.77^"_C_"^"_C
.S DIK="^BUDETSC(",DA=BUD1 D IX1^DIK
S ^XTMP("BUDERPT1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"UDS REPORT"
S ^XTMP("BUDERP6B",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^UDS TABLE 6B LISTS"
S ^XTMP("BUDERP7",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","17a","29a","27c","29b" 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 Native^0^0^0^0^Hawaiian/Other 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^race"
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"
;SEXUAL ORIENTATION
S BUDSOT(13)="13.^Lesbian or Gay^0^0^0^0"
S BUDSOT(14)="14.^Straight (not lesbian or gay)^0^0^0^0^"
S BUDSOT(15)="15.^Bisexual^0^0^0^0^"
S BUDSOT(16)="16.^Something else^0^0^0^0^"
S BUDSOT(17)="17.^Don't know^0^0^0^0^"
S BUDSOT(18)="18.^Chose not to disclose^0^0^0^0^"
S BUDSOT(19)="19.^Total Patients ^0^0^0^0^(Sum Lines 13 to 18)"
;GENDER IDENTITY
S BUDGIDT(20)="20.^Male^0^0^0^0"
S BUDGIDT(21)="21.^Female^0^0^0^0^"
S BUDGIDT(22)="22.^Transgender Male/^0^0^0^0^Female-to-Male"
S BUDGIDT(23)="23.^Transgender Female/^0^0^0^0^Male-to-Female"
S BUDGIDT(24)="24.^Other^0^0^0^0^"
S BUDGIDT(25)="25.^Chose not to disclose^0^0^0^0^"
S BUDGIDT(26)="26.^Total Patients ^0^0^0^0^(Sum Lines 20 to 25)"
;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
SEXOR ;EP
;SEXUAL ORIENTATION IS NOT CAPTURED AS OF V11 SO ALL GO IN DON'T KNOW LLINE 17
S $P(BUDSOT(17),U,3)=$P(BUDSOT(17),U,3)+1
S $P(BUDSOT(19),U,3)=$P(BUDSOT(19),U,3)+1
Q
GENDIDEN ;EP
;GENDER IDENTITY IS NOT CAPTURED AS OF V11 SO ALL GO IN OTHER LINE 24
S $P(BUDGIDT(24),U,3)=$P(BUDGIDT(24),U,3)+1
S $P(BUDGIDT(26),U,3)=$P(BUDGIDT(26),U,3)+1
Q
T5DH ;EP
D S(""),S(""),S("")
D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
D S($P(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
D S("*** RPMS Uniform Data System (UDS) ***")
D S("Patient List for Table 5 Columns B & C, By Service Category")
D S($P(^DIC(4,BUDSITE,0),U))
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
S X="Population: "_$S($G(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDBEN)=3:"All (both Indian/Alaskan Natives and Non 01)",BUDBEN=4:"Homeless",1:"") D S(X)
D S(" ")
D S("List of all patients, sorted by defined Service Categories. Displays")
D S("community, gender, age and visit data, including Provider codes.")
D S("* (R) - denotes the value was obtained from the Race field")
D S(" (C) - denotes the value was obtained from the Classification/Beneficiary field")
D S("Age is calculated as of June 30.")
D S("")
D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^VISIT DATE^PROV TYPE^PROV CD^SRV^CLINIC^LOCATION")
Q
S(V) ;
S BUDDECNT=BUDDECNT+1
S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
Q
DEP2HD ;
D S(),S(),S()
D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
D S($P(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
D S("*** RPMS Uniform Data System (UDS) ***")
D S("Patient List for Table 6B, Section M")
D S("Patients not Screened for Depression or w/o follow up")
D S($P(^DIC(4,BUDSITE,0),U))
S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
S X="Population: "_$S($G(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDBEN)=3:"All (both Indian/Alaskan Natives and Non 01)",BUDBEN=4:"Homeless",1:"") D S(X)
D HT6B^BUDEDU("DEP2")
D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^Depression Scrn: Date/Result^Follow-up Plan: Date")
Q
BUDERPTE ;IHS/CMI/LAB - UDS REPORT PROCESS;
+1 ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75
+2 ;
+3 ;
PROC ;EP - called from xbdbque
+1 SET BUDJ=$JOB
SET BUDH=$HOROLOG
+2 KILL ^TMP($JOB)
+3 ;SET DIAG LIST FOR TABLE 6A
+4 KILL ^BUDETSC("AC")
+5 SET BUD1=0
FOR
SET BUD1=$ORDER(^BUDETSC(BUD1))
IF BUD1'=+BUD1
QUIT
Begin DoDot:1
+6 SET T=$PIECE(^BUDETSC(BUD1,0),U,4)
+7 IF T=""
QUIT
+8 KILL ^BUDETSC(BUD1,7)
+9 KILL BUDTAX
+10 DO BLDTAX^ATXAPI(T,"BUDTAX",$ORDER(^ATXAX("B",T,0)),"")
+11 SET X=0
SET C=0
FOR
SET X=$ORDER(BUDTAX(X))
IF X'=+X
QUIT
Begin DoDot:2
+12 SET C=C+1
+13 SET ^BUDETSC(BUD1,7,C,0)=$PIECE(BUDTAX(X),U,1)_U_X_U_$PIECE(BUDTAX(X),U,3)
End DoDot:2
+14 SET ^BUDETSC(BUD1,7,0)="^90669.77^"_C_"^"_C
+15 SET DIK="^BUDETSC("
SET DA=BUD1
DO IX1^DIK
End DoDot:1
+16 SET ^XTMP("BUDERPT1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"UDS REPORT"
+17 SET ^XTMP("BUDERP6B",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^UDS TABLE 6B LISTS"
+18 SET ^XTMP("BUDERP7",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 7 LISTS"
+19 SET ^XTMP("BUDARP9DEL",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 9 DELIMINTED FILE"
+20 ;TABLE 3A
+21 ;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
+22 SET BUD019("M")=""
SET BUD019("F")=""
SET BUD019("ALL")=""
+23 ;TABLE 5
+24 FOR X=1:1:6
SET BUDTAB5(X)="0^0"
+25 FOR X=7:1:38
SET BUDTAB5(X)="0^0"
+26 FOR X="9A","9B","20A","20A1","20A2","20B","20C","22A","22B","22C","22D","29A","10A","27a","27b","30A","30B","30C","17a","29a","27c","29b"
SET BUDTAB5(X)="0^0"
+27 ;TABLE 3B
+28 KILL BUDRACET
+29 ;S BUDRACET(LINE)=LINE NUMBER^LABEL^HISP/LATINO^NOT HISPANIC^UNREP^TOTAL^LINE LABEL 2^LINE LABEL 3"
+30 SET BUDRACET(1)="1.^Asian^0^0^0^0"
+31 SET BUDRACET("2A")="2a.^Native Hawaiian^0^0^0^0"
+32 SET BUDRACET("2B")="2b.^Other Pacific^0^0^0^0^Islander"
+33 SET BUDRACET(2)="2.^Total Native^0^0^0^0^Hawaiian/Other Pacific ^Islander (Sum Lines ^2a+2b)"
+34 SET BUDRACET(3)="3.^Black/African^0^0^0^0^American"
+35 SET BUDRACET(4)="4.^American Indian/^0^0^0^0^Alaska Native"
+36 SET BUDRACET(5)="5.^White^0^0^0^0"
+37 SET BUDRACET(6)="6.^More than one^0^0^0^0^race"
+38 SET BUDRACET(7)="7.^Unreported/^0^0^0^0^Refused to report^race"
+39 SET BUDRACET(8)="8.^Total Patients^0^0^0^0^(Sum Lines 1+2^+ 3 to 7)"
+40 KILL BUDLANG
+41 SET BUDLANG(12)="12.^Patients Best Served in a Language Other Than^0^English"
+42 ;SEXUAL ORIENTATION
+43 SET BUDSOT(13)="13.^Lesbian or Gay^0^0^0^0"
+44 SET BUDSOT(14)="14.^Straight (not lesbian or gay)^0^0^0^0^"
+45 SET BUDSOT(15)="15.^Bisexual^0^0^0^0^"
+46 SET BUDSOT(16)="16.^Something else^0^0^0^0^"
+47 SET BUDSOT(17)="17.^Don't know^0^0^0^0^"
+48 SET BUDSOT(18)="18.^Chose not to disclose^0^0^0^0^"
+49 SET BUDSOT(19)="19.^Total Patients ^0^0^0^0^(Sum Lines 13 to 18)"
+50 ;GENDER IDENTITY
+51 SET BUDGIDT(20)="20.^Male^0^0^0^0"
+52 SET BUDGIDT(21)="21.^Female^0^0^0^0^"
+53 SET BUDGIDT(22)="22.^Transgender Male/^0^0^0^0^Female-to-Male"
+54 SET BUDGIDT(23)="23.^Transgender Female/^0^0^0^0^Male-to-Female"
+55 SET BUDGIDT(24)="24.^Other^0^0^0^0^"
+56 SET BUDGIDT(25)="25.^Chose not to disclose^0^0^0^0^"
+57 SET BUDGIDT(26)="26.^Total Patients ^0^0^0^0^(Sum Lines 20 to 25)"
+58 ;TABLE 6
+59 FOR X=1:1:26
SET $PIECE(BUDT6("V"),U,X)=0
SET $PIECE(BUDT6("P"),U,X)=0
+60 ;TABLE 4
+61 KILL BUDT4V
+62 FOR X=1:1:6
SET BUDT4V(X)=0
+63 FOR X=7,"8a","8b",8,9,"9a","10a","10b",10,11,12
SET BUDT4V(X)="0^0"
+64 FOR X=14:1:26
SET BUDT4V(X)=0
+65 ;TABLE 9 DELIMITED
+66 SET BUDT9C=0
+67 ;TABLE 9D
+68 KILL BUDT9TC
+69 ;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"
+70 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
SEXOR ;EP
+1 ;SEXUAL ORIENTATION IS NOT CAPTURED AS OF V11 SO ALL GO IN DON'T KNOW LLINE 17
+2 SET $PIECE(BUDSOT(17),U,3)=$PIECE(BUDSOT(17),U,3)+1
+3 SET $PIECE(BUDSOT(19),U,3)=$PIECE(BUDSOT(19),U,3)+1
+4 QUIT
GENDIDEN ;EP
+1 ;GENDER IDENTITY IS NOT CAPTURED AS OF V11 SO ALL GO IN OTHER LINE 24
+2 SET $PIECE(BUDGIDT(24),U,3)=$PIECE(BUDGIDT(24),U,3)+1
+3 SET $PIECE(BUDGIDT(26),U,3)=$PIECE(BUDGIDT(26),U,3)+1
+4 QUIT
T5DH ;EP
+1 DO S("")
DO S("")
DO S("")
+2 DO S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
+3 DO S($PIECE(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
+4 DO S("*** RPMS Uniform Data System (UDS) ***")
+5 DO S("Patient List for Table 5 Columns B & C, By Service Category")
+6 DO S($PIECE(^DIC(4,BUDSITE,0),U))
+7 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
DO S(X)
+8 SET X="Population: "_$SELECT($GET(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDBEN)=3:"All (both Indian/Alaskan Natives and Non 01)",BUDBEN=4:"Homeless",1:"")
DO S(X)
+9 DO S(" ")
+10 DO S("List of all patients, sorted by defined Service Categories. Displays")
+11 DO S("community, gender, age and visit data, including Provider codes.")
+12 DO S("* (R) - denotes the value was obtained from the Race field")
+13 DO S(" (C) - denotes the value was obtained from the Classification/Beneficiary field")
+14 DO S("Age is calculated as of June 30.")
+15 DO S("")
+16 DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^VISIT DATE^PROV TYPE^PROV CD^SRV^CLINIC^LOCATION")
+17 QUIT
S(V) ;
+1 SET BUDDECNT=BUDDECNT+1
+2 SET ^TMP($JOB,"BUDDEL",BUDDECNT)=$GET(V)
+3 QUIT
DEP2HD ;
+1 DO S()
DO S()
DO S()
+2 DO S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
+3 DO S($PIECE(^VA(200,DUZ,0),U,2)_" "_$$FMTE^XLFDT(DT))
+4 DO S("*** RPMS Uniform Data System (UDS) ***")
+5 DO S("Patient List for Table 6B, Section M")
+6 DO S("Patients not Screened for Depression or w/o follow up")
+7 DO S($PIECE(^DIC(4,BUDSITE,0),U))
+8 SET X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED)
DO S(X)
+9 SET X="Population: "_$SELECT($GET(BUDBEN)=1:"Indian/Alaskan Native (Classification 01)",$GET(BUDBEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$GET(BUDBEN)=3:"All (both Indian/Alaskan Natives and Non 01)",BUDBEN=4:"Homeless",1:"")
DO S(X)
+10 DO HT6B^BUDEDU("DEP2")
+11 DO S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^Depression Scrn: Date/Result^Follow-up Plan: Date")
+12 QUIT
