APCLRIN ; IHS/CMI/LAB - INTERNET ACCESS ;
;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
;
;
START ;
INFORM ;
W:$D(IOF) @IOF
W !,$$CTR($$LOC)
W !,$$CTR($$USR)
W !!,"This report will tally the number of Patients with internet access"
W !,"documented, the number with internet access and the method of internet"
W !,"access. You will be asked to run this for the user population, "
W !,"the GPRA defined active clinical population or for a search template"
W !,"of patients.",!!
D EXIT
GROUP ;what set of patients
S APCLGRP=""
S DIR(0)="S^U:User Population (1 visit past 3 yrs);C:Active Clinical Patients (see GPRA definition);S:Search Template of Patients (created inQMAN, etc);A:ALL Patients"
S DIR("A")="Which set of patients should the report include",DIR("B")="C"
KILL DA D ^DIR KILL DIR
G:$D(DIRUT) EXIT
S APCLGRP=Y
I APCLGRP="S" D TEMPLATE G:APCLSEAT="" GROUP G DATE
COMM ;
W !!,"User Population and Active Clinical Definitions usually only include"
W !,"patients who live in communities in your service area. You can "
W !,"limit this report to patients in certain communities or you can include"
W !,"all ",$S(APCLGRP="U":"User Population",APCLGRP="C":"Active Clinical",1:""),"patients or just those living in certain communities.",!
K DIR
W !,"Do you wish to limit the patients reviewed to those living in a particular set"
S DIR(0)="Y",DIR("A")="of communities",DIR("B")="Y"
KILL DA D ^DIR KILL DIR
I $D(DIRUT) G GROUP
S APCLYN=Y
I Y=0 S APCLTAXI="" G MFIC
W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
K APCLTAX
S APCLTAXI=""
D ^XBFMK
S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
D ^DIC
I Y=-1 Q
S APCLTAXI=+Y
COM1 ;
S X=0
F S X=$O(^ATXAX(APCLTAXI,21,X)) Q:'X D
.S APCLTAX($P(^ATXAX(APCLTAXI,21,X,0),U))=""
.Q
I '$D(APCLTAX) W !!,"There are no communities in that taxonomy." G COMM
S X=0,G=0
F S X=$O(^ATXAX(APCLTAXI,21,X)) Q:'X D
.S C=$P(^ATXAX(APCLTAXI,21,X,0),U)
.I '$D(^AUTTCOM("B",C)) W !!,"*** Warning: Community ",C," is in the taxonomy but was not",!,"found in the standard community table." S G=1
.Q
I G D I APCLQUIT D EXIT Q
.W !!,"These communities may have been renamed or there may be patients"
.W !,"who have been reassigned from this community to a new community and this"
.W !,"could reduce your patient population."
.S APCLQUIT=0
.S DIR(0)="Y",DIR("A")="Do you want to cancel the report and review the communities" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCLQUIT=1
.I Y S APCLQUIT=1
.Q
MFIC K APCLQUIT
I $P($G(^BGPSITE(DUZ(2),0)),U,8)=1 D I APCLMFIY="" G COMM
.S APCLMFIY=""
.W !!,"Specify the LOCATION taxonomy to determine which patient visits will be"
.W !,"used to determine whether a patient is in the denominators for the report."
.W !,"You should have created this taxonomy using QMAN.",!
.K APCLMFIT
.S APCLMFIY=""
.D ^XBFMK
.S DIC("S")="I $P(^(0),U,15)=9999999.06",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Location/Facility Taxonomy: "
.S B=$P($G(^BGPSITE(DUZ(2),0)),U,9) I B S DIC("B")=$P(^ATXAX(B,0),U)
.D ^DIC
.I Y=-1 Q
.S APCLMFIY=+Y
;
BEN ;
S APCLBEN=""
S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"
S DIR("B")="1" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G COMM
S APCLBEN=Y
;
DATE ;
K APCLED,APCLBD
W !!,"You can run this report based on the current status of patient's internet"
W !,"or run it based on internet access data as of a certain date in the past.",!
W !,"Please enter the 'As of Date', enter T for today to get current information.",!
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter as of Date"
D ^DIR K DIR G:Y<1 BEN S APCLBD=Y
;
ZIS ;call to XBDBQUE
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G DATE
S XBRP="PRINT^APCLRIN",XBRC="PROC^APCLRIN",XBRX="EXIT^APCLRIN",XBNS="APCL"
D ^XBDBQUE
D EXIT
Q
EXIT ;clean up and exit
D EN^XBVK("APCL")
D ^XBFMK
D KILL^AUPNPAT
Q
TEMPLATE ;If Template was selected
S APCLSEAT=""
;
W ! S DIC("S")="I $P(^(0),U,4)=9000001!($P(^(0),U,4)=2)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 W !!,"No search template selected.",! H 2 Q
S APCLSEAT=+Y
Q
;
PROC ;
K APCLDATA
S APCLDATA("TOTAL PATS")=0
S APCLDATA("W/DOC")=0
S APCLDATA("YN","YES")=0
S APCLDATA("YN","NO")=0
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D
.Q:'$D(^DPT(DFN,0))
.Q:$P(^DPT(DFN,0),U,19) ;merged away
.Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
.K ^TMP($J,"A")
.I APCLGRP="A" Q:'$$ALL^APCLRIN1(DFN,APCLBD,APCLTAXI,APCLBEN)
.I APCLGRP="U" Q:'$$UP^APCLRIN1(DFN,$$FMADD^XLFDT(APCLBD,-(3*365)),APCLBD,APCLTAXI,APCLBEN)
.I APCLGRP="C" Q:'$$ACTCL^APCLRIN1(DFN,$$FMADD^XLFDT(APCLBD,-(3*365)),APCLBD,APCLTAXI,APCLBEN,$P($G(^BGPSITE(DUZ(2),0)),U,6))
.I APCLGRP="S" Q:'$D(^DIBT(APCLSEAT,1,DFN)) ;pt not in search template
.S APCLDATA("TOTAL PATS")=$G(APCLDATA("TOTAL PATS"))+1
.I '$D(^AUPNPAT(DFN,81)) Q ;no internet access
.I '$O(^AUPNPAT(DFN,81,0)) Q ;no documentation of internet access
.S %="" S D=0 F S D=$O(^AUPNPAT(DFN,81,"B",D)) Q:D'=+D!(D>APCLBD) S X=0 F S X=$O(^AUPNPAT(DFN,81,"B",D,X)) Q:X'=+X S %=1
.Q:'%
.S APCLDATA("W/DOC")=$G(APCLDATA("W/DOC"))+1
.I $P(^DPT(DFN,0),U,2)="F" S APCLDATA("W/DOC","FEMALE")=$G(APCLDATA("W/DOC","FEMALE"))+1
.I $P(^DPT(DFN,0),U,2)="M" S APCLDATA("W/DOC","MALE")=$G(APCLDATA("W/DOC","MALE"))+1
.I $P(^DPT(DFN,0),U,2)="U" S APCLDATA("W/DOC","UNKNOWN")=$G(APCLDATA("W/DOC","UNKNOWN"))+1
.K APCLLYN,APCLLIM S D=0 F S D=$O(^AUPNPAT(DFN,81,"B",D)) Q:D'=+D!(D>APCLBD) S X=0 F S X=$O(^AUPNPAT(DFN,81,"B",D,X)) Q:X'=+X D
..S APCLLD=D
..S APCLLYN=$$GET1^DIQ(9000001.81,X_","_DFN_",",.02)
..S APCLLIM=$$GET1^DIQ(9000001.81,X_","_DFN_",",.03)
.Q:'$D(APCLLYN)
.S I=$S(APCLLYN="":"NO",1:APCLLYN) S APCLDATA("YN",I)=$G(APCLDATA("YN",I))+1
.I I="YES" D
..I $P(^DPT(DFN,0),U,2)="F" S APCLDATA("HAS INTERNET","FEMALE")=$G(APCLDATA("HAS INTERNET","FEMALE"))+1
..I $P(^DPT(DFN,0),U,2)="M" S APCLDATA("HAS INTERNET","MALE")=$G(APCLDATA("HAS INTERNET","MALE"))+1
..I $P(^DPT(DFN,0),U,2)="U" S APCLDATA("HAS INTERNET","UNKNOWN")=$G(APCLDATA("HAS INTERNET","UNKNOWN"))+1
..I $$AGE^AUPNPAT(DFN,APCLLD)<18 S APCLDATA("YNAGE","< 18")=$G(APCLDATA("YNAGE","< 18"))+1
..I $$AGE^AUPNPAT(DFN,APCLLD)>17,$$AGE^AUPNPAT(DFN,APCLLD)<36 S APCLDATA("YNAGE","18-35")=$G(APCLDATA("YNAGE","18-35"))+1
..I $$AGE^AUPNPAT(DFN,APCLLD)>35,$$AGE^AUPNPAT(DFN,APCLLD)<56 S APCLDATA("YNAGE","36-55")=$G(APCLDATA("YNAGE","36-55"))+1
..I $$AGE^AUPNPAT(DFN,APCLLD)>55 S APCLDATA("YNAGE","> 55")=$G(APCLDATA("YNAGE","> 55"))+1
..S X=$$COMMRES^AUPNPAT(DFN,"E")
..I X="" S X="UNKNOWN"
..S APCLDATA("COM",X)=$G(APCLDATA("COM",X))+1
.S I=$S(APCLLIM]"":APCLLIM,APCLLYN="NO":"",1:"NOT DOCUMENTED")
.I I]"" S APCLDATA("IM",I)=$G(APCLDATA("IM",I))+1
.Q
K ^TMP($J,"A")
Q
;
SUB ;
W !!,?55,"#",?68,"%"
W !,$$REPEAT^XLFSTR("-",80)
Q
PRINT ;EP - called from xbdbque
S APCLPG=0,APCLQUIT="",APCLQH="",APCLIOSL=$S($G(APCLGUI):55,1:IOSL)
D HEADER
I $Y>(APCLIOSL-15) D HDR I APCLQUIT Q
;D SUB
W !!,"Total # of Patients ",?55,$$C($G(APCLDATA("TOTAL PATS")),0,7)
W !!?2,"Total # w/Internet Access Screening ",?55,$$C($G(APCLDATA("W/DOC")),0,7)
W ?68,$$PER(APCLDATA("W/DOC"),APCLDATA("TOTAL PATS"))
;W ?68,$$PER(APCLDATA("W/DOC"),APCLDATA("TOTAL PATS"))
W !!?4,"# with Internet Access w/% of those screened ",?55,$$C($G(APCLDATA("YN","YES")),0,7)
W ?68,$$PER(APCLDATA("YN","YES"),APCLDATA("W/DOC"))
I $Y>(APCLIOSL-5) D HDR I APCLQUIT Q
W !!?3,"GENDER BREAKDOWN:"
W !?6,"# Females w/internet access",!?10,"with % of those with access",?55,$$C($G(APCLDATA("HAS INTERNET","FEMALE")),0,7)
W ?68,$$PER($G(APCLDATA("HAS INTERNET","FEMALE")),$G(APCLDATA("YN","YES")))
W !?6,"# Males w/internet access",!?10,"with % of those with access",?55,$$C($G(APCLDATA("HAS INTERNET","MALE")),0,7)
W ?68,$$PER($G(APCLDATA("HAS INTERNET","MALE")),$G(APCLDATA("YN","YES")))
W !?6,"# Unknown Gender w/internet access",!?10,"with % of those with access",?55,$$C($G(APCLDATA("HAS INTERNET","UNKNOWN")),0,7)
W ?68,$$PER($G(APCLDATA("HAS INTERNET","UNKNOWN")),$G(APCLDATA("YN","YES")))
I $Y>(APCLIOSL-7) D HDR I APCLQUIT Q
W !!,"AGE BREAKDOWN:"
W !?6,"# < 18 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($G(APCLDATA("YNAGE","< 18")),0,7)
W ?68,$$PER($G(APCLDATA("YNAGE","< 18")),$G(APCLDATA("YN","YES")))
W !?6,"# 18-35 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($G(APCLDATA("YNAGE","18-35")),0,7)
W ?68,$$PER($G(APCLDATA("YNAGE","18-35")),$G(APCLDATA("YN","YES")))
W !?6,"# 36-55 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($G(APCLDATA("YNAGE","36-55")),0,7)
W ?68,$$PER($G(APCLDATA("YNAGE","36-55")),$G(APCLDATA("YN","YES")))
W !?6,"# > 55 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($G(APCLDATA("YNAGE","> 55")),0,7)
W ?68,$$PER($G(APCLDATA("YNAGE","> 55")),$G(APCLDATA("YN","YES")))
I $Y>(APCLIOSL-10) D HDR I APCLQUIT Q
W !!,"COMMUNITY BREAKDOWN: (w/ % of total with access)"
S APCLX="" F S APCLX=$O(APCLDATA("COM",APCLX)) Q:APCLX=""!(APCLQUIT) D
.I $Y>(APCLIOSL-2) D HDR I APCLQUIT Q
.W !?6,APCLX,?55,$$C(APCLDATA("COM",APCLX),0,7)
.W ?68,$$PER(APCLDATA("COM",APCLX),APCLDATA("YN","YES"))
;W ?68,$$PER(APCLDATA("YN","YES"),APCLDATA("TOTAL PATS"))
;W !!?4,"# without Internet Access ",?45,$$C($G(APCLDATA("YN","NO")),0,7)
;W ?55,$$PER(APCLDATA("YN","NO"),APCLDATA("W/DOC"))
;W ?68,$$PER(APCLDATA("YN","NO"),APCLDATA("TOTAL PATS"))
;W !!?6,"Type of Internet Access: "
;I $Y>(APCLIOSL-4) D HDR Q:APCLQUIT D SUB
;S APCLX="" F S APCLX=$O(APCLDATA("IM",APCLX)) Q:APCLX=""!(APCLQUIT) D
;.I $Y>(APCLIOSL-3) D HDR Q:APCLQUIT D SUB
;.W !?8,APCLX
;.W ?45,$$C(APCLDATA("IM",APCLX),0,7)
;.W ?55,$$PER(APCLDATA("IM",APCLX),APCLDATA("YN","YES"))
;.W ?68,$$PER(APCLDATA("IM",APCLX),APCLDATA("TOTAL PATS"))
Q
;
;
D HDR
W !!,"PATIENTS INCLUDED IN THIS REPORT:",!
I APCLGRP="U" W !?5,"User Population: ",$S(APCLBEN=1:"AI/AN Only (Classification 01)",APCLBEN=2:"non AI/AN Only (Classification NOT 01)",APCLBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
I APCLGRP="C" W !?5,"Active Clinical Population: ",$S(APCLBEN=1:"AI/AN Only (Classification 01)",APCLBEN=2:"non AI/AN Only (Classification NOT 01)",APCLBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
I APCLGRP="S" W !?5,"Population: Patients in Search Template: ",$P(^DIBT(APCLSEAT,0),U)
I APCLGRP="A" W !?5,"All Patients: ",$S(APCLBEN=1:"AI/AN Only (Classification 01)",APCLBEN=2:"non AI/AN Only (Classification NOT 01)",APCLBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
I $G(APCLTAXI)="" W !!,"All Communities Included.",! G MFIX
W !?10,"Community Taxonomy Name: ",$P(^ATXAX(APCLTAXI,0),U)
W !?10,"The following communities are included in this report:",! D
.S APCLZZ="",APCLN=0,APCLY="" F S APCLZZ=$O(APCLTAX(APCLZZ)) Q:APCLZZ=""!(APCLQH) S APCLN=APCLN+1,APCLY=APCLY_$S(APCLN=1:"",1:";")_APCLZZ
.S APCLZZ=0,C=0 F APCLZZ=1:3:APCLN D Q:APCLQH
..I $Y>(APCLIOSL-2) D HDR Q:APCLQH
..W !?10,$E($P(APCLY,";",APCLZZ),1,20),?30,$E($P(APCLY,";",(APCLZZ+1)),1,20),?60,$E($P(APCLY,";",(APCLZZ+2)),1,20)
..Q
Q:APCLQH
I $G(APCLMFIY) W !!?10,"MFI Visit Location Taxonomy Name: ",$P(^ATXAX(APCLMFIY,0),U)
I $G(APCLMFIY) W !?10,"The following Locations are used for patient visits in this report:",! D
.S APCLZZ="",APCLN=0,APCLY="" F S APCLZZ=$O(^ATXAX(APCLMFIY,21,"B",APCLZZ)) Q:APCLZZ="" S APCLN=APCLN+1,APCLY=APCLY_$S(APCLN=1:"",1:";")_$P($G(^DIC(4,APCLZZ,0)),U)
.S APCLZZ=0,C=0 F APCLZZ=1:3:APCLN D Q:APCLQH
..I $Y>(APCLIOSL-2) D HDR Q:APCLQH
..W !?10,$E($P(APCLY,";",APCLZZ),1,20),?30,$E($P(APCLY,";",(APCLZZ+1)),1,20),?60,$E($P(APCLY,";",(APCLZZ+2)),1,20)
..Q
MFIX ;
K APCLX,APCLY,APCLZZ,APCLN
Q
HDR ;
I 'APCLPG G HDR1
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT=1 Q
HDR1 ;
W:$D(IOF) @IOF
S APCLPG=APCLPG+1
W ?70,"Page ",APCLPG,!
W !,$$CTR("*** PATIENT INTERNET ACCESS ***",80)
W !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
W !,$$CTR("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),80)
W !,$$CTR("Report Generated by: "_$$USR,80)
S X="Internet Access as of Date: "_$$FMTE^XLFDT(APCLBD) W !,$$CTR(X,80)
W !,$$REPEAT^XLFSTR("-",80)
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:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S 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")
;----------
PER(N,D) ;return % of n/d
I 'D Q "0%"
NEW Z
S Z=N/D,Z=Z*100,Z=$J(Z,3,0)
Q $$STRIP^XLFSTR(Z," ")_"%"
;
C(X,X2,X3) ;
D COMMA^%DTC
Q X
;Q $STRIP^XLFSTR(X," ")
;
PAD(D,L) ; -- SUBRTN to pad length of data
; -- D=data L=length
S L=L-$L(D)
Q $E($$REPEAT^XLFSTR(" ",L),1,L)_D
;
APCLRIN ; IHS/CMI/LAB - INTERNET ACCESS ;
+1 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
+2 ;
+3 ;
START ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC)
+3 WRITE !,$$CTR($$USR)
+4 WRITE !!,"This report will tally the number of Patients with internet access"
+5 WRITE !,"documented, the number with internet access and the method of internet"
+6 WRITE !,"access. You will be asked to run this for the user population, "
+7 WRITE !,"the GPRA defined active clinical population or for a search template"
+8 WRITE !,"of patients.",!!
+9 DO EXIT
GROUP ;what set of patients
+1 SET APCLGRP=""
+2 SET DIR(0)="S^U:User Population (1 visit past 3 yrs);C:Active Clinical Patients (see GPRA definition);S:Search Template of Patients (created inQMAN, etc);A:ALL Patients"
+3 SET DIR("A")="Which set of patients should the report include"
SET DIR("B")="C"
+4 KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO EXIT
+6 SET APCLGRP=Y
+7 IF APCLGRP="S"
DO TEMPLATE
IF APCLSEAT=""
GOTO GROUP
GOTO DATE
COMM ;
+1 WRITE !!,"User Population and Active Clinical Definitions usually only include"
+2 WRITE !,"patients who live in communities in your service area. You can "
+3 WRITE !,"limit this report to patients in certain communities or you can include"
+4 WRITE !,"all ",$SELECT(APCLGRP="U":"User Population",APCLGRP="C":"Active Clinical",1:""),"patients or just those living in certain communities.",!
+5 KILL DIR
+6 WRITE !,"Do you wish to limit the patients reviewed to those living in a particular set"
+7 SET DIR(0)="Y"
SET DIR("A")="of communities"
SET DIR("B")="Y"
+8 KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
GOTO GROUP
+10 SET APCLYN=Y
+11 IF Y=0
SET APCLTAXI=""
GOTO MFIC
+12 WRITE !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
+13 KILL APCLTAX
+14 SET APCLTAXI=""
+15 DO ^XBFMK
+16 SET DIC("S")="I $P(^(0),U,15)=9999999.05"
SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Community Taxonomy: "
+17 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+18 DO ^DIC
+19 IF Y=-1
QUIT
+20 SET APCLTAXI=+Y
COM1 ;
+1 SET X=0
+2 FOR
SET X=$ORDER(^ATXAX(APCLTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+3 SET APCLTAX($PIECE(^ATXAX(APCLTAXI,21,X,0),U))=""
+4 QUIT
End DoDot:1
+5 IF '$DATA(APCLTAX)
WRITE !!,"There are no communities in that taxonomy."
GOTO COMM
+6 SET X=0
SET G=0
+7 FOR
SET X=$ORDER(^ATXAX(APCLTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+8 SET C=$PIECE(^ATXAX(APCLTAXI,21,X,0),U)
+9 IF '$DATA(^AUTTCOM("B",C))
WRITE !!,"*** Warning: Community ",C," is in the taxonomy but was not",!,"found in the standard community table."
SET G=1
+10 QUIT
End DoDot:1
+11 IF G
Begin DoDot:1
+12 WRITE !!,"These communities may have been renamed or there may be patients"
+13 WRITE !,"who have been reassigned from this community to a new community and this"
+14 WRITE !,"could reduce your patient population."
+15 SET APCLQUIT=0
+16 SET DIR(0)="Y"
SET DIR("A")="Do you want to cancel the report and review the communities"
KILL DA
DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)
SET APCLQUIT=1
+18 IF Y
SET APCLQUIT=1
+19 QUIT
End DoDot:1
IF APCLQUIT
DO EXIT
QUIT
MFIC KILL APCLQUIT
+1 IF $PIECE($GET(^BGPSITE(DUZ(2),0)),U,8)=1
Begin DoDot:1
+2 SET APCLMFIY=""
+3 WRITE !!,"Specify the LOCATION taxonomy to determine which patient visits will be"
+4 WRITE !,"used to determine whether a patient is in the denominators for the report."
+5 WRITE !,"You should have created this taxonomy using QMAN.",!
+6 KILL APCLMFIT
+7 SET APCLMFIY=""
+8 DO ^XBFMK
+9 SET DIC("S")="I $P(^(0),U,15)=9999999.06"
SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Location/Facility Taxonomy: "
+10 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,9)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+11 DO ^DIC
+12 IF Y=-1
QUIT
+13 SET APCLMFIY=+Y
End DoDot:1
IF APCLMFIY=""
GOTO COMM
+14 ;
BEN ;
+1 SET APCLBEN=""
+2 SET DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)"
SET DIR("A")="Select Beneficiary Population to include in this report"
+3 SET DIR("B")="1"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO COMM
+5 SET APCLBEN=Y
+6 ;
DATE ;
+1 KILL APCLED,APCLBD
+2 WRITE !!,"You can run this report based on the current status of patient's internet"
+3 WRITE !,"or run it based on internet access data as of a certain date in the past.",!
+4 WRITE !,"Please enter the 'As of Date', enter T for today to get current information.",!
+5 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter as of Date"
+6 DO ^DIR
KILL DIR
IF Y<1
GOTO BEN
SET APCLBD=Y
+7 ;
ZIS ;call to XBDBQUE
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO DATE
+3 SET XBRP="PRINT^APCLRIN"
SET XBRC="PROC^APCLRIN"
SET XBRX="EXIT^APCLRIN"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 DO EXIT
+6 QUIT
EXIT ;clean up and exit
+1 DO EN^XBVK("APCL")
+2 DO ^XBFMK
+3 DO KILL^AUPNPAT
+4 QUIT
TEMPLATE ;If Template was selected
+1 SET APCLSEAT=""
+2 ;
+3 WRITE !
SET DIC("S")="I $P(^(0),U,4)=9000001!($P(^(0),U,4)=2)"
SET DIC="^DIBT("
SET DIC("A")="Enter Patient SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+4 IF Y=-1
WRITE !!,"No search template selected.",!
HANG 2
QUIT
+5 SET APCLSEAT=+Y
+6 QUIT
+7 ;
PROC ;
+1 KILL APCLDATA
+2 SET APCLDATA("TOTAL PATS")=0
+3 SET APCLDATA("W/DOC")=0
+4 SET APCLDATA("YN","YES")=0
+5 SET APCLDATA("YN","NO")=0
+6 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+7 IF '$DATA(^DPT(DFN,0))
QUIT
+8 ;merged away
IF $PIECE(^DPT(DFN,0),U,19)
QUIT
+9 IF $$DEMO^APCLUTL(DFN,$GET(APCLDEMO))
QUIT
+10 KILL ^TMP($JOB,"A")
+11 IF APCLGRP="A"
IF '$$ALL^APCLRIN1(DFN,APCLBD,APCLTAXI,APCLBEN)
QUIT
+12 IF APCLGRP="U"
IF '$$UP^APCLRIN1(DFN,$$FMADD^XLFDT(APCLBD,-(3*365)),APCLBD,APCLTAXI,APCLBEN)
QUIT
+13 IF APCLGRP="C"
IF '$$ACTCL^APCLRIN1(DFN,$$FMADD^XLFDT(APCLBD,-(3*365)),APCLBD,APCLTAXI,APCLBEN,$PIECE($GET(^BGPSITE(DUZ(2),0)),U,6))
QUIT
+14 ;pt not in search template
IF APCLGRP="S"
IF '$DATA(^DIBT(APCLSEAT,1,DFN))
QUIT
+15 SET APCLDATA("TOTAL PATS")=$GET(APCLDATA("TOTAL PATS"))+1
+16 ;no internet access
IF '$DATA(^AUPNPAT(DFN,81))
QUIT
+17 ;no documentation of internet access
IF '$ORDER(^AUPNPAT(DFN,81,0))
QUIT
+18 SET %=""
SET D=0
FOR
SET D=$ORDER(^AUPNPAT(DFN,81,"B",D))
IF D'=+D!(D>APCLBD)
QUIT
SET X=0
FOR
SET X=$ORDER(^AUPNPAT(DFN,81,"B",D,X))
IF X'=+X
QUIT
SET %=1
+19 IF '%
QUIT
+20 SET APCLDATA("W/DOC")=$GET(APCLDATA("W/DOC"))+1
+21 IF $PIECE(^DPT(DFN,0),U,2)="F"
SET APCLDATA("W/DOC","FEMALE")=$GET(APCLDATA("W/DOC","FEMALE"))+1
+22 IF $PIECE(^DPT(DFN,0),U,2)="M"
SET APCLDATA("W/DOC","MALE")=$GET(APCLDATA("W/DOC","MALE"))+1
+23 IF $PIECE(^DPT(DFN,0),U,2)="U"
SET APCLDATA("W/DOC","UNKNOWN")=$GET(APCLDATA("W/DOC","UNKNOWN"))+1
+24 KILL APCLLYN,APCLLIM
SET D=0
FOR
SET D=$ORDER(^AUPNPAT(DFN,81,"B",D))
IF D'=+D!(D>APCLBD)
QUIT
SET X=0
FOR
SET X=$ORDER(^AUPNPAT(DFN,81,"B",D,X))
IF X'=+X
QUIT
Begin DoDot:2
+25 SET APCLLD=D
+26 SET APCLLYN=$$GET1^DIQ(9000001.81,X_","_DFN_",",.02)
+27 SET APCLLIM=$$GET1^DIQ(9000001.81,X_","_DFN_",",.03)
End DoDot:2
+28 IF '$DATA(APCLLYN)
QUIT
+29 SET I=$SELECT(APCLLYN="":"NO",1:APCLLYN)
SET APCLDATA("YN",I)=$GET(APCLDATA("YN",I))+1
+30 IF I="YES"
Begin DoDot:2
+31 IF $PIECE(^DPT(DFN,0),U,2)="F"
SET APCLDATA("HAS INTERNET","FEMALE")=$GET(APCLDATA("HAS INTERNET","FEMALE"))+1
+32 IF $PIECE(^DPT(DFN,0),U,2)="M"
SET APCLDATA("HAS INTERNET","MALE")=$GET(APCLDATA("HAS INTERNET","MALE"))+1
+33 IF $PIECE(^DPT(DFN,0),U,2)="U"
SET APCLDATA("HAS INTERNET","UNKNOWN")=$GET(APCLDATA("HAS INTERNET","UNKNOWN"))+1
+34 IF $$AGE^AUPNPAT(DFN,APCLLD)<18
SET APCLDATA("YNAGE","< 18")=$GET(APCLDATA("YNAGE","< 18"))+1
+35 IF $$AGE^AUPNPAT(DFN,APCLLD)>17
IF $$AGE^AUPNPAT(DFN,APCLLD)<36
SET APCLDATA("YNAGE","18-35")=$GET(APCLDATA("YNAGE","18-35"))+1
+36 IF $$AGE^AUPNPAT(DFN,APCLLD)>35
IF $$AGE^AUPNPAT(DFN,APCLLD)<56
SET APCLDATA("YNAGE","36-55")=$GET(APCLDATA("YNAGE","36-55"))+1
+37 IF $$AGE^AUPNPAT(DFN,APCLLD)>55
SET APCLDATA("YNAGE","> 55")=$GET(APCLDATA("YNAGE","> 55"))+1
+38 SET X=$$COMMRES^AUPNPAT(DFN,"E")
+39 IF X=""
SET X="UNKNOWN"
+40 SET APCLDATA("COM",X)=$GET(APCLDATA("COM",X))+1
End DoDot:2
+41 SET I=$SELECT(APCLLIM]"":APCLLIM,APCLLYN="NO":"",1:"NOT DOCUMENTED")
+42 IF I]""
SET APCLDATA("IM",I)=$GET(APCLDATA("IM",I))+1
+43 QUIT
End DoDot:1
+44 KILL ^TMP($JOB,"A")
+45 QUIT
+46 ;
SUB ;
+1 WRITE !!,?55,"#",?68,"%"
+2 WRITE !,$$REPEAT^XLFSTR("-",80)
+3 QUIT
PRINT ;EP - called from xbdbque
+1 SET APCLPG=0
SET APCLQUIT=""
SET APCLQH=""
SET APCLIOSL=$SELECT($GET(APCLGUI):55,1:IOSL)
+2 DO HEADER
+3 IF $Y>(APCLIOSL-15)
DO HDR
IF APCLQUIT
QUIT
+4 ;D SUB
+5 WRITE !!,"Total # of Patients ",?55,$$C($GET(APCLDATA("TOTAL PATS")),0,7)
+6 WRITE !!?2,"Total # w/Internet Access Screening ",?55,$$C($GET(APCLDATA("W/DOC")),0,7)
+7 WRITE ?68,$$PER(APCLDATA("W/DOC"),APCLDATA("TOTAL PATS"))
+8 ;W ?68,$$PER(APCLDATA("W/DOC"),APCLDATA("TOTAL PATS"))
+9 WRITE !!?4,"# with Internet Access w/% of those screened ",?55,$$C($GET(APCLDATA("YN","YES")),0,7)
+10 WRITE ?68,$$PER(APCLDATA("YN","YES"),APCLDATA("W/DOC"))
+11 IF $Y>(APCLIOSL-5)
DO HDR
IF APCLQUIT
QUIT
+12 WRITE !!?3,"GENDER BREAKDOWN:"
+13 WRITE !?6,"# Females w/internet access",!?10,"with % of those with access",?55,$$C($GET(APCLDATA("HAS INTERNET","FEMALE")),0,7)
+14 WRITE ?68,$$PER($GET(APCLDATA("HAS INTERNET","FEMALE")),$GET(APCLDATA("YN","YES")))
+15 WRITE !?6,"# Males w/internet access",!?10,"with % of those with access",?55,$$C($GET(APCLDATA("HAS INTERNET","MALE")),0,7)
+16 WRITE ?68,$$PER($GET(APCLDATA("HAS INTERNET","MALE")),$GET(APCLDATA("YN","YES")))
+17 WRITE !?6,"# Unknown Gender w/internet access",!?10,"with % of those with access",?55,$$C($GET(APCLDATA("HAS INTERNET","UNKNOWN")),0,7)
+18 WRITE ?68,$$PER($GET(APCLDATA("HAS INTERNET","UNKNOWN")),$GET(APCLDATA("YN","YES")))
+19 IF $Y>(APCLIOSL-7)
DO HDR
IF APCLQUIT
QUIT
+20 WRITE !!,"AGE BREAKDOWN:"
+21 WRITE !?6,"# < 18 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($GET(APCLDATA("YNAGE","< 18")),0,7)
+22 WRITE ?68,$$PER($GET(APCLDATA("YNAGE","< 18")),$GET(APCLDATA("YN","YES")))
+23 WRITE !?6,"# 18-35 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($GET(APCLDATA("YNAGE","18-35")),0,7)
+24 WRITE ?68,$$PER($GET(APCLDATA("YNAGE","18-35")),$GET(APCLDATA("YN","YES")))
+25 WRITE !?6,"# 36-55 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($GET(APCLDATA("YNAGE","36-55")),0,7)
+26 WRITE ?68,$$PER($GET(APCLDATA("YNAGE","36-55")),$GET(APCLDATA("YN","YES")))
+27 WRITE !?6,"# > 55 yrs old w/internet access",!?10,"with % of those with access",?55,$$C($GET(APCLDATA("YNAGE","> 55")),0,7)
+28 WRITE ?68,$$PER($GET(APCLDATA("YNAGE","> 55")),$GET(APCLDATA("YN","YES")))
+29 IF $Y>(APCLIOSL-10)
DO HDR
IF APCLQUIT
QUIT
+30 WRITE !!,"COMMUNITY BREAKDOWN: (w/ % of total with access)"
+31 SET APCLX=""
FOR
SET APCLX=$ORDER(APCLDATA("COM",APCLX))
IF APCLX=""!(APCLQUIT)
QUIT
Begin DoDot:1
+32 IF $Y>(APCLIOSL-2)
DO HDR
IF APCLQUIT
QUIT
+33 WRITE !?6,APCLX,?55,$$C(APCLDATA("COM",APCLX),0,7)
+34 WRITE ?68,$$PER(APCLDATA("COM",APCLX),APCLDATA("YN","YES"))
End DoDot:1
+35 ;W ?68,$$PER(APCLDATA("YN","YES"),APCLDATA("TOTAL PATS"))
+36 ;W !!?4,"# without Internet Access ",?45,$$C($G(APCLDATA("YN","NO")),0,7)
+37 ;W ?55,$$PER(APCLDATA("YN","NO"),APCLDATA("W/DOC"))
+38 ;W ?68,$$PER(APCLDATA("YN","NO"),APCLDATA("TOTAL PATS"))
+39 ;W !!?6,"Type of Internet Access: "
+40 ;I $Y>(APCLIOSL-4) D HDR Q:APCLQUIT D SUB
+41 ;S APCLX="" F S APCLX=$O(APCLDATA("IM",APCLX)) Q:APCLX=""!(APCLQUIT) D
+42 ;.I $Y>(APCLIOSL-3) D HDR Q:APCLQUIT D SUB
+43 ;.W !?8,APCLX
+44 ;.W ?45,$$C(APCLDATA("IM",APCLX),0,7)
+45 ;.W ?55,$$PER(APCLDATA("IM",APCLX),APCLDATA("YN","YES"))
+46 ;.W ?68,$$PER(APCLDATA("IM",APCLX),APCLDATA("TOTAL PATS"))
+47 QUIT
+48 ;
+49 ;
+1 DO HDR
+2 WRITE !!,"PATIENTS INCLUDED IN THIS REPORT:",!
+3 IF APCLGRP="U"
WRITE !?5,"User Population: ",$SELECT(APCLBEN=1:"AI/AN Only (Classification 01)",APCLBEN=2:"non AI/AN Only (Classification NOT 01)",APCLBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
+4 IF APCLGRP="C"
WRITE !?5,"Active Clinical Population: ",$SELECT(APCLBEN=1:"AI/AN Only (Classification 01)",APCLBEN=2:"non AI/AN Only (Classification NOT 01)",APCLBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
+5 IF APCLGRP="S"
WRITE !?5,"Population: Patients in Search Template: ",$PIECE(^DIBT(APCLSEAT,0),U)
+6 IF APCLGRP="A"
WRITE !?5,"All Patients: ",$SELECT(APCLBEN=1:"AI/AN Only (Classification 01)",APCLBEN=2:"non AI/AN Only (Classification NOT 01)",APCLBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
+7 IF $GET(APCLTAXI)=""
WRITE !!,"All Communities Included.",!
GOTO MFIX
+8 WRITE !?10,"Community Taxonomy Name: ",$PIECE(^ATXAX(APCLTAXI,0),U)
+9 WRITE !?10,"The following communities are included in this report:",!
Begin DoDot:1
+10 SET APCLZZ=""
SET APCLN=0
SET APCLY=""
FOR
SET APCLZZ=$ORDER(APCLTAX(APCLZZ))
IF APCLZZ=""!(APCLQH)
QUIT
SET APCLN=APCLN+1
SET APCLY=APCLY_$SELECT(APCLN=1:"",1:";")_APCLZZ
+11 SET APCLZZ=0
SET C=0
FOR APCLZZ=1:3:APCLN
Begin DoDot:2
+12 IF $Y>(APCLIOSL-2)
DO HDR
IF APCLQH
QUIT
+13 WRITE !?10,$EXTRACT($PIECE(APCLY,";",APCLZZ),1,20),?30,$EXTRACT($PIECE(APCLY,";",(APCLZZ+1)),1,20),?60,$EXTRACT($PIECE(APCLY,";",(APCLZZ+2)),1,20)
+14 QUIT
End DoDot:2
IF APCLQH
QUIT
End DoDot:1
+15 IF APCLQH
QUIT
+16 IF $GET(APCLMFIY)
WRITE !!?10,"MFI Visit Location Taxonomy Name: ",$PIECE(^ATXAX(APCLMFIY,0),U)
+17 IF $GET(APCLMFIY)
WRITE !?10,"The following Locations are used for patient visits in this report:",!
Begin DoDot:1
+18 SET APCLZZ=""
SET APCLN=0
SET APCLY=""
FOR
SET APCLZZ=$ORDER(^ATXAX(APCLMFIY,21,"B",APCLZZ))
IF APCLZZ=""
QUIT
SET APCLN=APCLN+1
SET APCLY=APCLY_$SELECT(APCLN=1:"",1:";")_$PIECE($GET(^DIC(4,APCLZZ,0)),U)
+19 SET APCLZZ=0
SET C=0
FOR APCLZZ=1:3:APCLN
Begin DoDot:2
+20 IF $Y>(APCLIOSL-2)
DO HDR
IF APCLQH
QUIT
+21 WRITE !?10,$EXTRACT($PIECE(APCLY,";",APCLZZ),1,20),?30,$EXTRACT($PIECE(APCLY,";",(APCLZZ+1)),1,20),?60,$EXTRACT($PIECE(APCLY,";",(APCLZZ+2)),1,20)
+22 QUIT
End DoDot:2
IF APCLQH
QUIT
End DoDot:1
MFIX ;
+1 KILL APCLX,APCLY,APCLZZ,APCLN
+2 QUIT
HDR ;
+1 IF 'APCLPG
GOTO HDR1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=1
QUIT
HDR1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET APCLPG=APCLPG+1
+3 WRITE ?70,"Page ",APCLPG,!
+4 WRITE !,$$CTR("*** PATIENT INTERNET ACCESS ***",80)
+5 WRITE !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
+6 WRITE !,$$CTR("Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U),80)
+7 WRITE !,$$CTR("Report Generated by: "_$$USR,80)
+8 SET X="Internet Access as of Date: "_$$FMTE^XLFDT(APCLBD)
WRITE !,$$CTR(X,80)
+9 WRITE !,$$REPEAT^XLFSTR("-",80)
+10 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 $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
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 ;----------
PER(N,D) ;return % of n/d
+1 IF 'D
QUIT "0%"
+2 NEW Z
+3 SET Z=N/D
SET Z=Z*100
SET Z=$JUSTIFY(Z,3,0)
+4 QUIT $$STRIP^XLFSTR(Z," ")_"%"
+5 ;
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
+3 ;Q $STRIP^XLFSTR(X," ")
+4 ;
PAD(D,L) ; -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 SET L=L-$LENGTH(D)
+3 QUIT $EXTRACT($$REPEAT^XLFSTR(" ",L),1,L)_D
+4 ;
