Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRBEECP1

LRBEECP1.m

Go to the documentation of this file.
  1. LRBEECP1 ;DALOI/WTY - Edit CPT for CIDC (Cont'); 3/29/05
  1. ;;5.2;LAB SERVICES;**291**;Sep 27, 1994
  1. ;
  1. ;
  1. ; Called by LRBEECPT
  1. ;
  1. ; Reference to $$GET1^DIQ supported by IA #2056
  1. ; Reference to ^DIR supported by IA #10026
  1. ;
  1. Q
  1. ;
  1. AAMA(LRBETST,LRBETSTN) ;If panel, ask if AMA compliant
  1. N LRBEAX,LRBEQT
  1. S LRBEQT=0 F D Q:LRBEQT!(LRBEQUIT)
  1. .S LRBEAX=$$GAMA(LRBETST,LRBETSTN)
  1. .S:LRBEAX="" LRBEQT=1 Q:LRBEQT!(LRBEQUIT)
  1. .I +LRBEAX=-2 S LRBEQT=1 Q:LRBEQT
  1. .S LRBEAR2("TEST",LRBETST,"03-AMA FLAG")=LRBEAX,LRBEQT=1
  1. Q
  1. ;
  1. GAMA(LRBETST,LRBETSTN) ;
  1. N LRBEAMA,LRBECPT,LRBEDAMA,LRBEDT,LRBEMSG,LRBEFIL,LRBEFLD,LRBEQT,LRBEDESC
  1. S LRBEMSG="Are the CPT codes for "_LRBETSTN_" AMA compliant or otherwise billable? "
  1. S LRBEFIL=60,LRBEFLD=508
  1. S LRBEDAMA=$$GET1^DIQ(LRBEFIL,LRBETST_",",LRBEFLD,"I")
  1. S LRBEAMA=$$AMA(LRBEMSG,LRBEDAMA) Q:LRBEQUIT LRBEQUIT
  1. I LRBEAMA="" Q LRBEDAMA
  1. I LRBEAMA=LRBEDAMA Q -2
  1. Q LRBEAMA
  1. ;
  1. AMA(LRBEMSG,DAMA) ; Ask if the panel CPTs are AMA compliant
  1. N X,Y,DIR,DTOUT,DUOUT,DIRUT
  1. S DIR("B")=$S(DAMA:"YES",1:"NO")
  1. S DIR("A")=LRBEMSG,DIR(0)="YA" D ^DIR
  1. I $D(DTOUT)!($D(DUOUT))!(X[U) S LRBEQUIT=1 Q LRBEQUIT
  1. Q Y