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

BUDCRP6N.m

Go to the documentation of this file. 
  1. BUDCRP6N ; IHS/CMI/LAB - UDS REPORT  ;
  1.  ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
  1.  ;
  1. K ;EP ;CRC
  1.  S BUDDOB=$P(^DPT(DFN,0),U,3)
  1.  S BUD50RB=($E(BUDBD,1,3)-51)_"1231"
  1.  S BUD75RB=($E(BUDBD,1,3)-74)_"0101"
  1.  Q:BUDDOB<BUD75RB
  1.  Q:BUDDOB>BUD50RB
  1.  Q:BUDMEDV<1
  1.  Q:$$CRC(DFN,BUDED)
  1.  S BUDCRCT=$$SCREEN(DFN,,$$VD^APCLV(BUDLASTV))
  1.  I BUDCRCT]"" S BUDSECTK("CRC")=$G(BUDSECTK("CRC"))+1
  1.  S BUDCRCL=""
  1.  S BUDSECTK("PTS")=$G(BUDSECTK("PTS"))+1 D
  1.  .I $G(BUDCRC2L) D
  1.  ..I BUDCRCT="" D LAST S ^XTMP("BUDCRP6B",BUDJ,BUDH,"CRC2",BUDAGE,$P(^DPT(DFN,0),U),BUDCOM,DFN)=$P(BUDCRCL,U)
  1.  .I $G(BUDCRC1L) D
  1.  ..I BUDCRCT]"" S ^XTMP("BUDCRP6B",BUDJ,BUDH,"CRC1",BUDAGE,$P(^DPT(DFN,0),U),BUDCOM,DFN)=$P(BUDCRCT,U)
  1.  Q
  1. LAST ;
  1.  NEW LAST,COLO,SIG,FOBT
  1.  S BUDCRCL=""
  1.  S COLO=$$COLO(DFN,$$DOB^AUPNPAT(DFN),BUDED)
  1.  S BUDCRCL=COLO
  1.  S SIG=$$SIG(DFN,$$DOB^AUPNPAT(DFN),BUDED)
  1.  I $P(SIG,U,2)>$P(BUDCRCL,U,2) S BUDCRCL=SIG
  1.  S FOBT=$$FOB(DFN,$$DOB^AUPNPAT(DFN),BUDED)
  1.  I $P(FOBT,U,2)>$P(BUDCRCL,U,2) S BUDCRCL=FOBT
  1.  Q
  1. SCREEN(P,BDATE,EDATE) ;
  1.  NEW BUDCOLO,BUDSIG,BUDFOB
  1.  S BUDCOLO=$$COLO(DFN,,EDATE)
  1.  I BUDCOLO]"" Q BUDCOLO
  1.  S BUDSIG=$$SIG(DFN,,EDATE)
  1.  I BUDSIG]"" Q BUDSIG
  1.  S BUDFOB=$$FOB(P,,EDATE)
  1.  I BUDFOB]"" Q BUDFOB
  1.  Q ""
  1. CRC(P,EDATE) ;EP
  1.  NEW BUDG,X,E,Y,T
  1.  K BUDG
  1.  S Y="BUDG("
  1.  S X=P_"^LAST DX [BGP COLORECTAL CANCER DXS;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(BUDG(1)) Q 1
  1.  S T=$O(^ATXAX("B","BUD COLORECTAL CANCER CPTS",0))
  1.  I T D  I X]"" Q 1
  1.  .S X=$$CPT^BUDCDU(P,$$DOB^AUPNPAT(P),EDATE,T,5) I X]"" Q
  1.  .S X=$$TRAN^BUDCDU(P,$$DOB^AUPNPAT(P),EDATE,T,5)
  1.  S BUDG=$$LASTPRC^BUDCUTL1(P,"BGP TOTAL COLECTOMY PROCS",$$DOB^AUPNPAT(P),EDATE)
  1.  I BUDG Q 1
  1.  S X=$$PLTAX^BUDCDU(P,"BGP COLORECTAL CANCER DXS")
  1.  I X Q 1
  1.  Q 0
  1. SIG(P,BDATE,EDATE) ;EP
  1.  NEW BUDLSIG
  1.  S BUDLSIG=""
  1.  I $G(BDATE)="" S BDATE=$E(EDATE,1,3)-6_$E(EDATE,4,7)
  1.  S BUDG=$$LASTPRC^BUDCUTL1(P,"BGP SIG PROCS",BDATE,EDATE)
  1.  I $P(BUDG,U)=1 S BUDLSIG="SIG: Proc "_$P(BUDG,U,2)_":"_$$DATE^BUDCDU($P(BUDG,U,3))_U_$P(BUDG,U,3)
  1.  ;
  1.  S T=$O(^ATXAX("B","BUD SIG CPTS",0))
  1.  I T D  I X]"",$P(BUDLSIG,U,3)<$P(X,U,1) S BUDLSIG="SIG: CPT "_$P(X,U,2)_":"_$$DATE^BUDCDU($P(X,U,1))_U_$P(X,U,1)
  1.  .S X=$$CPT^BUDCDU(P,BDATE,EDATE,T,5) I X]"" Q
  1.  .S X=$$TRAN^BUDCDU(P,BDATE,EDATE,T,5)
  1.  Q BUDLSIG
  1. COLO(P,BDATE,EDATE) ;EP
  1.  K BUDG
  1.  S BUDLCOLO=""
  1.  I $G(BDATE)="" S BDATE=$E(EDATE,1,3)-10_$E(EDATE,4,7)
  1.  S BUDG=$$LASTPRC^BUDCUTL1(P,"BGP COLO PROCS",BDATE,EDATE)
  1.  I $P(BUDG,U)=1 S BUDLCOLO="COLO: Proc "_$P(BUDG,U,2)_":"_$$DATE^BUDCDU($P(BUDG,U,3))_U_$P(BUDG,U,3)
  1.  K BUDG
  1.  S %=P_"^LAST DIAGNOSIS [BGP COLO DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BUDG(")
  1.  I $D(BUDG(1)),$P(BUDLCOLO,U,3)<$P(BUDG(1),U,1) S BUDLCOLO="COLO: DX "_$P(BUDG(1),U,2)_":"_$$DATE^BUDCDU($P(BUDG(1),U))
  1.  S T=$O(^ATXAX("B","BUD COLO CPTS",0))
  1.  I T D  I X]"",$P(BUDLCOLO,U,3)<$P(X,U,1) S BUDLCOLO="COLO: CPT "_$P(X,U,2)_":"_$$DATE^BUDCDU($P(X,U,1))_U_$P(X,U,1)
  1.  .S X=$$CPT^BUDCDU(P,BDATE,EDATE,T,5) I X]"" Q
  1.  .S X=$$TRAN^BUDCDU(P,BDATE,EDATE,T,5)
  1.  Q BUDLCOLO
  1. FOB(P,BDATE,EDATE) ;EP
  1.  I $G(BDATE)="" S BDATE=$E(EDATE,1,3)-2_$E(EDATE,4,7)
  1.  S BUDC="",BUDLFOB=""
  1.  S T=$O(^ATXAX("B","BGP FOBT LOINC CODES",0))
  1.  S BUDLT=$O(^ATXLAB("B","BGP GPRA FOB TESTS",0))
  1.  S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BUDC]"")  D
  1.  .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BUDC]"")  D
  1.  ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BUDC]"")  D
  1.  ...Q:'$D(^AUPNVLAB(X,0))
  1.  ...I BUDLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BUDLT,21,"B",$P(^AUPNVLAB(X,0),U))) S BUDC="FOB: Lab "_$$VAL^XBDIQ1(9000010.09,X,.01)_":"_$$DATE^BUDCDU(9999999-D)_U_(9999999-D) Q
  1.  ...Q:'T
  1.  ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
  1.  ...Q:'$$LOINC(J,T)
  1.  ...S BUDC="FOB: LAB LOINC "_$$VAL^XBDIQ1(9000010.09,X,.01)_":"_$$DATE^BUDCDU(9999999-D)_U_(9999999-D) Q
  1.  ...Q
  1.  S BUDLFOB=BUDC
  1.  S T=$O(^ATXAX("B","BUD FOBT CPTS",0))
  1.  I T D  I X]"",$P(BUDLFOB,U,2)<$P(X,U,1) S BUDLFOB="FOB: CPT "_$P(X,"^",2)_":"_$$DATE^BUDCDU($P(X,U,1))_"^"_$P(X,U,1)
  1.  .S X=$$CPT^BUDCDU(P,BDATE,EDATE,T,5) I X]"" Q
  1.  Q BUDLFOB
  1.  ;
  1. LOINC(A,B) ;
  1.  NEW %
  1.  S %=$P($G(^LAB(95.3,A,9999999)),U,2)
  1.  I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
  1.  S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
  1.  I $D(^ATXAX(B,21,"B",%)) Q 1
  1.  Q ""
  1.  ;
  1. DEPLIST1 ;EP
  1.  D EOJ
  1.  S BUDDEP1L=1
  1.  D DEP1
  1.  G EN1^BUDCRP6B
  1. DEPLIST2 ;EP
  1.  D EOJ
  1.  S BUDDEP2L=1
  1.  D DEP2
  1.  G EN1^BUDCRP6B
  1. DEP1 ;EP
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC^BUDCRP6S,80)
  1.  W !,$$CTR("UDS 2015",80)
  1.  W !!,"All Patients 12+ w/Depression Scrn & if Positive a Follow-up Plan (Table 6B)",!
  1.  D GENI
  1.  D PAUSE
  1.  W !!,"This report provides a list of all patients 12 years and older who were "
  1.  W !,"screened for depression with a standardized tool during the report year"
  1.  W !,"and had a follow-up plan documented if screened positive, and had at"
  1.  W !,"least one medical visit during the report year."
  1.  W !
  1.  Q
  1. DEP1L ;EP
  1.  S BUDP=0,BUDQUIT=0,BUDTOT=0
  1.  D DEP1H Q:BUDQUIT
  1.  I '$D(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP1")) W:BUDROT="P" !!,"No patients to report." D:BUDROT="D" S() D:BUDROT="D" S("No patients to report.") Q
  1.  D DEP1L1
  1.  I BUDROT="P",$Y>(IOSL-3) D DEP1H Q:BUDQUIT
  1.  I BUDROT="P" W !,"TOTAL PATIENTS WITH DEP SCRN & IF POSITIVE, FOLLOW-UP:  ",BUDTOT,!
  1.  I BUDROT="D" D S(),S("TOTAL PATIENTS WITH DEP SCRN & IF POSITIVE, FOLLOW-UP:  "_BUDTOT)
  1.  Q
  1. DEP1L1 ;
  1.  I BUDROT="P",$Y>(IOSL-7) D DEP1H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP1",BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  .S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN=0 F  S DFN=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I BUDROT="P",$Y>(IOSL-3) D DEP1H Q:BUDQUIT
  1.  ....I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,25),?29,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?41,$E(BUDCOM,1,25),?70,$P(^DPT(DFN,0),U,2),?75,BUDAGE,!
  1.  ....S BUDTOT=BUDTOT+1
  1.  ....S BUDALL=^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP1",BUDAGE,BUDNAME,BUDCOM,DFN)
  1.  ....S BUD1=$P(BUDALL,"|",1),BUD2=$P(BUDALL,"|",2)
  1.  ....I BUD1]"",BUDROT="P" W ?5,$P(BUD1,U,2),": ",$P(BUD1,U,3),": ",$$FMTE^XLFDT($P(BUD1,U,1),5)
  1.  ....I BUDROT="P" W ?35,"Follow-up: " I BUD2]"" W $P(BUD2,U,2),": ",$$FMTE^XLFDT($P(BUD2,U,1),5)
  1.  ....I BUDROT="D" 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_BUDCOM_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCAD) D
  1.  .....I BUD1]"" S X=X_U_$P(BUD1,U,2)_": "_$P(BUD1,U,3)_": "_$$FMTE^XLFDT($P(BUD1,U,1),5)
  1.  .....S X=X_U_"Follow-up: "
  1.  .....I BUD2]"" S X=X_$P(BUD2,U,2)_": "_$$FMTE^XLFDT($P(BUD2,U,1),5)
  1.  .....D S(X)
  1.  Q
  1. DEP1HD ;
  1.  D S(),S(),S()
  1.  D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
  1.  D S($P(^VA(200,DUZ,0),U,2)_"    "_$$FMTE^XLFDT(DT))
  1.  D S("***  RPMS Uniform Data System (UDS)  ***")
  1.  D S("Patient List for Table 6B, Section M")
  1.  D S("Patients Screened for Depression and Followed Up if Appropriate")
  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(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") D S(X)
  1.  D S()
  1.  D S("This report provides a list of all patients 12 years and older who were ")
  1.  D S("screened for depression with a standardized tool during the report year and")
  1.  D S("had a follow-up plan documented if screened positive, and had at least one")
  1.  D S("medical visit during the report year. ")
  1.  D S("Age is calculated as of December 31.")
  1.  D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^Depression Scrn: Date/Result^Follow-up Plan: Date")
  1.  Q
  1. DEP1H ;
  1.  I BUDROT="D" D DEP1HD Q
  1.  G:'BUDGPG DEP1H1
  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. DEP1H1 ;
  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 6B, Section M,",80),!,$$CTR("Patients Screened for Depression and Followed Up if Appropriate",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(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") W $$CTR(X,80),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 D
  1.  .W !!,"This report provides a list of all patients 12 years and older who were "
  1.  .W !,"screened for depression with a standardized tool during the report year and"
  1.  .W !,"had a follow-up plan documented if screened positive, and had at least one"
  1.  .W !,"medical visit during the report year. "
  1.  .W !,"Age is calculated as of December 31."
  1.  W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
  1.  W !?5,"Depression Scrn: Date/Result",?35,"Follow-up Plan: Date"
  1.  W !,$TR($J("",80)," ","-"),!
  1.  S BUDP=1
  1.  Q
  1. DEP2 ;EP
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR($$LOC^BUDCRP6S,80)
  1.  W !,$$CTR("UDS 2015",80)
  1.  W !!,"All Patients 12+ w/o Depression Scrn or w/o Follow-up (Table 6B)",!
  1.  D GENI
  1.  D PAUSE
  1.  W !!,"This report provides a list of all patients 12 years and older not"
  1.  W !,"screened for depression or who were screened for depression with a"
  1.  W !,"standardized tool during the report year and does not have a follow-up"
  1.  W !,"plan documented if screened positive, and had at least one medical visit"
  1.  W !,"during the report year."
  1.  W !
  1.  Q
  1. DEP2L ;EP
  1.  S BUDP=0,BUDQUIT=0,BUDTOT=0
  1.  D DEP2H Q:BUDQUIT
  1.  I '$D(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP2")) W:BUDROT="P" !!,"No patients to report." D:BUDROT="D" S() D:BUDROT="D" S("No patients to report.") Q
  1.  D DEP2L1
  1.  I BUDROT="P",$Y>(IOSL-3) D DEP2H Q:BUDQUIT
  1.  I BUDROT="P" W !,"TOTAL PATIENTS W/O DEP SCRN OR W/O FOLLOW-UP IF POSITIVE:  ",BUDTOT,!
  1.  I BUDROT="D" D S(),S("TOTAL PATIENTS W/O DEP SCRN OR W/O FOLLOW-UP IF POSITIVE:  "_BUDTOT)
  1.  Q
  1. DEP2L1 ;
  1.  I BUDROT="P",$Y>(IOSL-7) D DEP2H Q:BUDQUIT
  1.  S BUDAGE="" F  S BUDAGE=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP2",BUDAGE)) Q:BUDAGE=""!(BUDQUIT)  D
  1.  .S BUDNAME="" F  S BUDNAME=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME)) Q:BUDNAME=""!(BUDQUIT)  D
  1.  ..S BUDCOM="" F  S BUDCOM=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME,BUDCOM)) Q:BUDCOM=""!(BUDQUIT)  D
  1.  ...S DFN=0 F  S DFN=$O(^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME,BUDCOM,DFN)) Q:DFN'=+DFN!(BUDQUIT)  D
  1.  ....I BUDROT="P",$Y>(IOSL-3) D DEP2H Q:BUDQUIT
  1.  ....I BUDROT="P" W !,$E($P(^DPT(DFN,0),U,1),1,25),?29,$S($$HRN^AUPNPAT(DFN,BUDSITE)]"":$$HRN^AUPNPAT(DFN,BUDSITE,2),1:$$HRN^AUPNPAT(DFN,DUZ(2),2)),?41,$E(BUDCOM,1,25),?70,$P(^DPT(DFN,0),U,2),?75,BUDAGE,!
  1.  ....S BUDTOT=BUDTOT+1
  1.  ....S BUDALL=^XTMP("BUDCRP6B",BUDJ,BUDH,"DEP2",BUDAGE,BUDNAME,BUDCOM,DFN)
  1.  ....S BUD1=$P(BUDALL,"|",1),BUD2=$P(BUDALL,"|",2)
  1.  ....I BUD1]"" I BUDROT="P" W ?5,$P(BUD1,U,2),": ",$P(BUD1,U,3),": ",$$FMTE^XLFDT($P(BUD1,U,1),5)
  1.  ....I BUDROT="P" W ?35,"Follow-up: " I BUD2]"" W $P(BUD2,U,2),": ",$$FMTE^XLFDT($P(BUD2,U,1),5)
  1.  ....I BUDROT="D" 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_BUDCOM_U_$P(^DPT(DFN,0),U,2)_U_$$AGE^AUPNPAT(DFN,BUDCAD) D
  1.  .....I BUD1]"" S X=X_U_$P(BUD1,U,2)_": "_$P(BUD1,U,3)_": "_$$FMTE^XLFDT($P(BUD1,U,1),5)
  1.  .....I BUD1="" S X=X_U
  1.  .....S X=X_U_"Follow-up: "
  1.  .....I BUD2]"" S X=X_$P(BUD2,U,2)_": "_$$FMTE^XLFDT($P(BUD2,U,1),5)
  1.  .....D S(X)
  1.  Q
  1. DEP2HD ;
  1.  D S(),S(),S()
  1.  D S("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****")
  1.  D S($P(^VA(200,DUZ,0),U,2)_"    "_$$FMTE^XLFDT(DT))
  1.  D S("***  RPMS Uniform Data System (UDS)  ***")
  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(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") D S(X)
  1.  D S()
  1.  D S("This report provides a list of all patients 12 years and older not")
  1.  D S("screened for depression or who were screened for depression with a")
  1.  D S("standardized tool during the report year and does not have a follow-up")
  1.  D S("plan documented if screened positive, and had at least one medical visit")
  1.  D S("during the report year.")
  1.  D S("Age is calculated as of December 31.")
  1.  D S("PATIENT NAME^HRN^COMMUNITY^SEX^AGE^Depression Scrn: Date/Result^Follow-up Plan: Date")
  1.  Q
  1. DEP2H ;
  1.  I BUDROT="D" D DEP2HD Q
  1.  G:'BUDGPG DEP2H1
  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. DEP2H1 ;
  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 6B, Section M,",80),!,$$CTR("Patients not Screened for Depression or w/o Follow-up",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(BUDCEN)=1:"Indian/Alaskan Native (Classification 01)",$G(BUDCEN)=2:"Not Indian Alaskan/Native (Not Classification 01)",$G(BUDCEN)=3:"All (both Indian/Alaskan Natives and Non 01)",1:"") W $$CTR(X,80),!
  1.  W $TR($J("",80)," ","-")
  1.  I BUDP=0 D
  1.  .W !!,"This report provides a list of all patients 12 years and older not"
  1.  .W !,"screened for depression or who were screened for depression with a"
  1.  .W !,"standardized tool during the report year and does not have a follow-up"
  1.  .W !,"plan documented if screened positive, and had at least one medical visit"
  1.  .W !,"during the report year."
  1.  .W !,"Age is calculated as of December 31."
  1.  W !!,"PATIENT NAME",?34,"HRN",?41,"COMMUNITY",?70,"SEX",?75,"AGE"
  1.  W !?5,"Depression Scrn: Date/Result",?35,"Follow-up Plan: Date"
  1.  W !,$TR($J("",80)," ","-"),!
  1.  S BUDP=1
  1.  Q
  1. S(V) ;
  1.  S BUDDECNT=BUDDECNT+1
  1.  S ^TMP($J,"BUDDEL",BUDDECNT)=$G(V)
  1.  Q
  1. PAUSE ;
  1.  K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" KILL DA D ^DIR KILL DIR
  1.  Q
  1. GENI ;EP
  1.  D GENI^BUDCRP6I
  1.  Q
  1.  ;
  1. CTR(X,Y) ;
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. EOJ ;
  1.  D EN^XBVK("BUD")
  1.  Q