source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPR08.m@ 1450

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

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1ORPR08 ; slc/dcm - Work Copies ; 07 Dec 99 01:43PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**69,132**;Dec 17, 1997
3WRK ;
4 I '$S($P($G(^OR(100,+ORIFN,3)),"^",3)'=11:1,1:0) Q
5 N ORX,OR3,ORPK,ORTCNT,ORPKG
6 D GET^ORPR01(ORIFN)
7 Q:'$L(ORX)
8 D CPRINT^ORPR01(ORIFN)
9 Q
10WRKSET ;Setup
11 S ORXPND=$$GET^XPAR("ALL","ORPF EXPAND CONTINUOUS ORDERS",1,"I")
12 S ORHEAD=$$GET^XPAR("ALL","ORPF WORK COPY HEADER",1,"I")
13 S ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")
14 S (OROFMT,ORFMT)=$$GET^XPAR("ALL","ORPF WORK COPY FORMAT",1,"I")
15 S ORIOSL=IOSL I +ORFOOT,$D(^ORD(100.23,ORFOOT,0)) S ORBOT=$P(^(0),"^",2),ORIOSL=IOSL-ORBOT
16 S ORIOF=IOF I +ORHEAD D PRINT^ORPR00(ORHEAD,1)
17 S IOF="!" I +OROFMT S ORFMT=OROFMT
18 Q
19WRKCLN ;Cleanup
20 G:+$G(OREND) WKCX
21 S ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")
22 I +ORFOOT S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))="" D PRINT^ORPR00(ORFOOT,1)
23 I $E(IOST)="C" D
24 . N DIR S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
25 . D ^DIR I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S OREND=1
26WKCX S IOF=ORIOF K ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL
27 Q
Note: See TracBrowser for help on using the repository browser.