- PSOLLLW ;BIR/EJW - LASER LABELS NEW WARNING LABEL SOURCE ;05/04/2004
- ;;7.0;OUTPATIENT PHARMACY;**161,338**;DEC 1997;Build 3
- ;
- ;External reference to WTEXT^PSSWRNA supported by DBIA 4444
- ;
- PRINT(T,B) ;
- S BOLD=$G(B)
- I 'BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
- I BOLD,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
- I $G(PSOIO("ST"))]"" X PSOIO("ST")
- W T,!
- I $G(PSOIO("ET"))]"" X PSOIO("ET")
- I BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) ;TURN OFF BOLDING
- Q
- ;
- WARN54 ; WARNING LABELS FROM RX CONSULT FILE
- I PSOWARN=" " S PSOY=WWW*115+29+(WWW-1*2) Q ; PRINT BLANK LABEL(S) TO BOTTOM-JUSTIFY IF LESS THAN 5 WARNING LABELS
- S (LENGTH,OUT)=0,LINE=1,LCNT=3
- S TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN)
- I TEXT'="" D FORMAT
- Q
- ;
- NEWWARN ; NEW WARNING LABEL SOURCE
- S (LENGTH,OUT)=0,LINE=1,LCNT=3
- S TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN)
- I TEXT'="" D FORMAT
- Q
- ;
- FORMAT ;
- D STRT^PSOLLU1("WRN",TEXT,.L,.XFONT)
- D INCREM
- S PTEXT=""
- F I=1:1 Q:$E(TEXT)'=" " S TEXT=$E(TEXT,2,255)
- F I=1:1:$L(TEXT," ") D STRT^PSOLLU1("WRN",$P(TEXT," ",I)_" ",.L) D Q:OUT
- . I LENGTH+L($E(XFONT,2,99))<1.99 S PTEXT=PTEXT_$P(TEXT," ",I)_" ",LENGTH=LENGTH+L($E(XFONT,2,99)) Q
- . S LENGTH=0,I=I-1,PSOFONT=XFONT
- . I LINE=4,$P(TEXT," ",I+1)'="" D
- . . S PTEXT="... See printed Additional Warnings."
- . . S PSOWLBL=$G(PSOWLBL)_$G(PSOWARN)_","
- . D PRINT(PTEXT) S PTEXT="",LINE=LINE+1 I LINE>LCNT S OUT=1 Q
- I 'OUT S PSOFONT=XFONT D PRINT(PTEXT)
- S PSOY=WWW*115+29+(WWW-1*2)
- Q
- ;
- INCREM ;
- I XFONT="F6" S LCNT=4
- 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)
- I WWW=1 S PSOY=$S(PSOY>103:PSOY-20,1:PSOY),PSOYI=$S(XFONT="F10":30,XFONT="F6":20,1:PSOYI)
- Q
- ;
- COUNTSG ; COUNT LINES NEEDED FOR BOTTLE LABEL SIG FOR CALCULATED FONT
- N CNT,SUBS
- S CNT=0
- K ^TMP($J,"PSOSIG",RX)
- S PSOX=OPSOX,LENGTH=0,PTEXT="",SIGF=0,XFONT=$E(PSOFONT,2,99)
- N DP,TEXTP,TEXTL,MORE
- F DR=SIGF("DR"):1 Q:$G(SGY(DR))="" S TEXT=SGY(DR) D Q:SIGF
- . F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
- . S DP=$S(TEXT[" ":" ",TEXT[",":",",1:" ")
- . F I=SIGF("T"):1:$L(TEXT,DP) D Q:SIGF
- .. S TEXTP=$P(TEXT,DP,I) Q:TEXTP="" I $D(SIGF("J")) S TEXTP=$E(TEXTP,SIGF("J"),255) K SIGF("J")
- .. D STRT^PSOLLU1("SIG",TEXTP_" ",.L) I L(XFONT)>3.3 D
- ... S MORE=0
- ... F J=$L(TEXTP):-1:1 S TEXTL=PTEXT_$E(TEXTP,1,J) D STRT^PSOLLU1("SIG",TEXTL_" ",.L) D Q:SIGF!MORE
- .... Q:L(XFONT)>3.3
- .... S CNT=CNT+1,^TMP($J,"PSOSIG",RX,CNT)=TEXTL,TEXT=$E(TEXT,J+1,999),PTEXT=""
- .... D STRT^PSOLLU1("SIG",TEXT_DP,.L) S TEXTP=TEXT,J=$L(TEXTP) I L(XFONT)<3.3 S MORE=1,LENGTH=0
- .. I LENGTH+L(XFONT)<3.3 S PTEXT=PTEXT_TEXTP_" ",LENGTH=LENGTH+L(XFONT) Q
- .. S LENGTH=0,I=I-1
- .. S CNT=CNT+1,^TMP($J,"PSOSIG",RX,CNT)=PTEXT S PTEXT=""
- . I 'SIGF S SIGF("T")=1
- I PTEXT]"" S CNT=CNT+1,^TMP($J,"PSOSIG",RX,CNT)=PTEXT
- K NSGY
- ; 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).
- ; 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.
- N I,J,MODCNT
- F I=1:1:CNT S J=$S(I#9:(I\9)+1,1:I\9) D
- .S SUBS=$S(J=1:I,1:I-((J-1)*9))
- .S NSGY(J,SUBS)=^TMP($J,"PSOSIG",RX,I)
- S MODCNT=CNT#9 I MODCNT=0!(MODCNT>4) S NSGY($G(J)+1,0)=" " ; FORCE LAST CONTINUED LABEL
- Q
- ;
- COUNTSGF ; COUNT LINES NEEDED FOR PHARMACY FILL CARD SIG FOR CALCULATED FONT
- N CNT
- S CNT=0
- K ^TMP($J,"PSOSIGF",RX)
- S LENGTH=0,PTEXT="",PFF=0,XFONT=$E(PSOFONT,2,99)
- N DP,TEXTP,TEXTL,MORE
- F DR=PFF("DR"):1 Q:$G(PGY(DR))="" S TEXT=PGY(DR) D Q:PFF
- . F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
- . S DP=$S(TEXT[" ":" ",TEXT[",":",",1:" ")
- . F I=PFF("T"):1:$L(TEXT,DP) D Q:PFF
- .. S TEXTP=$P(TEXT,DP,I) Q:TEXTP="" I $D(PFF("J")) S TEXTP=$E(TEXTP,PFF("J"),255) K PFF("J")
- .. D STRT^PSOLLU1("SIG",TEXTP_" ",.L) I L(XFONT)>3.3 D
- ... S MORE=0
- ... F J=$L(TEXTP):-1:1 S TEXTL=PTEXT_$E(TEXTP,1,J) D STRT^PSOLLU1("SIG",TEXTL_" ",.L) D Q:PFF!MORE
- .... Q:L(XFONT)>3.3
- .... S CNT=CNT+1,^TMP($J,"PSOSIGF",RX,CNT)=TEXTL,TEXT=$E(TEXT,J+1,999),PTEXT=""
- .... D STRT^PSOLLU1("SIG",TEXT_DP,.L) S TEXTP=TEXT,J=$L(TEXTP) I L(XFONT)<3.3 S MORE=1,LENGTH=0
- .. I LENGTH+L(XFONT)<3.3 S PTEXT=PTEXT_TEXTP_" ",LENGTH=LENGTH+L(XFONT) Q
- .. S LENGTH=0,I=I-1
- .. S CNT=CNT+1,^TMP($J,"PSOSIGF",RX,CNT)=PTEXT S PTEXT=""
- . I 'PFF S PFF("T")=1
- I PTEXT]"" S CNT=CNT+1,^TMP($J,"PSOSIGF",RX,CNT)=PTEXT
- K NPGY
- ; 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
- N I,J,MODCNT
- F I=1:1:CNT S J=$S(I#11:(I\11)+1,1:I\11) D
- .S SUBS=$S(J=1:I,1:I-((J-1)*11))
- .S NPGY(J,SUBS)=^TMP($J,"PSOSIGF",RX,I)
- S MODCNT=CNT#11 I MODCNT=0!(MODCNT>4) S NPGY($G(J)+1,0)=" " ; FORCE LAST CONTINUED LABEL
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOLLLW 5001 printed Feb 18, 2025@23:57:09 Page 2
- PSOLLLW ;BIR/EJW - LASER LABELS NEW WARNING LABEL SOURCE ;05/04/2004
- +1 ;;7.0;OUTPATIENT PHARMACY;**161,338**;DEC 1997;Build 3
- +2 ;
- +3 ;External reference to WTEXT^PSSWRNA supported by DBIA 4444
- +4 ;
- PRINT(T,B) ;
- +1 SET BOLD=$GET(B)
- +2 IF 'BOLD
- IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +3 IF BOLD
- IF $GET(PSOIO(PSOFONT_"B"))]""
- XECUTE PSOIO(PSOFONT_"B")
- +4 IF $GET(PSOIO("ST"))]""
- XECUTE PSOIO("ST")
- +5 WRITE T,!
- +6 IF $GET(PSOIO("ET"))]""
- XECUTE PSOIO("ET")
- +7 ;TURN OFF BOLDING
- IF BOLD
- IF $GET(PSOIO(PSOFONT))]""
- XECUTE PSOIO(PSOFONT)
- +8 QUIT
- +9 ;
- WARN54 ; WARNING LABELS FROM RX CONSULT FILE
- +1 ; PRINT BLANK LABEL(S) TO BOTTOM-JUSTIFY IF LESS THAN 5 WARNING LABELS
- IF PSOWARN=" "
- SET PSOY=WWW*115+29+(WWW-1*2)
- QUIT
- +2 SET (LENGTH,OUT)=0
- SET LINE=1
- SET LCNT=3
- +3 SET TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN)
- +4 IF TEXT'=""
- DO FORMAT
- +5 QUIT
- +6 ;
- NEWWARN ; NEW WARNING LABEL SOURCE
- +1 SET (LENGTH,OUT)=0
- SET LINE=1
- SET LCNT=3
- +2 SET TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN)
- +3 IF TEXT'=""
- DO FORMAT
- +4 QUIT
- +5 ;
- FORMAT ;
- +1 DO STRT^PSOLLU1("WRN",TEXT,.L,.XFONT)
- +2 DO INCREM
- +3 SET PTEXT=""
- +4 FOR I=1:1
- if $EXTRACT(TEXT)'=" "
- QUIT
- SET TEXT=$EXTRACT(TEXT,2,255)
- +5 FOR I=1:1:$LENGTH(TEXT," ")
- DO STRT^PSOLLU1("WRN",$PIECE(TEXT," ",I)_" ",.L)
- Begin DoDot:1
- +6 IF LENGTH+L($EXTRACT(XFONT,2,99))<1.99
- SET PTEXT=PTEXT_$PIECE(TEXT," ",I)_" "
- SET LENGTH=LENGTH+L($EXTRACT(XFONT,2,99))
- QUIT
- +7 SET LENGTH=0
- SET I=I-1
- SET PSOFONT=XFONT
- +8 IF LINE=4
- IF $PIECE(TEXT," ",I+1)'=""
- Begin DoDot:2
- +9 SET PTEXT="... See printed Additional Warnings."
- +10 SET PSOWLBL=$GET(PSOWLBL)_$GET(PSOWARN)_","
- End DoDot:2
- +11 DO PRINT(PTEXT)
- SET PTEXT=""
- SET LINE=LINE+1
- IF LINE>LCNT
- SET OUT=1
- QUIT
- End DoDot:1
- if OUT
- QUIT
- +12 IF 'OUT
- SET PSOFONT=XFONT
- DO PRINT(PTEXT)
- +13 SET PSOY=WWW*115+29+(WWW-1*2)
- +14 QUIT
- +15 ;
- INCREM ;
- +1 IF XFONT="F6"
- SET LCNT=4
- +2 SET PSOY=PSOY+$SELECT(XFONT="F12":10,XFONT="F10":8,XFONT="F9":8,1:5)
- SET PSOYI=$SELECT(XFONT="F12":40,XFONT="F10":35,XFONT="F9":29,1:29)
- +3 IF WWW=1
- SET PSOY=$SELECT(PSOY>103:PSOY-20,1:PSOY)
- SET PSOYI=$SELECT(XFONT="F10":30,XFONT="F6":20,1:PSOYI)
- +4 QUIT
- +5 ;
- COUNTSG ; COUNT LINES NEEDED FOR BOTTLE LABEL SIG FOR CALCULATED FONT
- +1 NEW CNT,SUBS
- +2 SET CNT=0
- +3 KILL ^TMP($JOB,"PSOSIG",RX)
- +4 SET PSOX=OPSOX
- SET LENGTH=0
- SET PTEXT=""
- SET SIGF=0
- SET XFONT=$EXTRACT(PSOFONT,2,99)
- +5 NEW DP,TEXTP,TEXTL,MORE
- +6 FOR DR=SIGF("DR"):1
- if $GET(SGY(DR))=""
- QUIT
- SET TEXT=SGY(DR)
- Begin DoDot:1
- +7 FOR I=1:1
- if $EXTRACT(TEXT,I)'=" "
- QUIT
- SET TEXT=$EXTRACT(TEXT,2,255)
- +8 SET DP=$SELECT(TEXT[" ":" ",TEXT[",":",",1:" ")
- +9 FOR I=SIGF("T"):1:$LENGTH(TEXT,DP)
- Begin DoDot:2
- +10 SET TEXTP=$PIECE(TEXT,DP,I)
- if TEXTP=""
- QUIT
- IF $DATA(SIGF("J"))
- SET TEXTP=$EXTRACT(TEXTP,SIGF("J"),255)
- KILL SIGF("J")
- +11 DO STRT^PSOLLU1("SIG",TEXTP_" ",.L)
- IF L(XFONT)>3.3
- Begin DoDot:3
- +12 SET MORE=0
- +13 FOR J=$LENGTH(TEXTP):-1:1
- SET TEXTL=PTEXT_$EXTRACT(TEXTP,1,J)
- DO STRT^PSOLLU1("SIG",TEXTL_" ",.L)
- Begin DoDot:4
- +14 if L(XFONT)>3.3
- QUIT
- +15 SET CNT=CNT+1
- SET ^TMP($JOB,"PSOSIG",RX,CNT)=TEXTL
- SET TEXT=$EXTRACT(TEXT,J+1,999)
- SET PTEXT=""
- +16 DO STRT^PSOLLU1("SIG",TEXT_DP,.L)
- SET TEXTP=TEXT
- SET J=$LENGTH(TEXTP)
- IF L(XFONT)<3.3
- SET MORE=1
- SET LENGTH=0
- End DoDot:4
- if SIGF!MORE
- QUIT
- End DoDot:3
- +17 IF LENGTH+L(XFONT)<3.3
- SET PTEXT=PTEXT_TEXTP_" "
- SET LENGTH=LENGTH+L(XFONT)
- QUIT
- +18 SET LENGTH=0
- SET I=I-1
- +19 SET CNT=CNT+1
- SET ^TMP($JOB,"PSOSIG",RX,CNT)=PTEXT
- SET PTEXT=""
- End DoDot:2
- if SIGF
- QUIT
- +20 IF 'SIGF
- SET SIGF("T")=1
- End DoDot:1
- if SIGF
- QUIT
- +21 IF PTEXT]""
- SET CNT=CNT+1
- SET ^TMP($JOB,"PSOSIG",RX,CNT)=PTEXT
- +22 KILL NSGY
- +23 ; 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).
- +24 ; 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.
- +25 NEW I,J,MODCNT
- +26 FOR I=1:1:CNT
- SET J=$SELECT(I#9:(I\9)+1,1:I\9)
- Begin DoDot:1
- +27 SET SUBS=$SELECT(J=1:I,1:I-((J-1)*9))
- +28 SET NSGY(J,SUBS)=^TMP($JOB,"PSOSIG",RX,I)
- End DoDot:1
- +29 ; FORCE LAST CONTINUED LABEL
- SET MODCNT=CNT#9
- IF MODCNT=0!(MODCNT>4)
- SET NSGY($GET(J)+1,0)=" "
- +30 QUIT
- +31 ;
- COUNTSGF ; COUNT LINES NEEDED FOR PHARMACY FILL CARD SIG FOR CALCULATED FONT
- +1 NEW CNT
- +2 SET CNT=0
- +3 KILL ^TMP($JOB,"PSOSIGF",RX)
- +4 SET LENGTH=0
- SET PTEXT=""
- SET PFF=0
- SET XFONT=$EXTRACT(PSOFONT,2,99)
- +5 NEW DP,TEXTP,TEXTL,MORE
- +6 FOR DR=PFF("DR"):1
- if $GET(PGY(DR))=""
- QUIT
- SET TEXT=PGY(DR)
- Begin DoDot:1
- +7 FOR I=1:1
- if $EXTRACT(TEXT,I)'=" "
- QUIT
- SET TEXT=$EXTRACT(TEXT,2,255)
- +8 SET DP=$SELECT(TEXT[" ":" ",TEXT[",":",",1:" ")
- +9 FOR I=PFF("T"):1:$LENGTH(TEXT,DP)
- Begin DoDot:2
- +10 SET TEXTP=$PIECE(TEXT,DP,I)
- if TEXTP=""
- QUIT
- IF $DATA(PFF("J"))
- SET TEXTP=$EXTRACT(TEXTP,PFF("J"),255)
- KILL PFF("J")
- +11 DO STRT^PSOLLU1("SIG",TEXTP_" ",.L)
- IF L(XFONT)>3.3
- Begin DoDot:3
- +12 SET MORE=0
- +13 FOR J=$LENGTH(TEXTP):-1:1
- SET TEXTL=PTEXT_$EXTRACT(TEXTP,1,J)
- DO STRT^PSOLLU1("SIG",TEXTL_" ",.L)
- Begin DoDot:4
- +14 if L(XFONT)>3.3
- QUIT
- +15 SET CNT=CNT+1
- SET ^TMP($JOB,"PSOSIGF",RX,CNT)=TEXTL
- SET TEXT=$EXTRACT(TEXT,J+1,999)
- SET PTEXT=""
- +16 DO STRT^PSOLLU1("SIG",TEXT_DP,.L)
- SET TEXTP=TEXT
- SET J=$LENGTH(TEXTP)
- IF L(XFONT)<3.3
- SET MORE=1
- SET LENGTH=0
- End DoDot:4
- if PFF!MORE
- QUIT
- End DoDot:3
- +17 IF LENGTH+L(XFONT)<3.3
- SET PTEXT=PTEXT_TEXTP_" "
- SET LENGTH=LENGTH+L(XFONT)
- QUIT
- +18 SET LENGTH=0
- SET I=I-1
- +19 SET CNT=CNT+1
- SET ^TMP($JOB,"PSOSIGF",RX,CNT)=PTEXT
- SET PTEXT=""
- End DoDot:2
- if PFF
- QUIT
- +20 IF 'PFF
- SET PFF("T")=1
- End DoDot:1
- if PFF
- QUIT
- +21 IF PTEXT]""
- SET CNT=CNT+1
- SET ^TMP($JOB,"PSOSIGF",RX,CNT)=PTEXT
- +22 KILL NPGY
- +23 ; 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
- +24 NEW I,J,MODCNT
- +25 FOR I=1:1:CNT
- SET J=$SELECT(I#11:(I\11)+1,1:I\11)
- Begin DoDot:1
- +26 SET SUBS=$SELECT(J=1:I,1:I-((J-1)*11))
- +27 SET NPGY(J,SUBS)=^TMP($JOB,"PSOSIGF",RX,I)
- End DoDot:1
- +28 ; FORCE LAST CONTINUED LABEL
- SET MODCNT=CNT#11
- IF MODCNT=0!(MODCNT>4)
- SET NPGY($GET(J)+1,0)=" "
- +29 QUIT
- +30 ;