LRBEECP1.m

LRBEECP1 ;DALOI/WTY - Edit CPT for CIDC (Cont'); 3/29/05

 ;;5.2;LAB SERVICES;**291**;Sep 27, 1994

 ;

 ;

 ; Called by LRBEECPT

 ;

 ; Reference to $$GET1^DIQ supported by IA #2056

 ; Reference to ^DIR supported by IA #10026

 ;

 Q

 ;

AAMA(LRBETST,LRBETSTN) ;If panel, ask if AMA compliant

 N LRBEAX,LRBEQT

 S LRBEQT=0 F  D  Q:LRBEQT!(LRBEQUIT)

 .S LRBEAX=$$GAMA(LRBETST,LRBETSTN)

 .S:LRBEAX="" LRBEQT=1 Q:LRBEQT!(LRBEQUIT)

 .I +LRBEAX=-2 S LRBEQT=1 Q:LRBEQT

 .S LRBEAR2("TEST",LRBETST,"03-AMA FLAG")=LRBEAX,LRBEQT=1

 Q

 ;

GAMA(LRBETST,LRBETSTN) ;

 N LRBEAMA,LRBECPT,LRBEDAMA,LRBEDT,LRBEMSG,LRBEFIL,LRBEFLD,LRBEQT,LRBEDESC

 S LRBEMSG="Are the CPT codes for "_LRBETSTN_" AMA compliant or otherwise billable? "

 S LRBEFIL=60,LRBEFLD=508

 S LRBEDAMA=$$GET1^DIQ(LRBEFIL,LRBETST_",",LRBEFLD,"I")

 S LRBEAMA=$$AMA(LRBEMSG,LRBEDAMA) Q:LRBEQUIT LRBEQUIT

 I LRBEAMA="" Q LRBEDAMA

 I LRBEAMA=LRBEDAMA Q -2

 Q LRBEAMA

 ;

AMA(LRBEMSG,DAMA) ; Ask if the panel CPTs are AMA compliant

 N X,Y,DIR,DTOUT,DUOUT,DIRUT

 S DIR("B")=$S(DAMA:"YES",1:"NO")

 S DIR("A")=LRBEMSG,DIR(0)="YA" D ^DIR

 I $D(DTOUT)!($D(DUOUT))!(X[U) S LRBEQUIT=1 Q LRBEQUIT

 Q Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBEECP1   1164     printed  Apr 09, 2024@21:05:29                                                                                                                                                                                                    Page 2

LRBEECP1  ;DALOI/WTY - Edit CPT for CIDC (Cont'); 3/29/05

 +1       ;;5.2;LAB SERVICES;**291**;Sep 27, 1994

 +2       ;

 +3       ;

 +4       ; Called by LRBEECPT

 +5       ;

 +6       ; Reference to $$GET1^DIQ supported by IA #2056

 +7       ; Reference to ^DIR supported by IA #10026

 +8       ;

 +9        QUIT 

 +10      ;

AAMA(LRBETST,LRBETSTN) ;If panel, ask if AMA compliant

 +1        NEW LRBEAX,LRBEQT

 +2        SET LRBEQT=0

           FOR 

               Begin DoDot:1

 +3                SET LRBEAX=$$GAMA(LRBETST,LRBETSTN)

 +4                if LRBEAX=""

                       SET LRBEQT=1

                   if LRBEQT!(LRBEQUIT)

                       QUIT 

 +5                IF +LRBEAX=-2

                       SET LRBEQT=1

                       if LRBEQT

                           QUIT 

 +6                SET LRBEAR2("TEST",LRBETST,"03-AMA FLAG")=LRBEAX

                   SET LRBEQT=1

               End DoDot:1

               if LRBEQT!(LRBEQUIT)

                   QUIT 

 +7        QUIT 

 +8       ;

GAMA(LRBETST,LRBETSTN) ;

 +1        NEW LRBEAMA,LRBECPT,LRBEDAMA,LRBEDT,LRBEMSG,LRBEFIL,LRBEFLD,LRBEQT,LRBEDESC

 +2        SET LRBEMSG="Are the CPT codes for "_LRBETSTN_" AMA compliant or otherwise billable? "

 +3        SET LRBEFIL=60

           SET LRBEFLD=508

 +4        SET LRBEDAMA=$$GET1^DIQ(LRBEFIL,LRBETST_",",LRBEFLD,"I")

 +5        SET LRBEAMA=$$AMA(LRBEMSG,LRBEDAMA)

           if LRBEQUIT

               QUIT LRBEQUIT

 +6        IF LRBEAMA=""

               QUIT LRBEDAMA

 +7        IF LRBEAMA=LRBEDAMA

               QUIT -2

 +8        QUIT LRBEAMA

 +9       ;

AMA(LRBEMSG,DAMA) ; Ask if the panel CPTs are AMA compliant

 +1        NEW X,Y,DIR,DTOUT,DUOUT,DIRUT

 +2        SET DIR("B")=$SELECT(DAMA:"YES",1:"NO")

 +3        SET DIR("A")=LRBEMSG

           SET DIR(0)="YA"

           DO ^DIR

 +4        IF $DATA(DTOUT)!($DATA(DUOUT))!(X[U)

               SET LRBEQUIT=1

               QUIT LRBEQUIT

 +5        QUIT Y