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 ---[H[J[2J[HIBCEPTU 675 printed Nov 22, 2024@17:22:13 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 ;
