| 1 | ORPR09 ; slc/dcm - Getting Consults pre-formatted output ;12/21/98 12:16
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11**;Dec 17, 1997
|
|---|
| 3 | EN(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
|
|---|
| 24 | TEXTOUT(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
|
|---|
| 30 | TEST ;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
|
|---|
| 35 | TEST1 ;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
|
|---|
| 40 | FEED(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
|
|---|
| 47 | HEAD(FF) ;Header
|
|---|
| 48 | I $G(FF)!($E(IOST)="C") W @ORIOF
|
|---|
| 49 | D TEXTOUT(ARRAY,99999.9,199999.9,,1)
|
|---|
| 50 | Q
|
|---|
| 51 | FOOT(CNT) ;Footer
|
|---|
| 52 | F Q:$Y+$G(CNT)>(ORIOSL-1) W !
|
|---|
| 53 | D TEXTOUT(ARRAY,499999.9,599999.9,,1)
|
|---|
| 54 | Q
|
|---|
| 55 | EN1(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
|
|---|
