| [613] | 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)
 | 
|---|