SDYRENR.m

SDYRENR ;ALB/ABR - PATIENT FILE ENROLL CLINIC CLEANUP ; SEP 28 1995

 ;;5.3;Scheduling;**32,1015**;Aug 13, 1993;Build 21

EN ;

 N ZTDESC,ZTRTN,ZTIO,ZTQUEUED,ZTSK,I,X

 W !!,"<<CLEAN-UP OF INCOMPLETE ENROLLMENT CLINICS IN PATIENT FILE>>",!

 I '$G(DUZ)!'$D(DTIME)!'$D(U) W !!,*7,">> USER NOT DEFINED.  CANNOT CONTINUE" Q

 F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="QUIT"  W !,X

QUE S ZTRTN="CLN^SDYRENR",ZTDESC="PATIENT FILE ENROLLMENT CLINIC CLEAN-UP",ZTIO=""

 D ^%ZTLOAD

 W !!,$S($D(ZTSK):">>>Task "_ZTSK_" has been queued.",1:">>>    UNABLE TO QUEUE THIS JOB.")

 Q

CLN ;entry point from Queue

 N SDI,SDJ,SDK,SDSTART

 S SDI=0,SDK=0,SDSTART=$$HTE^XLFDT($H)

 F  S SDI=$O(^DPT(SDI)) Q:'SDI  D

 .S SDJ=0

 .F  S SDJ=$O(^DPT(SDI,"DE",SDJ)),SDK=SDK+1 Q:'SDJ  D  W:'(SDK#500)&'$D(ZTQUEUED) "."

 ..Q:$P($G(^DPT(SDI,"DE",SDJ,0)),U,2)]""  I '$O(^(1,0)) D DELETE

 I '$D(ZTQUEUED) W ">> DONE!",!

 D TEMPLATE

 D MAIL

 Q

 ;

DELETE ; delete incomplete enrollment clinic

 N DA,DIE,DR

 S DIE="^DPT("_SDI_",""DE"",",DA(1)=SDI,DA=SDJ,DR=".01///@"

 D ^DIE

 Q

MAIL ;

 N SDTEXT,DIFROM

 S SDTEXT(1)="The Patient file Enrollment Clinic clean-up began on "_SDSTART

 S SDTEXT(2)="and ran to completion on "_$$HTE^XLFDT($H)_"."

 S SDTEXT(3)=" ",SDTEXT(4)="** Please delete the SDYR* routines at this time. **"

 S XMSUB="Patient File Enrollment Clinic Clean-up Complete",XMTEXT="SDTEXT("

 S XMDUZ=.5,XMY(DUZ)=""

 D ^XMD

 Q

TEXT ;display text

 ;;This routine will loop through the PATIENT file, checking to see that 

 ;;Enrollment Clinics are properly set up.

 ;;  

 ;;Any active clinics missing dates will be deleted.

 ;; 

 ;;This will also delete the unused sort template SD-AMB-PROC-LIST.

 ;;

 ;;THIS CLEAN-UP WILL TAKE SOME TIME AND MUST BE QUEUED!!

 ;;

 ;;QUIT

 Q

TEMPLATE ; clean-up of unused template

 N DIC,DIK,DA,X,Y

 S (DIC,DIK)="^DIBT(",DIC(0)="X",X="SD-AMB-PROC-LIST"

 D ^DIC

 I Y>0 S DA=+Y D ^DIK

 Q

SDYRENR   ;ALB/ABR - PATIENT FILE ENROLL CLINIC CLEANUP ; SEP 28 1995

 +1       ;;5.3;Scheduling;**32,1015**;Aug 13, 1993;Build 21

