| 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)
 | 
|---|