| 1 | SDYRENR ;ALB/ABR - PATIENT FILE ENROLL CLINIC CLEANUP ; SEP 28 1995
|
|---|
| 2 | ;;5.3;Scheduling;**32**;Aug 13, 1993
|
|---|
| 3 | EN ;
|
|---|
| 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
|
|---|
| 8 | QUE 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
|
|---|
| 12 | CLN ;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 | ;
|
|---|
| 24 | DELETE ; 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
|
|---|
| 29 | MAIL ;
|
|---|
| 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
|
|---|
| 38 | TEXT ;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
|
|---|
| 50 | TEMPLATE ; 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
|
|---|
