source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDYCENR.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1SDYCENR ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94
2 ;;5.3;Scheduling;**21**;Aug 13, 1993
3 ;
4EN 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
9ENQ K SDASH,SDPAGE,SDQUIT
10 D:'$D(ZTQUEUED) ^%ZISC Q
11 ;
12INIT ; Init variables
13 S $P(SDASH,"=",80)="",SDPAGE=0,SDQUIT=0
14 Q
15LOOP ; 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 ;
27LOOP1 ; 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
31WRT ;
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 ;
39QUE() ; -- 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)
Note: See TracBrowser for help on using the repository browser.