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

APCLEM2.m

Go to the documentation of this file.
  1. APCLEM2 ; IHS/CMI/LAB - active users by community ;
  1. ;;2.0;IHS PCC SUITE;**6**;MAY 14, 2009;Build 11
  1. ;IHS/CMI/LAB - added a template creation option
  1. START ;
  1. D INIT
  1. SUF ;
  1. F ;
  1. K APCLSU,APCLSUF
  1. W !!,"Enter the Facilities you want to report on. To be included in this report"
  1. W !,"the patient must be registered at one of these facilities and must have"
  1. W !,"had at least one visit in the past 3 years to one of these facilities.",!
  1. W !,"If you are operating on a multi divisional database it might be best to"
  1. W !,"run one report for each facility."
  1. S X="LOCATION OF ENCOUNTER",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 EOJ
  1. D PEP^AMQQGTX0(+Y,"APCLSU(")
  1. I '$D(APCLSU) D EOJ Q
  1. I $D(APCLSU("*")) W !,"You can't choose all locations." H 2 K APCLSU G SUF
  1. FY ;
  1. S Y=DT X ^DD("DD") S APCLDTP=Y
  1. S %DT("A")="** Patients are to be considered ACTIVE 'as of' what date: ",%DT="AEPX" W ! D ^%DT
  1. I Y=-1 G F
  1. S APCLFYE=Y X ^DD("DD") S APCLFYEY=Y
  1. ZIS ;
  1. DEMO ;
  1. D DEMOCHK^APCLUTL(.APCLDEMO)
  1. I APCLDEMO=-1 G FY
  1. W !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT FILE!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!
  1. S XBRP="PRINT^APCLEM2",XBRC="PROCESS^APCLEM2",XBRX="EOJ^APCLEM2",XBNS="APCL"
  1. D ^XBDBQUE
  1. D EOJ
  1. Q
  1. ;
  1. INIT ;
  1. ACC ;
  1. W:$D(IOF) @IOF
  1. W $$CTR("***** Percent of Patient's Empanelled *****")
  1. W !,"This option will produce either a count of active users and the "
  1. W !,"number and percent of those patients who were empanelled on the "
  1. W !,"as of the date the report is run."
  1. W !,"Your Report can be generated for one or more Facilities."
  1. W !!,"The system will select patients who have had a visit at the Facility(s) specified",!
  1. W "within the past 3 years of the date you specify."
  1. W !,"The visit used to determine if the patient is active must meet the following"
  1. W !,"criteria:"
  1. W !?5,"- must be to a location (facility) you specify"
  1. W !?5,"- must be a complete visit (have a POV and primary provider)"
  1. W !?5,"- must not be service category Chart Review, Telephone Call, Event"
  1. W !?10,"or In-Hospital visit"
  1. W !?5,"- must not be to clinics Home, Telephone, employee health or chart review"
  1. W !
  1. Q
  1. ;
  1. EOJ ;ENTRY POINT
  1. ACCEOJ K DIC,%DT,IO("Q"),I,J,K,JK,X,Y,POP,DIRUT,ZTSK,H,M,S,TS,ZTQUEUED
  1. D EN^XBVK("APCL")
  1. Q
  1. PROCESS ;
  1. S APCLTOTP=0,APCLTOTR=0
  1. X S X1=APCLFYE,X2=1 D C^%DTC S APCLFYB=($E(X,1,3)-3)_$E(X,4,7) S Y=APCLFYB D DD^%DT S APCLFYBY=Y
  1. S APCLJ=0
  1. PAT S APCLDFN=0 F S APCLDFN=$O(^AUPNPAT(APCLDFN)) Q:APCLDFN'=+APCLDFN D C1
  1. K APCLDFN,APCLV,APCLFYBI,APCLFYEI,APCLGOTA
  1. S APCLET=$H
  1. Q
  1. C1 ;
  1. Q:'$D(^DPT(APCLDFN,0))
  1. Q:$P(^DPT(APCLDFN,0),U,19)]""
  1. Q:$$DEMO^APCLUTL(APCLDFN,$G(APCLDEMO))
  1. I $D(^DPT(APCLDFN,.35)),$P(^(.35),U)]"",$P(^(.35),U)'>APCLFYE Q
  1. HRN S (APCLGOT1,APCLHRN)=0 F J=0:0 S APCLHRN=$O(^AUPNPAT(APCLDFN,41,APCLHRN)) Q:APCLHRN'=+APCLHRN!(APCLGOT1) I $D(APCLSU($P(^AUPNPAT(APCLDFN,41,APCLHRN,0),U))) S APCLGOT1=1
  1. Q:'APCLGOT1
  1. VISITS ;
  1. S APCLFYBI=9999999-APCLFYB,APCLFYEI=9999999-APCLFYE
  1. K APCLGOTA,APCLSKIP
  1. S APCLV=0 F S APCLV=$O(^AUPNVSIT("AA",APCLDFN,APCLV)) Q:APCLV'=+APCLV!($D(APCLGOTA))!($P(APCLV,".")>APCLFYBI) S APCLVD=$P(APCLV,".") D PROC
  1. Q
  1. PROC ;
  1. S APCLVDFN=0 F S APCLVDFN=$O(^AUPNVSIT("AA",APCLDFN,APCLV,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN!($D(APCLGOTA)) D ACTIVE
  1. Q
  1. ACTIVE ;determine if patient was seen in FYs
  1. ;home clinic, telephone and employee health clinics ignored
  1. Q:$D(APCLGOTA)
  1. Q:APCLVD>APCLFYBI
  1. Q:APCLVD<APCLFYEI
  1. Q:$P(^AUPNVSIT(APCLVDFN,0),U,11)
  1. Q:'$P(^AUPNVSIT(APCLVDFN,0),U,9)
  1. Q:"DXECTI"[$P(^AUPNVSIT(APCLVDFN,0),U,7)
  1. S %=$$CLINIC^APCLV(APCLVDFN,"C") I %=11!(%=68)!(%=51)!(%=52) Q
  1. Q:'$D(^AUPNVPOV("AD",APCLVDFN))
  1. Q:$$PRIMPROV^APCLV(APCLVDFN,"I")=""
  1. S F=$P(^AUPNVSIT(APCLVDFN,0),U,6)
  1. Q:F=""
  1. I '$D(APCLSU(F)) Q
  1. S APCLGOTA=1
  1. S APCLTOTP=APCLTOTP+1
  1. I $P(^AUPNPAT(APCLDFN,0),U,14) S APCLTOTR=APCLTOTR+1
  1. Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. EOP ;EP - End of page.
  1. Q:$E(IOST)'="C"
  1. Q:$D(ZTQUEUED)!(IOT'["TRM")!$D(IO("S"))
  1. NEW DIR
  1. K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1. S DIR("A")="End of Report. Press return",DIR(0)="E" D ^DIR
  1. Q
  1. ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC1() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------
  1. GETPROV ;
  1. ;get dpcp on date APCLFYE
  1. S P=""
  1. K S
  1. S X=$O(^BDPRECN("AA",APCLDFN,1,0))
  1. I 'X Q
  1. S Y=0 F S Y=$O(^BDPRECN(X,1,Y)) Q:Y'=+Y D
  1. .S B=$P(^BDPRECN(X,1,Y,0),U,3)
  1. .S Z=$O(^BDPRECN(X,1,Y))
  1. .I Z S E=$P(^BDPRECN(X,1,Z,0),U,3),E=$$FMADD^XLFDT(E,-1)
  1. .I 'Z S E=DT
  1. .S S(B,E)=$P(^BDPRECN(X,1,Y,0),U,1)
  1. .Q
  1. Q
  1. PRINT ;
  1. S APCLPG=0
  1. D HEADER
  1. W !," Total # of active patients: ",$$C^APCLEM1(APCLTOTP,0),!
  1. W !,"Total # of active patients Empanelled: ",$$C^APCLEM1(APCLTOTR,0),!
  1. W !," Percent Empanelled: ",$$PER^APCLEM1(APCLTOTR,APCLTOTP),!!
  1. D PAUSE^APCLVL01
  1. Q
  1. I 'APCLPG G HEAD1
  1. I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
  1. HEAD1 ;
  1. I APCLPG W:$D(IOF) @IOF
  1. S APCLPG=APCLPG+1
  1. W !,$$CTR^APCLEM1($$FMTE^XLFDT(DT),80),?70,"Page ",APCLPG,!
  1. W $$CTR^APCLEM1($$LOC^APCLEM1,80),!
  1. W $$CTR^APCLEM1("Patients Active as of: "_$$FMTE^XLFDT(APCLFYE)),!
  1. W $$REPEAT^XLFSTR("-",79),!
  1. Q