| 1 | PSONGR ;BHAM ISC/DMA - RETURNS INGREDIENTS LIST FOR ALLERGIES ; 11/17/92 10:21
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**11**;DEC 1997
|
|---|
| 3 | ;This routine is to be used in conjunction with the allergies package
|
|---|
| 4 | ;Input PSODA=internal entry number in file 50
|
|---|
| 5 | ;Returns PSOID=VAgeneric name pointer_"A"_VAproduct name pointer
|
|---|
| 6 | ;Returns ^TMP("PSO",$J,ifn)=primary ingredient
|
|---|
| 7 | ; where ifn=internal entry into 50.416 of primary ingredient
|
|---|
| 8 | ;Returns PSODA
|
|---|
| 9 | ;If pointers do not exist, PSOID and ^TMP("PSO",$J) are killed
|
|---|
| 10 | ;
|
|---|
| 11 | ;Other variables used - J,K and X - are NEWed before use and
|
|---|
| 12 | ;KILLed before exiting
|
|---|
| 13 | ;
|
|---|
| 14 | K PSOID,^TMP("PSO",$J) Q:'$D(PSODA) Q:'$D(^PSDRUG(PSODA)) Q:'$D(^PSDRUG(PSODA,"ND")) S PSOID=^("ND"),PSOID=$P(PSOID,"^")_"A"_$P(PSOID,"^",3) I PSOID'?1.N1"A"1.N K PSOID Q
|
|---|
| 15 | N J,K,X
|
|---|
| 16 | F J=0:0 S J=$O(^PS(50.416,"APD",PSOID,J)) Q:'J I $D(^PS(50.416,J,0)) S X=^(0),K=J S:$P(X,"^",2) K=$P(X,"^",2),X=^PS(50.416,K,0) S ^TMP("PSO",$J,K)=$P(X,"^")
|
|---|
| 17 | K J,K,X
|
|---|
| 18 | Q
|
|---|
