- 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 ---[H[J[2J[HORPR08 1163 printed Feb 18, 2025@23:59:15 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