Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORPR08

ORPR08.m

Go to the documentation of this file.
  1. ORPR08 ; slc/dcm - Work Copies ; 07 Dec 99 01:43PM
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**69,132**;Dec 17, 1997
  1. WRK ;
  1. I '$S($P($G(^OR(100,+ORIFN,3)),"^",3)'=11:1,1:0) Q
  1. N ORX,OR3,ORPK,ORTCNT,ORPKG
  1. D GET^ORPR01(ORIFN)
  1. Q:'$L(ORX)
  1. D CPRINT^ORPR01(ORIFN)
  1. Q
  1. WRKSET ;Setup
  1. S ORXPND=$$GET^XPAR("ALL","ORPF EXPAND CONTINUOUS ORDERS",1,"I")
  1. S ORHEAD=$$GET^XPAR("ALL","ORPF WORK COPY HEADER",1,"I")
  1. S ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")
  1. S (OROFMT,ORFMT)=$$GET^XPAR("ALL","ORPF WORK COPY FORMAT",1,"I")
  1. S ORIOSL=IOSL I +ORFOOT,$D(^ORD(100.23,ORFOOT,0)) S ORBOT=$P(^(0),"^",2),ORIOSL=IOSL-ORBOT
  1. S ORIOF=IOF I +ORHEAD D PRINT^ORPR00(ORHEAD,1)
  1. S IOF="!" I +OROFMT S ORFMT=OROFMT
  1. Q
  1. WRKCLN ;Cleanup
  1. G:+$G(OREND) WKCX
  1. S ORFOOT=$$GET^XPAR("ALL","ORPF WORK COPY FOOTER",1,"I")
  1. I +ORFOOT S:IOF?1"!"."!" $P(IOF,"!",$S(ORIOSL>200:200,ORIOSL-$Y>1:ORIOSL-$Y,1:2))="" D PRINT^ORPR00(ORFOOT,1)
  1. I $E(IOST)="C" D
  1. . N DIR S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
  1. . D ^DIR I $S($D(DIROUT):1,$D(DUOUT):1,$D(DTOUT):1,1:0) S OREND=1
  1. WKCX S IOF=ORIOF K ORHEAD,ORFOOT,OROFMT,ORFMT,ORIOF,ORBOT,ORIOSL
  1. Q