SDYCENR1 ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94
 ;;5.3;Scheduling;**21**;Aug 13, 1993
 ;
PRINT ;Print enrollment reports
 ;
 N SDPAT,SDCLIN,SDSOC S SDPAT=0
 S (SDPAGE,SDPAT)=0 D CHECK
 I '$D(^TMP("EN2",$J)) D CHECK,NO G PRINTQ
 F  S SDPAT=$O(^TMP("EN2",$J,SDPAT)) Q:SDPAT=""!(SDQUIT)  D
 .S SDSOC=0 F  S SDSOC=$O(^TMP("EN2",$J,SDPAT,SDSOC)) Q:'SDSOC!(SDQUIT)  D
 ..S SDCLIN=0
 ..F  S SDCLIN=$O(^TMP("EN2",$J,SDPAT,SDSOC,SDCLIN)) Q:SDCLIN=""!(SDQUIT)  D
 ...W !,$E(SDPAT,1,35),?37,SDSOC,?49,$E(SDCLIN,1,30)
 ...D CHECK Q:SDQUIT
PRINTQ K ^TMP("EN2",$J)
 Q
 ;
CHECK ; check to see if header should be printed
 I 'SDPAGE W @IOF D HDR Q
 I $E(IOST,1,2)="C-",($Y+6)>IOSL D PAUSE^VALM1 I 'Y S SDQUIT=1 Q
 I ($Y+6)>IOSL W @IOF D HDR
 Q
 ;
HDR ; Header
 ;
 U IO S SDPAGE=SDPAGE+1
 W !,"Patients with inactive enrollments and no Date of Discharge"
 W ?70,"Page: ",SDPAGE
 W !,"PATIENT",?37,"PATIENT ID",?49,"CLINIC",?70,$$FDATE^VALM1(DT),!,SDASH,!
 Q
NO ; No entries found
 ;
 W !,"No inactive enrollments with missing discharge dates found."
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDYCENR1   1070     printed  Sep 23, 2025@20:40:32                                                                                                                                                                                                    Page 2
SDYCENR1  ;ALB/CAW - CLINIC ENROLLMENT ; 7/18/94
 +1       ;;5.3;Scheduling;**21**;Aug 13, 1993
 +2       ;
PRINT     ;Print enrollment reports
 +1       ;
 +2        NEW SDPAT,SDCLIN,SDSOC
           SET SDPAT=0
 +3        SET (SDPAGE,SDPAT)=0
           DO CHECK
 +4        IF '$DATA(^TMP("EN2",$JOB))
               DO CHECK
               DO NO
               GOTO PRINTQ
 +5        FOR 
               SET SDPAT=$ORDER(^TMP("EN2",$JOB,SDPAT))
               if SDPAT=""!(SDQUIT)
                   QUIT 
               Begin DoDot:1
 +6                SET SDSOC=0
                   FOR 
                       SET SDSOC=$ORDER(^TMP("EN2",$JOB,SDPAT,SDSOC))
                       if 'SDSOC!(SDQUIT)
                           QUIT 
                       Begin DoDot:2
 +7                        SET SDCLIN=0
 +8                        FOR 
                               SET SDCLIN=$ORDER(^TMP("EN2",$JOB,SDPAT,SDSOC,SDCLIN))
                               if SDCLIN=""!(SDQUIT)
                                   QUIT 
                               Begin DoDot:3
 +9                                WRITE !,$EXTRACT(SDPAT,1,35),?37,SDSOC,?49,$EXTRACT(SDCLIN,1,30)
 +10                               DO CHECK
                                   if SDQUIT
                                       QUIT 
                               End DoDot:3
                       End DoDot:2
               End DoDot:1
PRINTQ     KILL ^TMP("EN2",$JOB)
 +1        QUIT 
 +2       ;
CHECK     ; check to see if header should be printed
 +1        IF 'SDPAGE
               WRITE @IOF
               DO HDR
               QUIT 
 +2        IF $EXTRACT(IOST,1,2)="C-"
               IF ($Y+6)>IOSL
                   DO PAUSE^VALM1
                   IF 'Y
                       SET SDQUIT=1
                       QUIT 
 +3        IF ($Y+6)>IOSL
               WRITE @IOF
               DO HDR
 +4        QUIT 
 +5       ;
HDR       ; Header
 +1       ;
 +2        USE IO
           SET SDPAGE=SDPAGE+1
 +3        WRITE !,"Patients with inactive enrollments and no Date of Discharge"
 +4        WRITE ?70,"Page: ",SDPAGE
 +5        WRITE !,"PATIENT",?37,"PATIENT ID",?49,"CLINIC",?70,$$FDATE^VALM1(DT),!,SDASH,!
 +6        QUIT 
NO        ; No entries found
 +1       ;
 +2        WRITE !,"No inactive enrollments with missing discharge dates found."
 +3        QUIT