APCLAAP.m

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      ;