| 1 | PSOLLL9 ;BIR/JLC -Prints allergy warning label ;01/24/03
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**120,161**;DEC 1997
|
|---|
| 3 | ;
|
|---|
| 4 | N AAA,DATE1,EXPDT,ISD,HARDCOPY,PSAA,PSAQUIT,PSBQUIT,PSCQUIT,BBBB,ICOUNT,PSOING,NOW,TB1,TB2,TB2,SSG
|
|---|
| 5 | S HARDCOPY=COPIES
|
|---|
| 6 | START ;
|
|---|
| 7 | I $G(PSOIO("AWI"))]"" X PSOIO("AWI")
|
|---|
| 8 | I $G(PSOIO(PSOFONT))]"" X PSOIO(PSOFONT)
|
|---|
| 9 | S COPIES=COPIES-1,Y=$P(^PSRX(RX,2),"^",6) X ^DD("DD") S EXPDT=Y,Y=$P(^PSRX(RX,0),"^",13) X ^DD("DD") S ISD=Y
|
|---|
| 10 | S Y=DATE X ^DD("DD") S DATE1=Y D NOW^%DTC S Y=% X ^DD("DD") S NOW=Y
|
|---|
| 11 | I '$G(RXRP(RX)) S T=$P(PS2,"^",2)_" ("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_") "_$P(NOW,":",1,2) D PRINT(T)
|
|---|
| 12 | S T="Rx# "_RXN_" has indicated a DRUG ALLERGY:" D PRINT(T)
|
|---|
| 13 | I $O(^PSRX(RX,"DAI",0)) D
|
|---|
| 14 | . S PSOY=PSOY+PSOYI,T=" Ingredients:" D PRINT(T)
|
|---|
| 15 | . F BBBB=0:0 S BBBB=$O(^PSRX(RX,"DAI",BBBB)) Q:'BBBB S T=" "_$G(^(BBBB,0)) D PRINT(T)
|
|---|
| 16 | S PSOY=PSOY+PSOYI
|
|---|
| 17 | S PSOY=PSOY+PSOYI,T="This prescription was entered by "_$G(TECH) D PRINT(T)
|
|---|
| 18 | S PSOY=PSOY+PSOYI,T="This prescription may require reviewing by a pharmacist" D PRINT(T)
|
|---|
| 19 | S PSOY=PSOY+PSOYI I $G(RXRP(RX)) S T="(REPRINT)" D PRINT(T)
|
|---|
| 20 | F ICOUNT=1:1 S T=$G(SGY(ICOUNT)) Q:T="" D PRINT(T)
|
|---|
| 21 | S T=RXN_" "_DATE1_" Fill "_(RXF+1)_" of "_(1+$P(RXY,"^",9)) D PRINT(T)
|
|---|
| 22 | S T=PNM_" "_SSNP D PRINT(T)
|
|---|
| 23 | S T="Qty: "_$G(QTY)_" "_$G(PHYS) D PRINT(T)
|
|---|
| 24 | S T=$G(DRUG) D PRINT(T)
|
|---|
| 25 | S T="Tech__________RPh__________" D PRINT(T)
|
|---|
| 26 | S T="Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL") D PRINT(T)
|
|---|
| 27 | S T="Days Supply: "_$G(DAYS)_" Cap: "_$S(PSCAP:"**NON-SFTY**",1:"SAFETY") D PRINT(T)
|
|---|
| 28 | S T="Isd: "_ISD_" Exp: "_EXPDT D PRINT(T)
|
|---|
| 29 | S T="Last Fill: "_$G(PSOFLAST) D PRINT(T)
|
|---|
| 30 | S T="Pat. Stat "_PATST_" Clinic: "_PSCLN D PRINT(T)
|
|---|
| 31 | W @IOF
|
|---|
| 32 | I COPIES>0 G START
|
|---|
| 33 | S COPIES=HARDCOPY K HARDCOPY
|
|---|
| 34 | ;
|
|---|
| 35 | STORE ;ALLERGY LABEL PRINT NODE - SHOULD ALWAYS BE ON THE ORIGINAL
|
|---|
| 36 | D NOW^%DTC S NOW=% S PSAA=0 F AAA=0:0 S AAA=$O(^PSRX(RX,"L",AAA)) Q:'AAA S PSAA=AAA
|
|---|
| 37 | S PSAA=PSAA+1,^PSRX(RX,"L",0)="^52.032DA^"_PSAA_"^"_PSAA,^PSRX(RX,"L",PSAA,0)=NOW_"^"_0_"^Allergy warning label"_$S($G(RXRP(RX)):" (Reprint)",1:"")_"^"_PDUZ_"^2"
|
|---|
| 38 | END ;
|
|---|
| 39 | Q
|
|---|
| 40 | PRINT(T) ;
|
|---|
| 41 | I $G(PSOIO("ST"))]"" X PSOIO("ST")
|
|---|
| 42 | W T,!
|
|---|
| 43 | I $G(PSOIO("ET"))]"" X PSOIO("ET")
|
|---|
| 44 | Q
|
|---|
