ABMDE8J.m

ABMDE8J ; IHS/ASDST/DMJ - Page 8 - SUPPLIES ; 

 ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009

 ;

 ; IHS/DSD/LSL - 09/01/98 - Patch 2 - NOIS NDA-0898-180038

 ;             0.00 charges on HCFA because version 2.0 does not assume

 ;             1 for units.  Modify code to set units to 1 if not

 ;             already defined.

 ; IHS/SD/SDR - v2.5 p11 - NPI

 ; IHS/SD/SDR - v2.6 CSV

 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI

 ;

DISP K ABMZ,DIC

 S ABMZ("TITL")="CHARGE MASTER",ABMZ("PG")="8J"

 I $D(ABMP("DDL")),$Y>(IOSL-9) D PAUSE^ABMDE1 G:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) XIT I 1

 E  D SUM^ABMDE1

 ;

 D J^ABMDE8X

 S $P(ABMZ("="),"=",81)=""

 S ABMZ("SUB")=45

 S ABMZ("ITEM")="Supply Item",ABMZ("DIC")="^ABMCM("

 S ABMZ("X")="X",(ABM("FEE"),ABMZ("TOTL"))=0

 D HD G LOOP

HD W !?5,"REVN",?75,"TOTAL"

 W !?5,"CODE",?31,"ITEM",?65,"QTY",?74,"CHARGE"

 W !,ABMZ("=")

 Q

LOOP S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0 F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABM)) Q:'ABM  S ABM("X")=ABM,ABMZ("NUM")=ABM("I") D PC1

 I ABMZ("NUM")>0 W !,?72,"========",!?5,"TOTAL",?71,$J("$"_($FN(ABMZ("TOTL"),",",2)),9)

 I +$O(ABME(0)) S ABME("CONT")="" D ^ABMDERR K ABME("CONT")

 G XIT

 ;

PC1 S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABM("X"),0)

 Q:'$D(^ABMCM(+ABM("X0"),0))

 S ABMZ("UNIT")=$P(ABM("X0"),U,3)

 S:'+ABMZ("UNIT") ABMZ("UNIT")=1

 S ABMZ(ABM("I"))=$P(^ABMCM(+ABM("X0"),0),U)_U_ABM("X")_U_$P(ABM("X0"),U,2)

EOP I $Y>(IOSL-8) D PAUSE^ABMDE1,HD

 W !,"[",ABM("I"),"]"

 I $P(ABM("X0"),"^",2) D

 .W ?5,"CHARGE DATE: "

 .W $$CDT^ABMDUTL($P(ABM("X0"),"^",2)),!

 W ?6,$P(ABM("X0"),"^",5)

 W ?12,$E($P(^ABMCM(+ABM("X0"),0),U),1,50)

 W ?65,$J(ABMZ("UNIT"),3)

 W ?72,$J($FN(($P(ABM("X0"),U,4)*ABMZ("UNIT")),",",2),8)

 S ABMZ("TOTL")=(ABMZ("UNIT")*$P(ABM("X0"),U,4))+ABMZ("TOTL")

 Q

XIT K ABM,ABMMODE

 Q

A ;ADD ENTRY

 I '$D(ABMDCLM(DUZ(2),ABMP("CDFN"),45)) D

 .S ^ABMDCLM(DUZ(2),ABMP("CDFN"),45,0)="^9002274.3045P^^"

 K DIC S DIC="^ABMCM(",DIC(0)="AEMQ"

 D ^DIC

 Q:+Y<0  S ABMZ("ITEM")=+Y

 S DA(1)=ABMP("CDFN")

 S DIC="^ABMDCLM(DUZ(2),DA(1),45,",X=+Y

 K DD,DO D FILE^DICN

 Q:Y<0  S DA=+Y

 I '$G(ABMZ("NUM")) S ABMZ("NUM")=1

