Routine: ABMDTCD

ABMDTCD ; IHS/ASDST/DMJ - Table Maintenance of 3P CODES ;

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

 ; IHS/SD/SDR - v2.5 p9 - IM18516

 ;    Added code for Delayed Reason Code

 S U="^"

W !

SEL ;

 K DIR,ABM

 S DIR(0)="SO^1:CONDITION CODES;2:OCCURRENCE CODES;3:OCCURRENCE SPAN CODES;4:SPECIAL PROGRAM CODES;5:VALUE CODES;6:BILL TYPE;7:DELAYED REASON CODES"

 S DIR("A")="Select Desired Code" D ^DIR

 G XIT:$D(DIROUT)!$D(DIRUT)

 S ABM=$S(Y=1:"C",Y=2:"O",Y=3:"S",Y=4:"I",Y=5:"V",Y=6:"B",1:"U")

 S ABM("TITL")=$S(ABM="C":"CONDITION CODE",ABM="O":"OCCURRENCE CODE",ABM="S":"OCCURRENCE SPAN CODE",ABM="I":"SPECIAL PROGRAM CODE",ABM="B":"BILL TYPE",ABM="U":"DELAYED REASON CODES",1:"VALUE CODE")

W !

 K DIR S DIR(0)="S^1:EDIT;2:ADD;3:QUIT",DIR("B")=1,DIR("A")="Desired Action" D ^DIR

 G XIT:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!(Y=3),ADD:Y=2

EDIT W !! K DIC S DIC="^ABMDCODE(",DIC("A")="Select "_ABM("TITL")_" to Edit: ",DIC(0)="QZEAM",DIC("S")="I $P(^(0),U,2)=ABM" D ^DIC K DIC

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

 I +Y<1 G EDIT

 S DA=+Y

 S DIE="^ABMDCODE(",DR=".03;.04" D ^ABMDDIE K DR G XIT:$D(ABM("DIE-FAIL"))

 G EDIT

