- IBCEMPRG ;ALB/JEH - Purge Status Messages ;25-apr-01
- ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;This routine will run as part of the EDI nightly background job.
- ;It will purge status messages in a Final Reveiw Status from
- ;file 361. If the field, Days to Wait to Purge Msgs(#8.02),
- ;of the IB Site Parameters file (#350.9) has been populated,
- ;status messages with a final review date prior to the # days to wait
- ;to purge msgs will be deleted.
- ;
- EN ; -- main entry point for purging status messages in final review status
- N IBDAYS,IBDT,IBDELDT,DIK,DA,X
- S IBDAYS=$P($G(^IBE(350.9,1,8)),U,2)
- Q:'IBDAYS
- S X1=DT,X2=-IBDAYS D C^%DTC S IBDELDT=X
- S DIK="^IBM(361,"
- S IBDT=0 F S IBDT=$O(^IBM(361,"AFR",IBDT)) Q:'IBDT!(IBDT>IBDELDT) S DA=0 F S DA=$O(^IBM(361,"AFR",IBDT,DA)) Q:'DA D ^DIK
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEMPRG 894 printed Feb 18, 2025@23:37:18 Page 2
- IBCEMPRG ;ALB/JEH - Purge Status Messages ;25-apr-01
- +1 ;;2.0;INTEGRATED BILLING;**137**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;This routine will run as part of the EDI nightly background job.
- +4 ;It will purge status messages in a Final Reveiw Status from
- +5 ;file 361. If the field, Days to Wait to Purge Msgs(#8.02),
- +6 ;of the IB Site Parameters file (#350.9) has been populated,
- +7 ;status messages with a final review date prior to the # days to wait
- +8 ;to purge msgs will be deleted.
- +9 ;
- EN ; -- main entry point for purging status messages in final review status
- +1 NEW IBDAYS,IBDT,IBDELDT,DIK,DA,X
- +2 SET IBDAYS=$PIECE($GET(^IBE(350.9,1,8)),U,2)
- +3 if 'IBDAYS
- QUIT
- +4 SET X1=DT
- SET X2=-IBDAYS
- DO C^%DTC
- SET IBDELDT=X
- +5 SET DIK="^IBM(361,"
- +6 SET IBDT=0
- FOR
- SET IBDT=$ORDER(^IBM(361,"AFR",IBDT))
- if 'IBDT!(IBDT>IBDELDT)
- QUIT
- SET DA=0
- FOR
- SET DA=$ORDER(^IBM(361,"AFR",IBDT,DA))
- if 'DA
- QUIT
- DO ^DIK
- +7 QUIT
- +8 ;