source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCXPND3.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 6.5 KB
Line 
1ORCXPND3 ; SLC/MKB,dcm - Expanded display of Reports ;2/21/01 14:07
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**25,30,43,85,172,243**;Dec 17, 1997;Build 242
3 ;
4AP ; -- Retrieve AP results for a specific date/time specimen taken
5 ; [alert follow-up, from LABS^ORCXPND1]
6 N ORACCNO,ORDTSTKN S ORACCNO=$P(ID,"-"),ORDTSTKN=$P(ID,"-",2)
7 I (ORACCNO["CY"!(ORACCNO["SP")!(ORACCNO["EM")!(ORACCNO["AU"))&($L(ORACCNO)>0) D ;check for valid accession #
8 . N ORLRDFN,ORLRSS S ORLRDFN=$$LRDFN^LR7OR1(DFN),ORLRSS=$P($G(XQADATA),U) ;DBIA/ICR #2503
9 . K ^TMP("ORAP",$J) D EN^LR7OSAP4("^TMP(""ORAP"",$J)",ORLRDFN,ORLRSS,ORDTSTKN)
10 . I '$O(^TMP("ORAP",$J,0)) S ^TMP("ORAP",$J,1,0)="",^TMP("ORAP",$J,2,0)="No Anatomic Pathology report available..."
11 . N I S I=0 F S I=$O(^TMP("ORAP",$J,I)) Q:I<1 S X=^(I,0),LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X
12 . K ^TMP("ORAP",$J)
13 Q
14 ;
15LRA ; -- Anatomic Pathology Report
16 N DFN,Y,I,LRLLOC,LRQ
17 D TIT^ORCXPNDR("Anatomic Path Report") Q:$$OS^ORCXPNDR()
18 D PREP^ORCXPNDR
19 D RPT^ORWRP(.Y,ID,3)
20 D ITEM^ORCXPND("Anatomic Path Report")
21 S I=3 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("ORDATA",$J,1,I)
22 K ^TMP("ORDATA",$J)
23 Q
24 ;
25LRAA ; -- Alternate Anatomic Path Report
26 N DFN,Y,I,LRLLOC,LRQ
27 D TIT^ORCXPNDR("Alternate Anatomic Path Report") Q:$$OS^ORCXPNDR()
28 D PREP^ORCXPNDR I $$OS^ORCXPNDR() Q
29 D AP^LR7OSUM(ID)
30 D ITEM^ORCXPND("Anatomic Pathology Report")
31 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="No Anatomic Pathology reports available..."
32 S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("LRC",$J,I,0)
33 K ^TMP("LRC",$J)
34 Q
35 ;
36LRB1 ; -- Blood Bank Report
37 N DFN,Y,I,LRBLOOD,LRCAPA,LRDT0,LRLABKY,LRLLOC,LRO,LRPCEVSO,LRPLASMA,LRSERUM,LRT,LRUNKNOW,LRURINE,LRVIDO,LRVIDOF
38 D TIT^ORCXPNDR("Blood Bank Report") Q:$$OS^ORCXPNDR()
39 D PREP^ORCXPNDR
40 D RPT^ORWRP(.Y,ID,2)
41 D ITEM^ORCXPND("Blood Bank Report")
42 S I=5 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("ORDATA",$J,1,I)
43 K ^TMP("ORDATA",$J)
44 Q
45 ;
46LRB ; -- A better Blood Bank Report
47 N DFN,ORY,I,SUBHEAD
48 D TIT^ORCXPNDR("Blood Bank Report")
49 S DFN=ID
50 D PREP^ORCXPNDR
51 I $$GET^XPAR("DIV^SYS^PKG","OR VBECS ON",1,"Q"),$L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface
52 . K ^TMP("ORLRC",$J)
53 . D EN^ORWLR1(DFN)
54 . I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
55 . D ITEM^ORCXPND("Blood Bank Report"),BLANK^ORCXPND
56 . S I=0 F S I=$O(^TMP("ORLRC",$J,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("ORLRC",$J,I,0)
57 . K ^TMP("ORLRC",$J)
58 S SUBHEAD("BLOOD BANK")=""
59 D EN^LR7OSUM(.ORY,DFN,,,,,.SUBHEAD)
60 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="No Blood Bank report available..."
61 D ITEM^ORCXPND("Blood Bank Report"),BLANK^ORCXPND
62 S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("LRC",$J,I,0)
63 K ^TMP("LRC",$J),^TMP("LRH",$J)
64 Q
65 ;
66LRC ; -- Lab Cumulative
67 N DFN,ORY,I,BEG,END,OREND,ORSSTRT,ORSSTOP
68 D TIT^ORCXPNDR("Lab Cumulative")
69 S DFN=ID
70 D RANGE($S($G(ORWARD):7,1:180)) Q:OREND S BEG=+ORSSTRT,END=+ORSSTOP
71 D PREP^ORCXPNDR
72 D EN^LR7OSUM(.ORY,DFN,BEG,END)
73 D ITEM^ORCXPND("Lab Cumulative"),BLANK^ORCXPND
74 S I=0 F S I=$O(^TMP("LRC",$J,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=^TMP("LRC",$J,I,0)
75 K ^TMP("LRC",$J),^TMP("LRH",$J)
76 Q
77 ;
78LRG ; -- Graph Lab Tests
79 N DFN,Y,I,X,BCNT,LRSS,LRCW,LRFLAG,LRCTRL,LRNSET,N,LOW,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,OREND,ORSSTRT,ORSSTOP
80 D TIT^ORCXPNDR("Graph Lab Tests") Q:$$OS^ORCXPNDR()
81 D RANGE($S($G(ORWARD):7,1:180)) Q:OREND
82 S LRSS="CH",LRCW=8,LRFLAG="",LRCTRL=0,(LRNSET,N)=80
83 D L2^LRDIST4 Q:'$D(LRTEST)
84 D PREP^ORCXPNDR
85 D RPT^ORWRP(.Y,ID,8,,,,+ORSSTRT,+ORSSTOP)
86 D ITEM^ORCXPND("Lab Graph")
87 S I=4,BCNT=0
88 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
89 . I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
90 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
91 K ^TMP("ORDATA",$J)
92 Q
93 ;
94LRI ; -- Interim Lab Results
95 N ORX,DFN,Y,I,X,BCNT,LREDT,LRIDT,LRLLT,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,OREND,ORSSTRT,ORSSTOP
96 D TIT^ORCXPNDR("Lab Interim Results") Q:$$OS^ORCXPNDR()
97 D RANGE($S($G(ORWARD):7,1:180)) Q:OREND
98 D SET^LRRP4
99 D PREP^ORCXPNDR
100 D RPT^ORWRP(.Y,ID,3,,,,+ORSSTRT,+ORSSTOP)
101 D ITEM^ORCXPND("Lab Interim Report")
102 S I=0,BCNT=0
103 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
104 . I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
105 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
106 K ^TMP("ORDATA",$J)
107 Q
108 ;
109LRGEN ;Lab Results by Test
110 N DFN,Y,I,II,X,BCNT,LRPRETTY,LREDT,LRLLT,LRPCEVSO,LRPRAC,LRRB,LRTREA,LRVIDO,LRVIDOF,LRCW,LREND,LRTP,LRIX,LRWPL,LRIDT,LRSC,DIC,LRTSTS,LRORD,LRTEST,LRSUB,LRHDR,LRSSP,LRHI,LRLO
111 N LBL,LRBLOOD,LRDAT,LRDFN,LRDPF,LRDT0,LREX,LRFFLG,LRFOOT,LRLAB,LRLABKY,LRND,LRNG,LRNOP,LRNOTE,LRODT0,LRONESPC,LRONETST,LRPAGE,LRPARAM,LRPLASMA,LRPP,LRSERUM,LRPS,LRTN,LRUNKNOW,LRURINE,LRWRD,LRX,LRY
112 N AGE,I,INC,LRIDT1,LRSV,OREND,ORSSTRT,ORSSTOP
113 K ^TMP("LR",$J)
114 D TIT^ORCXPNDR("Lab Results by Test") Q:$$OS^ORCXPNDR()
115 D RANGE($S($G(ORWARD):7,1:180)) Q:OREND
116 D SET^LRGEN
117 Q:LREND!'LRTSTS
118 D PREP^ORCXPNDR
119 D RPT^ORWRP(.Y,ID,16,,,,+ORSSTRT,+ORSSTOP)
120 D ITEM^ORCXPND("Lab Results by Test")
121 S I=1,BCNT=0
122 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
123 . I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
124 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
125 K ^TMP("ORDATA",$J)
126 Q
127 ;
128STAT ; -- Lab test status
129 N DFN,Y,I,X,BCNT,OREND,ORSSTRT,ORSSTOP
130 D TIT^ORCXPNDR("Lab Test Status") Q:$$OS^ORCXPNDR()
131 D RANGE($S($G(ORWARD):7,1:180)) Q:$G(OREND)
132 D PREP^ORCXPNDR
133 D RPT^ORWRP(.Y,ID,9,,,,+ORSSTRT,+ORSSTOP)
134 D ITEM^ORCXPND("Lab Test Status")
135 S I=0,BCNT=0
136 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=$S($D(^(I))#2:^(I),$D(^(I,0))#2:^(0),1:"") D
137 . I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
138 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
139 K ^TMP("ORDATA",$J)
140 Q
141 ;
142RANGE(BEG) ;Get date range for report
143 ;BEG=# of days (T-BEG) for start default
144 ;Output: ORSSTRT=Start date/time
145 ; ORSSTOP=Stop date/time
146 ; OREND=1 if user '^'s out, so look for it!
147 S BEG=$$FMADD^XLFDT(DT,-$G(BEG)),END=$$NOW^XLFDT
148 D RANGE^ORPRS01(BEG,END)
149 Q
150 ;
151MED(MED) ; -- Medicine Summary of Patient Procedures
152 N DFN,Y,I,X,BCNT,OREND,PROCID
153 D TIT^ORCXPNDR("Summary of Patient Procedures") Q:$$OS^ORCXPNDR()
154 D PREP^ORCXPNDR
155 S DFN=+ID,PROCID=$P(MED,"~",2)
156 D RPT^ORWRP(.Y,DFN,19,,,PROCID)
157 D ITEM^ORCXPND("Summary of Patient Procedures")
158 S I=4,BCNT=0
159 F S I=$O(^TMP("ORDATA",$J,1,I)) Q:I<1 S X=^(I) D
160 . I '$L(X) S BCNT=BCNT+1 I BCNT>1 Q
161 . I $E(X,1,4)="Pg. " Q
162 . I X["PHYSICIANS' SIGNATURE" Q
163 . S LCNT=LCNT+1,^TMP("ORXPND",$J,LCNT,0)=X S:$L(X) BCNT=0
164 K ^TMP("ORDATA",$J)
165 Q
Note: See TracBrowser for help on using the repository browser.