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.
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
 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