IBBACDM.m

IBBACDM ;OAK/ELZ - PFSS SERVICE MASTER API ;15-MAR-2005

 ;;2.0;INTEGRATED BILLING;**286**;21-MAR-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

GETCODE(IBBCPT,IBBCPTDT) ;return service code based on cpt/hcpcs and date of service

 ;

 ;input IBBCPT = pointer to file #81

 ;      IBBCPTDT = service date

 ;output IBBBSRVC = ien in file #374

 ;       RETURN = service_code^activation_date^inactivation_date

 N IBBSRVC,ACTDT,INACTDT,IEN,SUBIEN,NEXTSUB,RETURN,X,XX,XD

 S IBBSRVC=999999

 Q:'$G(IBBCPT) IBBSRVC_"^^"

 Q:'$G(IBBCPTDT) IBBSRVC_"^^"

 S ACTDT="",INACTDT="",IEN="",SUBIEN=""

 S XD=9999999 F  S XD=$O(^IBBAS(374,"AA",IBBCPT,XD),-1) Q:'XD  D  Q:$G(ACTDT)

 .Q:(XD>IBBCPTDT)

 .S ACTDT=XD

 .S IEN=$O(^IBBAS(374,"AA",IBBCPT,ACTDT,0)),SUBIEN=$O(^IBBAS(374,"AA",IBBCPT,ACTDT,IEN,0))

 .S NEXTSUB=$O(^IBBAS(374,IEN,1,SUBIEN)) I 'NEXTSUB Q

 .S INACTDT=$P(^IBBAS(374,IEN,1,NEXTSUB,0),"^",2)

 .I INACTDT'>IBBCPTDT S IEN=""

 I IEN S IBBSRVC=IEN,RETURN=IBBSRVC_"^"_ACTDT_"^"_INACTDT

 E  S RETURN=IBBSRVC_"^^"

 Q RETURN

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBBACDM   1064     printed  Apr 09, 2024@21:32:44                                                                                                                                                                                                     Page 2

IBBACDM   ;OAK/ELZ - PFSS SERVICE MASTER API ;15-MAR-2005

 +1       ;;2.0;INTEGRATED BILLING;**286**;21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

GETCODE(IBBCPT,IBBCPTDT) ;return service code based on cpt/hcpcs and date of service

 +1       ;

 +2       ;input IBBCPT = pointer to file #81

 +3       ;      IBBCPTDT = service date

 +4       ;output IBBBSRVC = ien in file #374

 +5       ;       RETURN = service_code^activation_date^inactivation_date

 +6        NEW IBBSRVC,ACTDT,INACTDT,IEN,SUBIEN,NEXTSUB,RETURN,X,XX,XD

 +7        SET IBBSRVC=999999

 +8        if '$GET(IBBCPT)

               QUIT IBBSRVC_"^^"

 +9        if '$GET(IBBCPTDT)

               QUIT IBBSRVC_"^^"

 +10       SET ACTDT=""

           SET INACTDT=""

           SET IEN=""

           SET SUBIEN=""

 +11       SET XD=9999999

           FOR 

               SET XD=$ORDER(^IBBAS(374,"AA",IBBCPT,XD),-1)

               if 'XD

                   QUIT 

               Begin DoDot:1

 +12               if (XD>IBBCPTDT)

                       QUIT 

 +13               SET ACTDT=XD

 +14               SET IEN=$ORDER(^IBBAS(374,"AA",IBBCPT,ACTDT,0))

                   SET SUBIEN=$ORDER(^IBBAS(374,"AA",IBBCPT,ACTDT,IEN,0))

 +15               SET NEXTSUB=$ORDER(^IBBAS(374,IEN,1,SUBIEN))

                   IF 'NEXTSUB

                       QUIT 

 +16               SET INACTDT=$PIECE(^IBBAS(374,IEN,1,NEXTSUB,0),"^",2)

 +17               IF INACTDT'>IBBCPTDT

                       SET IEN=""

               End DoDot:1

               if $GET(ACTDT)

                   QUIT 

 +18       IF IEN

               SET IBBSRVC=IEN

               SET RETURN=IBBSRVC_"^"_ACTDT_"^"_INACTDT

 +19      IF '$TEST

               SET RETURN=IBBSRVC_"^^"

 +20       QUIT RETURN

 +21      ;