ABMDTCPT.m

ABMDTCPT ; IHS/ASDST/DMJ - Table Maintenance of CPT CODES ; 

 ;;2.6;IHS Third Party Billing System;**3,21**;NOV 12, 2009;Build 379

 ;IHS/SD/SDR - 2.6*21 HEAT266454 - Added option back into TPB so users can add/edit/delete revenue code only.  No editing should be done to CPT codes themselves.

 ;

ENT K ABM

 ;K DIR S DIR(0)="SO^1:EDIT EXISTING CPT CODE;2:ADD NEW CPT CODE",DIR("A")="Select DESIRED ACTION",DIR("B")=1 D ^DIR K DIR G XIT:'Y!$D(DIRUT),ADD:Y=2  ;abm*2.6*3 NOHEAT

 ;

SEL W !! K DIC S DIC="^ICPT(",DIC("A")="Select CPT CODE to Edit: ",DIC(0)="QEAM" D ^DIC K DIC

 G XIT:X=""!$D(DUOUT)!$D(DTOUT)

 I +Y<1 G SEL

 S ABM("DFN")=+Y,ABM("MODE")=0

 I '$D(ABM("PROT")) G EDIT

 ;S DIE="^ICPT(",DR="W !;5T;4;9999999.01;9999999.02" D ^ABMDDIE K DR  ;abm*2.6*3 NOHEAT

 S DIE="^ICPT(",DR="W !;9999999.02" D ^ABMDDIE K DR  ;abm*2.6*3 NOHEAT

 G SEL

 ;

ADD S (ABM("DFN"),ABM,ABM("LOCK"))=0,ABM("MODE")=1

 W ! K DIR S DIR(0)="FO^5:6",DIR("A")="Enter the CPT CODE" D ^DIR K DIR G XIT:$D(DIRUT) S ABM("DFN")=X

 I $D(^ICPT("B",X)) W *7,!!,"The CPT CODE '",X,"' already exists!" G PAZ

 I X?5.6AN

 E  W !!?10,*7,"ERROR: Improper Format, code must be 5 or 6 Alphanumeric Characters." G ADD

 W !,*7 K DIR S DIR(0)="Y",DIR("A")="Do you want to Add '"_ABM("DFN")_"' as a New CPT CODE" D ^DIR K DIR G ENT:$D(DUOUT)!$D(DTOUT),ENT:Y<1

 W !,"OK, adding..."

 S X=ABM("DFN")

 S DIC="^ICPT(",DIC(0)="LX" D ^DIC

 I +Y<1 W *7,!!,"ERROR: CPT CODE ENTRY NOT CREATED!",! G PAZ

 S ABM("DFN")=+Y

 ;

EDIT ;S DA=ABM("DFN"),DIE="^ICPT(",DR="W !;2R" D ^ABMDDIE G KILL:$D(Y)!$D(ABM("DIE-FAIL"))  ;abm*2.6*3 NOHEAT

 I ABM("MODE") D  G KILL:Y<1

 .S DA(1)=ABM("DFN"),DIC="^ICPT("_DA(1)_",""D"",",DIC(0)="LE"

 .K DD,DO,DINUM

 .I '$D(@(DIC_"0)")) S @(DIC_"0)")="^81.01A"

 .D FILE^DICN

 S DIE="^ICPT("  ;abm*2.6*3 NOHEAT

 S DA=ABM("DFN")

 S DR="W !;9999999.02" D ^ABMDDIE

 G XIT

 ;

PAZ W ! K DIR S DIR(0)="E" D ^DIR

XIT K ABM,DIC,DIE

 Q

KILL I ABM("MODE") W !!,*7,"<Data Incomplete: Entry Deleted>" S DIK=DIE D ^DIK G PAZ

 G XIT

 Q

ABMDTCPT  ; IHS/ASDST/DMJ - Table Maintenance of CPT CODES ; 

 +1       ;;2.6;IHS Third Party Billing System;**3,21**;NOV 12, 2009;Build 379

 +2       ;IHS/SD/SDR - 2.6*21 HEAT266454 - Added option back into TPB so users can add/edit/delete revenue code only.  No editing should be done to CPT codes themselves.

 +3       ;

