Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWRPP1

ORWRPP1.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. MEDB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Medicine report
  1. K ^TMP("MCAR",$J)
  1. ;I '$D(^MCAR(690,"AC",ORDFN)) Q
  1. N ORHFS,%,%I,DA,DILCT,DISTP,S1,S2,S4,S6,TY,WH
  1. S ORHFS=1
  1. D EN^MCARPS2(ORDFN)
  1. D MEDB^ORWRP1(.ROOT,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
  1. K ^TMP("MCAR",$J)
  1. Q
  1. 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
  1. IF $O(ORCOMP(0)) D LRSITE^ORWRPP($G(STATION)),PREPORT^ORWRP2(.ROOT,.ORCOMP,.ORDFN) Q
  1. D LRSITE^ORWRPP($G(STATION)),HSB^ORWRP1(.ROOT,.ORDFN,.ORHSTYPE,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
  1. Q
  1. HSTYPEB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Health Summary type report
  1. D HSTYPEB^ORWRP1(.ROOT,.ORDFN,$P(ORHSTYPE,";",3),.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
  1. Q
  1. LSB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Lab Status Report
  1. N ORY,PAGE,ORVP,TEXT
  1. S ORVP=ORDFN_";DPT("
  1. D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
  1. Q:'$L(ORY)
  1. S PAGE=1,TEXT="PATIENT LAB ORDER STATUS REPORT ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
  1. D HEAD(ORDFN,PAGE,TEXT)
  1. D HURL(.ORY,ORDFN,TEXT)
  1. Q
  1. BCMA2B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Hist
  1. N ORY,PAGE,TEXT
  1. D
  1. . N IO
  1. . D BCMA2^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
  1. U IO
  1. Q:'$L(ORY)
  1. S PAGE=1,TEXT="PATIENT BCMA MEDICATION HISTORY BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
  1. D HEAD(ORDFN,PAGE,TEXT,$G(STATION))
  1. D HURL(.ORY,ORDFN,TEXT,1)
  1. I $L($G(ORY)) K @ORY
  1. Q
  1. BCMA1B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Log
  1. N ORY,PAGE,TEXT
  1. D
  1. . N IO
  1. . D BCMA1^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
  1. U IO
  1. Q:'$L(ORY)
  1. S PAGE=1,TEXT="PATIENT MEDICATION LOG BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
  1. D HEAD(ORDFN,PAGE,TEXT,$G(STATION))
  1. D HURL(.ORY,ORDFN,TEXT,1)
  1. I $L($G(ORY)) K @ORY
  1. Q
  1. PROBB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Problem List (Problem Tab)
  1. D SITE^ORWRPP($G(STATION))
  1. W ! ; OR*3*449
  1. D PROBB^ORWRP1(.ORY,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
  1. Q
  1. GETVTYPE ;Print V Type reports
  1. S PAGE=1,ORY="ORRPT"
  1. D HEAD(ORDFN,PAGE,ORHEAD,$G(STATION))
  1. D HURL(.ORY,ORDFN,ORHEAD,1)
  1. Q
  1. PRINTV(ORY,ORIO,ORDFN,ORHEAD,ORRPT) ;Print data for remote sites
  1. ; RPC: ORWRP PRINT V REPORT
  1. N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ORHSTAG
  1. ;S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
  1. S ZTIO=ORIO,ZTDTH=$H
  1. S ZTDESC="Remote V Report Print"
  1. S ZTRTN="GETVTYPE^ORWRPP1"
  1. F I="ORDFN","ORHEAD","ORRPT(" S ZTSAVE(I)=""
  1. D ^%ZTLOAD
  1. I $D(ZTSK) D
  1. . S ORY="0^Report queued. (Task #"_ZTSK_")"
  1. E D
  1. . S ORY="99^Task Rejected."
  1. Q
  1. Q:'$G(ORDFN)
  1. N %,%H,%I,DISYS,ORAGE,ORDOB,ORHLINE,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD,VA,X,ORI
  1. S:'$L($G(TITLE)) TITLE="PATIENT REPORT"
  1. D PAT^ORPR03(ORDFN)
  1. D SITE^ORWRPP($G(STATION))
  1. W !,TITLE,?(IOM-$L("Page "_PAGE)),"Page "_PAGE
  1. S X=ORDOB_" ("_ORAGE_")"
  1. W !,ORPNM_" "_ORSSN,?39,$G(ORL(0))_$S($L($G(ORL(1))):"/"_ORL(1),1:""),?(79-$L(X)),X
  1. S $P(ORHLINE,"=",IOM+1)=""
  1. W !,ORHLINE
  1. S X="Printed: "_$$DATE^ORU($$NOW^XLFDT,"MM/DD/CCYY HR:MIN")
  1. W !?27,"*** WORK COPY ONLY ***",?(IOM-($L(X))-1),X
  1. Q
  1. LRHEAD(ORDFN,PAGE,TITLE,STATION) ; modified patient header to add facility address for lab rpts
  1. Q:'$G(ORDFN)
  1. N %,%H,%I,DISYS,ORAGE,ORDOB,ORHLINE,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD,VA,X,ORI
  1. S:'$L($G(TITLE)) TITLE="PATIENT REPORT"
  1. D PAT^ORPR03(ORDFN)
  1. D LRSITE^ORWRPP($G(STATION))
  1. W !,TITLE,?(IOM-$L("Page "_PAGE)),"Page "_PAGE
  1. S X=ORDOB_" ("_ORAGE_")"
  1. W !,ORPNM_" "_ORSSN,?39,$G(ORL(0))_$S($L($G(ORL(1))):"/"_ORL(1),1:""),?(79-$L(X)),X
  1. S $P(ORHLINE,"=",IOM+1)=""
  1. W !,ORHLINE
  1. S X="Printed: "_$$DATE^ORU($$NOW^XLFDT,"MM/DD/CCYY HR:MIN")
  1. W !?27,"*** WORK COPY ONLY ***",?(IOM-($L(X))-1),X
  1. Q
  1. HURL(Y,ORDFN,TITLE,FORMAT,STATION,READ) ;Write out the file
  1. ;FORMAT tells me which node to go after
  1. N L,NOHURL,A,OUT
  1. S OUT=0,L="",NOHURL=0
  1. F S L=$O(@Y@(L)) Q:L="" Q:OUT D
  1. . I $Y+4>IOSL D
  1. .. S PAGE=PAGE+1
  1. .. W !?27,"*** WORK COPY ONLY *** (continued...)"
  1. .. I $G(READ),$G(IOT)'["HFS" R !,"^ TO STOP: ",A:DTIME I A["^" S OUT=1 Q
  1. .. W @IOF
  1. .. I $G(IOT)["HFS" S $Y=0
  1. .. D HEAD(ORDFN,PAGE,$G(TITLE),$G(STATION))
  1. .. W !,"(...continued)"
  1. . I $G(FORMAT) D Q
  1. .. Q:'$D(@Y@(L))
  1. .. I NOHURL,$P(@Y@(L),"^")'="[REPORT TEXT]" Q
  1. .. I NOHURL,$P(@Y@(L),"^")="[REPORT TEXT]" S NOHURL=0 Q
  1. .. I $P(@Y@(L),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
  1. .. I @Y@(L)["**PAGE BREAK**" Q
  1. .. W !,@Y@(L)
  1. . Q:'$D(@Y@(L,0))
  1. . I NOHURL,$P(@Y@(L,0),"^")'="[REPORT TEXT]" Q
  1. . I NOHURL,$P(@Y@(L,0),"^")="[REPORT TEXT]" S NOHURL=0 Q
  1. . I $P(@Y@(L,0),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
  1. . I @Y@(L,0)["**PAGE BREAK**" Q
  1. . W !,@Y@(L,0)
  1. W !?27,"*** WORK COPY ONLY ***"
  1. Q
  1. 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
  1. N L,NOHURL,A,OUT
  1. S OUT=0,L="",NOHURL=0
  1. F S L=$O(@Y@(L)) Q:L="" Q:OUT D
  1. . I $Y+4>IOSL D
  1. .. S PAGE=PAGE+1
  1. .. W !?27,"*** WORK COPY ONLY *** (continued...)"
  1. .. I $G(READ),$G(IOT)'["HFS" R !,"^ TO STOP: ",A:DTIME I A["^" S OUT=1 Q
  1. .. W @IOF
  1. .. I $G(IOT)["HFS" S $Y=0
  1. .. D LRHEAD(ORDFN,PAGE,$G(TITLE),$G(STATION))
  1. .. W !,"(...continued)"
  1. . I $G(FORMAT) D Q
  1. .. Q:'$D(@Y@(L))
  1. .. I NOHURL,$P(@Y@(L),"^")'="[REPORT TEXT]" Q
  1. .. I NOHURL,$P(@Y@(L),"^")="[REPORT TEXT]" S NOHURL=0 Q
  1. .. I $P(@Y@(L),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
  1. .. I @Y@(L)["**PAGE BREAK**" Q
  1. .. W !,@Y@(L)
  1. . Q:'$D(@Y@(L,0))
  1. . I NOHURL,$P(@Y@(L,0),"^")'="[REPORT TEXT]" Q
  1. . I NOHURL,$P(@Y@(L,0),"^")="[REPORT TEXT]" S NOHURL=0 Q
  1. . I $P(@Y@(L,0),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
  1. . I @Y@(L,0)["**PAGE BREAK**" Q
  1. . W !,@Y@(L,0)
  1. W !?27,"*** WORK COPY ONLY ***"
  1. Q