APCL2AP ; IHS/CMI/LAB - print apc report 1A ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;CMI/TUCSON/LAB - patch 3
START ;
S APCL132="__________________________________________________________________________________________________________________________________"
S APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"
;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
D START1
Q:$D(APCLQUIT)
D DONE
Q
START1 ;
S APCLLOC=0 F S APCLLOC=$O(APCLLOCS(APCLLOC)) Q:APCLLOC'=+APCLLOC!($D(APCLQUIT)) D
.S APCLLOCC=$P(^AUTTLOC(APCLLOC,0),U,10),APCLLOCP=$P(^DIC(4,APCLLOC,0),U)
.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)
.D SU
.Q
Q
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,APCLPDC="" D HEAD
K APCLQUIT
I APCLGRAN(APCLLOC)=0 W !!,"NO VISITS FOR THIS FISCAL YEAR",! G DONE
F S APCLPDC=$O(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"MODISC",APCLPDC)) Q:APCLPDC=""!($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(APCLLOC),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("APCL2A",APCLJOB,APCLBT,APCLLOC,"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(APCLLOC))*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("APCL2A",APCLJOB,APCLBT,APCLLOC,"MONTOTPCP",APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8
I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT")) D I 1
.I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"IN XREF")) W !!!,^("IN XREF")," visits were not exported to the National Data Warehouse because they ",!,"were posted or modified after the last NDW export was generated.",!
.W !,($S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT")):^("NO EXPORT"),1:0)-$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"IN XREF")):^("IN XREF"),1:0))
.W " visits were not exported because of missing or invalid data. To see a list"
.W !,"of these visits so that they may be resubmitted use the option ",!,"called 'List APC-1A Visits Not Exported.",!
;I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")) D I 1
;.W !,"There were ",^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")," instances of 2 or more visits"
;.W " by a patient to the same clinic, same provider in the same day. These ",^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")," will not be",!,"counted in the report produced at the Data Center, but are counted in the report above.",!
;I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE"))!($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT"))) D I 1
;.W !,"This accounts for a total of ",($S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT")):^("NO EXPORT"),1:0)+$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")):^("DUPLICATE"),1:0))
;W " visits that will be counted in this report but not in the 1A report from the Data Center.",!
W !
Q
DONE D DONE^APCLOSUT
K ^XTMP("APCL2A",APCLJOB,APCLBT)
Q
P ;
S APCLDISC="" F S APCLDISC=$O(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"MODISC",APCLPDC,APCLDISC)) Q:APCLDISC=""!($D(APCLQUIT)) D P1
Q
;
P1 ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
S (APCLP,APCLT)=^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DISCTOT",APCLPDC,APCLDISC),APCLP=(((APCLP/APCLGRAN(APCLLOC))*100.00)+.05),APCLP=$P(APCLP,".")_"."_$E($P(APCLP,".",2))
I APCLDISC="??" S APCLDISN="NO PROVIDER CLASS" G W
S APCLDISN=$P($G(^DIC(7,APCLDISC,9999999)),U)_" "_$E($P(^DIC(7,APCLDISC,0),U),1,17) 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("APCL2A",APCLJOB,APCLBT,APCLLOC,"MODISC",APCLPDC,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("APCL2A",APCLJOB,APCLBT,APCLLOC,"MONTOTALL",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
I $D(APCLPRIM) S ^(APCLJ)=$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"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-AMBULATORY PATIENT CARE REPORT 1A",?95,APCLDT,?110,"Page ",APCLPG
W !?5,"S.U.: ",APCLSUC," ",APCLSU,?58,"FISCAL YEAR ",APCLFYD
W !?5,"FAC.: ",APCLLOCC," ",APCLLOCP
W !?24,"AMBULATORY CARE 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
;
APCL2AP ; IHS/CMI/LAB - print apc report 1A ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;CMI/TUCSON/LAB - patch 3
START ;
+1 SET APCL132="__________________________________________________________________________________________________________________________________"
+2 SET APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"
+3 ;beginning Y2K
+4 ;S Y=$E(APCLFYE,1,3)_"0000" D DD^%DT S APCLFYD=Y S Y=DT D DD^%DT S APCLDT=Y ;Y2000
+5 ;Y2000
SET APCLFYD=APCL("FY")
SET Y=DT
DO DD^%DT
SET APCLDT=Y
+6 ;end Y2K
+7 DO START1
+8 IF $DATA(APCLQUIT)
QUIT
+9 DO DONE
+10 QUIT
START1 ;
+1 SET APCLLOC=0
FOR
SET APCLLOC=$ORDER(APCLLOCS(APCLLOC))
IF APCLLOC'=+APCLLOC!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+2 SET APCLLOCC=$PIECE(^AUTTLOC(APCLLOC,0),U,10)
SET APCLLOCP=$PIECE(^DIC(4,APCLLOC,0),U)
+3 SET APCLAREA=$PIECE(^AUTTLOC(APCLLOC,0),U,4)
IF APCLAREA=""
SET (APCLAREA,APCLAREC)="???"
GOTO SU
+4 IF '$DATA(^AUTTAREA(APCLAREA,0))
SET (APCLAREA,APCLAREC)="???"
GOTO SU
+5 SET APCLAREC=$PIECE(^AUTTAREA(APCLAREA,0),U,2)
SET APCLAREA=$PIECE(^AUTTAREA(APCLAREA,0),U)
+6 DO SU
+7 QUIT
End DoDot:1
+8 QUIT
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 ;
+1 SET (APCLPG,APCLDISC,APCLPRIT)=0
SET APCLPDC=""
DO HEAD
+2 KILL APCLQUIT
+3 IF APCLGRAN(APCLLOC)=0
WRITE !!,"NO VISITS FOR THIS FISCAL YEAR",!
GOTO DONE
+4 FOR
SET APCLPDC=$ORDER(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"MODISC",APCLPDC))
IF APCLPDC=""!($DATA(APCLQUIT))
QUIT
DO P
+5 IF $DATA(APCLQUIT)
GOTO DONE
+6 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+7 WRITE !!," T O T A L",?21,$JUSTIFY(APCLGRAN(APCLLOC),7),?30,"100.0"
+8 SET APCLMON=""
SET APCLTAB=36
FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9
SET APCLMON=$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"MONTOTALL",APCLJ)):^(APCLJ),1:0)
WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)
SET APCLTAB=APCLTAB+8
+9 WRITE !!,"*TOTAL PRIMARY PVDR",?21,$JUSTIFY(APCLPRIT,7)
SET APCLP=(((APCLPRIT/APCLGRAN(APCLLOC))*100.00)+.05)
SET APCLP=$PIECE(APCLP,".")_"."_$EXTRACT($PIECE(APCLP,".",2))
+10 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("APCL2A",APCLJOB,APCLBT,APCLLOC,"MONTOTPCP",APCLJ)):^(APCLJ),1:0)
WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)
SET APCLTAB=APCLTAB+8
+11 IF $DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT"))
Begin DoDot:1
+12 IF $DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"IN XREF"))
WRITE !!!,^("IN XREF")," visits were not exported to the National Data Warehouse because they ",!,"were posted or modified after the last NDW export was generated.",!
+13 WRITE !,($SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT")):^("NO EXPORT"),1:0)-$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"IN XREF")):^("IN XREF"),1:0))
+14 WRITE " visits were not exported because of missing or invalid data. To see a list"
+15 WRITE !,"of these visits so that they may be resubmitted use the option ",!,"called 'List APC-1A Visits Not Exported.",!
End DoDot:1
IF 1
+16 ;I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")) D I 1
+17 ;.W !,"There were ",^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")," instances of 2 or more visits"
+18 ;.W " by a patient to the same clinic, same provider in the same day. These ",^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")," will not be",!,"counted in the report produced at the Data Center, but are counted in the report above.",!
+19 ;I $D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE"))!($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT"))) D I 1
+20 ;.W !,"This accounts for a total of ",($S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"NO EXPORT")):^("NO EXPORT"),1:0)+$S($D(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DUPLICATE")):^("DUPLICATE"),1:0))
+21 ;W " visits that will be counted in this report but not in the 1A report from the Data Center.",!
+22 WRITE !
+23 QUIT
DONE DO DONE^APCLOSUT
+1 KILL ^XTMP("APCL2A",APCLJOB,APCLBT)
+2 QUIT
P ;
+1 SET APCLDISC=""
FOR
SET APCLDISC=$ORDER(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"MODISC",APCLPDC,APCLDISC))
IF APCLDISC=""!($DATA(APCLQUIT))
QUIT
DO P1
+2 QUIT
+3 ;
P1 ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 SET (APCLP,APCLT)=^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"DISCTOT",APCLPDC,APCLDISC)
SET APCLP=(((APCLP/APCLGRAN(APCLLOC))*100.00)+.05)
SET APCLP=$PIECE(APCLP,".")_"."_$EXTRACT($PIECE(APCLP,".",2))
+3 IF APCLDISC="??"
SET APCLDISN="NO PROVIDER CLASS"
GOTO W
+4 SET APCLDISN=$PIECE($GET(^DIC(7,APCLDISC,9999999)),U)_" "_$EXTRACT($PIECE(^DIC(7,APCLDISC,0),U),1,17)
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("APCL2A",APCLJOB,APCLBT,APCLLOC,"MODISC",APCLPDC,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("APCL2A",APCLJOB,APCLBT,APCLLOC,"MONTOTALL",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
+2 IF $DATA(APCLPRIM)
SET ^(APCLJ)=$SELECT($DATA(^XTMP("APCL2A",APCLJOB,APCLBT,APCLLOC,"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-AMBULATORY PATIENT CARE REPORT 1A",?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,"AMBULATORY CARE 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 ;
