| [613] | 1 | LRBLPH ;AVAMC/REG - PATIENT DRUG LIST ;2/18/93 09:44
|
|---|
| 2 | ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
|
|---|
| 3 | ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
|
|---|
| 4 | D V^LRU S LRDPAF=1 D ^LRDPA G:LRDFN<1 END I +LRDPF'=2 W $C(7),!,"Must be entry in Patient File (2)" G LRBLPH
|
|---|
| 5 | W ! S ZTRTN="QUE^LRBLPH" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 6 | QUE U IO K ^TMP($J) D L^LRU,S^LRU
|
|---|
| 7 | D H S LR("F")=1
|
|---|
| 8 | F X=0:0 S X=$O(^PS(55,DFN,"P",X)) Q:'X I $D(^(X,0)) S Y=+^(0) I $D(^PSRX(Y,0)) S ^TMP($J,+$P(^(0),"^",6))=0
|
|---|
| 9 | F LRX=0:0 S LRX=$O(^TMP($J,LRX)) Q:'LRX I $D(^PSDRUG(LRX,0)) D:$Y>(IOSL-6) H Q:LR("Q") W !,"OUTPATIENT PHARMACY ITEM: ",$P(^PSDRUG(LRX,0),"^")
|
|---|
| 10 | G:LR("Q") OUT K ^TMP($J) F X=0:0 S X=$O(^PS(55,DFN,"IV",X)) Q:'X F Y=0:0 S Y=$O(^PS(55,DFN,"IV",X,"AD",Y)) Q:'Y S ^TMP($J,+^(Y,0))=""
|
|---|
| 11 | F LRX=0:0 S LRX=$O(^TMP($J,LRX)) Q:'LRX I $D(^PS(52.6,LRX,0)) D:$Y>(IOSL-6) H Q:LR("Q") W !,"IV DRUG: ",$P(^PS(52.6,LRX,0),"^")
|
|---|
| 12 | G:LR("Q") OUT K ^TMP($J) F X=0:0 S X=$O(^PS(55,DFN,5,X)) Q:'X F Y=0:0 S Y=$O(^PS(55,DFN,5,X,1,Y)) Q:'Y S ^TMP($J,+^(Y,0))=""
|
|---|
| 13 | F LRX=0:0 S LRX=$O(^TMP($J,LRX)) Q:'LRX I $D(^PSDRUG(LRX,0)) D:$Y>(IOSL-6) H Q:LR("Q") W !,"INPATIENT PHARMACY ITEM: ",$P(^PSDRUG(LRX,0),"^")
|
|---|
| 14 | OUT D END^LRUTL,END Q
|
|---|
| 15 | ;
|
|---|
| 16 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 17 | D F^LRU W !,"Medication List for ",PNM," ",SSN,!,LR("%") Q
|
|---|
| 18 | ;
|
|---|
| 19 | END D V^LRU Q
|
|---|
