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