E ;EDIT EXISTING ENTRY

 D MODE^ABMDE8X

 I '$G(ABMZ("NUM")) G A

 I '$G(ABMZ("ITEM")) D  Q:'Y

 .S DA(1)=ABMP("CDFN")

 .I ABMZ("NUM")=1 S Y=1

 .E  S DIR(0)="NO^1:"_ABMZ("NUM") D ^DIR K DIR Q:'Y

 .S DA=$P(ABMZ(Y),"^",2)

 .S ABMZ("ITEM")=$P(^ABMDCLM(DUZ(2),DA(1),45,DA,0),U)

 S DIE="^ABMDCLM(DUZ(2),DA(1),45,"

 S DR=".02//"_$$SDT^ABMDUTL(ABMP("VDT"))

 D ^DIE Q:$D(Y)

 S DR=".03//1"

 D ^DIE Q:$D(Y)

 ;S DR=".04//"_+$P($G(^ABMDFEE(ABMP("FEE"),32,ABMZ("ITEM"),0)),"^",2)  ;abm*2.6*2 3PMS10003A

 S DR=".04//"_+$P($$ONE^ABMFEAPI(ABMP("FEE"),32,ABMZ("ITEM"),ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A

 D ^DIE Q:$D(Y)

 I ^ABMDEXP(ABMMODE(10),0)["UB" D  Q:$D(Y)

 .S DR=".05//"_$P(^ABMCM(ABMZ("ITEM"),0),"^",2)

 .D ^DIE

 S ABMZ("HCPCS")=$P($$CPT^ABMCVAPI(+$P(^ABMCM(ABMZ("ITEM"),0),U,3),ABMP("VDT")),U,2)  ;CSV-c

 S DR=".07//"_ABMZ("HCPCS")

 D ^DIE Q:$D(Y)

 S ABM("X0")=^ABMDCLM(DUZ(2),DA(1),45,DA,0)

 I (^ABMDEXP(ABMMODE(10),0)["HCFA")!(^ABMDEXP(ABMMODE(10),0)["CMS") D

 .D DX^ABMDEMLC

 .S DR=".06////"_$G(Y(0))

 .D ^DIE

 S DR=".17///M" D ^DIE

 W !!

 S DIR(0)="E",DIR("A")="Enter RETURN to Continue" K DIR("B") D ^DIR K DIR

 Q

ABMDE8J   ; IHS/ASDST/DMJ - Page 8 - SUPPLIES ; 

 +1       ;;2.6;IHS Third Party Billing System;**2**;NOV 12, 2009

 +2       ;

 +3       ; IHS/DSD/LSL - 09/01/98 - Patch 2 - NOIS NDA-0898-180038

 +4       ;             0.00 charges on HCFA because version 2.0 does not assume

 +5       ;             1 for units.  Modify code to set units to 1 if not

 +6       ;             already defined.

 +7       ; IHS/SD/SDR - v2.5 p11 - NPI

 +8       ; IHS/SD/SDR - v2.6 CSV

 +9       ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - Modified to call ABMFEAPI

 +10      ;

DISP       KILL ABMZ,DIC

 +1        SET ABMZ("TITL")="CHARGE MASTER"

           SET ABMZ("PG")="8J"

 +2        IF $DATA(ABMP("DDL"))

               IF $Y>(IOSL-9)

                   DO PAUSE^ABMDE1

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

                       GOTO XIT

                   IF 1

 +3       IF '$TEST

               DO SUM^ABMDE1

 +4       ;

 +5        DO J^ABMDE8X

 +6        SET $PIECE(ABMZ("="),"=",81)=""

 +7        SET ABMZ("SUB")=45

 +8        SET ABMZ("ITEM")="Supply Item"

           SET ABMZ("DIC")="^ABMCM("

 +9        SET ABMZ("X")="X"

           SET (ABM("FEE"),ABMZ("TOTL"))=0

 +10       DO HD

           GOTO LOOP

HD         WRITE !?5,"REVN",?75,"TOTAL"

 +1        WRITE !?5,"CODE",?31,"ITEM",?65,"QTY",?74,"CHARGE"

 +2        WRITE !,ABMZ("=")

 +3        QUIT 

LOOP       SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABM)=0

           FOR ABM("I")=1:1

               SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABM))

               IF 'ABM

                   QUIT 

               SET ABM("X")=ABM

               SET ABMZ("NUM")=ABM("I")

               DO PC1

 +1        IF ABMZ("NUM")>0

               WRITE !,?72,"========",!?5,"TOTAL",?71,$JUSTIFY("$"_($FNUMBER(ABMZ("TOTL"),",",2)),9)

 +2        IF +$ORDER(ABME(0))

               SET ABME("CONT")=""

               DO ^ABMDERR

               KILL ABME("CONT")

 +3        GOTO XIT

 +4       ;

PC1        SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),45,ABM("X"),0)

 +1        IF '$DATA(^ABMCM(+ABM("X0"),0))

               QUIT 

 +2        SET ABMZ("UNIT")=$PIECE(ABM("X0"),U,3)

 +3        IF '+ABMZ("UNIT")

               SET ABMZ("UNIT")=1

 +4        SET ABMZ(ABM("I"))=$PIECE(^ABMCM(+ABM("X0"),0),U)_U_ABM("X")_U_$PIECE(ABM("X0"),U,2)

