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

DGPREP4.m

Go to the documentation of this file.
  1. DGPREP4 ;ALB/SCK - Delete/Purge Utilities for Pre-registration ; 1/1/97
  1. ;;5.3;Registration;**109**;Aug 13, 1993
  1. Q
  1. ;
  1. PURGE42 ; Interactive call for purging call list
  1. N DGPX
  1. I '$D(^XUSEC("DGPRE SUPV",DUZ)) D Q
  1. . W !!,"You do not have the DGPRE Supervisor key"
  1. . W !,"Please contact your supervisor."
  1. W !
  1. D PRGLST(1,.DGPX)
  1. W !,DGPX," Entries purged from the Pre-Registration Call List."
  1. Q
  1. ;
  1. PRGLST(DGPFLG,DGPCNT) ; Purges all called entries from the PRE-REGISTRATION CALL LIST File, #41.42
  1. ;
  1. N DGPN1
  1. S (DGPN1,DGPCNT)=0
  1. F S DGPN1=$O(^DGS(41.42,DGPN1)) Q:DGPN1']"" D
  1. . I $P($G(^DGS(41.42,DGPN1,0)),U,6)="Y" D
  1. .. S DIK="^DGS(41.42,",DA=DGPN1
  1. .. D ^DIK K DIK
  1. .. S DGPCNT=+$G(DGPCNT)+1
  1. . W:$G(DGPFLG) "."
  1. ;
  1. PRGQ Q
  1. ;
  1. CLEAR42 ; Interactive call for clearing the call list
  1. N DGPX
  1. I '$D(^XUSEC("DGPRE SUPV",DUZ)) D Q
  1. . W !!,"You do not have the DGPRE Supervisor key,"
  1. . W !,"Please contact your supervisor."
  1. W !
  1. D CLRLST(1,.DGPX)
  1. W !!,DGPX," Entries deleted from the Pre-Registration Call List."
  1. Q
  1. ;
  1. CLRLST(DGPFLG,DGPCNT) ; Deletes all entries from the PRE-REGISTRATION CALL LIST File, #41.42
  1. N DGPN1
  1. S (DGPN1,DGPCNT)=0
  1. F S DGPN1=$O(^DGS(41.42,DGPN1)) Q:DGPN1']"" D
  1. . S DIK="^DGS(41.42,",DA=DGPN1
  1. . D ^DIK K DIK
  1. . W:$G(DGPFLG) "."
  1. . S DGPCNT=$G(DGPCNT)+1
  1. ;
  1. Q
  1. ;
  1. PURGE43 ; Interactive call to purge the Pre-registration call log file
  1. ;
  1. N X1,X2,DGPCNT,DGPDT,DGPN2,XD
  1. K DIRUT,DUOUT
  1. ;
  1. S DGPCNT=0
  1. I '$D(^XUSEC("DGPRE SUPV",DUZ)) D Q
  1. . W !!,"You do not have the DGPRE Supervisor key,"
  1. . W !,"Please contact your supervisor."
  1. ;
  1. S DIR(0)="DA^::EX"
  1. S XD=+$P($G(^DG(43,1,"DGPRE")),U,4)
  1. S X1=$P($$NOW^XLFDT,"."),X2=$$FMADD^XLFDT(X1,$S(XD>0:-XD,1:-60))
  1. S DIR("B")=$$FMTE^XLFDT(X2)
  1. S DIR("A")="Enter purge date for Call Log : "
  1. S DIR("?",1)="All log entries prior to this date will be purged."
  1. S DIR("?")="Enter date in a valid VA Format."
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S DGPDT=Y
  1. S DIR(0)="YA"
  1. S DIR("A")="Do you really want to purge all entries prior to "_$$FMTE^XLFDT(DGPDT)_"? "
  1. D ^DIR K DIR
  1. Q:'Y
  1. D WAIT^DICD
  1. S X1=0
  1. ;
  1. F S X1=$O(^DGS(41.43,"B",X1)) Q:X1']""!(X1>DGPDT) D
  1. . S DGPN2="" F S DGPN2=$O(^DGS(41.43,"B",X1,DGPN2)) Q:'DGPN2 D
  1. .. S DIK="^DGS(41.43,",DA=DGPN2
  1. .. D ^DIK K DIK,DA
  1. .. S DGPCNT=+$G(DGPCNT)+1
  1. ;
  1. W !!,+$G(DGPCNT)," Entries were purged from the PRE-REGISTRATION CALL LOG File."
  1. Q