source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOLLL2.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1PSOLLL2 ;BIR/JLC-LASER LABEL ;11/19/02
2 ;;7.0;OUTPATIENT PHARMACY;**120,138,141,161,200**;DEC 1997;Build 7
3 ;
4 ;Reference to $$ECMEON^BPSUTIL supported by DBIA 4410
5L1 I $G(PSOIO("PFDI"))]"" X PSOIO("PFDI")
6 I '$G(PFF) D
7 .N PGY
8 .M PGY=SGY I $D(OSGY) K PGY M PGY=OSGY
9 .D COUNTSGF^PSOLLLW
10 S PFM=0,T=$S($D(REPRINT)&($G(PSOBLALL)):"(GROUP REPRINT)",$D(REPRINT):"(REPRINT)",1:"")
11 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)
12 S T="Rx# "_RXN_" "_DATE_" "_$S('PFF:"Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)),1:"(fill document continued)") D PRINT(T)
13 S T=PNM_" "_$G(SSNPN) D PRINT(T,1)
14 S LENGTH=0,PTEXT="",PFF=0,XFONT=$E(PSOFONT,2,99)
15 N DP,TEXTP,TEXTL,MORE
16 S DR=PFF("DR")
17 F I=1:1 Q:'$D(NPGY(DR,I)) S TEXT=NPGY(DR,I) D PRINT(TEXT)
18 I I>4,$D(NPGY(DR,5)) S PFF=1,PFF("DR")=DR+1
19 S OPSOY=PSOY
20 I $G(PSOIO("PFDQ"))]"" X PSOIO("PFDQ")
21 I PFF S PSOX=PSOCX,PSOY=OPSOY,T="(continued on next fill document)" S PFM=1 D PRINT(T) Q
22 K NPGY,^TMP($J,"PSOSIGF")
23 S XFONT=$E(PSOQFONT,2,99)
24 S TEXT="Qty: " D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(1)=L(XFONT)
25 S TEXT=" "_PSDU D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(2)=L(XFONT)
26 S TEXT=" "_$G(PHYS) D STRT^PSOLLU1("SIG2",TEXT,.L) S Q(3)=L(XFONT)
27 S PPHYS=$G(PHYS)
28 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)
29 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
30 S OPSOX=PSOX,PSOX=Q(1)*300+OPSOX,T=$G(QTY) D PRINT(T) S PSOX=OPSOX
31 S PSOFONT=PSOQFONT,PSOY=PSOY-PSOYI,T="Qty: " D PRINT(T)
32 S PSOY=PSOY-PSOYI,PSOX=Q(1)+Q(4)*300+OPSOX,T=" "_$G(PSDU)_" "_$G(PPHYS) D PRINT(T)
33 I $G(PSOIO("PFDT"))]"" X PSOIO("PFDT")
34 S T=DRUG D PRINT(T)
35L11 ;
36 N NDCTEXT
37 S NDCTEXT="NDC/MFR_______________"
38 I $$ECMEON^BPSUTIL($$RXSITE^PSOBPSUT(RX,RXF)) S NDCTEXT="NDC "_$$GETNDC^PSONDCUT(RX,RXF)
39 S OPSOX=PSOX,T=NDCTEXT D PRINT(T)
40 S T="Lot# ___________________" D STRT^PSOLLU1("SIG2",T,.L)
41 S PSOY=PSOY-PSOYI,PSOX=L(XFONT+2)*300+OPSOX,T="Lot# _____________________" D PRINT(T)
42L12 S PSOX=OPSOX,T="Tech___________________ RPh _____________________" D PRINT(T)
43 S PSOFONT=PSOTFONT
44 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)
45 I PSCAP D
46 .D STRT^PSOLLU1("SIG2",T,.L) S LENGTH=L(XFONT+1)
47 .S OPSOX=PSOX,T="NON-SAFETY",PSOX=LENGTH*300+OPSOX,PSOY=PSOY-PSOYI D PRINT(T,1) S PSOX=OPSOX
48 S T="Isd: "_ISD_" Exp: "_EXPDT_" Last Fill: "_$G(PSOFLAST) D PRINT(T)
49 S PSOYI=PSOBYI,PSOY=PSOBY
50 I $G(PSOIO("SBT"))]"" X PSOIO("SBT")
51 S X2=PSOINST_"-"_RX
52 W X2
53 I $G(PSOIO("EBT"))]"" X PSOIO("EBT")
54 I $G(PSOIO("PFDW"))]"" X PSOIO("PFDW")
55 S XFONT=$E(PSOFONT,2,99)
56 I $G(WARN)'="" S PTEXT="DRUG WARNING " D STRT^PSOLLU1("SIG2",PTEXT,.L) S LENGTH=L(XFONT) D
57 . F I=1:1:$L(WARN,",") S TEXT=$P(WARN,",",I)_"," D
58 .. D STRT^PSOLLU1("SIG2",TEXT,.L)
59 .. I LENGTH+L(XFONT)<1.8 S PTEXT=PTEXT_TEXT,LENGTH=LENGTH+L(XFONT) Q
60 .. S LENGTH=0,I=I-1
61 .. S T=$P(PTEXT,",",1,$L(PTEXT,",")-1) D PRINT(T) S PTEXT=""
62 .. I PSOY>PSOYM W "*"
63 . I PTEXT]"" S T=$P(PTEXT,",",1,$L(PTEXT,",")-1) D PRINT(T)
64 S PTEXT="Pat. Stat "_PATST_" Clinic: "_PSCLN D STRT^PSOLLU1("SIG2",PTEXT,.L) S T=PTEXT D PRINT(T)
65 Q
66 ;
67PRINT(T,B) ;
68 S BOLD=$G(B)
69 I 'BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
70 I BOLD,$G(PSOIO(PSOFONT_"B"))]"" X PSOIO(PSOFONT_"B")
71 I $G(PSOIO("ST"))]"" X PSOIO("ST")
72 W T,!
73 I $G(PSOIO("ET"))]"" X PSOIO("ET")
74 I BOLD,$G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT) ;TURN OFF BOLDING
75 Q
Note: See TracBrowser for help on using the repository browser.