- 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 ;
