source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBBACDM.m@ 1608

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

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1IBBACDM ;OAK/ELZ - PFSS SERVICE MASTER API ;15-MAR-2005
2 ;;2.0;INTEGRATED BILLING;**286**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5GETCODE(IBBCPT,IBBCPTDT) ;return service code based on cpt/hcpcs and date of service
6 ;
7 ;input IBBCPT = pointer to file #81
8 ; IBBCPTDT = service date
9 ;output IBBBSRVC = ien in file #374
10 ; RETURN = service_code^activation_date^inactivation_date
11 N IBBSRVC,ACTDT,INACTDT,IEN,SUBIEN,NEXTSUB,RETURN,X,XX,XD
12 S IBBSRVC=999999
13 Q:'$G(IBBCPT) IBBSRVC_"^^"
14 Q:'$G(IBBCPTDT) IBBSRVC_"^^"
15 S ACTDT="",INACTDT="",IEN="",SUBIEN=""
16 S XD=9999999 F S XD=$O(^IBBAS(374,"AA",IBBCPT,XD),-1) Q:'XD D Q:$G(ACTDT)
17 .Q:(XD>IBBCPTDT)
18 .S ACTDT=XD
19 .S IEN=$O(^IBBAS(374,"AA",IBBCPT,ACTDT,0)),SUBIEN=$O(^IBBAS(374,"AA",IBBCPT,ACTDT,IEN,0))
20 .S NEXTSUB=$O(^IBBAS(374,IEN,1,SUBIEN)) I 'NEXTSUB Q
21 .S INACTDT=$P(^IBBAS(374,IEN,1,NEXTSUB,0),"^",2)
22 .I INACTDT'>IBBCPTDT S IEN=""
23 I IEN S IBBSRVC=IEN,RETURN=IBBSRVC_"^"_ACTDT_"^"_INACTDT
24 E S RETURN=IBBSRVC_"^^"
25 Q RETURN
26 ;
Note: See TracBrowser for help on using the repository browser.