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

PSORLLL2.m

Go to the documentation of this file.
  1. PSORLLL2 ;AITC/BWF-LASER LABEL ;11/19/02
  1. ;;7.0;OUTPATIENT PHARMACY;**454**;DEC 1997;Build 349
  1. ;
  1. ; BWF - modified copy of PSOLLL2
  1. ;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
  1. L1 I $G(PSOIO("PFDI"))]"" X PSOIO("PFDI")
  1. I '$G(PFF) D
  1. .N PGY
  1. .M PGY=SGY I $D(OSGY) K PGY M PGY=OSGY
  1. .D COUNTSGF^PSOLLLW
  1. S PFM=0,T=$S($D(REPRINT)&($G(PSOBLALL)):"(GROUP REPRINT)",$D(REPRINT):"(REPRINT)",1:"")
  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)
  1. S T="Rx# "_RXN_" "_DATE_" "_$S('PFF:"Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)),1:"(fill document continued)") D PRINT(T)
  1. S SSNPN=""
  1. S T=PNM_" "_$G(SSNPN) D PRINT(T,1) S SSNPN=""
  1. S LENGTH=0,PTEXT="",PFF=0,XFONT=$E(PSOFONT,2,99)
  1. N DP,TEXTP,TEXTL,MORE
  1. S DR=PFF("DR")
  1. F I=1:1 Q:'$D(NPGY(DR,I)) S TEXT=NPGY(DR,I) D PRINT(TEXT)
  1. I I>4,$D(NPGY(DR,5)) S PFF=1,PFF("DR")=DR+1
  1. S OPSOY=PSOY
  1. I $G(PSOIO("PFDQ"))]"" X PSOIO("PFDQ")
  1. I PFF S PSOX=PSOCX,PSOY=OPSOY,T="(continued on next fill document)" S PFM=1 D PRINT(T) Q
  1. K NPGY,^TMP($J,"PSOSIGF")
  1. S XFONT=$E(PSOQFONT,2,99)
  1. S TEXT="Qty: " D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(1)=L(XFONT)
  1. S TEXT=" "_PSDU D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(2)=L(XFONT)
  1. S TEXT=" "_$G(PHYS) D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(3)=L(XFONT)
  1. S PPHYS=$G(PHYS)
  1. 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)
  1. 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
  1. S OPSOX=PSOX,PSOX=Q(1)*300+OPSOX,T=$G(QTY) D PRINT(T) S PSOX=OPSOX
  1. S PSOFONT=PSOQFONT,PSOY=PSOY-PSOYI,T="Qty: " D PRINT(T)
  1. S PSOY=PSOY-PSOYI,PSOX=Q(1)+Q(4)*300+OPSOX,T=" "_$G(PSDU)_" "_$G(PPHYS) D PRINT(T)
  1. I $G(PSOIO("PFDT"))]"" X PSOIO("PFDT")
  1. S T=DRUG D PRINT(T)
  1. L11 ;
  1. N NDCTEXT
  1. S NDCTEXT="NDC/MFR_______________"
  1. I $$ECMEON^BPSUTIL(PSOSITE) S NDCTEXT="NDC "_$$NDCFMT^PSSNDCUT($$GET1^DIQ(50,LOCDRUG,31,"E"))
  1. S OPSOX=PSOX,T=NDCTEXT D PRINT(T)
  1. S T="Lot# ___________________" D STRT^PSOLLU1("SIG2",T,.L)
  1. S PSOY=PSOY-PSOYI,PSOX=L(XFONT+2)*300+OPSOX,T="Lot# _____________________" D PRINT(T)
  1. L12 S PSOX=OPSOX,T="Tech___________________ RPh _____________________" D PRINT(T)
  1. S PSOFONT=PSOTFONT
  1. 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)
  1. I PSCAP D
  1. .D STRT^PSOLLU1("SIG2",T,.L) S LENGTH=L(XFONT+1)
  1. .S OPSOX=PSOX,T="NON-SAFETY",PSOX=LENGTH*300+OPSOX,PSOY=PSOY-PSOYI D PRINT(T,1) S PSOX=OPSOX
  1. S T="Isd: "_ISD_" Exp: "_EXPDT_" Last Fill: "_$G(PSOFLAST) D PRINT(T)
  1. S PSOYI=PSOBYI,PSOY=PSOBY
  1. I $G(PSOIO("SBT"))]"" X PSOIO("SBT")
  1. S X2=$P($G(HINFO),"^",4)_"-"_RX
  1. W X2
  1. I $G(PSOIO("EBT"))]"" X PSOIO("EBT")
  1. I $G(PSOIO("PFDW"))]"" X PSOIO("PFDW")
  1. S XFONT=$E(PSOFONT,2,99)
  1. I $G(WARN)'="" S PTEXT="DRUG WARNING " D STRT^PSOLLU1("SIG2",PTEXT,.L) S LENGTH=L(XFONT) D
  1. . F I=1:1:$L(WARN,",") S TEXT=$P(WARN,",",I)_"," D
  1. .. D STRT^PSOLLU1("SIG2",TEXT,.L)
  1. .. I LENGTH+L(XFONT)<1.8 S PTEXT=PTEXT_TEXT,LENGTH=LENGTH+L(XFONT) Q
  1. .. S LENGTH=0,I=I-1
  1. .. S T=$P(PTEXT,",",1,$L(PTEXT,",")-1) D PRINT(T) S PTEXT=""
  1. .. I PSOY>PSOYM W "*"
  1. . I PTEXT]"" S T=$P(PTEXT,",",1,$L(PTEXT,",")-1) D PRINT(T)
  1. S PTEXT="Pat. Stat "_PATST_" Clinic: "_PSCLN D STRT^PSOLLU1("SIG2",PTEXT,.L) S T=PTEXT D PRINT(T)
  1. Q
  1. ;
  1. PRINT(T,B) ;
  1. S BOLD=$G(B)
  1. I 'BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
  1. I BOLD,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
  1. I $G(PSOIO("ST"))]"" X PSOIO("ST")
  1. W T,!
  1. I $G(PSOIO("ET"))]"" X PSOIO("ET")
  1. I BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) ;TURN OFF BOLDING
  1. Q