PSN4P365.m

PSN4P365 ;ALB/HW-Post Install Routine removes incorrect data ; 02/18/14 13:09

 ;;4.0;NATIONAL DRUG FILE;**365**;30 Oct 98;Build 9

 Q  ;Must be called at entry point

EN ;Find and delete incorrect entry and related cross-references

 N PSNDIEN,PSNIIEN,PSNFILE,PSNFDA,PSNRN,PSNCTR,PSNERR,Y

 S PSNDIEN=""

 F  S PSNDIEN=$O(^PS(50.416,"B","VARENICLINE",PSNDIEN)) Q:PSNDIEN=""  D

 .I $D(^PS(50.416,PSNDIEN,1,0))=10!($D(^PS(50.416,PSNDIEN,1,0))=0) D FZNODE

 .S PSNIIEN=""

 . F  S PSNIIEN=$O(^PS(50.416,PSNDIEN,1,"B","184A20598",PSNIIEN)) Q:PSNIIEN=""  D

 ..S PSNFILE=50.4161

 ..I $$GET1^DIQ(PSNFILE,PSNIIEN_","_PSNDIEN_",",.01)]"" D

 ...S PSNFDA(PSNFILE,PSNIIEN_","_PSNDIEN_",",.01)="@"

 ...D FILE^DIE("","PSNFDA","PSNERR")

 ...K PSNFDA Q

 ..Q

 I $D(PSNERR) W !,"CHECK ERROR LOG FOR ERRORS"

 Q

FZNODE ;If the zero multiple node is missing add it first

 S PSNRN="",PSNCTR=""

 F  S PSNRN=$O(^PS(50.416,PSNDIEN,1,PSNRN)) Q:PSNRN'>0  D

 .S PSNCTR=PSNCTR+1

 S ^PS(50.416,PSNDIEN,1,0)="^50.4161A^"_PSNCTR_"^"_PSNCTR_""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSN4P365   1031     printed  Apr 09, 2024@21:20:24                                                                                                                                                                                                    Page 2

PSN4P365  ;ALB/HW-Post Install Routine removes incorrect data ; 02/18/14 13:09

 +1       ;;4.0;NATIONAL DRUG FILE;**365**;30 Oct 98;Build 9

 +2       ;Must be called at entry point

           QUIT 

EN        ;Find and delete incorrect entry and related cross-references

 +1        NEW PSNDIEN,PSNIIEN,PSNFILE,PSNFDA,PSNRN,PSNCTR,PSNERR,Y

 +2        SET PSNDIEN=""

 +3        FOR 

               SET PSNDIEN=$ORDER(^PS(50.416,"B","VARENICLINE",PSNDIEN))

               if PSNDIEN=""

                   QUIT 

               Begin DoDot:1

 +4                IF $DATA(^PS(50.416,PSNDIEN,1,0))=10!($DATA(^PS(50.416,PSNDIEN,1,0))=0)

                       DO FZNODE

 +5                SET PSNIIEN=""

 +6                FOR 

                       SET PSNIIEN=$ORDER(^PS(50.416,PSNDIEN,1,"B","184A20598",PSNIIEN))

                       if PSNIIEN=""

                           QUIT 

                       Begin DoDot:2

 +7                        SET PSNFILE=50.4161

 +8                        IF $$GET1^DIQ(PSNFILE,PSNIIEN_","_PSNDIEN_",",.01)]""

                               Begin DoDot:3

 +9                                SET PSNFDA(PSNFILE,PSNIIEN_","_PSNDIEN_",",.01)="@"

 +10                               DO FILE^DIE("","PSNFDA","PSNERR")

 +11                               KILL PSNFDA

                                   QUIT 

                               End DoDot:3

 +12                       QUIT 

                       End DoDot:2

               End DoDot:1

 +13       IF $DATA(PSNERR)

               WRITE !,"CHECK ERROR LOG FOR ERRORS"

 +14       QUIT 

FZNODE    ;If the zero multiple node is missing add it first

 +1        SET PSNRN=""

           SET PSNCTR=""

 +2        FOR 

               SET PSNRN=$ORDER(^PS(50.416,PSNDIEN,1,PSNRN))

               if PSNRN'>0

                   QUIT 

               Begin DoDot:1

 +3                SET PSNCTR=PSNCTR+1

               End DoDot:1

 +4        SET ^PS(50.416,PSNDIEN,1,0)="^50.4161A^"_PSNCTR_"^"_PSNCTR_""

 +5        QUIT