- 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 Feb 19, 2025@00:00:22 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