ABMDRPR3.m

ABMDRPR3 ; IHS/ASDST/DMJ - Productivity Stats ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;Original;TMD;

 ;

PRINT ;EP for writing data

 S ABM("PG")=0

 D HDB

 S ABM("CNT")=0,ABM("AMT")=0,ABM("O")="",ABM("OL")=""

 F  S ABM("O")=$O(ABM("ST",ABM("O"))) Q:'ABM("O")!($G(ABM("F1")))  D

 .I '$G(ABMY("APPR")) W !!?5,"Approving Official: ",$P(^VA(200,ABM("O"),0),U)

 .S ABM("L")="",(ABM("SUBCNT"),ABM("V"),ABM("SUBAMT"))=0

 .F  S ABM("L")=$O(ABM("ST",ABM("O"),ABM("L"))) Q:ABM("L")=""!($G(ABM("F1")))  D

 ..S (ABM("SSCNT"),ABM("V"),ABM("SSAMT"))=0

 ..F  S ABM("V")=$O(ABM("ST",ABM("O"),ABM("L"),ABM("V"))) Q:'ABM("V")!($G(ABM("F1")))  D

 ...I $Y>(IOSL-5) D HD Q:$G(ABM("F1"))  S ABM("OL")=""

 ...I ABM("L")'=ABM("OL") W !!,$E(ABM("L"),1,30) S ABM("OL")=ABM("L")

 ...E  W !

 ...I ABMY("SORT")="V" W ?32,$E($P(^ABMDVTYP(ABM("V"),0),U),1,26)

 ...I ABMY("SORT")="C" W ?32,$E($P(^DIC(40.7,ABM("V"),0),U),1,26)

 ...S ABM("T")=$P(ABM("ST",ABM("O"),ABM("L"),ABM("V")),U,1)

 ...S ABM("A")=$P(ABM("ST",ABM("O"),ABM("L"),ABM("V")),U,2)

 ...W ?60,$J($FN(ABM("T"),",",0),5)

 ...W ?67,$J($FN(ABM("A"),",",2),12)

 ...S ABM("CNT")=ABM("CNT")+ABM("T"),ABM("SUBCNT")=ABM("SUBCNT")+ABM("T")

 ...S ABM("AMT")=ABM("AMT")+ABM("A"),ABM("SUBAMT")=ABM("SUBAMT")+ABM("A")

 ...S ABM("SSAMT")=ABM("SSAMT")+ABM("A"),ABM("SSCNT")=ABM("SSCNT")+ABM("T")

 ..Q:$G(ABM("F1"))

 ..W !?60,"-----",?69,"----------",!?49,"Subtotal:",?60,$J($FN(ABM("SSCNT"),",",0),5)

 ..W ?67,$J($FN(ABM("SSAMT"),",",2),12)

 .Q:$G(ABM("F1"))

 .W !?60,"-----",?69,"----------",!?52,"Total:",?60,$J($FN(ABM("SUBCNT"),",",0),5)

 .W ?67,$J($FN(ABM("SUBAMT"),",",2),12)

 I ABM("CNT")'=+$G(ABM("SUBCNT")),'$G(ABM("F1")) W !?59,"======",?68,"===========",!?46,"Grand Total:",?59,$J($FN(ABM("CNT"),",",0),6),?67,$J($FN(ABM("AMT"),",",2),12)

 Q

 ;

HD D PAZ^ABMDRUTL I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S ABM("F1")=1 Q

HDB S ABM("PG")=ABM("PG")+1 D WHD^ABMDRHD

 W !,?58,"Number of",?72,"Amount"

 W !,"Location",?32,$S(ABMY("SORT")="C":"Clinic",1:"Visit Type"),?60,"Claims",?72,"Billed"

 S $P(ABM("LINE"),"-",80)="" W !,ABM("LINE") K ABM("LINE")

 Q

XIT ;EXIT POINT

 Q

ABMDRPR3  ; IHS/ASDST/DMJ - Productivity Stats ;

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

 +2       ;Original;TMD;

 +3       ;

