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 ---[H[J[2J[HLRBEECP1 1164 printed Dec 13, 2024@02:10:03 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
