PSOLLL2 ;BIR/JLC-LASER LABEL ;29-May-2012 14:52;PLS
;;7.0;OUTPATIENT PHARMACY;**120,138,141,1006,161,200,1015**;DEC 1997;Build 62
;
;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
; Modified - IHS/CIA/PLS - 03/05/04
; IHS/MSC/PLS - 09/11/07 - Line L11
; 05/26/10 - Line L11+7
L1 I $G(PSOIO("PFDI"))]"" X PSOIO("PFDI")
I '$G(PFF) D
.N PGY
.M PGY=SGY I $D(OSGY) K PGY M PGY=OSGY
.D COUNTSGF^PSOLLLW
S PFM=0,T=$S($D(REPRINT)&($G(PSOBLALL)):"(GROUP REPRINT)",$D(REPRINT):"(REPRINT)",1:"")
S T=T_$S($G(RXP):"(PARTIAL)",1:"")_$S($D(REPRINT):" ",$G(RXP):" ",1:"")_$P(PS2,"^",2)_" "_TECH_" "_$P(PSONOWT,":",1,2) D PRINT(T)
S T="Rx# "_RXN_" "_DATE_" "_$S('PFF:"Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)),1:"(fill document continued)") D PRINT(T)
S T=PNM_" "_$G(SSNPN) D PRINT(T,1)
S LENGTH=0,PTEXT="",PFF=0,XFONT=$E(PSOFONT,2,99)
N DP,TEXTP,TEXTL,MORE
S DR=PFF("DR")
F I=1:1 Q:'$D(NPGY(DR,I)) S TEXT=NPGY(DR,I) D PRINT(TEXT)
I I>4,$D(NPGY(DR,5)) S PFF=1,PFF("DR")=DR+1
S OPSOY=PSOY
I $G(PSOIO("PFDQ"))]"" X PSOIO("PFDQ")
I PFF S PSOX=PSOCX,PSOY=OPSOY,T="(continued on next fill document)" S PFM=1 D PRINT(T) Q
K NPGY,^TMP($J,"PSOSIGF")
S XFONT=$E(PSOQFONT,2,99)
S TEXT="Qty: " D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(1)=L(XFONT)
S TEXT=" "_PSDU D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(2)=L(XFONT)
S TEXT=" "_$G(PHYS) D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(3)=L(XFONT)
S PPHYS=$G(PHYS)
S TEXT=$G(QTY) D STRT^PSOLLU1("SIG2",TEXT,.L) S LENGTH=Q(1)+Q(2)+Q(3)+L(XFONT+2),Q(4)=L(XFONT+2)
I LENGTH>3.7 F I=$L(PHYS)-1:-1:1 S PPHYS=$E(PHYS,1,I),TEXT=" "_PPHYS D STRT^PSOLLU1("SIG2",TEXT,.L) I Q(1)+Q(2)+Q(4)+L(XFONT)<3.7 Q
S OPSOX=PSOX,PSOX=Q(1)*300+OPSOX,T=$G(QTY) D PRINT(T) S PSOX=OPSOX
S PSOFONT=PSOQFONT,PSOY=PSOY-PSOYI,T="Qty: " D PRINT(T)
S PSOY=PSOY-PSOYI,PSOX=Q(1)+Q(4)*300+OPSOX,T=" "_$G(PSDU)_" "_$G(PPHYS) D PRINT(T)
I $G(PSOIO("PFDT"))]"" X PSOIO("PFDT")
S T=DRUG D PRINT(T)
L11 ; IHS/MSC/PLS - 09/11/07
I $$GET1^DIQ(9009033,PSOSITE,311,"I") D
.S T="NDC "_$$NDCVAL^APSPFUNC(RX,+$G(RXFL(RX))) S T=$$PAD^APSPFUNC(T," ",27)_" Lot# _______________________" D PRINT(T) ;IHS/MSC/PLS - 09/11/07
E S T="Mfr ___________________ Lot# _______________________" D PRINT(T)
G L12
N NDCTEXT
S NDCTEXT="NDC/MFR_______________"
;IHS/MSC/PLS - 05/26/2010 - Next line commented out.
;I $$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RXF)) S NDCTEXT="NDC "_$$GETNDC^PSONDCUT(RX,RXF)
S OPSOX=PSOX,T=NDCTEXT D PRINT(T)
S T="Lot# ___________________" D STRT^PSOLLU1("SIG2",T,.L)
S PSOY=PSOY-PSOYI,PSOX=L(XFONT+2)*300+OPSOX,T="Lot# _____________________" D PRINT(T)
L12 S PSOX=OPSOX,T="Tech___________________ RPh _____________________" D PRINT(T)
S PSOFONT=PSOTFONT
S T="Routing: "_$S("W"[$E(MW):MW,PS55=2:"DO NOT MAIL",1:MW_" MAIL")_" Days supply: "_$G(DAYS)_" Cap: "_$S('PSCAP:"SAFETY",1:"") D PRINT(T)
I PSCAP D
.D STRT^PSOLLU1("SIG2",T,.L) S LENGTH=L(XFONT+1)
.S OPSOX=PSOX,T="NON-SAFETY",PSOX=LENGTH*300+OPSOX,PSOY=PSOY-PSOYI D PRINT(T,1) S PSOX=OPSOX
S T="Isd: "_ISD_" Exp: "_EXPDT_" Last Fill: "_$G(PSOFLAST) D PRINT(T)
S PSOYI=PSOBYI,PSOY=PSOBY
; IHS/CIA/PLS - 03/08/04 - Barcode initialization not needed
;I $G(PSOIO("SBT"))]"" X PSOIO("SBT")
S X2=PSOINST_"-"_RX
; IHS/CIA/PLS - 03/08/04 - Changed to use barcode output routine
;W X2
W $$BC^CIAUBC28(X2,0,50,PSOX,PSOY)
I $G(PSOIO("EBT"))]"" X PSOIO("EBT")
I $G(PSOIO("PFDW"))]"" X PSOIO("PFDW")
S XFONT=$E(PSOFONT,2,99)
I $G(WARN)'="" S PTEXT="DRUG WARNING " D STRT^PSOLLU1("SIG2",PTEXT,.L) S LENGTH=L(XFONT) D
. F I=1:1:$L(WARN,",") S TEXT=$P(WARN,",",I)_"," D
.. D STRT^PSOLLU1("SIG2",TEXT,.L)
.. I LENGTH+L(XFONT)<1.8 S PTEXT=PTEXT_TEXT,LENGTH=LENGTH+L(XFONT) Q
.. S LENGTH=0,I=I-1
.. S T=$P(PTEXT,",",1,$L(PTEXT,",")-1) D PRINT(T) S PTEXT=""
.. I PSOY>PSOYM W "*"
. I PTEXT]"" S T=$P(PTEXT,",",1,$L(PTEXT,",")-1) D PRINT(T)
S PTEXT="Pat. Stat "_PATST_" Clinic: "_PSCLN D STRT^PSOLLU1("SIG2",PTEXT,.L) S T=PTEXT D PRINT(T)
Q
;
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
PSOLLL2 ;BIR/JLC-LASER LABEL ;29-May-2012 14:52;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**120,138,141,1006,161,200,1015**;DEC 1997;Build 62
+2 ;
+3 ;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
+4 ; Modified - IHS/CIA/PLS - 03/05/04
+5 ; IHS/MSC/PLS - 09/11/07 - Line L11
+6 ; 05/26/10 - Line L11+7
L1 IF $GET(PSOIO("PFDI"))]""
XECUTE PSOIO("PFDI")
+1 IF '$GET(PFF)
Begin DoDot:1
+2 NEW PGY
+3 MERGE PGY=SGY
IF $DATA(OSGY)
KILL PGY
MERGE PGY=OSGY
+4 DO COUNTSGF^PSOLLLW
End DoDot:1
+5 SET PFM=0
SET T=$SELECT($DATA(REPRINT)&($GET(PSOBLALL)):"(GROUP REPRINT)",$DATA(REPRINT):"(REPRINT)",1:"")
+6 SET T=T_$SELECT($GET(RXP):"(PARTIAL)",1:"")_$SELECT($DATA(REPRINT):" ",$GET(RXP):" ",1:"")_$PIECE(PS2,"^",2)_" "_TECH_" "_$PIECE(PSONOWT,":",1,2)
DO PRINT(T)
+7 SET T="Rx# "_RXN_" "_DATE_" "_$SELECT('PFF:"Fill "_(RXF+1)_" of "_(1+$PIECE(RXY,"^",9)),1:"(fill document continued)")
DO PRINT(T)
+8 SET T=PNM_" "_$GET(SSNPN)
DO PRINT(T,1)
+9 SET LENGTH=0
SET PTEXT=""
SET PFF=0
SET XFONT=$EXTRACT(PSOFONT,2,99)
+10 NEW DP,TEXTP,TEXTL,MORE
+11 SET DR=PFF("DR")
+12 FOR I=1:1
IF '$DATA(NPGY(DR,I))
QUIT
SET TEXT=NPGY(DR,I)
DO PRINT(TEXT)
+13 IF I>4
IF $DATA(NPGY(DR,5))
SET PFF=1
SET PFF("DR")=DR+1
+14 SET OPSOY=PSOY
+15 IF $GET(PSOIO("PFDQ"))]""
XECUTE PSOIO("PFDQ")
+16 IF PFF
SET PSOX=PSOCX
SET PSOY=OPSOY
SET T="(continued on next fill document)"
SET PFM=1
DO PRINT(T)
QUIT
+17 KILL NPGY,^TMP($JOB,"PSOSIGF")
+18 SET XFONT=$EXTRACT(PSOQFONT,2,99)
+19 SET TEXT="Qty: "
DO STRT^PSOLLU1("SIG2",TEXT,.L)
SET Q(1)=L(XFONT)
+20 SET TEXT=" "_PSDU
DO STRT^PSOLLU1("SIG2",TEXT,.L)
SET Q(2)=L(XFONT)
+21 SET TEXT=" "_$GET(PHYS)
DO STRT^PSOLLU1("SIG2",TEXT,.L)
SET Q(3)=L(XFONT)
+22 SET PPHYS=$GET(PHYS)
+23 SET TEXT=$GET(QTY)
DO STRT^PSOLLU1("SIG2",TEXT,.L)
SET LENGTH=Q(1)+Q(2)+Q(3)+L(XFONT+2)
SET Q(4)=L(XFONT+2)
+24 IF LENGTH>3.7
FOR I=$LENGTH(PHYS)-1:-1:1
SET PPHYS=$EXTRACT(PHYS,1,I)
SET TEXT=" "_PPHYS
DO STRT^PSOLLU1("SIG2",TEXT,.L)
IF Q(1)+Q(2)+Q(4)+L(XFONT)<3.7
QUIT
+25 SET OPSOX=PSOX
SET PSOX=Q(1)*300+OPSOX
SET T=$GET(QTY)
DO PRINT(T)
SET PSOX=OPSOX
+26 SET PSOFONT=PSOQFONT
SET PSOY=PSOY-PSOYI
SET T="Qty: "
DO PRINT(T)
+27 SET PSOY=PSOY-PSOYI
SET PSOX=Q(1)+Q(4)*300+OPSOX
SET T=" "_$GET(PSDU)_" "_$GET(PPHYS)
DO PRINT(T)
+28 IF $GET(PSOIO("PFDT"))]""
XECUTE PSOIO("PFDT")
+29 SET T=DRUG
DO PRINT(T)
L11 ; IHS/MSC/PLS - 09/11/07
+1 IF $$GET1^DIQ(9009033,PSOSITE,311,"I")
Begin DoDot:1
+2 ;IHS/MSC/PLS - 09/11/07
SET T="NDC "_$$NDCVAL^APSPFUNC(RX,+$GET(RXFL(RX)))
SET T=$$PAD^APSPFUNC(T," ",27)_" Lot# _______________________"
DO PRINT(T)
End DoDot:1
+3 IF '$TEST
SET T="Mfr ___________________ Lot# _______________________"
DO PRINT(T)
+4 GOTO L12
+5 NEW NDCTEXT
+6 SET NDCTEXT="NDC/MFR_______________"
+7 ;IHS/MSC/PLS - 05/26/2010 - Next line commented out.
+8 ;I $$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RXF)) S NDCTEXT="NDC "_$$GETNDC^PSONDCUT(RX,RXF)
+9 SET OPSOX=PSOX
SET T=NDCTEXT
DO PRINT(T)
+10 SET T="Lot# ___________________"
DO STRT^PSOLLU1("SIG2",T,.L)
+11 SET PSOY=PSOY-PSOYI
SET PSOX=L(XFONT+2)*300+OPSOX
SET T="Lot# _____________________"
DO PRINT(T)
L12 SET PSOX=OPSOX
SET T="Tech___________________ RPh _____________________"
DO PRINT(T)
+1 SET PSOFONT=PSOTFONT
+2 SET T="Routing: "_$SELECT("W"[$EXTRACT(MW):MW,PS55=2:"DO NOT MAIL",1:MW_" MAIL")_" Days supply: "_$GET(DAYS)_" Cap: "_$SELECT('PSCAP:"SAFETY",1:"")
DO PRINT(T)
+3 IF PSCAP
Begin DoDot:1
+4 DO STRT^PSOLLU1("SIG2",T,.L)
SET LENGTH=L(XFONT+1)
+5 SET OPSOX=PSOX
SET T="NON-SAFETY"
SET PSOX=LENGTH*300+OPSOX
SET PSOY=PSOY-PSOYI
DO PRINT(T,1)
SET PSOX=OPSOX
End DoDot:1
+6 SET T="Isd: "_ISD_" Exp: "_EXPDT_" Last Fill: "_$GET(PSOFLAST)
DO PRINT(T)
+7 SET PSOYI=PSOBYI
SET PSOY=PSOBY
+8 ; IHS/CIA/PLS - 03/08/04 - Barcode initialization not needed
+9 ;I $G(PSOIO("SBT"))]"" X PSOIO("SBT")
+10 SET X2=PSOINST_"-"_RX
+11 ; IHS/CIA/PLS - 03/08/04 - Changed to use barcode output routine
+12 ;W X2
+13 WRITE $$BC^CIAUBC28(X2,0,50,PSOX,PSOY)
+14 IF $GET(PSOIO("EBT"))]""
XECUTE PSOIO("EBT")
+15 IF $GET(PSOIO("PFDW"))]""
XECUTE PSOIO("PFDW")
+16 SET XFONT=$EXTRACT(PSOFONT,2,99)
+17 IF $GET(WARN)'=""
SET PTEXT="DRUG WARNING "
DO STRT^PSOLLU1("SIG2",PTEXT,.L)
SET LENGTH=L(XFONT)
Begin DoDot:1
+18 FOR I=1:1:$LENGTH(WARN,",")
SET TEXT=$PIECE(WARN,",",I)_","
Begin DoDot:2
+19 DO STRT^PSOLLU1("SIG2",TEXT,.L)
+20 IF LENGTH+L(XFONT)<1.8
SET PTEXT=PTEXT_TEXT
SET LENGTH=LENGTH+L(XFONT)
QUIT
+21 SET LENGTH=0
SET I=I-1
+22 SET T=$PIECE(PTEXT,",",1,$LENGTH(PTEXT,",")-1)
DO PRINT(T)
SET PTEXT=""
+23 IF PSOY>PSOYM
WRITE "*"
End DoDot:2
+24 IF PTEXT]""
SET T=$PIECE(PTEXT,",",1,$LENGTH(PTEXT,",")-1)
DO PRINT(T)
End DoDot:1
+25 SET PTEXT="Pat. Stat "_PATST_" Clinic: "_PSCLN
DO STRT^PSOLLU1("SIG2",PTEXT,.L)
SET T=PTEXT
DO PRINT(T)
+26 QUIT
+27 ;
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
