ORWRPP1 ; SLC/DCM - Background Report Prints (cont.) ;Dec 02, 2021@12:51:43
;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,160,192,263,449,405**;Dec 17, 1997;Build 211
;;Per VHA Directive 6402, this routine should not be modified.
;
;
MEDB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Medicine report
K ^TMP("MCAR",$J)
;I '$D(^MCAR(690,"AC",ORDFN)) Q
N ORHFS,%,%I,DA,DILCT,DISTP,S1,S2,S4,S6,TY,WH
S ORHFS=1
D EN^MCARPS2(ORDFN)
D MEDB^ORWRP1(.ROOT,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
K ^TMP("MCAR",$J)
Q
HSB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Health Summary report
;replaced SITE^ORWRPP references with LRSITE^ORWRPP to print facility address at header of all Health Summary reports
IF $O(ORCOMP(0)) D LRSITE^ORWRPP($G(STATION)),PREPORT^ORWRP2(.ROOT,.ORCOMP,.ORDFN) Q
D LRSITE^ORWRPP($G(STATION)),HSB^ORWRP1(.ROOT,.ORDFN,.ORHSTYPE,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
Q
HSTYPEB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Health Summary type report
D HSTYPEB^ORWRP1(.ROOT,.ORDFN,$P(ORHSTYPE,";",3),.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
Q
LSB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Lab Status Report
N ORY,PAGE,ORVP,TEXT
S ORVP=ORDFN_";DPT("
D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
Q:'$L(ORY)
S PAGE=1,TEXT="PATIENT LAB ORDER STATUS REPORT ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
D HEAD(ORDFN,PAGE,TEXT)
D HURL(.ORY,ORDFN,TEXT)
Q
BCMA2B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Hist
N ORY,PAGE,TEXT
D
. N IO
. D BCMA2^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
U IO
Q:'$L(ORY)
S PAGE=1,TEXT="PATIENT BCMA MEDICATION HISTORY BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
D HEAD(ORDFN,PAGE,TEXT,$G(STATION))
D HURL(.ORY,ORDFN,TEXT,1)
I $L($G(ORY)) K @ORY
Q
BCMA1B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Log
N ORY,PAGE,TEXT
D
. N IO
. D BCMA1^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
U IO
Q:'$L(ORY)
S PAGE=1,TEXT="PATIENT MEDICATION LOG BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
D HEAD(ORDFN,PAGE,TEXT,$G(STATION))
D HURL(.ORY,ORDFN,TEXT,1)
I $L($G(ORY)) K @ORY
Q
PROBB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Problem List (Problem Tab)
D SITE^ORWRPP($G(STATION))
W ! ; OR*3*449
D PROBB^ORWRP1(.ORY,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
Q
GETVTYPE ;Print V Type reports
S PAGE=1,ORY="ORRPT"
D HEAD(ORDFN,PAGE,ORHEAD,$G(STATION))
D HURL(.ORY,ORDFN,ORHEAD,1)
Q
PRINTV(ORY,ORIO,ORDFN,ORHEAD,ORRPT) ;Print data for remote sites
; RPC: ORWRP PRINT V REPORT
N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ORHSTAG
;S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
S ZTIO=ORIO,ZTDTH=$H
S ZTDESC="Remote V Report Print"
S ZTRTN="GETVTYPE^ORWRPP1"
F I="ORDFN","ORHEAD","ORRPT(" S ZTSAVE(I)=""
D ^%ZTLOAD
I $D(ZTSK) D
. S ORY="0^Report queued. (Task #"_ZTSK_")"
E D
. S ORY="99^Task Rejected."
Q
HEAD(ORDFN,PAGE,TITLE,STATION) ;Print a patient header
Q:'$G(ORDFN)
N %,%H,%I,DISYS,ORAGE,ORDOB,ORHLINE,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD,VA,X,ORI
S:'$L($G(TITLE)) TITLE="PATIENT REPORT"
D PAT^ORPR03(ORDFN)
D SITE^ORWRPP($G(STATION))
W !,TITLE,?(IOM-$L("Page "_PAGE)),"Page "_PAGE
S X=ORDOB_" ("_ORAGE_")"
W !,ORPNM_" "_ORSSN,?39,$G(ORL(0))_$S($L($G(ORL(1))):"/"_ORL(1),1:""),?(79-$L(X)),X
S $P(ORHLINE,"=",IOM+1)=""
W !,ORHLINE
S X="Printed: "_$$DATE^ORU($$NOW^XLFDT,"MM/DD/CCYY HR:MIN")
W !?27,"*** WORK COPY ONLY ***",?(IOM-($L(X))-1),X
Q
LRHEAD(ORDFN,PAGE,TITLE,STATION) ; modified patient header to add facility address for lab rpts
Q:'$G(ORDFN)
N %,%H,%I,DISYS,ORAGE,ORDOB,ORHLINE,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD,VA,X,ORI
S:'$L($G(TITLE)) TITLE="PATIENT REPORT"
D PAT^ORPR03(ORDFN)
D LRSITE^ORWRPP($G(STATION))
W !,TITLE,?(IOM-$L("Page "_PAGE)),"Page "_PAGE
S X=ORDOB_" ("_ORAGE_")"
W !,ORPNM_" "_ORSSN,?39,$G(ORL(0))_$S($L($G(ORL(1))):"/"_ORL(1),1:""),?(79-$L(X)),X
S $P(ORHLINE,"=",IOM+1)=""
W !,ORHLINE
S X="Printed: "_$$DATE^ORU($$NOW^XLFDT,"MM/DD/CCYY HR:MIN")
W !?27,"*** WORK COPY ONLY ***",?(IOM-($L(X))-1),X
Q
HURL(Y,ORDFN,TITLE,FORMAT,STATION,READ) ;Write out the file
;FORMAT tells me which node to go after
N L,NOHURL,A,OUT
S OUT=0,L="",NOHURL=0
F S L=$O(@Y@(L)) Q:L="" Q:OUT D
. I $Y+4>IOSL D
.. S PAGE=PAGE+1
.. W !?27,"*** WORK COPY ONLY *** (continued...)"
.. I $G(READ),$G(IOT)'["HFS" R !,"^ TO STOP: ",A:DTIME I A["^" S OUT=1 Q
.. W @IOF
.. I $G(IOT)["HFS" S $Y=0
.. D HEAD(ORDFN,PAGE,$G(TITLE),$G(STATION))
.. W !,"(...continued)"
. I $G(FORMAT) D Q
.. Q:'$D(@Y@(L))
.. I NOHURL,$P(@Y@(L),"^")'="[REPORT TEXT]" Q
.. I NOHURL,$P(@Y@(L),"^")="[REPORT TEXT]" S NOHURL=0 Q
.. I $P(@Y@(L),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
.. I @Y@(L)["**PAGE BREAK**" Q
.. W !,@Y@(L)
. Q:'$D(@Y@(L,0))
. I NOHURL,$P(@Y@(L,0),"^")'="[REPORT TEXT]" Q
. I NOHURL,$P(@Y@(L,0),"^")="[REPORT TEXT]" S NOHURL=0 Q
. I $P(@Y@(L,0),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
. I @Y@(L,0)["**PAGE BREAK**" Q
. W !,@Y@(L,0)
W !?27,"*** WORK COPY ONLY ***"
Q
LRHURL(Y,ORDFN,TITLE,FORMAT,STATION,READ) ; modified patient header to add facility address for lab rpts
;FORMAT tells me which node to go after
N L,NOHURL,A,OUT
S OUT=0,L="",NOHURL=0
F S L=$O(@Y@(L)) Q:L="" Q:OUT D
. I $Y+4>IOSL D
.. S PAGE=PAGE+1
.. W !?27,"*** WORK COPY ONLY *** (continued...)"
.. I $G(READ),$G(IOT)'["HFS" R !,"^ TO STOP: ",A:DTIME I A["^" S OUT=1 Q
.. W @IOF
.. I $G(IOT)["HFS" S $Y=0
.. D LRHEAD(ORDFN,PAGE,$G(TITLE),$G(STATION))
.. W !,"(...continued)"
. I $G(FORMAT) D Q
.. Q:'$D(@Y@(L))
.. I NOHURL,$P(@Y@(L),"^")'="[REPORT TEXT]" Q
.. I NOHURL,$P(@Y@(L),"^")="[REPORT TEXT]" S NOHURL=0 Q
.. I $P(@Y@(L),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
.. I @Y@(L)["**PAGE BREAK**" Q
.. W !,@Y@(L)
. Q:'$D(@Y@(L,0))
. I NOHURL,$P(@Y@(L,0),"^")'="[REPORT TEXT]" Q
. I NOHURL,$P(@Y@(L,0),"^")="[REPORT TEXT]" S NOHURL=0 Q
. I $P(@Y@(L,0),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
. I @Y@(L,0)["**PAGE BREAK**" Q
. W !,@Y@(L,0)
W !?27,"*** WORK COPY ONLY ***"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWRPP1 6565 printed Dec 13, 2024@02:37:27 Page 2
ORWRPP1 ; SLC/DCM - Background Report Prints (cont.) ;Dec 02, 2021@12:51:43
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,160,192,263,449,405**;Dec 17, 1997;Build 211
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
MEDB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Medicine report
+1 KILL ^TMP("MCAR",$JOB)
+2 ;I '$D(^MCAR(690,"AC",ORDFN)) Q
+3 NEW ORHFS,%,%I,DA,DILCT,DISTP,S1,S2,S4,S6,TY,WH
+4 SET ORHFS=1
+5 DO EN^MCARPS2(ORDFN)
+6 DO MEDB^ORWRP1(.ROOT,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
+7 KILL ^TMP("MCAR",$JOB)
+8 QUIT
HSB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Health Summary report
+1 ;replaced SITE^ORWRPP references with LRSITE^ORWRPP to print facility address at header of all Health Summary reports
+2 IF $ORDER(ORCOMP(0))
DO LRSITE^ORWRPP($GET(STATION))
DO PREPORT^ORWRP2(.ROOT,.ORCOMP,.ORDFN)
QUIT
+3 DO LRSITE^ORWRPP($GET(STATION))
DO HSB^ORWRP1(.ROOT,.ORDFN,.ORHSTYPE,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
+4 QUIT
HSTYPEB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Health Summary type report
+1 DO HSTYPEB^ORWRP1(.ROOT,.ORDFN,$PIECE(ORHSTYPE,";",3),.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
+2 QUIT
LSB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Lab Status Report
+1 NEW ORY,PAGE,ORVP,TEXT
+2 SET ORVP=ORDFN_";DPT("
+3 DO EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
+4 if '$LENGTH(ORY)
QUIT
+5 SET PAGE=1
SET TEXT="PATIENT LAB ORDER STATUS REPORT ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
+6 DO HEAD(ORDFN,PAGE,TEXT)
+7 DO HURL(.ORY,ORDFN,TEXT)
+8 QUIT
BCMA2B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Hist
+1 NEW ORY,PAGE,TEXT
+2 Begin DoDot:1
+3 NEW IO
+4 DO BCMA2^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
End DoDot:1
+5 USE IO
+6 if '$LENGTH(ORY)
QUIT
+7 SET PAGE=1
SET TEXT="PATIENT BCMA MEDICATION HISTORY BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
+8 DO HEAD(ORDFN,PAGE,TEXT,$GET(STATION))
+9 DO HURL(.ORY,ORDFN,TEXT,1)
+10 IF $LENGTH($GET(ORY))
KILL @ORY
+11 QUIT
BCMA1B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Log
+1 NEW ORY,PAGE,TEXT
+2 Begin DoDot:1
+3 NEW IO
+4 DO BCMA1^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
End DoDot:1
+5 USE IO
+6 if '$LENGTH(ORY)
QUIT
+7 SET PAGE=1
SET TEXT="PATIENT MEDICATION LOG BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
+8 DO HEAD(ORDFN,PAGE,TEXT,$GET(STATION))
+9 DO HURL(.ORY,ORDFN,TEXT,1)
+10 IF $LENGTH($GET(ORY))
KILL @ORY
+11 QUIT
PROBB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Problem List (Problem Tab)
+1 DO SITE^ORWRPP($GET(STATION))
+2 ; OR*3*449
WRITE !
+3 DO PROBB^ORWRP1(.ORY,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
+4 QUIT
GETVTYPE ;Print V Type reports
+1 SET PAGE=1
SET ORY="ORRPT"
+2 DO HEAD(ORDFN,PAGE,ORHEAD,$GET(STATION))
+3 DO HURL(.ORY,ORDFN,ORHEAD,1)
+4 QUIT
PRINTV(ORY,ORIO,ORDFN,ORHEAD,ORRPT) ;Print data for remote sites
+1 ; RPC: ORWRP PRINT V REPORT
+2 NEW ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ORHSTAG
+3 ;S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
+4 SET ZTIO=ORIO
SET ZTDTH=$HOROLOG
+5 SET ZTDESC="Remote V Report Print"
+6 SET ZTRTN="GETVTYPE^ORWRPP1"
+7 FOR I="ORDFN","ORHEAD","ORRPT("
SET ZTSAVE(I)=""
+8 DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 SET ORY="0^Report queued. (Task #"_ZTSK_")"
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 SET ORY="99^Task Rejected."
End DoDot:1
+13 QUIT
HEAD(ORDFN,PAGE,TITLE,STATION) ;Print a patient header
+1 if '$GET(ORDFN)
QUIT
+2 NEW %,%H,%I,DISYS,ORAGE,ORDOB,ORHLINE,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD,VA,X,ORI
+3 if '$LENGTH($GET(TITLE))
SET TITLE="PATIENT REPORT"
+4 DO PAT^ORPR03(ORDFN)
+5 DO SITE^ORWRPP($GET(STATION))
+6 WRITE !,TITLE,?(IOM-$LENGTH("Page "_PAGE)),"Page "_PAGE
+7 SET X=ORDOB_" ("_ORAGE_")"
+8 WRITE !,ORPNM_" "_ORSSN,?39,$GET(ORL(0))_$SELECT($LENGTH($GET(ORL(1))):"/"_ORL(1),1:""),?(79-$LENGTH(X)),X
+9 SET $PIECE(ORHLINE,"=",IOM+1)=""
+10 WRITE !,ORHLINE
+11 SET X="Printed: "_$$DATE^ORU($$NOW^XLFDT,"MM/DD/CCYY HR:MIN")
+12 WRITE !?27,"*** WORK COPY ONLY ***",?(IOM-($LENGTH(X))-1),X
+13 QUIT
LRHEAD(ORDFN,PAGE,TITLE,STATION) ; modified patient header to add facility address for lab rpts
+1 if '$GET(ORDFN)
QUIT
+2 NEW %,%H,%I,DISYS,ORAGE,ORDOB,ORHLINE,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD,VA,X,ORI
+3 if '$LENGTH($GET(TITLE))
SET TITLE="PATIENT REPORT"
+4 DO PAT^ORPR03(ORDFN)
+5 DO LRSITE^ORWRPP($GET(STATION))
+6 WRITE !,TITLE,?(IOM-$LENGTH("Page "_PAGE)),"Page "_PAGE
+7 SET X=ORDOB_" ("_ORAGE_")"
+8 WRITE !,ORPNM_" "_ORSSN,?39,$GET(ORL(0))_$SELECT($LENGTH($GET(ORL(1))):"/"_ORL(1),1:""),?(79-$LENGTH(X)),X
+9 SET $PIECE(ORHLINE,"=",IOM+1)=""
+10 WRITE !,ORHLINE
+11 SET X="Printed: "_$$DATE^ORU($$NOW^XLFDT,"MM/DD/CCYY HR:MIN")
+12 WRITE !?27,"*** WORK COPY ONLY ***",?(IOM-($LENGTH(X))-1),X
+13 QUIT
HURL(Y,ORDFN,TITLE,FORMAT,STATION,READ) ;Write out the file
+1 ;FORMAT tells me which node to go after
+2 NEW L,NOHURL,A,OUT
+3 SET OUT=0
SET L=""
SET NOHURL=0
+4 FOR
SET L=$ORDER(@Y@(L))
if L=""
QUIT
if OUT
QUIT
Begin DoDot:1
+5 IF $Y+4>IOSL
Begin DoDot:2
+6 SET PAGE=PAGE+1
+7 WRITE !?27,"*** WORK COPY ONLY *** (continued...)"
+8 IF $GET(READ)
IF $GET(IOT)'["HFS"
READ !,"^ TO STOP: ",A:DTIME
IF A["^"
SET OUT=1
QUIT
+9 WRITE @IOF
+10 IF $GET(IOT)["HFS"
SET $Y=0
+11 DO HEAD(ORDFN,PAGE,$GET(TITLE),$GET(STATION))
+12 WRITE !,"(...continued)"
End DoDot:2
+13 IF $GET(FORMAT)
Begin DoDot:2
+14 if '$DATA(@Y@(L))
QUIT
+15 IF NOHURL
IF $PIECE(@Y@(L),"^")'="[REPORT TEXT]"
QUIT
+16 IF NOHURL
IF $PIECE(@Y@(L),"^")="[REPORT TEXT]"
SET NOHURL=0
QUIT
+17 IF $PIECE(@Y@(L),"^")="[HIDDEN TEXT]"
SET NOHURL=1
QUIT
+18 IF @Y@(L)["**PAGE BREAK**"
QUIT
+19 WRITE !,@Y@(L)
End DoDot:2
QUIT
+20 if '$DATA(@Y@(L,0))
QUIT
+21 IF NOHURL
IF $PIECE(@Y@(L,0),"^")'="[REPORT TEXT]"
QUIT
+22 IF NOHURL
IF $PIECE(@Y@(L,0),"^")="[REPORT TEXT]"
SET NOHURL=0
QUIT
+23 IF $PIECE(@Y@(L,0),"^")="[HIDDEN TEXT]"
SET NOHURL=1
QUIT
+24 IF @Y@(L,0)["**PAGE BREAK**"
QUIT
+25 WRITE !,@Y@(L,0)
End DoDot:1
+26 WRITE !?27,"*** WORK COPY ONLY ***"
+27 QUIT
LRHURL(Y,ORDFN,TITLE,FORMAT,STATION,READ) ; modified patient header to add facility address for lab rpts
+1 ;FORMAT tells me which node to go after
+2 NEW L,NOHURL,A,OUT
+3 SET OUT=0
SET L=""
SET NOHURL=0
+4 FOR
SET L=$ORDER(@Y@(L))
if L=""
QUIT
if OUT
QUIT
Begin DoDot:1
+5 IF $Y+4>IOSL
Begin DoDot:2
+6 SET PAGE=PAGE+1
+7 WRITE !?27,"*** WORK COPY ONLY *** (continued...)"
+8 IF $GET(READ)
IF $GET(IOT)'["HFS"
READ !,"^ TO STOP: ",A:DTIME
IF A["^"
SET OUT=1
QUIT
+9 WRITE @IOF
+10 IF $GET(IOT)["HFS"
SET $Y=0
+11 DO LRHEAD(ORDFN,PAGE,$GET(TITLE),$GET(STATION))
+12 WRITE !,"(...continued)"
End DoDot:2
+13 IF $GET(FORMAT)
Begin DoDot:2
+14 if '$DATA(@Y@(L))
QUIT
+15 IF NOHURL
IF $PIECE(@Y@(L),"^")'="[REPORT TEXT]"
QUIT
+16 IF NOHURL
IF $PIECE(@Y@(L),"^")="[REPORT TEXT]"
SET NOHURL=0
QUIT
+17 IF $PIECE(@Y@(L),"^")="[HIDDEN TEXT]"
SET NOHURL=1
QUIT
+18 IF @Y@(L)["**PAGE BREAK**"
QUIT
+19 WRITE !,@Y@(L)
End DoDot:2
QUIT
+20 if '$DATA(@Y@(L,0))
QUIT
+21 IF NOHURL
IF $PIECE(@Y@(L,0),"^")'="[REPORT TEXT]"
QUIT
+22 IF NOHURL
IF $PIECE(@Y@(L,0),"^")="[REPORT TEXT]"
SET NOHURL=0
QUIT
+23 IF $PIECE(@Y@(L,0),"^")="[HIDDEN TEXT]"
SET NOHURL=1
QUIT
+24 IF @Y@(L,0)["**PAGE BREAK**"
QUIT
+25 WRITE !,@Y@(L,0)
End DoDot:1
+26 WRITE !?27,"*** WORK COPY ONLY ***"
+27 QUIT
