| 1 | PSOLBLD1 ;BHAM ISC/RTR-Prints allergy warning label ; 2/20/95 | 
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**117**;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 | 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 | 
|---|
| 8 | S Y=DATE X ^DD("DD") S DATE1=Y D NOW^%DTC S Y=% X ^DD("DD") S NOW=Y | 
|---|
| 9 | S:'$P($G(^PS(59,+$G(PSOSITE),1)),"^",28) TB1=38,TB2=50,TB3=83 S:$P($G(^PS(59,+$G(PSOSITE),1)),"^",28) TB1=54,TB2=66,TB3=102 | 
|---|
| 10 | PRINT ; | 
|---|
| 11 | W !,"***********************************",?TB3 W:$G(RXRP(RX)) "(REPRINT)" I '$G(RXRP(RX)) W $P(PS2,"^",2)," ","("_$P(RXY,"^",16)_"/"_$S(+$G(VRPH):VRPH,1:" ")_")"_" ",$P(NOW,":",1,2) | 
|---|
| 12 | W !,"* THIS MEDICATION HAS INDICATED A *",?TB1,"PRESCRIPTION # "_RXN_" HAS",?TB3,RXN,"  ",DATE1,"  Fill 1 of ",1+$P(RXY,"^",9) | 
|---|
| 13 | W !,"*         DRUG ALLERGY            *",?TB1,"INDICATED A DRUG ALLERGY:",?TB3,PNM,"  ",SSNP | 
|---|
| 14 | W !,"***********************************" | 
|---|
| 15 | S PSOING(1)="",PSOING(2)=$G(DRUG) I $O(^PSRX(RX,"DAI",0)) D | 
|---|
| 16 | .S PSOING(3)="  "_"INGREDIENTS:" S ICOUNT=4 F BBBB=0:0 S BBBB=$O(^PSRX(RX,"DAI",BBBB)) Q:'BBBB  S PSOING(ICOUNT)="  "_$G(^(BBBB,0)) S ICOUNT=ICOUNT+1 | 
|---|
| 17 | S (PSAQUIT,PSBQUIT,PSCQUIT)=0 F ICOUNT=1:1 Q:$G(PSCQUIT)  D | 
|---|
| 18 | .W ?TB1,$G(PSOING(ICOUNT)) S:'$O(PSOING(ICOUNT)) PSAQUIT=1 | 
|---|
| 19 | .W ?TB3,$S($G(OSGY(ICOUNT))]"":OSGY(ICOUNT),1:$G(SGY(ICOUNT))),! S:'$O(SGY(ICOUNT)) PSBQUIT=1 | 
|---|
| 20 | .I PSAQUIT,PSBQUIT S PSCQUIT=1 | 
|---|
| 21 | W !!,?TB1,"THIS PRESCRIPTION WAS ENTERED BY",?TB3,"Qty: ",$G(QTY),"  ",$G(PHYS) | 
|---|
| 22 | W !,?TB1,$G(TECH),?TB3,"Tech__________RPh__________" | 
|---|
| 23 | W !,?TB1,"THIS PRESCRIPTION MAY REQUIRE",?TB3,$G(DRUG) | 
|---|
| 24 | W !,?TB1,"REVIEWING BY A PHARMACIST",?TB3,"Routing: "_$S("W"[$E(MW):MW,1:MW_" MAIL") | 
|---|
| 25 | W !,?TB3,"Days Supply: ",$G(DAYS)," Cap: ",$S(PSCAP:"**NON-SFTY**",1:"SAFETY") | 
|---|
| 26 | W !,?TB3,"Isd: ",ISD," Exp: ",EXPDT | 
|---|
| 27 | W !,?TB3,"Last Fill: ",$G(PSOLASTF) | 
|---|
| 28 | W !,?TB3,"Pat. Stat ",PATST," Clinic: ",PSCLN | 
|---|
| 29 | W @IOF | 
|---|
| 30 | I COPIES>0 G START | 
|---|
| 31 | S COPIES=HARDCOPY K HARDCOPY | 
|---|
| 32 | ; | 
|---|
| 33 | STORE ;ALLERGY LABEL PRINT NODE - SHOULD ALWAYS BE ON THE ORIGINAL | 
|---|
| 34 | D NOW^%DTC S NOW=% S PSAA=0 F AAA=0:0 S AAA=$O(^PSRX(RX,"L",AAA)) Q:'AAA  S PSAA=AAA | 
|---|
| 35 | 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" | 
|---|
| 36 | END ; | 
|---|
| 37 | Q | 
|---|