ADD S ABM("D")="^ABMDCODE(",ABM("D0")="QZEM",ABM("DS")="I $P(^(0),U,2)=ABM"

 K DIR

 S DIR("?",1)="Enter a number which will be a new "_ABM("TITL")_"."

 S DIR("?",2)=""

 S DIR("?")="(NOTE: Existing Codes are displayed by entering ""??"")"

 W !!

 S DIR(0)="FOA^1:3"

 S DIR("A")="Enter the CODE to be Added: "

 S DIR("??")="^S X=""??"",DIC=ABM(""D""),DIC(0)=ABM(""D0""),DIC(""S"")=ABM(""DS"") D ^DIC"

 D ^DIR

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

 I $D(^ABMDCODE("AC",ABM,Y))=10 W !!?10,*7,"This CODE already exists!",!?5,"CODE: ",Y," - ",$P(^ABMDCODE($O(^(Y,"")),0),U,3) G ADD

 S ABM("Y")=Y

 W !!

 K DIR

 S DIR(0)="YO"

 S DIR("A")="Do you wish to Add "_Y_" as a New "_ABM("TITL")

 D ^DIR

 G XIT:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)!(X="")!(Y'=1)

 W !! S DIC="^ABMDCODE(",DIC(0)="L",X=ABM("Y"),DIC("DR")=".02////"_ABM_";.03;.04" K DD,DO D FILE^DICN

 I +Y>0 D

 . I +ABM("Y"),$E(ABM("Y"))=0 S ^ABMDCODE("AC",ABM,+ABM("Y"),+Y)=""

 . I +ABM("Y"),$L(ABM("Y"))<2 S ^ABMDCODE("AC",ABM,"0"_ABM("Y"),+Y)=""

 . W !!,"(Record has been Added)"

 E  W !!,*7,"** WARNING: Record was NOT Added! **"

 G ADD

XIT K ABM,DIR,DIC,DIE

ABMDTCD   ; IHS/ASDST/DMJ - Table Maintenance of 3P CODES ;

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

 +2       ;

 +3       ; IHS/SD/SDR - v2.5 p9 - IM18516

 +4       ;    Added code for Delayed Reason Code

 +5       ;

 +6        SET U="^"

 +7        WRITE !

SEL       ;

 +1        KILL DIR,ABM

 +2        SET DIR(0)="SO^1:CONDITION CODES;2:OCCURRENCE CODES;3:OCCURRENCE SPAN CODES;4:SPECIAL PROGRAM CODES;5:VALUE CODES;6:BILL TYPE;7:DELAYED REASON CODES"

 +3        SET DIR("A")="Select Desired Code"

           DO ^DIR

 +4        IF $DATA(DIROUT)!$DATA(DIRUT)

               GOTO XIT

 +5        SET ABM=$SELECT(Y=1:"C",Y=2:"O",Y=3:"S",Y=4:"I",Y=5:"V",Y=6:"B",1:"U")

 +6       ;

 +7        SET ABM("TITL")=$SELECT(ABM="C":"CONDITION CODE",ABM="O":"OCCURRENCE CODE",ABM="S":"OCCURRENCE SPAN CODE",ABM="I":"SPECIAL PROGRAM CODE",ABM="B":"BILL TYPE",ABM="U":"DELAYED REASON CODES",1:"VALUE CODE")

 +8        WRITE !

 +9        KILL DIR

           SET DIR(0)="S^1:EDIT;2:ADD;3:QUIT"

           SET DIR("B")=1

           SET DIR("A")="Desired Action"

           DO ^DIR

 +10       IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!(Y=3)

               GOTO XIT

           IF Y=2

               GOTO ADD

 +11      ;

EDIT       WRITE !!

           KILL DIC

           SET DIC="^ABMDCODE("

           SET DIC("A")="Select "_ABM("TITL")_" to Edit: "

           SET DIC(0)="QZEAM"

           SET DIC("S")="I $P(^(0),U,2)=ABM"

           DO ^DIC

           KILL DIC

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

               GOTO XIT

 +2        IF +Y<1

               GOTO EDIT

 +3        SET DA=+Y

 +4        SET DIE="^ABMDCODE("

           SET DR=".03;.04"

           DO ^ABMDDIE

           KILL DR

           IF $DATA(ABM("DIE-FAIL"))

               GOTO XIT

 +5        GOTO EDIT

 +6       ;

ADD        SET ABM("D")="^ABMDCODE("

           SET ABM("D0")="QZEM"

           SET ABM("DS")="I $P(^(0),U,2)=ABM"

 +1        KILL DIR

 +2        SET DIR("?",1)="Enter a number which will be a new "_ABM("TITL")_"."

 +3        SET DIR("?",2)=""

 +4        SET DIR("?")="(NOTE: Existing Codes are displayed by entering ""??"")"

 +5        WRITE !!

 +6        SET DIR(0)="FOA^1:3"

 +7        SET DIR("A")="Enter the CODE to be Added: "

 +8        SET DIR("??")="^S X=""??"",DIC=ABM(""D""),DIC(0)=ABM(""D0""),DIC(""S"")=ABM(""DS"") D ^DIC"

 +9        DO ^DIR

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

               GOTO XIT

 +11       IF $DATA(^ABMDCODE("AC",ABM,Y))=10

               WRITE !!?10,*7,"This CODE already exists!",!?5,"CODE: ",Y," - ",$PIECE(^ABMDCODE($ORDER(^(Y,"")),0),U,3)

               GOTO ADD

 +12       SET ABM("Y")=Y

 +13       WRITE !!

 +14       KILL DIR

 +15       SET DIR(0)="YO"

 +16       SET DIR("A")="Do you wish to Add "_Y_" as a New "_ABM("TITL")

 +17       DO ^DIR

 +18       IF $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)!(X="")!(Y'=1)

               GOTO XIT

 +19       WRITE !!

           SET DIC="^ABMDCODE("

           SET DIC(0)="L"

           SET X=ABM("Y")

           SET DIC("DR")=".02////"_ABM_";.03;.04"

           KILL DD,DO

           DO FILE^DICN

 +20       IF +Y>0

               Begin DoDot:1

 +21               IF +ABM("Y")

                       IF $EXTRACT(ABM("Y"))=0

                           SET ^ABMDCODE("AC",ABM,+ABM("Y"),+Y)=""

 +22               IF +ABM("Y")

                       IF $LENGTH(ABM("Y"))<2

                           SET ^ABMDCODE("AC",ABM,"0"_ABM("Y"),+Y)=""

 +23               WRITE !!,"(Record has been Added)"

               End DoDot:1

 +24      IF '$TEST

               WRITE !!,*7,"** WARNING: Record was NOT Added! **"

 +25       GOTO ADD

 +26      ;

XIT        KILL ABM,DIR,DIC,DIE

 +1        QUIT

ABMDTCD.m