| 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 | ;
|
|---|
