ABMMUPV2.m

ABMMUPV2 ;IHS/SD/SDR - MU Patient Volume EP Report ;

 ;;2.6;IHS 3P BILLING SYSTEM;**7,8**;NOV 12, 2009

 ;

CALC ;EP

 I ABMY("RTYP")="GRP" D CALC2 Q  ;abm*2.6*8

 S ABMSDT=0

 F  S ABMSDT=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT)) Q:'ABMSDT  D

 .S ABMPRV=0

 .F  S ABMPRV=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV)) Q:'ABMPRV  D

 ..S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMPRV))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV))))*100,0,1)

 ..S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMPRV)=ABMPERCT

 ..I '$D(^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)) S ^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)=ABMPERCT_"^"_ABMSDT

 ..I +$P($G(^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)),U)<ABMPERCT S ^XTMP("ABM-PVP",$J,"PRV TOP",ABMPRV)=ABMPERCT_"^"_ABMSDT

 ..;

 ..S ABMVLOC=0

 ..F  S ABMVLOC=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC)) Q:'ABMVLOC  D

 ...I +$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC))=0 S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=0 Q

 ...S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC))))*100,0,1)

 ...S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=ABMPERCT

 Q

 ;start new code abm*2.6*8

CALC2 ;EP

 S ABMSDT=0

 F  S ABMSDT=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT)) Q:'ABMSDT  D

 .S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT))))*100,0,1)

 .S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT)=ABMPERCT

 .I '$D(^XTMP("ABM-PVP",$J,"PRV TOP")) S ^XTMP("ABM-PVP",$J,"PRV TOP")=ABMPERCT_"^"_ABMSDT

 .I +$P($G(^XTMP("ABM-PVP",$J,"PRV TOP")),U)<ABMPERCT S ^XTMP("ABM-PVP",$J,"PRV TOP")=ABMPERCT_"^"_ABMSDT

 .;

 .S ABMVLOC=0

 .F  S ABMVLOC=$O(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMVLOC)) Q:'ABMVLOC  D

 ..I +$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMVLOC))=0 S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMVLOC)=0 Q

 ..S ABMPERCT=$J((+$G(^XTMP("ABM-PVP",$J,"PRV-NUM",ABMSDT,ABMVLOC))/(+$G(^XTMP("ABM-PVP",$J,"PRV-DENOM",ABMSDT,ABMVLOC))))*100,0,1)

 ..S ^XTMP("ABM-PVP",$J,"PRV PERCENT",ABMSDT,ABMVLOC)=ABMPERCT

 Q

 ;end new code abm*2.6*8

ABMMUPV2  ;IHS/SD/SDR - MU Patient Volume EP Report ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**7,8**;NOV 12, 2009

 +2       ;

CALC      ;EP

 +1       ;abm*2.6*8

           IF ABMY("RTYP")="GRP"

               DO CALC2

               QUIT 

 +2        SET ABMSDT=0

 +3        FOR 

               SET ABMSDT=$ORDER(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT))

               IF 'ABMSDT

                   QUIT 

               Begin DoDot:1

 +4                SET ABMPRV=0

 +5                FOR 

                       SET ABMPRV=$ORDER(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT,ABMPRV))

                       IF 'ABMPRV

                           QUIT 

                       Begin DoDot:2

 +6                        SET ABMPERCT=$JUSTIFY((+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMSDT,ABMPRV))/(+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT,ABMPRV))))*100,0,1)

 +7                        SET ^XTMP("ABM-PVP",$JOB,"PRV PERCENT",ABMSDT,ABMPRV)=ABMPERCT

 +8                        IF '$DATA(^XTMP("ABM-PVP",$JOB,"PRV TOP",ABMPRV))

                               SET ^XTMP("ABM-PVP",$JOB,"PRV TOP",ABMPRV)=ABMPERCT_"^"_ABMSDT

 +9                        IF +$PIECE($GET(^XTMP("ABM-PVP",$JOB,"PRV TOP",ABMPRV)),U)<ABMPERCT

                               SET ^XTMP("ABM-PVP",$JOB,"PRV TOP",ABMPRV)=ABMPERCT_"^"_ABMSDT

 +10      ;

 +11                       SET ABMVLOC=0

 +12                       FOR 

                               SET ABMVLOC=$ORDER(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC))

                               IF 'ABMVLOC

                                   QUIT 

                               Begin DoDot:3

 +13                               IF +$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC))=0

                                       SET ^XTMP("ABM-PVP",$JOB,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=0

                                       QUIT 

 +14                               SET ABMPERCT=$JUSTIFY((+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC))/(+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC))))*100,0,1)

 +15                               SET ^XTMP("ABM-PVP",$JOB,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=ABMPERCT

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +16       QUIT 

 +17      ;start new code abm*2.6*8

CALC2     ;EP

 +1        SET ABMSDT=0

 +2        FOR 

               SET ABMSDT=$ORDER(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT))

               IF 'ABMSDT

                   QUIT 

               Begin DoDot:1

 +3                SET ABMPERCT=$JUSTIFY((+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMSDT))/(+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT))))*100,0,1)

 +4                SET ^XTMP("ABM-PVP",$JOB,"PRV PERCENT",ABMSDT)=ABMPERCT

 +5                IF '$DATA(^XTMP("ABM-PVP",$JOB,"PRV TOP"))

                       SET ^XTMP("ABM-PVP",$JOB,"PRV TOP")=ABMPERCT_"^"_ABMSDT

 +6                IF +$PIECE($GET(^XTMP("ABM-PVP",$JOB,"PRV TOP")),U)<ABMPERCT

                       SET ^XTMP("ABM-PVP",$JOB,"PRV TOP")=ABMPERCT_"^"_ABMSDT

 +7       ;

 +8                SET ABMVLOC=0

 +9                FOR 

                       SET ABMVLOC=$ORDER(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT,ABMVLOC))

                       IF 'ABMVLOC

                           QUIT 

                       Begin DoDot:2

 +10                       IF +$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMSDT,ABMVLOC))=0

                               SET ^XTMP("ABM-PVP",$JOB,"PRV PERCENT",ABMSDT,ABMVLOC)=0

                               QUIT 

 +11                       SET ABMPERCT=$JUSTIFY((+$GET(^XTMP("ABM-PVP",$JOB,"PRV-NUM",ABMSDT,ABMVLOC))/(+$GET(^XTMP("ABM-PVP",$JOB,"PRV-DENOM",ABMSDT,ABMVLOC))))*100,0,1)

 +12                       SET ^XTMP("ABM-PVP",$JOB,"PRV PERCENT",ABMSDT,ABMVLOC)=ABMPERCT

                       End DoDot:2

               End DoDot:1

 +13       QUIT 

 +14      ;end new code abm*2.6*8