APCLAL3 ; IHS/CMI/LAB - list ALCOHOL screenings ;
;;2.0;IHS PCC SUITE;**2,8,10,11**;MAY 14, 2009;Build 58
;
;
INFORM ;
W !,$$CTR($$USR)
W !,$$CTR($$LOC())
W !!,$$CTR("LISTING OF PATIENTS RECEIVING ALCOHOL SCREENING, INCLUDING REFUSALS",80)
W !!,"This report will tally and optionally list all patients who have had "
W !,"ALCOHOL screening or a refusal documented in the time frame specified by "
W !,"the user. Alcohol Screening is defined as any of the following documented:"
W !?5,"- Alcohol Screening Exam (Exam code 35)"
W !?5,"- Measurements: AUDC, AUDT, CRFT"
W !?5,"- Health Factor with Alcohol/Drug Category (CAGE)"
W !?5,"- Diagnoses V79.1 (there are no ICD10 codes), 29.1 (Behavioral Hlth Code)"
W !?5,"- Education Topics: AOD-SCR, CD-SCR"
W !?5,"- CPT Codes: 99408, 99409, G0396, G0397, H0049"
W !?5,"- refusal of exam code 35"
W !,"This report will tally the patients by age, gender, screening exam result,"
W !,"provider (either exam provider, if available, or primary provider on the "
W !,"visit), clinic, date of screening, designated PCP, MH Provider, SS Provider"
W !,"and A/SA Provider."
W !," Notes: "
W !?10,"- the last screening/refusal for each patient is used. If a patient"
W !?10," was screened more than once in the time period, only the latest"
W !?10," is used in this report."
W !?10,"- this report will optionally, look at both PCC and the Behavioral"
W !?10," Health databases for evidence of screening/refusal"
W !?10,"- this is a tally of Patients, not visits or screenings"
D PAUSE^APCLVL01
W !!,"You will be able to choose the patients by age, gender, clinic, primary"
W !,"provider or result of the screening."
W !
D PAUSE^APCLVL01
D XIT
S APCREXC=$O(^AUTTEXAM("C",35,0))
I 'APCREXC W !!,"Exam code 35 is missing from the EXAM table. Cannot run report.",! H 3 D XIT Q
;
DATES K APCRED,APCRBD
W !,"Please enter the date range during which the screening was done.",!,"To get all screenings ever put in a long date range like 01/01/1980",!,"to the present date.",!
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date for Screening"
D ^DIR Q:Y<1 S APCRBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date for Screening"
D ^DIR Q:Y<1 S APCRED=Y
;
I APCRED<APCRBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
;
EXCL ;
S APCLEXBH=""
W !!,"Would you like to include screenings recorded in the Behavioral Clinics"
W !,"Mental Health (14); DEPRESSION and Substance Abuse (43), Medical Social"
S DIR(0)="Y",DIR("A")="Services, Behavioral Health (C4) and Telebehavioral Health (C9): ",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G DATES
S APCLEXBH=Y
S APCREXPC=1
SEX ;
S APCRSEX=""
S DIR(0)="S^F:FEMALES Only;M:MALES Only;U:UNKNOWN GENDER Only;B:ALL GENDERS",DIR("A")="Include which patients in the list",DIR("B")="F" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G EXCL
S APCRSEX=Y
I APCRSEX="B" S APCRSEX="MFU"
AGE ;Age Screening
K APCRAGE,APCRAGET
W ! S DIR(0)="YO",DIR("A")="Would you like to restrict the report by Patient age range",DIR("B")="YES"
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 RESULT
;
AGER ;Age Screening
W !
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 APCRAGET=Y
RESULT ;result screenig
K APCRREST
W !!,"You can limit the list to only patients who have had a screening"
W !,"in the time period on which the result was any combination of the"
W !,"following: (e.g. to get only those patients who have had a result of "
W !,"Positive enter 2 to get all patients who have had a screening result of"
W !,"Positive or Refused, enter 2,3)",!
W !?3,"1) Normal/Negative"
W !?3,"2) Positive"
W !?3,"3) Refused"
W !?3,"4) Unable to Screen"
W !?3,"5) Screenings done with no result entered"
W !
K DIR S DIR(0)="L^1:5",DIR("A")="Which result values do you want included on this list",DIR("B")="" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G AGE
I Y="" G AGE
S APCRREST=Y
S A=Y,C="" F I=1:1 S C=$P(A,",",I) Q:C="" S APCRREST(C)=""
CLINIC ;
K APCRCLNT
W ! S DIR(0)="Y",DIR("A")="Include visits to ALL clinics",DIR("B")="Yes" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) RESULT
I Y=1 G PRIMPRV
CLINIC1 ;
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D PEP^AMQQGTX0(+Y,"APCRCLNT(")
I '$D(APCRCLNT) G CLINIC
I $D(APCRCLNT("*")) K APCRCLNT
PRIMPRV ;
S (APCRDISC,APCRPSRT,APCRPPUN)="" K APCRPROV
S DIR(0)="SO^O:One Provider Only;P:Any/All Providers (including unknown);U:Unknown Provider Only"
S DIR("A")="Report should include visits whose PRIMARY PROVIDER on the visit is"
S DIR("?")="If you wish to count only one primary provider of service enter a 'O'. To include ALL providers enter an 'A'. To include all providers of one discipline enter a 'D'." D ^DIR K DIR
G:$D(DIRUT) XIT
S APCRPSRT=Y
I Y="P" K APCRPROV G PRVSCR
I Y="U" S APCRPPUN=1 G PRVSCR
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 APCRPROV=+Y
PRVSCR ;
S (APCRSSRT,APCRSPUN)="" K APCRSPRV
S DIR(0)="SO^O:One Provider Only;P:Any/All Providers (including unknown);U:Unknown Provider Only"
S DIR("A")="Select which providers WHO PERFORMED THE SCREENING should be included"
S DIR("?")="If you wish to count only one Provider enter a 'O'. To include ALL providers enter an 'A'. To include all providers of one discipline enter a 'D'." D ^DIR K DIR
G:$D(DIRUT) XIT
S APCRSSRT=Y
I Y="P" K APCRSPRV G DESPRV
I Y="U" S APCRSPUN=1 G DESPRV
SCRPRV1 ;
S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D MIX^DIC1 K DIC,D
I $D(DTOUT)!(Y=-1) G PRVSCR
S APCRSPRV=+Y
DESPRV ;
S APCRDESP=""
W !!,"Would you like to limit the list to just patients who have"
S DIR(0)="Y",DIR("A")="a particular designated Mental Health provider",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G PRIMPRV
I 'Y S APCRDESP="" G SSPRV
DESPRV1 ;
S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D MIX^DIC1 K DIC,D
I $D(DTOUT)!(Y=-1) G DESPRV
S APCRDESP=+Y
SSPRV ;
S APCRSSP=""
W !!,"Would you like to limit the list to just patients who have"
S DIR(0)="Y",DIR("A")="a particular designated Social Services provider",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G DESPRV
I 'Y S APCRSSP="" G CDPRV
SSPRV1 ;
S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D MIX^DIC1 K DIC,D
I $D(DTOUT)!(Y=-1) G SSPRV
S APCRSSP=+Y
CDPRV ;
S APCRCDP=""
W !!,"Would you like to limit the list to just patients who have"
S DIR(0)="Y",DIR("A")="a particular designated ASA/CD provider",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G SSPRV
I 'Y S APCRCDP="" G TEMP
CDPRV1 ;
S DIC="^VA(200,",DIC(0)="AEMQ",D="AK.PROVIDER",DIC("A")="Enter PROVIDER (Lastname,Firstname): " D MIX^DIC1 K DIC,D
I $D(DTOUT)!(Y=-1) G CDPRV
S APCRCDP=+Y
TEMP ;TEMPLATE OR LIST
S APCRTMPL="",APCRSTMP=""
S DIR(0)="SO^L:List of Patient Screenings;S:Create a Search Template of Patients",DIR("B")="L",DIR("A")="Select Report Type"
D ^DIR K DIR
I $D(DIRUT) G DESPRV
S APCRTMPL=Y
I APCRTMPL="S" D ^APCLSTMP G:APCRSTMP="" TEMP G ZIS
LIST1 ;
S APCRSORT=""
W !
S DIR(0)="S^H:Health Record Number;N:Patient Name;P:Provider who screened;C:Clinic;R:Result of Exam;D:Date Screened;A:Age of Patient at Screening;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 PRIMPRV
S APCRSORT=Y
DP ;
S APCRDP=""
W !
S DIR(0)="Y",DIR("A")="Display the Patient's Designated Providers on the list",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G LIST1
S APCRDP=Y
ZIS ;
S XBRP="PRINT^APCLAL3P",XBRC="PROC^APCLAL31",XBRX="XIT^APCLAL3",XBNS="APC"
D ^XBDBQUE
D XIT
Q
XIT ;
D EN^XBVK("APC")
D ^XBFMK
Q
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")
;----------
APCLAL3 ; IHS/CMI/LAB - list ALCOHOL screenings ;
+1 ;;2.0;IHS PCC SUITE;**2,8,10,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
INFORM ;
+1 WRITE !,$$CTR($$USR)
+2 WRITE !,$$CTR($$LOC())
+3 WRITE !!,$$CTR("LISTING OF PATIENTS RECEIVING ALCOHOL SCREENING, INCLUDING REFUSALS",80)
+4 WRITE !!,"This report will tally and optionally list all patients who have had "
+5 WRITE !,"ALCOHOL screening or a refusal documented in the time frame specified by "
+6 WRITE !,"the user. Alcohol Screening is defined as any of the following documented:"
+7 WRITE !?5,"- Alcohol Screening Exam (Exam code 35)"
+8 WRITE !?5,"- Measurements: AUDC, AUDT, CRFT"
+9 WRITE !?5,"- Health Factor with Alcohol/Drug Category (CAGE)"
+10 WRITE !?5,"- Diagnoses V79.1 (there are no ICD10 codes), 29.1 (Behavioral Hlth Code)"
+11 WRITE !?5,"- Education Topics: AOD-SCR, CD-SCR"
+12 WRITE !?5,"- CPT Codes: 99408, 99409, G0396, G0397, H0049"
+13 WRITE !?5,"- refusal of exam code 35"
+14 WRITE !,"This report will tally the patients by age, gender, screening exam result,"
+15 WRITE !,"provider (either exam provider, if available, or primary provider on the "
+16 WRITE !,"visit), clinic, date of screening, designated PCP, MH Provider, SS Provider"
+17 WRITE !,"and A/SA Provider."
+18 WRITE !," Notes: "
+19 WRITE !?10,"- the last screening/refusal for each patient is used. If a patient"
+20 WRITE !?10," was screened more than once in the time period, only the latest"
+21 WRITE !?10," is used in this report."
+22 WRITE !?10,"- this report will optionally, look at both PCC and the Behavioral"
+23 WRITE !?10," Health databases for evidence of screening/refusal"
+24 WRITE !?10,"- this is a tally of Patients, not visits or screenings"
+25 DO PAUSE^APCLVL01
+26 WRITE !!,"You will be able to choose the patients by age, gender, clinic, primary"
+27 WRITE !,"provider or result of the screening."
+28 WRITE !
+29 DO PAUSE^APCLVL01
+30 DO XIT
+31 SET APCREXC=$ORDER(^AUTTEXAM("C",35,0))
+32 IF 'APCREXC
WRITE !!,"Exam code 35 is missing from the EXAM table. Cannot run report.",!
HANG 3
DO XIT
QUIT
+33 ;
DATES KILL APCRED,APCRBD
+1 WRITE !,"Please enter the date range during which the screening was done.",!,"To get all screenings ever put in a long date range like 01/01/1980",!,"to the present date.",!
+2 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Date for Screening"
+3 DO ^DIR
IF Y<1
QUIT
SET APCRBD=Y
+4 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Date for Screening"
+5 DO ^DIR
IF Y<1
QUIT
SET APCRED=Y
+6 ;
+7 IF APCRED<APCRBD
Begin DoDot:1
+8 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
+9 ;
EXCL ;
+1 SET APCLEXBH=""
+2 WRITE !!,"Would you like to include screenings recorded in the Behavioral Clinics"
+3 WRITE !,"Mental Health (14); DEPRESSION and Substance Abuse (43), Medical Social"
+4 SET DIR(0)="Y"
SET DIR("A")="Services, Behavioral Health (C4) and Telebehavioral Health (C9): "
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO DATES
+6 SET APCLEXBH=Y
+7 SET APCREXPC=1
SEX ;
+1 SET APCRSEX=""
+2 SET DIR(0)="S^F:FEMALES Only;M:MALES Only;U:UNKNOWN GENDER Only;B:ALL GENDERS"
SET DIR("A")="Include which patients in the list"
SET DIR("B")="F"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO EXCL
+4 SET APCRSEX=Y
+5 IF APCRSEX="B"
SET APCRSEX="MFU"
AGE ;Age Screening
+1 KILL APCRAGE,APCRAGET
+2 WRITE !
SET DIR(0)="YO"
SET DIR("A")="Would you like to restrict the report by Patient age range"
SET DIR("B")="YES"
+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 RESULT
+7 ;
AGER ;Age Screening
+1 WRITE !
+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 APCRAGET=Y
RESULT ;result screenig
+1 KILL APCRREST
+2 WRITE !!,"You can limit the list to only patients who have had a screening"
+3 WRITE !,"in the time period on which the result was any combination of the"
+4 WRITE !,"following: (e.g. to get only those patients who have had a result of "
+5 WRITE !,"Positive enter 2 to get all patients who have had a screening result of"
+6 WRITE !,"Positive or Refused, enter 2,3)",!
+7 WRITE !?3,"1) Normal/Negative"
+8 WRITE !?3,"2) Positive"
+9 WRITE !?3,"3) Refused"
+10 WRITE !?3,"4) Unable to Screen"
+11 WRITE !?3,"5) Screenings done with no result entered"
+12 WRITE !
+13 KILL DIR
SET DIR(0)="L^1:5"
SET DIR("A")="Which result values do you want included on this list"
SET DIR("B")=""
KILL DA
DO ^DIR
KILL DIR
+14 IF $DATA(DIRUT)
GOTO AGE
+15 IF Y=""
GOTO AGE
+16 SET APCRREST=Y
+17 SET A=Y
SET C=""
FOR I=1:1
SET C=$PIECE(A,",",I)
IF C=""
QUIT
SET APCRREST(C)=""
CLINIC ;
+1 KILL APCRCLNT
+2 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Include visits to ALL clinics"
SET DIR("B")="Yes"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO RESULT
+4 IF Y=1
GOTO PRIMPRV
CLINIC1 ;
+1 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+2 DO PEP^AMQQGTX0(+Y,"APCRCLNT(")
+3 IF '$DATA(APCRCLNT)
GOTO CLINIC
+4 IF $DATA(APCRCLNT("*"))
KILL APCRCLNT
PRIMPRV ;
+1 SET (APCRDISC,APCRPSRT,APCRPPUN)=""
KILL APCRPROV
+2 SET DIR(0)="SO^O:One Provider Only;P:Any/All Providers (including unknown);U:Unknown Provider Only"
+3 SET DIR("A")="Report should include visits whose PRIMARY PROVIDER on the visit is"
+4 SET DIR("?")="If you wish to count only one primary provider of service enter a 'O'. To include ALL providers enter an 'A'. To include all providers of one discipline enter a 'D'."
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO XIT
+6 SET APCRPSRT=Y
+7 IF Y="P"
KILL APCRPROV
GOTO PRVSCR
+8 IF Y="U"
SET APCRPPUN=1
GOTO PRVSCR
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 ;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
+3 IF $DATA(DTOUT)!(Y=-1)
GOTO PRIMPRV
+4 SET APCRPROV=+Y
PRVSCR ;
+1 SET (APCRSSRT,APCRSPUN)=""
KILL APCRSPRV
+2 SET DIR(0)="SO^O:One Provider Only;P:Any/All Providers (including unknown);U:Unknown Provider Only"
+3 SET DIR("A")="Select which providers WHO PERFORMED THE SCREENING should be included"
+4 SET DIR("?")="If you wish to count only one Provider enter a 'O'. To include ALL providers enter an 'A'. To include all providers of one discipline enter a 'D'."
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO XIT
+6 SET APCRSSRT=Y
+7 IF Y="P"
KILL APCRSPRV
GOTO DESPRV
+8 IF Y="U"
SET APCRSPUN=1
GOTO DESPRV
SCRPRV1 ;
+1 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 $DATA(DTOUT)!(Y=-1)
GOTO PRVSCR
+3 SET APCRSPRV=+Y
DESPRV ;
+1 SET APCRDESP=""
+2 WRITE !!,"Would you like to limit the list to just patients who have"
+3 SET DIR(0)="Y"
SET DIR("A")="a particular designated Mental Health provider"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO PRIMPRV
+5 IF 'Y
SET APCRDESP=""
GOTO SSPRV
DESPRV1 ;
+1 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 $DATA(DTOUT)!(Y=-1)
GOTO DESPRV
+3 SET APCRDESP=+Y
SSPRV ;
+1 SET APCRSSP=""
+2 WRITE !!,"Would you like to limit the list to just patients who have"
+3 SET DIR(0)="Y"
SET DIR("A")="a particular designated Social Services provider"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO DESPRV
+5 IF 'Y
SET APCRSSP=""
GOTO CDPRV
SSPRV1 ;
+1 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 $DATA(DTOUT)!(Y=-1)
GOTO SSPRV
+3 SET APCRSSP=+Y
CDPRV ;
+1 SET APCRCDP=""
+2 WRITE !!,"Would you like to limit the list to just patients who have"
+3 SET DIR(0)="Y"
SET DIR("A")="a particular designated ASA/CD provider"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO SSPRV
+5 IF 'Y
SET APCRCDP=""
GOTO TEMP
CDPRV1 ;
+1 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 $DATA(DTOUT)!(Y=-1)
GOTO CDPRV
+3 SET APCRCDP=+Y
TEMP ;TEMPLATE OR LIST
+1 SET APCRTMPL=""
SET APCRSTMP=""
+2 SET DIR(0)="SO^L:List of Patient Screenings;S:Create a Search Template of Patients"
SET DIR("B")="L"
SET DIR("A")="Select Report Type"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO DESPRV
+5 SET APCRTMPL=Y
+6 IF APCRTMPL="S"
DO ^APCLSTMP
IF APCRSTMP=""
GOTO TEMP
GOTO ZIS
LIST1 ;
+1 SET APCRSORT=""
+2 WRITE !
+3 SET DIR(0)="S^H:Health Record Number;N:Patient Name;P:Provider who screened;C:Clinic;R:Result of Exam;D:Date Screened;A:Age of Patient at Screening;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 PRIMPRV
+7 SET APCRSORT=Y
DP ;
+1 SET APCRDP=""
+2 WRITE !
+3 SET DIR(0)="Y"
SET DIR("A")="Display the Patient's Designated Providers on the list"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO LIST1
+5 SET APCRDP=Y
ZIS ;
+1 SET XBRP="PRINT^APCLAL3P"
SET XBRC="PROC^APCLAL31"
SET XBRX="XIT^APCLAL3"
SET XBNS="APC"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
XIT ;
+1 DO EN^XBVK("APC")
+2 DO ^XBFMK
+3 QUIT
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 ;----------
