source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWRPL.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1ORWRPL ; slc/dcm - Background GUI Lab Print Driver;10:36 AM 14 Jan 2000 ; 08 Feb 2001 09:02AM [7/2/01 7:27am]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109**;Dec 17, 1997
3RPTLIST ; -- list of Lab reports
4 ; <ID> ^ <report name> ^ <qualifier type> ^
5 ; <qualifier type> = 0:none,2:DateTime
6 ;;21^Cumulative^2
7 ;;3^Interim^2
8 ;;4^Interim for Selected Tests^2
9 ;;20^Anatomic Path Report^0
10 ;;2^Blood Bank Report^0
11 ;;9^Microbiology Report^2
12 ;;10^Lab Status Report^2
13 ;;$$END
14 ;
15PRINT(ORY,ORIO,ORDFN,RPTID,ORDAYSBK,ORTESTS,ORALPHA,OROMEGA) ; -- print report entry point
16 ; See RPC definition for details on input and output parameters
17 IF '$$CHK() G PRINTQ
18 N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE
19 S ZTIO=ORIO,ZTDTH=$H
20 S ZTDESC="GUI Lab Report Print"
21 S ZTRTN="DEQUE^ORWRPL"
22 S ZTSAVE("ORDFN")="",ZTSAVE("RPTID")="",ZTSAVE("ORDAYSBK")="",ZTSAVE("DUZ(")="",ZTSAVE("ORTESTS(")="",ZTSAVE("ORALPHA")="",ZTSAVE("OROMEGA")=""
23 D ^%ZTLOAD
24 I $D(ZTSK) D
25 . S ORY="0^Report queued. (Task #"_ZTSK_")"
26 E D
27 . S ORY="99^Task Rejected."
28PRINTQ Q
29REMOTE(ORY,ORIO,ORDFN,RPTID,ORHANDS) ;Print data for remote sites
30 ; RPC: ORWRP PRINT REMOTE REPORT
31 N ZTDTH,ZTRTN,ZTSK,ZTDESC,ZTSAVE,I
32 S ZTIO=ORIO,ZTDTH=$H
33 S ZTDESC="Remote Lab Report Print"
34 S ZTRTN="DEQUE^ORWRPL"
35 F I="ORDFN","RPTID","ORHANDS(" S ZTSAVE(I)=""
36 D ^%ZTLOAD
37 I $D(ZTSK) D
38 . S ORY="0^Report queued. (Task #"_ZTSK_")"
39 E D
40 . S ORY="99^Task Rejected."
41 Q
42 ;
43PRINTW(ORTEXT,ORDFN,RPTID,ORDAYSBK,ORTESTS,ORALPHA,OROMEGA) ;Windows device print
44 N ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO
45 N IOM,IOSL,IOST,IOF,IOT,IOS
46 S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS"
47 S ORTEXT=$NA(^TMP(ORSUB,$J,1))
48 I '$$CHK() S @ORTEXT@(0)=ORY G PRINTWQ
49 S ORHFS=$$HFS^ORWRP()
50 D HFSOPEN^ORWRP("ORWRP",ORHFS,"W")
51 I POP D Q
52 . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file")
53 D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
54 N $ETRAP,$ESTACK
55 S $ETRAP="D ERR^ORWRP Q"
56 U IO
57 D DEQUE
58 D HFSCLOSE^ORWRP("ORWRP",ORHFS)
59PRINTWQ Q
60PRINTWR(ORTEXT,ORDFN,RPTID,ORHANDS) ;Windows Remote device print
61 N ZTQUEUED,ORHFS,ORSUB,ROOT,ORIO,ORHANDLE
62 N IOM,IOSL,IOST,IOF,IOT,IOS
63 S (ORSUB,ROOT)="ORDATA",ORIO="OR WINDOWS HFS",ORTEXT=$NA(^TMP(ORSUB,$J,1)),ORHANDLE="ORWRP"
64 S ORHFS=$$HFS^ORWRP()
65 D HFSOPEN^ORWRP(ORHANDLE,ORHFS,"W")
66 I POP D Q
67 . I $D(ROOT) D SETITEM^ORWRP(.ROOT,"ERROR: Unable to open HFS file")
68 D IOVAR^ORWRP(.ORIO,,,"P-WINHFS80")
69 N $ETRAP,$ESTACK
70 S $ETRAP="D ERR^ORWRP Q"
71 U IO
72 D DEQUE
73 D HFSCLOSE^ORWRP(ORHANDLE,ORHFS)
74 Q
75CHK() ; -- do checks for required data
76 N OROK,FALSE,TRUE,ORRPT,TXT
77 S FALSE=0,TRUE=1
78 IF $G(ORIO)']"" S OROK=FALSE,ORY="1^No device selected." G CHKQ
79 IF '$G(RPTID) S OROK=FALSE,ORY="2^No report specified." G CHKQ
80 ; -- get report definition
81 S (TXT,ORRPT)=""
82 F I=3:1 S TXT=$P($TEXT(RPTLIST+I),";;",2) Q:TXT="$$END"!(TXT="") I +TXT=RPTID S ORRPT=TXT Q
83 IF +ORRPT'=RPTID S OROK=FALSE,ORY="3^Report type specified is not valid." G CHKQ
84 IF $P(ORRPT,U,3)=2,'$G(ORDAYSBK),'$G(ORALPHA) S OROK=FALSE,ORY="4^No date range specified." G CHKQ
85 IF '$D(^DPT(+$G(ORDFN),0)) S OROK=FALSE,ORY="6^Patient specified is not valid." G CHKQ
86 S OROK=TRUE
87CHKQ Q OROK
88 ;
89DEQUE ; -- logic to print queued report
90 ; -- call build report logic
91 I '$O(ORHANDS(0)) D LOOP Q
92 N ORI,ORX
93 S ORI=0
94 F S ORI=$O(ORHANDS(ORI)) Q:'ORI S ORX=ORHANDS(ORI) D
95 . N ORY,PAGE,ORALPHA,OROMEGA,ORID
96 . D RTNDATA^XWBDRPC(.ORY,$P(ORX,"^",2))
97 . S:ORY="" ORY="ORY"
98 . S PAGE=1,ORALPHA=$P(ORX,"^",3),OROMEGA=$P(ORX,"^",4),ORID=$$ID(RPTID)
99 . D HEAD^ORWRPP1(ORDFN,PAGE,ORID,$P(ORX,"^"))
100 . D HURL^ORWRPP1(.ORY,ORDFN,ORID,1,$P(ORX,"^"))
101 Q
102ID(ID) ;Get Report ID
103 I ID=21 Q "LAB CUMULATIVE ("_ORALPHA_" - "_OROMEGA_")"
104 I ID=3 Q "LAB INTERIM ("_ORALPHA_" - "_OROMEGA_")"
105 I ID=4 Q "LAB INTERIM FOR SELECTED TESTS ("_ORALPHA_" - "_OROMEGA_")"
106 I ID=20 Q "PATIENT ANATOMIC PATHOLOGY REPORT"
107 I ID=2 Q "PATIENT BLOOD BANK REPORT"
108 I ID=9 Q "MICROBIOLOGY REPORT ("_ORALPHA_" - "_OROMEGA_")"
109 I ID=10 Q "PATIENT LAB ORDER STATUS REPORT ("_ORALPHA_" - "_OROMEGA_")"
110 Q ""
111LOOP ;
112 IF RPTID=21 D G DEQUEQ
113 . N ORY,PAGE,TEXT,X1,X2,X
114 . D CUM^ORWLR(.ORY,.ORDFN,.ORDAYSBK,.ORALPHA,.OROMEGA)
115 . Q:'$L(ORY)
116 . S PAGE=1,X1=DT,X2=-$G(ORDAYSBK,7)
117 . D C^%DTC
118 . S TEXT="LAB CUMULATIVE ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
119 . D HEAD^ORWRPP1(ORDFN,PAGE,TEXT,$G(STATION))
120 . D HURL^ORWRPP1(.ORY,ORDFN,TEXT)
121 IF RPTID=3 D G DEQUEQ
122 . N ORY,PAGE,TEXT,X
123 . I $L(ORDAYSBK),'$G(ORALPHA) S ORALPHA=$$FMADD^XLFDT(DT,-ORDAYSBK),OROMEGA=$$NOW^XLFDT
124 . Q:'$G(ORALPHA) Q:'$G(OROMEGA)
125 . D INTERIM^ORWLRR(.ORY,.ORDFN,OROMEGA,.ORALPHA)
126 . Q:'$L(ORY)
127 . S PAGE=1,TEXT="LAB INTERIM ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
128 . D HEAD^ORWRPP1(ORDFN,PAGE,TEXT,$G(STATION))
129 . D HURL^ORWRPP1(.ORY,ORDFN,TEXT,1)
130 IF RPTID=4 D G DEQUEQ
131 . N ORY,PAGE,TEXT,X
132 . I $L(ORDAYSBK),'$G(ORALPHA) S ORALPHA=$$FMADD^XLFDT(DT,-ORDAYSBK),OROMEGA=$$NOW^XLFDT
133 . Q:'$G(ORALPHA) Q:'$G(OROMEGA)
134 . D INTERIMS^ORWLRR(.ORY,.ORDFN,.OROMEGA,.ORALPHA,.ORTESTS)
135 . Q:'$L(ORY)
136 . S PAGE=1,TEXT="LAB INTERIM FOR SELECTED TESTS ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
137 . D HEAD^ORWRPP1(ORDFN,PAGE,TEXT,$G(STATION))
138 . D HURL^ORWRPP1(.ORY,ORDFN,TEXT,1)
139 IF RPTID=20 D G DEQUEQ
140 . N ORY,PAGE
141 . D AP^ORWRP1(.ORY,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDTRNG,.REMOTE)
142 . Q:'$L(ORY)
143 . S PAGE=1
144 . D HEAD^ORWRPP1(ORDFN,PAGE,"PATIENT ANATOMIC PATHOLOGY REPORT",$G(STATION))
145 . D HURL^ORWRPP1(.ORY,ORDFN,"PATIENT ANATOMIC PATHOLOGY REPORT")
146 IF RPTID=2 D G DEQUEQ
147 . N ORY,PAGE
148 . D BLR^ORWRP1(.ORY,.ORDFN,.ID,.ORALPHA,.OROMEGA,.ORDAYSBK,.REMOTE)
149 . Q:'$L(ORY)
150 . S PAGE=1
151 . D HEAD^ORWRPP1(ORDFN,PAGE,"PATIENT BLOOD BANK REPORT",$G(STATION))
152 . D HURL^ORWRPP1(.ORY,ORDFN,"PATIENT BLOOD BANK REPORT")
153 IF RPTID=9 D G DEQUEQ
154 . N ORY,PAGE,TEXT,X
155 . I $L(ORDAYSBK),'$G(ORALPHA) S ORALPHA=$$FMADD^XLFDT(DT,-ORDAYSBK),OROMEGA=$$NOW^XLFDT
156 . Q:'$G(ORALPHA) Q:'$G(OROMEGA)
157 . D MICRO^ORWLRR(.ORY,.ORDFN,.OROMEGA,.ORALPHA)
158 . Q:'$L(ORY)
159 . S PAGE=1,TEXT="MICROBIOLOGY REPORT ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
160 . D HEAD^ORWRPP1(ORDFN,PAGE,TEXT,$G(STATION))
161 . D HURL^ORWRPP1(.ORY,ORDFN,TEXT,1)
162 IF RPTID=10 D G DEQUEQ
163 . N ORY,PAGE,TEXT,X,ORVP
164 . S ORVP=ORDFN_";DPT("
165 . D EN1^LR7OSOS1(.ORY,ORVP,.ORALPHA,.OROMEGA,.ORDAYSBK)
166 . I '$O(^TMP("ORDATA",$J,1,0)) S ^TMP("ORDATA",$J,1,1,0)="",^TMP("ORDATA",$J,1,2,0)="No Orders found..."
167 . S PAGE=1,TEXT="PATIENT LAB ORDER STATUS REPORT ("_$$FMTE^XLFDT(ORALPHA)_" - "_$$FMTE^XLFDT(OROMEGA)_")"
168 . D HEAD^ORWRPP1(ORDFN,PAGE,TEXT,$G(STATION))
169 . D HURL^ORWRPP1(.ORY,ORDFN,TEXT)
170DEQUEQ Q
Note: See TracBrowser for help on using the repository browser.