source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRP1.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 9.5 KB
Line 
1ORWRP1 ; ALB/MJK,dcm Report Calls ;9/18/96 15:02
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,160,262**;Dec 17, 1997;Build 3
3 ;
4AHS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - get adhoc health summary report
5 D START^ORWRP(80,"AHSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
6 Q
7AHSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -build adhoc health summary
8 N ORVP,GMTYP,Y
9 S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTSTYP=+ORHS
10 D ADHOC^ORPRS13
11 Q
12HS(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - get health summary report
13 D START^ORWRP(80,"HSB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
14 Q
15HSB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - build health summary report
16 N I,ICN,ORVP,GMTYP,Y,GMARXN,GMTSDLM,GMTSDTC,GMTSE,GMTSEGH,GMTSEGL,GMTSEGN,GMTSEGR,GMSEQ,GMTSHDR,GMTSLCMP,GMTSNDM,GMTSNPK,GMTSPG,GMTSPHDR,X
17 I $G(REMOTE) D Q:'ORHS
18 . S Y=$O(^GMT(142,"E",$P(ORHS,";",2),0))
19 . I 'Y S Y=$O(^GMT(142,"E",$P($$UPPER^ORU(ORHS),";",2),0))
20 . I 'Y S I=0 F S I=$O(^GMT(142,I)) Q:'I I $L($P($G(^GMT(142,I,"T")),"^")),$P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(^("T")) S Y=I Q
21 . I 'Y S Y=$O(^GMT(142,"B",$P(ORHS,";",2),0))
22 . I 'Y S Y=$O(^GMT(142,"B",$P($$UPPER^ORU(ORHS),";",2),0))
23 . I 'Y S I=0 F S I=$O(^GMT(142,I)) Q:'I S X=$P(^(I,0),"^") I $P($$UPPER^ORU(ORHS),";",2)=$$UPPER^ORU(X) S Y=I Q
24 . I 'Y U IO W !,ORHS_" not found on remote system",! S ORHS=Y Q
25 . S ORHS=Y
26 I +$G(ORHS)<1 W !,"Report not Available" Q
27 S ORVP=ORDFN_";DPT(",Y=$P($G(^GMT(142,+ORHS,0)),U),GMTYP(0)=1,GMTYP(1)=+ORHS_U_Y_U_Y_U_Y
28 D PQ^ORPRS13
29 Q
30HSTYPE(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - Get HS type report
31 D START^ORWRP(80,"HSTYPEB^ORWRP1(.ROOT,.ORDFN,.ORHS,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
32 Q
33HSTYPEB(ROOT,ORDFN,ORHS,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; - Build HS type report
34 N GMTSQIT,GMTSPRM,GMTSTITL,GMTSPX2,GMTSPX1
35 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
36 Q:'$G(ALPHA) Q:'$G(OMEGA)
37 I +$G(ORHS)<1 W !,"Report not Available" Q
38 S GMTSQIT=1,GMTSPRM=$P($G(^GMT(142.1,+ORHS,0)),"^",4),GMTSTITL="",GMTSPX2=ALPHA,GMTSPX1=OMEGA,DFN=ORDFN
39 D ENCWA^GMTS
40 Q
41HSGUI(DFN,GMTSTYP) ; - Call ENX^GMTSDVR to print HS Type for Patient
42 D ENX^GMTSDVR(DFN,GMTSTYP)
43 Q
44BLR(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get 'enhanced' blood bank report
45 N DFN,ORY,ORSBHEAD
46 S DFN=ORDFN
47 I $L($T(EN^ORWLR1)),$L($T(CPRS^VBECA3B)) D Q ;Transition to VBEC's interface
48 . K ^TMP("ORLRC",$J)
49 . D EN^ORWLR1(DFN)
50 . I '$O(^TMP("ORLRC",$J,0)) S ^TMP("ORLRC",$J,1,0)="",^TMP("ORLRC",$J,2,0)="No Blood Bank report available..."
51 . S ROOT=$NA(^TMP("ORLRC",$J))
52 K ^TMP("LRC",$J)
53 S ORSBHEAD("BLOOD BANK")=""
54 D EN^LR7OSUM(.ORY,DFN,,,,,.ORSBHEAD)
55 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Blood Bank report available..."
56 S ROOT=$NA(^TMP("LRC",$J))
57 Q
58AP(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get Anatomic path report
59 N I,C,LINES,X
60 K ^TMP("LRC",$J),^TMP("LRH",$J)
61 D AP^LR7OSUM(ORDFN)
62 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Anatomic Pathology reports available..."
63 S I=0
64 I $L($O(^TMP("LRH",$J,0))) S I=.001,^TMP("LRC",$J,I)="[HIDDEN TEXT]^" D
65 . S X="",C=2 F S X=$O(^TMP("LRH",$J,X)) Q:X="" S LINES(^(X))=X,C=C+1
66 . S $P(^TMP("LRC",$J,.001),"^",2)=C
67 . S X="" F S X=$O(LINES(X)) Q:X="" D
68 .. S I=I+.001,^TMP("LRC",$J,I)=X_"^"_LINES(X)
69 . S I=I+.001,^TMP("LRC",$J,I)="[REPORT TEXT]"
70 S ROOT=$NA(^TMP("LRC",$J))
71 K ^TMP("LRH",$J)
72 Q
73DIET(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get dietetics profile
74 N LCNT,ORVP
75 S LCNT=0,ORVP=DFN_";DPT("
76 D FHP^ORCXPNDR
77 S ROOT=$NA(^TMP("ORXPND",$J))
78 Q
79LISTNUTR(ROOT,DFN) ; -- list nutritional assessments
80 N OK,I,X
81 K ^TMP($J,"FHADT")
82 S OK=$$FHWORADT^FHWORA(DFN)
83 S I=0,SITE=$$SITE^VASITE,SITE=$P(SITE,"^",2)_";"_$P(SITE,"^",3)
84 F S I=$O(^TMP($J,"FHADT",DFN,I)) Q:'I S X=SITE_U_I_U_^(I),^(I)=X
85 S ROOT=$NA(^TMP($J,"FHADT",DFN))
86 Q
87NUTR(ROOT,DFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- get nutritional assessment
88 N LCNT,ORVP
89 K ^TMP("ORXPND",$J)
90 S LCNT=0,ORVP=DFN_";DPT(",ID=DFN_";"_ID
91 D FHA^ORCXPNDR
92 S ROOT=$NA(^TMP("ORXPND",$J))
93 Q
94VITALS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- get vitals report
95 D START^ORWRP(132,"VITALSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
96 Q
97VITALSB(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ; -- build vitals report
98 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
99 Q:'$G(ORDFN)
100 I $L(ORDTRNG),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-ORDTRNG),OMEGA=$$NOW^XLFDT
101 Q:'$G(ALPHA) Q:'$G(OMEGA)
102 I '$P(OMEGA,".",2) S OMEGA=OMEGA_".2359"
103 S ORVP=ORDFN_";DPT(",XQORNOD=1,ORSSTRT(XQORNOD)=ALPHA,ORSSTOP(XQORNOD)=OMEGA
104 D VITCUM^ORPRS14
105 Q
106STAT(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Lab Order Status
107 N ORVP
108 K ^TMP("ORDATA",$J)
109 S ORVP=ORDFN_";DPT("
110 D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDTRNG)
111 I '$O(^TMP("ORDATA",$J,1,0)) S ^TMP("ORDATA",$J,1,1,0)="",^TMP("ORDATA",$J,1,2,0)="No Orders found..."
112 S ROOT=ORY
113 Q
114INTERIM(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Lab Interim
115 D START^ORWRP(80,"INTERIMB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
116 Q
117INTERIMB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Build Interim
118 Q:'$G(DFN) Q:'$G(ALPHA) Q:'$G(OMEGA)
119 N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LRACC,LRAD,LRAN,LRRT,LRPG,LRSB,LREDT,LRIDT
120 S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRIDT)=(9999999-OMEGA)
121 D OERR^LRRP4,CLEAN^LRRP4
122 Q
123LRGEN(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Lab results by test
124 D START^ORWRP(80,"LRGENB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
125 Q
126LRGENB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Build Results
127 Q:'$G(DFN) Q:'$G(ALPHA) Q:'$G(OMEGA)
128 N ORVP,ORSSTRT,ORSSTOP,LREDT,LRSDT,XQORNOD
129 S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=(9999999-ALPHA),(ORSSTOP(XQORNOD),LRSDT)=(9999999-OMEGA)
130 D SET1^LRGEN,CLEAN^LRRP4
131 K LRPR
132 Q
133GRAPH(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Graph labs
134 D START^ORWRP(80,"GRAPHB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
135 Q
136GRAPHB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Graph labs
137 Q:'$G(DFN) Q:'$G(ALPHA) Q:'$G(OMEGA)
138 N ORVP,XQORNOD,ORSSTRT,ORSSTOP,LREDT,LRSDT
139 S ORVP=DFN_";DPT(",XQORNOD=1,(ORSSTRT(XQORNOD),LREDT)=ALPHA,(ORSSTOP(XQORNOD),LRSDT)=OMEGA
140 D OERR^LRDIST4,CLEAN^LRDIST4
141 Q
142ORS(ROOT,ORDFN,ID,ALPHA,OMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Daily order summary
143 D START^ORWRP(80,"ORSB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
144 Q
145ORSB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Daily order summary
146 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
147 S ORVP=DFN_";DPT(",XQORNOD=1,X1=DT,X2=-$S(DTRANGE:DTRANGE-1,1:0)
148 D C^%DTC
149 S ORSSTRT=X-.7641,ORSSTOP=DT+.2359
150 D DAY^ORPRS02
151 Q
152ORD(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Order Summary for Date Range
153 D START^ORWRP(80,"ORDB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORMAX,.ORFHIE)")
154 Q
155ORDB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Order Summary for Date Range
156 Q:'$G(DFN)
157 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
158 Q:'$G(ALPHA) Q:'$G(OMEGA)
159 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
160 S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
161 D RANGE^ORPRS02
162 Q
163ORC(ROOT,ORDFN,ID,ORALPHA,OROMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Custom order summary
164 D START^ORWRP(80,"ORCB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
165 Q
166ORCB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Custom order summary build
167 Q:'$G(DFN) Q:'$G(ALPHA) Q:'$G(OMEGA)
168 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
169 S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
170 D CUSTOM^ORPRS02
171 Q
172ORP(ROOT,ORDFN,ID,ORALPHA,OROMEGA,ORDTRNG,REMOTE,ORMAX,ORFHIE) ;Chart copy summary
173 D START^ORWRP(80,"ORPB^ORWRP1(.ROOT,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE,.ORFHIE)")
174 Q
175ORPB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Chart copy summary
176 Q:'$G(DFN)
177 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
178 Q:'$G(ALPHA) Q:'$G(OMEGA)
179 N ORVP,XQORNOD,ORSSTRT,ORSSTOP
180 S ORVP=DFN_";DPT(",XQORNOD=1,ORSSTRT=ALPHA,ORSSTOP=OMEGA
181 D CHART^ORPRS02
182 Q
183PSO(ROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Outpatient RX Profile
184 D START^ORWRP(80,"PSOB^ORWRP1(.ROOT,.ORDFN,.ID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORFHIE)")
185 Q
186PSOB(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Outpatient RX Action Profile
187 N ORVP,PSTYPE,PSONOPG
188 S ORVP=DFN_";DPT(",PSTYPE=1,PSONOPG=2
189 D DFN^PSOSD1
190 Q
191MED(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Medicine Summary of Procedures
192 D START^ORWRP(80,"MEDB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
193 Q
194MEDB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Medicine Summary of Procedures
195 Q:'$L($G(IID))
196 N ORVP,XQY0,OT,MCARPPS,MCPRO,MCARGRTN,DXS,SSN,I,J,L,DA,MCARGDA
197 S ORVP=DFN_";DPT(",XQY0="",OT=$G(^TMP("OR",$J,"MCAR","OT",IID))
198 Q:'$L(OT)
199 S (DA,MCARGDA)=$P(OT,U,2),MCARPPS=$P(OT,U,3,4),MCPRO=$P(OT,U,11)
200 D MCPPROC^MCARP
201 S MCARGRTN=$P(OT,U,5)
202 D @MCARPPS
203 Q
204PROB(ROOT,ORDFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; Problem List (Problem Tab)
205 D START^ORWRP(80,"PROBB^ORWRP1(.ROOT,.ORDFN,.IID,.ALPHA,.OMEGA,.DTRANGE,.REMOTE,.ORMAX,.ORFHIE)")
206 Q
207PROBB(ROOT,DFN,IID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;Problem List
208 N ORSILENT S ORSILENT=1
209 D VAF^GMPLUTL2(DFN,ORSILENT)
210 Q
Note: See TracBrowser for help on using the repository browser.