APCLOSP.m

APCLOSP ; IHS/CMI/LAB - print Operational summary ;

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

 ;

 ;

START ;

 S APCLPG=0

 S:APCLLOCT="S" (APCLSUP,APCLSUN)=$P(^AUTTSU(APCLSU,0),U)

 I APCLLOCT="O" S APCLSUP=$P(^DIC(4,$O(^XTMP("APCLSU",APCLJOB,APCLBTH,0)),0),U),APCLSUN=$P(^AUTTSU(APCLSU,0),U)

 I APCLLOCT="T" S (APCLSUP,APCLSUN)="A Set of Facilities"

 D HEAD

 K APCLQUIT S APCLSEGN="" F APCLSQ=0:0 S APCLSEGN=$O(^APCLOST(APCLRPT,1,"B",APCLSEGN)) Q:APCLSEGN=""  D SEGMNT Q:$D(APCLQUIT)

DONE ;

 K ^XTMP("APCLOS",APCLJOB,APCLBTH),^XTMP("APCLOSP",APCLJOB,APCLBTH),^XTMP("APCLSU",APCLJOB,APCLBTH)

 D DONE^APCLOSUT

EOJ ;ENTRY POINT

 K APCLPG,APCLSUP,APCLSUN,APCLSU,APCLLOCT,APCLSQIT,APCLSEGN,APCLRPT,APCLSEGT,APCLSEGC,APCLSEGP,APCLX,APCLY,APCLTYPE,APCLN,APCLLENG,APCLC,APCLD,APCLPD,APCLTOT,APCLLC,APCLMAX,APCLGLOB,APCL1,APCL2,APCLPIEC

 K APCL1,APCL2,APCL3,APCLX,APCLTOTO,APCLTOTC,APCLLC,APCLT,APCLBT

 K APCLPTR,APCLWC,APCL3,APCLT,APCLTOTC,APCLTOTO,APCLLWC

 K X,Z,G,Y

 Q

SEGMNT ; OUTPUT A SEGMENT TYPE

 S APCLSEGT=$O(^APCLOST(APCLRPT,1,"B",APCLSEGN,"")) S APCLSEGC=$P(^APCLOST(APCLRPT,1,APCLSEGT,0),U,2) S APCLSEGP=$P(^APCLOSC(APCLSEGC,0),U,3),APCLSEGC=$P(^APCLOSC(APCLSEGC,0),"^",2)

 D @($P(APCLSEGP,";")_U_$P(APCLSEGP,";",2))

 Q

 ;

POP ;

 I $Y>(IOSL-10) D HEAD Q:$D(APCLQUIT)

 W !!,"PATIENT REGISTRATION"

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"LIVREG")):^("LIVREG"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"LIVREG")):^("LIVREG"),1:0) D CALC^APCLOSUT

 W !!,"There are ",X," (",Z,") living patients registered at this ",$S(APCLLOCT="O":"facility.",1:"SU.")

 W !,"This number does not represent the 'Active User Population' which",!,"is found elsewhere in PCC Reports."

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"NEWREG")):^("NEWREG"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"NEWREG")):^("NEWREG"),1:0) D CALC^APCLOSUT

 W "  There were ",X," (",Z,") new patients, ",!

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"BIRTHS")):^("BIRTHS"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"BIRTHS")):^("BIRTHS"),1:0) D CALC^APCLOSUT

 W X," (",Z,") births, and "

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"DEATHS")):^("DEATHS"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"DEATHS")):^("DEATHS"),1:0) D CALC^APCLOSUT

 W X," (",Z,") death(s) during this period. Data is",!,"based on the Patient Registration File."

THIRD ;

 I $Y>(IOSL-10) D HEAD Q:$D(APCLQUIT)

 W !!,"THIRD PARTY ELIGIBILITY"

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCRA")):^("MCRA"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCRA")):^("MCRA"),1:0) D CALC^APCLOSUT

 W !!,"There were ",X," (",Z,") patients enrolled in Medicare Part A and "

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCRB")):^("MCRB"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCRB")):^("MCRB"),1:0) D CALC^APCLOSUT

 W !,X," (",Z,") patients enrolled in Part B at the end of this time period."

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCRD")):^("MCRD"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCRD")):^("MCRD"),1:0) D CALC^APCLOSUT

 W !!,"There were ",X," (",Z,") patients enrolled in Medicare Part D."

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCD")):^("MCD"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCD")):^("MCD"),1:0) D CALC^APCLOSUT

 W !!,"There were also ",X," (",Z,") patients enrolled in Medicaid and"

 S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"PI")):^("PI"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"PI")):^("PI"),1:0) D CALC^APCLOSUT

 W !,X," (",Z,") patients with an active private insurance policy as of that date."

 Q

