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