Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSORLLL4

PSORLLL4.m

Go to the documentation of this file.
  1. PSORLLL4 ;AITC/BWF - LASER LABELS PRINT PMI ;4/7/22 10:01
  1. ;;7.0;OUTPATIENT PHARMACY;**454,676**;DEC 1997;Build 4
  1. ;
  1. ; BWF - modified copy of PSOLLL4 for OneVa Pharmacy
  1. ;Reference to PSNPPIO supported by DBIA 3794
  1. ;
  1. S FLAG=$$EN^PSNPPIO($G(LOCDRUG),.MSG)
  1. EN I $G(PSOIO("PMII"))]"" X PSOIO("PMII")
  1. ;
  1. ; Print a line of CAUTION for HAZ-related medications - PSO*7.0*676
  1. I '$G(L4) D
  1. . N CAUTION,DRUGIEN,HAZ,HAZTEXT
  1. . S CAUTION="CAUTION: HAZARDOUS MEDICATION, PLEASE "
  1. . S DRUGIEN=$P($G(^PSRX(RX,0)),"^",6) ; DRUGIEN=3
  1. . S HAZ=$$HAZ^PSSUTIL(DRUGIEN) ; HAZ="1^1^BLEOMYCIN"
  1. . S HAZTEXT=""
  1. . I $P(HAZ,"^",1) S HAZTEXT=CAUTION_"HANDLE PROPERLY."
  1. . I $P(HAZ,"^",2) S HAZTEXT=CAUTION_"DISPOSE OF PROPERLY."
  1. . I $P(HAZ,"^",1),$P(HAZ,"^",2) S HAZTEXT=CAUTION_"HANDLE AND DISPOSE OF PROPERLY."
  1. . I $L(HAZTEXT)>0 D PRINT^PSOLLL1(HAZTEXT,0) S PSOY=PSOY+PSOYI-25
  1. ;
  1. I '$G(PMIM) D MOREWARN
  1. S T=PNM_" Rx#: "_RXN_" "_DRUG D PRINT(T,0) S PSOY=PSOY+PSOYI-25
  1. S CONT=0 I PMIM S CONT=1 D PRINT(PMIF("T"),PMIF("H")) G CONT
  1. I 'FLAG D PRINT(MSG) Q
  1. S T=^TMP($J,"PSNPMI",0)_": "_$G(^TMP($J,"PSNPMI","F",1,0)) D PRINT(T,1) S PSOY=PSOY+PSOYI-25
  1. S T=$G(^TMP($J,"PSNPMI","C",1,0)) I T]"" D PRINT(T,1) S PSOY=PSOY+PSOYI-25
  1. CONT S XFONT=$E(PSOFONT,2,99),(CNT,OUT,PMIM)=0
  1. K A F A="W","U","H","S","M","P","I","O","N","D","R" S CNT=CNT+1,A(CNT)=A
  1. 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
  1. . F B=PMIF("B"):1 Q:'$D(^TMP($J,"PSNPMI",A,B,0)) S TEXT=^(0) D Q:OUT
  1. .. F I=1:1 Q:$E(TEXT,I)'=" " S TEXT=$E(TEXT,2,255)
  1. .. F I=PMIF("I"):1:$L(TEXT," ") D STRT^PSOLLU1("FULL",$P(TEXT," ",I)_" ",.L) D Q:OUT
  1. ... I LENGTH+L(XFONT)<8.1 S PTEXT=PTEXT_$P(TEXT," ",I)_" ",LENGTH=LENGTH+L(XFONT) Q
  1. ... S LENGTH=0,I=I-1
  1. ... I HDR D Q
  1. .... I PSOY>PSOYM S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1
  1. .... D PRINT(PTEXT,1) S PTEXT="",HDR=0
  1. ... I PSOY>(PSOYM+25) S PMIF("A")=J,PMIF("I")=I+1,PMIF("B")=B,OUT=1,PMIM=1 Q
  1. ... D PRINT(PTEXT,0) S PTEXT=""
  1. .. I 'PMIM F I="I","B" S PMIF(I)=1
  1. . I 'PMIM S PMIF("B")=1
  1. . I OUT S PMIF("T")=PTEXT,PMIF("H")=HDR
  1. . Q:OUT I HDR,PTEXT[":" D Q
  1. .. 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
  1. .. I PTEXT]"" D PRINT(PTEXT,1)
  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
  1. . I PTEXT]"" D PRINT(PTEXT,0)
  1. Q
  1. PRINT(T,HDR) ;
  1. ; Input: T - text to be printed
  1. ; HDR - 0-no / 1-yes
  1. ;
  1. S HDR=+$G(HDR)
  1. I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
  1. I $G(PSOIO("ST"))]"" X PSOIO("ST")
  1. I HDR,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
  1. I HDR D G PRINT2
  1. . W $P(T,":"),":"
  1. . I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
  1. . W $P(T,":",2,99)
  1. W T
  1. PRINT2 I $G(PSOIO("ET"))]"" X PSOIO("ET")
  1. W ! Q
  1. ;
  1. MOREWARN ; SEE ID MORE THAN 5 WARNINGS AND PRINT REMAINDER, IF SO
  1. N LEN,LEN2,I,J,PSOWARN,NEWWARN,PRE
  1. S LEN=$L($G(WARN),",") I LEN<6,'$G(PSOWLBL) Q
  1. S NEWWARN=$G(PSOWLBL)_$P(WARN,",",6,99)
  1. I $E(NEWWARN,$L(NEWWARN))="," S NEWWARN=$E(NEWWARN,1,$L(NEWWARN)-1) I NEWWARN="" Q
  1. S T="Additional Warnings:" D PRINT(T,1)
  1. F I=1:1:$L(NEWWARN,",") S PSOWARN=$P(NEWWARN,",",I) D
  1. .S PRE=PSOWARN_": ",LEN2=$L(PRE)
  1. .S TEXT=$$WTEXT^PSSWRNA(PSOWARN,PSOLAN) I TEXT'="" D
  1. ..I $L(TEXT)<100 S T=PRE_TEXT D PRINT(T) Q
  1. ..S PTEXT="" F J=1:1:$L(TEXT," ") S PTEXT=PTEXT_$P(TEXT," ",J)_" " D
  1. ...I $L(PTEXT)>90 D
  1. ....S T=PRE_PTEXT D PRINT(T) S PRE=$E(" ",1,LEN2),PTEXT=""
  1. ..I PTEXT'="" S T=$G(PRE)_PTEXT D PRINT(T) S PTEXT=""
  1. I PTEXT'="" S T=$G(PRE)_PTEXT D PRINT(T) S PTEXT=""
  1. S PSOY=PSOY+PSOYI
  1. K PSOWLBL
  1. Q