EHMDISH1 ;ALB/WTC - EHRM - AUTOMATED PATIENT DISCHARGE TOOL; Feb 25, 2025@11:33:31
;;1.0;ELECTRONIC HEALTH MODERNIZATION;**15**;Apr 19, 2021;Build 14
;
; Use of SDAPI^SDAMA301 is through icr #4433 (supported)
;
Q ;
;
INAPPT ;
;
; List inpatient appointments for patients eligible for discharge. To be used at time of conversion to Millennium.
;
N WARD,DFN,VADM,FIRST,PTNAME,SORTBY,INSTFLTR,DIR,Y,X,DIRUT,CONVDATE,INSTUTN,IEN,INSTNAME,QUEUED,LINES,QUIT,STATION,POP,WARDFLTR,SSN4,APPTDTTM ;
;
S INSTFLTR=$$INSTFLTR^EHMDISCH() Q:INSTFLTR="" ;
S WARDFLTR="" I $P(INSTFLTR,U,1)="S" S WARDFLTR=$$WARDFLTR^EHMDISCH($P(INSTFLTR,U,2)) ;
;
S DIR(0)="S^WARD:Ward;PATIENT:Patient",DIR("A")="Sort by" D ^DIR Q:$D(DIRUT) S SORTBY=Y ;
;
K DIR S DIR(0)="D^:"_DT_":EX",DIR("A")="Conversion Date",DIR("B")=$$FMTE^XLFDT(DT) D ^DIR Q:$D(DIRUT) "" S CONVDATE=Y ;
;
W !!,"Report is 132 columns wide",! ;
S %ZIS="Q" D ^%ZIS I POP Q ;
;
; If report is queued, add to Taskman
;
S QUEUED=0 I $D(IO("Q")) S QUEUED=1 D Q ;
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
. S ZTRTN="INAPPT1^EHMDISH1",ZTDESC="Patient Discharge List - Inpatient Appointments" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
INAPPT1 ; TaskMan start point
;
I 'QUEUED,SORTBY="WARD" W !,"Sorting patients within ward..." ;
I 'QUEUED,SORTBY="PATIENT" W !,"Sorting patients..." ;
K ^TMP($J) ;
;
D BLDLIST(SORTBY,INSTFLTR,WARDFLTR,CONVDATE,QUEUED) ;
U IO ;
;
I SORTBY="WARD" D ;
. S INSTUTN="",QUIT=0 F S INSTUTN=$O(^TMP($J,INSTUTN)) Q:INSTUTN="" D Q:QUIT ;
.. S INSTNAME=$P(INSTUTN,U,1),IEN=$P(INSTUTN,U,2),STATION=$$GET1^DIQ(4,IEN,99) D HEADER(INSTNAME,STATION,SORTBY) ;
.. S WARD="",LINES=0 F S WARD=$O(^TMP($J,INSTUTN,WARD)) Q:WARD="" D Q:QUIT ;
... ;D HEADER(INSTNAME,STATION,SORTBY) ;
... S PTNAME="" ;
... F S PTNAME=$O(^TMP($J,INSTUTN,WARD,PTNAME)) Q:PTNAME="" Q:QUIT D ;
.... S DFN=0 F S DFN=$O(^TMP($J,INSTUTN,WARD,PTNAME,DFN)) Q:'DFN S SSN4=^(DFN),APPTDTTM=0,FIRST=1 F S APPTDTTM=$O(^TMP($J,INSTUTN,WARD,PTNAME,DFN,APPTDTTM)) Q:'APPTDTTM S X=^(APPTDTTM) D S FIRST=0 Q:QUIT ;
..... ;
..... I 'QUEUED D PAGINATE(.QUIT,INSTNAME,STATION,SORTBY,.LINES) Q:QUIT ;
..... ;
..... W $S(FIRST:WARD,1:""),?32,PTNAME,?64,SSN4,?70,$$GET1^DIQ(44,$P(X,U,1),.01),?102,$$DATETIME^EHMDISCH(APPTDTTM),! S LINES=LINES+1,FIRST=0 ;
.... W ! S LINES=LINES+1 ;
.. ;
.. I 'QUEUED,'QUIT S QUIT=$$CONTINUE^EHMDISCH()=0 ;
;
I SORTBY="PATIENT" D ;
. S INSTUTN="",QUIT=0 F S INSTUTN=$O(^TMP($J,INSTUTN)) Q:INSTUTN="" D Q:QUIT ;
.. S INSTNAME=$P(INSTUTN,U,1),IEN=$P(INSTUTN,U,2),STATION=$$GET1^DIQ(4,IEN,99) D HEADER(INSTNAME,STATION,SORTBY) ;
.. S PTNAME="",LINES=0 F S PTNAME=$O(^TMP($J,INSTUTN,PTNAME)) Q:PTNAME="" D Q:QUIT ;
... S DFN=0 F S DFN=$O(^TMP($J,INSTUTN,PTNAME,DFN)) Q:'DFN S SSN4=^(DFN),APPTDTTM=0,LINES=LINES+1 W ! F S APPTDTTM=$O(^TMP($J,INSTUTN,PTNAME,DFN,APPTDTTM)) Q:'APPTDTTM S X=^(APPTDTTM) D Q:QUIT ;
.... ;
.... I 'QUEUED D PAGINATE(.QUIT,INSTNAME,STATION,SORTBY,.LINES) Q:QUIT ;
.... ;
.... W PTNAME,?32,SSN4,?38,$$GET1^DIQ(44,$P(X,U,1),.01),?70,$$DATETIME^EHMDISCH(APPTDTTM),! S LINES=LINES+1 ;
.. ;
.. I 'QUEUED,'QUIT S QUIT=$$CONTINUE^EHMDISCH()=0 ;
;
I QUIT W ! ;
U 0 I 'QUEUED,IO=$I R !,"Press [RETURN] to continue",X:$G(DTIME,300) ;
K ^TMP($J) D ^%ZISC ;
Q ;
;
BLDLIST(SORTBY,INSTFLTR,WARDFLTR,CONVDATE,QUEUED) ;
;
; Build sorted list of patients to be discharged in ^TMP($J).
;
; INSTFLTR = "A" if all institutions are included or "S^ien" if a single institution included. "ien" points to file #4.
; SORTBY = "WARD" or "PATIENT"
; QUEUED = 1 if report is queued, 0 otherwise.
;
N WARD,IEN,INSTUTN,INSTNAME,DFN,ADMPTR,VADM,APPTDTTM,X,SSN4,INCLUDE,SDA,COUNT,SDIEN ;
;
K ^TMP($J) S WARD="" F S WARD=$O(^DPT("CN",WARD)) Q:WARD="" D ;
. I $G(WARDFLTR)'="" Q:$P(^SC(WARDFLTR,0),U,1)'=WARD ;
. S IEN=$O(^SC("B",WARD,0)) Q:'IEN S INSTUTN=$P($G(^SC(IEN,0)),U,4) Q:'INSTUTN I $P(INSTFLTR,U,1)="S" Q:$P(INSTFLTR,U,2)'=INSTUTN ;
. S INSTNAME=$P(^DIC(4,INSTUTN,0),U,1) ;
. W:'QUEUED "." S DFN=0 F S DFN=$O(^DPT("CN",WARD,DFN)) Q:'DFN S ADMPTR=^(DFN) D ;
.. ;
.. K VADM D DEM^VADPT S SSN4=$G(VADM(2)) I SSN4'="" S SSN4=$E($P(SSN4,U,1),6,9) ;
.. ;
.. I SORTBY="WARD" D ;
... K SDA S SDA(1)=CONVDATE,SDA(3)="R;I",SDA(4)=DFN,SDA("MAX")=1000,SDA("FLDS")="3" ;
... S COUNT=$$SDAPI^SDAMA301(.SDA) Q:'COUNT S ^TMP($J,INSTNAME_U_INSTUTN,WARD,VADM(1),DFN)=SSN4 ; icr #4433
... S SDIEN=0 F S SDIEN=$O(^TMP($J,"SDAMA301",DFN,SDIEN)) Q:'SDIEN S APPTDTTM=0 D ;
.... F S APPTDTTM=$O(^TMP($J,"SDAMA301",DFN,SDIEN,APPTDTTM)) Q:'APPTDTTM S ^TMP($J,INSTNAME_U_INSTUTN,WARD,VADM(1),DFN,APPTDTTM)=SDIEN ;
... K ^TMP($J,"SDAMA301") ;
.. ;
.. I SORTBY="PATIENT" D ;
... K SDA S SDA(1)=CONVDATE,SDA(3)="R;I",SDA(4)=DFN,SDA("MAX")=1000,SDA("FLDS")="3" ;
... S COUNT=$$SDAPI^SDAMA301(.SDA) Q:'COUNT S ^TMP($J,INSTNAME_U_INSTUTN,VADM(1),DFN)=SSN4 ; icr #4433
... S SDIEN=0 F S SDIEN=$O(^TMP($J,"SDAMA301",DFN,SDIEN)) Q:'SDIEN S APPTDTTM=0 D ;
.... F S APPTDTTM=$O(^TMP($J,"SDAMA301",DFN,SDIEN,APPTDTTM)) Q:'APPTDTTM S ^TMP($J,INSTNAME_U_INSTUTN,VADM(1),DFN,APPTDTTM)=SDIEN ;
... K ^TMP($J,"SDAMA301") ;
Q ;
;
;
W @IOF,$$CENTER^EHMDISCH("Patient Discharge List - Inpatient Appointments",IOM),?IOM-8,$$FMTE^XLFDT(DT,2),!,$$CENTER^EHMDISCH(INSTNAME_" ("_STATION_")",IOM),!! ;
I SORTBY="WARD" D ;
. W "WARD",?32,"PATIENT",?64,"SSN4",?70,"CLINIC",?102,"APPOINTMENT DATE/TIME",! ;
. W $$DASHES^EHMDISCH(30),?32,$$DASHES^EHMDISCH(30),?64,$$DASHES^EHMDISCH(4),?70,$$DASHES^EHMDISCH(30),?102,$$DASHES^EHMDISCH(21),! ;
;
I SORTBY="PATIENT" D ;
. W "PATIENT",?32,"SSN4",?38,"CLINIC",?70,"APPOINTMENT DATE/TIME",! ;
. W $$DASHES^EHMDISCH(30),?32,$$DASHES^EHMDISCH(4),?38,$$DASHES^EHMDISCH(30),?70,$$DASHES^EHMDISCH(21),! ;
Q ;
;
PAGINATE(QUIT,INSTNAME,STATION,SORTBY,LINES) ;
;
; If report displayed on screen, stop when screen full and prompt user to continue or stop.
;
U 0 ;
I IO=$I Q:LINES<(IOSL-7) S QUIT=$$CONTINUE^EHMDISCH()=0 Q:QUIT U IO D HEADER(INSTNAME,STATION,SORTBY) S LINES=1 Q ;
;
; New page header for printed report
;
I LINES'<IOSL U IO D HEADER(INSTNAME,STATION,SORTBY) S LINES=1 ;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEHMDISH1 6425 printed Jul 11, 2026@01:48:12 Page 2
EHMDISH1 ;ALB/WTC - EHRM - AUTOMATED PATIENT DISCHARGE TOOL; Feb 25, 2025@11:33:31
+1 ;;1.0;ELECTRONIC HEALTH MODERNIZATION;**15**;Apr 19, 2021;Build 14
+2 ;
+3 ; Use of SDAPI^SDAMA301 is through icr #4433 (supported)
+4 ;
+5 ;
QUIT
+6 ;
INAPPT ;
+1 ;
+2 ; List inpatient appointments for patients eligible for discharge. To be used at time of conversion to Millennium.
+3 ;
+4 ;
NEW WARD,DFN,VADM,FIRST,PTNAME,SORTBY,INSTFLTR,DIR,Y,X,DIRUT,CONVDATE,INSTUTN,IEN,INSTNAME,QUEUED,LINES,QUIT,STATION,POP,WARDFLTR,SSN4,APPTDTTM
+5 ;
+6 ;
SET INSTFLTR=$$INSTFLTR^EHMDISCH()
if INSTFLTR=""
QUIT
+7 ;
SET WARDFLTR=""
IF $PIECE(INSTFLTR,U,1)="S"
SET WARDFLTR=$$WARDFLTR^EHMDISCH($PIECE(INSTFLTR,U,2))
+8 ;
+9 ;
SET DIR(0)="S^WARD:Ward;PATIENT:Patient"
SET DIR("A")="Sort by"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET SORTBY=Y
+10 ;
+11 ;
KILL DIR
SET DIR(0)="D^:"_DT_":EX"
SET DIR("A")="Conversion Date"
SET DIR("B")=$$FMTE^XLFDT(DT)
DO ^DIR
if $DATA(DIRUT)
QUIT ""
SET CONVDATE=Y
+12 ;
+13 ;
WRITE !!,"Report is 132 columns wide",!
+14 ;
SET %ZIS="Q"
DO ^%ZIS
IF POP
QUIT
+15 ;
+16 ; If report is queued, add to Taskman
+17 ;
+18 ;
SET QUEUED=0
IF $DATA(IO("Q"))
SET QUEUED=1
Begin DoDot:1
+19 ;
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+20 ;
SET ZTRTN="INAPPT1^EHMDISH1"
SET ZTDESC="Patient Discharge List - Inpatient Appointments"
+21 ;
SET ZTSAVE("*")=""
+22 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+23 ;
INAPPT1 ; TaskMan start point
+1 ;
+2 ;
IF 'QUEUED
IF SORTBY="WARD"
WRITE !,"Sorting patients within ward..."
+3 ;
IF 'QUEUED
IF SORTBY="PATIENT"
WRITE !,"Sorting patients..."
+4 ;
KILL ^TMP($JOB)
+5 ;
+6 ;
DO BLDLIST(SORTBY,INSTFLTR,WARDFLTR,CONVDATE,QUEUED)
+7 ;
USE IO
+8 ;
+9 ;
IF SORTBY="WARD"
Begin DoDot:1
+10 ;
SET INSTUTN=""
SET QUIT=0
FOR
SET INSTUTN=$ORDER(^TMP($JOB,INSTUTN))
if INSTUTN=""
QUIT
Begin DoDot:2
+11 ;
SET INSTNAME=$PIECE(INSTUTN,U,1)
SET IEN=$PIECE(INSTUTN,U,2)
SET STATION=$$GET1^DIQ(4,IEN,99)
DO HEADER(INSTNAME,STATION,SORTBY)
+12 ;
SET WARD=""
SET LINES=0
FOR
SET WARD=$ORDER(^TMP($JOB,INSTUTN,WARD))
if WARD=""
QUIT
Begin DoDot:3
+13 ;D HEADER(INSTNAME,STATION,SORTBY) ;
+14 ;
SET PTNAME=""
+15 ;
FOR
SET PTNAME=$ORDER(^TMP($JOB,INSTUTN,WARD,PTNAME))
if PTNAME=""
QUIT
if QUIT
QUIT
Begin DoDot:4
+16 ;
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,INSTUTN,WARD,PTNAME,DFN))
if 'DFN
QUIT
SET SSN4=^(DFN)
SET APPTDTTM=0
SET FIRST=1
FOR
SET APPTDTTM=$ORDER(^TMP($JOB,INSTUTN,WARD,PTNAME,DFN,APPTDTTM))
if 'APPTDTTM
QUIT
SET X=^(APPTDTTM)
Begin DoDot:5
+17 ;
+18 ;
IF 'QUEUED
DO PAGINATE(.QUIT,INSTNAME,STATION,SORTBY,.LINES)
if QUIT
QUIT
+19 ;
+20 ;
WRITE $SELECT(FIRST:WARD,1:""),?32,PTNAME,?64,SSN4,?70,$$GET1^DIQ(44,$PIECE(X,U,1),.01),?102,$$DATETIME^EHMDISCH(APPTDTTM),!
SET LINES=LINES+1
SET FIRST=0
End DoDot:5
SET FIRST=0
if QUIT
QUIT
+21 ;
WRITE !
SET LINES=LINES+1
End DoDot:4
End DoDot:3
if QUIT
QUIT
+22 ;
+23 ;
IF 'QUEUED
IF 'QUIT
SET QUIT=$$CONTINUE^EHMDISCH()=0
End DoDot:2
if QUIT
QUIT
End DoDot:1
+24 ;
+25 ;
IF SORTBY="PATIENT"
Begin DoDot:1
+26 ;
SET INSTUTN=""
SET QUIT=0
FOR
SET INSTUTN=$ORDER(^TMP($JOB,INSTUTN))
if INSTUTN=""
QUIT
Begin DoDot:2
+27 ;
SET INSTNAME=$PIECE(INSTUTN,U,1)
SET IEN=$PIECE(INSTUTN,U,2)
SET STATION=$$GET1^DIQ(4,IEN,99)
DO HEADER(INSTNAME,STATION,SORTBY)
+28 ;
SET PTNAME=""
SET LINES=0
FOR
SET PTNAME=$ORDER(^TMP($JOB,INSTUTN,PTNAME))
if PTNAME=""
QUIT
Begin DoDot:3
+29 ;
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,INSTUTN,PTNAME,DFN))
if 'DFN
QUIT
SET SSN4=^(DFN)
SET APPTDTTM=0
SET LINES=LINES+1
WRITE !
FOR
SET APPTDTTM=$ORDER(^TMP($JOB,INSTUTN,PTNAME,DFN,APPTDTTM))
if 'APPTDTTM
QUIT
SET X=^(APPTDTTM)
Begin DoDot:4
+30 ;
+31 ;
IF 'QUEUED
DO PAGINATE(.QUIT,INSTNAME,STATION,SORTBY,.LINES)
if QUIT
QUIT
+32 ;
+33 ;
WRITE PTNAME,?32,SSN4,?38,$$GET1^DIQ(44,$PIECE(X,U,1),.01),?70,$$DATETIME^EHMDISCH(APPTDTTM),!
SET LINES=LINES+1
End DoDot:4
if QUIT
QUIT
End DoDot:3
if QUIT
QUIT
+34 ;
+35 ;
IF 'QUEUED
IF 'QUIT
SET QUIT=$$CONTINUE^EHMDISCH()=0
End DoDot:2
if QUIT
QUIT
End DoDot:1
+36 ;
+37 ;
IF QUIT
WRITE !
+38 ;
USE 0
IF 'QUEUED
IF IO=$IO
READ !,"Press [RETURN] to continue",X:$GET(DTIME,300)
+39 ;
KILL ^TMP($JOB)
DO ^%ZISC
+40 ;
QUIT
+41 ;
BLDLIST(SORTBY,INSTFLTR,WARDFLTR,CONVDATE,QUEUED) ;
+1 ;
+2 ; Build sorted list of patients to be discharged in ^TMP($J).
+3 ;
+4 ; INSTFLTR = "A" if all institutions are included or "S^ien" if a single institution included. "ien" points to file #4.
+5 ; SORTBY = "WARD" or "PATIENT"
+6 ; QUEUED = 1 if report is queued, 0 otherwise.
+7 ;
+8 ;
NEW WARD,IEN,INSTUTN,INSTNAME,DFN,ADMPTR,VADM,APPTDTTM,X,SSN4,INCLUDE,SDA,COUNT,SDIEN
+9 ;
+10 ;
KILL ^TMP($JOB)
SET WARD=""
FOR
SET WARD=$ORDER(^DPT("CN",WARD))
if WARD=""
QUIT
Begin DoDot:1
+11 ;
IF $GET(WARDFLTR)'=""
if $PIECE(^SC(WARDFLTR,0),U,1)'=WARD
QUIT
+12 ;
SET IEN=$ORDER(^SC("B",WARD,0))
if 'IEN
QUIT
SET INSTUTN=$PIECE($GET(^SC(IEN,0)),U,4)
if 'INSTUTN
QUIT
IF $PIECE(INSTFLTR,U,1)="S"
if $PIECE(INSTFLTR,U,2)'=INSTUTN
QUIT
+13 ;
SET INSTNAME=$PIECE(^DIC(4,INSTUTN,0),U,1)
+14 ;
if 'QUEUED
WRITE "."
SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",WARD,DFN))
if 'DFN
QUIT
SET ADMPTR=^(DFN)
Begin DoDot:2
+15 ;
+16 ;
KILL VADM
DO DEM^VADPT
SET SSN4=$GET(VADM(2))
IF SSN4'=""
SET SSN4=$EXTRACT($PIECE(SSN4,U,1),6,9)
+17 ;
+18 ;
IF SORTBY="WARD"
Begin DoDot:3
+19 ;
KILL SDA
SET SDA(1)=CONVDATE
SET SDA(3)="R;I"
SET SDA(4)=DFN
SET SDA("MAX")=1000
SET SDA("FLDS")="3"
+20 ; icr #4433
SET COUNT=$$SDAPI^SDAMA301(.SDA)
if 'COUNT
QUIT
SET ^TMP($JOB,INSTNAME_U_INSTUTN,WARD,VADM(1),DFN)=SSN4
+21 ;
SET SDIEN=0
FOR
SET SDIEN=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDIEN))
if 'SDIEN
QUIT
SET APPTDTTM=0
Begin DoDot:4
+22 ;
FOR
SET APPTDTTM=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDIEN,APPTDTTM))
if 'APPTDTTM
QUIT
SET ^TMP($JOB,INSTNAME_U_INSTUTN,WARD,VADM(1),DFN,APPTDTTM)=SDIEN
End DoDot:4
+23 ;
KILL ^TMP($JOB,"SDAMA301")
End DoDot:3
+24 ;
+25 ;
IF SORTBY="PATIENT"
Begin DoDot:3
+26 ;
KILL SDA
SET SDA(1)=CONVDATE
SET SDA(3)="R;I"
SET SDA(4)=DFN
SET SDA("MAX")=1000
SET SDA("FLDS")="3"
+27 ; icr #4433
SET COUNT=$$SDAPI^SDAMA301(.SDA)
if 'COUNT
QUIT
SET ^TMP($JOB,INSTNAME_U_INSTUTN,VADM(1),DFN)=SSN4
+28 ;
SET SDIEN=0
FOR
SET SDIEN=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDIEN))
if 'SDIEN
QUIT
SET APPTDTTM=0
Begin DoDot:4
+29 ;
FOR
SET APPTDTTM=$ORDER(^TMP($JOB,"SDAMA301",DFN,SDIEN,APPTDTTM))
if 'APPTDTTM
QUIT
SET ^TMP($JOB,INSTNAME_U_INSTUTN,VADM(1),DFN,APPTDTTM)=SDIEN
End DoDot:4
+30 ;
KILL ^TMP($JOB,"SDAMA301")
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
QUIT
+32 ;
+1 ;
+2 ;
WRITE @IOF,$$CENTER^EHMDISCH("Patient Discharge List - Inpatient Appointments",IOM),?IOM-8,$$FMTE^XLFDT(DT,2),!,$$CENTER^EHMDISCH(INSTNAME_" ("_STATION_")",IOM),!!
+3 ;
IF SORTBY="WARD"
Begin DoDot:1
+4 ;
WRITE "WARD",?32,"PATIENT",?64,"SSN4",?70,"CLINIC",?102,"APPOINTMENT DATE/TIME",!
+5 ;
WRITE $$DASHES^EHMDISCH(30),?32,$$DASHES^EHMDISCH(30),?64,$$DASHES^EHMDISCH(4),?70,$$DASHES^EHMDISCH(30),?102,$$DASHES^EHMDISCH(21),!
End DoDot:1
+6 ;
+7 ;
IF SORTBY="PATIENT"
Begin DoDot:1
+8 ;
WRITE "PATIENT",?32,"SSN4",?38,"CLINIC",?70,"APPOINTMENT DATE/TIME",!
+9 ;
WRITE $$DASHES^EHMDISCH(30),?32,$$DASHES^EHMDISCH(4),?38,$$DASHES^EHMDISCH(30),?70,$$DASHES^EHMDISCH(21),!
End DoDot:1
+10 ;
QUIT
+11 ;
PAGINATE(QUIT,INSTNAME,STATION,SORTBY,LINES) ;
+1 ;
+2 ; If report displayed on screen, stop when screen full and prompt user to continue or stop.
+3 ;
+4 ;
USE 0
+5 ;
IF IO=$IO
if LINES<(IOSL-7)
QUIT
SET QUIT=$$CONTINUE^EHMDISCH()=0
if QUIT
QUIT
USE IO
DO HEADER(INSTNAME,STATION,SORTBY)
SET LINES=1
QUIT
+6 ;
+7 ; New page header for printed report
+8 ;
+9 ;
IF LINES'<IOSL
USE IO
DO HEADER(INSTNAME,STATION,SORTBY)
SET LINES=1
+10 ;
QUIT
+11 ;
