APCLAAP ; IHS/CMI/LAB - print apc report 1A ;
;;2.0;IHS PCC SUITE;**15**;MAY 14, 2009;Build 11
;CMI/TUCSON/LAB - patch 3 FY Fix
START ;
S APCL132="__________________________________________________________________________________________________________________________________"
S APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"
S APCLLOCC=$P(^AUTTLOC(APCLLOC,0),U,10),APCLLOCP=$P(^DIC(4,APCLLOC,0),U)
;beginning Y2K
;S Y=$E(APCLFYE,1,3)_"0000" D DD^%DT S APCLFYD=Y S Y=DT D DD^%DT S APCLDT=Y ;Y2000
S APCLFYD=APCL("FY") S Y=DT D DD^%DT S APCLDT=Y ;Y2000
;end Y2K
S APCLAREA=$P(^AUTTLOC(APCLLOC,0),U,4) I APCLAREA="" S (APCLAREA,APCLAREC)="???" G SU
I '$D(^AUTTAREA(APCLAREA,0)) S (APCLAREA,APCLAREC)="???" G SU
S APCLAREC=$P(^AUTTAREA(APCLAREA,0),U,2),APCLAREA=$P(^AUTTAREA(APCLAREA,0),U)
SU ;
S APCLSU=$P(^AUTTLOC(APCLLOC,0),U,5) I APCLSU="" S (APCLSU,APCLSUC)="???" G START2
I '$D(^AUTTSU(APCLSU,0)) S (APCLSU,APCLSUC)="999" G START2
S APCLSUC=$P(^AUTTSU(APCLSU,0),U,3),APCLSU=$P(^AUTTSU(APCLSU,0),U)
START2 S (APCLPG,APCLDISC,APCLPRIT)=0 D HEAD
K APCLQUIT
I APCLGRAN=0 W !!,"NO VISITS FOR THIS FISCAL YEAR",! G DONE
F S APCLDISC=$O(^XTMP("APCLAA",APCLJOB,APCLBT,"MODISC",APCLDISC)) Q:APCLDISC=""!($D(APCLQUIT)) D P
G:$D(APCLQUIT) DONE
I $Y>(IOSL-8) D HEAD G:$D(APCLQUIT) DONE
W !!," T O T A L",?21,$J(APCLGRAN,7),?30,"100.0"
S APCLMON="",APCLTAB=36 F APCLJ=10,11,12,1,2,3,4,5,6,7,8,9 S APCLMON=$S($D(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTALL",APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8
W !!,"*TOTAL PRIMARY PVDR",?21,$J(APCLPRIT,7) S APCLP=(((APCLPRIT/APCLGRAN)*100.00)+.05),APCLP=$P(APCLP,".")_"."_$E($P(APCLP,".",2))
W ?30,$J(APCLP,5) S APCLMON="",APCLTAB=36 F APCLJ=10,11,12,1,2,3,4,5,6,7,8,9 S APCLMON=$S($D(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTPCP",APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8
W !
DONE D DONE^APCLOSUT
K ^XTMP("APCLAA",APCLJOB,APCLBT)
Q
P ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
S (APCLP,APCLT)=^XTMP("APCLAA",APCLJOB,APCLBT,"DISCTOT",APCLDISC),APCLP=(((APCLP/APCLGRAN)*100.00)+.05),APCLP=$P(APCLP,".")_"."_$E($P(APCLP,".",2))
I APCLDISC="??"!(APCLDISC="UNKNOWN") S APCLDISN="NO PROVIDER CLASS" G W
S APCLDISN=$E($P(^DIC(7,APCLDISC,0),U),1,20) K APCLPRIM D CHKPRIM I $D(APCLPRIM) S APCLDISN=$E(APCLDISN,1,19)_"*"
W W !,APCLDISN,?22,$J(APCLT,6),?30,$J(APCLP,5)
S APCLMON="",APCLTAB=36 F APCLJ=10,11,12,1,2,3,4,5,6,7,8,9 S APCLMON=$S($D(^XTMP("APCLAA",APCLJOB,APCLBT,"MODISC",APCLDISC,APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8 D MONTOT
Q
;
MONTOT ;set up month totals for all visits and pcp visits
S ^(APCLJ)=$S($D(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTALL",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
I $D(APCLPRIM) S ^(APCLJ)=$S($D(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTPCP",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
Q
CHKPRIM ;
;I $D(^APCLCNTL(1,11,"B",$P(^DIC(7,APCLDISC,9999999),U))) S APCLPRIM=1,APCLPRIT=APCLPRIT+APCLT
I $P($G(^DIC(7,APCLDISC,9999999)),U,3)="Y" S APCLPRIM=1,APCLPRIT=APCLPRIT+APCLT
Q
HEAD 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
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W APCL132,!
W !?5,"AREA: ",APCLAREC," ",APCLAREA,?50,"PCC-OUTPATIENT PATIENT CARE REPORT",?95,APCLDT,?110,"Page ",APCLPG
W !?5,"S.U.: ",APCLSUC," ",APCLSU,?58,"FISCAL YEAR ",APCLFYD
W !?5,"FAC.: ",APCLLOCC," ",APCLLOCP
W !?24,"ALL PCC OUTPATIENT (NON-HOSPITAL) VISITS TO SERVICE LOCATION BY PRIMARY PROVIDER AND MONTH OF SERVICE",!
W APCL132,!
W "PRIMARY PROVIDER",?23,"YR-TO",?30,"% OF"
W !," OF SERVICE",?23,"DATE",?30,"TOTAL"
S APCLTAB=38 F APCLX=1:1:12 W ?APCLTAB,$P(APCLMOL,",",APCLX) S APCLTAB=APCLTAB+8
W !,APCL132
Q
;
APCLAAP ; IHS/CMI/LAB - print apc report 1A ;
+1 ;;2.0;IHS PCC SUITE;**15**;MAY 14, 2009;Build 11
+2 ;CMI/TUCSON/LAB - patch 3 FY Fix
START ;
+1 SET APCL132="__________________________________________________________________________________________________________________________________"
+2 SET APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"
+3 SET APCLLOCC=$PIECE(^AUTTLOC(APCLLOC,0),U,10)
SET APCLLOCP=$PIECE(^DIC(4,APCLLOC,0),U)
+4 ;beginning Y2K
+5 ;S Y=$E(APCLFYE,1,3)_"0000" D DD^%DT S APCLFYD=Y S Y=DT D DD^%DT S APCLDT=Y ;Y2000
+6 ;Y2000
SET APCLFYD=APCL("FY")
SET Y=DT
DO DD^%DT
SET APCLDT=Y
+7 ;end Y2K
+8 SET APCLAREA=$PIECE(^AUTTLOC(APCLLOC,0),U,4)
IF APCLAREA=""
SET (APCLAREA,APCLAREC)="???"
GOTO SU
+9 IF '$DATA(^AUTTAREA(APCLAREA,0))
SET (APCLAREA,APCLAREC)="???"
GOTO SU
+10 SET APCLAREC=$PIECE(^AUTTAREA(APCLAREA,0),U,2)
SET APCLAREA=$PIECE(^AUTTAREA(APCLAREA,0),U)
SU ;
+1 SET APCLSU=$PIECE(^AUTTLOC(APCLLOC,0),U,5)
IF APCLSU=""
SET (APCLSU,APCLSUC)="???"
GOTO START2
+2 IF '$DATA(^AUTTSU(APCLSU,0))
SET (APCLSU,APCLSUC)="999"
GOTO START2
+3 SET APCLSUC=$PIECE(^AUTTSU(APCLSU,0),U,3)
SET APCLSU=$PIECE(^AUTTSU(APCLSU,0),U)
START2 SET (APCLPG,APCLDISC,APCLPRIT)=0
DO HEAD
+1 KILL APCLQUIT
+2 IF APCLGRAN=0
WRITE !!,"NO VISITS FOR THIS FISCAL YEAR",!
GOTO DONE
+3 FOR
SET APCLDISC=$ORDER(^XTMP("APCLAA",APCLJOB,APCLBT,"MODISC",APCLDISC))
IF APCLDISC=""!($DATA(APCLQUIT))
QUIT
DO P
+4 IF $DATA(APCLQUIT)
GOTO DONE
+5 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+6 WRITE !!," T O T A L",?21,$JUSTIFY(APCLGRAN,7),?30,"100.0"
+7 SET APCLMON=""
SET APCLTAB=36
FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9
SET APCLMON=$SELECT($DATA(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTALL",APCLJ)):^(APCLJ),1:0)
WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)
SET APCLTAB=APCLTAB+8
+8 WRITE !!,"*TOTAL PRIMARY PVDR",?21,$JUSTIFY(APCLPRIT,7)
SET APCLP=(((APCLPRIT/APCLGRAN)*100.00)+.05)
SET APCLP=$PIECE(APCLP,".")_"."_$EXTRACT($PIECE(APCLP,".",2))
+9 WRITE ?30,$JUSTIFY(APCLP,5)
SET APCLMON=""
SET APCLTAB=36
FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9
SET APCLMON=$SELECT($DATA(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTPCP",APCLJ)):^(APCLJ),1:0)
WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)
SET APCLTAB=APCLTAB+8
+10 WRITE !
DONE DO DONE^APCLOSUT
+1 KILL ^XTMP("APCLAA",APCLJOB,APCLBT)
+2 QUIT
P ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 SET (APCLP,APCLT)=^XTMP("APCLAA",APCLJOB,APCLBT,"DISCTOT",APCLDISC)
SET APCLP=(((APCLP/APCLGRAN)*100.00)+.05)
SET APCLP=$PIECE(APCLP,".")_"."_$EXTRACT($PIECE(APCLP,".",2))
+3 IF APCLDISC="??"!(APCLDISC="UNKNOWN")
SET APCLDISN="NO PROVIDER CLASS"
GOTO W
+4 SET APCLDISN=$EXTRACT($PIECE(^DIC(7,APCLDISC,0),U),1,20)
KILL APCLPRIM
DO CHKPRIM
IF $DATA(APCLPRIM)
SET APCLDISN=$EXTRACT(APCLDISN,1,19)_"*"
W WRITE !,APCLDISN,?22,$JUSTIFY(APCLT,6),?30,$JUSTIFY(APCLP,5)
+1 SET APCLMON=""
SET APCLTAB=36
FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9
SET APCLMON=$SELECT($DATA(^XTMP("APCLAA",APCLJOB,APCLBT,"MODISC",APCLDISC,APCLJ)):^(APCLJ),1:0)
WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)
SET APCLTAB=APCLTAB+8
DO MONTOT
+2 QUIT
+3 ;
MONTOT ;set up month totals for all visits and pcp visits
+1 SET ^(APCLJ)=$SELECT($DATA(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTALL",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
+2 IF $DATA(APCLPRIM)
SET ^(APCLJ)=$SELECT($DATA(^XTMP("APCLAA",APCLJOB,APCLBT,"MONTOTPCP",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
+3 QUIT
CHKPRIM ;
+1 ;I $D(^APCLCNTL(1,11,"B",$P(^DIC(7,APCLDISC,9999999),U))) S APCLPRIM=1,APCLPRIT=APCLPRIT+APCLT
+2 IF $PIECE($GET(^DIC(7,APCLDISC,9999999)),U,3)="Y"
SET APCLPRIM=1
SET APCLPRIT=APCLPRIT+APCLT
+3 QUIT
HEAD IF 'APCLPG
GOTO HEAD1
+1 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
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE APCL132,!
+3 WRITE !?5,"AREA: ",APCLAREC," ",APCLAREA,?50,"PCC-OUTPATIENT PATIENT CARE REPORT",?95,APCLDT,?110,"Page ",APCLPG
+4 WRITE !?5,"S.U.: ",APCLSUC," ",APCLSU,?58,"FISCAL YEAR ",APCLFYD
+5 WRITE !?5,"FAC.: ",APCLLOCC," ",APCLLOCP
+6 WRITE !?24,"ALL PCC OUTPATIENT (NON-HOSPITAL) VISITS TO SERVICE LOCATION BY PRIMARY PROVIDER AND MONTH OF SERVICE",!
+7 WRITE APCL132,!
+8 WRITE "PRIMARY PROVIDER",?23,"YR-TO",?30,"% OF"
+9 WRITE !," OF SERVICE",?23,"DATE",?30,"TOTAL"
+10 SET APCLTAB=38
FOR APCLX=1:1:12
WRITE ?APCLTAB,$PIECE(APCLMOL,",",APCLX)
SET APCLTAB=APCLTAB+8
+11 WRITE !,APCL132
+12 QUIT
+13 ;
