PSNPRE1.m

PSNPRE1 ;BIR/WRT-pre-init routine to kill off old reference files sent with the package  ;09/23/98 9:55

 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98

 ; INITIALIZATION ROUTINE

 N ROOT,ROOT1,DA,I,J,X,DIU

KILLIT D BMES^XPDUTL("I Am Deleting Your ""DRUG INGREDIENTS"" File So That It Can Be Updated.") S DIU=50.416,DIU(0)="D" D EN^DIU2 K DIU

 D BMES^XPDUTL("I Am Deleting Your ""VA DRUG CLASS"" File So That It Can Be Updated.") S DIU="^PS(50.605,",DIU(0)="D" D EN^DIU2 K DIU

 D BMES^XPDUTL("I Am Deleting Your ""DRUG UNITS"" File So That It Can Be Updated.") S DIU="^PS(50.607,",DIU(0)="D" D EN^DIU2 K DIU

 D BMES^XPDUTL("I Am Deleting Your ""PACKAGE TYPE"" File So That It Can Be Updated.") S DIU="^PS(50.608,",DIU(0)="D" D EN^DIU2 K DIU

 D BMES^XPDUTL("I Am Deleting Your ""PACKAGE SIZE"" File So That It Can Be Updated.") S DIU="^PS(50.609,",DIU(0)="D" D EN^DIU2 K DIU

 D BMES^XPDUTL("I Am Deleting Your ""DRUG MANUFACTURER"" File So That It Can Be Updated.") S DIU="^PS(55.95,",DIU(0)="D" D EN^DIU2 K DIU

 D BMES^XPDUTL("I Am Deleting Your ""NATIONAL DRUG TRANSLATION"" File So That It Can Be Updated.") S DIU="^PSNTRAN(",DIU(0)="D" D EN^DIU2 K DIU

 D BMES^XPDUTL("Now deleting the data dictionary for the ""NATIONAL DRUG"" File.")

 F NDF=50.68,50.67,50.66,50.65,50.64,50.63,50.62,50.61 S DIU=NDF,DIU(0)="S" D EN^DIU2

 S DIU=50.6,DIU(0)="" D EN^DIU2

 ;

 S ROOT=$NA(@XPDGREF@("LOCAL")),ROOT1=$NA(@XPDGREF@("OLD")),DA=0,I=1,J=1

 F  S DA=$O(^PS(56,DA)) Q:'DA  S X=^(DA,0) S:'$P(X,"^",5) @ROOT@(I)=X,I=I+1 S:$P(X,"^",5) @ROOT1@(J)=X,J=J+1

 S DIU="^PS(56,",DIU(0)="D" D EN^DIU2

 ;

 Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSNPRE1   1598     printed  Apr 09, 2024@21:27:03                                                                                                                                                                                                     Page 2

PSNPRE1   ;BIR/WRT-pre-init routine to kill off old reference files sent with the package  ;09/23/98 9:55

 +1       ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98

 +2       ; INITIALIZATION ROUTINE

 +3        NEW ROOT,ROOT1,DA,I,J,X,DIU

KILLIT     DO BMES^XPDUTL("I Am Deleting Your ""DRUG INGREDIENTS"" File So That It Can Be Updated.")

           SET DIU=50.416

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

 +1        DO BMES^XPDUTL("I Am Deleting Your ""VA DRUG CLASS"" File So That It Can Be Updated.")

           SET DIU="^PS(50.605,"

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

 +2        DO BMES^XPDUTL("I Am Deleting Your ""DRUG UNITS"" File So That It Can Be Updated.")

           SET DIU="^PS(50.607,"

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

 +3        DO BMES^XPDUTL("I Am Deleting Your ""PACKAGE TYPE"" File So That It Can Be Updated.")

           SET DIU="^PS(50.608,"

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

 +4        DO BMES^XPDUTL("I Am Deleting Your ""PACKAGE SIZE"" File So That It Can Be Updated.")

           SET DIU="^PS(50.609,"

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

 +5        DO BMES^XPDUTL("I Am Deleting Your ""DRUG MANUFACTURER"" File So That It Can Be Updated.")

           SET DIU="^PS(55.95,"

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

 +6        DO BMES^XPDUTL("I Am Deleting Your ""NATIONAL DRUG TRANSLATION"" File So That It Can Be Updated.")

           SET DIU="^PSNTRAN("

           SET DIU(0)="D"

           DO EN^DIU2

           KILL DIU

 +7        DO BMES^XPDUTL("Now deleting the data dictionary for the ""NATIONAL DRUG"" File.")

 +8        FOR NDF=50.68,50.67,50.66,50.65,50.64,50.63,50.62,50.61

               SET DIU=NDF

               SET DIU(0)="S"

               DO EN^DIU2

 +9        SET DIU=50.6

           SET DIU(0)=""

           DO EN^DIU2

 +10      ;

 +11       SET ROOT=$NAME(@XPDGREF@("LOCAL"))

           SET ROOT1=$NAME(@XPDGREF@("OLD"))

           SET DA=0

           SET I=1

           SET J=1

 +12       FOR 

               SET DA=$ORDER(^PS(56,DA))

               if 'DA

                   QUIT 

               SET X=^(DA,0)

               if '$PIECE(X,"^",5)

                   SET @ROOT@(I)=X

                   SET I=I+1

               if $PIECE(X,"^",5)

                   SET @ROOT1@(J)=X

                   SET J=J+1

 +13       SET DIU="^PS(56,"

           SET DIU(0)="D"

           DO EN^DIU2

 +14      ;

 +15       QUIT 

 +16       QUIT