SDSCRPT2 ;ALB/JAM/RBS - ASCD SB/Reports for Service Connected Automated Monitor ;3/5/07 12:11pm
;;5.3;Scheduling;**495,586**;Aug 13, 1993;Build 28
;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
;;known as Service Connected Automated Monitoring (SCAM).
;
; Routine should be called at specified tags only.
; Reference to $$ICDDX^ICDEX supported by ICR #5747
Q
; Do standard header setup
D STDHDR Q:$G(SDABRT)=1
W "O/P ENCOUNTERS THAT ARE "_$S('SDOPT:"NOT ",1:"")_"SERVICE CONNECTED" W:SDOPT=2 " & NON SERVICE CONNECTED" W ?67,"PAGE: ",P
W !,?5,"ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
W !,"DATE",?18,"PATIENT",?50,"ENCOUNTER",?65,"SC VALUE",!,!
Q
;
ENCBDDT ; Detailed Body of the Disability/POV Encounter report
I L+3+$S(SDDET:$$CTPOV(),1:0)>IOSL D HEADER Q:$G(SDABRT)=1
; Display the Encounter date
W $$FMTE^XLFDT(SDOEDT,"5MZ")
N DFN,VADM S DFN=SDPAT D DEM^VADPT
; Display the patient name and last 4 SSN.
W ?18,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
D KVA^VADPT
; Display the ENCOUNTER Number
W ?50,SDOE,?65,$S(SCVAL:"YES",SCVAL=0:"NO",1:"TBD"),! S L=L+1
; If summary report, quit.
Q:SDDET=0
; Display all ICD CODES and DIAGNOSES for the specified encounter.
I L+2+$$CTPOV()>IOSL D HEADER Q:$G(SDABRT)=1
D POV2S
I L+2+$$CTDIS()>IOSL D HEADER Q:$G(SDABRT)=1
D DIS2S
I L+4>IOSL D HEADER Q:$G(SDABRT)=1
W !,! S L=L+2
Q
;
NBILLHD ; Display an appropriate header for this report.
; Do standard header setup
D STDHDR Q:$G(SDABRT)=1
W SDHDR,?67,"PAGE: ",P
W !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
W !,"DATE",?18,"PATIENT",?50,"ENCOUNTER",!,!
Q
;
NBILLBD ; Body of the Non Service Connected Billable Encounter reports
I L+2>IOSL D NBILLHD Q:$G(SDABRT)=1
; Display the Encounter date
W $$FMTE^XLFDT(SDOEDT,"5MZ")
; Display the patient name and last 4 SSN.
N DFN,VADM S DFN=SDPAT D DEM^VADPT
W ?18,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
; Display the ENCOUNTER Number
W ?50,SDOE,! S L=L+1
I L+5>IOSL D NBILLHD Q:$G(SDABRT)=1
Q
;
PRVHD ; Display the header for the Provider Service Connected Review Report.
; Do standard header setup
D STDHDR Q:$G(SDABRT)=1
S SDNWPV=1
W SDHDR,?67,"PAGE: ",P
W !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
W !,?5,"ENCOUNTER DATE",?23,"PATIENT NAME",?56,"ENC #",?65,"VBA SC",?73,"USER SC",!,!
Q
;
PRVBD ; Body of the Provider Service Connected Review Report
; This routine will display the Activity during a review
; Start a new page for every provider.
N SDSCCVB,SDSCCUB,DFN,VADM
I L+3+$S(SDDET:$$CTPOV(),1:0)>IOSL D PRVHD Q:$G(SDABRT)=1 S SDPVCN=1
; Display the Provider, reset new provider print flag
I SDNWPV=1 D
. W $$UP^XLFSTR($$NAME^XUSER(SDPROV,"F"))
. S SDNWPV=0
. I SDPVCN=1 W " (cont'd)" S SDPVCN=0
. W ! S L=L+1
. Q
; Display the Encounter date
W ?5,$$FMTE^XLFDT(SDOEDT,"5MZ")
; Display the Patient Name
S DFN=SDPAT D DEM^VADPT
W ?23,$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
D KVA^VADPT
; Display the ENCOUNTER Number,VBA/ICD Connected,VBA by User. Increment Line Count.
S SDSCCVB=$$GET1^DIQ(409.48,SDOE,.09,"E")
S SDSCCUB=$$GET1^DIQ(409.48,SDOE,.06,"E")
I SDSCCUB="" S SDSCCUB="TBD"
W ?56,SDOE,?65,SDSCCVB,?73,SDSCCUB
I 'SDDET W ! S L=L+1
I SDDET D Q:$G(SDABRT)=1
. ; check for enough room for return prompt and data.
. I L+2+$$CTPOV()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
. D POV2S
. I L+2+$$CTDIS()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
. D DIS2S
. I L+4>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
. W !,! S L=L+2
. Q
I L+3>IOSL D PRVHD Q:$G(SDABRT)=1 S SDPVCN=1
Q
;
RVWHD ; Display the header for the User Service Connected Review Report.
; Do standard header setup
D STDHDR Q:$G(SDABRT)=1
S SDNWPV=1
W SDHDR,?67,"PAGE: ",P
W !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
I $G(SDSCDNM)'="" W " By Division: "_SDSCDNM
W !,?5,"ENCOUNTER DATE",?23,"ENC #",?33,"VBA SC",?40,"USER SC",?50,"STATUS",?60,"DATE LAST EDITED",!,!
Q
;
RVWBD ; Body of the User Service Connected Review Report
; This routine will display the Activity during a review
; Start a new page for every user.
N SDSCCVB,SDSCCUB
I L+3+$S(SDDET:$$CTPOV(),1:0)>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
; Display the Encounter date
I SDNWPV=1 D
. W $$UP^XLFSTR($$NAME^XUSER(SDLEB,"F"))
. S SDNWPV=0
. I SDPVCN=1 W " (cont'd)" S SDPVCN=0
. W ! S L=L+1
; Display the Encounter date
W ?5,$$FMTE^XLFDT(SDOEDT,"5MZ")
; Display the ENCOUNTER Number,VBA/ICD Connected,VBA by User, and Status. Increment Line Count.
S SDSCCVB=$$GET1^DIQ(409.48,SDOE,.09,"E")
S SDSCCUB=$$GET1^DIQ(409.48,SDOE,.06,"E")
I SDSCCUB="" S SDSCCUB="TBD"
W ?23,SDOE,?33,SDSCCVB,?40,SDSCCUB
W ?48,$$GET1^DIQ(409.48,SDOE,.05,"E")
W ?60,$$FMTE^XLFDT($$GET1^DIQ(409.48,SDOE,.02,"E"),"5MZ")
I 'SDDET W ! S L=L+1
I SDDET D Q:$G(SDABRT)=1
. ; check for enough room for return prompt and data.
. I L+2+$$CTPOV()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
. D POV2S
. I L+2+$$CTDIS()>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
. D DIS2S
. I L+4>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
. W !,! S L=L+2
I L+3>IOSL D RVWHD Q:$G(SDABRT)=1 S SDPVCN=1
Q
;
CTPOV() ; Count all POV entries for the specified visit.
N SDCT,SDVPOV0
S SDCT=2
S SDVPOV0=0 F S SDVPOV0=$O(^AUPNVPOV("AD",SDV0,SDVPOV0)) Q:'SDVPOV0 S SDCT=SDCT+1
Q SDCT
;
CTDIS() ; Count all rated disabilities for this patient.
N I,I3,SCRD
S I3=2,I=0
D RDIS^DGRPDB(SDPAT,.SCRD)
F S I=$O(SCRD(I)) Q:'I S I3=I3+1
Q I3
;
POV2S ; Loop through and display all POV entries for the specified visit.
N SDICD,SDVPOV0
W !!,?10,"POVs/ICDs:" S L=L+2
S SDVPOV0=0 F S SDVPOV0=$O(^AUPNVPOV("AD",SDV0,SDVPOV0)) Q:'SDVPOV0 D
. S SDPOV=$P($G(^AUPNVPOV(SDVPOV0,0)),U),SDICD=$$ICDDX^ICDEX(SDPOV,SDOEDT,+$$SYS^ICDEX("DIAG",SDOEDT,"I"),"I") ;SD*5.3*586
. W !?15,$P(SDICD,U,2),?23,$P(SDICD,U,4) S L=L+1
. Q
Q
;
DIS2S ; Loop through and display all rated disabilities for this patient.
W !!,?10,"Rated Disabilities:" S L=L+2
N I,I1,I2,I3,SCRD
D RDIS^DGRPDB(SDPAT,.SCRD)
S I3=0,I=0 F S I=$O(SCRD(I)) Q:'I D
. S I1=SCRD(I)
. S I2=$S($D(^DIC(31,+I1,0)):$P(^(0),U,3)_" "_$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",$P(I1,"^",3)']"":"not specified",1:"NSC")_")",1:""),I3=I3+1
. W !,?15,I2 S L=L+1
. Q
Q
;
STDHDR ; tag for all of the standard report header calls
; Do not ask 'RETURN' before first page on CRT.
I $E(IOST,1,2)="C-",P N DIR,Y S DIR(0)="E" D ^DIR I 'Y S SDABRT=1 Q
; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
I $E(IOST,1,2)="C-"!P W @IOF
S P=P+1,L=5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDSCRPT2 7084 printed Apr 09, 2024@21:49:17 Page 2
SDSCRPT2 ;ALB/JAM/RBS - ASCD SB/Reports for Service Connected Automated Monitor ;3/5/07 12:11pm
+1 ;;5.3;Scheduling;**495,586**;Aug 13, 1993;Build 28
+2 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
+3 ;;known as Service Connected Automated Monitoring (SCAM).
+4 ;
+5 ; Routine should be called at specified tags only.
+6 ; Reference to $$ICDDX^ICDEX supported by ICR #5747
+7 QUIT
+1 ; Do standard header setup
+2 DO STDHDR
if $GET(SDABRT)=1
QUIT
+3 WRITE "O/P ENCOUNTERS THAT ARE "_$SELECT('SDOPT:"NOT ",1:"")_"SERVICE CONNECTED"
if SDOPT=2
WRITE " & NON SERVICE CONNECTED"
WRITE ?67,"PAGE: ",P
+4 WRITE !,?5,"ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
+5 IF $GET(SDSCDNM)'=""
WRITE " By Division: "_SDSCDNM
+6 WRITE !,"DATE",?18,"PATIENT",?50,"ENCOUNTER",?65,"SC VALUE",!,!
+7 QUIT
+8 ;
ENCBDDT ; Detailed Body of the Disability/POV Encounter report
+1 IF L+3+$SELECT(SDDET:$$CTPOV(),1:0)>IOSL
DO HEADER
if $GET(SDABRT)=1
QUIT
+2 ; Display the Encounter date
+3 WRITE $$FMTE^XLFDT(SDOEDT,"5MZ")
+4 NEW DFN,VADM
SET DFN=SDPAT
DO DEM^VADPT
+5 ; Display the patient name and last 4 SSN.
+6 WRITE ?18,$EXTRACT(VADM(1),1,25)_" ("_$EXTRACT($PIECE(VADM(2),U),6,9)_")"
+7 DO KVA^VADPT
+8 ; Display the ENCOUNTER Number
+9 WRITE ?50,SDOE,?65,$SELECT(SCVAL:"YES",SCVAL=0:"NO",1:"TBD"),!
SET L=L+1
+10 ; If summary report, quit.
+11 if SDDET=0
QUIT
+12 ; Display all ICD CODES and DIAGNOSES for the specified encounter.
+13 IF L+2+$$CTPOV()>IOSL
DO HEADER
if $GET(SDABRT)=1
QUIT
+14 DO POV2S
+15 IF L+2+$$CTDIS()>IOSL
DO HEADER
if $GET(SDABRT)=1
QUIT
+16 DO DIS2S
+17 IF L+4>IOSL
DO HEADER
if $GET(SDABRT)=1
QUIT
+18 WRITE !,!
SET L=L+2
+19 QUIT
+20 ;
NBILLHD ; Display an appropriate header for this report.
+1 ; Do standard header setup
+2 DO STDHDR
if $GET(SDABRT)=1
QUIT
+3 WRITE SDHDR,?67,"PAGE: ",P
+4 WRITE !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
+5 IF $GET(SDSCDNM)'=""
WRITE " By Division: "_SDSCDNM
+6 WRITE !,"DATE",?18,"PATIENT",?50,"ENCOUNTER",!,!
+7 QUIT
+8 ;
NBILLBD ; Body of the Non Service Connected Billable Encounter reports
+1 IF L+2>IOSL
DO NBILLHD
if $GET(SDABRT)=1
QUIT
+2 ; Display the Encounter date
+3 WRITE $$FMTE^XLFDT(SDOEDT,"5MZ")
+4 ; Display the patient name and last 4 SSN.
+5 NEW DFN,VADM
SET DFN=SDPAT
DO DEM^VADPT
+6 WRITE ?18,$EXTRACT(VADM(1),1,25)_" ("_$EXTRACT($PIECE(VADM(2),U),6,9)_")"
+7 ; Display the ENCOUNTER Number
+8 WRITE ?50,SDOE,!
SET L=L+1
+9 IF L+5>IOSL
DO NBILLHD
if $GET(SDABRT)=1
QUIT
+10 QUIT
+11 ;
PRVHD ; Display the header for the Provider Service Connected Review Report.
+1 ; Do standard header setup
+2 DO STDHDR
if $GET(SDABRT)=1
QUIT
+3 SET SDNWPV=1
+4 WRITE SDHDR,?67,"PAGE: ",P
+5 WRITE !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
+6 IF $GET(SDSCDNM)'=""
WRITE " By Division: "_SDSCDNM
+7 WRITE !,?5,"ENCOUNTER DATE",?23,"PATIENT NAME",?56,"ENC #",?65,"VBA SC",?73,"USER SC",!,!
+8 QUIT
+9 ;
PRVBD ; Body of the Provider Service Connected Review Report
+1 ; This routine will display the Activity during a review
+2 ; Start a new page for every provider.
+3 NEW SDSCCVB,SDSCCUB,DFN,VADM
+4 IF L+3+$SELECT(SDDET:$$CTPOV(),1:0)>IOSL
DO PRVHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+5 ; Display the Provider, reset new provider print flag
+6 IF SDNWPV=1
Begin DoDot:1
+7 WRITE $$UP^XLFSTR($$NAME^XUSER(SDPROV,"F"))
+8 SET SDNWPV=0
+9 IF SDPVCN=1
WRITE " (cont'd)"
SET SDPVCN=0
+10 WRITE !
SET L=L+1
+11 QUIT
End DoDot:1
+12 ; Display the Encounter date
+13 WRITE ?5,$$FMTE^XLFDT(SDOEDT,"5MZ")
+14 ; Display the Patient Name
+15 SET DFN=SDPAT
DO DEM^VADPT
+16 WRITE ?23,$EXTRACT(VADM(1),1,25)_" ("_$EXTRACT($PIECE(VADM(2),U),6,9)_")"
+17 DO KVA^VADPT
+18 ; Display the ENCOUNTER Number,VBA/ICD Connected,VBA by User. Increment Line Count.
+19 SET SDSCCVB=$$GET1^DIQ(409.48,SDOE,.09,"E")
+20 SET SDSCCUB=$$GET1^DIQ(409.48,SDOE,.06,"E")
+21 IF SDSCCUB=""
SET SDSCCUB="TBD"
+22 WRITE ?56,SDOE,?65,SDSCCVB,?73,SDSCCUB
+23 IF 'SDDET
WRITE !
SET L=L+1
+24 IF SDDET
Begin DoDot:1
+25 ; check for enough room for return prompt and data.
+26 IF L+2+$$CTPOV()>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+27 DO POV2S
+28 IF L+2+$$CTDIS()>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+29 DO DIS2S
+30 IF L+4>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+31 WRITE !,!
SET L=L+2
+32 QUIT
End DoDot:1
if $GET(SDABRT)=1
QUIT
+33 IF L+3>IOSL
DO PRVHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+34 QUIT
+35 ;
RVWHD ; Display the header for the User Service Connected Review Report.
+1 ; Do standard header setup
+2 DO STDHDR
if $GET(SDABRT)=1
QUIT
+3 SET SDNWPV=1
+4 WRITE SDHDR,?67,"PAGE: ",P
+5 WRITE !,?5,"FOR ENCOUNTERS DATED ",$$FMTE^XLFDT(SDSCTDT,2)," THRU ",$$FMTE^XLFDT(SDEDT,2)
+6 IF $GET(SDSCDNM)'=""
WRITE " By Division: "_SDSCDNM
+7 WRITE !,?5,"ENCOUNTER DATE",?23,"ENC #",?33,"VBA SC",?40,"USER SC",?50,"STATUS",?60,"DATE LAST EDITED",!,!
+8 QUIT
+9 ;
RVWBD ; Body of the User Service Connected Review Report
+1 ; This routine will display the Activity during a review
+2 ; Start a new page for every user.
+3 NEW SDSCCVB,SDSCCUB
+4 IF L+3+$SELECT(SDDET:$$CTPOV(),1:0)>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+5 ; Display the Encounter date
+6 IF SDNWPV=1
Begin DoDot:1
+7 WRITE $$UP^XLFSTR($$NAME^XUSER(SDLEB,"F"))
+8 SET SDNWPV=0
+9 IF SDPVCN=1
WRITE " (cont'd)"
SET SDPVCN=0
+10 WRITE !
SET L=L+1
End DoDot:1
+11 ; Display the Encounter date
+12 WRITE ?5,$$FMTE^XLFDT(SDOEDT,"5MZ")
+13 ; Display the ENCOUNTER Number,VBA/ICD Connected,VBA by User, and Status. Increment Line Count.
+14 SET SDSCCVB=$$GET1^DIQ(409.48,SDOE,.09,"E")
+15 SET SDSCCUB=$$GET1^DIQ(409.48,SDOE,.06,"E")
+16 IF SDSCCUB=""
SET SDSCCUB="TBD"
+17 WRITE ?23,SDOE,?33,SDSCCVB,?40,SDSCCUB
+18 WRITE ?48,$$GET1^DIQ(409.48,SDOE,.05,"E")
+19 WRITE ?60,$$FMTE^XLFDT($$GET1^DIQ(409.48,SDOE,.02,"E"),"5MZ")
+20 IF 'SDDET
WRITE !
SET L=L+1
+21 IF SDDET
Begin DoDot:1
+22 ; check for enough room for return prompt and data.
+23 IF L+2+$$CTPOV()>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+24 DO POV2S
+25 IF L+2+$$CTDIS()>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+26 DO DIS2S
+27 IF L+4>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+28 WRITE !,!
SET L=L+2
End DoDot:1
if $GET(SDABRT)=1
QUIT
+29 IF L+3>IOSL
DO RVWHD
if $GET(SDABRT)=1
QUIT
SET SDPVCN=1
+30 QUIT
+31 ;
CTPOV() ; Count all POV entries for the specified visit.
+1 NEW SDCT,SDVPOV0
+2 SET SDCT=2
+3 SET SDVPOV0=0
FOR
SET SDVPOV0=$ORDER(^AUPNVPOV("AD",SDV0,SDVPOV0))
if 'SDVPOV0
QUIT
SET SDCT=SDCT+1
+4 QUIT SDCT
+5 ;
CTDIS() ; Count all rated disabilities for this patient.
+1 NEW I,I3,SCRD
+2 SET I3=2
SET I=0
+3 DO RDIS^DGRPDB(SDPAT,.SCRD)
+4 FOR
SET I=$ORDER(SCRD(I))
if 'I
QUIT
SET I3=I3+1
+5 QUIT I3
+6 ;
POV2S ; Loop through and display all POV entries for the specified visit.
+1 NEW SDICD,SDVPOV0
+2 WRITE !!,?10,"POVs/ICDs:"
SET L=L+2
+3 SET SDVPOV0=0
FOR
SET SDVPOV0=$ORDER(^AUPNVPOV("AD",SDV0,SDVPOV0))
if 'SDVPOV0
QUIT
Begin DoDot:1
+4 ;SD*5.3*586
SET SDPOV=$PIECE($GET(^AUPNVPOV(SDVPOV0,0)),U)
SET SDICD=$$ICDDX^ICDEX(SDPOV,SDOEDT,+$$SYS^ICDEX("DIAG",SDOEDT,"I"),"I")
+5 WRITE !?15,$PIECE(SDICD,U,2),?23,$PIECE(SDICD,U,4)
SET L=L+1
+6 QUIT
End DoDot:1
+7 QUIT
+8 ;
DIS2S ; Loop through and display all rated disabilities for this patient.
+1 WRITE !!,?10,"Rated Disabilities:"
SET L=L+2
+2 NEW I,I1,I2,I3,SCRD
+3 DO RDIS^DGRPDB(SDPAT,.SCRD)
+4 SET I3=0
SET I=0
FOR
SET I=$ORDER(SCRD(I))
if 'I
QUIT
Begin DoDot:1
+5 SET I1=SCRD(I)
+6 SET I2=$SELECT($DATA(^DIC(31,+I1,0)):$PIECE(^(0),U,3)_" "_$PIECE(^(0),"^",1)_" ("_+$PIECE(I1,"^",2)_"%-"_$SELECT($PIECE(I1,"^",3):"SC",$PIECE(I1,"^",3)']"":"not specified",1:"NSC")_")",1:"")
SET I3=I3+1
+7 WRITE !,?15,I2
SET L=L+1
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
STDHDR ; tag for all of the standard report header calls
+1 ; Do not ask 'RETURN' before first page on CRT.
+2 IF $EXTRACT(IOST,1,2)="C-"
IF P
NEW DIR,Y
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET SDABRT=1
QUIT
+3 ; Do not print a form feed before first page on printer. Top of form is set at end of previous report.
+4 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+5 SET P=P+1
SET L=5
+6 QUIT
