Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BUDHRPTE

BUDHRPTE.m

Go to the documentation of this file. 
  1. BUDHRPTE ;IHS/CMI/LAB - UDS REPORT PROCESS;
  1.  ;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
  1.  ;
  1.  ;
  1. PROC ;EP - called from xbdbque
  1.  S BUDJ=$J,BUDH=$H
  1.  K ^TMP($J)
  1.  ;SET DIAG LIST FOR TABLE 6A
  1.  K ^BUDHTSC("AC")
  1.  S BUD1=0 F  S BUD1=$O(^BUDHTSC(BUD1)) Q:BUD1'=+BUD1  D
  1.  .S T=$P($G(^BUDHTSC(BUD1,0)),U,4)
  1.  .Q:T=""
  1.  .K ^BUDHTSC(BUD1,7)
  1.  .K BUDTAX
  1.  .D BLDTAX^ATXAPI(T,"BUDTAX",$O(^ATXAX("B",T,0)),"")
  1.  .S X=0,C=0 F  S X=$O(BUDTAX(X)) Q:X'=+X  D
  1.  ..S C=C+1
  1.  ..S ^BUDHTSC(BUD1,7,C,0)=$P(BUDTAX(X),U,1)_U_X_U_$P(BUDTAX(X),U,3)
  1.  .S ^BUDHTSC(BUD1,7,0)="^90669.9077^"_C_"^"_C
  1.  .S DIK="^BUDHTSC(",DA=BUD1 D IX1^DIK
  1.  S ^XTMP("BUDHRPT1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"UDS REPORT"
  1.  S ^XTMP("BUDHRP6B",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^UDS TABLE 6B LISTS"
  1.  S ^XTMP("BUDHRP7",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 7 LISTS"
  1.  S ^XTMP("BUDARP9DEL",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BUD TABLE 9 DELIMINTED FILE"
  1.  ;TABLE 3A
  1.  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
  1.  S BUD019("M")="",BUD019("F")="",BUD019("ALL")=""
  1.  ;TABLE 5
  1.  F X=1:1:6 S BUDTAB5(X)="0^0"
  1.  F X=7:1:38 S BUDTAB5(X)="0^0"
  1.  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"
  1.  ;TABLE 3B
  1.  K BUDRACET
  1.  ;S BUDRACET(LINE)=LINE NUMBER^LABEL^HISP/LATINO^NOT HISPANIC^UNREP^TOTAL^LINE LABEL 2^LINE LABEL 3"
  1.  S BUDRACET(1)="1.^Asian^0^0^0^0"
  1.  S BUDRACET("2A")="2a.^Native Hawaiian^0^0^0^0"
  1.  S BUDRACET("2B")="2b.^Other Pacific^0^0^0^0^Islander"
  1.  S BUDRACET(2)="2.^Total Native^0^0^0^0^Hawaiian/Other Pacific ^Islander (Sum Lines ^2a+2b)"
  1.  S BUDRACET(3)="3.^Black/African^0^0^0^0^American"
  1.  S BUDRACET(4)="4.^American Indian/^0^0^0^0^Alaska Native"
  1.  S BUDRACET(5)="5.^White^0^0^0^0"
  1.  S BUDRACET(6)="6.^More than one^0^0^0^0^race"
  1.  S BUDRACET(7)="7.^Unreported/^0^0^0^0^Refused to report^race"
  1.  S BUDRACET(8)="8.^Total Patients^0^0^0^0^(Sum Lines 1+2^+ 3 to 7)"
  1.  K BUDLANG
  1.  S BUDLANG(12)="12.^Patients Best Served in a Language Other Than^0^English"
  1.  ;SEXUAL ORIENTATION
  1.  S BUDSOT(13)="13.^Lesbian or Gay^0^0^0^0"
  1.  S BUDSOT(14)="14.^Straight (not lesbian or gay)^0^0^0^0^"
  1.  S BUDSOT(15)="15.^Bisexual^0^0^0^0^"
  1.  S BUDSOT(16)="16.^Something else^0^0^0^0^"
  1.  S BUDSOT(17)="17.^Don't know^0^0^0^0^"
  1.  S BUDSOT(18)="18.^Chose not to disclose^0^0^0^0^"
  1.  S BUDSOT(19)="19.^Total Patients ^0^0^0^0^(Sum Lines 13 to 18)"
  1.  ;GENDER IDENTITY
  1.  S BUDGIDT(20)="20.^Male^0^0^0^0"
  1.  S BUDGIDT(21)="21.^Female^0^0^0^0^"
  1.  S BUDGIDT(22)="22.^Transgender Male/^0^0^0^0^Female-to-Male"
  1.  S BUDGIDT(23)="23.^Transgender Female/^0^0^0^0^Male-to-Female"
  1.  S BUDGIDT(24)="24.^Other^0^0^0^0^"
  1.  S BUDGIDT(25)="25.^Chose not to disclose^0^0^0^0^"
  1.  S BUDGIDT(26)="26.^Total Patients ^0^0^0^0^(Sum Lines 20 to 25)"
  1.  ;TABLE 6
  1.  F X=1:1:26 S $P(BUDT6("V"),U,X)=0,$P(BUDT6("P"),U,X)=0
  1.  ;TABLE 4
  1.  K BUDT4V
  1.  F X=1:1:6 S BUDT4V(X)=0
  1.  F X=7,"8a","8b",8,9,"9a","10a","10b",10,11,12 S BUDT4V(X)="0^0"
  1.  F X=14:1:26 S BUDT4V(X)=0
  1.  ;TABLE 9 DELIMITED
  1.  S BUDT9C=0
  1.  ;TABLE 9D
  1.  K BUDT9TC
  1.  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
  1.  Q
  1. PT ;EP
  1.  S (BUDROT,BUDDELT,BUDDELF)=""
  1.  W !!,"Please choose an output type.  For an explanation of the delimited",!,"file please see the user manual.",!
  1.  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
  1.  I $D(DIRUT) Q
  1.  S BUDROT=Y
  1.  Q:BUDROT="P"
  1.  S BUDDELF="",BUDDELT=""
  1.  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"
  1.  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!!",!!
  1.  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
  1.  I $D(DIRUT) G PT
  1.  S BUDDELT=Y
  1.  Q:BUDDELT="S"
  1. 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
  1.  I $D(DIRUT) G PT
  1.  I Y["/" W !!!,"Your filename cannot contain a '/'." H 2 G PT1
  1.  S BUDDELF=Y
  1.  W !!,"When the report is finished your delimited output will be found in the",!,$$GETDEDIR()," directory."
  1.  Q
  1. GETDEDIR() ;EP - get default directory
  1.  NEW D
  1.  S D=""
  1.  S D=$P($G(^AUTTSITE(1,1)),"^",2)
  1.  I D]"" Q D
  1.  S D=$P($G(^XTV(8989.3,1,"DEV")),"^",1)
  1.  I D]"" Q D
  1.  I $P(^AUTTSITE(1,0),U,21)=1 S D="/usr/spool/uucppublic/"
  1.  Q D
  1. SEXOR ;EP
  1.  ;SEXUAL ORIENTATION IS NOT CAPTURED AS OF V11 SO ALL GO IN DON'T KNOW LLINE 17
  1.  S $P(BUDSOT(17),U,3)=$P(BUDSOT(17),U,3)+1
  1.  S $P(BUDSOT(19),U,3)=$P(BUDSOT(19),U,3)+1
  1.  Q
  1. GENDIDEN ;EP
  1.  ;GENDER IDENTITY IS NOT CAPTURED AS OF V11 SO ALL GO IN OTHER LINE 24
  1.  S $P(BUDGIDT(24),U,3)=$P(BUDGIDT(24),U,3)+1
  1.  S $P(BUDGIDT(26),U,3)=$P(BUDGIDT(26),U,3)+1
  1.  Q
  1. T5DH ;EP
  1.  D S(""),S(""),S("")
  1.  D S("***** SENSITIVE INFORMATION *****")
  1.  D S($P(^VA(200,DUZ,0),U,2)_"       "_$$FMTE^XLFDT(DT))
  1.  D S("***  RPMS Uniform Data System (UDS) "_$$VER^BUDHBAN()_"  ***")
  1.  D S("Patient List for Table 5 Columns B & C, By Service Category")
  1.  D S($P(^DIC(4,BUDSITE,0),U))
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
  1.  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)
  1.  D S(" ")
  1.  D S("List of all patients, sorted by defined Service Categories.  Displays")
  1.  D S("community, gender, age and visit data, including Provider codes.")
  1.  D S("* (R) - denotes the value was obtained from the Race field")
  1.  D S("  (C) - denotes the value was obtained from the Classification/Beneficiary field")
  1.  D S("Age on the patient list is calculated as of June 30.")
  1.  D S("")
  1.  D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^RACE*^VISIT DATE^PROV TYPE^PROV CD^SRV^CLINIC^LOCATION")
  1.  Q
  1. S(V) ;
  1.  S BUDDECNT=BUDDECNT+1
  1.  S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
  1.  Q
  1. DEP2HD ;
  1.  D S(),S(),S()
  1.  D S("***** SENSITIVE INFORMATION *****")
  1.  D S($P(^VA(200,DUZ,0),U,2)_"    "_$$FMTE^XLFDT(DT))
  1.  D S("***  RPMS Uniform Data System (UDS) "_$$VER^BUDHBAN()_"  ***")
  1.  D S("Patient List for Table 6B, Section M")
  1.  D S("Patients not Screened for Depression or w/o follow up")
  1.  D S($P(^DIC(4,BUDSITE,0),U))
  1.  S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) D S(X)
  1.  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)
  1.  D HT6B^BUDHDU("DEP2")
  1.  D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^Depression Scrn: Date/Result^Follow-up Plan: Date")
  1.  Q