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

BUDERPTL.m

Go to the documentation of this file.
  1. BUDERPTL ; IHS/CMI/LAB - UDS ;
  1. ;;12.0;IHS/RPMS UNIFORM DATA SYSTEM;;NOV 22, 2017;Build 75
  1. ;
  1. START ;
  1. S BUDQUIT="",BUDGPG=0
  1. I $G(BUDTZL) S BUDGPG=0 D TZ
  1. Q:BUDQUIT
  1. I $G(BUDT3AL) S BUDGPG=0 D T3A
  1. Q:BUDQUIT
  1. I $G(BUDT3BRL) S BUDGPG=0 D T3BR
  1. Q:BUDQUIT
  1. I $G(BUDT4IPP) S BUDGPG=0 D T4IPPL
  1. Q:BUDQUIT
  1. I $G(BUDT4PMI) S BUDGPG=0 D T4PMIS
  1. Q:BUDQUIT
  1. I $G(BUDT4CHA) S BUDGPG=0 D T4CHAR
  1. Q:BUDQUIT
  1. I $G(BUDT5L1) S BUDGPG=0 D T51
  1. Q:BUDQUIT
  1. I $G(BUDT5L) S BUDGPG=0 D T5
  1. Q:BUDQUIT
  1. I $G(BUDT5L2) S BUDGPG=0 D T52
  1. Q:BUDQUIT
  1. I $G(BUDT6L) S BUDGPG=0 D T6
  1. Q:BUDQUIT
  1. Q
  1. S(V) ;
  1. S BUDDECNT=BUDDECNT+1
  1. S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
  1. Q
  1. T3BR ;
  1. D T3BR^BUDERPL4
  1. Q
  1. T4IPPL ;
  1. D T4IPPL^BUDERPL5
  1. Q
  1. T4PMIS ;
  1. D T4PMIS^BUDERPL5
  1. Q
  1. T4CHAR ;
  1. D T4CHAR^BUDERPL5
  1. Q
  1. T3A ;
  1. D T3A^BUDERPL2
  1. Q
  1. T52 ;
  1. D T52^BUDERPL2
  1. Q
  1. T51 ;EP
  1. D T51^BUDERPL2
  1. Q
  1. T5 ;
  1. I BUDROT="D" D T5DH
  1. S BUDP=0
  1. S BUDX2L="" F S BUDX2L=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L)) Q:BUDX2L=""!(BUDQUIT) D
  1. .Q:BUDX2L=35
  1. .S BUDX2L2="" F S BUDX2L2=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2)) Q:BUDX2L2=""!(BUDQUIT) D
  1. ..S BUDX2LL=BUDX2L_$S(BUDX2L2=0:"",1:BUDX2L2)
  1. ..S BUDY=$O(^BUDETFIV("B",BUDX2LL,0)),BUDY=$P(^BUDETFIV(BUDY,0),U,2)_" "_$P(^BUDETFIV(BUDY,0),U,3)_" "_$P(^BUDETFIV(BUDY,0),U,4)
  1. ..S BUDSUBT="Line "_BUDX2LL_" "_BUDY
  1. ..I BUDROT="P" D T5H Q:BUDQUIT
  1. ..I BUDROT="D" D S(""),S(BUDSUBT)
  1. ..S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
  1. ...S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
  1. ....S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
  1. .....S DFN=0 F S DFN=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT) D T5W
  1. I BUDROT="P" W !
  1. Q
  1. T5W I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,22),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))
  1. I BUDROT="P" W ?36,$E(BUDCCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD),?60,$E($P($$RACE^BUDERPTC(DFN),U,4),1,16)," (",$P($$RACE^BUDERPTC(DFN),U,3),")"
  1. K BUDVLST S BUDV=0 F S BUDV=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T5",BUDX2L,BUDX2L2,BUDCCOM,BUDAGE,BUDSEX,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT) D
  1. .S BUDVLST($P(^AUPNVSIT(BUDV,0),U),BUDV)=""
  1. S BUDDD=0 F S BUDDD=$O(BUDVLST(BUDDD)) Q:BUDDD=""!(BUDQUIT) D
  1. .S BUDV=0 F S BUDV=$O(BUDVLST(BUDDD,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT) D
  1. ..I BUDROT="P",$Y>(IOSL-3) D T5H Q:BUDQUIT
  1. ..I BUDROT="P" D
  1. ...W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,$E($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$E($$PRIMPROV^APCLV(BUDV,"D"),1,8),?50,$P(^AUPNVSIT(BUDV,0),U,7),?55,$E($$CLINIC^APCLV(BUDV,"E"),1,14),?70,$E($$LOCENC^APCLV(BUDV,"E"),1,9)
  1. ..I BUDROT="D" D
  1. ...S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCCOM,1,12)_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCCAD)
  1. ...S X=X_U_$E($P($$RACE^BUDERPTC(DFN),U,4),1,16)_" ("_$P($$RACE^BUDERPTC(DFN),U,3)_")"
  1. ...S X=X_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),"."))_U_$$PRIMPROV^APCLV(BUDV,"E")_U_$$PRIMPROV^APCLV(BUDV,"D")_U_$P(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")
  1. ...D S(X)
  1. ...Q
  1. Q
  1. T5DH ;
  1. D T5DH^BUDERPTE
  1. Q
  1. T5H ;
  1. G:'BUDGPG T5H1
  1. K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BUDQUIT=1 Q
  1. T5H1 ;
  1. W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1. W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1. W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1. W !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
  1. W !,$$CTR("Patient List for Table 5 Columns B & C, By Service Category",80),!
  1. W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1. S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  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:"")
  1. W $$CTR(X,80),!
  1. W $TR($J("",80)," ","-")
  1. I BUDP=0 W !,"List of all patients, sorted by defined Service Categories. Displays",!,"community, gender, age and visit data, including Provider codes.",!,"Age is calculated as of June 30." D
  1. .W !,"* (R) - denotes the value was obtained from the Race field"
  1. .W !," (C) - denotes the value was obtained from the Classification/Beneficiary field"
  1. W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE*"
  1. W !?5,"VISIT DATE",?25,"PROV TYPE",?41,"PROV CD",?50,"SRV",?55,"CLINIC",?62,"LOCATION"
  1. W !,$TR($J("",80)," ","-")
  1. W !!,BUDSUBT,!
  1. S BUDP=1
  1. Q
  1. TZ ;
  1. S BUDP=0
  1. I BUDROT="P" D TZH Q:BUDQUIT
  1. I BUDROT="D" D TZHD^BUDERPTD
  1. S BUDYY=0 F S BUDYY=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY)) Q:BUDYY'=+BUDYY!(BUDQUIT) D TZ1
  1. Q:BUDQUIT
  1. ;
  1. S BUDYY="Unknown Residence" D TZ2
  1. Q
  1. TZ2 ;
  1. S BUDINS="" F S BUDINS=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"Z",BUDYY,BUDINS)) Q:BUDINS=""!(BUDQUIT) D
  1. .S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"Z",BUDYY,BUDINS,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
  1. ..S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"Z",BUDYY,BUDINS,BUDCCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
  1. ...S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"Z",BUDYY,BUDINS,BUDCCOM,BUDSEX,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
  1. ....S DFN="" F S DFN=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"Z",BUDYY,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
  1. .....I BUDROT="P",$Y>(IOSL-3) D TZH Q:BUDQUIT
  1. .....I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,22),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$E(BUDCCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,"Unk Res",?65,$$INS(BUDINS)
  1. .....S BUDV=0 F S BUDV=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"Z",BUDYY,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT) D
  1. ......I BUDROT="P",$Y>(IOSL-3) D TZH Q:BUDQUIT
  1. ......I BUDROT="P" W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,$E($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$P(^AUPNVSIT(BUDV,0),U,7),?45,$E($$CLINIC^APCLV(BUDV,"E"),1,14),?62,$E($$LOCENC^APCLV(BUDV,"E"),1,14)
  1. ......I BUDROT="D" D
  1. .......S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCCOM,1,12)_U_$P(^DPT(DFN,0),U,2)_U_"Unk Res"_U_$$INS(BUDINS)
  1. .......S X=X_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),"."))_U_$$PRIMPROV^APCLV(BUDV,"E")_U_$P(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")
  1. .......D S^BUDERPTD(X)
  1. I BUDROT="P" W !
  1. Q
  1. TZ1 ;
  1. S BUDZIP="" F S BUDZIP=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP)) Q:BUDZIP=""!(BUDQUIT) D
  1. .S BUDINS="" F S BUDINS=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDINS)) Q:BUDINS=""!(BUDQUIT) D
  1. ..S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDINS,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
  1. ...S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDINS,BUDCCOM,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
  1. ....S BUDNAME="" F S BUDNAME=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDINS,BUDCCOM,BUDSEX,BUDNAME)) Q:BUDNAME=""!(BUDQUIT) D
  1. .....S DFN="" F S DFN=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN)) Q:DFN'=+DFN!(BUDQUIT) D
  1. ......I BUDROT="P",$Y>(IOSL-3) D TZH Q:BUDQUIT
  1. ......I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,22),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?36,$E(BUDCCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,BUDZIP,?65,$$INS(BUDINS)
  1. ......S BUDV=0 F S BUDV=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"ZNEW",BUDYY,BUDZIP,BUDINS,BUDCCOM,BUDSEX,BUDNAME,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT) D
  1. .......I BUDROT="P",$Y>(IOSL-3) D TZH Q:BUDQUIT
  1. .......I BUDROT="P" W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,$E($$PRIMPROV^APCLV(BUDV,"E"),1,14),?42,$P(^AUPNVSIT(BUDV,0),U,7),?45,$E($$CLINIC^APCLV(BUDV,"E"),1,14),?62,$E($$LOCENC^APCLV(BUDV,"E"),1,14)
  1. .......I BUDROT="D" D
  1. ........S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCCOM,1,12)_U_$P(^DPT(DFN,0),U,2)_U_BUDZIP_U_$$INS(BUDINS)
  1. ........S X=X_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),"."))_U_$$PRIMPROV^APCLV(BUDV,"E")_U_$P(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")
  1. ........D S^BUDERPTD(X)
  1. I BUDROT="P" W !
  1. Q
  1. INS(Z) ;
  1. I Z="e" Q "PI"
  1. I Z="d" Q "Medicare"
  1. I Z="c" Q "MCD/CHIP/OP"
  1. I Z="b" Q "None/Unins"
  1. Q ""
  1. TZH ;
  1. I BUDROT="D" Q
  1. D TZH^BUDERPTD
  1. Q
  1. T6 ;
  1. I BUDROT="D" D T6DH
  1. S BUDP=0
  1. S BUDX2L=0 F S BUDX2L=$O(^BUDETSC("B",BUDX2L)) Q:BUDX2L'=+BUDX2L S BUDY=0 F S BUDY=$O(^BUDETSC("B",BUDX2L,BUDY)) Q:BUDY'=+BUDY D
  1. .Q:'$D(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L))
  1. .I BUDROT="P" D T6H Q:BUDQUIT
  1. .S BUDLLL="",X=0 F S X=$O(^BUDETSC(BUDY,2,X)) Q:X'=+X S BUDLLL=BUDLLL_" "_$P(^BUDETSC(BUDY,2,X,0),U,1)
  1. .I BUDROT="P" W !!,"Line ",$P(^BUDETSC(BUDY,0),U,3)," ",BUDLLL
  1. .I BUDROT="D" D S(""),S("Line "_$P(^BUDETSC(BUDY,0),U,3)_" "_BUDLLL)
  1. .S BUDCCOM="" F S BUDCCOM=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM)) Q:BUDCCOM=""!(BUDQUIT) D
  1. ..S BUDAGE="" F S BUDAGE=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE)) Q:BUDAGE=""!(BUDQUIT) D
  1. ...S BUDSEX="" F S BUDSEX=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX)) Q:BUDSEX=""!(BUDQUIT) D
  1. ....S DFN=0 F S DFN=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN)) Q:DFN'=+DFN!(BUDQUIT) D T6W
  1. I BUDROT="P" W !
  1. Q
  1. T6W ;
  1. I BUDROT="P",$Y>(IOSL-3) D T6H Q:BUDQUIT W !!,"Line ",$P(^BUDETSC(BUDY,0),U,3)," ",BUDLLL
  1. I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,22),?24,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))
  1. I BUDROT="P" W ?36,$E(BUDCCOM,1,12),?51,$P(^DPT(DFN,0),U,2),?55,$$AGE^AUPNPAT(DFN,BUDCCAD),?60,$E($P($$RACE^BUDERPTC(DFN),U,4),1,16)," (",$P($$RACE^BUDERPTC(DFN),U,3),")"
  1. K BUDVRR S BUDV=0,BUDVC=0 F S BUDV=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,BUDV)) Q:BUDV'=+BUDV!(BUDQUIT) S BUDVC=BUDVC+1,BUDVRR($$VD^APCLV(BUDV),BUDVC)=BUDV
  1. S BUDVD=0 F S BUDVD=$O(BUDVRR(BUDVD)) Q:BUDVD="" S BUDVC=0 F S BUDVC=$O(BUDVRR(BUDVD,BUDVC)) Q:BUDVC="" D
  1. .I BUDROT="P",$Y>(IOSL-3) D T6H Q:BUDQUIT W !!,"Line ",$P(^BUDETSC(BUDY,0),U,3)," ",BUDLLL
  1. .S BUDV=BUDVRR(BUDVD,BUDVC)
  1. .S Z=^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,BUDV)
  1. .F A=1:1 S J=$P(Z,U,A) Q:J="" D
  1. ..I BUDROT="P" W !?5,$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),".")),?25,J,?40,$P(^AUPNVSIT(BUDV,0),U,7),?45,$E($$CLINIC^APCLV(BUDV,"E"),1,15),?62,$E($$LOCENC^APCLV(BUDV,"E"),1,15) Q
  1. ..S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCCOM,1,12)_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCCAD)
  1. ..S X=X_U_$E($P($$RACE^BUDERPTC(DFN),U,4),1,16)_" ("_$P($$RACE^BUDERPTC(DFN),U,3)_")"
  1. ..S X=X_U_$$FMTE^XLFDT($P($P(^AUPNVSIT(BUDV,0),U),"."))_U_J_U_$P(^AUPNVSIT(BUDV,0),U,7)_U_$$CLINIC^APCLV(BUDV,"E")_U_$$LOCENC^APCLV(BUDV,"E")
  1. ..D S^BUDERPTD(X)
  1. ..Q
  1. I BUDX2L=35 D
  1. .S BUDW=0 F S BUDW=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT) D
  1. ..I BUDROT="P" W !?5,$P(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW),U,2),?25,$P(^(BUDW),U,1)
  1. ..I BUDROT="D" D
  1. ...S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCCOM,1,12)_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCCAD)
  1. ...S X=X_U_$E($P($$RACE^BUDERPTC(DFN),U,4),1,16)_" ("_$P($$RACE^BUDERPTC(DFN),U,3)_")"
  1. ...S X=X_U_$P(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,"WH","MAM",BUDW),U,2)_U_$P(^(BUDW),U,1)
  1. ...D S(X)
  1. I BUDX2L=36 D
  1. .S BUDW=0 F S BUDW=$O(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,"WH","PAP",BUDW)) Q:BUDW'=+BUDW!(BUDQUIT) D
  1. ..I BUDROT="P" W !?5,$P(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,"WH","PAP",BUDW),U,2),?25,$P(^(BUDW),U,1)
  1. ..I BUDROT="D" D
  1. ...S X=$P(^DPT(DFN,0),U,1)_U_$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2))_U_$E(BUDCCOM,1,12)_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCCAD)
  1. ...S X=X_U_$E($P($$RACE^BUDERPTC(DFN),U,4),1,16)_" ("_$P($$RACE^BUDERPTC(DFN),U,3)_")"
  1. ...S X=X_U_$P(^XTMP("BUDERPT1",BUDJ,BUDH,"T6",BUDX2L,BUDCCOM,BUDAGE,BUDSEX,DFN,"WH","PAP",BUDW),U,2)_U_$P(^(BUDW),U,1)
  1. ...D S(X)
  1. Q
  1. T6H ;
  1. I BUDROT="D" D T6DH Q
  1. G:'BUDGPG T6H1
  1. K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BUDQUIT=1 Q
  1. T6H1 ;
  1. W:$D(IOF) @IOF S BUDGPG=BUDGPG+1
  1. W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1. W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BUDGPG,!
  1. W !,$$CTR("*** RPMS Uniform Data System (UDS) ***",80)
  1. W !,$$CTR("Patient List for Table 6A, By Diagnosis Category",80),!
  1. W $$CTR($P(^DIC(4,BUDSITE,0),U),80),!
  1. S X="Reporting Period: "_$$FMTE^XLFDT(BUDBD)_" to "_$$FMTE^XLFDT(BUDED) W $$CTR(X,80),!
  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:"")
  1. W $$CTR(X,80),!
  1. W $TR($J("",80)," ","-")
  1. I BUDP=0 W !,"List of all patients, sorted by diagnosis and tests/screening",!,"categories. Displays community, gender, age and visit data, and codes." D
  1. .W !,"* (R) - denotes the value was obtained from the Race field"
  1. .W !," (C) - denotes the value was obtained from the Classification/Beneficiary field"
  1. W !,"PATIENT NAME",?24,"HRN",?36,"COMMUNITY",?50,"SEX",?55,"AGE",?60,"RACE*"
  1. W !?5,"VISIT DATE",?25,"VALUE",?41,"SRV",?45,"CLINIC",?63,"LOCATION"
  1. W !,$TR($J("",80)," ","-")
  1. S BUDP=1
  1. Q
  1. CTR(X,Y) ;
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. T6DH ;
  1. D T6DH^BUDERPTD
  1. Q