ORPR05.m

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

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