Routine: APCLACC

APCLACC ; IHS/CMI/LAB - active users by community ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;IHS/CMI/LAB - added a template creation option

START ;

 D INIT

 G:$D(APCLQUIT) EOJ

SUF ;S (APCLSUF,APCLFS)="",DIR(0)="SBO^F:FACILITY;S:SERVICE UNIT",DIR("A")="Report for a particular Facility or for a Service Unit?" D ^DIR K DIR

 S (APCLSUF,APCLFS)="",DIR(0)="S^F:ONE OR MORE FACILITIES;S:ONE OR MORE SERVICE UNITS",DIR("A")="Report on patients registered at",DIR("B")="F" K DA D ^DIR K DIR

 G:$D(DIRUT) EOJ

 S APCLFS=Y

 G:Y="S" S

F ;

 K APCLSU,APCLSUF

 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

 D PEP^AMQQGTX0(+Y,"APCLSU(")

 I '$D(APCLSU) G SUF

 I $D(APCLSU("*")) K APCLSU G SUF

 S X=0 F  S X=$O(APCLSU(X)) Q:X'=+X  I $P(^AUTTLOC(X,0),U,5) S APCLSUF($P(^AUTTLOC(X,0),U,5))="" ;set all service units in APCLSUF

 G SUR

S ;

 K APCLSU

 S X="SERVICE UNIT",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

 D PEP^AMQQGTX0(+Y,"APCLSU(")

 I '$D(APCLSU) G SUF

 I $D(APCLSU("*")) K APCLSU G SUF

 S X=0 F  S X=$O(APCLSU(X)) Q:X'=+X  S APCLSUF(X)=""

SUR ;

W !

 S APCLSSUR=""

 W ! S DIR("A")="Do you want to include only patients living in these"_$S(APCLFS="F":" Facility's",1:"")_" SERVICE UNIT's"

 S DIR(0)="YO"

 S DIR("?")="If you want to only include those people living in the SU indicated or the SU of the Facility indicated enter Y" D ^DIR K DIR

 G:$D(DIRUT) SUF

 S APCLSSUR=Y

IND ;

 W ! S APCLIND="",DIR(0)="YO",DIR("A")="Do you wish to include only INDIAN patients",DIR("?")="If you wish to exclude Non-Indians from the report enter a Y" D ^DIR K DIR

 G:$D(DIRUT) SUF

 S APCLIND=Y

FY ;

 S Y=DT X ^DD("DD") S APCLDTP=Y

 S %DT("A")="** Patients are to be considered ACTIVE 'as of' what date: ",%DT="AEPX" W ! D ^%DT

 I Y=-1 G IND

 S APCLFYE=Y X ^DD("DD") S APCLFYEY=Y

RPT ;report type

 S APCLRPTT=""

 S DIR(0)="S^F:Full Report;T:Create a Template of the Active Patients",DIR("A")="Which report type do you want",DIR("B")="F" KILL DA D ^DIR KILL DIR

 G:$D(DIRUT) FY

 S APCLRPTT=Y

 I APCLRPTT="T" W !!,$C(7),"The name of the template will be:  ACTIVE USERS AS OF "_$$FMTE^XLFDT(APCLFYE,"2E")_" and it will be attached to the IHS PATIENT file" G ZIS

SBT ;subtotal by tribe?

 G:APCLSORT'="C" SBC

 W ! S APCLSUB="" S DIR(0)="YO",DIR("A")="Do you wish to Sub-Total by Tribe",DIR("?")="If you want sub-totals by tribe for each community enter a Y" D ^DIR K DIR

 G:$D(DIRUT) FY

 S APCLSUB=Y

 G ZIS

SBC ;subtotal by community

 W ! S APCLSUB="" S DIR(0)="YO",DIR("A")="Do you wish to Sub-Total by Current Community of Residence",DIR("?")="If you want sub-totals by community for each Tribe enter a Y" D ^DIR K DIR

 G:$D(DIRUT) FY

 S APCLSUB=Y

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G RPT

 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!",!

 S XBRP="^APCLACC1",XBRC="^APCLACC2",XBRX="EOJ^APCLACC",XBNS="APCL"

 D ^XBDBQUE

 D EOJ

INIT ;

ACC ;

 I '$D(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",! S APCLQUIT="" Q

 I 'DUZ(2) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",! S APCLQUIT="" Q

 W:$D(IOF) @IOF

 I '$D(APCLSORT) W $C(7),$C(7),!!,"Report Type Missing!!",! S APCLQUIT="" Q

 W !,"This option will produce either:"

 W !?5,"1) A Report of Registered Patients and Active Users sorted by",!?8,$S(APCLSORT="C":"Community of Residence",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),", OR"

 W !?5,"2) A Template of Active Users for use in QMan Searches"

 W !!,"Your Report or Template can be generated for one or more Facilities or for",!,"one or more Service Units."

 W !!,"To determine Active Users for your Report or Template, the system will select",!,"patients who have had a visit at the Facility(s) or Service Unit(s) specified",!

 W "within the past 3 years of the date you specify.  IHS, CHS and Tribal"

 W !,"visits will all be included.  Home, telephone, employee health, and chart review",!,"visits are excluded."

 W !!,"You will be asked if the patients must live in the Service Unit specified",!,"and if you only want Indian patients included."

  W "  You must answer YES to both",!,"questions in order to conform to the official IHS definition of Active Users."

 ;W "The report will be sorted by ",$S(APCLSORT="C":"COMMUNITY OF RESIDENCE",APCLSORT="T":"TRIBE OF MEMBERSHIP",1:"SERVICE UNIT OF RESIDENCE"),"."