EOP        IF $Y>(IOSL-8)

               DO PAUSE^ABMDE1

               DO HD

 +1        WRITE !,"[",ABM("I"),"]"

 +2        IF $PIECE(ABM("X0"),"^",2)

               Begin DoDot:1

 +3                WRITE ?5,"CHARGE DATE: "

 +4                WRITE $$CDT^ABMDUTL($PIECE(ABM("X0"),"^",2)),!

               End DoDot:1

 +5        WRITE ?6,$PIECE(ABM("X0"),"^",5)

 +6        WRITE ?12,$EXTRACT($PIECE(^ABMCM(+ABM("X0"),0),U),1,50)

 +7        WRITE ?65,$JUSTIFY(ABMZ("UNIT"),3)

 +8        WRITE ?72,$JUSTIFY($FNUMBER(($PIECE(ABM("X0"),U,4)*ABMZ("UNIT")),",",2),8)

 +9        SET ABMZ("TOTL")=(ABMZ("UNIT")*$PIECE(ABM("X0"),U,4))+ABMZ("TOTL")

 +10       QUIT 

XIT        KILL ABM,ABMMODE

 +1        QUIT 

A         ;ADD ENTRY

 +1        IF '$DATA(ABMDCLM(DUZ(2),ABMP("CDFN"),45))

               Begin DoDot:1

 +2                SET ^ABMDCLM(DUZ(2),ABMP("CDFN"),45,0)="^9002274.3045P^^"

               End DoDot:1

 +3        KILL DIC

           SET DIC="^ABMCM("

           SET DIC(0)="AEMQ"

 +4        DO ^DIC

 +5        IF +Y<0

               QUIT 

           SET ABMZ("ITEM")=+Y

 +6        SET DA(1)=ABMP("CDFN")

 +7        SET DIC="^ABMDCLM(DUZ(2),DA(1),45,"

           SET X=+Y

 +8        KILL DD,DO

           DO FILE^DICN

 +9        IF Y<0

               QUIT 

           SET DA=+Y

 +10       IF '$GET(ABMZ("NUM"))

               SET ABMZ("NUM")=1

E         ;EDIT EXISTING ENTRY

 +1        DO MODE^ABMDE8X

 +2        IF '$GET(ABMZ("NUM"))

               GOTO A

 +3        IF '$GET(ABMZ("ITEM"))

               Begin DoDot:1

 +4                SET DA(1)=ABMP("CDFN")

 +5                IF ABMZ("NUM")=1

                       SET Y=1

 +6               IF '$TEST

                       SET DIR(0)="NO^1:"_ABMZ("NUM")

                       DO ^DIR

                       KILL DIR

                       IF 'Y

                           QUIT 

 +7                SET DA=$PIECE(ABMZ(Y),"^",2)

 +8                SET ABMZ("ITEM")=$PIECE(^ABMDCLM(DUZ(2),DA(1),45,DA,0),U)

               End DoDot:1

               IF 'Y

                   QUIT 

 +9        SET DIE="^ABMDCLM(DUZ(2),DA(1),45,"

 +10       SET DR=".02//"_$$SDT^ABMDUTL(ABMP("VDT"))

 +11       DO ^DIE

           IF $DATA(Y)

               QUIT 

 +12       SET DR=".03//1"

 +13       DO ^DIE

           IF $DATA(Y)

               QUIT 

 +14      ;S DR=".04//"_+$P($G(^ABMDFEE(ABMP("FEE"),32,ABMZ("ITEM"),0)),"^",2)  ;abm*2.6*2 3PMS10003A

 +15      ;abm*2.6*2 3PMS10003A

           SET DR=".04//"_+$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),32,ABMZ("ITEM"),ABMP("VDT")),U)

 +16       DO ^DIE

           IF $DATA(Y)

               QUIT 

 +17       IF ^ABMDEXP(ABMMODE(10),0)["UB"

               Begin DoDot:1

 +18               SET DR=".05//"_$PIECE(^ABMCM(ABMZ("ITEM"),0),"^",2)

 +19               DO ^DIE

               End DoDot:1

               IF $DATA(Y)

                   QUIT 

 +20      ;CSV-c

           SET ABMZ("HCPCS")=$PIECE($$CPT^ABMCVAPI(+$PIECE(^ABMCM(ABMZ("ITEM"),0),U,3),ABMP("VDT")),U,2)

 +21       SET DR=".07//"_ABMZ("HCPCS")

 +22       DO ^DIE

           IF $DATA(Y)

               QUIT 

 +23       SET ABM("X0")=^ABMDCLM(DUZ(2),DA(1),45,DA,0)

 +24       IF (^ABMDEXP(ABMMODE(10),0)["HCFA")!(^ABMDEXP(ABMMODE(10),0)["CMS")

               Begin DoDot:1

 +25               DO DX^ABMDEMLC

 +26               SET DR=".06////"_$GET(Y(0))

 +27               DO ^DIE

               End DoDot:1

 +28       SET DR=".17///M"

           DO ^DIE

 +29       WRITE !!

 +30       SET DIR(0)="E"

           SET DIR("A")="Enter RETURN to Continue"

           KILL DIR("B")

           DO ^DIR

           KILL DIR

 +31       QUIT