1 | SDYCENR ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94
|
---|
2 | ;;5.3;Scheduling;**21**;Aug 13, 1993
|
---|
3 | ;
|
---|
4 | EN N SDFLAG,SDASH,SDPAGE,SDQUIT
|
---|
5 | D WRT,INIT
|
---|
6 | S %ZIS="PMQ" D ^%ZIS I POP G ENQ
|
---|
7 | I '$D(IO("Q")) D LOOP G ENQ
|
---|
8 | S Y=$$QUE
|
---|
9 | ENQ K SDASH,SDPAGE,SDQUIT
|
---|
10 | D:'$D(ZTQUEUED) ^%ZISC Q
|
---|
11 | ;
|
---|
12 | INIT ; Init variables
|
---|
13 | S $P(SDASH,"=",80)="",SDPAGE=0,SDQUIT=0
|
---|
14 | Q
|
---|
15 | LOOP ; Loop through the enrollment info
|
---|
16 | N SDCLIN,SDCLN,SDENR,SDENROL,SDPAT
|
---|
17 | K ^DPT("AEB1")
|
---|
18 | K ^TMP("EN2",$J) S SDPAT=0
|
---|
19 | F S SDPAT=$O(^DPT(SDPAT)) Q:'SDPAT D
|
---|
20 | .S SDCLN=0 F S SDCLN=$O(^DPT(SDPAT,"DE",SDCLN)) Q:'SDCLN S SDCLIN=^(SDCLN,0) D
|
---|
21 | ..S SDENR=0 F S SDENR=$O(^DPT(SDPAT,"DE",SDCLN,1,SDENR)) Q:'SDENR S SDENROL=^(SDENR,0) D
|
---|
22 | ...S ^DPT("AEB1",+SDCLIN,+SDENROL,SDPAT,SDCLN,SDENR)=""
|
---|
23 | ...D LOOP1
|
---|
24 | D ^SDYCENR1
|
---|
25 | Q
|
---|
26 | ;
|
---|
27 | LOOP1 ; Find inactive enrollments with no date of discharge
|
---|
28 | I ($P(SDCLIN,U,2)="I"&('$P(SDENROL,U,3))) S SDPT=$G(^DPT(SDPAT,0)) Q:SDPT="" D
|
---|
29 | .S ^TMP("EN2",$J,$P(SDPT,U),$P(SDPT,U,9),$P($G(^SC(+SDCLIN,0)),U))=""
|
---|
30 | Q
|
---|
31 | WRT ;
|
---|
32 | W !,"The following will provide a listing which will include patients that "
|
---|
33 | W !,"have an inactive enrollment with no date of discharge. Because the "
|
---|
34 | W !,"date of discharge cannot be automatically determined, the dates of "
|
---|
35 | W !,"discharge will have to be entered manually via the 'Edit Clinic "
|
---|
36 | W !,"Enrollment Data' option.",!
|
---|
37 | Q
|
---|
38 | ;
|
---|
39 | QUE() ; -- que job
|
---|
40 | ; return: did job que [ 1|yes 0|no ]
|
---|
41 | ;
|
---|
42 | K ZTSK,IO("Q")
|
---|
43 | S ZTDESC="Enrollment Information Report",ZTRTN="LOOP^SDYCENR"
|
---|
44 | S (ZTSAVE("SDPAGE"),ZTSAVE("SDASH"),ZTSAVE("SDQUIT"))=""
|
---|
45 | D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
|
---|
46 | Q $D(ZTSK)
|
---|