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

ORU.m

Go to the documentation of this file.
  1. ORU ; slc/dcm,JER - OE/RR Functions ;6/1/92 09:13
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,69**;Dec 17, 1997
  1. UPPER(X) ; Convert lower case X to UPPER CASE
  1. Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1. LOWER(X) ; Convert UPPER CASE X to lower case
  1. Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
  1. MIXED(X) ; Return Mixed Case X
  1. N GMI,WORD,TMP
  1. 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
  1. Q TMP
  1. INV() ;
  1. N DX,DY
  1. G:'$L($G(X))!($E(IOST)'="C") INVX
  1. W:$Y>24 @IOF
  1. W:$X>79 !
  1. S DX=$X,DY=$Y
  1. W @X
  1. X ^%ZOSF("XY")
  1. INVX ;
  1. I $E(IOST)'="C",($L($G(X))) W:$Y'<IOSL @IOF W:$X>(IOM-1) ! W @X
  1. Q ""
  1. HON() ; High intensity on
  1. I $E($G(IOST))="C",$D(ORTERM(7)),$L($P(ORTERM(7),"^")) W @$P(ORTERM(7),"^")
  1. Q ""
  1. HOFF() ; High intensity off
  1. I $E($G(IOST))="C",$D(ORTERM(7)),$L($P(ORTERM(7),"^",3)) W @$P(ORTERM(7),"^",3)
  1. Q ""
  1. TIME(X,FMT) ; Recieves X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
  1. N HR,MIN,SEC,ORI
  1. I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
  1. S (HR,MIN,SEC)="",X=$P(X,".",2)
  1. I '$L(X),FMT["HR" S FMT=$P(FMT,"HR")
  1. 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)))
  1. F ORI="HR","MIN","SEC" S:FMT[ORI FMT=$P(FMT,ORI)_@ORI_$P(FMT,ORI,2)
  1. Q FMT
  1. DATE(X,FMT) ; Call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
  1. N AMTH,MM,CC,DD,YY,ORI
  1. I +X'>0 S FMT="" G QDATE
  1. I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/CCYY"
  1. S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
  1. S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
  1. F ORI="AMTH","MM","DD","CC","YY" S:FMT[ORI FMT=$P(FMT,ORI)_@ORI_$P(FMT,ORI,2)
  1. I FMT["HR" S FMT=$$TIME(X,FMT)
  1. QDATE Q FMT
  1. DATETIME(X,FMT) ;Gets date & time format
  1. Q:'$G(X) ""
  1. Q $$DATE(X,$S($L($G(FMT)):FMT,1:"MM/DD/CCYY HR:MIN"))
  1. NAME(X,FMT) ; Call with X="LAST,FIRST MI", FMT=Return Format ("LAST, FI")
  1. N ORLAST,ORLI,ORFIRST,ORFI,ORMI,ORI
  1. I X']"" S FMT="" G NAMEX
  1. I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="LAST,FIRST MI"
  1. S FMT=$$LOWER(FMT)
  1. 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," ")
  1. F ORI="last","li","first","fi","mi" I FMT[ORI S FMT=$P(FMT,ORI)_@("OR"_$$UPPER(ORI))_$P(FMT,ORI,2)
  1. NAMEX Q FMT
  1. SSN(X,FMT) ;Call with Unformatted SSN
  1. I '$L(X) Q ""
  1. S FMT=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,99)
  1. Q FMT
  1. SEX(X,FMT) ;Call with unformatted SEX
  1. I '$L($G(X)) Q ""
  1. S FMT=$S($E(X)="F":"Female",1:"Male")
  1. Q FMT
  1. AGE(X,FMT) ;Pass DOB to calc age
  1. I '$G(X) Q ""
  1. S FMT=$S($L(X)=7:DT-X\10000,1:"??")
  1. Q FMT
  1. DOB(X,FMT) ;Pass unformatted DOB
  1. I '$G(X) Q ""
  1. I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/CCYY"
  1. Q $$DATE(X,FMT)
  1. WORD(OROOT,FMT) ; Call with X=Word Processing array root, FMT=Wrap Width
  1. I '$L($G(OROOT)) Q ""
  1. S:'$G(FMT) FMT=80
  1. N X,DIWL,DIWF,ORI
  1. S DIWL=2,DIWF="WRC"_FMT,ORI=0
  1. F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0) D ^DIWP
  1. D ^DIWW
  1. Q ""
  1. TEXT(OROOT,FMT) ;Non DIWP version of WORD function
  1. I '$L($G(OROOT)) Q ""
  1. S:'$G(FMT) FMT=80
  1. N X,ORI,ORTX,ORCL,ORINDX
  1. S ORCL=$X,ORINDX=1,ORI=0
  1. F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0),X=$$FMT^ORPRS09(FMT,ORINDX,X)
  1. 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)
  1. I '$G(OREND),$G(ORPDAD),$D(ORIFN) D DAD
  1. Q ""
  1. TEXTWRAP(OROOT,FMT) ;Non DIWP Word function that really Raps!
  1. I '$L($G(OROOT)) Q ""
  1. S:'$G(FMT) FMT=80
  1. N X,ORI,ORTX,ORCL,ORINDX
  1. S ORCL=$X,ORINDX=0,ORI=0
  1. F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0),ORINDX=ORINDX+1,X=$$FMT^ORPRS09(FMT,ORINDX,X)
  1. 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)
  1. I '$G(OREND),$G(ORPDAD),$D(ORIFN) D DAD
  1. Q ""
  1. TMPWRAP(OROOT,FMT) ;Non DIWP text function that Raps for ^TMP arays
  1. I '$L($G(OROOT)) Q ""
  1. S:'$G(FMT) FMT=80
  1. N X,ORI,ORTX,ORCL,ORINDX
  1. S ORCL=$X,ORINDX=0,ORI=0
  1. 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)
  1. 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)
  1. I '$G(OREND),$G(ORPDAD),$D(ORIFN) D DAD
  1. Q ""
  1. DAD ;
  1. N I,ORDAD
  1. I '$D(ORIOSL) S ORIOSL=$S($G(IOSL):IOSL,1:50)
  1. S ORDAD=1
  1. D PRT1^ORPRS03(ORIFN,FMT)
  1. K ORPDAD ;Set by print code in file 100.22
  1. Q
  1. FEED ;Roomcheck
  1. Q:$G(ORTEST)
  1. I $Y+2<$S($G(ORIOSL):ORIOSL,1:IOSL) Q
  1. I $G(ORFOOT) D Q
  1. . W ?(IOM-15),"(continued...)"
  1. . D FOOT^ORPR01(ORFOOT)
  1. . I '$G(OREND),$G(ORHEAD) D HEAD^ORPR01(ORHEAD) W !,"(...continued)"
  1. Q:$E(IOST)'="C"
  1. D PGBRK^ORUHDR
  1. W:'$D(ORTIT)&($G(ORIOF)]"") @ORIOF
  1. Q