| 1 | PSNNGR ;BIR/WRT-creates UTILITY GLOBAL OF INGREDIENTS FOR EACH VAPN FROM ^PSNDF(50.6, ;09/21/98 7:54
|
|---|
| 2 | ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
|
|---|
| 3 | ; This routine is to be used in conjunction of the allergies package.
|
|---|
| 4 | ; It expects an input of PSNDA=internal number in File 50.6
|
|---|
| 5 | ; Returns ^TMP("PSN",$J,IFN)=Primary Ingredient
|
|---|
| 6 | ; IFN=Internal # from 50.416 of primary ingredient
|
|---|
| 7 | ; If PSNDA doesn't exist, PSNID & ^TMP("PSN",$J) are killed
|
|---|
| 8 | ; Variables X,J,K,PSNPN are used and are killed before exiting
|
|---|
| 9 | ;
|
|---|
| 10 | START K ^TMP("PSN",$J),PSNID D BEGIN
|
|---|
| 11 | K PSNPN,PSNDA,J,K,X,PSNID
|
|---|
| 12 | Q
|
|---|
| 13 | BEGIN Q:'$D(PSNDA) Q:'$D(^PSNDF(50.6,PSNDA)) D VAPN
|
|---|
| 14 | Q
|
|---|
| 15 | VAPN S DA=PSNDA,X=$$VAP^PSNAPIS(DA,.LIST) I X]"" D GETLIST
|
|---|
| 16 | Q
|
|---|
| 17 | GETLIST F HH=0:0 S HH=$O(LIST(HH)) Q:'HH S PSNPN=HH D BLD
|
|---|
| 18 | Q
|
|---|
| 19 | BLD S PSNID=PSNDA_"A"_PSNPN D INGR
|
|---|
| 20 | Q
|
|---|
| 21 | INGR F J=0:0 S J=$O(^PS(50.416,"APD",PSNID,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("PSN",$J,K)=$P(X,"^",1)
|
|---|
| 22 | K J,K,X
|
|---|
| 23 | Q
|
|---|
| 24 | DISPDRG K ^TMP("PSNDD",$J),PSNDD D STRT
|
|---|
| 25 | K PSNDA,PSNVPN,PSNDD,J,K,X
|
|---|
| 26 | Q
|
|---|
| 27 | STRT Q:'PSNDA Q:'PSNVPN Q:'$D(^PSNDF(50.6,PSNDA)) Q:'$D(^PSNDF(50.68,PSNVPN)) S PSNDD=PSNDA_"A"_PSNVPN D FNDING
|
|---|
| 28 | Q
|
|---|
| 29 | FNDING F J=0:0 S J=$O(^PS(50.416,"APD",PSNDD,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("PSNDD",$J,K)=$P(X,"^",1)
|
|---|
| 30 | K J,K,X
|
|---|
| 31 | Q
|
|---|
