| [613] | 1 | IBBACDM ;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 | ; | 
|---|
|  | 5 | GETCODE(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 | ; | 
|---|