SDYCENR1.m

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 ---SDYCENR1   1070     printed  Apr 09, 2024@21:54:58                                                                                                                                                                                                    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