AMHRSB1 ; IHS/CMI/LAB - list sbirt 24 Aug 2009 6:21 PM ; 07 Jul 2017 9:59 AM
;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
;
;
INFORM ;
W !,$$CTR("SCREENING, BRIEF INTERVENTION, AND REFERRAL TO TREATMENT (SBIRT)",80)
W !,$$CTR("TALLY AND LISTING OF PATIENTS SCREENED POSITIVE FOR ALCOHOL USE W/RESULT ",80),!,$$CTR("AND TREATMENT FOR EACH SCREENING DONE",80)
W !,"This report will tally and optionally list all patients who have had a positive"
W !,"screening result for risky or harmful alcohol use in an Ambulatory Care setting"
W !,"in the time frame specified by the user. These tallies will also be further "
W !,"defined to show if the patient recieved a Brief Negotiated Interview (BNI),"
W !,"Brief Intervention (BI), and/or Referral to Treatment (RT) within 7 days of"
W !,"the positive screen result. Visits from PCC and AMH will be included."
W !!,"A positive screening result for risky or harmful alcohol use is defined as"
W !,"any of the following:"
W !?2,"- Alcohol Screening Exam (Exam code 35)-positive result"
W !?2,"- Measurements: AUDT result >=8, AUDC result >=4 (men), AUDC result >=3,"
W !?2," (women), CRFT result >=2, and CRFT result <=6"
W !?2,"- Health Factor (CAGE): result of 1/4, 2/4, 3/4, or 4/4"
W !!,"BNI/BI documented by the following:"
W !?2,"- CPT G0396, G0397, H0050, 99408 (old code), 99409 (old code), 96150 "
W !?2," through 96155"
W !?2,"- Patient education codes containing AOD-BNI, G0396, G0397, H0050, 99408,"
W !?2," 99409, 96150 through 96155"
W !!,"Referral to Treatment documented by the following:"
W !?2,"- Patient education code AOD-TX"
W !
D PAUSE^AMHLEA
D DBHUSR^AMHUTIL
D XIT
;
DATES K AMHRED,AMHRBD
W !,"Please enter the date range for this report."
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"
D ^DIR Q:Y<1 S AMHRBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date"
D ^DIR Q:Y<1 S AMHRED=Y
;
I AMHRED<AMHRBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
;
SEX ;
S AMHRSEX=""
S DIR(0)="S^F:FEMALES Only;M:MALES Only;A:All Genders",DIR("A")="Include which patients in the list",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G DATES
S AMHRSEX=Y
I AMHRSEX="A" S AMHRSEX="MFU"
AGE ;Age Screening
K AMHRAGE,AMHRAGET
W ! S DIR(0)="YO",DIR("A")="Would you like to restrict the report by Patient age range",DIR("B")="NO"
S DIR("?")="If you wish to include visits from ALL age ranges, anwser No. If you wish to list visits for only patients within a particular age range, enter Yes."
D ^DIR K DIR
G:$D(DIRUT) SEX
I 'Y G PRIMPRV
;
AGER ;Age Screening
W !,"Please note: age is calculated as of the 1st day of the report date range.",!
S DIR(0)="FO^1:7",DIR("A")="Enter an Age Range (e.g. 5-12,1-1)" D ^DIR
I Y="" W !!,"No age range entered." G AGE
I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20." G AGER
S AMHRAGET=Y
PRIMPRV ;
W !
S (AMHRDISC,AMHRPSRT,AMHRPPUN)="" K AMHRPROV
S DIR(0)="SO^O:One Provider Only;P:Any/All Providers"
S DIR("A")="Include patients who were seen by which providers during the report period",DIR("B")="P"
S DIR("?")="If you wish to count only one primary provider of service enter a 'O'. To include ALL/ANY providers enter an 'A'." D ^DIR K DIR
G:$D(DIRUT) XIT
S AMHRPSRT=Y
I Y="P" K AMHRPROV G LIST
PRV1 ;
I $P(^DD(9000010.06,.01,0),U,2)[200 S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D MIX^DIC1 K DIC,D
I $P(^DD(9000010.06,.01,0),U,2)[6 S DIC="^DIC(6,",DIC(0)="AEMQ",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D ^DIC K DIC
I $D(DTOUT)!(Y=-1) G PRIMPRV
S AMHRPROV=+Y
LIST ;
K AMHRLIST
W !!,"Patient Lists"
W !?5,"1 Those with a Positive Alcohol Screening"
W !?5,"2 Those with at least 1 Positive Alcohol Screening with BNI/BI or RT"
W !?5,"3 Those with all Positive Alcohol Screenings without BNI/BI or RT"
W !?5,"0 No Lists"
S DIR(0)="L^0:3",DIR("A")="Which list(s) would you like to include",DIR("B")="0" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G DATES
I Y[0 G DEMO
S A=Y,C="" F I=1:1 S C=$P(A,",",I) Q:C="" S AMHRLIST(C)=""
LIST1 ;
S AMHRSORT=""
W !
S DIR(0)="S^H:Health Record Number;N:Patient Name;A:Age of Patient;G:Gender of Patient;T:Terminal Digit HRN"
S DIR("A")="How would you like the list to be sorted",DIR("B")="H"
KILL DA D ^DIR KILL DIR
I $D(DIRUT) G LIST
S AMHRSORT=Y
DEMO ;
D DEMOCHK^AMHUTIL1(.AMHDEMO)
I AMHDEMO=-1 G LIST
ZIS ;CALL TO XBDBQUE
S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G XIT
I $G(Y)="B" D BROWSE,XIT Q
S XBRP="PRINT^AMHRSB1P",XBRC="PROC^AMHRSB1",XBRX="XIT^AMHRSB1",XBNS="AMH"
D ^XBDBQUE
D XIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""^AMHRSB1P"")"
S XBNS="AMH",XBRC="PROC^AMHRSB1",XBRX="XIT^AMHRSB1",XBIOP=0 D ^XBDBQUE
Q
XIT ;
D EN^XBVK("AMHR")
D ^XBFMK
Q
PROC ;
S AMHRCNT=0
S AMHRH=$H,AMHRJ=$J
K ^XTMP("AMHRSB1",AMHRJ,AMHRH)
D XTMP^AMHUTIL("AMHRSB1","SBIRT REPORT")
S (AMHTPTSR,AMHTSCRS,AMHTPTPO,AMHTSCRP,AMHTSCR0,AMHTSCR1,AMHTSCR4,AMHTSCRB,AMHTPTB,AMHTPT0,AMHTPT1,AMHTPT4,AMHTPTT,AMHTSCRT)=0
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D
.;I DUZ=2881 Q:DFN'=42
.Q:'$D(^DPT(DFN,0))
.Q:$P(^DPT(DFN,0),U,19) ;merged away
.Q:'$$ALLOWP^AMHUTIL(DUZ,DFN) ;not allowed to see this patient
.Q:$$DEMO^AMHUTIL1(DFN,$G(AMHDEMO)) ;demo patient
.I AMHRSEX'[$P(^DPT(DFN,0),U,2) Q ;not right gender
.S X=$$AGE^AUPNPAT(DFN,AMHRBD)
.I $D(AMHRAGET),X>$P(AMHRAGET,"-",2) Q
.I $D(AMHRAGET),X<$P(AMHRAGET,"-",1) Q
.K ^TMP($J),AMHAPRVS
.D GATHER ;gather up all visits and providers that were allowed to be looked at for this.
.I $D(AMHRPROV),'$D(AMHAPRVS(AMHRPROV)) Q ;quit if want only pts provider saw
.;now we need to get all of the screenings, positive screenings and bni's for this patient and update counters
.I '$D(^TMP($J)) Q ;no visits
.S (GPS,GPP,GPB,GP0,GP1,GP4,GPT)=0
.D SCREENS
.I GPS S AMHTPTSR=AMHTPTSR+1
.I GPP S AMHTPTPO=AMHTPTPO+1
.I GPB S AMHTPTB=AMHTPTB+1
.I GP0 S AMHTPT0=AMHTPT0+1
.I GP1 S AMHTPT1=AMHTPT1+1
.I GP4 S AMHTPT4=AMHTPT4+1
.I GPT S AMHTPTT=AMHTPTT+1
.;LISTS
.Q:'$D(AMHRLIST) ;no lists wanted
.D LISTS^AMHRSB2
Q
GATHER ;
K AMHAPRVS
S AMHRSD=$$FMADD^XLFDT(AMHRBD,-1),AMHRSD=AMHRSD_".9999"
F S AMHRSD=$O(^AMHREC("AF",DFN,AMHRSD)) Q:AMHRSD'=+AMHRSD!($P(AMHRSD,".")>AMHRED) D
.S AMHRBIEN=0 F S AMHRBIEN=$O(^AMHREC("AF",DFN,AMHRSD,AMHRBIEN)) Q:AMHRBIEN'=+AMHRBIEN D
..S AMHRDATE=$P(AMHRSD,".")
..Q:'$D(^AMHREC(AMHRBIEN,0))
..Q:'$$ALLOWVI^AMHUTIL(DUZ,AMHRBIEN)
..S T=$$VAL^XBDIQ1(9002011,AMHRBIEN,.07)
..I T'="AFTERCARE",T'="OUTPATIENT",T'="INTENSIVE OUTPATIENT",T'="EMERGENCY ROOM",T'="TELE-BEHAVIORAL HEALTH" Q
..Q:AMHRDATE>AMHRED
..Q:AMHRDATE<AMHRBD
..S ^TMP($J,"BHV",DFN,AMHRBIEN)=""
..S X=0 S X=$O(^AMHRPROV("AD",AMHRBIEN,X)) Q:X'=+X S AMHAPRVS($P(^AMHRPROV(X,0),U))=""
;NOW DO THE SAME WITH PCC VISITS
K AMHPCCV
D ALLV^APCLAPIU(DFN,AMHRBD,AMHRED,"AMHPCCV")
I '$D(AMHPCCV) Q ;NO PCC VISITS
S X=0 F S X=$O(AMHPCCV(X)) Q:X'=+X D
.S V=$P(AMHPCCV(X),U,5)
.I '$D(^AUPNVSIT(V,0)) Q
.I $P(^AUPNVSIT(V,0),U,7)'="A" Q
.I '$$ALLOWPCC^AMHUTIL(DUZ,V) Q
.S Y=0 S Y=$O(^AUPNVPRV("AD",V,Y)) Q:Y'=+Y S AMHAPRVS($P(^AUPNVPRV(Y,0),U))=""
.S ^TMP($J,"PCCV",DFN,V)=""
K AMHPCCV
Q
SCREENS ;
K AMHASCR
S AMHV=0 F S AMHV=$O(^TMP($J,"BHV",DFN,AMHV)) Q:AMHV'=+AMHV D
.S (GVS,GVP,GVT,GV0,GV1,GV4,GVB)=0 ;CONTROLS VISIT
.D CHECK
.I GVS S AMHTSCRS=AMHTSCRS+1
.I GVP S AMHTSCRP=AMHTSCRP+1
.I GVT S AMHTSCRT=AMHTSCRT+1
.I GV0 S AMHTSCR0=AMHTSCR0+1
.I GV1 S AMHTSCR1=AMHTSCR1+1
.I GV4 S AMHTSCR4=AMHTSCR4+1
.I GVB S AMHTSCRB=AMHTSCRB+1
.Q
S AMHV=0 F S AMHV=$O(^TMP($J,"PCCV",DFN,AMHV)) Q:AMHV'=+AMHV D
.S (GVS,GVP,GVT,GV0,GV1,GV4,GVB)=0
.S AMHD=$$VD^APCLV(AMHV)
.Q:$D(AMHASCR(AMHD)) ;ALREADY HAVE A POSITITVE ON THIS DATE
.D CHECKPCC
.I GVS S AMHTSCRS=AMHTSCRS+1
.I GVP S AMHTSCRP=AMHTSCRP+1
.I GVT S AMHTSCRT=AMHTSCRT+1
.I GV0 S AMHTSCR0=AMHTSCR0+1
.I GV1 S AMHTSCR1=AMHTSCR1+1
.I GV4 S AMHTSCR4=AMHTSCR4+1
.I GVB S AMHTSCRB=AMHTSCRB+1
Q
CHECK ;
S AMHD=$P($P(^AMHREC(AMHV,0),U),".")
S S=$$VALI^XBDIQ1(9002011,AMHV,1403)
I S]"" S GPS=1,GVS=1
I S="P" S GPP=1,GVP=1,AMHASCR(AMHD)="Alc Scrn^POSITIVE" D GOTONE Q
I GVP Q
;MEASUREMENTS
S X=0 F S X=$O(^AMHRMSR("AD",AMHV,X)) Q:X'=+X D
.S I=$$VAL^XBDIQ1(9002011.12,X,.01)
.I I'="AUDT",I'="AUDC",I'="CRFT" Q
.S GVS=1
.S GPS=1
.S R=$$VAL^XBDIQ1(9002011.12,X,.04)
.S T=""
.I I="AUDT",R>7 S T=1
.I I="AUDC",$P(^DPT(DFN,0),U,2)="M",R>3 S T=1
.I I="AUDC",$P(^DPT(DFN,0),U,2)="F",R>2 S T=1
.I I="CRFT",R>1,R<7
.I T=1 D
..S GVP=1,GPP=1,AMHASCR(AMHD)=I_U_R D GOTONE
I GVP Q
BHCPT ;now add in CPT codes
S AMHCTAX=$O(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0))
S X=0 F S X=$O(^AMHRPROC("AD",AMHV,X)) Q:X'=+X D
.S I=$P($G(^AMHRPROC(X,0)),U,1)
.Q:'I
.Q:'$$ICD^ATXAPI(I,$O(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0)),1)
.S GVS=1
.S GPS=1
.S J=$P(^ICPT(I,0),U,1)
.S R=$S($$ICD^ATXAPI(I,$O(^ATXAX("B","BGP ALCOHOL POSITIVE SCRN CPTS",0)),1):"POSITIVE",1:"")
.I R="POSITIVE" S GVP=1,GPP=1,AMHASCR(AMHD)="CPT "_J_U_R D GOTONE
I GVP=1 Q
BHHF ;
S X=0 F S X=$O(^AMHRHF("AD",AMHV,X)) Q:X'=+X D
.S I=$P($G(^AMHRHF(X,0)),U,1)
.Q:'I
.S I=$P($G(^AUTTHF(I,0)),U,1)
.I I'="CAGE 0/4",I'="CAGE 1/4",I'="CAGE 2/4",I'="CAGE 3/4",I'="CAGE 4/4" Q ;cage only
.S R=$S(I["0":"NEGATIVE",1:"POSITIVE")
.S GVS=1,GPS=1
.I R="POSITIVE" S GVP=1,GPP=1,AMHASCR(AMHD)="HF^"_I_U_R D GOTONE
.Q
Q
CHECKPCC ;
;EXAMS
S AMHD=$$VD^APCLV(AMHV)
S X=0 F S X=$O(^AUPNVXAM("AD",AMHV,X)) Q:X'=+X D
.S I=$P($G(^AUPNVXAM(X,0)),U,1)
.Q:'I
.Q:$P($G(^AUTTEXAM(I,0)),U,2)'=35
.S S=$$VALI^XBDIQ1(9000010.13,X,.04)
.I S]"" S GPS=1,GVS=1
.I S="P" S GPP=1,GVP=1,AMHASCR(AMHD)="Alc Scrn^POSITIVE" D GOTONE Q
I GVP Q
PCCHF ;
S E=0 F S E=$O(^AUPNVHF("AD",AMHV,E)) Q:E'=+E D
.S I=$P($G(^AUPNVHF(E,0)),U,1)
.S I=$P($G(^AUTTHF(I,0)),U,1)
.I I'="CAGE 0/4",I'="CAGE 1/4",I'="CAGE 2/4",I'="CAGE 3/4",I'="CAGE 4/4" Q ;cage only
.S R=$S(I["0":"NEGATIVE",1:"POSITIVE")
.S GVS=1,GPS=1
.I R="POSITIVE" S GVP=1,GPP=1,AMHASCR(AMHD)="HF^"_I_U_R D GOTONE
I GVP Q
PCCCPT ;
S E=0 F S E=$O(^AUPNVCPT("AD",AMHV,E)) Q:E'=+E D
.S I=$P($G(^AUPNVCPT(E,0)),U,1)
.Q:'I
.Q:'$$ICD^ATXAPI(I,$O(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0)),1)
.S GVS=1
.S GPS=1
.S J=$P(^ICPT(I,0),U,1)
.S R=$S($$ICD^ATXAPI(I,$O(^ATXAX("B","BGP ALCOHOL POSITIVE SCRN CPTS",0)),1):"POSITIVE",1:"")
.I R="POSITIVE" S GVP=1,GPP=1,AMHASCR(AMHD)="CPT "_J_U_R D GOTONE
I GVP=1 Q
PCCMEAS ;now add in v measurements
S E=0 F S E=$O(^AUPNVMSR("AD",AMHV,E)) Q:E'=+E D
.S I=$$VAL^XBDIQ1(9000010.01,E,.01)
.I I'="AUDT",I'="AUDC",I'="CRFT" Q
.S R=$$VAL^XBDIQ1(9000010.01,E,.04)
.S T=""
.I I="AUDT",R>7 S T=1
.I I="AUDC",$P(^DPT(DFN,0),U,2)="M",R>3 S T=1
.I I="AUDC",$P(^DPT(DFN,0),U,2)="F",R>2 S T=1
.I I="CRFT",R>1,R<7
.I T=1 D
..S GVP=1,GPP=1,AMHASCR(AMHD)=I_U_R D GOTONE
Q
;
GOTONE ;DO BNI STUFF
;AMHD is the date of the positive screen
NEW X,Z,E
K AMHABNI
D BNI^AMHRSB2(DFN,AMHD,$$FMADD^XLFDT(AMHD,7),.AMHABNI)
I '$D(AMHABNI) G TRT
S D=$O(AMHABNI(0)) I D S Y=$O(AMHABNI(D,0)) S AMHBNID=AMHABNI(D,Y)_U_"BNI"
S AMHTSCRB=AMHTSCRB+1,GPB=1,GVB=1 ;TOTAL SCREENS WITH A BNI
S Z=$P(AMHBNID,U,5)
I Z=0 S AMHTSCR0=AMHTSCR0+1,GP0=1,GV0=1 ;TOTAL SCREENS ON SAME DAY
I Z>0,Z<4 S AMHTSCR1=AMHTSCR1+1,GP1=1,GV1=1 ;TOTAL SCREENS 1-3 DAYS
I Z>3 S AMHTSCR4=AMHTSCR4+1,GP4=1,GV4=1 ;TOTAL SCREENS 4-7 DAYS
S $P(AMHASCR(AMHD),U,4)="BNI"_U_$P(AMHBNID,U,2)_U_$P(AMHBNID,U,3)_U_$P(AMHBNID,U,4)_U_$P(AMHBNID,U,5)
Q
TRT S AMHBNID=""
S AMHBNID=$$TXPTED(DFN,AMHD,$$FMADD^XLFDT(AMHD,7))
I AMHBNID S AMHTSCRT=AMHTSCRT+1,GPT=1,GVT=1,$P(AMHASCR(AMHD),U,4)="REF TX"_U_$P(AMHBNID,U,2)_U_$P(AMHBNID,U,3)_U_$P(AMHBNID,U,4)_U_$P(AMHBNID,U,5)
Q
TXPTED(P,BDATE,EDATE) ;
NEW AMHG
S Y="AMHG("
S X=P_"^FIRST EDUC AOD-TX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I '$D(AMHG(1)) G BHTX
Q 1_U_"AOD-TX "_U_$$DATE^BGP7UTL($P(AMHG(1),U))_U_$P(AMHG(1),U,1)_U_$$FMDIFF^XLFDT($P(AMHG(1),U,1),BDATE)
BHTX ;
NEW AMHV,AMHVD,X,I,T,G
S G=""
S AMHV=0 F S AMHV=$O(^TMP($J,"BHV",AMHV)) Q:AMHV'=+AMHV D
.S X=0 F S X=$O(^AMHREDU("AD",AMHV,X)) Q:X'=+X D
..S I=$P($G(^AMHREDU(X,0)),U,1)
..Q:'I
..S T=$P($G(^AUTTEDT(I,0)),U,2)
..I T="AOD-TX" S G=1_U_"REFERRAL: AOD-TX "_U_$$DATE^BGP7UTL($P(AMHG(1),U))_U_$P(AMHG(1),U,1)_U_$$FMDIFF^XLFDT($P(AMHG(1),U,1),BDATE)
Q G
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:IO'=IO(0)
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
W !
S DIR("A")="End of Report. Press Enter",DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
AMHRSB1 ; IHS/CMI/LAB - list sbirt 24 Aug 2009 6:21 PM ; 07 Jul 2017 9:59 AM
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**8**;JUN 02, 2010;Build 7
+2 ;
+3 ;
INFORM ;
+1 WRITE !,$$CTR("SCREENING, BRIEF INTERVENTION, AND REFERRAL TO TREATMENT (SBIRT)",80)
+2 WRITE !,$$CTR("TALLY AND LISTING OF PATIENTS SCREENED POSITIVE FOR ALCOHOL USE W/RESULT ",80),!,$$CTR("AND TREATMENT FOR EACH SCREENING DONE",80)
+3 WRITE !,"This report will tally and optionally list all patients who have had a positive"
+4 WRITE !,"screening result for risky or harmful alcohol use in an Ambulatory Care setting"
+5 WRITE !,"in the time frame specified by the user. These tallies will also be further "
+6 WRITE !,"defined to show if the patient recieved a Brief Negotiated Interview (BNI),"
+7 WRITE !,"Brief Intervention (BI), and/or Referral to Treatment (RT) within 7 days of"
+8 WRITE !,"the positive screen result. Visits from PCC and AMH will be included."
+9 WRITE !!,"A positive screening result for risky or harmful alcohol use is defined as"
+10 WRITE !,"any of the following:"
+11 WRITE !?2,"- Alcohol Screening Exam (Exam code 35)-positive result"
+12 WRITE !?2,"- Measurements: AUDT result >=8, AUDC result >=4 (men), AUDC result >=3,"
+13 WRITE !?2," (women), CRFT result >=2, and CRFT result <=6"
+14 WRITE !?2,"- Health Factor (CAGE): result of 1/4, 2/4, 3/4, or 4/4"
+15 WRITE !!,"BNI/BI documented by the following:"
+16 WRITE !?2,"- CPT G0396, G0397, H0050, 99408 (old code), 99409 (old code), 96150 "
+17 WRITE !?2," through 96155"
+18 WRITE !?2,"- Patient education codes containing AOD-BNI, G0396, G0397, H0050, 99408,"
+19 WRITE !?2," 99409, 96150 through 96155"
+20 WRITE !!,"Referral to Treatment documented by the following:"
+21 WRITE !?2,"- Patient education code AOD-TX"
+22 WRITE !
+23 DO PAUSE^AMHLEA
+24 DO DBHUSR^AMHUTIL
+25 DO XIT
+26 ;
DATES KILL AMHRED,AMHRBD
+1 WRITE !,"Please enter the date range for this report."
+2 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Date"
+3 DO ^DIR
IF Y<1
QUIT
SET AMHRBD=Y
+4 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Date"
+5 DO ^DIR
IF Y<1
QUIT
SET AMHRED=Y
+6 ;
+7 IF AMHRED<AMHRBD
Begin DoDot:1
+8 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+9 ;
SEX ;
+1 SET AMHRSEX=""
+2 SET DIR(0)="S^F:FEMALES Only;M:MALES Only;A:All Genders"
SET DIR("A")="Include which patients in the list"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO DATES
+4 SET AMHRSEX=Y
+5 IF AMHRSEX="A"
SET AMHRSEX="MFU"
AGE ;Age Screening
+1 KILL AMHRAGE,AMHRAGET
+2 WRITE !
SET DIR(0)="YO"
SET DIR("A")="Would you like to restrict the report by Patient age range"
SET DIR("B")="NO"
+3 SET DIR("?")="If you wish to include visits from ALL age ranges, anwser No. If you wish to list visits for only patients within a particular age range, enter Yes."
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO SEX
+6 IF 'Y
GOTO PRIMPRV
+7 ;
AGER ;Age Screening
+1 WRITE !,"Please note: age is calculated as of the 1st day of the report date range.",!
+2 SET DIR(0)="FO^1:7"
SET DIR("A")="Enter an Age Range (e.g. 5-12,1-1)"
DO ^DIR
+3 IF Y=""
WRITE !!,"No age range entered."
GOTO AGE
+4 IF Y'?1.3N1"-"1.3N
WRITE !!,$CHAR(7),$CHAR(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20."
GOTO AGER
+5 SET AMHRAGET=Y
PRIMPRV ;
+1 WRITE !
+2 SET (AMHRDISC,AMHRPSRT,AMHRPPUN)=""
KILL AMHRPROV
+3 SET DIR(0)="SO^O:One Provider Only;P:Any/All Providers"
+4 SET DIR("A")="Include patients who were seen by which providers during the report period"
SET DIR("B")="P"
+5 SET DIR("?")="If you wish to count only one primary provider of service enter a 'O'. To include ALL/ANY providers enter an 'A'."
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO XIT
+7 SET AMHRPSRT=Y
+8 IF Y="P"
KILL AMHRPROV
GOTO LIST
PRV1 ;
+1 IF $PIECE(^DD(9000010.06,.01,0),U,2)[200
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET D="AK.PROVIDER"
SET DIC("A")="Enter PROVIDER (Lastname,Firstname): "
DO MIX^DIC1
KILL DIC,D
+2 IF $PIECE(^DD(9000010.06,.01,0),U,2)[6
SET DIC="^DIC(6,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter PROVIDER (Lastname,Firstname): "
DO ^DIC
KILL DIC
+3 IF $DATA(DTOUT)!(Y=-1)
GOTO PRIMPRV
+4 SET AMHRPROV=+Y
LIST ;
+1 KILL AMHRLIST
+2 WRITE !!,"Patient Lists"
+3 WRITE !?5,"1 Those with a Positive Alcohol Screening"
+4 WRITE !?5,"2 Those with at least 1 Positive Alcohol Screening with BNI/BI or RT"
+5 WRITE !?5,"3 Those with all Positive Alcohol Screenings without BNI/BI or RT"
+6 WRITE !?5,"0 No Lists"
+7 SET DIR(0)="L^0:3"
SET DIR("A")="Which list(s) would you like to include"
SET DIR("B")="0"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO DATES
+9 IF Y[0
GOTO DEMO
+10 SET A=Y
SET C=""
FOR I=1:1
SET C=$PIECE(A,",",I)
IF C=""
QUIT
SET AMHRLIST(C)=""
LIST1 ;
+1 SET AMHRSORT=""
+2 WRITE !
+3 SET DIR(0)="S^H:Health Record Number;N:Patient Name;A:Age of Patient;G:Gender of Patient;T:Terminal Digit HRN"
+4 SET DIR("A")="How would you like the list to be sorted"
SET DIR("B")="H"
+5 KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
GOTO LIST
+7 SET AMHRSORT=Y
DEMO ;
+1 DO DEMOCHK^AMHUTIL1(.AMHDEMO)
+2 IF AMHDEMO=-1
GOTO LIST
ZIS ;CALL TO XBDBQUE
+1 SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to "
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+4 SET XBRP="PRINT^AMHRSB1P"
SET XBRC="PROC^AMHRSB1"
SET XBRX="XIT^AMHRSB1"
SET XBNS="AMH"
+5 DO ^XBDBQUE
+6 DO XIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""^AMHRSB1P"")"
+2 SET XBNS="AMH"
SET XBRC="PROC^AMHRSB1"
SET XBRX="XIT^AMHRSB1"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
XIT ;
+1 DO EN^XBVK("AMHR")
+2 DO ^XBFMK
+3 QUIT
PROC ;
+1 SET AMHRCNT=0
+2 SET AMHRH=$HOROLOG
SET AMHRJ=$JOB
+3 KILL ^XTMP("AMHRSB1",AMHRJ,AMHRH)
+4 DO XTMP^AMHUTIL("AMHRSB1","SBIRT REPORT")
+5 SET (AMHTPTSR,AMHTSCRS,AMHTPTPO,AMHTSCRP,AMHTSCR0,AMHTSCR1,AMHTSCR4,AMHTSCRB,AMHTPTB,AMHTPT0,AMHTPT1,AMHTPT4,AMHTPTT,AMHTSCRT)=0
+6 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+7 ;I DUZ=2881 Q:DFN'=42
+8 IF '$DATA(^DPT(DFN,0))
QUIT
+9 ;merged away
IF $PIECE(^DPT(DFN,0),U,19)
QUIT
+10 ;not allowed to see this patient
IF '$$ALLOWP^AMHUTIL(DUZ,DFN)
QUIT
+11 ;demo patient
IF $$DEMO^AMHUTIL1(DFN,$GET(AMHDEMO))
QUIT
+12 ;not right gender
IF AMHRSEX'[$PIECE(^DPT(DFN,0),U,2)
QUIT
+13 SET X=$$AGE^AUPNPAT(DFN,AMHRBD)
+14 IF $DATA(AMHRAGET)
IF X>$PIECE(AMHRAGET,"-",2)
QUIT
+15 IF $DATA(AMHRAGET)
IF X<$PIECE(AMHRAGET,"-",1)
QUIT
+16 KILL ^TMP($JOB),AMHAPRVS
+17 ;gather up all visits and providers that were allowed to be looked at for this.
DO GATHER
+18 ;quit if want only pts provider saw
IF $DATA(AMHRPROV)
IF '$DATA(AMHAPRVS(AMHRPROV))
QUIT
+19 ;now we need to get all of the screenings, positive screenings and bni's for this patient and update counters
+20 ;no visits
IF '$DATA(^TMP($JOB))
QUIT
+21 SET (GPS,GPP,GPB,GP0,GP1,GP4,GPT)=0
+22 DO SCREENS
+23 IF GPS
SET AMHTPTSR=AMHTPTSR+1
+24 IF GPP
SET AMHTPTPO=AMHTPTPO+1
+25 IF GPB
SET AMHTPTB=AMHTPTB+1
+26 IF GP0
SET AMHTPT0=AMHTPT0+1
+27 IF GP1
SET AMHTPT1=AMHTPT1+1
+28 IF GP4
SET AMHTPT4=AMHTPT4+1
+29 IF GPT
SET AMHTPTT=AMHTPTT+1
+30 ;LISTS
+31 ;no lists wanted
IF '$DATA(AMHRLIST)
QUIT
+32 DO LISTS^AMHRSB2
End DoDot:1
+33 QUIT
GATHER ;
+1 KILL AMHAPRVS
+2 SET AMHRSD=$$FMADD^XLFDT(AMHRBD,-1)
SET AMHRSD=AMHRSD_".9999"
+3 FOR
SET AMHRSD=$ORDER(^AMHREC("AF",DFN,AMHRSD))
IF AMHRSD'=+AMHRSD!($PIECE(AMHRSD,".")>AMHRED)
QUIT
Begin DoDot:1
+4 SET AMHRBIEN=0
FOR
SET AMHRBIEN=$ORDER(^AMHREC("AF",DFN,AMHRSD,AMHRBIEN))
IF AMHRBIEN'=+AMHRBIEN
QUIT
Begin DoDot:2
+5 SET AMHRDATE=$PIECE(AMHRSD,".")
+6 IF '$DATA(^AMHREC(AMHRBIEN,0))
QUIT
+7 IF '$$ALLOWVI^AMHUTIL(DUZ,AMHRBIEN)
QUIT
+8 SET T=$$VAL^XBDIQ1(9002011,AMHRBIEN,.07)
+9 IF T'="AFTERCARE"
IF T'="OUTPATIENT"
IF T'="INTENSIVE OUTPATIENT"
IF T'="EMERGENCY ROOM"
IF T'="TELE-BEHAVIORAL HEALTH"
QUIT
+10 IF AMHRDATE>AMHRED
QUIT
+11 IF AMHRDATE<AMHRBD
QUIT
+12 SET ^TMP($JOB,"BHV",DFN,AMHRBIEN)=""
+13 SET X=0
SET X=$ORDER(^AMHRPROV("AD",AMHRBIEN,X))
IF X'=+X
QUIT
SET AMHAPRVS($PIECE(^AMHRPROV(X,0),U))=""
End DoDot:2
End DoDot:1
+14 ;NOW DO THE SAME WITH PCC VISITS
+15 KILL AMHPCCV
+16 DO ALLV^APCLAPIU(DFN,AMHRBD,AMHRED,"AMHPCCV")
+17 ;NO PCC VISITS
IF '$DATA(AMHPCCV)
QUIT
+18 SET X=0
FOR
SET X=$ORDER(AMHPCCV(X))
IF X'=+X
QUIT
Begin DoDot:1
+19 SET V=$PIECE(AMHPCCV(X),U,5)
+20 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+21 IF $PIECE(^AUPNVSIT(V,0),U,7)'="A"
QUIT
+22 IF '$$ALLOWPCC^AMHUTIL(DUZ,V)
QUIT
+23 SET Y=0
SET Y=$ORDER(^AUPNVPRV("AD",V,Y))
IF Y'=+Y
QUIT
SET AMHAPRVS($PIECE(^AUPNVPRV(Y,0),U))=""
+24 SET ^TMP($JOB,"PCCV",DFN,V)=""
End DoDot:1
+25 KILL AMHPCCV
+26 QUIT
SCREENS ;
+1 KILL AMHASCR
+2 SET AMHV=0
FOR
SET AMHV=$ORDER(^TMP($JOB,"BHV",DFN,AMHV))
IF AMHV'=+AMHV
QUIT
Begin DoDot:1
+3 ;CONTROLS VISIT
SET (GVS,GVP,GVT,GV0,GV1,GV4,GVB)=0
+4 DO CHECK
+5 IF GVS
SET AMHTSCRS=AMHTSCRS+1
+6 IF GVP
SET AMHTSCRP=AMHTSCRP+1
+7 IF GVT
SET AMHTSCRT=AMHTSCRT+1
+8 IF GV0
SET AMHTSCR0=AMHTSCR0+1
+9 IF GV1
SET AMHTSCR1=AMHTSCR1+1
+10 IF GV4
SET AMHTSCR4=AMHTSCR4+1
+11 IF GVB
SET AMHTSCRB=AMHTSCRB+1
+12 QUIT
End DoDot:1
+13 SET AMHV=0
FOR
SET AMHV=$ORDER(^TMP($JOB,"PCCV",DFN,AMHV))
IF AMHV'=+AMHV
QUIT
Begin DoDot:1
+14 SET (GVS,GVP,GVT,GV0,GV1,GV4,GVB)=0
+15 SET AMHD=$$VD^APCLV(AMHV)
+16 ;ALREADY HAVE A POSITITVE ON THIS DATE
IF $DATA(AMHASCR(AMHD))
QUIT
+17 DO CHECKPCC
+18 IF GVS
SET AMHTSCRS=AMHTSCRS+1
+19 IF GVP
SET AMHTSCRP=AMHTSCRP+1
+20 IF GVT
SET AMHTSCRT=AMHTSCRT+1
+21 IF GV0
SET AMHTSCR0=AMHTSCR0+1
+22 IF GV1
SET AMHTSCR1=AMHTSCR1+1
+23 IF GV4
SET AMHTSCR4=AMHTSCR4+1
+24 IF GVB
SET AMHTSCRB=AMHTSCRB+1
End DoDot:1
+25 QUIT
CHECK ;
+1 SET AMHD=$PIECE($PIECE(^AMHREC(AMHV,0),U),".")
+2 SET S=$$VALI^XBDIQ1(9002011,AMHV,1403)
+3 IF S]""
SET GPS=1
SET GVS=1
+4 IF S="P"
SET GPP=1
SET GVP=1
SET AMHASCR(AMHD)="Alc Scrn^POSITIVE"
DO GOTONE
QUIT
+5 IF GVP
QUIT
+6 ;MEASUREMENTS
+7 SET X=0
FOR
SET X=$ORDER(^AMHRMSR("AD",AMHV,X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET I=$$VAL^XBDIQ1(9002011.12,X,.01)
+9 IF I'="AUDT"
IF I'="AUDC"
IF I'="CRFT"
QUIT
+10 SET GVS=1
+11 SET GPS=1
+12 SET R=$$VAL^XBDIQ1(9002011.12,X,.04)
+13 SET T=""
+14 IF I="AUDT"
IF R>7
SET T=1
+15 IF I="AUDC"
IF $PIECE(^DPT(DFN,0),U,2)="M"
IF R>3
SET T=1
+16 IF I="AUDC"
IF $PIECE(^DPT(DFN,0),U,2)="F"
IF R>2
SET T=1
+17 IF I="CRFT"
IF R>1
IF R<7
+18 IF T=1
Begin DoDot:2
+19 SET GVP=1
SET GPP=1
SET AMHASCR(AMHD)=I_U_R
DO GOTONE
End DoDot:2
End DoDot:1
+20 IF GVP
QUIT
BHCPT ;now add in CPT codes
+1 SET AMHCTAX=$ORDER(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0))
+2 SET X=0
FOR
SET X=$ORDER(^AMHRPROC("AD",AMHV,X))
IF X'=+X
QUIT
Begin DoDot:1
+3 SET I=$PIECE($GET(^AMHRPROC(X,0)),U,1)
+4 IF 'I
QUIT
+5 IF '$$ICD^ATXAPI(I,$ORDER(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0)),1)
QUIT
+6 SET GVS=1
+7 SET GPS=1
+8 SET J=$PIECE(^ICPT(I,0),U,1)
+9 SET R=$SELECT($$ICD^ATXAPI(I,$ORDER(^ATXAX("B","BGP ALCOHOL POSITIVE SCRN CPTS",0)),1):"POSITIVE",1:"")
+10 IF R="POSITIVE"
SET GVP=1
SET GPP=1
SET AMHASCR(AMHD)="CPT "_J_U_R
DO GOTONE
End DoDot:1
+11 IF GVP=1
QUIT
BHHF ;
+1 SET X=0
FOR
SET X=$ORDER(^AMHRHF("AD",AMHV,X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET I=$PIECE($GET(^AMHRHF(X,0)),U,1)
+3 IF 'I
QUIT
+4 SET I=$PIECE($GET(^AUTTHF(I,0)),U,1)
+5 ;cage only
IF I'="CAGE 0/4"
IF I'="CAGE 1/4"
IF I'="CAGE 2/4"
IF I'="CAGE 3/4"
IF I'="CAGE 4/4"
QUIT
+6 SET R=$SELECT(I["0":"NEGATIVE",1:"POSITIVE")
+7 SET GVS=1
SET GPS=1
+8 IF R="POSITIVE"
SET GVP=1
SET GPP=1
SET AMHASCR(AMHD)="HF^"_I_U_R
DO GOTONE
+9 QUIT
End DoDot:1
+10 QUIT
CHECKPCC ;
+1 ;EXAMS
+2 SET AMHD=$$VD^APCLV(AMHV)
+3 SET X=0
FOR
SET X=$ORDER(^AUPNVXAM("AD",AMHV,X))
IF X'=+X
QUIT
Begin DoDot:1
+4 SET I=$PIECE($GET(^AUPNVXAM(X,0)),U,1)
+5 IF 'I
QUIT
+6 IF $PIECE($GET(^AUTTEXAM(I,0)),U,2)'=35
QUIT
+7 SET S=$$VALI^XBDIQ1(9000010.13,X,.04)
+8 IF S]""
SET GPS=1
SET GVS=1
+9 IF S="P"
SET GPP=1
SET GVP=1
SET AMHASCR(AMHD)="Alc Scrn^POSITIVE"
DO GOTONE
QUIT
End DoDot:1
+10 IF GVP
QUIT
PCCHF ;
+1 SET E=0
FOR
SET E=$ORDER(^AUPNVHF("AD",AMHV,E))
IF E'=+E
QUIT
Begin DoDot:1
+2 SET I=$PIECE($GET(^AUPNVHF(E,0)),U,1)
+3 SET I=$PIECE($GET(^AUTTHF(I,0)),U,1)
+4 ;cage only
IF I'="CAGE 0/4"
IF I'="CAGE 1/4"
IF I'="CAGE 2/4"
IF I'="CAGE 3/4"
IF I'="CAGE 4/4"
QUIT
+5 SET R=$SELECT(I["0":"NEGATIVE",1:"POSITIVE")
+6 SET GVS=1
SET GPS=1
+7 IF R="POSITIVE"
SET GVP=1
SET GPP=1
SET AMHASCR(AMHD)="HF^"_I_U_R
DO GOTONE
End DoDot:1
+8 IF GVP
QUIT
PCCCPT ;
+1 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AD",AMHV,E))
IF E'=+E
QUIT
Begin DoDot:1
+2 SET I=$PIECE($GET(^AUPNVCPT(E,0)),U,1)
+3 IF 'I
QUIT
+4 IF '$$ICD^ATXAPI(I,$ORDER(^ATXAX("B","BGP ALCOHOL SCREENING CPTS",0)),1)
QUIT
+5 SET GVS=1
+6 SET GPS=1
+7 SET J=$PIECE(^ICPT(I,0),U,1)
+8 SET R=$SELECT($$ICD^ATXAPI(I,$ORDER(^ATXAX("B","BGP ALCOHOL POSITIVE SCRN CPTS",0)),1):"POSITIVE",1:"")
+9 IF R="POSITIVE"
SET GVP=1
SET GPP=1
SET AMHASCR(AMHD)="CPT "_J_U_R
DO GOTONE
End DoDot:1
+10 IF GVP=1
QUIT
PCCMEAS ;now add in v measurements
+1 SET E=0
FOR
SET E=$ORDER(^AUPNVMSR("AD",AMHV,E))
IF E'=+E
QUIT
Begin DoDot:1
+2 SET I=$$VAL^XBDIQ1(9000010.01,E,.01)
+3 IF I'="AUDT"
IF I'="AUDC"
IF I'="CRFT"
QUIT
+4 SET R=$$VAL^XBDIQ1(9000010.01,E,.04)
+5 SET T=""
+6 IF I="AUDT"
IF R>7
SET T=1
+7 IF I="AUDC"
IF $PIECE(^DPT(DFN,0),U,2)="M"
IF R>3
SET T=1
+8 IF I="AUDC"
IF $PIECE(^DPT(DFN,0),U,2)="F"
IF R>2
SET T=1
+9 IF I="CRFT"
IF R>1
IF R<7
+10 IF T=1
Begin DoDot:2
+11 SET GVP=1
SET GPP=1
SET AMHASCR(AMHD)=I_U_R
DO GOTONE
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
GOTONE ;DO BNI STUFF
+1 ;AMHD is the date of the positive screen
+2 NEW X,Z,E
+3 KILL AMHABNI
+4 DO BNI^AMHRSB2(DFN,AMHD,$$FMADD^XLFDT(AMHD,7),.AMHABNI)
+5 IF '$DATA(AMHABNI)
GOTO TRT
+6 SET D=$ORDER(AMHABNI(0))
IF D
SET Y=$ORDER(AMHABNI(D,0))
SET AMHBNID=AMHABNI(D,Y)_U_"BNI"
+7 ;TOTAL SCREENS WITH A BNI
SET AMHTSCRB=AMHTSCRB+1
SET GPB=1
SET GVB=1
+8 SET Z=$PIECE(AMHBNID,U,5)
+9 ;TOTAL SCREENS ON SAME DAY
IF Z=0
SET AMHTSCR0=AMHTSCR0+1
SET GP0=1
SET GV0=1
+10 ;TOTAL SCREENS 1-3 DAYS
IF Z>0
IF Z<4
SET AMHTSCR1=AMHTSCR1+1
SET GP1=1
SET GV1=1
+11 ;TOTAL SCREENS 4-7 DAYS
IF Z>3
SET AMHTSCR4=AMHTSCR4+1
SET GP4=1
SET GV4=1
+12 SET $PIECE(AMHASCR(AMHD),U,4)="BNI"_U_$PIECE(AMHBNID,U,2)_U_$PIECE(AMHBNID,U,3)_U_$PIECE(AMHBNID,U,4)_U_$PIECE(AMHBNID,U,5)
+13 QUIT
TRT SET AMHBNID=""
+1 SET AMHBNID=$$TXPTED(DFN,AMHD,$$FMADD^XLFDT(AMHD,7))
+2 IF AMHBNID
SET AMHTSCRT=AMHTSCRT+1
SET GPT=1
SET GVT=1
SET $PIECE(AMHASCR(AMHD),U,4)="REF TX"_U_$PIECE(AMHBNID,U,2)_U_$PIECE(AMHBNID,U,3)_U_$PIECE(AMHBNID,U,4)_U_$PIECE(AMHBNID,U,5)
+3 QUIT
TXPTED(P,BDATE,EDATE) ;
+1 NEW AMHG
+2 SET Y="AMHG("
+3 SET X=P_"^FIRST EDUC AOD-TX;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 IF '$DATA(AMHG(1))
GOTO BHTX
+5 QUIT 1_U_"AOD-TX "_U_$$DATE^BGP7UTL($PIECE(AMHG(1),U))_U_$PIECE(AMHG(1),U,1)_U_$$FMDIFF^XLFDT($PIECE(AMHG(1),U,1),BDATE)
BHTX ;
+1 NEW AMHV,AMHVD,X,I,T,G
+2 SET G=""
+3 SET AMHV=0
FOR
SET AMHV=$ORDER(^TMP($JOB,"BHV",AMHV))
IF AMHV'=+AMHV
QUIT
Begin DoDot:1
+4 SET X=0
FOR
SET X=$ORDER(^AMHREDU("AD",AMHV,X))
IF X'=+X
QUIT
Begin DoDot:2
+5 SET I=$PIECE($GET(^AMHREDU(X,0)),U,1)
+6 IF 'I
QUIT
+7 SET T=$PIECE($GET(^AUTTEDT(I,0)),U,2)
+8 IF T="AOD-TX"
SET G=1_U_"REFERRAL: AOD-TX "_U_$$DATE^BGP7UTL($PIECE(AMHG(1),U))_U_$PIECE(AMHG(1),U,1)_U_$$FMDIFF^XLFDT($PIECE(AMHG(1),U,1),BDATE)
End DoDot:2
End DoDot:1
+9 QUIT G
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF IO'=IO(0)
QUIT
+3 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+4 NEW DIR
+5 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+6 WRITE !
+7 SET DIR("A")="End of Report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+8 QUIT
+9 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
