source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORU4.m@ 1774

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1ORU4 ; slc/dcm - Silent utilities/functions ;12/7/00 13:10
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,92**;Dec 17, 1997
3 ;Silent versions of functions found in ^ORU
4TIME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
5 Q $$TIME^ORU($G(X),$G(FMT))
6DATE(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
7 Q $$DATE^ORU($G(X),$G(FMT))
8DATETIME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
9 Q $$DATETIME^ORU($G(X),$G(FMT))
10NAME(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
11 Q $$NAME^ORU($G(X),$G(FMT))
12SSN(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
13 Q $$SSN^ORU($G(X),$G(FMT))
14AGE(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
15 Q $$AGE^ORU($G(X),$G(FMT))
16DOB(X,FMT,ORHOOT,ORCL,GCNT,CCNT) ;
17 Q $$DOB^ORU($G(X),$G(FMT))
18WORD(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ; Call with X=Word Processing array root, FMT=Wrap Width
19 I '$L($G(OROOT)) Q ""
20 S:'$G(FMT) FMT=80
21 N X,DIWL,DIWF,ORI
22 S ORI=0,CCNT=CCNT+1
23 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
24 Q ""
25TEXT(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ;Get text unformatted
26 I '$L($G(OROOT)) Q ""
27 S:'$G(FMT) FMT=80
28 S:'$G(ORCL) ORCL=0
29 S:'$G(CCNT) CCNT=0
30 S:'$G(GCNT) GCNT=1
31 N X,ORI,ORTX,ORINDX
32 S ORINDX=1,ORI=0,CCNT=CCNT+1
33 F S ORI=$O(@OROOT@(ORI)) Q:ORI'>0 S X=@OROOT@(ORI,0),X=$$FMT^ORPRS09(FMT,ORINDX,X)
34 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
35 I $G(ORPDAD),$D(ORIFN) D PRT1(ORIFN,OACTION,1,FMT,ORHOOT,.GCNT,.CCNT)
36 Q ""
37TMPWRAP(OROOT,FMT,ORHOOT,ORCL,GCNT,CCNT) ;Get text formatted
38 I '$L($G(OROOT)) Q ""
39 S:'$G(FMT) FMT=80
40 S:'$G(ORCL) ORCL=0
41 S:'$G(CCNT) CCNT=1
42 S:'$G(GCNT) GCNT=1
43 N X,ORI,ORTX,ORINDX
44 S (ORI,ORINDX)=0,CCNT=CCNT+1
45 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)
46 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
47 I $G(ORPDAD),$D(ORIFN) D PRT1(ORIFN,OACTION,1,FMT,ORHOOT,.GCNT,.CCNT) K ORPDAD ;ORPDAD set by print code
48 Q ""
49S(X,Y,Z,CCNT) ;Pad over
50 ;X=Where to begin placing text; similar to Column # in W ?CL
51 ;Y=Current position in string ; similar to $X
52 ;Z=Text to be added to string
53 ;SP=Return value of formatted text
54 ;CCNT=Line position after text is added; call by value
55 ; Initialize and cleanup CCNT before making call
56 ; Multiple calls to $$S pass CCNT as 2nd parameter (Y)
57 I '$D(Z) Q ""
58 N SP
59 S SP=Z I X,Y,X>Y S SP=$E(" ",1,X-Y)_Z
60 S CCNT=$$INC(CCNT,SP)
61 Q SP
62INC(X,Y) ;Character position count
63 ;X=Current count
64 ;Y=Text
65 N INC
66 S INC=X+$L(Y)
67 Q INC
68LN ;Increment the array counter & set node position=1
69 ;GCNT=Global node counter)
70 ;CCNT=Text position on global node
71 S GCNT=GCNT+1,CCNT=1
72 Q
73LINE(OROOT,GIOM) ;Add a blank line to the array
74 N X
75 S:'$G(GIOM) GIOM=80
76 D LN S X="",$P(X," ",GIOM)="",@OROOT@(GCNT,0)=X
77 Q
78PRT1(ORIFN,OACTION,ORDAD,LENGTH,ORHOOT,GCNT,CCNT) ;For kids sake
79 ;ORIFN=Internal order # of parent order
80 ;OACTION=Action
81 ;LENGTH=column width length
82 N ORCHLD,OREND,I
83 S (OREND,ORCHLD)=0
84 F S ORCHLD=$O(^OR(100,ORIFN,2,ORCHLD)) Q:ORCHLD<1 D ONE(ORCHLD,OACTION,ORDAD," ",$G(LENGTH),ORHOOT,.GCNT,CCNT)
85 Q
86ONE(ORIFN,OACTION,ORDAD,ORSEQ,LENGTH,OROOT,GCNT,CCNT) ;Single line format
87 N ORTX,OREL,ORSTS,ORASTS,ORSTRT,ORSTOP,I,Z,X3,X0
88 Q:'$D(^OR(100,ORIFN,3)) S X3=^(3),X0=^(0)
89 S ORSEQ=$G(ORSEQ),ORSTS=$P(X3,"^",3),ORSTRT=$P(X0,"^",8),ORSTOP=$P(X0,"^",9),OREL=$S(ORSTS=11:1,1:"")
90 S:'$G(LENGTH) LENGTH=45
91 I $G(OACTION),$D(^OR(100,ORIFN,8,OACTION,0)) S ORASTS=$P(^(0),"^",15)
92 D LN
93 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:" ")
94 D TEXT^ORQ12(.ORTX,$S($G(OACTION):ORIFN_";"_OACTION,1:ORIFN),LENGTH)
95 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)
96 S Z=$S($D(ORDAD):$S(ORDAD:2,1:1),1:1)
97 I Z=2 S ORSTRT=$$FMTE^XLFDT(ORSTRT,"2M"),ORSTOP=$$FMTE^XLFDT(ORSTOP,"2M") D
98 . 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)
99 . S @OROOT@(GCNT,0)=$$S(14,CCNT," Start: "_ORSTRT,.CCNT)
100 . I $L(ORSTOP) S @OROOT@(GCNT,0)=@OROOT@(GCNT,0)_$$S(CCNT,CCNT," Stop: "_ORSTOP,.CCNT)
101 Q
Note: See TracBrowser for help on using the repository browser.