IBCEPTU.m

IBCEPTU ;ALB/TMK-TEST TRANSMIT CLAIMS UTILITIES ;25-JAN-2005

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

 ;

PURGE ; Purge test claim transmit records over 60 days old

 N IBDAYS,IBDT,IBDELDT,DIK,DA,X

 S IBDAYS=60

 S X1=DT,X2=-IBDAYS D C^%DTC S IBDELDT=X

 S DIK="^IBM(361.4,"

 S IBDT=0 F  S IBDT=$O(^IBM(361.4,"ALT",IBDT)) Q:'IBDT!(IBDT>IBDELDT)  S DA=0 F  S DA=$O(^IBM(361.4,"ALT",IBDT,DA)) Q:'DA  D ^DIK

 Q

 ;

LASTDT(DA) ; Get last txmt dt file 361.4 for xref

 ; DA = array of iens from Fileman

 N Z,Z0,X

 S X=""

 S Z="" F  S Z=$O(^IBM(361.4,DA(1),1,"ALTD",Z),-1) Q:Z=""!X  S Z0=0 F  S Z0=$O(^IBM(361.4,DA(1),1,"ALTD",Z,Z0)) Q:'Z0  I Z0'=DA S X=Z Q

 Q X

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCEPTU   675     printed  Apr 09, 2024@21:19:43                                                                                                                                                                                                      Page 2

IBCEPTU   ;ALB/TMK-TEST TRANSMIT CLAIMS UTILITIES ;25-JAN-2005

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

 +2       ;

PURGE     ; Purge test claim transmit records over 60 days old

 +1        NEW IBDAYS,IBDT,IBDELDT,DIK,DA,X

 +2        SET IBDAYS=60

 +3        SET X1=DT

           SET X2=-IBDAYS

           DO C^%DTC

           SET IBDELDT=X

 +4        SET DIK="^IBM(361.4,"

 +5        SET IBDT=0

           FOR 

               SET IBDT=$ORDER(^IBM(361.4,"ALT",IBDT))

               if 'IBDT!(IBDT>IBDELDT)

                   QUIT 

               SET DA=0

               FOR 

                   SET DA=$ORDER(^IBM(361.4,"ALT",IBDT,DA))

                   if 'DA

                       QUIT 

                   DO ^DIK

 +6        QUIT 

 +7       ;

LASTDT(DA) ; Get last txmt dt file 361.4 for xref

 +1       ; DA = array of iens from Fileman

 +2        NEW Z,Z0,X

 +3        SET X=""

 +4        SET Z=""

           FOR 

               SET Z=$ORDER(^IBM(361.4,DA(1),1,"ALTD",Z),-1)

               if Z=""!X

                   QUIT 

               SET Z0=0

               FOR 

                   SET Z0=$ORDER(^IBM(361.4,DA(1),1,"ALTD",Z,Z0))

                   if 'Z0

                       QUIT 

                   IF Z0'=DA

                       SET X=Z

                       QUIT 

 +5        QUIT X

 +6       ;