PSONGR.m

PSONGR ;BHAM ISC/DMA - RETURNS INGREDIENTS LIST FOR ALLERGIES ; 11/17/92 10:21

 ;;7.0;OUTPATIENT PHARMACY;**11**;DEC 1997

 ;This routine is to be used in conjunction with the allergies package

 ;Input PSODA=internal entry number in file 50

 ;Returns PSOID=VAgeneric name pointer_"A"_VAproduct name pointer

 ;Returns ^TMP("PSO",$J,ifn)=primary ingredient

 ;        where ifn=internal entry into 50.416 of primary ingredient

 ;Returns PSODA

 ;If pointers do not exist, PSOID and ^TMP("PSO",$J) are killed

 ;

 ;Other variables used - J,K and X - are NEWed before use and

 ;KILLed before exiting

 ;

 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

 N J,K,X

 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,"^")

 K J,K,X

 Q

PSONGR    ;BHAM ISC/DMA - RETURNS INGREDIENTS LIST FOR ALLERGIES ; 11/17/92 10:21

 +1       ;;7.0;OUTPATIENT PHARMACY;**11**;DEC 1997

 +2       ;This routine is to be used in conjunction with the allergies package

 +3       ;Input PSODA=internal entry number in file 50

 +4       ;Returns PSOID=VAgeneric name pointer_"A"_VAproduct name pointer

 +5       ;Returns ^TMP("PSO",$J,ifn)=primary ingredient

 +6       ;        where ifn=internal entry into 50.416 of primary ingredient

 +7       ;Returns PSODA

 +8       ;If pointers do not exist, PSOID and ^TMP("PSO",$J) are killed

 +9       ;

 +10      ;Other variables used - J,K and X - are NEWed before use and

 +11      ;KILLed before exiting

 +12      ;

 +13       KILL PSOID,^TMP("PSO",$JOB)

           IF '$DATA(PSODA)

               QUIT 

           IF '$DATA(^PSDRUG(PSODA))

               QUIT 

           IF '$DATA(^PSDRUG(PSODA,"ND"))

               QUIT 

           SET PSOID=^("ND")

           SET PSOID=$PIECE(PSOID,"^")_"A"_$PIECE(PSOID,"^",3)

           IF PSOID'?1.N1"A"1.N

               KILL PSOID

               QUIT 

 +14       NEW J,K,X

 +15       FOR J=0:0

               SET J=$ORDER(^PS(50.416,"APD",PSOID,J))

               IF 'J

                   QUIT 

               IF $DATA(^PS(50.416,J,0))

                   SET X=^(0)

                   SET K=J

                   IF $PIECE(X,"^",2)

                       SET K=$PIECE(X,"^",2)

                       SET X=^PS(50.416,K,0)

                   SET ^TMP("PSO",$JOB,K)=$PIECE(X,"^")

 +16       KILL J,K,X

 +17       QUIT