PSN113P.m

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 ---PSN113P   456     printed  Nov 22, 2024@17:26:35                                                                                                                                                                                                      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       ;