- 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 Feb 19, 2025@00:03:59 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