ORU4.m

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

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