ORU4 ; slc/dcm - Silent utilities/functions ;12/7/00 13:10
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,92**;Dec 17, 1997
;Silent versions of functions found in ^ORU
TIME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
Q $$TIME^ORU($G(X),$G(FMT))
DATE(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
Q $$DATE^ORU($G(X),$G(FMT))
DATETIME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
Q $$DATETIME^ORU($G(X),$G(FMT))
NAME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
Q $$NAME^ORU($G(X),$G(FMT))
SSN(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
Q $$SSN^ORU($G(X),$G(FMT))
AGE(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
Q $$AGE^ORU($G(X),$G(FMT))
DOB(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
Q $$DOB^ORU($G(X),$G(FMT))
WORD(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ; Call with X=Word Processing array root, FMT=Wrap Width
I '$L($G(OROOT)) Q ""
S:'$G(FMT) FMT=80
N X,DIWL,DIWF,ORI
S ORI=0,CCNT=CCNT+1
F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0) S @ORHOOT@(GCNT,0)=$S($D(@ORHOOT@(GCNT,0)):@ORHOOT@(GCNT,0),1:"")_X D:$O(@OROOT@(ORI)) LN
Q ""
TEXT(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ;Get text unformatted
I '$L($G(OROOT)) Q ""
S:'$G(FMT) FMT=80
S:'$G(ORCL) ORCL=0
S:'$G(CCNT) CCNT=0
S:'$G(GCNT) GCNT=1
N X,ORI,ORTX,ORINDX
S ORINDX=1,ORI=0,CCNT=CCNT+1
F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0),X=$$FMT^ORPRS09(FMT,ORINDX,X)
F ORI=0:0 S ORI=$O(ORTX(ORI)) Q:'ORI S @ORHOOT@(GCNT,0)=$S($D(@ORHOOT@(GCNT,0)):@ORHOOT@(GCNT,0),1:"")_$$S(ORCL,CCNT,ORTX(ORI),.CCNT) D:$O(ORTX(ORI)) LN
I $G(ORPDAD),$D(ORIFN) D PRT1(ORIFN,OACTION,1,FMT,ORHOOT,.GCNT,.CCNT)
Q ""
TMPWRAP(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ;Get text formatted
I '$L($G(OROOT)) Q ""
S:'$G(FMT) FMT=80
S:'$G(ORCL) ORCL=0
S:'$G(CCNT) CCNT=1
S:'$G(GCNT) GCNT=1
N X,ORI,ORTX,ORINDX
S (ORI,ORINDX)=0,CCNT=CCNT+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@(0),1:""),ORINDX=ORINDX+1,X=$$FMT^ORPRS09(FMT,ORINDX,X)
F ORI=0:0 S ORI=$O(ORTX(ORI)) Q:'ORI S @ORHOOT@(GCNT,0)=$S($D(@ORHOOT@(GCNT,0)):@ORHOOT@(GCNT,0),1:"")_$$S(ORCL,CCNT,ORTX(ORI),.CCNT) D:$O(ORTX(ORI)) LN
I $G(ORPDAD),$D(ORIFN) D PRT1(ORIFN,OACTION,1,FMT,ORHOOT,.GCNT,.CCNT) K ORPDAD ;ORPDAD set by print code
Q ""
S(X,Y,Z,CCNT) ;Pad over
;X=Where to begin placing text; similar to Column # in W ?CL
;Y=Current position in string ; similar to $X
;Z=Text to be added to string
;SP=Return value of formatted text
;CCNT=Line position after text is added; call by value
; Initialize and cleanup CCNT before making call
; Multiple calls to $$S pass CCNT as 2nd parameter (Y)
I '$D(Z) Q ""
N SP
S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
S CCNT=$$INC(CCNT,SP)
Q SP
INC(X,Y) ;Character position count
;X=Current count
;Y=Text
N INC
S INC=X+$L(Y)
Q INC
LN ;Increment the array counter & set node position=1
;GCNT=Global node counter)
;CCNT=Text position on global node
S GCNT=GCNT+1,CCNT=1
Q
LINE(OROOT,GIOM) ;Add a blank line to the array
N X
S:'$G(GIOM) GIOM=80
D LN S X="",$P(X," ",GIOM)="",@OROOT@(GCNT,0)=X
Q
PRT1(ORIFN,OACTION,ORDAD,LENGTH,ORHOOT,GCNT,CCNT) ;For kids sake
;ORIFN=Internal order # of parent order
;OACTION=Action
;LENGTH=column width length
N ORCHLD,OREND,I
S (OREND,ORCHLD)=0
F S ORCHLD=$O(^OR(100,ORIFN,2,ORCHLD)) Q:ORCHLD<1 D ONE(ORCHLD,OACTION,ORDAD," ",$G(LENGTH),ORHOOT,.GCNT,CCNT)
Q
ONE(ORIFN,OACTION,ORDAD,ORSEQ,LENGTH,OROOT,GCNT,CCNT) ;Single line format
N ORTX,OREL,ORSTS,ORASTS,ORSTRT,ORSTOP,I,Z,X3,X0
Q:'$D(^OR(100,ORIFN,3)) S X3=^(3),X0=^(0)
S ORSEQ=$G(ORSEQ),ORSTS=$P(X3,"^",3),ORSTRT=$P(X0,"^",8),ORSTOP=$P(X0,"^",9),OREL=$S(ORSTS=11:1,1:"")
S:'$G(LENGTH) LENGTH=45
I $G(OACTION),$D(^OR(100,ORIFN,8,OACTION,0)) S ORASTS=$P(^(0),"^",15)
D LN
S @OROOT@(GCNT,0)=ORSEQ_$S($L(ORSEQ)=1:" ",1:"")_$S($G(ORASTS)!(ORSTS):" "_$P(^ORD(100.01,$S($G(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
D TEXT^ORQ12(.ORTX,$S($G(OACTION):ORIFN_";"_OACTION,1:ORIFN),LENGTH)
F I=0:0 S I=$O(ORTX(I)) Q:'I D:I>1 LINE(OROOT) S @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S(14,CCNT,ORTX(I),.CCNT)
S Z=$S($D(ORDAD):$S(ORDAD:2,1:1),1:1)
I Z=2 S ORSTRT=$$FMTE^XLFDT(ORSTRT,"2M"),ORSTOP=$$FMTE^XLFDT(ORSTOP,"2M") D
. I (CCNT+9+$L(ORSTRT)+$S($L(ORSTOP):$L(ORSTOP)+8,1:0))>(LENGTH+14) D LN S @OROOT@(GCNT,0)=$$S(14,CCNT,"",.CCNT)
. S @OROOT@(GCNT,0)=$$S(14,CCNT," Start: "_ORSTRT,.CCNT)
. I $L(ORSTOP) S @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S(CCNT,CCNT," Stop: "_ORSTOP,.CCNT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORU4 4523 printed Nov 22, 2024@17:44:20 Page 2
ORU4 ; slc/dcm - Silent utilities/functions ;12/7/00 13:10
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,92**;Dec 17, 1997
+2 ;Silent versions of functions found in ^ORU
TIME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
+1 QUIT $$TIME^ORU($GET(X),$GET(FMT))
DATE(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
+1 QUIT $$DATE^ORU($GET(X),$GET(FMT))
DATETIME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
+1 QUIT $$DATETIME^ORU($GET(X),$GET(FMT))
NAME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
+1 QUIT $$NAME^ORU($GET(X),$GET(FMT))
SSN(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
+1 QUIT $$SSN^ORU($GET(X),$GET(FMT))
AGE(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
+1 QUIT $$AGE^ORU($GET(X),$GET(FMT))
DOB(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
+1 QUIT $$DOB^ORU($GET(X),$GET(FMT))
WORD(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ; Call with X=Word Processing array root, FMT=Wrap Width
+1 IF '$LENGTH($GET(OROOT))
QUIT ""
+2 if '$GET(FMT)
SET FMT=80
+3 NEW X,DIWL,DIWF,ORI
+4 SET ORI=0
SET CCNT=CCNT+1
+5 FOR
SET ORI=$ORDER(@OROOT@(ORI))
if ORI'>0
QUIT
SET X=@OROOT@(ORI,0)
SET @ORHOOT@(GCNT,0)=$SELECT($DATA(@ORHOOT@(GCNT,0)):@ORHOOT@(GCNT,0),1:"")_X
if $ORDER(@OROOT@(ORI))
DO LN
+6 QUIT ""
TEXT(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ;Get text unformatted
+1 IF '$LENGTH($GET(OROOT))
QUIT ""
+2 if '$GET(FMT)
SET FMT=80
+3 if '$GET(ORCL)
SET ORCL=0
+4 if '$GET(CCNT)
SET CCNT=0
+5 if '$GET(GCNT)
SET GCNT=1
+6 NEW X,ORI,ORTX,ORINDX
+7 SET ORINDX=1
SET ORI=0
SET CCNT=CCNT+1
+8 FOR
SET ORI=$ORDER(@OROOT@(ORI))
if ORI'>0
QUIT
SET X=@OROOT@(ORI,0)
SET X=$$FMT^ORPRS09(FMT,ORINDX,X)
+9 FOR ORI=0:0
SET ORI=$ORDER(ORTX(ORI))
if 'ORI
QUIT
SET @ORHOOT@(GCNT,0)=$SELECT($DATA(@ORHOOT@(GCNT,0)):@ORHOOT@(GCNT,0),1:"")_$$S(ORCL,CCNT,ORTX(ORI),.CCNT)
if $ORDER(ORTX(ORI))
DO LN
+10 IF $GET(ORPDAD)
IF $DATA(ORIFN)
DO PRT1(ORIFN,OACTION,1,FMT,ORHOOT,.GCNT,.CCNT)
+11 QUIT ""
TMPWRAP(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ;Get text formatted
+1 IF '$LENGTH($GET(OROOT))
QUIT ""
+2 if '$GET(FMT)
SET FMT=80
+3 if '$GET(ORCL)
SET ORCL=0
+4 if '$GET(CCNT)
SET CCNT=1
+5 if '$GET(GCNT)
SET GCNT=1
+6 NEW X,ORI,ORTX,ORINDX
+7 SET (ORI,ORINDX)=0
SET CCNT=CCNT+1
+8 FOR
SET ORI=$ORDER(@OROOT@(ORI))
if ORI'>0
QUIT
SET X=$SELECT($LENGTH($GET(@OROOT@(ORI))):@OROOT@(ORI),$LENGTH($GET(@OROOT@(ORI,0))):@OROOT@(0),1:"")
SET ORINDX=ORINDX+1
SET X=$$FMT^ORPRS09(FMT,ORINDX,X)
+9 FOR ORI=0:0
SET ORI=$ORDER(ORTX(ORI))
if 'ORI
QUIT
SET @ORHOOT@(GCNT,0)=$SELECT($DATA(@ORHOOT@(GCNT,0)):@ORHOOT@(GCNT,0),1:"")_$$S(ORCL,CCNT,ORTX(ORI),.CCNT)
if $ORDER(ORTX(ORI))
DO LN
+10 ;ORPDAD set by print code
IF $GET(ORPDAD)
IF $DATA(ORIFN)
DO PRT1(ORIFN,OACTION,1,FMT,ORHOOT,.GCNT,.CCNT)
KILL ORPDAD
+11 QUIT ""
S(X,Y,Z,CCNT) ;Pad over
+1 ;X=Where to begin placing text; similar to Column # in W ?CL
+2 ;Y=Current position in string ; similar to $X
+3 ;Z=Text to be added to string
+4 ;SP=Return value of formatted text
+5 ;CCNT=Line position after text is added; call by value
+6 ; Initialize and cleanup CCNT before making call
+7 ; Multiple calls to $$S pass CCNT as 2nd parameter (Y)
+8 IF '$DATA(Z)
QUIT ""
+9 NEW SP
+10 SET SP=Z
IF X
IF Y
IF X>Y
SET SP=$EXTRACT(" ",1,X-Y)_Z
+11 SET CCNT=$$INC(CCNT,SP)
+12 QUIT SP
INC(X,Y) ;Character position count
+1 ;X=Current count
+2 ;Y=Text
+3 NEW INC
+4 SET INC=X+$LENGTH(Y)
+5 QUIT INC
LN ;Increment the array counter & set node position=1
+1 ;GCNT=Global node counter)
+2 ;CCNT=Text position on global node
+3 SET GCNT=GCNT+1
SET CCNT=1
+4 QUIT
LINE(OROOT,GIOM) ;Add a blank line to the array
+1 NEW X
+2 if '$GET(GIOM)
SET GIOM=80
+3 DO LN
SET X=""
SET $PIECE(X," ",GIOM)=""
SET @OROOT@(GCNT,0)=X
+4 QUIT
PRT1(ORIFN,OACTION,ORDAD,LENGTH,ORHOOT,GCNT,CCNT) ;For kids sake
+1 ;ORIFN=Internal order # of parent order
+2 ;OACTION=Action
+3 ;LENGTH=column width length
+4 NEW ORCHLD,OREND,I
+5 SET (OREND,ORCHLD)=0
+6 FOR
SET ORCHLD=$ORDER(^OR(100,ORIFN,2,ORCHLD))
if ORCHLD<1
QUIT
DO ONE(ORCHLD,OACTION,ORDAD," ",$GET(LENGTH),ORHOOT,.GCNT,CCNT)
+7 QUIT
ONE(ORIFN,OACTION,ORDAD,ORSEQ,LENGTH,OROOT,GCNT,CCNT) ;Single line format
+1 NEW ORTX,OREL,ORSTS,ORASTS,ORSTRT,ORSTOP,I,Z,X3,X0
+2 if '$DATA(^OR(100,ORIFN,3))
QUIT
SET X3=^(3)
SET X0=^(0)
+3 SET ORSEQ=$GET(ORSEQ)
SET ORSTS=$PIECE(X3,"^",3)
SET ORSTRT=$PIECE(X0,"^",8)
SET ORSTOP=$PIECE(X0,"^",9)
SET OREL=$SELECT(ORSTS=11:1,1:"")
+4 if '$GET(LENGTH)
SET LENGTH=45
+5 IF $GET(OACTION)
IF $DATA(^OR(100,ORIFN,8,OACTION,0))
SET ORASTS=$PIECE(^(0),"^",15)
+6 DO LN
+7 SET @OROOT@(GCNT,0)=ORSEQ_$SELECT($LENGTH(ORSEQ)=1:" ",1:"")_$SELECT($GET(ORASTS)!(ORSTS):" "_$PIECE(^ORD(100.01,$SELECT($GET(ORASTS):ORASTS,1:ORSTS),.1),"^"),1:" ")
+8 DO TEXT^ORQ12(.ORTX,$SELECT($GET(OACTION):ORIFN_";"_OACTION,1:ORIFN),LENGTH)
+9 FOR I=0:0
SET I=$ORDER(ORTX(I))
if 'I
QUIT
if I>1
DO LINE(OROOT)
SET @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S(14,CCNT,ORTX(I),.CCNT)
+10 SET Z=$SELECT($DATA(ORDAD):$SELECT(ORDAD:2,1:1),1:1)
+11 IF Z=2
SET ORSTRT=$$FMTE^XLFDT(ORSTRT,"2M")
SET ORSTOP=$$FMTE^XLFDT(ORSTOP,"2M")
Begin DoDot:1
+12 IF (CCNT+9+$LENGTH(ORSTRT)+$SELECT($LENGTH(ORSTOP):$LENGTH(ORSTOP)+8,1:0))>(LENGTH+14)
DO LN
SET @OROOT@(GCNT,0)=$$S(14,CCNT,"",.CCNT)
+13 SET @OROOT@(GCNT,0)=$$S(14,CCNT," Start: "_ORSTRT,.CCNT)
+14 IF $LENGTH(ORSTOP)
SET @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S(CCNT,CCNT," Stop: "_ORSTOP,.CCNT)
End DoDot:1
+15 QUIT
