source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRPP1.m@ 1803

Last change on this file since 1803 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1ORWRPP1 ; slc/dcm - Background Report Prints (cont.) ; 12/05/02 11:02
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,160,192,263**;Dec 17, 1997;Build 9
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4MEDB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Medicine report
5 K ^TMP("MCAR",$J)
6 ;I '$D(^MCAR(690,"AC",ORDFN)) Q
7 N ORHFS,%,%I,DA,DILCT,DISTP,S1,S2,S4,S6,TY,WH
8 S ORHFS=1
9 D EN^MCARPS2(ORDFN)
10 D MEDB^ORWRP1(.ROOT,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
11 K ^TMP("MCAR",$J)
12 Q
13HSB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Health Summary report
14 IF $O(ORCOMP(0)) D SITE^ORWRPP($G(STATION)),PREPORT^ORWRP2(.ROOT,.ORCOMP,.ORDFN) Q
15 D SITE^ORWRPP($G(STATION)),HSB^ORWRP1(.ROOT,.ORDFN,.ORHSTYPE,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
16 Q
17HSTYPEB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Health Summary type report
18 D HSTYPEB^ORWRP1(.ROOT,.ORDFN,$P(ORHSTYPE,";",3),.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
19 Q
20LSB(ROOT,ORDFN,ORHSTYPE,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Lab Status Report
21 N ORY,PAGE,ORVP,TEXT
22 S ORVP=ORDFN_";DPT("
23 D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
24 Q:'$L(ORY)
25 S PAGE=1,TEXT="PATIENT LAB ORDER STATUS REPORT ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
26 D HEAD(ORDFN,PAGE,TEXT)
27 D HURL(.ORY,ORDFN,TEXT)
28 Q
29BCMA2B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Hist
30 N ORY,PAGE,TEXT
31 D
32 . N IO
33 . D BCMA2^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
34 U IO
35 Q:'$L(ORY)
36 S PAGE=1,TEXT="PATIENT BCMA MEDICATION HISTORY BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
37 D HEAD(ORDFN,PAGE,TEXT,$G(STATION))
38 D HURL(.ORY,ORDFN,TEXT,1)
39 I $L($G(ORY)) K @ORY
40 Q
41BCMA1B(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print BCMA Med Log
42 N ORY,PAGE,TEXT
43 D
44 . N IO
45 . D BCMA1^ORWRP1A(.ORY,.ORDFN,.OREXAMID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
46 U IO
47 Q:'$L(ORY)
48 S PAGE=1,TEXT="PATIENT MEDICATION LOG BCMA ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
49 D HEAD(ORDFN,PAGE,TEXT,$G(STATION))
50 D HURL(.ORY,ORDFN,TEXT,1)
51 I $L($G(ORY)) K @ORY
52 Q
53PROBB(ROOT,ORDFN,OREXAMID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Print Problem List (Problem Tab)
54 D SITE^ORWRPP($G(STATION)),PROBB^ORWRP1(.ORY,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)
55 Q
56GETVTYPE ;Print V Type reports
57 S PAGE=1,ORY="ORRPT"
58 D HEAD(ORDFN,PAGE,ORHEAD,$G(STATION))
59 D HURL(.ORY,ORDFN,ORHEAD,1)
60 Q
61PRINTV(ORY,ORIO,ORDFN,ORHEAD,ORRPT) ;Print data for remote sites
62 ; RPC: ORWRP PRINT V REPORT
63 N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I,ORHSTAG
64 ;S ORHSTAG=$P($G(ORRPTID),"~",2),ORRPTID=$P($G(ORRPTID),"~"),ORRPTID=$P($P(ORRPTID,";"),":")
65 S ZTIO=ORIO,ZTDTH=$H
66 S ZTDESC="Remote V Report Print"
67 S ZTRTN="GETVTYPE^ORWRPP1"
68 F I="ORDFN","ORHEAD","ORRPT(" S ZTSAVE(I)=""
69 D ^%ZTLOAD
70 I $D(ZTSK) D
71 . S ORY="0^Report queued. (Task #"_ZTSK_")"
72 E D
73 . S ORY="99^Task Rejected."
74 Q
75HEAD(ORDFN,PAGE,TITLE,STATION) ;Print a patient header
76 Q:'$G(ORDFN)
77 N %,%H,%I,DISYS,ORAGE,ORDOB,ORHLINE,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD,VA,X,ORI
78 S:'$L($G(TITLE)) TITLE="PATIENT REPORT"
79 D PAT^ORPR03(ORDFN)
80 D SITE^ORWRPP($G(STATION))
81 W !,TITLE,?(IOM-$L("Page "_PAGE)),"Page "_PAGE
82 S X=ORDOB_" ("_ORAGE_")"
83 W !,ORPNM_" "_ORSSN,?39,$G(ORL(0))_$S($L($G(ORL(1))):"/"_ORL(1),1:""),?(79-$L(X)),X
84 S $P(ORHLINE,"=",IOM+1)=""
85 W !,ORHLINE
86 S X="Printed: "_$$DATE^ORU($$NOW^XLFDT,"MM/DD/CCYY HR:MIN")
87 W !?27,"*** WORK COPY ONLY ***",?(IOM-($L(X))-1),X
88 Q
89HURL(Y,ORDFN,TITLE,FORMAT,STATION,READ) ;Write out the file
90 ;FORMAT tells me which node to go after
91 N L,NOHURL,A,OUT
92 S OUT=0,L="",NOHURL=0
93 F S L=$O(@Y@(L)) Q:L="" Q:OUT D
94 . I $Y+4>IOSL D
95 .. S PAGE=PAGE+1
96 .. W !?27,"*** WORK COPY ONLY *** (continued...)"
97 .. I $G(READ),$G(IOT)'["HFS" R !,"^ TO STOP: ",A:DTIME I A["^" S OUT=1 Q
98 .. W @IOF
99 .. I $G(IOT)["HFS" S $Y=0
100 .. D HEAD(ORDFN,PAGE,$G(TITLE),$G(STATION))
101 .. W !,"(...continued)"
102 . I $G(FORMAT) D Q
103 .. Q:'$D(@Y@(L))
104 .. I NOHURL,$P(@Y@(L),"^")'="[REPORT TEXT]" Q
105 .. I NOHURL,$P(@Y@(L),"^")="[REPORT TEXT]" S NOHURL=0 Q
106 .. I $P(@Y@(L),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
107 .. I @Y@(L)["**PAGE BREAK**" Q
108 .. W !,@Y@(L)
109 . Q:'$D(@Y@(L,0))
110 . I NOHURL,$P(@Y@(L,0),"^")'="[REPORT TEXT]" Q
111 . I NOHURL,$P(@Y@(L,0),"^")="[REPORT TEXT]" S NOHURL=0 Q
112 . I $P(@Y@(L,0),"^")="[HIDDEN TEXT]" S NOHURL=1 Q
113 . I @Y@(L,0)["**PAGE BREAK**" Q
114 . W !,@Y@(L,0)
115 W !?27,"*** WORK COPY ONLY ***"
116 Q
Note: See TracBrowser for help on using the repository browser.