[613] | 1 | PSOLLLW ;BIR/EJW - LASER LABELS NEW WARNING LABEL SOURCE ;05/04/2004
|
---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**161**;DEC 1997
|
---|
| 3 | ;
|
---|
| 4 | ;External reference to WTEXT^PSSWRNA supported by DBIA 4444
|
---|
| 5 | ;
|
---|
| 6 | PRINT(T,B) ;
|
---|
| 7 | S BOLD=$G(B)
|
---|
| 8 | I 'BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
|
---|
| 9 | I BOLD,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
|
---|
| 10 | I $G(PSOIO("ST"))]"" X PSOIO("ST")
|
---|
| 11 | W T,!
|
---|
| 12 | I $G(PSOIO("ET"))]"" X PSOIO("ET")
|
---|
| 13 | I BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) ;TURN OFF BOLDING
|
---|
| 14 | Q
|
---|
| 15 | ;
|
---|
| 16 | WARN54 ; WARNING LABELS FROM RX CONSULT FILE
|
---|
| 17 | I PSOWARN=" " S PSOY=WWW*115+29+(WWW-1*2) Q ; PRINT BLANK LABEL(S) TO BOTTOM-JUSTIFY IF LESS THAN 5 WARNING LABELS
|
---|
| 18 | S (LENGTH,OUT)=0,LINE=1,LCNT=3
|
---|
| 19 | S TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN)
|
---|
| 20 | I TEXT'="" D FORMAT
|
---|
| 21 | Q
|
---|
| 22 | ;
|
---|
| 23 | NEWWARN ; NEW WARNING LABEL SOURCE
|
---|
| 24 | S (LENGTH,OUT)=0,LINE=1,LCNT=3
|
---|
| 25 | S TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN)
|
---|
| 26 | I TEXT'="" D FORMAT
|
---|
| 27 | Q
|
---|
| 28 | ;
|
---|
| 29 | FORMAT ;
|
---|
| 30 | D STRT^PSOLLU1("WRN",TEXT,.L,.XFONT)
|
---|
| 31 | D INCREM
|
---|
| 32 | S PTEXT=""
|
---|
| 33 | F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
|
---|
| 34 | F I=1:1:$L(TEXT," ") D STRT^PSOLLU1("WRN",$P(TEXT," ",I)_" ",.L) D Q:OUT
|
---|
| 35 | . I LENGTH+L($E(XFONT,2,99))<1.99 S PTEXT=PTEXT_$P(TEXT," ",I)_" ",LENGTH=LENGTH+L($E(XFONT,2,99)) Q
|
---|
| 36 | . S LENGTH=0,I=I-1,PSOFONT=XFONT
|
---|
| 37 | . D PRINT(PTEXT) S PTEXT="",LINE=LINE+1 I LINE>LCNT S OUT=1 Q
|
---|
| 38 | I 'OUT S PSOFONT=XFONT D PRINT(PTEXT)
|
---|
| 39 | S PSOY=WWW*115+29+(WWW-1*2)
|
---|
| 40 | Q
|
---|
| 41 | ;
|
---|
| 42 | INCREM ;
|
---|
| 43 | I XFONT="F6" S LCNT=4
|
---|
| 44 | S PSOY=PSOY+$S(XFONT="F12":10,XFONT="F10":8,XFONT="F9":8,1:5),PSOYI=$S(XFONT="F12":40,XFONT="F10":35,XFONT="F9":29,1:29)
|
---|
| 45 | I WWW=1 S PSOY=$S(PSOY>103:PSOY-20,1:PSOY),PSOYI=$S(XFONT="F10":30,XFONT="F6":20,1:PSOYI)
|
---|
| 46 | Q
|
---|
| 47 | ;
|
---|
| 48 | COUNTSG ; COUNT LINES NEEDED FOR BOTTLE LABEL SIG FOR CALCULATED FONT
|
---|
| 49 | N CNT,SUBS
|
---|
| 50 | S CNT=0
|
---|
| 51 | K ^TMP($J,"PSOSIG",RX)
|
---|
| 52 | S PSOX=OPSOX,LENGTH=0,PTEXT="",SIGF=0,XFONT=$E(PSOFONT,2,99)
|
---|
| 53 | N DP,TEXTP,TEXTL,MORE
|
---|
| 54 | F DR=SIGF("DR"):1 Q:$G(SGY(DR))="" S TEXT=SGY(DR) D Q:SIGF
|
---|
| 55 | . F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
|
---|
| 56 | . S DP=$S(TEXT[" ":" ",TEXT[",":",",1:" ")
|
---|
| 57 | . F I=SIGF("T"):1:$L(TEXT,DP) D Q:SIGF
|
---|
| 58 | .. S TEXTP=$P(TEXT,DP,I) Q:TEXTP="" I $D(SIGF("J")) S TEXTP=$E(TEXTP,SIGF("J"),255) K SIGF("J")
|
---|
| 59 | .. D STRT^PSOLLU1("SIG",TEXTP_" ",.L) I L(XFONT)>3.3 D
|
---|
| 60 | ... S MORE=0
|
---|
| 61 | ... F J=$L(TEXTP):-1:1 S TEXTL=PTEXT_$E(TEXTP,1,J) D STRT^PSOLLU1("SIG",TEXTL_" ",.L) D Q:SIGF!MORE
|
---|
| 62 | .... Q:L(XFONT)>3.3
|
---|
| 63 | .... S CNT=CNT+1,^TMP($J,"PSOSIG",RX,CNT)=TEXTL,TEXT=$E(TEXT,J+1,999),PTEXT=""
|
---|
| 64 | .... D STRT^PSOLLU1("SIG",TEXT_DP,.L) S TEXTP=TEXT,J=$L(TEXTP) I L(XFONT)<3.3 S MORE=1,LENGTH=0
|
---|
| 65 | .. I LENGTH+L(XFONT)<3.3 S PTEXT=PTEXT_TEXTP_" ",LENGTH=LENGTH+L(XFONT) Q
|
---|
| 66 | .. S LENGTH=0,I=I-1
|
---|
| 67 | .. S CNT=CNT+1,^TMP($J,"PSOSIG",RX,CNT)=PTEXT S PTEXT=""
|
---|
| 68 | . I 'SIGF S SIGF("T")=1
|
---|
| 69 | I PTEXT]"" S CNT=CNT+1,^TMP($J,"PSOSIG",RX,CNT)=PTEXT
|
---|
| 70 | K NSGY
|
---|
| 71 | ; FOR LONG SIGS THE SMALLEST FONT WILL BE USED. USING THAT FONT, 9 LINES OF THE SIG WILL FIT ON EACH BOTTLE LABEL. ON THE LAST 'CONTINUED' LABEL A MAXIMUM OF 4 LINES OF THE SIG CAN PRINT (WITHIN LINES 5-8 OF THE LABEL).
|
---|
| 72 | ; IF THERE ARE LESS THAN 4 LINES ON THE LAST 'CONTINUED' LABEL, THE REMAINDER OF THE SIG WILL PRINT BOTTOM-JUSTIFIED WITHIN LINES 5-8 OF THE CONTINUATION LABEL.
|
---|
| 73 | N I,J,MODCNT
|
---|
| 74 | F I=1:1:CNT S J=$S(I#9:(I\9)+1,1:I\9) D
|
---|
| 75 | .S SUBS=$S(J=1:I,1:I-((J-1)*9))
|
---|
| 76 | .S NSGY(J,SUBS)=^TMP($J,"PSOSIG",RX,I)
|
---|
| 77 | S MODCNT=CNT#9 I MODCNT=0!(MODCNT>4) S NSGY($G(J)+1,0)=" " ; FORCE LAST CONTINUED LABEL
|
---|
| 78 | Q
|
---|
| 79 | ;
|
---|
| 80 | COUNTSGF ; COUNT LINES NEEDED FOR PHARMACY FILL CARD SIG FOR CALCULATED FONT
|
---|
| 81 | N CNT
|
---|
| 82 | S CNT=0
|
---|
| 83 | K ^TMP($J,"PSOSIGF",RX)
|
---|
| 84 | S LENGTH=0,PTEXT="",PFF=0,XFONT=$E(PSOFONT,2,99)
|
---|
| 85 | N DP,TEXTP,TEXTL,MORE
|
---|
| 86 | F DR=PFF("DR"):1 Q:$G(PGY(DR))="" S TEXT=PGY(DR) D Q:PFF
|
---|
| 87 | . F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
|
---|
| 88 | . S DP=$S(TEXT[" ":" ",TEXT[",":",",1:" ")
|
---|
| 89 | . F I=PFF("T"):1:$L(TEXT,DP) D Q:PFF
|
---|
| 90 | .. S TEXTP=$P(TEXT,DP,I) Q:TEXTP="" I $D(PFF("J")) S TEXTP=$E(TEXTP,PFF("J"),255) K PFF("J")
|
---|
| 91 | .. D STRT^PSOLLU1("SIG",TEXTP_" ",.L) I L(XFONT)>3.3 D
|
---|
| 92 | ... S MORE=0
|
---|
| 93 | ... F J=$L(TEXTP):-1:1 S TEXTL=PTEXT_$E(TEXTP,1,J) D STRT^PSOLLU1("SIG",TEXTL_" ",.L) D Q:PFF!MORE
|
---|
| 94 | .... Q:L(XFONT)>3.3
|
---|
| 95 | .... S CNT=CNT+1,^TMP($J,"PSOSIGF",RX,CNT)=TEXTL,TEXT=$E(TEXT,J+1,999),PTEXT=""
|
---|
| 96 | .... D STRT^PSOLLU1("SIG",TEXT_DP,.L) S TEXTP=TEXT,J=$L(TEXTP) I L(XFONT)<3.3 S MORE=1,LENGTH=0
|
---|
| 97 | .. I LENGTH+L(XFONT)<3.3 S PTEXT=PTEXT_TEXTP_" ",LENGTH=LENGTH+L(XFONT) Q
|
---|
| 98 | .. S LENGTH=0,I=I-1
|
---|
| 99 | .. S CNT=CNT+1,^TMP($J,"PSOSIGF",RX,CNT)=PTEXT S PTEXT=""
|
---|
| 100 | . I 'PFF S PFF("T")=1
|
---|
| 101 | I PTEXT]"" S CNT=CNT+1,^TMP($J,"PSOSIGF",RX,CNT)=PTEXT
|
---|
| 102 | K NPGY
|
---|
| 103 | ; 11 LINES OF THE SIG WILL FIT ON EACH PHARMACY FILL CARD LABEL. ON THE LAST 'CONTINUED' LABEL A MAXIMUM OF 4 LINES OF THE SIG CAN PRINT
|
---|
| 104 | N I,J,MODCNT
|
---|
| 105 | F I=1:1:CNT S J=$S(I#11:(I\11)+1,1:I\11) D
|
---|
| 106 | .S SUBS=$S(J=1:I,1:I-((J-1)*11))
|
---|
| 107 | .S NPGY(J,SUBS)=^TMP($J,"PSOSIGF",RX,I)
|
---|
| 108 | S MODCNT=CNT#11 I MODCNT=0!(MODCNT>4) S NPGY($G(J)+1,0)=" " ; FORCE LAST CONTINUED LABEL
|
---|
| 109 | Q
|
---|
| 110 | ;
|
---|