- 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 Feb 18, 2025@23:35:57 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