EN        ;

 +1        NEW ZTDESC,ZTRTN,ZTIO,ZTQUEUED,ZTSK,I,X

 +2        WRITE !!,"<<CLEAN-UP OF INCOMPLETE ENROLLMENT CLINICS IN PATIENT FILE>>",!

 +3        IF '$GET(DUZ)!'$DATA(DTIME)!'$DATA(U)

               WRITE !!,*7,">> USER NOT DEFINED.  CANNOT CONTINUE"

               QUIT 

 +4        FOR I=1:1

               SET X=$PIECE($TEXT(TEXT+I),";;",2)

               IF X="QUIT"

                   QUIT 

               WRITE !,X

QUE        SET ZTRTN="CLN^SDYRENR"

           SET ZTDESC="PATIENT FILE ENROLLMENT CLINIC CLEAN-UP"

           SET ZTIO=""

 +1        DO ^%ZTLOAD

 +2        WRITE !!,$SELECT($DATA(ZTSK):">>>Task "_ZTSK_" has been queued.",1:">>>    UNABLE TO QUEUE THIS JOB.")

 +3        QUIT 

CLN       ;entry point from Queue

 +1        NEW SDI,SDJ,SDK,SDSTART

 +2        SET SDI=0

           SET SDK=0

           SET SDSTART=$$HTE^XLFDT($HOROLOG)

 +3        FOR 

               SET SDI=$ORDER(^DPT(SDI))

               IF 'SDI

                   QUIT 

               Begin DoDot:1

 +4                SET SDJ=0

 +5                FOR 

                       SET SDJ=$ORDER(^DPT(SDI,"DE",SDJ))

                       SET SDK=SDK+1

                       IF 'SDJ

                           QUIT 

                       Begin DoDot:2

 +6                        IF $PIECE($GET(^DPT(SDI,"DE",SDJ,0)),U,2)]""

                               QUIT 

                           IF '$ORDER(^(1,0))

                               DO DELETE

                       End DoDot:2

                       IF '(SDK#500)&'$DATA(ZTQUEUED)

                           WRITE "."

               End DoDot:1

 +7        IF '$DATA(ZTQUEUED)

               WRITE ">> DONE!",!

 +8        DO TEMPLATE

 +9        DO MAIL

 +10       QUIT 

 +11      ;

DELETE    ; delete incomplete enrollment clinic

 +1        NEW DA,DIE,DR

 +2        SET DIE="^DPT("_SDI_",""DE"","

           SET DA(1)=SDI

           SET DA=SDJ

           SET DR=".01///@"

 +3        DO ^DIE

 +4        QUIT 

MAIL      ;

 +1        NEW SDTEXT,DIFROM

 +2        SET SDTEXT(1)="The Patient file Enrollment Clinic clean-up began on "_SDSTART

 +3        SET SDTEXT(2)="and ran to completion on "_$$HTE^XLFDT($HOROLOG)_"."

 +4        SET SDTEXT(3)=" "

           SET SDTEXT(4)="** Please delete the SDYR* routines at this time. **"

 +5        SET XMSUB="Patient File Enrollment Clinic Clean-up Complete"

           SET XMTEXT="SDTEXT("

 +6        SET XMDUZ=.5

           SET XMY(DUZ)=""

 +7        DO ^XMD

 +8        QUIT 

TEXT      ;display text

 +1       ;;This routine will loop through the PATIENT file, checking to see that 

 +2       ;;Enrollment Clinics are properly set up.

 +3       ;;  

 +4       ;;Any active clinics missing dates will be deleted.

 +5       ;; 

 +6       ;;This will also delete the unused sort template SD-AMB-PROC-LIST.

 +7       ;;

 +8       ;;THIS CLEAN-UP WILL TAKE SOME TIME AND MUST BE QUEUED!!

 +9       ;;

 +10      ;;QUIT

 +11       QUIT 

TEMPLATE  ; clean-up of unused template

 +1        NEW DIC,DIK,DA,X,Y

 +2        SET (DIC,DIK)="^DIBT("

           SET DIC(0)="X"

           SET X="SD-AMB-PROC-LIST"

 +3        DO ^DIC

 +4        IF Y>0

               SET DA=+Y

               DO ^DIK

 +5        QUIT