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 ---[H[J[2J[HSDYCENR 1613 printed Dec 13, 2024@03:03:41 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)
