source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOUTLA2.m@ 632

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1PSOUTLA2 ;BHAM ISC/GSN-Pharmacy utility program cont. ;6/6/05 12:19pm
2 ;;7.0;OUTPATIENT PHARMACY;**210**;DEC 1997
3 Q
4 ;
5WORDWRAP(STR,IEN,GL,LM) ;Wraps words at spaces normally and will breakup long
6 ; words at a delimiter & wrap at those break points
7 ; Input: STR - a text string
8 ; IEN - ien of global
9 ; GL - global root
10 ; LM - left margin
11 ; Output: Populated global (usually in ^TMP)
12 ;
13 ; When a long word is encountered, i.e. text with no spaces, an
14 ; attempt will be made to locate a delimiter & break the line there.
15 ; If it can't find a valid delimiter without a restricted scenario,
16 ; i.e. a number like 1,000 , then it will be forced to break at the
17 ; End of Line (EOL).
18 ;
19 ; Delimiters searched for and order they are picked for use:
20 ; preferred: , ;
21 ; alternate: : =
22 ; do not use: - . ) ( / (to critical, used in dosing)
23 ; example: "TAKE 1/2-1 TAB(7.5MG) TABLET(S)"
24 ;
25 ; Key Variables: WORD - current word from text string
26 ; WORD1 - 1st part of word that will fit
27 ; WORD2 - 2nd part of word for new line
28 ; WORD0 - remnant that won't fit on the new line
29 ;
30 N QQ,DL,DLM,WD,LL,TL,UL,MAXLN,LSTD,CURD,GWRD,LC,WORD0,WORD,WORD1,WORD2
31 S IEN=+$G(IEN),@GL@(IEN,0)=$G(@GL@(IEN,0)),WORD0=""
32 ;loop thru words, quit if no more words & no remnants - i.e. WORD0
33 F QQ=1:1 S WORD=$P(STR," ",QQ) D Q:(QQ'<$L(STR," "))&(WORD0="")
34 . ;if remnant exists, prepend to next Word
35 . S:WORD0]"" WORD=WORD0_WORD,WORD0=""
36 . ;wrap short words at spaces, check if last char is already a space
37 . S GWRD=@GL@(IEN,0)
38 . S LC=$E(@GL@(IEN,0),$L(GWRD))
39 . I LC=" ",$L(GWRD_WORD)<81 S @GL@(IEN,0)=@GL@(IEN,0)_WORD Q
40 . I LC'=" ",$L(GWRD_" "_WORD)<81 S @GL@(IEN,0)=@GL@(IEN,0)_" "_WORD Q
41 . I $L(WORD)<20,$L(LM+1+$L(WORD))<81 D Q
42 . . S WORD1="",WORD2=WORD,DLM="" D ADDWORDS S WORD0=WORD2 Q
43 . ;
44 . ;word>80, so wrap long words @ a specific delimiter, if found
45 . S MAXLN=79-$L(@GL@(IEN,0))
46 . ;search backwards & pick 1st dl > 1 count of preferred delims
47 . F DL=";","," S DL($L(WORD,DL))=DL
48 . S DL=$O(DL(DL),-1) S DLM=$S(DL>1:DL(DL),1:"")
49 . I DLM="" F DL="=",":" S DL($L(WORD,DL))=DL D ;try these alt delims
50 . . S DL=$O(DL(DL),-1) S DLM=$S(DL>1:DL(DL),1:"")
51 . ;
52 . ;no good delimiter, will have to break at end of line
53 . I DLM="" D Q
54 . . S WORD1=$E(WORD,1,MAXLN),WORD2=$E(WORD,MAXLN+1,$L(WORD))
55 . . D ADDWORDS S WORD0=WORD2
56 . ;
57 . ;good delimiter, will break at last dlm that fits within maxln
58 . S (LSTD,LL)=0,CURD=1 F TL=0:0 S CURD=$F(WORD,DLM,CURD) Q:'CURD D
59 . . S TL=TL+1
60 . . S WD(TL)=CURD_"^"_$E(WORD,CURD-2,CURD)
61 . . S:CURD<MAXLN LSTD=CURD,LL=TL
62 . ;special check of "," embedded in a number e.g. 1,000
63 . ;backup to previous delimiter if pattern match
64 . I DLM="," F UL=LL:-1:0 Q:$P($G(WD(UL)),"^",2)'?1N1","1N
65 . I DLM=",",+$G(WD(UL))<LSTD S LSTD=+$G(WD(UL))
66 . ;
67 . ;'LSTD usually means no valid Dlm's found in Word, but if line
68 . ;found to have some valid Dlm's later in the Word, then go ahead
69 . ;defer entire string to next line via Addwords Api
70 . I 'LSTD,TL>LL,$P($G(WD(TL)),"^",2)'?1N1","1N D Q
71 . . S WORD1="",WORD2=WORD D ADDWORDS S WORD0=WORD2
72 . ;
73 . ;no valid Dlm's found in word, can't determine a word, break @EOL
74 . I 'LSTD,$L(WORD)>(MAXLN) D Q
75 . . S WORD1=$E(WORD,1,MAXLN),WORD2=$E(WORD,MAXLN+1,$L(WORD))
76 . . D ADDWORDS S WORD0=WORD2
77 . ;no valid Dlm's found in word, and can add Word to curr line
78 . I 'LSTD,$L(WORD)'>(MAXLN) S @GL@(IEN,0)=@GL@(IEN,0)_WORD Q
79 . ;
80 . ;valid Dlm's & location found indicated by SS
81 . I LSTD D Q
82 . . S WORD1=$E(WORD,1,LSTD-1),WORD2=$E(WORD,LSTD,$L(WORD))
83 . . D ADDWORDS S WORD0=WORD2
84 Q
85 ;
86ADDWORDS ;Add words to curr line and to a new line
87 N CH
88 ;if last character is the DLM or a " ", then don't add a space when
89 ;adding Word1 to current line
90 S CH=$E(@GL@(IEN,0),$L(@GL@(IEN,0)))
91 I (CH=DLM)!(CH=" ") D
92 . S @GL@(IEN,0)=@GL@(IEN,0)_WORD1
93 E D
94 . S @GL@(IEN,0)=@GL@(IEN,0)_" "_WORD1
95 ;create new line to hold Word2
96 S IEN=IEN+1,$P(@GL@(IEN,0)," ",LM+1)=" "
97 S MAXLN=79-$L(@GL@(IEN,0))
98 ;word2 won't fit, quit for further wrapping
99 Q:$L(WORD2)>(80-LM)
100 ;word2 will fit add it
101 S @GL@(IEN,0)=@GL@(IEN,0)_WORD2,WORD2=""
102 Q
Note: See TracBrowser for help on using the repository browser.