- IBDFPRG ;ALB/AAS - AICS PURGE UTILITY ; 4-OCT-95
- ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- ;
- % ; -- purge utility for purging entries from the
- ; Form Definition file (357.95)
- ; Form Tracking file (357.96)
- ; Form Specification file (359.2)
- ; AICS Error Log file (359.3)
- ;
- MANUAL ; -- Option to purge records, ask input
- N IBCNT2,IBCNT5,IBCNT6,IBCNT7,IBD,IBHOW,IBLDT,IBDAYS,IBPURGE,IBQUIT,DIR,DIRUT,DUOUT,X,Y,IBLOG,D0,DA,D,ZTSK
- I '$D(DT) D DT^DICRW
- ;
- S IBQUIT=0
- D ASK
- Q:IBQUIT
- S IBLDT=$$FMADD^XLFDT(DT,-IBDAYS)
- S ZTSAVE("IB*")="",ZTRTN="DQ^IBDFPRG",ZTDESC="IBD - Manual Purge of form tracking",ZTIO="" D ^%ZTLOAD
- W !,$S($D(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled") D HOME^%ZIS S IBQUIT=1 Q
- Q
- ;
- DQ ; -- entry point from manual task
- S IBLOG=$$ADD
- I IBPURGE("FT") D PURGFT^IBDFPRG1(IBLDT,IBHOW),PURGEL^IBDFPRG1(IBLDT)
- I IBPURGE("FD") D PURGFD^IBDFPRG1(IBLDT)
- D OUTPUT
- G EXIT
- Q
- ;
- EXIT ; -- exit for all modes
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- ;
- AUTO ; -- Background option to automatically purge records
- N X,Y,IBCNT2,IBCNT5,IBCNT6,IBCNT7,IBLDT,IBHOW,IBD,IBLOG,D0,DA,D
- I '$D(DT) D DT^DICRW
- ;
- ; -- if parameters not defined don't run
- I $P($G(^IBD(357.09,1,0)),"^",3)=""!($P($G(^IBD(357.09,1,0)),"^",2)="") G AUTOQ
- S IBHOW=$P($G(^IBD(357.09,1,0)),"^",2)
- ;
- ; -- Compute last date to purge records
- S IBLDT=$$FMADD^XLFDT(DT,-$P($G(^IBD(357.09,1,0)),"^",3))
- S IBLOG=$$ADD
- ;
- ; -- purge all entries in form tracking according to parameters
- D PURGFT^IBDFPRG1(IBLDT,+$P($G(^IBD(357.09,1,0)),"^",2))
- ;
- ; -- purge form definition entries only if marked for deletion
- ; and all entries are complete
- D PURGFD^IBDFPRG1(IBLDT)
- ;
- ; -- purge entries from AICS ERROR LOG (359.3)
- D PURGEL^IBDFPRG1(IBLDT)
- ;
- D OUTPUT
- G EXIT
- ;
- AUTOQ Q
- ;
- ADD() ; -- add new entry to purge log
- N DIC,DLAYGO
- S Y=-1
- I $G(^IBD(357.08,0))'="" S X=$$NOW^XLFDT,DIC="^IBD(357.08,",DIC(0)="L",DLAYGO=357.08 D FILE^DICN
- ADDQ Q +Y
- ;
- EDIT ; -- update entry after running
- N DIC,DIE,DA,DR,X,Y
- I IBLOG<1!($G(^IBD(357.08,+IBLOG,0))="") Q
- S DIE="^IBD(357.08,",DA=IBLOG
- S DR=".02////"_$G(IBHOW)_";.03////"_$G(IBLDT)_";.04////"_$G(IBCNT6)_";.05////"_$G(IBCNT5)_";.06////"_$G(IBCNT2)_";.07////"_$G(IBCNT7)
- D ^DIE
- Q
- ;
- OUTPUT ; -- output results of purge
- ;
- S IBD(1)="Purge of Form Tracking Statistics"
- S IBD(2)="Status of Form Tracking Entries Purged .......... "_$S(+$G(IBHOW)=0:"None",$G(IBHOW)=1:"Completed",$G(IBHOW)=2:"All",1:"None")
- S IBD(3)="Form Tracking entries purged upto ............... "_$$FMTE^XLFDT($G(IBLDT))
- S IBD(4)="Number of Form tracking Entries Deleted ......... "_$G(IBCNT6)
- S IBD(5)="Number of Form Definition Entries Deleted ....... "_$G(IBCNT5)
- S IBD(6)="Number of Form Specification Entries Deleted .... "_$G(IBCNT2)
- S IBD(7)="Number of AICS Error Log Entries Deleted ........ "_$G(IBCNT7)
- D EDIT,SEND
- ;
- I '$D(ZTQUEUED) S X="" F S X=$O(IBD(X)) Q:'X W !,IBD(X)
- Q
- ;
- ASK ; -- ask what to purge
- ; Output : ibpurge("ft") := 1=yes purge form tracking, 0=no
- ; ibpurge("fd") := 1=yes purge form definition, 0=no
- ;
- N DIR
- S IBPURGE("FD")=0,IBPURGE("FT")=0
- ;
- S DIR(0)="Y"
- S DIR("?")="Answer YES if you want to purge Form Tracking of unneeded records"
- W !!!,"Do you want to purge Form Tracking?"
- D ^DIR
- I $D(DIRUT) S IBQUIT=1 Q
- S IBPURGE("FT")=+Y
- ;
- K DIR
- S DIR(0)="Y"
- S DIR("?")="Answer YES if you want to purge Form Defintions of unneeded records"
- W !!,"Do you want to purge Form Definitions and Form Specifications?"
- D ^DIR
- I $D(DIRUT) S IBQUIT=1 Q
- S IBPURGE("FD")=+Y
- ;
- ; -- if the user wants to purge form tracking get needed parms
- I IBPURGE("FT")!(IBPURGE("FD")) D ASKN,ASKH
- I 'IBPURGE("FT"),'IBPURGE("FD") S IBQUIT=1
- Q
- ;
- ASKN ; -- ask number of days to retain
- ; Output : IBDAYS := number of days to retain
- ;
- N DIR
- S IBDAYS=-1
- S DIR(0)="N^60:999:0"
- S DIR("A")="Number of Days to Retain"
- S DIR("B")=+$P($G(^IBD(357.09,1,0)),"^",3)
- S DIR("?")="Enter the number of days of form tracking data to retain"
- D ^DIR
- I $D(DIRUT) S IBQUIT=1 Q
- S IBDAYS=+Y
- Q
- ;
- ASKH ; -- ask how to purge
- ; Output : IBHOW := 0=none, 1=complete, 2=all
- ;
- N DIR
- S IBHOW=-1
- S DIR(0)="S^0:None;1:Purge Completed Entries;2:Purge All Entries"
- S DIR("A")="Purge what Entries"
- S DIR("B")=+$P($G(^IBD(357.09,1,0)),"^",2)
- S DIR("?")="Choose whether you want to purge only completed entries or whether to purge all entries"
- D ^DIR
- I $D(DIRUT) S IBQUIT=1 Q
- S IBHOW=+Y
- Q
- ;
- SEND ; -- send mail message to group if defined
- N IBDGRP,XMDUZ,XMTEXT,XMY,XMSUB,XMZ
- S XMDUZ="AICS PACKAGE",XMTEXT="IBD(",XMSUB="AICS PURGE RESULTS"
- K XMY S XMN=0
- S IBDGRP=$$GET1^DIQ(3.8,+$P($G(^IBD(357.09,1,1)),"^"),.01)
- ;S IBDGRP=$P($G(^XMB(3.8,+$P($G(^IBD(357.09,1,1)),"^"),0)),"^")
- Q:IBDGRP=""
- S XMY("G."_IBDGRP_"@"_^XMB("NETNAME"))=""
- D ^XMD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDFPRG 4975 printed Jan 18, 2025@03:54:20 Page 2
- IBDFPRG ;ALB/AAS - AICS PURGE UTILITY ; 4-OCT-95
- +1 ;;3.0;AUTOMATED INFO COLLECTION SYS;;APR 24, 1997
- +2 ;
- % ; -- purge utility for purging entries from the
- +1 ; Form Definition file (357.95)
- +2 ; Form Tracking file (357.96)
- +3 ; Form Specification file (359.2)
- +4 ; AICS Error Log file (359.3)
- +5 ;
- MANUAL ; -- Option to purge records, ask input
- +1 NEW IBCNT2,IBCNT5,IBCNT6,IBCNT7,IBD,IBHOW,IBLDT,IBDAYS,IBPURGE,IBQUIT,DIR,DIRUT,DUOUT,X,Y,IBLOG,D0,DA,D,ZTSK
- +2 IF '$DATA(DT)
- DO DT^DICRW
- +3 ;
- +4 SET IBQUIT=0
- +5 DO ASK
- +6 if IBQUIT
- QUIT
- +7 SET IBLDT=$$FMADD^XLFDT(DT,-IBDAYS)
- +8 SET ZTSAVE("IB*")=""
- SET ZTRTN="DQ^IBDFPRG"
- SET ZTDESC="IBD - Manual Purge of form tracking"
- SET ZTIO=""
- DO ^%ZTLOAD
- +9 WRITE !,$SELECT($DATA(ZTSK):"Request Queued Task="_ZTSK,1:"Request Canceled")
- DO HOME^%ZIS
- SET IBQUIT=1
- QUIT
- +10 QUIT
- +11 ;
- DQ ; -- entry point from manual task
- +1 SET IBLOG=$$ADD
- +2 IF IBPURGE("FT")
- DO PURGFT^IBDFPRG1(IBLDT,IBHOW)
- DO PURGEL^IBDFPRG1(IBLDT)
- +3 IF IBPURGE("FD")
- DO PURGFD^IBDFPRG1(IBLDT)
- +4 DO OUTPUT
- +5 GOTO EXIT
- +6 QUIT
- +7 ;
- EXIT ; -- exit for all modes
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 QUIT
- +3 ;
- AUTO ; -- Background option to automatically purge records
- +1 NEW X,Y,IBCNT2,IBCNT5,IBCNT6,IBCNT7,IBLDT,IBHOW,IBD,IBLOG,D0,DA,D
- +2 IF '$DATA(DT)
- DO DT^DICRW
- +3 ;
- +4 ; -- if parameters not defined don't run
- +5 IF $PIECE($GET(^IBD(357.09,1,0)),"^",3)=""!($PIECE($GET(^IBD(357.09,1,0)),"^",2)="")
- GOTO AUTOQ
- +6 SET IBHOW=$PIECE($GET(^IBD(357.09,1,0)),"^",2)
- +7 ;
- +8 ; -- Compute last date to purge records
- +9 SET IBLDT=$$FMADD^XLFDT(DT,-$PIECE($GET(^IBD(357.09,1,0)),"^",3))
- +10 SET IBLOG=$$ADD
- +11 ;
- +12 ; -- purge all entries in form tracking according to parameters
- +13 DO PURGFT^IBDFPRG1(IBLDT,+$PIECE($GET(^IBD(357.09,1,0)),"^",2))
- +14 ;
- +15 ; -- purge form definition entries only if marked for deletion
- +16 ; and all entries are complete
- +17 DO PURGFD^IBDFPRG1(IBLDT)
- +18 ;
- +19 ; -- purge entries from AICS ERROR LOG (359.3)
- +20 DO PURGEL^IBDFPRG1(IBLDT)
- +21 ;
- +22 DO OUTPUT
- +23 GOTO EXIT
- +24 ;
- AUTOQ QUIT
- +1 ;
- ADD() ; -- add new entry to purge log
- +1 NEW DIC,DLAYGO
- +2 SET Y=-1
- +3 IF $GET(^IBD(357.08,0))'=""
- SET X=$$NOW^XLFDT
- SET DIC="^IBD(357.08,"
- SET DIC(0)="L"
- SET DLAYGO=357.08
- DO FILE^DICN
- ADDQ QUIT +Y
- +1 ;
- EDIT ; -- update entry after running
- +1 NEW DIC,DIE,DA,DR,X,Y
- +2 IF IBLOG<1!($GET(^IBD(357.08,+IBLOG,0))="")
- QUIT
- +3 SET DIE="^IBD(357.08,"
- SET DA=IBLOG
- +4 SET DR=".02////"_$GET(IBHOW)_";.03////"_$GET(IBLDT)_";.04////"_$GET(IBCNT6)_";.05////"_$GET(IBCNT5)_";.06////"_$GET(IBCNT2)_";.07////"_$GET(IBCNT7)
- +5 DO ^DIE
- +6 QUIT
- +7 ;
- OUTPUT ; -- output results of purge
- +1 ;
- +2 SET IBD(1)="Purge of Form Tracking Statistics"
- +3 SET IBD(2)="Status of Form Tracking Entries Purged .......... "_$SELECT(+$GET(IBHOW)=0:"None",$GET(IBHOW)=1:"Completed",$GET(IBHOW)=2:"All",1:"None")
- +4 SET IBD(3)="Form Tracking entries purged upto ............... "_$$FMTE^XLFDT($GET(IBLDT))
- +5 SET IBD(4)="Number of Form tracking Entries Deleted ......... "_$GET(IBCNT6)
- +6 SET IBD(5)="Number of Form Definition Entries Deleted ....... "_$GET(IBCNT5)
- +7 SET IBD(6)="Number of Form Specification Entries Deleted .... "_$GET(IBCNT2)
- +8 SET IBD(7)="Number of AICS Error Log Entries Deleted ........ "_$GET(IBCNT7)
- +9 DO EDIT
- DO SEND
- +10 ;
- +11 IF '$DATA(ZTQUEUED)
- SET X=""
- FOR
- SET X=$ORDER(IBD(X))
- if 'X
- QUIT
- WRITE !,IBD(X)
- +12 QUIT
- +13 ;
- ASK ; -- ask what to purge
- +1 ; Output : ibpurge("ft") := 1=yes purge form tracking, 0=no
- +2 ; ibpurge("fd") := 1=yes purge form definition, 0=no
- +3 ;
- +4 NEW DIR
- +5 SET IBPURGE("FD")=0
- SET IBPURGE("FT")=0
- +6 ;
- +7 SET DIR(0)="Y"
- +8 SET DIR("?")="Answer YES if you want to purge Form Tracking of unneeded records"
- +9 WRITE !!!,"Do you want to purge Form Tracking?"
- +10 DO ^DIR
- +11 IF $DATA(DIRUT)
- SET IBQUIT=1
- QUIT
- +12 SET IBPURGE("FT")=+Y
- +13 ;
- +14 KILL DIR
- +15 SET DIR(0)="Y"
- +16 SET DIR("?")="Answer YES if you want to purge Form Defintions of unneeded records"
- +17 WRITE !!,"Do you want to purge Form Definitions and Form Specifications?"
- +18 DO ^DIR
- +19 IF $DATA(DIRUT)
- SET IBQUIT=1
- QUIT
- +20 SET IBPURGE("FD")=+Y
- +21 ;
- +22 ; -- if the user wants to purge form tracking get needed parms
- +23 IF IBPURGE("FT")!(IBPURGE("FD"))
- DO ASKN
- DO ASKH
- +24 IF 'IBPURGE("FT")
- IF 'IBPURGE("FD")
- SET IBQUIT=1
- +25 QUIT
- +26 ;
- ASKN ; -- ask number of days to retain
- +1 ; Output : IBDAYS := number of days to retain
- +2 ;
- +3 NEW DIR
- +4 SET IBDAYS=-1
- +5 SET DIR(0)="N^60:999:0"
- +6 SET DIR("A")="Number of Days to Retain"
- +7 SET DIR("B")=+$PIECE($GET(^IBD(357.09,1,0)),"^",3)
- +8 SET DIR("?")="Enter the number of days of form tracking data to retain"
- +9 DO ^DIR
- +10 IF $DATA(DIRUT)
- SET IBQUIT=1
- QUIT
- +11 SET IBDAYS=+Y
- +12 QUIT
- +13 ;
- ASKH ; -- ask how to purge
- +1 ; Output : IBHOW := 0=none, 1=complete, 2=all
- +2 ;
- +3 NEW DIR
- +4 SET IBHOW=-1
- +5 SET DIR(0)="S^0:None;1:Purge Completed Entries;2:Purge All Entries"
- +6 SET DIR("A")="Purge what Entries"
- +7 SET DIR("B")=+$PIECE($GET(^IBD(357.09,1,0)),"^",2)
- +8 SET DIR("?")="Choose whether you want to purge only completed entries or whether to purge all entries"
- +9 DO ^DIR
- +10 IF $DATA(DIRUT)
- SET IBQUIT=1
- QUIT
- +11 SET IBHOW=+Y
- +12 QUIT
- +13 ;
- SEND ; -- send mail message to group if defined
- +1 NEW IBDGRP,XMDUZ,XMTEXT,XMY,XMSUB,XMZ
- +2 SET XMDUZ="AICS PACKAGE"
- SET XMTEXT="IBD("
- SET XMSUB="AICS PURGE RESULTS"
- +3 KILL XMY
- SET XMN=0
- +4 SET IBDGRP=$$GET1^DIQ(3.8,+$PIECE($GET(^IBD(357.09,1,1)),"^"),.01)
- +5 ;S IBDGRP=$P($G(^XMB(3.8,+$P($G(^IBD(357.09,1,1)),"^"),0)),"^")
- +6 if IBDGRP=""
- QUIT
- +7 SET XMY("G."_IBDGRP_"@"_^XMB("NETNAME"))=""
- +8 DO ^XMD
- +9 QUIT