source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSONGR.m@ 1259

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

initial load of WorldVistAEHR

File size: 950 bytes
Line 
1PSONGR ;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
Note: See TracBrowser for help on using the repository browser.