source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRP1A.m@ 810

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

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1ORWRP1A ; slc/dcm - Report Calls Cont. ;5/8/01 09:27
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**109,160**;Dec 17, 1997
3BCMA1(OROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;BCMA Med Log
4 Q:'$G(ORDFN)
5 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
6 Q:'$G(ALPHA) Q:'$G(OMEGA)
7 I $L($T(RPC^PSBO)) D RPC^PSBO(.OROOT,"ML",ORDFN,ALPHA,OMEGA,"0^0^0^0^1^1")
8 I '$L($G(OROOT)) Q
9 I '$O(@OROOT@(0)) S @OROOT@(1)="",@OROOT@(2)="No report available..."
10 Q
11BCMA2(OROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ;BCMA MAH Report
12 Q:'$G(ORDFN)
13 I $L($G(DTRANGE)),'$G(ALPHA) S ALPHA=$$FMADD^XLFDT(DT,-DTRANGE),OMEGA=$$NOW^XLFDT
14 Q:'$G(ALPHA) Q:'$G(OMEGA)
15 I $L($T(RPC^PSBO)) D RPC^PSBO(.OROOT,"MH",ORDFN,ALPHA,OMEGA,"")
16 I '$L($G(OROOT)) Q
17 I '$O(@OROOT@(0)) S @OROOT@(1)="",@OROOT@(2)="No report available..."
18 Q
19EM(OROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get Electron Microscopy Report
20 N I,C,LINES,X,ORSBHEAD,ORZIP
21 K ^TMP("LRC",$J),^TMP("LRH",$J)
22 S ORSBHEAD("EM")=""
23 D EN^LR7OSUM(.ORZIP,ORDFN,,,,80,.ORSBHEAD)
24 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No EM reports available..."
25 S OROOT=$NA(^TMP("LRC",$J))
26 K ^TMP("LRH",$J)
27 Q
28CY(OROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get Cytology Report
29 N I,C,LINES,X,ORSBHEAD,ORZIP
30 K ^TMP("LRC",$J),^TMP("LRH",$J)
31 S ORSBHEAD("CYTOPATHOLOGY")=""
32 D EN^LR7OSUM(.ORZIP,ORDFN,,,,80,.ORSBHEAD)
33 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Cytology reports available..."
34 S OROOT=$NA(^TMP("LRC",$J))
35 K ^TMP("LRH",$J)
36 Q
37SP(OROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get Surgical Pathology Report
38 N I,C,LINES,X,ORSBHEAD,ORZIP
39 K ^TMP("LRC",$J),^TMP("LRH",$J)
40 S ORSBHEAD("SURGICAL PATHOLOGY")=""
41 D EN^LR7OSUM(.ORZIP,ORDFN,,,,80,.ORSBHEAD)
42 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Surgical Pathology reports available..."
43 S OROOT=$NA(^TMP("LRC",$J))
44 K ^TMP("LRH",$J)
45 Q
46AU(OROOT,ORDFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,ORMAX,ORFHIE) ; -- get Autopsy Report
47 N I,C,LINES,X,ORSBHEAD,ORZIP
48 K ^TMP("LRC",$J),^TMP("LRH",$J)
49 S ORSBHEAD("AUTOPSY")=""
50 D EN^LR7OSUM(.ORZIP,ORDFN,,,,80,.ORSBHEAD)
51 I '$O(^TMP("LRC",$J,0)) S ^TMP("LRC",$J,1,0)="",^TMP("LRC",$J,2,0)="No Autopsy report available..."
52 S OROOT=$NA(^TMP("LRC",$J))
53 K ^TMP("LRH",$J)
54 Q
Note: See TracBrowser for help on using the repository browser.