PSORLLL4 ;AITC/BWF - LASER LABELS PRINT PMI ;4/7/22 10:01
;;7.0;OUTPATIENT PHARMACY;**454,676**;DEC 1997;Build 4
;
; BWF - modified copy of PSOLLL4 for OneVa Pharmacy
;Reference to PSNPPIO supported by DBIA 3794
;
S FLAG=$$EN^PSNPPIO($G(LOCDRUG),.MSG)
EN I $G(PSOIO("PMII"))]"" X PSOIO("PMII")
;
; Print a line of CAUTION for HAZ-related medications - PSO*7.0*676
I '$G(L4) D
. N CAUTION,DRUGIEN,HAZ,HAZTEXT
. S CAUTION="CAUTION: HAZARDOUS MEDICATION, PLEASE "
. S DRUGIEN=$P($G(^PSRX(RX,0)),"^",6) ; DRUGIEN=3
. S HAZ=$$HAZ^PSSUTIL(DRUGIEN) ; HAZ="1^1^BLEOMYCIN"
. S HAZTEXT=""
. I $P(HAZ,"^",1) S HAZTEXT=CAUTION_"HANDLE PROPERLY."
. I $P(HAZ,"^",2) S HAZTEXT=CAUTION_"DISPOSE OF PROPERLY."
. I $P(HAZ,"^",1),$P(HAZ,"^",2) S HAZTEXT=CAUTION_"HANDLE AND DISPOSE OF PROPERLY."
. I $L(HAZTEXT)>0 D PRINT^PSOLLL1(HAZTEXT,0) S PSOY=PSOY+PSOYI-25
;
I '$G(PMIM) D MOREWARN
S T=PNM_" Rx#: "_RXN_" "_DRUG D PRINT(T,0) S PSOY=PSOY+PSOYI-25
S CONT=0 I PMIM S CONT=1 D PRINT(PMIF("T"),PMIF("H")) G CONT
I 'FLAG D PRINT(MSG) Q
S T=^TMP($J,"PSNPMI",0)_": "_$G(^TMP($J,"PSNPMI","F",1,0)) D PRINT(T,1) S PSOY=PSOY+PSOYI-25
S T=$G(^TMP($J,"PSNPMI","C",1,0)) I T]"" D PRINT(T,1) S PSOY=PSOY+PSOYI-25
CONT S XFONT=$E(PSOFONT,2,99),(CNT,OUT,PMIM)=0
K A F A="W","U","H","S","M","P","I","O","N","D","R" S CNT=CNT+1,A(CNT)=A
F J=PMIF("A"):1 Q:$G(A(J))="" S A=A(J) I $D(^TMP($J,"PSNPMI",A,1,0)) S HDR=$S(PMIF("A")=1:1,PMIF("B")=1:1,J=PMIF("A"):0,1:1),LENGTH=0,PTEXT="" D Q:OUT S PSOY=PSOY+PSOYI-25
. F B=PMIF("B"):1 Q:'$D(^TMP($J,"PSNPMI",A,B,0)) S TEXT=^(0) D Q:OUT
.. F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
.. F I=PMIF("I"):1:$L(TEXT," ") D STRT^PSOLLU1("FULL",$P(TEXT," ",I)_" ",.L) D Q:OUT
... I LENGTH+L(XFONT)<8.1 S PTEXT=PTEXT_$P(TEXT," ",I)_" ",LENGTH=LENGTH+L(XFONT) Q
... S LENGTH=0,I=I-1
... I HDR D Q
.... I PSOY>PSOYM S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1
.... D PRINT(PTEXT,1) S PTEXT="",HDR=0
... I PSOY>(PSOYM+25) S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1 Q
... D PRINT(PTEXT,0) S PTEXT=""
.. I 'PMIM F I="I","B" S PMIF(I)=1
. I 'PMIM S PMIF("B")=1
. I OUT S PMIF("T")=PTEXT,PMIF("H")=HDR
. Q:OUT I HDR,PTEXT[":" D Q
.. I PSOY>PSOYM S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1,PMIF("T")=PTEXT,PMIF("H")=HDR Q
.. I PTEXT]"" D PRINT(PTEXT,1)
. I PTEXT]"",PSOY>PSOYM S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1,PMIF("T")=PTEXT,PMIF("H")=HDR Q
. I PTEXT]"" D PRINT(PTEXT,0)
Q
PRINT(T,HDR) ;
; Input: T - text to be printed
; HDR - 0-no / 1-yes
;
S HDR=+$G(HDR)
I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
I $G(PSOIO("ST"))]"" X PSOIO("ST")
I HDR,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
I HDR D G PRINT2
. W $P(T,":"),":"
. I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
. W $P(T,":",2,99)
W T
PRINT2 I $G(PSOIO("ET"))]"" X PSOIO("ET")
W ! Q
;
MOREWARN ; SEE ID MORE THAN 5 WARNINGS AND PRINT REMAINDER, IF SO
N LEN,LEN2,I,J,PSOWARN,NEWWARN,PRE
S LEN=$L($G(WARN),",") I LEN<6,'$G(PSOWLBL) Q
S NEWWARN=$G(PSOWLBL)_$P(WARN,",",6,99)
I $E(NEWWARN,$L(NEWWARN))="," S NEWWARN=$E(NEWWARN,1,$L(NEWWARN)-1) I NEWWARN="" Q
S T="Additional Warnings:" D PRINT(T,1)
F I=1:1:$L(NEWWARN,",") S PSOWARN=$P(NEWWARN,",",I) D
.S PRE=PSOWARN_": ",LEN2=$L(PRE)
.S TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN) I TEXT'="" D
..I $L(TEXT)<100 S T=PRE_TEXT D PRINT(T) Q
..S PTEXT="" F J=1:1:$L(TEXT," ") S PTEXT=PTEXT_$P(TEXT," ",J)_" " D
...I $L(PTEXT)>90 D
....S T=PRE_PTEXT D PRINT(T) S PRE=$E(" ",1,LEN2),PTEXT=""
..I PTEXT'="" S T=$G(PRE)_PTEXT D PRINT(T) S PTEXT=""
I PTEXT'="" S T=$G(PRE)_PTEXT D PRINT(T) S PTEXT=""
S PSOY=PSOY+PSOYI
K PSOWLBL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSORLLL4 3761 printed Nov 22, 2024@17:43:55 Page 2
PSORLLL4 ;AITC/BWF - LASER LABELS PRINT PMI ;4/7/22 10:01
+1 ;;7.0;OUTPATIENT PHARMACY;**454,676**;DEC 1997;Build 4
+2 ;
+3 ; BWF - modified copy of PSOLLL4 for OneVa Pharmacy
+4 ;Reference to PSNPPIO supported by DBIA 3794
+5 ;
+6 SET FLAG=$$EN^PSNPPIO($GET(LOCDRUG),.MSG)
EN IF $GET(PSOIO("PMII"))]""
XECUTE PSOIO("PMII")
+1 ;
+2 ; Print a line of CAUTION for HAZ-related medications - PSO*7.0*676
+3 IF '$GET(L4)
Begin DoDot:1
+4 NEW CAUTION,DRUGIEN,HAZ,HAZTEXT
+5 SET CAUTION="CAUTION: HAZARDOUS MEDICATION, PLEASE "
+6 ; DRUGIEN=3
SET DRUGIEN=$PIECE($GET(^PSRX(RX,0)),"^",6)
+7 ; HAZ="1^1^BLEOMYCIN"
SET HAZ=$$HAZ^PSSUTIL(DRUGIEN)
+8 SET HAZTEXT=""
+9 IF $PIECE(HAZ,"^",1)
SET HAZTEXT=CAUTION_"HANDLE PROPERLY."
+10 IF $PIECE(HAZ,"^",2)
SET HAZTEXT=CAUTION_"DISPOSE OF PROPERLY."
+11 IF $PIECE(HAZ,"^",1)
IF $PIECE(HAZ,"^",2)
SET HAZTEXT=CAUTION_"HANDLE AND DISPOSE OF PROPERLY."
+12 IF $LENGTH(HAZTEXT)>0
DO PRINT^PSOLLL1(HAZTEXT,0)
SET PSOY=PSOY+PSOYI-25
End DoDot:1
+13 ;
+14 IF '$GET(PMIM)
DO MOREWARN
+15 SET T=PNM_" Rx#: "_RXN_" "_DRUG
DO PRINT(T,0)
SET PSOY=PSOY+PSOYI-25
+16 SET CONT=0
IF PMIM
SET CONT=1
DO PRINT(PMIF("T"),PMIF("H"))
GOTO CONT
+17 IF 'FLAG
DO PRINT(MSG)
QUIT
+18 SET T=^TMP($JOB,"PSNPMI",0)_": "_$GET(^TMP($JOB,"PSNPMI","F",1,0))
DO PRINT(T,1)
SET PSOY=PSOY+PSOYI-25
+19 SET T=$GET(^TMP($JOB,"PSNPMI","C",1,0))
IF T]""
DO PRINT(T,1)
SET PSOY=PSOY+PSOYI-25
CONT SET XFONT=$EXTRACT(PSOFONT,2,99)
SET (CNT,OUT,PMIM)=0
+1 KILL A
FOR A="W","U","H","S","M","P","I","O","N","D","R"
SET CNT=CNT+1
SET A(CNT)=A
+2 FOR J=PMIF("A"):1
if $GET(A(J))=""
QUIT
SET A=A(J)
IF $DATA(^TMP($JOB,"PSNPMI",A,1,0))
SET HDR=$SELECT(PMIF("A")=1:1,PMIF("B")=1:1,J=PMIF("A"):0,1:1)
SET LENGTH=0
SET PTEXT=""
Begin DoDot:1
+3 FOR B=PMIF("B"):1
if '$DATA(^TMP($JOB,"PSNPMI",A,B,0))
QUIT
SET TEXT=^(0)
Begin DoDot:2
+4 FOR I=1:1
if $EXTRACT(TEXT,I)'=" "
QUIT
SET TEXT=$EXTRACT(TEXT,2,255)
+5 FOR I=PMIF("I"):1:$LENGTH(TEXT," ")
DO STRT^PSOLLU1("FULL",$PIECE(TEXT," ",I)_" ",.L)
Begin DoDot:3
+6 IF LENGTH+L(XFONT)<8.1
SET PTEXT=PTEXT_$PIECE(TEXT," ",I)_" "
SET LENGTH=LENGTH+L(XFONT)
QUIT
+7 SET LENGTH=0
SET I=I-1
+8 IF HDR
Begin DoDot:4
+9 IF PSOY>PSOYM
SET PMIF("A")=J
SET PMIF("I")=I+1
SET PMIF("B")=B
SET OUT=1
SET PMIM=1
+10 DO PRINT(PTEXT,1)
SET PTEXT=""
SET HDR=0
End DoDot:4
QUIT
+11 IF PSOY>(PSOYM+25)
SET PMIF("A")=J
SET PMIF("I")=I+1
SET PMIF("B")=B
SET OUT=1
SET PMIM=1
QUIT
+12 DO PRINT(PTEXT,0)
SET PTEXT=""
End DoDot:3
if OUT
QUIT
+13 IF 'PMIM
FOR I="I","B"
SET PMIF(I)=1
End DoDot:2
if OUT
QUIT
+14 IF 'PMIM
SET PMIF("B")=1
+15 IF OUT
SET PMIF("T")=PTEXT
SET PMIF("H")=HDR
+16 if OUT
QUIT
IF HDR
IF PTEXT[":"
Begin DoDot:2
+17 IF PSOY>PSOYM
SET PMIF("A")=J
SET PMIF("I")=I+1
SET PMIF("B")=B
SET OUT=1
SET PMIM=1
SET PMIF("T")=PTEXT
SET PMIF("H")=HDR
QUIT
+18 IF PTEXT]""
DO PRINT(PTEXT,1)
End DoDot:2
QUIT
+19 IF PTEXT]""
IF PSOY>PSOYM
SET PMIF("A")=J
SET PMIF("I")=I+1
SET PMIF("B")=B
SET OUT=1
SET PMIM=1
SET PMIF("T")=PTEXT
SET PMIF("H")=HDR
QUIT
+20 IF PTEXT]""
DO PRINT(PTEXT,0)
End DoDot:1
if OUT
QUIT
SET PSOY=PSOY+PSOYI-25
+21 QUIT
PRINT(T,HDR) ;
+1 ; Input: T - text to be printed
+2 ; HDR - 0-no / 1-yes
+3 ;
+4 SET HDR=+$GET(HDR)
+5 IF $GET(PSOIO(PSOFONT))]""
XECUTE PSOIO(PSOFONT)
+6 IF $GET(PSOIO("ST"))]""
XECUTE PSOIO("ST")
+7 IF HDR
IF $GET(PSOIO(PSOFONT_"B"))]""
XECUTE PSOIO(PSOFONT_"B")
+8 IF HDR
Begin DoDot:1
+9 WRITE $PIECE(T,":"),":"
+10 IF $GET(PSOIO(PSOFONT))]""
XECUTE PSOIO(PSOFONT)
+11 WRITE $PIECE(T,":",2,99)
End DoDot:1
GOTO PRINT2
+12 WRITE T
PRINT2 IF $GET(PSOIO("ET"))]""
XECUTE PSOIO("ET")
+1 WRITE !
QUIT
+2 ;
MOREWARN ; SEE ID MORE THAN 5 WARNINGS AND PRINT REMAINDER, IF SO
+1 NEW LEN,LEN2,I,J,PSOWARN,NEWWARN,PRE
+2 SET LEN=$LENGTH($GET(WARN),",")
IF LEN<6
IF '$GET(PSOWLBL)
QUIT
+3 SET NEWWARN=$GET(PSOWLBL)_$PIECE(WARN,",",6,99)
+4 IF $EXTRACT(NEWWARN,$LENGTH(NEWWARN))=","
SET NEWWARN=$EXTRACT(NEWWARN,1,$LENGTH(NEWWARN)-1)
IF NEWWARN=""
QUIT
+5 SET T="Additional Warnings:"
DO PRINT(T,1)
+6 FOR I=1:1:$LENGTH(NEWWARN,",")
SET PSOWARN=$PIECE(NEWWARN,",",I)
Begin DoDot:1
+7 SET PRE=PSOWARN_": "
SET LEN2=$LENGTH(PRE)
+8 SET TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN)
IF TEXT'=""
Begin DoDot:2
+9 IF $LENGTH(TEXT)<100
SET T=PRE_TEXT
DO PRINT(T)
QUIT
+10 SET PTEXT=""
FOR J=1:1:$LENGTH(TEXT," ")
SET PTEXT=PTEXT_$PIECE(TEXT," ",J)_" "
Begin DoDot:3
+11 IF $LENGTH(PTEXT)>90
Begin DoDot:4
+12 SET T=PRE_PTEXT
DO PRINT(T)
SET PRE=$EXTRACT(" ",1,LEN2)
SET PTEXT=""
End DoDot:4
End DoDot:3
+13 IF PTEXT'=""
SET T=$GET(PRE)_PTEXT
DO PRINT(T)
SET PTEXT=""
End DoDot:2
End DoDot:1
+14 IF PTEXT'=""
SET T=$GET(PRE)_PTEXT
DO PRINT(T)
SET PTEXT=""
+15 SET PSOY=PSOY+PSOYI
+16 KILL PSOWLBL
+17 QUIT
