37 lines
1.1 KiB
Mathematica
37 lines
1.1 KiB
Mathematica
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
|