| [613] | 1 | PSOUTLA2 ;BHAM ISC/GSN-Pharmacy utility program cont. ;6/6/05 12:19pm
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**210**;DEC 1997
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | WORDWRAP(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 | ;
|
|---|
| 86 | ADDWORDS ;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
|
|---|
