ABMDTLAB.m

ABMDTLAB ; IHS/ASDT/DMJ - Enter/Edit Lab CPT's in table  

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

 ;

 ; IHS/ASDS/LSL - 07/02/01 - V2.4 Patch 9 - NOIS NEA-0600-180021

 ;     New routine to allow entry of Lab CPT's to 3P CPT TABLE file.

 ;     Thanks to Jim Gray for the code.         

 ;

 ; *********************************************************************

 Q

 ;

START ; EP

 F  D START2 Q:$G(Y)=-1!$D(DTOUT)!$D(DUOUT)

 Q

 ; *********************************************************************

START2 ;

 K DTOUT,DUOUT

 S DIC=9002274.37

 S DIC(0)="AQEMSLN"

 S DIC("A")="Select Lab CPT table entry: "

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

 S DIC("W")="W ""  "",$P(^(0),U,4,5)"

 S DLAYGO=9002274

 D ^DIC

 Q:Y=-1!$D(DTOUT)!$D(DUOUT)

 S ABMDA=+Y

 S ABMNEW=$P(Y,U,3)

 K DIR

 I 'ABMNEW D  Q:$D(DTOUT)!$D(DUOUT)  I Y="D" D DEL Q

 . S DIR(0)="SM^M:Modify;D:Delete"

 . S DIR("A")="Select action on selected table entry"

 . S DIR("?")="Do you wish to modify or delete the selected entry?"

 . D ^DIR

 S DIR(0)="N^80000:89999:0"

 S DIR("A")="Low CPT: "

 S DIR("?")="Enter LAB CPT code at lower end of range."

 S DIR("B")=$$GET1^DIQ(9002274.37,ABMDA_",",4)

 D ^DIR

 I ABMNEW,+Y=0 S ABMDEL="@" D DEL S Y=-1 Q

 Q:+Y=0

 S ABML=Y

 S DIR(0)="N^"_ABML_":89999:0"

 S DIR("A")="High CPT: "

 S DIR("?")="Enter LAB CPT code at higher end of range."

 S DIR("B")=$$GET1^DIQ(9002274.37,ABMDA_",",5)

 D ^DIR

 I ABMNEW,+Y=0 S ABMDEL="@" D DEL S Y=-1 Q

 Q:+Y=0

 S ABMH=Y

 K DIR

 S DIE=DIC

 S DA=ABMDA

 S DR="2///LAB;4///"_ABML_";5///"_ABMH

 D ^DIE

 Q

 ;

DEL ;Delete entry if both CPT codes not entered

 W !,"Deleting"

 S DIE=DIC

 S DA=ABMDA

 S DR=".01///@"

 D ^DIE

 Q

ABMDTLAB  ; IHS/ASDT/DMJ - Enter/Edit Lab CPT's in table  

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

 +2       ;

 +3       ; IHS/ASDS/LSL - 07/02/01 - V2.4 Patch 9 - NOIS NEA-0600-180021

 +4       ;     New routine to allow entry of Lab CPT's to 3P CPT TABLE file.

 +5       ;     Thanks to Jim Gray for the code.         

 +6       ;

 +7       ; *********************************************************************

 +8        QUIT 

 +9       ;

START     ; EP

 +1        FOR 

               DO START2

               IF $GET(Y)=-1!$DATA(DTOUT)!$DATA(DUOUT)

                   QUIT 

 +2        QUIT 

 +3       ; *********************************************************************

START2    ;

 +1        KILL DTOUT,DUOUT

 +2        SET DIC=9002274.37

 +3        SET DIC(0)="AQEMSLN"

 +4        SET DIC("A")="Select Lab CPT table entry: "

 +5        SET DIC("S")="I $P(^(0),U,2)=""LAB"""

 +6        SET DIC("W")="W ""  "",$P(^(0),U,4,5)"

 +7        SET DLAYGO=9002274

 +8        DO ^DIC

 +9        IF Y=-1!$DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

 +10       SET ABMDA=+Y

 +11       SET ABMNEW=$PIECE(Y,U,3)

 +12       KILL DIR

 +13       IF 'ABMNEW

               Begin DoDot:1

 +14               SET DIR(0)="SM^M:Modify;D:Delete"

 +15               SET DIR("A")="Select action on selected table entry"

 +16               SET DIR("?")="Do you wish to modify or delete the selected entry?"

 +17               DO ^DIR

               End DoDot:1

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

                   QUIT 

               IF Y="D"

                   DO DEL

                   QUIT 

 +18       SET DIR(0)="N^80000:89999:0"

 +19       SET DIR("A")="Low CPT: "

 +20       SET DIR("?")="Enter LAB CPT code at lower end of range."

 +21       SET DIR("B")=$$GET1^DIQ(9002274.37,ABMDA_",",4)

 +22       DO ^DIR

 +23       IF ABMNEW

               IF +Y=0

                   SET ABMDEL="@"

                   DO DEL

                   SET Y=-1

                   QUIT 

 +24       IF +Y=0

               QUIT 

 +25       SET ABML=Y

 +26       SET DIR(0)="N^"_ABML_":89999:0"

 +27       SET DIR("A")="High CPT: "

 +28       SET DIR("?")="Enter LAB CPT code at higher end of range."

 +29       SET DIR("B")=$$GET1^DIQ(9002274.37,ABMDA_",",5)

 +30       DO ^DIR

 +31       IF ABMNEW

               IF +Y=0

                   SET ABMDEL="@"

                   DO DEL

                   SET Y=-1

                   QUIT 

 +32       IF +Y=0

               QUIT 

 +33       SET ABMH=Y

 +34       KILL DIR

 +35       SET DIE=DIC

 +36       SET DA=ABMDA

 +37       SET DR="2///LAB;4///"_ABML_";5///"_ABMH

 +38       DO ^DIE

 +39       QUIT 

 +40      ;

DEL       ;Delete entry if both CPT codes not entered

 +1        WRITE !,"Deleting"

 +2        SET DIE=DIC

 +3        SET DA=ABMDA

 +4        SET DR=".01///@"

 +5        DO ^DIE

 +6        QUIT