Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMTEXT

PXRMTEXT.m

Go to the documentation of this file. 
  1. PXRMTEXT ; SLC/PKR - Text formatting utility routines. ;03/25/2009
  1.  ;;2.0;CLINICAL REMINDERS;**6,12**;Feb 04, 2005;Build 73
  1.  ;
  1.  ;============================================
  1. NEWLINE ;Put TEXT on a new line to the output, make sure it does not end
  1.  ;with a " ".
  1.  N TLEN
  1.  ;If there is no text in TEXT don't do anything.
  1.  I TEXT=INDSTR Q
  1.  S TLEN=$L(TEXT)
  1.  I $E(TEXT,TLEN)=" " S TEXT=$E(TEXT,1,TLEN-1)
  1.  S NOUT=NOUT+1,TEXTOUT(NOUT)=TEXT
  1.  S TEXT=INDSTR,CLEN=0
  1.  Q
  1.  ;
  1.  ;============================================
  1. BLANK ;Add a blank line (line containing just " ") to the output.
  1.  S NOUT=NOUT+1,TEXTOUT(NOUT)=" "
  1.  S TEXT=INDSTR,CLEN=0
  1.  Q
  1.  ;
  1.  ;============================================
  1. CHECKLEN(WORD) ;Check to see if adding the next word makes the line too long.
  1.  ;If it does add it to the output and start a new line.
  1.  N LENWORD,SPLEFT,TLEN
  1.  S LENWORD=$L(WORD)
  1.  S TLEN=CLEN+LENWORD
  1.  I TLEN'>WIDTH D  Q
  1.  . I WORD'[" " S WORD=WORD_" ",LENWORD=LENWORD+1
  1.  . S TEXT=TEXT_WORD,CLEN=CLEN+LENWORD
  1.  ;Width exceeded.
  1.  ;If at least 70% of the width is filled go ahead and break.
  1.  I CLEN>(0.7*WIDTH) D  Q
  1.  . D NEWLINE
  1.  . I WORD'[" " S WORD=WORD_" ",LENWORD=LENWORD+1
  1.  . S TEXT=INDSTR_WORD,CLEN=LENWORD
  1.  S SPLEFT=WIDTH-CLEN+1
  1.  I (LENWORD-SPLEFT)<2 D  Q
  1.  . D NEWLINE
  1.  . I WORD'[" " S WORD=WORD_" ",LENWORD=LENWORD+1
  1.  . S TEXT=INDSTR_WORD,CLEN=LENWORD
  1.  S TEXT=TEXT_$E(WORD,1,SPLEFT-1)
  1.  D NEWLINE
  1.  S WORD=$E(WORD,SPLEFT,LENWORD)
  1.  D CHECKLEN(WORD)
  1.  Q
  1.  ;
  1.  ;============================================
  1. COLFMT(FMTSTR,TEXTSTR,PC,NL,OUTPUT) ;Columnar text formatter.
  1.  ;FMTSTR - format string; ^ separated string for each column in the
  1.  ;output. 35R2 defines a right justified column 35 characters wide
  1.  ;with 2 blank spaces following. Columns can be centered (C) left
  1.  ;justified (L) or right justified (R).
  1.  ;TEXTSTR - string to be formated, text for each column separated by "^"
  1.  ;PC - the pad character
  1.  ;NL - number of lines of output
  1.  ;OUTPUT - array containing output lines.
  1.  N COLOUT,ENTRY,FMT,JND,JUS,IND,LEN,NCOL,NLO,NROW
  1.  N SP,TEMP,TEXT,TEXTOUT,WIDTH,WPSP
  1.  S NCOL=$L(FMTSTR,U),NROW=1
  1.  F IND=1:1:NCOL D
  1.  . S FMT=$P(FMTSTR,U,IND)
  1.  . S JUS(IND)=$S(FMT["C":"C",FMT["L":"L",FMT["R":"R",1:"C")
  1.  . S WIDTH(IND)=$P(FMT,JUS(IND),1)
  1.  . S SP(IND)=$P(FMT,JUS(IND),2)
  1.  . S WPSP(IND)=WIDTH(IND)+SP(IND)
  1.  F IND=1:1:NCOL D
  1.  . S ENTRY=$S(JUS(IND)="C":"CJ",JUS(IND)="L":"LJ",JUS(IND)="R":"RJ")
  1.  . S TEMP=$P(TEXTSTR,U,IND)
  1.  . S LEN=$L(TEMP)
  1.  . I LEN'>WIDTH(IND) D
  1.  .. S TEMP=$$@ENTRY^XLFSTR(TEMP,WIDTH(IND),PC)
  1.  .. S COLOUT(1,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
  1.  . I LEN>WIDTH(IND) D
  1.  .. D FORMATS(1,WIDTH(IND),TEMP,.NLO,.TEXTOUT)
  1.  .. F JND=1:1:NLO D
  1.  ... S TEMP=$$@ENTRY^XLFSTR(TEXTOUT(JND),WIDTH(IND),PC)
  1.  ... S COLOUT(JND,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
  1.  .. I NLO>NROW S NROW=NLO
  1.  F IND=1:1:NROW D
  1.  . S TEXT=""
  1.  . F JND=1:1:NCOL D
  1.  .. I $D(COLOUT(IND,JND)) S TEXT=TEXT_COLOUT(IND,JND)
  1.  .. E  S TEXT=TEXT_$$LJ^XLFSTR("",(WPSP(JND))," ")
  1.  . S OUTPUT(IND)=TEXT
  1.  S NL=NROW
  1.  Q
  1.  ;
  1.  ;============================================
  1. COLFMTA(FMTSTR,INPUT,PC,NL,OUTPUT) ;Columnar text formatter.
  1.  ;Array version of COLFMT. Input array is ^TMP($J,INPUT,M) and
  1.  ;output is ^TMP(OUTPUT,$J,N,0).
  1.  N COLOUT,ENTRY,FMT,JND,JUS,IND,LEN,NCOL,NLO,NROW,NUM
  1.  N SP,TEMP,TEXT,WIDTH,WPSP
  1.  S NCOL=$L(FMTSTR,U)
  1.  F IND=1:1:NCOL D
  1.  . S FMT=$P(FMTSTR,U,IND)
  1.  . S JUS(IND)=$S(FMT["C":"C",FMT["L":"L",FMT["R":"R",1:"C")
  1.  . S WIDTH(IND)=$P(FMT,JUS(IND),1)
  1.  . S SP(IND)=$P(FMT,JUS(IND),2)
  1.  . S WPSP(IND)=WIDTH(IND)+SP(IND)
  1.  S NL=0,NUM=""
  1.  F  S NUM=$O(^TMP($J,INPUT,NUM)) Q:NUM=""  D
  1.  . K COLOUT
  1.  . S NROW=1
  1.  . F IND=1:1:NCOL D
  1.  .. S ENTRY=$S(JUS(IND)="C":"CJ",JUS(IND)="L":"LJ",JUS(IND)="R":"RJ")
  1.  .. S TEMP=$P(^TMP($J,INPUT,NUM),U,IND)
  1.  .. S LEN=$L(TEMP)
  1.  .. I LEN'>WIDTH(IND) D
  1.  ... S TEMP=$$@ENTRY^XLFSTR(TEMP,WIDTH(IND),PC)
  1.  ... S COLOUT(1,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
  1.  .. I LEN>WIDTH(IND) D
  1.  ... D FORMATS(1,WIDTH(IND),TEMP,.NLO,.TEXTOUT)
  1.  ... F JND=1:1:NLO D
  1.  .... S TEMP=$$@ENTRY^XLFSTR(TEXTOUT(JND),WIDTH(IND),PC)
  1.  .... S COLOUT(JND,IND)=TEMP_$$LJ^XLFSTR("",SP(IND)," ")
  1.  ... I NLO>NROW S NROW=NLO
  1.  . F IND=1:1:NROW D
  1.  .. S TEXT=""
  1.  .. F JND=1:1:NCOL D
  1.  ... I $D(COLOUT(IND,JND)) S TEXT=TEXT_COLOUT(IND,JND)
  1.  ... E  S TEXT=TEXT_$$LJ^XLFSTR("",(WPSP(JND))," ")
  1.  .. S NL=NL+1,^TMP(OUTPUT,$J,NL,0)=TEXT
  1.  Q
  1.  ;
  1.  ;============================================
  1. FORMAT(LM,RM,NIN,TEXTIN,NOUT,TEXTOUT) ;Format the text in TEXTIN so it has
  1.  ;a left margin of LM and a right margin of RM. The formatted text
  1.  ;is in TEXTOUT. "\\" is the end of line marker. Lines ending with
  1.  ;"\\" will not have anything appended to them. A blank line can
  1.  ;be created with a line containing just "\\". Lines containing
  1.  ;nothing but whitespace will also act like a "\\".
  1.  I NIN=0 S NOUT=0 Q
  1.  N ACHAR,ALLWSP,CHAR,CLEN,END,IND,INDENT,INDSTR,JND
  1.  N LWSP,NWSP,START,TEMP,TEXT,TLEN,WIDTH,W1,W2,WORD
  1.  ;Catalog the whitespace so we have places to break and look for
  1.  ;end of line markers.
  1.  F IND=1:1:NIN D
  1.  . S TEMP=TEXTIN(IND)
  1.  . I TEMP="" S TEMP=" "
  1.  . S TLEN=$L(TEMP)
  1.  . S ALLWSP=1,NWSP=0
  1.  . F JND=1:1:TLEN D
  1.  .. S CHAR=$E(TEMP,JND)
  1.  .. S ACHAR=$A(CHAR)
  1.  .. I ACHAR>32 S ALLWSP=0
  1.  .. E  S NWSP=NWSP+1,LWSP(IND,NWSP)=JND
  1.  .;Mark the end of the line unless it is already whitespace.
  1.  . I ACHAR>32 S NWSP=NWSP+1,LWSP(IND,NWSP)=TLEN
  1.  . S LWSP(IND)=NWSP
  1.  . I ALLWSP S LWSP(IND,"ALLWSP")=""
  1.  I LM<1 S LM=1
  1.  S WIDTH=RM-LM+1
  1.  S INDENT=LM-1
  1.  S INDSTR=""
  1.  F IND=1:1:INDENT S INDSTR=INDSTR_" "
  1.  S NOUT=0
  1.  S TEXT=INDSTR,CLEN=0
  1.  F IND=1:1:NIN D
  1.  .;If there is a blank line force whatever is in TEXT to be output by
  1.  .;calling NEWLINE and then add the blank.
  1.  . I $D(LWSP(IND,"ALLWSP")) D NEWLINE,BLANK Q
  1.  . S TEMP=TEXTIN(IND)
  1.  . S (END,NWSP)=0
  1.  . F NWSP=1:1:LWSP(IND) D
  1.  .. S START=END+1,END=LWSP(IND,NWSP)
  1.  .. S WORD=$E(TEMP,START,END)
  1.  .. I WORD["\\" D  Q
  1.  ... S W1=$P(WORD,"\\",1)
  1.  ... D CHECKLEN(W1)
  1.  ... D NEWLINE
  1.  ... S W2=$P(WORD,"\\",2)
  1.  ... I W2'="" D CHECKLEN(W2)
  1.  .. D CHECKLEN(WORD)
  1.  ;Output the last line.
  1.  D NEWLINE
  1.  Q
  1.  ;
  1.  ;============================================
  1. FORMATS(LM,RM,TEXTLINE,NOUT,TEXTOUT) ;Take a single line of input text
  1.  ;and format it.
  1.  N TEXTIN
  1.  S TEXTIN(1)=TEXTLINE
  1.  D FORMAT(LM,RM,1,.TEXTIN,.NOUT,.TEXTOUT)
  1.  Q
  1.  ;
  1.  ;============================================
  1. LMFMTSTR(VALMDDF,JSTR) ;The List Manager variable VALMDDF contains the
  1.  ;list template caption column formatting information. It contains
  1.  ;the starting column and the width in the form
  1.  ;VALMDDF(COLUMN NAME)=COLUMN NAME^COLUMN^WIDTH^CAPTION^VIDEO^SCROLL
  1.  ;LOCK. JUSSTR, which is optional,is the justification for each column;
  1.  ;(L=left, C=center, R=right) the default is center. Use this information
  1.  ;to build the format string for the column formatter COLFMT.
  1.  N CN,COL,FMTSTR,IND,JC,JUSSTR,PLCOL,SCOL,SP,TEMP,WIDTH
  1.  ;Sort by columns
  1.  S IND=""
  1.  F  S IND=$O(VALMDDF(IND)) Q:IND=""  D
  1.  . S TEMP=VALMDDF(IND)
  1.  . S COL($P(TEMP,U,2))=$P(TEMP,U,3)
  1.  S JUSSTR=$G(JSTR)
  1.  S (CN,PLCOL,SCOL,SP)=0
  1.  S FMTSTR=""
  1.  S SCOL=0
  1.  F  S SCOL=$O(COL(SCOL)) Q:SCOL=""  D
  1.  . S CN=CN+1
  1.  . S WIDTH=COL(SCOL)
  1.  . I CN=1 S PLCOL=WIDTH
  1.  . E  S SP=SCOL-PLCOL-1,FMTSTR=FMTSTR_SP_U,PLCOL=SCOL+WIDTH-1
  1.  . S JC=$E(JUSSTR,CN)
  1.  . I JC="" S JC="C"
  1.  . S TEMP=WIDTH_JC
  1.  . S FMTSTR=FMTSTR_TEMP
  1.  Q FMTSTR
  1.  ;