PSN113P ;BIR/DMA-DELETE INATIVATION DATES AS NEEDED ; 02 Mar 2006 2:27 PM
;;4.0; NATIONAL DRUG FILE;**113**; 30 Oct 98
;
N DA,J,LIST
S LIST=$P($T(LIST+1),";",3,300)
F J=1:1 S DA=$P(LIST,"^",J) Q:DA="" S $P(^PSNDF(50.68,DA,7),"^",3)="" D
.N DA2 S DA2=0 F S DA2=$O(^PSNDF(50.68,"ANDC",DA,DA2)) Q:'DA2 S $P(^PSNDF(50.67,DA,0),"^",7)=""
K DA,DA2,J,LIST Q
;
LIST ;OF PRODUCT IENS
;;2633^2634^2635^15524^16452^16649^16819^16909^16910
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN113P 456 printed Dec 13, 2024@02:16:31 Page 2
PSN113P ;BIR/DMA-DELETE INATIVATION DATES AS NEEDED ; 02 Mar 2006 2:27 PM
+1 ;;4.0; NATIONAL DRUG FILE;**113**; 30 Oct 98
+2 ;
+3 NEW DA,J,LIST
+4 SET LIST=$PIECE($TEXT(LIST+1),";",3,300)
+5 FOR J=1:1
SET DA=$PIECE(LIST,"^",J)
if DA=""
QUIT
SET $PIECE(^PSNDF(50.68,DA,7),"^",3)=""
Begin DoDot:1
+6 NEW DA2
SET DA2=0
FOR
SET DA2=$ORDER(^PSNDF(50.68,"ANDC",DA,DA2))
if 'DA2
QUIT
SET $PIECE(^PSNDF(50.67,DA,0),"^",7)=""
End DoDot:1
+7 KILL DA,DA2,J,LIST
QUIT
+8 ;
LIST ;OF PRODUCT IENS
+1 ;;2633^2634^2635^15524^16452^16649^16819^16909^16910
+2 ;