ENT        KILL ABM

 +1       ;K DIR S DIR(0)="SO^1:EDIT EXISTING CPT CODE;2:ADD NEW CPT CODE",DIR("A")="Select DESIRED ACTION",DIR("B")=1 D ^DIR K DIR G XIT:'Y!$D(DIRUT),ADD:Y=2  ;abm*2.6*3 NOHEAT

 +2       ;

SEL        WRITE !!

           KILL DIC

           SET DIC="^ICPT("

           SET DIC("A")="Select CPT CODE to Edit: "

           SET DIC(0)="QEAM"

           DO ^DIC

           KILL DIC

 +1        IF X=""!$DATA(DUOUT)!$DATA(DTOUT)

               GOTO XIT

 +2        IF +Y<1

               GOTO SEL

 +3        SET ABM("DFN")=+Y

           SET ABM("MODE")=0

 +4        IF '$DATA(ABM("PROT"))

               GOTO EDIT

 +5       ;S DIE="^ICPT(",DR="W !;5T;4;9999999.01;9999999.02" D ^ABMDDIE K DR  ;abm*2.6*3 NOHEAT

 +6       ;abm*2.6*3 NOHEAT

           SET DIE="^ICPT("

           SET DR="W !;9999999.02"

           DO ^ABMDDIE

           KILL DR

 +7        GOTO SEL

 +8       ;

ADD        SET (ABM("DFN"),ABM,ABM("LOCK"))=0

           SET ABM("MODE")=1

 +1        WRITE !

           KILL DIR

           SET DIR(0)="FO^5:6"

           SET DIR("A")="Enter the CPT CODE"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO XIT

           SET ABM("DFN")=X

 +2        IF $DATA(^ICPT("B",X))

               WRITE *7,!!,"The CPT CODE '",X,"' already exists!"

               GOTO PAZ

 +3        IF X?5.6AN

 +4       IF '$TEST

               WRITE !!?10,*7,"ERROR: Improper Format, code must be 5 or 6 Alphanumeric Characters."

               GOTO ADD

 +5        WRITE !,*7

           KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Do you want to Add '"_ABM("DFN")_"' as a New CPT CODE"

           DO ^DIR

           KILL DIR

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

               GOTO ENT

           IF Y<1

               GOTO ENT

 +6        WRITE !,"OK, adding..."

 +7        SET X=ABM("DFN")

 +8        SET DIC="^ICPT("

           SET DIC(0)="LX"

           DO ^DIC

 +9        IF +Y<1

               WRITE *7,!!,"ERROR: CPT CODE ENTRY NOT CREATED!",!

               GOTO PAZ

 +10       SET ABM("DFN")=+Y

 +11      ;

EDIT      ;S DA=ABM("DFN"),DIE="^ICPT(",DR="W !;2R" D ^ABMDDIE G KILL:$D(Y)!$D(ABM("DIE-FAIL"))  ;abm*2.6*3 NOHEAT

 +1        IF ABM("MODE")

               Begin DoDot:1

 +2                SET DA(1)=ABM("DFN")

                   SET DIC="^ICPT("_DA(1)_",""D"","

                   SET DIC(0)="LE"

 +3                KILL DD,DO,DINUM

 +4                IF '$DATA(@(DIC_"0)"))

                       SET @(DIC_"0)")="^81.01A"

 +5                DO FILE^DICN

               End DoDot:1

               IF Y<1

                   GOTO KILL

 +6       ;abm*2.6*3 NOHEAT

           SET DIE="^ICPT("

 +7        SET DA=ABM("DFN")

 +8        SET DR="W !;9999999.02"

           DO ^ABMDDIE

 +9        GOTO XIT

 +10      ;

PAZ        WRITE !

           KILL DIR

           SET DIR(0)="E"

           DO ^DIR

XIT        KILL ABM,DIC,DIE

 +1        QUIT 

KILL       IF ABM("MODE")

               WRITE !!,*7,"<Data Incomplete: Entry Deleted>"

               SET DIK=DIE

               DO ^DIK

               GOTO PAZ

 +1        GOTO XIT

 +2        QUIT