source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBEECP1.m@ 1394

Last change on this file since 1394 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1LRBEECP1 ;DALOI/WTY - Edit CPT for CIDC (Cont'); 3/29/05
2 ;;5.2;LAB SERVICES;**291**;Sep 27, 1994
3 ;
4 ;
5 ; Called by LRBEECPT
6 ;
7 ; Reference to $$GET1^DIQ supported by IA #2056
8 ; Reference to ^DIR supported by IA #10026
9 ;
10 Q
11 ;
12AAMA(LRBETST,LRBETSTN) ;If panel, ask if AMA compliant
13 N LRBEAX,LRBEQT
14 S LRBEQT=0 F D Q:LRBEQT!(LRBEQUIT)
15 .S LRBEAX=$$GAMA(LRBETST,LRBETSTN)
16 .S:LRBEAX="" LRBEQT=1 Q:LRBEQT!(LRBEQUIT)
17 .I +LRBEAX=-2 S LRBEQT=1 Q:LRBEQT
18 .S LRBEAR2("TEST",LRBETST,"03-AMA FLAG")=LRBEAX,LRBEQT=1
19 Q
20 ;
21GAMA(LRBETST,LRBETSTN) ;
22 N LRBEAMA,LRBECPT,LRBEDAMA,LRBEDT,LRBEMSG,LRBEFIL,LRBEFLD,LRBEQT,LRBEDESC
23 S LRBEMSG="Are the CPT codes for "_LRBETSTN_" AMA compliant or otherwise billable? "
24 S LRBEFIL=60,LRBEFLD=508
25 S LRBEDAMA=$$GET1^DIQ(LRBEFIL,LRBETST_",",LRBEFLD,"I")
26 S LRBEAMA=$$AMA(LRBEMSG,LRBEDAMA) Q:LRBEQUIT LRBEQUIT
27 I LRBEAMA="" Q LRBEDAMA
28 I LRBEAMA=LRBEDAMA Q -2
29 Q LRBEAMA
30 ;
31AMA(LRBEMSG,DAMA) ; Ask if the panel CPTs are AMA compliant
32 N X,Y,DIR,DTOUT,DUOUT,DIRUT
33 S DIR("B")=$S(DAMA:"YES",1:"NO")
34 S DIR("A")=LRBEMSG,DIR(0)="YA" D ^DIR
35 I $D(DTOUT)!($D(DUOUT))!(X[U) S LRBEQUIT=1 Q LRBEQUIT
36 Q Y
Note: See TracBrowser for help on using the repository browser.