source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPR05.m@ 1361

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1ORPR05 ; slc/dcm - When you are in the Service copies... ; 07 Dec 99 01:43PM
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**69**;Dec 17, 1997
3SRV1 ;
4 N ORTCNT,ORX,OR3,ORPK,ORTCNT,ORPKG,ORSNUM
5 D GET^ORPR01(ORIFN)
6 S ORPKG=$P(ORX,"^",14) I $D(OROPKG),(OROPKG'=ORPKG) S ORSNUM=1 D FOOT^ORPR01(ORFOOT) W @ORIOF
7 D SRVSET
8 I +ORFMT'>0,'+$G(OREND) W:$E(IOST)="C" $C(7),!!,"SERVICE COPY FORMAT is NOT defined for "_ORPKNM_".",!! H 1 Q
9 Q:+$P(OR3,"^",9)>0
10 D CPRINT^ORPR01(ORIFN)
11 Q
12SCSORT ; Sorts selected orders by package
13 N ORPKG,ORI,ORJ,ORIFN,ORSORT
14 F ORI=1:1:$L(ORNMBR,",") S ORJ=$P(ORNMBR,",",ORI) I ORJ S ORIFN=$G(^XTMP(ORXTMP,ORJ)) I ORIFN]"" D
15 . S ORPKG=$P($G(^OR(100,+ORIFN,0)),U,14),ORSORT(ORPKG,ORJ)=""
16 I $O(ORSORT(0)) D
17 . S ORPKG=0,ORNMBR="" F S ORPKG=$O(ORSORT(ORPKG)) Q:ORPKG'>0 D
18 .. S ORI=0 F S ORI=$O(ORSORT(ORPKG,ORI)) Q:ORI'>0 D
19 ... S ORNMBR=ORNMBR_ORI_","
20 Q
21SRVSET ;Setup
22 ;Input=PACKAGE
23 ;Output=ORHEAD,ORFOOT
24 I $S('$G(ORPKG):1,ORPKG=$G(OROPKG):1,1:0) Q
25 S (OROFMT,ORFMT)=$$GET^XPAR("SYS","ORPF SERVICE COPY FORMAT",ORPKG,"I")
26 S ORHEAD=$$GET^XPAR("SYS","ORPF SERVICE COPY HEADER",ORPKG,"I")
27 S ORFOOT=$$GET^XPAR("SYS","ORPF SERVICE COPY FOOTER",ORPKG,"I")
28 S ORPKNM=$P($G(^DIC(9.4,+ORPKG,0)),U),ORIOSL=IOSL
29 I +ORFOOT,$D(^ORD(100.23,ORFOOT,0)) S ORBOT=$P(^(0),"^",2),ORIOSL=IOSL-ORBOT,OROPKG=ORPKG
30 S ORIOF=IOF I +ORHEAD D PRINT^ORPR00(ORHEAD,1)
31 S IOF="!" I +OROFMT S ORFMT=OROFMT
32 Q
33SRVCLN ;Cleanup
34 G:+$G(OREND) SCCLEANX
35 I $G(ORFOOT) S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))="" D PRINT^ORPR00(ORFOOT,1)
36SCCLEANX S:$D(ORIOF) IOF=ORIOF K ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL,ORPKG
37 K OROPKG,ORPKNM,ORPKNO
38 Q
Note: See TracBrowser for help on using the repository browser.