PRINT     ;EP for writing data

 +1        SET ABM("PG")=0

 +2        DO HDB

 +3        SET ABM("CNT")=0

           SET ABM("AMT")=0

           SET ABM("O")=""

           SET ABM("OL")=""

 +4        FOR 

               SET ABM("O")=$ORDER(ABM("ST",ABM("O")))

               IF 'ABM("O")!($GET(ABM("F1")))

                   QUIT 

               Begin DoDot:1

 +5                IF '$GET(ABMY("APPR"))

                       WRITE !!?5,"Approving Official: ",$PIECE(^VA(200,ABM("O"),0),U)

 +6                SET ABM("L")=""

                   SET (ABM("SUBCNT"),ABM("V"),ABM("SUBAMT"))=0

 +7                FOR 

                       SET ABM("L")=$ORDER(ABM("ST",ABM("O"),ABM("L")))

                       IF ABM("L")=""!($GET(ABM("F1")))

                           QUIT 

                       Begin DoDot:2

 +8                        SET (ABM("SSCNT"),ABM("V"),ABM("SSAMT"))=0

 +9                        FOR 

                               SET ABM("V")=$ORDER(ABM("ST",ABM("O"),ABM("L"),ABM("V")))

                               IF 'ABM("V")!($GET(ABM("F1")))

                                   QUIT 

                               Begin DoDot:3

 +10                               IF $Y>(IOSL-5)

                                       DO HD

                                       IF $GET(ABM("F1"))

                                           QUIT 

                                       SET ABM("OL")=""

 +11                               IF ABM("L")'=ABM("OL")

                                       WRITE !!,$EXTRACT(ABM("L"),1,30)

                                       SET ABM("OL")=ABM("L")

 +12                              IF '$TEST

                                       WRITE !

 +13                               IF ABMY("SORT")="V"

                                       WRITE ?32,$EXTRACT($PIECE(^ABMDVTYP(ABM("V"),0),U),1,26)

 +14                               IF ABMY("SORT")="C"

                                       WRITE ?32,$EXTRACT($PIECE(^DIC(40.7,ABM("V"),0),U),1,26)

 +15                               SET ABM("T")=$PIECE(ABM("ST",ABM("O"),ABM("L"),ABM("V")),U,1)

 +16                               SET ABM("A")=$PIECE(ABM("ST",ABM("O"),ABM("L"),ABM("V")),U,2)

 +17                               WRITE ?60,$JUSTIFY($FNUMBER(ABM("T"),",",0),5)

 +18                               WRITE ?67,$JUSTIFY($FNUMBER(ABM("A"),",",2),12)

 +19                               SET ABM("CNT")=ABM("CNT")+ABM("T")

                                   SET ABM("SUBCNT")=ABM("SUBCNT")+ABM("T")

 +20                               SET ABM("AMT")=ABM("AMT")+ABM("A")

                                   SET ABM("SUBAMT")=ABM("SUBAMT")+ABM("A")

 +21                               SET ABM("SSAMT")=ABM("SSAMT")+ABM("A")

                                   SET ABM("SSCNT")=ABM("SSCNT")+ABM("T")

                               End DoDot:3

 +22                       IF $GET(ABM("F1"))

                               QUIT 

 +23                       WRITE !?60,"-----",?69,"----------",!?49,"Subtotal:",?60,$JUSTIFY($FNUMBER(ABM("SSCNT"),",",0),5)

 +24                       WRITE ?67,$JUSTIFY($FNUMBER(ABM("SSAMT"),",",2),12)

                       End DoDot:2

 +25               IF $GET(ABM("F1"))

                       QUIT 

 +26               WRITE !?60,"-----",?69,"----------",!?52,"Total:",?60,$JUSTIFY($FNUMBER(ABM("SUBCNT"),",",0),5)

 +27               WRITE ?67,$JUSTIFY($FNUMBER(ABM("SUBAMT"),",",2),12)

               End DoDot:1

 +28       IF ABM("CNT")'=+$GET(ABM("SUBCNT"))

               IF '$GET(ABM("F1"))

                   WRITE !?59,"======",?68,"===========",!?46,"Grand Total:",?59,$JUSTIFY($FNUMBER(ABM("CNT"),",",0),6),?67,$JUSTIFY($FNUMBER(ABM("AMT"),",",2),12)

 +29       QUIT 

 +30      ;

HD         DO PAZ^ABMDRUTL

           IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               SET ABM("F1")=1

               QUIT 

HDB        SET ABM("PG")=ABM("PG")+1

           DO WHD^ABMDRHD

 +1        WRITE !,?58,"Number of",?72,"Amount"

 +2        WRITE !,"Location",?32,$SELECT(ABMY("SORT")="C":"Clinic",1:"Visit Type"),?60,"Claims",?72,"Billed"

 +3        SET $PIECE(ABM("LINE"),"-",80)=""

           WRITE !,ABM("LINE")

           KILL ABM("LINE")

 +4        QUIT 

XIT       ;EXIT POINT

 +1        QUIT