EOJ ;ENTRY POINT

ACCEOJ K DIC,%DT,IO("Q"),I,J,K,JK,X,Y,POP,DIRUT,ZTSK,H,M,S,TS,ZTQUEUED

 K APCLSVJ,APCLCOMM,APCLDIC("B"),APCLDICB,APCLJ,APCLDFN,APCLGOT1,APCLHRN,APCLTRI,APCLTRIC,APCLSU,APCL80D,APCLPG,APCLFYEY,APCLFS,APCLFYB,APCLFYE,APCLRPTT,APCLSTMP

 K APCLQUIT,APCLPCP,APCLCOMN,APCLGOTA,APCLSKIP,APCLV,APCLVDFN,APCL1,APCL2,APCLDTP,APCLSUP,APCLVD,APCLSUB,APCLBT,APCLJOB

 K APCLVAR,APCLVAR1,APCLVAR2,APCLIND,APCLT,APCLP,APCLI,APCLSUF,APCLCOMN,APCLFYBY,APCLFYB,APCLSORT,APCLFYBI,APCLFYEI,APCLSUN,APCLMAJ,APCLMIN,APCLSSUR,APCLSUR

APCLACC   ; IHS/CMI/LAB - active users by community ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;IHS/CMI/LAB - added a template creation option

START     ;

 +1        DO INIT

 +2        IF $DATA(APCLQUIT)

               GOTO EOJ

SUF       ;S (APCLSUF,APCLFS)="",DIR(0)="SBO^F:FACILITY;S:SERVICE UNIT",DIR("A")="Report for a particular Facility or for a Service Unit?" D ^DIR K DIR

 +1        SET (APCLSUF,APCLFS)=""

           SET DIR(0)="S^F:ONE OR MORE FACILITIES;S:ONE OR MORE SERVICE UNITS"

           SET DIR("A")="Report on patients registered at"

           SET DIR("B")="F"

           KILL DA

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO EOJ

 +3        SET APCLFS=Y

 +4        IF Y="S"

               GOTO S

F         ;

 +1        KILL APCLSU,APCLSUF

 +2        SET X="LOCATION OF ENCOUNTER"

           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 EOJ

 +3        DO PEP^AMQQGTX0(+Y,"APCLSU(")

 +4        IF '$DATA(APCLSU)

               GOTO SUF

 +5        IF $DATA(APCLSU("*"))

               KILL APCLSU

               GOTO SUF

 +6       ;set all service units in APCLSUF

           SET X=0

FOR

               SET X=$ORDER(APCLSU(X))

               IF X'=+X

                   QUIT

               IF $PIECE(^AUTTLOC(X,0),U,5)

                   SET APCLSUF($PIECE(^AUTTLOC(X,0),U,5))=""

 +7        GOTO SUR

S         ;

 +1        KILL APCLSU

 +2        SET X="SERVICE UNIT"

           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 EOJ

 +3        DO PEP^AMQQGTX0(+Y,"APCLSU(")

 +4        IF '$DATA(APCLSU)

               GOTO SUF

 +5        IF $DATA(APCLSU("*"))

               KILL APCLSU

               GOTO SUF

 +6        SET X=0

FOR

               SET X=$ORDER(APCLSU(X))

               IF X'=+X

                   QUIT

               SET APCLSUF(X)=""

SUR       ;

 +1        WRITE !

 +2        SET APCLSSUR=""

 +3        WRITE !

           SET DIR("A")="Do you want to include only patients living in these"_$SELECT(APCLFS="F":" Facility's",1:"")_" SERVICE UNIT's"

 +4        SET DIR(0)="YO"

 +5        SET DIR("?")="If you want to only include those people living in the SU indicated or the SU of the Facility indicated enter Y"

           DO ^DIR

           KILL DIR

 +6        IF $DATA(DIRUT)

               GOTO SUF

 +7        SET APCLSSUR=Y

IND       ;

 +1        WRITE !

           SET APCLIND=""

           SET DIR(0)="YO"

           SET DIR("A")="Do you wish to include only INDIAN patients"

           SET DIR("?")="If you wish to exclude Non-Indians from the report enter a Y"

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO SUF

 +3        SET APCLIND=Y

FY        ;

 +1        SET Y=DT

           XECUTE ^DD("DD")

           SET APCLDTP=Y

 +2        SET %DT("A")="** Patients are to be considered ACTIVE 'as of' what date: "

           SET %DT="AEPX"

           WRITE !

           DO ^%DT

 +3        IF Y=-1

               GOTO IND

 +4        SET APCLFYE=Y

           XECUTE ^DD("DD")

           SET APCLFYEY=Y

