| 1 | DGPREP4 ;ALB/SCK - Delete/Purge Utilities for Pre-registration ; 1/1/97
|
|---|
| 2 | ;;5.3;Registration;**109**;Aug 13, 1993
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | PURGE42 ; 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 | ;
|
|---|
| 15 | PRGLST(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 | ;
|
|---|
| 26 | PRGQ Q
|
|---|
| 27 | ;
|
|---|
| 28 | CLEAR42 ; 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 | ;
|
|---|
| 38 | CLRLST(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 | ;
|
|---|
| 49 | PURGE43 ; 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
|
|---|
