| [613] | 1 | ORPR05 ; 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
 | 
|---|
 | 3 | SRV1 ;
 | 
|---|
 | 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
 | 
|---|
 | 12 | SCSORT ; 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
 | 
|---|
 | 21 | SRVSET ;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
 | 
|---|
 | 33 | SRVCLN ;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)
 | 
|---|
 | 36 | SCCLEANX S:$D(ORIOF) IOF=ORIOF K ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL,ORPKG
 | 
|---|
 | 37 |  K OROPKG,ORPKNM,ORPKNO
 | 
|---|
 | 38 |  Q
 | 
|---|