RPT       ;report type

 +1        SET APCLRPTT=""

 +2        SET DIR(0)="S^F:Full Report;T:Create a Template of the Active Patients"

           SET DIR("A")="Which report type do you want"

           SET DIR("B")="F"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO FY

 +4        SET APCLRPTT=Y

 +5        IF APCLRPTT="T"

               WRITE !!,$CHAR(7),"The name of the template will be:  ACTIVE USERS AS OF "_$$FMTE^XLFDT(APCLFYE,"2E")_" and it will be attached to the IHS PATIENT file"

               GOTO ZIS

SBT       ;subtotal by tribe?

 +1        IF APCLSORT'="C"

               GOTO SBC

 +2        WRITE !

           SET APCLSUB=""

           SET DIR(0)="YO"

           SET DIR("A")="Do you wish to Sub-Total by Tribe"

           SET DIR("?")="If you want sub-totals by tribe for each community enter a Y"

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO FY

 +4        SET APCLSUB=Y

 +5        GOTO ZIS

SBC       ;subtotal by community

 +1        WRITE !

           SET APCLSUB=""

           SET DIR(0)="YO"

           SET DIR("A")="Do you wish to Sub-Total by Current Community of Residence"

           SET DIR("?")="If you want sub-totals by community for each Tribe enter a Y"

           DO ^DIR

           KILL DIR

 +2        IF $DATA(DIRUT)

               GOTO FY

 +3        SET APCLSUB=Y

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO RPT

 +3        WRITE !!!,"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!",!

 +4        SET XBRP="^APCLACC1"

           SET XBRC="^APCLACC2"

           SET XBRX="EOJ^APCLACC"

           SET XBNS="APCL"

 +5        DO ^XBDBQUE

 +6        DO EOJ

 +7        QUIT

 +8       ;

INIT      ;

ACC       ;

 +1        IF '$DATA(DUZ(2))

               WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!

               SET APCLQUIT=""

               QUIT

 +2        IF 'DUZ(2)

               WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!

               SET APCLQUIT=""

               QUIT

 +3        IF $DATA(IOF)

               WRITE @IOF

 +4        IF '$DATA(APCLSORT)

               WRITE $CHAR(7),$CHAR(7),!!,"Report Type Missing!!",!

               SET APCLQUIT=""

               QUIT

 +5        WRITE !,"This option will produce either:"

 +6        WRITE !?5,"1) A Report of Registered Patients and Active Users sorted by",!?8,$SELECT(APCLSORT="C":"Community of Residence",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),", OR"

 +7        WRITE !?5,"2) A Template of Active Users for use in QMan Searches"

 +8        WRITE !!,"Your Report or Template can be generated for one or more Facilities or for",!,"one or more Service Units."

 +9        WRITE !!,"To determine Active Users for your Report or Template, the system will select",!,"patients who have had a visit at the Facility(s) or Service Unit(s) specified",!

 +10       WRITE "within the past 3 years of the date you specify.  IHS, CHS and Tribal"

 +11       WRITE !,"visits will all be included.  Home, telephone, employee health, and chart review",!,"visits are excluded."

 +12       WRITE !!,"You will be asked if the patients must live in the Service Unit specified",!,"and if you only want Indian patients included."

 +13       WRITE "  You must answer YES to both",!,"questions in order to conform to the official IHS definition of Active Users."

 +14      ;W "The report will be sorted by ",$S(APCLSORT="C":"COMMUNITY OF RESIDENCE",APCLSORT="T":"TRIBE OF MEMBERSHIP",1:"SERVICE UNIT OF RESIDENCE"),"."

 +15       QUIT

 +16      ;

EOJ       ;ENTRY POINT

ACCEOJ     KILL DIC,%DT,IO("Q"),I,J,K,JK,X,Y,POP,DIRUT,ZTSK,H,M,S,TS,ZTQUEUED

 +1        KILL APCLSVJ,APCLCOMM,APCLDIC("B"),APCLDICB,APCLJ,APCLDFN,APCLGOT1,APCLHRN,APCLTRI,APCLTRIC,APCLSU,APCL80D,APCLPG,APCLFYEY,APCLFS,APCLFYB,APCLFYE,APCLRPTT,APCLSTMP

 +2        KILL APCLQUIT,APCLPCP,APCLCOMN,APCLGOTA,APCLSKIP,APCLV,APCLVDFN,APCL1,APCL2,APCLDTP,APCLSUP,APCLVD,APCLSUB,APCLBT,APCLJOB

 +3        KILL APCLVAR,APCLVAR1,APCLVAR2,APCLIND,APCLT,APCLP,APCLI,APCLSUF,APCLCOMN,APCLFYBY,APCLFYB,APCLSORT,APCLFYBI,APCLFYEI,APCLSUN,APCLMAJ,APCLMIN,APCLSSUR,APCLSUR

 +4        QUIT

 +5       ;

 +6        QUIT

APCLACC.m