source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDYCENR1.m@ 1710

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

initial load of WorldVistAEHR

File size: 1.0 KB
RevLine 
[613]1SDYCENR1 ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94
2 ;;5.3;Scheduling;**21**;Aug 13, 1993
3 ;
4PRINT ;Print enrollment reports
5 ;
6 N SDPAT,SDCLIN,SDSOC S SDPAT=0
7 S (SDPAGE,SDPAT)=0 D CHECK
8 I '$D(^TMP("EN2",$J)) D CHECK,NO G PRINTQ
9 F S SDPAT=$O(^TMP("EN2",$J,SDPAT)) Q:SDPAT=""!(SDQUIT) D
10 .S SDSOC=0 F S SDSOC=$O(^TMP("EN2",$J,SDPAT,SDSOC)) Q:'SDSOC!(SDQUIT) D
11 ..S SDCLIN=0
12 ..F S SDCLIN=$O(^TMP("EN2",$J,SDPAT,SDSOC,SDCLIN)) Q:SDCLIN=""!(SDQUIT) D
13 ...W !,$E(SDPAT,1,35),?37,SDSOC,?49,$E(SDCLIN,1,30)
14 ...D CHECK Q:SDQUIT
15PRINTQ K ^TMP("EN2",$J)
16 Q
17 ;
18CHECK ; check to see if header should be printed
19 I 'SDPAGE W @IOF D HDR Q
20 I $E(IOST,1,2)="C-",($Y+6)>IOSL D PAUSE^VALM1 I 'Y S SDQUIT=1 Q
21 I ($Y+6)>IOSL W @IOF D HDR
22 Q
23 ;
24HDR ; Header
25 ;
26 U IO S SDPAGE=SDPAGE+1
27 W !,"Patients with inactive enrollments and no Date of Discharge"
28 W ?70,"Page: ",SDPAGE
29 W !,"PATIENT",?37,"PATIENT ID",?49,"CLINIC",?70,$$FDATE^VALM1(DT),!,SDASH,!
30 Q
31NO ; No entries found
32 ;
33 W !,"No inactive enrollments with missing discharge dates found."
34 Q
Note: See TracBrowser for help on using the repository browser.