- 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 Jan 18, 2025@04:04:51 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