HEAD ;ENTRY POINT

 I 'APCLPG G HEAD1

 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

 S APCLPG=APCLPG+1

 W:$D(IOF) @IOF W !?10,"PCC Operations Summary for ",APCLSUP,$S(APCLLOCT="O":"",APCLLOCT="S":" Service Unit",1:""),?70,"Page ",APCLPG

 Q

HEAD1 ;

 W:$D(IOF) @IOF S APCLPG=APCLPG+1

 S APCLLENG=36+$L(APCLSUN)

 W !?72,"Page ",APCLPG

 W !?((80-APCLLENG)/2),"OPERATIONS SUMMARY FOR ",APCLSUP,$S(APCLLOCT="O":"",APCLLOCT="S":" Service Unit",1:"")

 I APCLMFY=1 S Y=APCLMON D DD^%DT W !?33,"FOR ",Y

 ;I APCLMFY=2 W !192,"FOR FY",APCLFY,"-To-Date as of ",APCLFYEY

 I APCLMFY=2 W !?22,"FOR FY",APCLFY,"-To-Date:  ",APCLFYBY," - ",APCLFYEY

 I APCLMFY=3 W !?15,"FOR DATE RANGE: ",$$FMTE^XLFDT(APCLFYB)," - ",$$FMTE^XLFDT(APCLFYE)

 W !!,"(Note:  In parentheses following each statistic is the percent increase or",!,"decrease from the same time period in the previous year.  '**' indicates",!,"no data is present for one of the two time periods.)",!

 Q

APCLOSP   ; IHS/CMI/LAB - print Operational summary ;

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

 +2       ;

 +3       ;

START     ;

 +1        SET APCLPG=0

 +2        IF APCLLOCT="S"

               SET (APCLSUP,APCLSUN)=$PIECE(^AUTTSU(APCLSU,0),U)

 +3        IF APCLLOCT="O"

               SET APCLSUP=$PIECE(^DIC(4,$ORDER(^XTMP("APCLSU",APCLJOB,APCLBTH,0)),0),U)

               SET APCLSUN=$PIECE(^AUTTSU(APCLSU,0),U)

 +4        IF APCLLOCT="T"

               SET (APCLSUP,APCLSUN)="A Set of Facilities"

 +5        DO HEAD

 +6        KILL APCLQUIT

           SET APCLSEGN=""

           FOR APCLSQ=0:0

               SET APCLSEGN=$ORDER(^APCLOST(APCLRPT,1,"B",APCLSEGN))

               IF APCLSEGN=""

                   QUIT 

               DO SEGMNT

               IF $DATA(APCLQUIT)

                   QUIT 

DONE      ;

 +1        KILL ^XTMP("APCLOS",APCLJOB,APCLBTH),^XTMP("APCLOSP",APCLJOB,APCLBTH),^XTMP("APCLSU",APCLJOB,APCLBTH)

 +2        DO DONE^APCLOSUT

EOJ       ;ENTRY POINT

 +1        KILL APCLPG,APCLSUP,APCLSUN,APCLSU,APCLLOCT,APCLSQIT,APCLSEGN,APCLRPT,APCLSEGT,APCLSEGC,APCLSEGP,APCLX,APCLY,APCLTYPE,APCLN,APCLLENG,APCLC,APCLD,APCLPD,APCLTOT,APCLLC,APCLMAX,APCLGLOB,APCL1,APCL2,APCLPIEC

 +2        KILL APCL1,APCL2,APCL3,APCLX,APCLTOTO,APCLTOTC,APCLLC,APCLT,APCLBT

 +3        KILL APCLPTR,APCLWC,APCL3,APCLT,APCLTOTC,APCLTOTO,APCLLWC

 +4        KILL X,Z,G,Y

 +5        QUIT 

SEGMNT    ; OUTPUT A SEGMENT TYPE

 +1        SET APCLSEGT=$ORDER(^APCLOST(APCLRPT,1,"B",APCLSEGN,""))

           SET APCLSEGC=$PIECE(^APCLOST(APCLRPT,1,APCLSEGT,0),U,2)

           SET APCLSEGP=$PIECE(^APCLOSC(APCLSEGC,0),U,3)

           SET APCLSEGC=$PIECE(^APCLOSC(APCLSEGC,0),"^",2)

 +2        DO @($PIECE(APCLSEGP,";")_U_$PIECE(APCLSEGP,";",2))

 +3        QUIT 

 +4       ;

