source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPR09.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1ORPR09 ; slc/dcm - Getting Consults pre-formatted output ;12/21/98 12:16
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
3EN(Y,ORIFN,QUIET) ;Get consult report
4 I $G(ORTEST) D TEST Q
5 Q:'$L($T(GUI^GMRCP5))
6 N IEN,ARRAY,OREND,CNT,I
7 Q:'$D(^OR(100,+$G(ORIFN),0)) Q:'$G(^(4)) S IEN=+^(4)
8 S ARRAY="",CNT=1
9 D GUI^GMRCP5(.ARRAY,IEN)
10 S I=499999.9 F S I=$O(@ARRAY@(1,I)) Q:'I!(I>599999.9) S CNT=CNT+1
11 I $G(QUIET) K Y S (I,Y)=0 D Q
12 . S ORPICKUP=1,Y=$E(ARRAY,1,($L(ARRAY)-1))_",1)"
13 U IO
14 I '$D(ORIOSL) N ORIOSL S ORIOSL=$S($D(IOSL):IOSL,1:50)
15 I '$D(ORIOF) N ORIOF S ORIOF=$S($D(IOF):IOF,1:"!")
16 I $G(ORFIRST1)=0,$Y>ORIOSL W @ORIOF
17 D HEAD()
18 D TEXTOUT(ARRAY,299999.9,399999.9,1,$S($E(IOST)="C":2,1:CNT))
19 I $E(IOST)="C",$Y+CNT>ORIOSL D PGBRK^ORUHDR W @ORIOF
20 D FOOT(CNT)
21 I $E(IOST)="C" D PGBRK^ORUHDR
22 K @ARRAY
23 Q
24TEXTOUT(OROOT,START,END,FFCHK,CNT) ;Non DIWP text function that Raps for ^TMP arays
25 I '$L($G(OROOT)) Q
26 N X,ORI
27 S ORI=$S($G(START):START,1:0),END=$S($G(END):END,1:99999999999)
28 F S ORI=$O(@OROOT@(1,ORI)) Q:'ORI!(ORI>END) S X=$S($L($G(@OROOT@(1,ORI))):@OROOT@(1,ORI),$L($G(@OROOT@(1,ORI,0))):@OROOT@(1,ORI,0),1:"") D:$G(FFCHK) FEED(CNT) Q:$G(OREND) W !,X
29 Q
30TEST ;Test the output
31 W !,"This format does the entire consult report and cannot be customized"
32 W !,"There is no need for a separate Header and Footer formats."
33 W !,"..."
34 Q
35TEST1 ;Test for Consult Body only
36 W !,"This format does the 'body' of the consult report"
37 W !,"Headers and Footers have to be added to the report"
38 W !,"format for a complete report."
39 Q
40FEED(CNT) ;Roomcheck
41 Q:$G(ORTEST)
42 I $Y+CNT<ORIOSL Q
43 I $E(IOST)'="C" D FOOT(CNT)
44 I $E(IOST)="C" D PGBRK^ORUHDR W @ORIOF
45 I $E(IOST)'="C" D HEAD(1)
46 Q
47HEAD(FF) ;Header
48 I $G(FF)!($E(IOST)="C") W @ORIOF
49 D TEXTOUT(ARRAY,99999.9,199999.9,,1)
50 Q
51FOOT(CNT) ;Footer
52 F Q:$Y+$G(CNT)>(ORIOSL-1) W !
53 D TEXTOUT(ARRAY,499999.9,599999.9,,1)
54 Q
55EN1(Y,ORIFN,QUIET) ;Get consult report (Body only)
56 I $G(ORTEST) D TEST1 Q
57 Q:'$L($T(GUI^GMRCP5))
58 N IEN,ARRAY,OREND,CNT,I
59 Q:'$D(^OR(100,+$G(ORIFN),0)) Q:'$G(^(4)) S IEN=+^(4)
60 S ARRAY="",CNT=1
61 D GUI^GMRCP5(.ARRAY,IEN)
62 S I=99999.9 F S I=$O(@ARRAY@(1,I)) Q:'I!(I>199999.9) K @ARRAY@(1,I) ;Remove header
63 S I=499999.9 F S I=$O(@ARRAY@(1,I)) Q:'I!(I>599999.9) K @ARRAY@(1,I) ;Remove footer
64 I $G(QUIET) K Y S (I,Y)=0 D Q
65 . S ORPICKUP=1,Y=$E(ARRAY,1,($L(ARRAY)-1))_",1)"
66 U IO
67 I '$D(ORIOSL) N ORIOSL S ORIOSL=$S($D(IOSL):IOSL,1:50)
68 I '$D(ORIOF) N ORIOF S ORIOF=$S($D(IOF):IOF,1:"!")
69 I $G(ORFIRST1)=0,$Y>ORIOSL W @ORIOF
70 D TEXTOUT(ARRAY,299999.9,399999.9,1,$S($E(IOST)="C":2,1:CNT))
71 I $E(IOST)="C",$Y+CNT>ORIOSL D PGBRK^ORUHDR W @ORIOF
72 K @ARRAY
73 Q
Note: See TracBrowser for help on using the repository browser.