ORPR05 ; slc/dcm - When you are in the Service copies... ; 07 Dec 99 01:43PM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**69**;Dec 17, 1997
SRV1 ;
N ORTCNT,ORX,OR3,ORPK,ORTCNT,ORPKG,ORSNUM
D GET^ORPR01(ORIFN)
S ORPKG=$P(ORX,"^",14) I $D(OROPKG),(OROPKG'=ORPKG) S ORSNUM=1 D FOOT^ORPR01(ORFOOT) W @ORIOF
D SRVSET
I +ORFMT'>0,'+$G(OREND) W:$E(IOST)="C" $C(7),!!,"SERVICE COPY FORMAT is NOT defined for "_ORPKNM_".",!! H 1 Q
Q:+$P(OR3,"^",9)>0
D CPRINT^ORPR01(ORIFN)
Q
SCSORT ; Sorts selected orders by package
N ORPKG,ORI,ORJ,ORIFN,ORSORT
F ORI=1:1:$L(ORNMBR,",") S ORJ=$P(ORNMBR,",",ORI) I ORJ S ORIFN=$G(^XTMP(ORXTMP,ORJ)) I ORIFN]"" D
. S ORPKG=$P($G(^OR(100,+ORIFN,0)),U,14),ORSORT(ORPKG,ORJ)=""
I $O(ORSORT(0)) D
. S ORPKG=0,ORNMBR="" F S ORPKG=$O(ORSORT(ORPKG)) Q:ORPKG'>0 D
.. S ORI=0 F S ORI=$O(ORSORT(ORPKG,ORI)) Q:ORI'>0 D
... S ORNMBR=ORNMBR_ORI_","
Q
SRVSET ;Setup
;Input=PACKAGE
;Output=ORHEAD,ORFOOT
I $S('$G(ORPKG):1,ORPKG=$G(OROPKG):1,1:0) Q
S (OROFMT,ORFMT)=$$GET^XPAR("SYS","ORPF SERVICE COPY FORMAT",ORPKG,"I")
S ORHEAD=$$GET^XPAR("SYS","ORPF SERVICE COPY HEADER",ORPKG,"I")
S ORFOOT=$$GET^XPAR("SYS","ORPF SERVICE COPY FOOTER",ORPKG,"I")
S ORPKNM=$P($G(^DIC(9.4,+ORPKG,0)),U),ORIOSL=IOSL
I +ORFOOT,$D(^ORD(100.23,ORFOOT,0)) S ORBOT=$P(^(0),"^",2),ORIOSL=IOSL-ORBOT,OROPKG=ORPKG
S ORIOF=IOF I +ORHEAD D PRINT^ORPR00(ORHEAD,1)
S IOF="!" I +OROFMT S ORFMT=OROFMT
Q
SRVCLN ;Cleanup
G:+$G(OREND) SCCLEANX
I $G(ORFOOT) S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))="" D PRINT^ORPR00(ORFOOT,1)
SCCLEANX S:$D(ORIOF) IOF=ORIOF K ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL,ORPKG
K OROPKG,ORPKNM,ORPKNO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPR05 1710 printed Nov 22, 2024@17:42:36 Page 2
ORPR05 ; slc/dcm - When you are in the Service copies... ; 07 Dec 99 01:43PM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**69**;Dec 17, 1997
SRV1 ;
+1 NEW ORTCNT,ORX,OR3,ORPK,ORTCNT,ORPKG,ORSNUM
+2 DO GET^ORPR01(ORIFN)
+3 SET ORPKG=$PIECE(ORX,"^",14)
IF $DATA(OROPKG)
IF (OROPKG'=ORPKG)
SET ORSNUM=1
DO FOOT^ORPR01(ORFOOT)
WRITE @ORIOF
+4 DO SRVSET
+5 IF +ORFMT'>0
IF '+$GET(OREND)
if $EXTRACT(IOST)="C"
WRITE $CHAR(7),!!,"SERVICE COPY FORMAT is NOT defined for "_ORPKNM_".",!!
HANG 1
QUIT
+6 if +$PIECE(OR3,"^",9)>0
QUIT
+7 DO CPRINT^ORPR01(ORIFN)
+8 QUIT
SCSORT ; Sorts selected orders by package
+1 NEW ORPKG,ORI,ORJ,ORIFN,ORSORT
+2 FOR ORI=1:1:$LENGTH(ORNMBR,",")
SET ORJ=$PIECE(ORNMBR,",",ORI)
IF ORJ
SET ORIFN=$GET(^XTMP(ORXTMP,ORJ))
IF ORIFN]""
Begin DoDot:1
+3 SET ORPKG=$PIECE($GET(^OR(100,+ORIFN,0)),U,14)
SET ORSORT(ORPKG,ORJ)=""
End DoDot:1
+4 IF $ORDER(ORSORT(0))
Begin DoDot:1
+5 SET ORPKG=0
SET ORNMBR=""
FOR
SET ORPKG=$ORDER(ORSORT(ORPKG))
if ORPKG'>0
QUIT
Begin DoDot:2
+6 SET ORI=0
FOR
SET ORI=$ORDER(ORSORT(ORPKG,ORI))
if ORI'>0
QUIT
Begin DoDot:3
+7 SET ORNMBR=ORNMBR_ORI_","
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
SRVSET ;Setup
+1 ;Input=PACKAGE
+2 ;Output=ORHEAD,ORFOOT
+3 IF $SELECT('$GET(ORPKG):1,ORPKG=$GET(OROPKG):1,1:0)
QUIT
+4 SET (OROFMT,ORFMT)=$$GET^XPAR("SYS","ORPF SERVICE COPY FORMAT",ORPKG,"I")
+5 SET ORHEAD=$$GET^XPAR("SYS","ORPF SERVICE COPY HEADER",ORPKG,"I")
+6 SET ORFOOT=$$GET^XPAR("SYS","ORPF SERVICE COPY FOOTER",ORPKG,"I")
+7 SET ORPKNM=$PIECE($GET(^DIC(9.4,+ORPKG,0)),U)
SET ORIOSL=IOSL
+8 IF +ORFOOT
IF $DATA(^ORD(100.23,ORFOOT,0))
SET ORBOT=$PIECE(^(0),"^",2)
SET ORIOSL=IOSL-ORBOT
SET OROPKG=ORPKG
+9 SET ORIOF=IOF
IF +ORHEAD
DO PRINT^ORPR00(ORHEAD,1)
+10 SET IOF="!"
IF +OROFMT
SET ORFMT=OROFMT
+11 QUIT
SRVCLN ;Cleanup
+1 if +$GET(OREND)
GOTO SCCLEANX
+2 IF $GET(ORFOOT)
if IOF?1"!"."!"
SET $PIECE(IOF,"!",$SELECT(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))=""
DO PRINT^ORPR00(ORFOOT,1)
SCCLEANX if $DATA(ORIOF)
SET IOF=ORIOF
KILL ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL,ORPKG
+1 KILL OROPKG,ORPKNM,ORPKNO
+2 QUIT
