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