PSOUTLA2.m

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