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