ABMDES2.m

ABMDES2 ; IHS/ASDST/DMJ - Display Summarized HCFA-1500 charges ; 

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

 ;

HCFA ;EP for displaying charge summary for HCFA-1500

 ;

 I $Y+5>IOSL S DIR(0)="E" D ^DIR W $$EN^ABMVDF("IOF") Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)

 D HD

 S ABMS="" F  S ABMS=$O(ABMS(ABMS)) Q:'ABMS  D  Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)

 .I $Y>(IOSL-5) S DIR(0)="EO" D ^DIR W $$EN^ABMVDF("IOF") Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)  D HD

 .W !,$P(ABMS(ABMS),U,2),?15,$S(ABMP("BTYP")=111:1,1:3),?20,$P(ABMS(ABMS),U,4)

 .K ABMU

 .I $L($P(ABMS(ABMS),U,8))>19 S ABMU("LNG")=19,ABMU("TXT")=$P(ABMS(ABMS),U,8),ABMU=2 D LNG^ABMDWRAP W ?29,ABMU(1) I 1

 .E  W ?29,$P(ABMS(ABMS),U,8)

 .W ?52,$P(ABMS(ABMS),U,5),?60,$J($FN($P(ABMS(ABMS),U),",",2),8),?72,$P(ABMS(ABMS),U,6),?77,$P(ABMS(ABMS),U,7),!

 .W:$P(ABMS(ABMS),U,3)'=$P(ABMS(ABMS),U,2) ?4,$P(ABMS(ABMS),U,3) I $D(ABMU(2)) W ?29,ABMU(2)

 .K ABMS(ABMS)

 W !?59,"---------",!?59,$J($FN(ABMS("TOT"),",",2),9)

 S ABMP("TOT")=ABMP("TOT")+ABMS("TOT")

 Q

 ;

 I $D(ABMP("VTYP",999)) D

 .S ABMP("RATIO")=1/(ABMP("HCFA")+ABMP("UB82"))

 .I $D(ABM("DD-FRT")) S ABMP("UB82")=ABMP("RESP"),ABMP("HCFA")=0 Q

 .S ABMP("UB82")=+$FN(ABMP("RESP")*ABMP("UB82")*ABMP("RATIO"),"T",2),ABMP("HCFA")=+$FN(ABMP("RESP")*ABMP("HCFA")*ABMP("RATIO"),"T",2)

 I '$D(ABMP("VTYP",999)) S ABMP("HCFA")=ABMP("RESP")

 Q

 ;

HD W ?20,"***** HCFA-1500A CHARGE SUMMARY *****"

 W !,"   Dates of    Vst",?21,$S(ABMP("VTYP")=998:"ADA",$G(ABMP("PX"))="I":"ICD",1:"CPT"),?32,"Description        Corr"

 W !,"   Service     Typ   Code       of Service           ICD      Charge   Qty  Cat"

 S ABMS("I")="",$P(ABMS("I"),"-",80)="" W !,ABMS("I")

 Q

ABMDES2   ; IHS/ASDST/DMJ - Display Summarized HCFA-1500 charges ; 

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

 +2       ;

HCFA      ;EP for displaying charge summary for HCFA-1500

 +1       ;

 +2        IF $Y+5>IOSL

               SET DIR(0)="E"

               DO ^DIR

               WRITE $$EN^ABMVDF("IOF")

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

                   QUIT 

 +3        DO HD

 +4        SET ABMS=""

           FOR 

               SET ABMS=$ORDER(ABMS(ABMS))

               IF 'ABMS

                   QUIT 

               Begin DoDot:1

 +5                IF $Y>(IOSL-5)

                       SET DIR(0)="EO"

                       DO ^DIR

                       WRITE $$EN^ABMVDF("IOF")

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

                           QUIT 

                       DO HD

 +6                WRITE !,$PIECE(ABMS(ABMS),U,2),?15,$SELECT(ABMP("BTYP")=111:1,1:3),?20,$PIECE(ABMS(ABMS),U,4)

 +7                KILL ABMU

 +8                IF $LENGTH($PIECE(ABMS(ABMS),U,8))>19

                       SET ABMU("LNG")=19

                       SET ABMU("TXT")=$PIECE(ABMS(ABMS),U,8)

                       SET ABMU=2

                       DO LNG^ABMDWRAP

                       WRITE ?29,ABMU(1)

                       IF 1

 +9               IF '$TEST

                       WRITE ?29,$PIECE(ABMS(ABMS),U,8)

 +10               WRITE ?52,$PIECE(ABMS(ABMS),U,5),?60,$JUSTIFY($FNUMBER($PIECE(ABMS(ABMS),U),",",2),8),?72,$PIECE(ABMS(ABMS),U,6),?77,$PIECE(ABMS(ABMS),U,7),!

 +11               IF $PIECE(ABMS(ABMS),U,3)'=$PIECE(ABMS(ABMS),U,2)

                       WRITE ?4,$PIECE(ABMS(ABMS),U,3)

                   IF $DATA(ABMU(2))

                       WRITE ?29,ABMU(2)

 +12               KILL ABMS(ABMS)

               End DoDot:1

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

                   QUIT 

 +13       WRITE !?59,"---------",!?59,$JUSTIFY($FNUMBER(ABMS("TOT"),",",2),9)

 +14       SET ABMP("TOT")=ABMP("TOT")+ABMS("TOT")

 +15       QUIT 

 +16      ;

 +17       IF $DATA(ABMP("VTYP",999))

               Begin DoDot:1

 +18               SET ABMP("RATIO")=1/(ABMP("HCFA")+ABMP("UB82"))

 +19               IF $DATA(ABM("DD-FRT"))

                       SET ABMP("UB82")=ABMP("RESP")

                       SET ABMP("HCFA")=0

                       QUIT 

 +20               SET ABMP("UB82")=+$FNUMBER(ABMP("RESP")*ABMP("UB82")*ABMP("RATIO"),"T",2)

                   SET ABMP("HCFA")=+$FNUMBER(ABMP("RESP")*ABMP("HCFA")*ABMP("RATIO"),"T",2)

               End DoDot:1

 +21       IF '$DATA(ABMP("VTYP",999))

               SET ABMP("HCFA")=ABMP("RESP")

 +22       QUIT 

 +23      ;

HD         WRITE ?20,"***** HCFA-1500A CHARGE SUMMARY *****"

 +1        WRITE !,"   Dates of    Vst",?21,$SELECT(ABMP("VTYP")=998:"ADA",$GET(ABMP("PX"))="I":"ICD",1:"CPT"),?32,"Description        Corr"

 +2        WRITE !,"   Service     Typ   Code       of Service           ICD      Charge   Qty  Cat"

 +3        SET ABMS("I")=""

           SET $PIECE(ABMS("I"),"-",80)=""

           WRITE !,ABMS("I")

 +4        QUIT