source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPREP4.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1DGPREP4 ;ALB/SCK - Delete/Purge Utilities for Pre-registration ; 1/1/97
2 ;;5.3;Registration;**109**;Aug 13, 1993
3 Q
4 ;
5PURGE42 ; Interactive call for purging call list
6 N DGPX
7 I '$D(^XUSEC("DGPRE SUPV",DUZ)) D Q
8 . W !!,"You do not have the DGPRE Supervisor key"
9 . W !,"Please contact your supervisor."
10 W !
11 D PRGLST(1,.DGPX)
12 W !,DGPX," Entries purged from the Pre-Registration Call List."
13 Q
14 ;
15PRGLST(DGPFLG,DGPCNT) ; Purges all called entries from the PRE-REGISTRATION CALL LIST File, #41.42
16 ;
17 N DGPN1
18 S (DGPN1,DGPCNT)=0
19 F S DGPN1=$O(^DGS(41.42,DGPN1)) Q:DGPN1']"" D
20 . I $P($G(^DGS(41.42,DGPN1,0)),U,6)="Y" D
21 .. S DIK="^DGS(41.42,",DA=DGPN1
22 .. D ^DIK K DIK
23 .. S DGPCNT=+$G(DGPCNT)+1
24 . W:$G(DGPFLG) "."
25 ;
26PRGQ Q
27 ;
28CLEAR42 ; Interactive call for clearing the call list
29 N DGPX
30 I '$D(^XUSEC("DGPRE SUPV",DUZ)) D Q
31 . W !!,"You do not have the DGPRE Supervisor key,"
32 . W !,"Please contact your supervisor."
33 W !
34 D CLRLST(1,.DGPX)
35 W !!,DGPX," Entries deleted from the Pre-Registration Call List."
36 Q
37 ;
38CLRLST(DGPFLG,DGPCNT) ; Deletes all entries from the PRE-REGISTRATION CALL LIST File, #41.42
39 N DGPN1
40 S (DGPN1,DGPCNT)=0
41 F S DGPN1=$O(^DGS(41.42,DGPN1)) Q:DGPN1']"" D
42 . S DIK="^DGS(41.42,",DA=DGPN1
43 . D ^DIK K DIK
44 . W:$G(DGPFLG) "."
45 . S DGPCNT=$G(DGPCNT)+1
46 ;
47 Q
48 ;
49PURGE43 ; Interactive call to purge the Pre-registration call log file
50 ;
51 N X1,X2,DGPCNT,DGPDT,DGPN2,XD
52 K DIRUT,DUOUT
53 ;
54 S DGPCNT=0
55 I '$D(^XUSEC("DGPRE SUPV",DUZ)) D Q
56 . W !!,"You do not have the DGPRE Supervisor key,"
57 . W !,"Please contact your supervisor."
58 ;
59 S DIR(0)="DA^::EX"
60 S XD=+$P($G(^DG(43,1,"DGPRE")),U,4)
61 S X1=$P($$NOW^XLFDT,"."),X2=$$FMADD^XLFDT(X1,$S(XD>0:-XD,1:-60))
62 S DIR("B")=$$FMTE^XLFDT(X2)
63 S DIR("A")="Enter purge date for Call Log : "
64 S DIR("?",1)="All log entries prior to this date will be purged."
65 S DIR("?")="Enter date in a valid VA Format."
66 D ^DIR K DIR
67 Q:$D(DIRUT)
68 S DGPDT=Y
69 S DIR(0)="YA"
70 S DIR("A")="Do you really want to purge all entries prior to "_$$FMTE^XLFDT(DGPDT)_"? "
71 D ^DIR K DIR
72 Q:'Y
73 D WAIT^DICD
74 S X1=0
75 ;
76 F S X1=$O(^DGS(41.43,"B",X1)) Q:X1']""!(X1>DGPDT) D
77 . S DGPN2="" F S DGPN2=$O(^DGS(41.43,"B",X1,DGPN2)) Q:'DGPN2 D
78 .. S DIK="^DGS(41.43,",DA=DGPN2
79 .. D ^DIK K DIK,DA
80 .. S DGPCNT=+$G(DGPCNT)+1
81 ;
82 W !!,+$G(DGPCNT)," Entries were purged from the PRE-REGISTRATION CALL LOG File."
83 Q
Note: See TracBrowser for help on using the repository browser.