Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDYCENR1

SDYCENR1.m

Go to the documentation of this file.
  1. SDYCENR1 ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94
  1. ;;5.3;Scheduling;**21**;Aug 13, 1993
  1. ;
  1. PRINT ;Print enrollment reports
  1. ;
  1. N SDPAT,SDCLIN,SDSOC S SDPAT=0
  1. S (SDPAGE,SDPAT)=0 D CHECK
  1. I '$D(^TMP("EN2",$J)) D CHECK,NO G PRINTQ
  1. F S SDPAT=$O(^TMP("EN2",$J,SDPAT)) Q:SDPAT=""!(SDQUIT) D
  1. .S SDSOC=0 F S SDSOC=$O(^TMP("EN2",$J,SDPAT,SDSOC)) Q:'SDSOC!(SDQUIT) D
  1. ..S SDCLIN=0
  1. ..F S SDCLIN=$O(^TMP("EN2",$J,SDPAT,SDSOC,SDCLIN)) Q:SDCLIN=""!(SDQUIT) D
  1. ...W !,$E(SDPAT,1,35),?37,SDSOC,?49,$E(SDCLIN,1,30)
  1. ...D CHECK Q:SDQUIT
  1. PRINTQ K ^TMP("EN2",$J)
  1. Q
  1. ;
  1. CHECK ; check to see if header should be printed
  1. I 'SDPAGE W @IOF D HDR Q
  1. I $E(IOST,1,2)="C-",($Y+6)>IOSL D PAUSE^VALM1 I 'Y S SDQUIT=1 Q
  1. I ($Y+6)>IOSL W @IOF D HDR
  1. Q
  1. ;
  1. HDR ; Header
  1. ;
  1. U IO S SDPAGE=SDPAGE+1
  1. W !,"Patients with inactive enrollments and no Date of Discharge"
  1. W ?70,"Page: ",SDPAGE
  1. W !,"PATIENT",?37,"PATIENT ID",?49,"CLINIC",?70,$$FDATE^VALM1(DT),!,SDASH,!
  1. Q
  1. NO ; No entries found
  1. ;
  1. W !,"No inactive enrollments with missing discharge dates found."
  1. Q