- 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 Mar 13, 2025@21:16:57 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 ;
