source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORU.m@ 1150

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1ORU ; slc/dcm,JER - OE/RR Functions ;6/1/92 09:13
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69**;Dec 17, 1997
3UPPER(X) ; Convert lower case X to UPPER CASE
4 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
5LOWER(X) ; Convert UPPER CASE X to lower case
6 Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
7MIXED(X) ; Return Mixed Case X
8 N GMI,WORD,TMP
9 S TMP="" F GMI=1:1:$L(X," ") S WORD=$$UPPER($E($P(X," ",GMI)))_$$LOWER($E($P(X," ",GMI),2,$L($P(X," ",GMI)))),TMP=TMP_" "_WORD
10 Q TMP
11INV() ;
12 N DX,DY
13 G:'$L($G(X))!($E(IOST)'="C") INVX
14 W:$Y>24 @IOF
15 W:$X>79 !
16 S DX=$X,DY=$Y
17 W @X
18 X ^%ZOSF("XY")
19INVX ;
20 I $E(IOST)'="C",($L($G(X))) W:$Y'<IOSL @IOF W:$X>(IOM-1) ! W @X
21 Q ""
22HON() ; High intensity on
23 I $E($G(IOST))="C",$D(ORTERM(7)),$L($P(ORTERM(7),"^")) W @$P(ORTERM(7),"^")
24 Q ""
25HOFF() ; High intensity off
26 I $E($G(IOST))="C",$D(ORTERM(7)),$L($P(ORTERM(7),"^",3)) W @$P(ORTERM(7),"^",3)
27 Q ""
28TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
29 N HR,MIN,SEC,ORI
30 I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
31 S (HR,MIN,SEC)="",X=$P(X,".",2)
32 I '$L(X),FMT["HR" S FMT=$P(FMT,"HR")
33 I $L(X) S HR=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2))),MIN=$E(X,3,4)_$E("00",0,2-$L($E(X,3,4))),SEC=$E(X,5,6)_$E("00",0,2-$L($E(X,5,6)))
34 F ORI="HR","MIN","SEC" S:FMT[ORI FMT=$P(FMT,ORI)_@ORI_$P(FMT,ORI,2)
35 Q FMT
36DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
37 N AMTH,MM,CC,DD,YY,ORI
38 I +X'>0 S FMT="" G QDATE
39 I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/CCYY"
40 S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
41 S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
42 F ORI="AMTH","MM","DD","CC","YY" S:FMT[ORI FMT=$P(FMT,ORI)_@ORI_$P(FMT,ORI,2)
43 I FMT["HR" S FMT=$$TIME(X,FMT)
44QDATE Q FMT
45DATETIME(X,FMT) ;Gets date & time format
46 Q:'$G(X) ""
47 Q $$DATE(X,$S($L($G(FMT)):FMT,1:"MM/DD/CCYY HR:MIN"))
48NAME(X,FMT) ; Call with X="LAST,FIRST MI", FMT=Return Format ("LAST, FI")
49 N ORLAST,ORLI,ORFIRST,ORFI,ORMI,ORI
50 I X']"" S FMT="" G NAMEX
51 I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="LAST,FIRST MI"
52 S FMT=$$LOWER(FMT)
53 S ORLAST=$P(X,","),ORLI=$E(ORLAST),ORFIRST=$P(X,",",2),ORFI=$E(ORFIRST),ORMI=$S($P(ORFIRST," ",2,5)'="NMI":$P(ORFIRST," ",2,5),1:""),ORFIRST=$P(ORFIRST," ")
54 F ORI="last","li","first","fi","mi" I FMT[ORI S FMT=$P(FMT,ORI)_@("OR"_$$UPPER(ORI))_$P(FMT,ORI,2)
55NAMEX Q FMT
56SSN(X,FMT) ;Call with Unformatted SSN
57 I '$L(X) Q ""
58 S FMT=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99)
59 Q FMT
60SEX(X,FMT) ;Call with unformatted SEX
61 I '$L($G(X)) Q ""
62 S FMT=$S($E(X)="F":"Female",1:"Male")
63 Q FMT
64AGE(X,FMT) ;Pass DOB to calc age
65 I '$G(X) Q ""
66 S FMT=$S($L(X)=7:DT-X\10000,1:"??")
67 Q FMT
68DOB(X,FMT) ;Pass unformatted DOB
69 I '$G(X) Q ""
70 I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/CCYY"
71 Q $$DATE(X,FMT)
72WORD(OROOT,FMT) ; Call with X=Word Processing array root, FMT=Wrap Width
73 I '$L($G(OROOT)) Q ""
74 S:'$G(FMT) FMT=80
75 N X,DIWL,DIWF,ORI
76 S DIWL=2,DIWF="WRC"_FMT,ORI=0
77 F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0) D ^DIWP
78 D ^DIWW
79 Q ""
80TEXT(OROOT,FMT) ;Non DIWP version of WORD function
81 I '$L($G(OROOT)) Q ""
82 S:'$G(FMT) FMT=80
83 N X,ORI,ORTX,ORCL,ORINDX
84 S ORCL=$X,ORINDX=1,ORI=0
85 F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0),X=$$FMT^ORPRS09(FMT,ORINDX,X)
86 F ORI=0:0 S ORI=$O(ORTX(ORI)) Q:'ORI D FEED Q:$G(OREND) W:ORI'=$O(ORTX(0))&(+ORI>0) ! W ?ORCL,ORTX(ORI)
87 I '$G(OREND),$G(ORPDAD),$D(ORIFN) D DAD
88 Q ""
89TEXTWRAP(OROOT,FMT) ;Non DIWP Word function that really Raps!
90 I '$L($G(OROOT)) Q ""
91 S:'$G(FMT) FMT=80
92 N X,ORI,ORTX,ORCL,ORINDX
93 S ORCL=$X,ORINDX=0,ORI=0
94 F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0),ORINDX=ORINDX+1,X=$$FMT^ORPRS09(FMT,ORINDX,X)
95 F ORI=0:0 S ORI=$O(ORTX(ORI)) Q:'ORI D FEED Q:$G(OREND) W:ORI'=$O(ORTX(0))&(+ORI>0) ! W ?ORCL,ORTX(ORI)
96 I '$G(OREND),$G(ORPDAD),$D(ORIFN) D DAD
97 Q ""
98TMPWRAP(OROOT,FMT) ;Non DIWP text function that Raps for ^TMP arays
99 I '$L($G(OROOT)) Q ""
100 S:'$G(FMT) FMT=80
101 N X,ORI,ORTX,ORCL,ORINDX
102 S ORCL=$X,ORINDX=0,ORI=0
103 F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=$S($L($G(@OROOT@(ORI))):@OROOT@(ORI),$L($G(@OROOT@(ORI,0))):@OROOT@(ORI,0),1:""),ORINDX=ORINDX+1,X=$$FMT^ORPRS09(FMT,ORINDX,X)
104 F ORI=0:0 S ORI=$O(ORTX(ORI)) Q:'ORI D FEED Q:$G(OREND) W:ORI'=$O(ORTX(0))&(+ORI>0) ! W ?ORCL,ORTX(ORI)
105 I '$G(OREND),$G(ORPDAD),$D(ORIFN) D DAD
106 Q ""
107DAD ;
108 N I,ORDAD
109 I '$D(ORIOSL) S ORIOSL=$S($G(IOSL):IOSL,1:50)
110 S ORDAD=1
111 D PRT1^ORPRS03(ORIFN,FMT)
112 K ORPDAD ;Set by print code in file 100.22
113 Q
114FEED ;Roomcheck
115 Q:$G(ORTEST)
116 I $Y+2<$S($G(ORIOSL):ORIOSL,1:IOSL) Q
117 I $G(ORFOOT) D Q
118 . W ?(IOM-15),"(continued...)"
119 . D FOOT^ORPR01(ORFOOT)
120 . I '$G(OREND),$G(ORHEAD) D HEAD^ORPR01(ORHEAD) W !,"(...continued)"
121 Q:$E(IOST)'="C"
122 D PGBRK^ORUHDR
123 W:'$D(ORTIT)&($G(ORIOF)]"") @ORIOF
124 Q
Note: See TracBrowser for help on using the repository browser.