- PSOLLU1 ;BHAM/RJS - LASER LABEL UTILITIES ;11/22/02
- ;;7.0;OUTPATIENT PHARMACY;**120,141,161**;DEC 1997
- ;
- FONT(RLN,TEXT) ;
- ;--------------------------------------------------------------------
- ;VARIABLES:
- ; INPUT:
- ; REQUIRED: RLN - Relates to a value used to determine the max
- ; line length.
- ; TEXT - Can contain a string and the $L(TEXT) is used
- ; to calculate the font size.
- ; RETURN:
- ; FONT - This is the calculated optimal font size.
- ; F8, F9, F10 or F12 will be returned.
- ;--------------------------------------------------------------------
- D STRT(RLN,TEXT,"",.FONT) Q FONT
- Q
- ;
- STRT(RLN,TEXT,LNTH,FONT) ;
- ; The LETTER array contains all the number of character per inch
- ; for the different font sizes that can be used.
- N LN,LETTER,TXTIDX,SIZ,FNTIDX,LTTR,A
- S LETTER(1)="22^16^14^13^10",LETTER("!")="40^32^28^25^21"
- S LETTER(2)="22^16^14^13^10",LETTER("@")="11^8^7^7^5"
- S LETTER(3)="22^16^14^13^10",LETTER("#")="19^16^14^12^10"
- S LETTER(4)="22^16^14^13^10",LETTER("$")="20^18^16^14^12"
- S LETTER(5)="22^16^14^13^10",LETTER("%")="14^13^11^10^8"
- S LETTER(6)="22^16^14^13^10"
- S LETTER(7)="22^16^14^13^10",LETTER("&")="22^16^14^12^10"
- S LETTER(8)="22^16^14^13^10",LETTER("*")="30^23^20^18^15"
- S LETTER(9)="22^16^14^13^10",LETTER("(")="32^27^24^21^18"
- S LETTER(0)="22^16^14^13^10",LETTER(")")="32^27^24^21^18"
- S LETTER($C(34))="30^27^24^21^18",LETTER("'")="45^40^36^32^27"
- S LETTER("`")="30^27^24^21^18",LETTER("~")="18^15^13^12^10"
- S LETTER(",")="40^32^28^25^21",LETTER("<")="18^15^13^12^10"
- S LETTER(".")="35^27^24^21^18",LETTER(">")="18^15^13^12^10"
- S LETTER(";")="40^32^28^25^21",LETTER(":")="40^32^28^25^21"
- S LETTER("?")="22^16^14^12^10",LETTER("/")="40^32^28^25^21"
- S LETTER("[")="40^32^28^25^21",LETTER("{")="35^26^23^21^17"
- S LETTER("\")="40^32^28^25^21",LETTER("|")="42^34^30^27^23"
- S LETTER("]")="40^32^28^25^21",LETTER("}")="35^26^23^21^17"
- S LETTER("_")="20^15^14^12^10",LETTER("-")="30^27^24^21^18"
- S LETTER("=")="20^15^14^12^10",LETTER("+")="22^18^16^14^12"
- S LETTER(" ")="40^32^28^25^21"
- S LETTER("a")="19^16^14^12^10",LETTER("A")="16^13^11^10^8"
- S LETTER("b")="19^16^14^12^10",LETTER("B")="16^13^11^10^8"
- S LETTER("c")="22^18^16^14^12",LETTER("C")="15^13^11^10^8"
- S LETTER("d")="20^16^14^12^10",LETTER("D")="15^13^11^10^8"
- S LETTER("e")="20^16^14^12^10",LETTER("E")="16^13^11^10^8"
- S LETTER("f")="40^32^28^25^21",LETTER("F")="18^14^13^11^9"
- S LETTER("g")="20^16^14^12^10",LETTER("G")="14^11^10^9^7"
- S LETTER("h")="20^16^14^12^10",LETTER("H")="15^13^11^10^8"
- S LETTER("i")="50^40^36^32^27",LETTER("I")="40^32^28^25^21"
- S LETTER("j")="50^40^36^32^27",LETTER("J")="22^18^16^14^12"
- S LETTER("k")="24^18^16^14^12",LETTER("K")="16^13^11^10^8"
- S LETTER("l")="50^40^36^32^27",LETTER("L")="20^16^14^12^10"
- S LETTER("m")="13^10^9^8^7",LETTER("M")="13^11^10^9^7"
- S LETTER("n")="20^16^14^12^10",LETTER("N")="15^13^11^10^8"
- S LETTER("o")="20^16^14^12^10",LETTER("O")="14^11^10^9^7"
- S LETTER("p")="20^16^14^12^10",LETTER("P")="16^13^11^10^8"
- S LETTER("q")="20^16^14^12^10",LETTER("Q")="14^11^10^9^7"
- S LETTER("r")="35^32^28^25^21",LETTER("R")="15^13^11^10^8"
- S LETTER("s")="22^18^16^14^12",LETTER("S")="16^13^11^10^8"
- S LETTER("t")="40^32^28^25^21",LETTER("T")="18^14^13^11^9"
- S LETTER("u")="20^16^14^12^10",LETTER("U")="15^13^11^10^8"
- S LETTER("v")="23^18^16^14^12",LETTER("V")="16^13^11^10^8"
- S LETTER("w")="14^12^11^9^8",LETTER("W")="11^9^8^7^6"
- S LETTER("x")="23^18^16^14^12",LETTER("X")="16^13^11^10^8"
- S LETTER("y")="23^18^16^14^12",LETTER("Y")="16^13^11^10^8"
- S LETTER("z")="23^18^16^14^12",LETTER("Z")="18^14^13^11^9"
- ;
- ; The LN array contains the length in inches for the different
- ; sections of the laser label.
- S LN("RX#")=3.126
- S LN("RXVAMC")=2.626
- S LN("DRG")=3.376
- S LN("SIG")=3.126
- S LN("WRN")=1.99
- S LN("ML")=2.376
- S LN("ML2")=1.76
- S LN("SEC2")=4.1876
- S LN("SEC2X")=LN("SEC2")
- S LN("SIG2")=LN("SEC2")
- S LN("SEC2B")=LN("WRN")
- S LN("FULL")=8.1876
- ;
- ; The LNTH array is used in calculating the length of the text
- ; for each of the different font sizes.
- S (LNTH(6),LNTH(8),LNTH(9),LNTH(10),LNTH(12))=""
- ;
- ; This section walks the TEXT string and extracts the each character
- ; then uses the LETTER array to lookup the number of characters per
- ; inch and calculates the length of the TEXT for each font.
- F TXTIDX=1:1:$L(TEXT) D
- .S LTTR=$E(TEXT,TXTIDX),A=$G(LETTER(LTTR),"18^16^14^12^10")
- .S LNTH(6)=LNTH(6)+(1/$P(A,U))
- .S LNTH(8)=LNTH(8)+(1/($P(A,U,2)))
- .S LNTH(9)=LNTH(9)+(1/($P(A,U,3)))
- .S LNTH(10)=LNTH(10)+(1/($P(A,U,4)))
- .S LNTH(12)=LNTH(12)+(1/($P(A,U,5)))
- ;
- ; This section determines what would be the optimal font for the TEXT
- I RLN="WRN" D Q
- . I LNTH(12)<LN(RLN) S FONT="F12" Q
- . I LNTH(10)<(LN(RLN)*2) S FONT="F10" Q
- . I LNTH(9)<(LN(RLN)*2.5) S FONT="F9" Q
- . I LNTH(8)<(LN(RLN)*2.6) S FONT="F8" Q
- . S FONT="F6"
- S FONT="F0"
- I LNTH(8)<LN(RLN) S FONT="F8"
- I LNTH(9)<LN(RLN) S FONT="F9"
- I LNTH(10)<LN(RLN) S FONT="F10"
- I LNTH(12)<LN(RLN) S FONT="F12"
- Q
- ADD ; Calculate the length and pad "_" to the end of TEXT for change of address
- ; then return FONT and TEXT to calling program.
- N NEEDED,CNT,DASH
- S NEEDED=LN("SEC2X")-LNTH(10)
- S CNT=NEEDED*12\1
- S DASH="________________________________________________________________________________________________________________"
- S TEXT2=TEXT_" "_$E(DASH,1,CNT)
- S FONT="F10"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLLU1 5565 printed Jan 18, 2025@03:31:52 Page 2
- PSOLLU1 ;BHAM/RJS - LASER LABEL UTILITIES ;11/22/02
- +1 ;;7.0;OUTPATIENT PHARMACY;**120,141,161**;DEC 1997
- +2 ;
- FONT(RLN,TEXT) ;
- +1 ;--------------------------------------------------------------------
- +2 ;VARIABLES:
- +3 ; INPUT:
- +4 ; REQUIRED: RLN - Relates to a value used to determine the max
- +5 ; line length.
- +6 ; TEXT - Can contain a string and the $L(TEXT) is used
- +7 ; to calculate the font size.
- +8 ; RETURN:
- +9 ; FONT - This is the calculated optimal font size.
- +10 ; F8, F9, F10 or F12 will be returned.
- +11 ;--------------------------------------------------------------------
- +12 DO STRT(RLN,TEXT,"",.FONT)
- QUIT FONT
- +13 QUIT
- +14 ;
- STRT(RLN,TEXT,LNTH,FONT) ;
- +1 ; The LETTER array contains all the number of character per inch
- +2 ; for the different font sizes that can be used.
- +3 NEW LN,LETTER,TXTIDX,SIZ,FNTIDX,LTTR,A
- +4 SET LETTER(1)="22^16^14^13^10"
- SET LETTER("!")="40^32^28^25^21"
- +5 SET LETTER(2)="22^16^14^13^10"
- SET LETTER("@")="11^8^7^7^5"
- +6 SET LETTER(3)="22^16^14^13^10"
- SET LETTER("#")="19^16^14^12^10"
- +7 SET LETTER(4)="22^16^14^13^10"
- SET LETTER("$")="20^18^16^14^12"
- +8 SET LETTER(5)="22^16^14^13^10"
- SET LETTER("%")="14^13^11^10^8"
- +9 SET LETTER(6)="22^16^14^13^10"
- +10 SET LETTER(7)="22^16^14^13^10"
- SET LETTER("&")="22^16^14^12^10"
- +11 SET LETTER(8)="22^16^14^13^10"
- SET LETTER("*")="30^23^20^18^15"
- +12 SET LETTER(9)="22^16^14^13^10"
- SET LETTER("(")="32^27^24^21^18"
- +13 SET LETTER(0)="22^16^14^13^10"
- SET LETTER(")")="32^27^24^21^18"
- +14 SET LETTER($CHAR(34))="30^27^24^21^18"
- SET LETTER("'")="45^40^36^32^27"
- +15 SET LETTER("`")="30^27^24^21^18"
- SET LETTER("~")="18^15^13^12^10"
- +16 SET LETTER(",")="40^32^28^25^21"
- SET LETTER("<")="18^15^13^12^10"
- +17 SET LETTER(".")="35^27^24^21^18"
- SET LETTER(">")="18^15^13^12^10"
- +18 SET LETTER(";")="40^32^28^25^21"
- SET LETTER(":")="40^32^28^25^21"
- +19 SET LETTER("?")="22^16^14^12^10"
- SET LETTER("/")="40^32^28^25^21"
- +20 SET LETTER("[")="40^32^28^25^21"
- SET LETTER("{")="35^26^23^21^17"
- +21 SET LETTER("\")="40^32^28^25^21"
- SET LETTER("|")="42^34^30^27^23"
- +22 SET LETTER("]")="40^32^28^25^21"
- SET LETTER("}")="35^26^23^21^17"
- +23 SET LETTER("_")="20^15^14^12^10"
- SET LETTER("-")="30^27^24^21^18"
- +24 SET LETTER("=")="20^15^14^12^10"
- SET LETTER("+")="22^18^16^14^12"
- +25 SET LETTER(" ")="40^32^28^25^21"
- +26 SET LETTER("a")="19^16^14^12^10"
- SET LETTER("A")="16^13^11^10^8"
- +27 SET LETTER("b")="19^16^14^12^10"
- SET LETTER("B")="16^13^11^10^8"
- +28 SET LETTER("c")="22^18^16^14^12"
- SET LETTER("C")="15^13^11^10^8"
- +29 SET LETTER("d")="20^16^14^12^10"
- SET LETTER("D")="15^13^11^10^8"
- +30 SET LETTER("e")="20^16^14^12^10"
- SET LETTER("E")="16^13^11^10^8"
- +31 SET LETTER("f")="40^32^28^25^21"
- SET LETTER("F")="18^14^13^11^9"
- +32 SET LETTER("g")="20^16^14^12^10"
- SET LETTER("G")="14^11^10^9^7"
- +33 SET LETTER("h")="20^16^14^12^10"
- SET LETTER("H")="15^13^11^10^8"
- +34 SET LETTER("i")="50^40^36^32^27"
- SET LETTER("I")="40^32^28^25^21"
- +35 SET LETTER("j")="50^40^36^32^27"
- SET LETTER("J")="22^18^16^14^12"
- +36 SET LETTER("k")="24^18^16^14^12"
- SET LETTER("K")="16^13^11^10^8"
- +37 SET LETTER("l")="50^40^36^32^27"
- SET LETTER("L")="20^16^14^12^10"
- +38 SET LETTER("m")="13^10^9^8^7"
- SET LETTER("M")="13^11^10^9^7"
- +39 SET LETTER("n")="20^16^14^12^10"
- SET LETTER("N")="15^13^11^10^8"
- +40 SET LETTER("o")="20^16^14^12^10"
- SET LETTER("O")="14^11^10^9^7"
- +41 SET LETTER("p")="20^16^14^12^10"
- SET LETTER("P")="16^13^11^10^8"
- +42 SET LETTER("q")="20^16^14^12^10"
- SET LETTER("Q")="14^11^10^9^7"
- +43 SET LETTER("r")="35^32^28^25^21"
- SET LETTER("R")="15^13^11^10^8"
- +44 SET LETTER("s")="22^18^16^14^12"
- SET LETTER("S")="16^13^11^10^8"
- +45 SET LETTER("t")="40^32^28^25^21"
- SET LETTER("T")="18^14^13^11^9"
- +46 SET LETTER("u")="20^16^14^12^10"
- SET LETTER("U")="15^13^11^10^8"
- +47 SET LETTER("v")="23^18^16^14^12"
- SET LETTER("V")="16^13^11^10^8"
- +48 SET LETTER("w")="14^12^11^9^8"
- SET LETTER("W")="11^9^8^7^6"
- +49 SET LETTER("x")="23^18^16^14^12"
- SET LETTER("X")="16^13^11^10^8"
- +50 SET LETTER("y")="23^18^16^14^12"
- SET LETTER("Y")="16^13^11^10^8"
- +51 SET LETTER("z")="23^18^16^14^12"
- SET LETTER("Z")="18^14^13^11^9"
- +52 ;
- +53 ; The LN array contains the length in inches for the different
- +54 ; sections of the laser label.
- +55 SET LN("RX#")=3.126
- +56 SET LN("RXVAMC")=2.626
- +57 SET LN("DRG")=3.376
- +58 SET LN("SIG")=3.126
- +59 SET LN("WRN")=1.99
- +60 SET LN("ML")=2.376
- +61 SET LN("ML2")=1.76
- +62 SET LN("SEC2")=4.1876
- +63 SET LN("SEC2X")=LN("SEC2")
- +64 SET LN("SIG2")=LN("SEC2")
- +65 SET LN("SEC2B")=LN("WRN")
- +66 SET LN("FULL")=8.1876
- +67 ;
- +68 ; The LNTH array is used in calculating the length of the text
- +69 ; for each of the different font sizes.
- +70 SET (LNTH(6),LNTH(8),LNTH(9),LNTH(10),LNTH(12))=""
- +71 ;
- +72 ; This section walks the TEXT string and extracts the each character
- +73 ; then uses the LETTER array to lookup the number of characters per
- +74 ; inch and calculates the length of the TEXT for each font.
- +75 FOR TXTIDX=1:1:$LENGTH(TEXT)
- Begin DoDot:1
- +76 SET LTTR=$EXTRACT(TEXT,TXTIDX)
- SET A=$GET(LETTER(LTTR),"18^16^14^12^10")
- +77 SET LNTH(6)=LNTH(6)+(1/$PIECE(A,U))
- +78 SET LNTH(8)=LNTH(8)+(1/($PIECE(A,U,2)))
- +79 SET LNTH(9)=LNTH(9)+(1/($PIECE(A,U,3)))
- +80 SET LNTH(10)=LNTH(10)+(1/($PIECE(A,U,4)))
- +81 SET LNTH(12)=LNTH(12)+(1/($PIECE(A,U,5)))
- End DoDot:1
- +82 ;
- +83 ; This section determines what would be the optimal font for the TEXT
- +84 IF RLN="WRN"
- Begin DoDot:1
- +85 IF LNTH(12)<LN(RLN)
- SET FONT="F12"
- QUIT
- +86 IF LNTH(10)<(LN(RLN)*2)
- SET FONT="F10"
- QUIT
- +87 IF LNTH(9)<(LN(RLN)*2.5)
- SET FONT="F9"
- QUIT
- +88 IF LNTH(8)<(LN(RLN)*2.6)
- SET FONT="F8"
- QUIT
- +89 SET FONT="F6"
- End DoDot:1
- QUIT
- +90 SET FONT="F0"
- +91 IF LNTH(8)<LN(RLN)
- SET FONT="F8"
- +92 IF LNTH(9)<LN(RLN)
- SET FONT="F9"
- +93 IF LNTH(10)<LN(RLN)
- SET FONT="F10"
- +94 IF LNTH(12)<LN(RLN)
- SET FONT="F12"
- +95 QUIT
- ADD ; Calculate the length and pad "_" to the end of TEXT for change of address
- +1 ; then return FONT and TEXT to calling program.
- +2 NEW NEEDED,CNT,DASH
- +3 SET NEEDED=LN("SEC2X")-LNTH(10)
- +4 SET CNT=NEEDED*12\1
- +5 SET DASH="________________________________________________________________________________________________________________"
- +6 SET TEXT2=TEXT_" "_$EXTRACT(DASH,1,CNT)
- +7 SET FONT="F10"
- +8 QUIT