source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDYRENR.m@ 1446

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1SDYRENR ;ALB/ABR - PATIENT FILE ENROLL CLINIC CLEANUP ; SEP 28 1995
2 ;;5.3;Scheduling;**32**;Aug 13, 1993
3EN ;
4 N ZTDESC,ZTRTN,ZTIO,ZTQUEUED,ZTSK,I,X
5 W !!,"<<CLEAN-UP OF INCOMPLETE ENROLLMENT CLINICS IN PATIENT FILE>>",!
6 I '$G(DUZ)!'$D(DTIME)!'$D(U) W !!,*7,">> USER NOT DEFINED. CANNOT CONTINUE" Q
7 F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="QUIT" W !,X
8QUE S ZTRTN="CLN^SDYRENR",ZTDESC="PATIENT FILE ENROLLMENT CLINIC CLEAN-UP",ZTIO=""
9 D ^%ZTLOAD
10 W !!,$S($D(ZTSK):">>>Task "_ZTSK_" has been queued.",1:">>> UNABLE TO QUEUE THIS JOB.")
11 Q
12CLN ;entry point from Queue
13 N SDI,SDJ,SDK,SDSTART
14 S SDI=0,SDK=0,SDSTART=$$HTE^XLFDT($H)
15 F S SDI=$O(^DPT(SDI)) Q:'SDI D
16 .S SDJ=0
17 .F S SDJ=$O(^DPT(SDI,"DE",SDJ)),SDK=SDK+1 Q:'SDJ D W:'(SDK#500)&'$D(ZTQUEUED) "."
18 ..Q:$P($G(^DPT(SDI,"DE",SDJ,0)),U,2)]"" I '$O(^(1,0)) D DELETE
19 I '$D(ZTQUEUED) W ">> DONE!",!
20 D TEMPLATE
21 D MAIL
22 Q
23 ;
24DELETE ; delete incomplete enrollment clinic
25 N DA,DIE,DR
26 S DIE="^DPT("_SDI_",""DE"",",DA(1)=SDI,DA=SDJ,DR=".01///@"
27 D ^DIE
28 Q
29MAIL ;
30 N SDTEXT,DIFROM
31 S SDTEXT(1)="The Patient file Enrollment Clinic clean-up began on "_SDSTART
32 S SDTEXT(2)="and ran to completion on "_$$HTE^XLFDT($H)_"."
33 S SDTEXT(3)=" ",SDTEXT(4)="** Please delete the SDYR* routines at this time. **"
34 S XMSUB="Patient File Enrollment Clinic Clean-up Complete",XMTEXT="SDTEXT("
35 S XMDUZ=.5,XMY(DUZ)=""
36 D ^XMD
37 Q
38TEXT ;display text
39 ;;This routine will loop through the PATIENT file, checking to see that
40 ;;Enrollment Clinics are properly set up.
41 ;;
42 ;;Any active clinics missing dates will be deleted.
43 ;;
44 ;;This will also delete the unused sort template SD-AMB-PROC-LIST.
45 ;;
46 ;;THIS CLEAN-UP WILL TAKE SOME TIME AND MUST BE QUEUED!!
47 ;;
48 ;;QUIT
49 Q
50TEMPLATE ; clean-up of unused template
51 N DIC,DIK,DA,X,Y
52 S (DIC,DIK)="^DIBT(",DIC(0)="X",X="SD-AMB-PROC-LIST"
53 D ^DIC
54 I Y>0 S DA=+Y D ^DIK
55 Q
Note: See TracBrowser for help on using the repository browser.