source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS03.m@ 1195

Last change on this file since 1195 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1ORPRS03 ; slc/dcm - (@) Formerly known as prints ;12/7/00 13:15
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69,92**;Dec 17, 1997
3EN ;Print orders
4 I $$S^%ZTLOAD S (ZTSTOP,OREND,DIROUT)=1 W !!,"TASKED Report stopped by "_$P(^VA(200,DUZ,0),U) Q
5 N DIRUT,DUOUT,ORBOT,ORSPG,ORLINE,YENKO,SHELBY,ORLST,ORREQ
6 N ORAGE,ORDOB,ORL,ORNP,ORPNM,ORPV,ORSEX,ORSSN,ORTS,ORWARD
7 I $G(ORNO),'$O(^TMP("ORR",$J,ORLIST,0)) Q
8 S YENKO=$$GET^XPAR("ALL","OR PRINT NO ORDERS ON SUM",1,"I"),SHELBY=$O(^TMP("ORR",$J,ORLIST,0))
9 ;YENKO=0 or "", if you don't want to print a page when no orders are present
10 ; 1 to print the page with "NO ORDERS" on it.
11 I 'YENKO,'SHELBY Q
12 S $P(ORLINE,"=",IOM+1)="",ORBOT=$S(IOSL<254:IOSL,1:254),Y=+ORVP
13 D END^ORUDPA
14 S ORREQ("O")=""
15 I '$G(ORSPG) S ORSPG=1 D
16 . I $E(IOST)="C" D CTOP^ORPRS05(ORSPG,$G(ORSEND),$G(ORSPG("EOP")),ORTIT,ORSHORT,ORL(0),ORL(1),ORWARD,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD)) Q
17 . D PTOP^ORPRS05(ORSPG,ORTIT,ORSHORT,ORSSTRT,ORSSTOP)
18 I '$O(^TMP("ORR",$J,ORLIST,0)) W !!?3,"No orders.",!!! D Q
19 . F I=$Y:1:ORBOT-5 W !
20 . I $E(IOST)="C" D Q
21 .. K Y F Q:$G(Y)["^"!($G(Y)=-1) K DIR S DIR(0)="FO^1;2",DIR("A")="Press RETURN to continue or '^' to exit" D ^DIR S:Y="" Y=-1 K DIR Q:Y<0 D
22 ... I Y'["^" W $C(7),!!,"Enter '^' to stop listing for current patient",!,"and '^^' to stop the entire report, or RETURN to continue"
23 . D PBOT^ORPRS05(1,ORBOT,ORPNM,ORSSN,ORDOB,ORAGE,$G(ORPD),ORL(0),ORL(1))
24 . W @IOF
25 . I '$G(ORSEND) Q
26 . W !!!!!?(IOM-44)\2,"***** E N D O F R E P O R T ****",!
27 . W @IOF
28 . K ORSEND,ORSPG,ORCONT
29 S (ORLST,OREND)=0
30 F S ORLST=$O(^TMP("ORR",$J,ORLIST,ORLST)) Q:'ORLST!$D(DUOUT) D PRT^ORPRS04
31 K ORSEND,ORSPG,ORCONT
32 Q
33ONE(ORIFN,ORSEQ,LENGTH) ;Single line format
34 N ORTX,OREL,ORSTS,ORASTS,ORSTRT,ORSTOP,ORFLAG,I,Z,X3
35 Q:'$D(^OR(100,ORIFN,3))
36 S ORSEQ=$G(ORSEQ),X3=^(3),ORSTS=$P(X3,"^",3),ORSTRT=$P(^(0),"^",8),ORSTOP=$P(^(0),"^",9),OREL=$S(ORSTS=11:1,1:"")
37 I $G(OACTION) I $D(^OR(100,ORIFN,8,OACTION,0)) S ORASTS=$P(^(0),"^",15)
38 D:'$D(ORTERM(5)) TERM^ORPRS01(IOST)
39 S ORFLAG=$$FLAG(ORIFN,ORTERM(5))
40 W !
41 S X=$P(ORTERM(5),"^")
42 S:ORFLAG X=$$INV^ORU
43 W ORSEQ_$S($L(ORSEQ)=1:" ",1:"")
44 S X=$P(ORTERM(5),"^",2)
45 S:ORFLAG X=$$INV^ORU
46 S X=$P(ORTERM(7),"^")
47 S:OREL X=$$INV^ORU
48 W $S($G(ORASTS)!(ORSTS):" "_$P(^ORD(100.01,$S($G(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
49 S:'$G(LENGTH) LENGTH=45
50 D TEXT^ORQ12(.ORTX,$S($G(OACTION):ORIFN_";"_OACTION,1:ORIFN),LENGTH)
51 F I=0:0 S I=$O(ORTX(I)) Q:'I W:I>1 ! W ?14,ORTX(I)
52 S Z=$S($D(ORDAD):$S(ORDAD:2,1:1),1:1)
53 I Z=2 S ORSTRT=$$FMTE^XLFDT(ORSTRT,"2M"),ORSTOP=$$FMTE^XLFDT(ORSTOP,"2M") W:($X+9+$L(ORSTRT)+$S($L(ORSTOP):$L(ORSTOP)+8,1:0))>(LENGTH+14) !?14 W " Start: "_ORSTRT W:$L(ORSTOP) " Stop: "_ORSTOP
54 I OREL S X=$P(ORTERM(7),"^",3),X=$$INV^ORU
55 Q
56PRT1(ORIFN,LENGTH) ;For kids sake
57 ;ORIFN=Internal order # of parent order
58 ;LENGTH=column width length
59 N ORCHLD
60 S ORCHLD=0
61 F S ORCHLD=$O(^OR(100,ORIFN,2,ORCHLD)) Q:ORCHLD<1 D:(($Y+5)>ORIOSL) WAIT Q:$G(OREND) D ONE(ORCHLD," ",$G(LENGTH))
62 Q
63FLAG(ORIFN,INVERSE) ;Is order flagged?
64 S X=""
65 I $D(^OR(100,ORIFN,6)),$P(^(6),"^"),$L($P($G(INVERSE),"^")),$L($P($G(INVERSE),"^",2)) S X=1
66 Q X
67WAIT ;
68 I $G(ORFOOT) D Q
69 . W ?(IOM-15),"(continued...)"
70 . D FOOT^ORPR01(ORFOOT)
71 . I '$G(OREND),$G(ORHEAD) D HEAD^ORPR01(ORHEAD) W !,"(...continued)"
72 Q:$E(IOST)'="C"
73 D PGBRK^ORUHDR,TIT^ORUHDR:$D(ORTIT)
74 W:'$D(ORTIT)&($G(ORIOF)]"") @ORIOF
75 Q
Note: See TracBrowser for help on using the repository browser.