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 ---[H[J[2J[HPSSDENT 464 printed Nov 22, 2024@17:40:48 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
