Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBDFPRG

IBDFPRG.m

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