APCLHCT.m

APCLHCT ; IHS/CMI/LAB - DRIVER FOR ACTIVE POP ;

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

START ;

 D INIT

 G:$D(APCLEOJ) EOJ

F ;

 W !,"For which Hospital (Location of Encounter) should the report be run?",!

 S DIC("A")="Which Location (Hospital)? ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA G:Y<0 EOJ

 S APCLLOC=+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) F

 S APCLIND=Y

SD ;

 W !

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

 S %DT("A")="Starting Discharge Date for Inpatient Counts: ",%DT="AEPX" W ! D ^%DT

 I Y=-1 G IND

 S APCLSD=Y X ^DD("DD") S APCLSDY=Y

ED S %DT("A")="Ending Discharge Date for Inpatient Counts: " W ! D ^%DT K %DT

 I Y=-1 G SD

 S APCLED=Y X ^DD("DD") S APCLEDY=Y

 I APCLED<APCLSD W !!,"Ending Date cannot be before Starting Date! Please reenter.",! G SD

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) SD

 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) SD

 S APCLSUB=Y

 W !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT AND VISIT FILES!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!

ZIS ;

DEMO ;

 D DEMOCHK^APCLUTL(.APCLDEMO)

 I APCLDEMO=-1 G SD

 S XBRP="^APCLHCT1",XBRC="^APCLHCT2",XBRX="EOJ^APCLHCT",XBNS="APCL"

 D ^XBDBQUE

 D EOJ

 Q

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

 D EN^XBVK("APCL")

 Q

 ;

INIT ;

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

 W:$D(IOF) @IOF

 W !!,"This Option will search the Patient file for all patients registered",!,"at the Service Unit or the facility that you select.",!

 W "A Report will result which will give the following counts:",!

 ;W ?5,"- All Living Patients registered at the facility or SU selected",!

 W ?5,"- The Number of ADULT/PEDIATRIC Discharges in the date range specified",!

 W ?5,"- Total number of Inpatient Days by Adult/Peds",!

 W ?5,"- The Number of NEWBORN discharges",!

 W ?5,"- The number of NEWBORN Days",!

 W ?5,"- The number of transfers in",!

 W ?5,"- The number with MCR/MCD/PI on the date of admission",!

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

 Q

APCLHCT   ; IHS/CMI/LAB - DRIVER FOR ACTIVE POP ;

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

START     ;

 +1        DO INIT

 +2        IF $DATA(APCLEOJ)

               GOTO EOJ

F         ;

 +1        WRITE !,"For which Hospital (Location of Encounter) should the report be run?",!

 +2        SET DIC("A")="Which Location (Hospital)? "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC,DA

           IF Y<0

               GOTO EOJ

 +3        SET APCLLOC=+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 F

 +3        SET APCLIND=Y

SD        ;

 +1        WRITE !

 +2        SET Y=DT

           XECUTE ^DD("DD")

           SET APCLDTP=Y

 +3        SET %DT("A")="Starting Discharge Date for Inpatient Counts: "

           SET %DT="AEPX"

           WRITE !

           DO ^%DT

 +4        IF Y=-1

               GOTO IND

 +5        SET APCLSD=Y

           XECUTE ^DD("DD")

           SET APCLSDY=Y

ED         SET %DT("A")="Ending Discharge Date for Inpatient Counts: "

           WRITE !

           DO ^%DT

           KILL %DT

 +1        IF Y=-1

               GOTO SD

 +2        SET APCLED=Y

           XECUTE ^DD("DD")

           SET APCLEDY=Y

 +3        IF APCLED<APCLSD

               WRITE !!,"Ending Date cannot be before Starting Date! Please reenter.",!

               GOTO SD

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 SD

 +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 SD

 +3        SET APCLSUB=Y

 +4        WRITE !!!,"THIS REPORT WILL SEARCH THE ENTIRE PATIENT AND VISIT FILES!",!!,"IT IS STRONGLY RECOMMENDED THAT YOU QUEUE THIS REPORT FOR A TIME WHEN THE",!,"SYSTEM IS NOT IN HEAVY USE!",!

ZIS       ;

DEMO      ;

 +1        DO DEMOCHK^APCLUTL(.APCLDEMO)

 +2        IF APCLDEMO=-1

               GOTO SD

 +3        SET XBRP="^APCLHCT1"

           SET XBRC="^APCLHCT2"

           SET XBRX="EOJ^APCLHCT"

           SET XBNS="APCL"

 +4        DO ^XBDBQUE

 +5        DO EOJ

 +6        QUIT 

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

 +1        DO EN^XBVK("APCL")

 +2        QUIT 

 +3       ;

INIT      ;

 +1        IF '$DATA(APCLSORT)

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

               SET APCLQUIT=""

               QUIT 

 +2        IF $DATA(IOF)

               WRITE @IOF

 +3        WRITE !!,"This Option will search the Patient file for all patients registered",!,"at the Service Unit or the facility that you select.",!

 +4        WRITE "A Report will result which will give the following counts:",!

 +5       ;W ?5,"- All Living Patients registered at the facility or SU selected",!

 +6        WRITE ?5,"- The Number of ADULT/PEDIATRIC Discharges in the date range specified",!

 +7        WRITE ?5,"- Total number of Inpatient Days by Adult/Peds",!

 +8        WRITE ?5,"- The Number of NEWBORN discharges",!

 +9        WRITE ?5,"- The number of NEWBORN Days",!

 +10       WRITE ?5,"- The number of transfers in",!

 +11       WRITE ?5,"- The number with MCR/MCD/PI on the date of admission",!

 +12       WRITE "The report will be sorted by ",$SELECT(APCLSORT="C":"COMMUNITY OF RESIDENCE",APCLSORT="T":"TRIBE OF MEMBERSHIP",1:"SERVICE UNIT OF RESIDENCE"),".",!!

 +13       QUIT