- 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
