PSSDENT.m

PSSDENT ;BIR/WRT-Put ID number on "ND" node ; 09/01/98 7:08;

 ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97

 D START K IEN,ID,PSSDA,PSSDA1

 Q

START F IEN=0:0 S IEN=$O(^PSDRUG(IEN)) Q:'IEN  I $D(^PSDRUG(IEN,"ND")),$P(^PSDRUG(IEN,"ND"),"^",2)]"" D IDENT

 Q

IDENT S PSSDA=$P(^PSDRUG(IEN,"ND"),"^"),PSSDA1=$P(^PSDRUG(IEN,"ND"),"^",3),DA=PSSDA,K=PSSDA1,X=$$PROD2^PSNAPIS(DA,K) I X]"" S ID=$P(X,"^",2),$P(^PSDRUG(IEN,"ND"),"^",10)=ID,^PSDRUG("AQ1",ID,IEN)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSSDENT   464     printed  Apr 09, 2024@21:32:28                                                                                                                                                                                                      Page 2

PSSDENT   ;BIR/WRT-Put ID number on "ND" node ; 09/01/98 7:08;

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**15**;9/30/97

 +2        DO START

           KILL IEN,ID,PSSDA,PSSDA1

 +3        QUIT 

START      FOR IEN=0:0

               SET IEN=$ORDER(^PSDRUG(IEN))

               if 'IEN

                   QUIT 

               IF $DATA(^PSDRUG(IEN,"ND"))

                   IF $PIECE(^PSDRUG(IEN,"ND"),"^",2)]""

                       DO IDENT

 +1        QUIT 

IDENT      SET PSSDA=$PIECE(^PSDRUG(IEN,"ND"),"^")

           SET PSSDA1=$PIECE(^PSDRUG(IEN,"ND"),"^",3)

           SET DA=PSSDA

           SET K=PSSDA1

           SET X=$$PROD2^PSNAPIS(DA,K)

           IF X]""

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

               SET $PIECE(^PSDRUG(IEN,"ND"),"^",10)=ID

               SET ^PSDRUG("AQ1",ID,IEN)=""

 +1        QUIT