POP       ;

 +1        IF $Y>(IOSL-10)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT 

 +2        WRITE !!,"PATIENT REGISTRATION"

 +3        SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"LIVREG")):^("LIVREG"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"LIVREG")):^("LIVREG"),1:0)

           DO CALC^APCLOSUT

 +4        WRITE !!,"There are ",X," (",Z,") living patients registered at this ",$SELECT(APCLLOCT="O":"facility.",1:"SU.")

 +5        WRITE !,"This number does not represent the 'Active User Population' which",!,"is found elsewhere in PCC Reports."

 +6        SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"NEWREG")):^("NEWREG"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"NEWREG")):^("NEWREG"),1:0)

           DO CALC^APCLOSUT

 +7        WRITE "  There were ",X," (",Z,") new patients, ",!

 +8        SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"BIRTHS")):^("BIRTHS"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"BIRTHS")):^("BIRTHS"),1:0)

           DO CALC^APCLOSUT

 +9        WRITE X," (",Z,") births, and "

 +10       SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"DEATHS")):^("DEATHS"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"DEATHS")):^("DEATHS"),1:0)

           DO CALC^APCLOSUT

 +11       WRITE X," (",Z,") death(s) during this period. Data is",!,"based on the Patient Registration File."

THIRD     ;

 +1        IF $Y>(IOSL-10)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT 

 +2        WRITE !!,"THIRD PARTY ELIGIBILITY"

 +3        SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCRA")):^("MCRA"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCRA")):^("MCRA"),1:0)

           DO CALC^APCLOSUT

 +4        WRITE !!,"There were ",X," (",Z,") patients enrolled in Medicare Part A and "

 +5        SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCRB")):^("MCRB"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCRB")):^("MCRB"),1:0)

           DO CALC^APCLOSUT

 +6        WRITE !,X," (",Z,") patients enrolled in Part B at the end of this time period."

 +7        SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCRD")):^("MCRD"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCRD")):^("MCRD"),1:0)

           DO CALC^APCLOSUT

 +8        WRITE !!,"There were ",X," (",Z,") patients enrolled in Medicare Part D."

 +9        SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"MCD")):^("MCD"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"MCD")):^("MCD"),1:0)

           DO CALC^APCLOSUT

 +10       WRITE !!,"There were also ",X," (",Z,") patients enrolled in Medicaid and"

 +11       SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"PI")):^("PI"),1:0)

           SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"PI")):^("PI"),1:0)

           DO CALC^APCLOSUT

 +12       WRITE !,X," (",Z,") patients with an active private insurance policy as of that date."

 +13       QUIT 

HEAD      ;ENTRY POINT

 +1        IF 'APCLPG

               GOTO HEAD1

 +2        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=""

                       QUIT 

 +3        SET APCLPG=APCLPG+1

 +4        IF $DATA(IOF)

               WRITE @IOF

           WRITE !?10,"PCC Operations Summary for ",APCLSUP,$SELECT(APCLLOCT="O":"",APCLLOCT="S":" Service Unit",1:""),?70,"Page ",APCLPG

 +5        QUIT 

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +2        SET APCLLENG=36+$LENGTH(APCLSUN)

 +3        WRITE !?72,"Page ",APCLPG

 +4        WRITE !?((80-APCLLENG)/2),"OPERATIONS SUMMARY FOR ",APCLSUP,$SELECT(APCLLOCT="O":"",APCLLOCT="S":" Service Unit",1:"")

 +5        IF APCLMFY=1

               SET Y=APCLMON

               DO DD^%DT

               WRITE !?33,"FOR ",Y

 +6       ;I APCLMFY=2 W !192,"FOR FY",APCLFY,"-To-Date as of ",APCLFYEY

 +7        IF APCLMFY=2

               WRITE !?22,"FOR FY",APCLFY,"-To-Date:  ",APCLFYBY," - ",APCLFYEY

 +8        IF APCLMFY=3

               WRITE !?15,"FOR DATE RANGE: ",$$FMTE^XLFDT(APCLFYB)," - ",$$FMTE^XLFDT(APCLFYE)

 +9        WRITE !!,"(Note:  In parentheses following each statistic is the percent increase or",!,"decrease from the same time period in the previous year.  '**' indicates",!,"no data is present for one of the two time periods.)",!

 +10       QUIT