SDYCENR.m

SDYCENR ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94

 ;;5.3;Scheduling;**21**;Aug 13, 1993

 ;

EN N SDFLAG,SDASH,SDPAGE,SDQUIT

 D WRT,INIT

 S %ZIS="PMQ" D ^%ZIS I POP G ENQ

 I '$D(IO("Q")) D LOOP G ENQ

 S Y=$$QUE

ENQ K SDASH,SDPAGE,SDQUIT

 D:'$D(ZTQUEUED) ^%ZISC Q

 ;

INIT ; Init variables

 S $P(SDASH,"=",80)="",SDPAGE=0,SDQUIT=0

 Q

LOOP ; Loop through the enrollment info

 N SDCLIN,SDCLN,SDENR,SDENROL,SDPAT

 K ^DPT("AEB1")

 K ^TMP("EN2",$J) S SDPAT=0

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

 .S SDCLN=0 F  S SDCLN=$O(^DPT(SDPAT,"DE",SDCLN)) Q:'SDCLN  S SDCLIN=^(SDCLN,0) D

 ..S SDENR=0 F  S SDENR=$O(^DPT(SDPAT,"DE",SDCLN,1,SDENR)) Q:'SDENR  S SDENROL=^(SDENR,0) D

 ...S ^DPT("AEB1",+SDCLIN,+SDENROL,SDPAT,SDCLN,SDENR)=""

 ...D LOOP1

 D ^SDYCENR1

 Q

 ;

LOOP1 ; Find inactive enrollments with no date of discharge

 I ($P(SDCLIN,U,2)="I"&('$P(SDENROL,U,3))) S SDPT=$G(^DPT(SDPAT,0)) Q:SDPT=""  D

 .S ^TMP("EN2",$J,$P(SDPT,U),$P(SDPT,U,9),$P($G(^SC(+SDCLIN,0)),U))=""

 Q

WRT ;

 W !,"The following will provide a listing which will include patients that "

 W !,"have an inactive enrollment with no date of discharge.  Because the "

 W !,"date of discharge cannot be automatically determined, the dates of "

 W !,"discharge will have to be entered manually via the 'Edit Clinic "

 W !,"Enrollment Data' option.",!

 Q

 ;

QUE() ; -- que job

 ; return: did job que [ 1|yes   0|no ]

 ;

 K ZTSK,IO("Q")

 S ZTDESC="Enrollment Information Report",ZTRTN="LOOP^SDYCENR"

 S (ZTSAVE("SDPAGE"),ZTSAVE("SDASH"),ZTSAVE("SDQUIT"))=""

 D ^%ZTLOAD W:$D(ZTSK) "   (Task: ",ZTSK,")"

 Q $D(ZTSK)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDYCENR   1613     printed  Mar 13, 2025@22:08:45                                                                                                                                                                                                     Page 2

SDYCENR   ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94

 +1       ;;5.3;Scheduling;**21**;Aug 13, 1993

 +2       ;

EN         NEW SDFLAG,SDASH,SDPAGE,SDQUIT

 +1        DO WRT

           DO INIT

 +2        SET %ZIS="PMQ"

           DO ^%ZIS

           IF POP

               GOTO ENQ

 +3        IF '$DATA(IO("Q"))

               DO LOOP

               GOTO ENQ

 +4        SET Y=$$QUE

ENQ        KILL SDASH,SDPAGE,SDQUIT

 +1        if '$DATA(ZTQUEUED)

               DO ^%ZISC

           QUIT 

 +2       ;

INIT      ; Init variables

 +1        SET $PIECE(SDASH,"=",80)=""

           SET SDPAGE=0

           SET SDQUIT=0

 +2        QUIT 

LOOP      ; Loop through the enrollment info

 +1        NEW SDCLIN,SDCLN,SDENR,SDENROL,SDPAT

 +2        KILL ^DPT("AEB1")

 +3        KILL ^TMP("EN2",$JOB)

           SET SDPAT=0

 +4        FOR 

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

               if 'SDPAT

                   QUIT 

               Begin DoDot:1

 +5                SET SDCLN=0

                   FOR 

                       SET SDCLN=$ORDER(^DPT(SDPAT,"DE",SDCLN))

                       if 'SDCLN

                           QUIT 

                       SET SDCLIN=^(SDCLN,0)

                       Begin DoDot:2

 +6                        SET SDENR=0

                           FOR 

                               SET SDENR=$ORDER(^DPT(SDPAT,"DE",SDCLN,1,SDENR))

                               if 'SDENR

                                   QUIT 

                               SET SDENROL=^(SDENR,0)

                               Begin DoDot:3

 +7                                SET ^DPT("AEB1",+SDCLIN,+SDENROL,SDPAT,SDCLN,SDENR)=""

 +8                                DO LOOP1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +9        DO ^SDYCENR1

 +10       QUIT 

 +11      ;

LOOP1     ; Find inactive enrollments with no date of discharge

 +1        IF ($PIECE(SDCLIN,U,2)="I"&('$PIECE(SDENROL,U,3)))

               SET SDPT=$GET(^DPT(SDPAT,0))

               if SDPT=""

                   QUIT 

               Begin DoDot:1

 +2                SET ^TMP("EN2",$JOB,$PIECE(SDPT,U),$PIECE(SDPT,U,9),$PIECE($GET(^SC(+SDCLIN,0)),U))=""

               End DoDot:1

 +3        QUIT 

WRT       ;

 +1        WRITE !,"The following will provide a listing which will include patients that "

 +2        WRITE !,"have an inactive enrollment with no date of discharge.  Because the "

 +3        WRITE !,"date of discharge cannot be automatically determined, the dates of "

 +4        WRITE !,"discharge will have to be entered manually via the 'Edit Clinic "

 +5        WRITE !,"Enrollment Data' option.",!

 +6        QUIT 

 +7       ;

QUE()     ; -- que job

 +1       ; return: did job que [ 1|yes   0|no ]

 +2       ;

 +3        KILL ZTSK,IO("Q")

 +4        SET ZTDESC="Enrollment Information Report"

           SET ZTRTN="LOOP^SDYCENR"

 +5        SET (ZTSAVE("SDPAGE"),ZTSAVE("SDASH"),ZTSAVE("SDQUIT"))=""

 +6        DO ^%ZTLOAD

           if $DATA(ZTSK)

               WRITE "   (Task: ",ZTSK,")"

 +7        QUIT $DATA(ZTSK)