source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLLLW.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1PSOLLLW ;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 ;
6PRINT(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 ;
16WARN54 ; 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 ;
23NEWWARN ; 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 ;
29FORMAT ;
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 ;
42INCREM ;
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 ;
48COUNTSG ; 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 ;
80COUNTSGF ; 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 ;
Note: See TracBrowser for help on using the repository browser.