ORPR08.m

ORPR08 ; slc/dcm - Work Copies ; 07 Dec 99  01:43PM

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**69,132**;Dec 17, 1997

WRK ;

 I '$S($P($G(^OR(100,+ORIFN,3)),"^",3)'=11:1,1:0) Q

 N ORX,OR3,ORPK,ORTCNT,ORPKG

 D GET^ORPR01(ORIFN)

 Q:'$L(ORX)

 D CPRINT^ORPR01(ORIFN)

 Q

WRKSET ;Setup

 S ORXPND=$$GET^XPAR("ALL","ORPF EXPAND CONTINUOUS ORDERS",1,"I")

 S ORHEAD=$$GET^XPAR("ALL","ORPF WORK COPY HEADER",1,"I")

 S ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")

 S (OROFMT,ORFMT)=$$GET^XPAR("ALL","ORPF WORK COPY FORMAT",1,"I")

 S ORIOSL=IOSL I +ORFOOT,$D(^ORD(100.23,ORFOOT,0)) S ORBOT=$P(^(0),"^",2),ORIOSL=IOSL-ORBOT

 S ORIOF=IOF I +ORHEAD D PRINT^ORPR00(ORHEAD,1)

 S IOF="!" I +OROFMT S ORFMT=OROFMT

 Q

WRKCLN ;Cleanup

 G:+$G(OREND) WKCX

 S ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")

 I +ORFOOT S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))="" D PRINT^ORPR00(ORFOOT,1)

 I $E(IOST)="C" D

 . N DIR S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"

 . D ^DIR I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S OREND=1

WKCX S IOF=ORIOF K ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ORPR08   1163     printed  Apr 09, 2024@21:41:59                                                                                                                                                                                                      Page 2

ORPR08    ; slc/dcm - Work Copies ; 07 Dec 99  01:43PM

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**69,132**;Dec 17, 1997

WRK       ;

 +1        IF '$SELECT($PIECE($GET(^OR(100,+ORIFN,3)),"^",3)'=11:1,1:0)

               QUIT 

 +2        NEW ORX,OR3,ORPK,ORTCNT,ORPKG

 +3        DO GET^ORPR01(ORIFN)

 +4        if '$LENGTH(ORX)

               QUIT 

 +5        DO CPRINT^ORPR01(ORIFN)

 +6        QUIT 

WRKSET    ;Setup

 +1        SET ORXPND=$$GET^XPAR("ALL","ORPF EXPAND CONTINUOUS ORDERS",1,"I")

 +2        SET ORHEAD=$$GET^XPAR("ALL","ORPF WORK COPY HEADER",1,"I")

 +3        SET ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")

 +4        SET (OROFMT,ORFMT)=$$GET^XPAR("ALL","ORPF WORK COPY FORMAT",1,"I")

 +5        SET ORIOSL=IOSL

           IF +ORFOOT

               IF $DATA(^ORD(100.23,ORFOOT,0))

                   SET ORBOT=$PIECE(^(0),"^",2)

                   SET ORIOSL=IOSL-ORBOT

 +6        SET ORIOF=IOF

           IF +ORHEAD

               DO PRINT^ORPR00(ORHEAD,1)

 +7        SET IOF="!"

           IF +OROFMT

               SET ORFMT=OROFMT

 +8        QUIT 

WRKCLN    ;Cleanup

 +1        if +$GET(OREND)

               GOTO WKCX

 +2        SET ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")

 +3        IF +ORFOOT

               if IOF?1"!"."!"

                   SET $PIECE(IOF,"!",$SELECT(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))=""

               DO PRINT^ORPR00(ORFOOT,1)

 +4        IF $EXTRACT(IOST)="C"

               Begin DoDot:1

 +5                NEW DIR

                   SET DIR(0)="FO^1:1"

                   SET DIR("A")="Press RETURN to continue or '^' to exit"

 +6                DO ^DIR

                   IF $SELECT($DATA(DIROUT):1,$DATA(DUOUT):1,$DATA(DTOUT):1,1:0)

                       SET OREND=1

               End DoDot:1

WKCX       SET IOF=ORIOF

           KILL ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL

 +1        QUIT