PSNPPSI1.m

PSNPPSI1 ;HP/MJE-PPSN update NDF data for parsing DATANT records ; 05 Mar 2014  1:20 PM

 ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53

 ;

 Q

 ;

 ;This routine parses DATANT records which add .01 fields to files and sub-files

DATANT ;

 K FDA

 S FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="DATANT"

 D UPDATE^DIE("","FDA","CTRLIEN")

 K FDA

 D CTRLFILE^PSNPPSMS(0)

 D CTRLSS^PSNPPSMS(0)

 D CTRLIEN^PSNPPSMS(0)

 S FILE=0,GROOT=$NA(^TMP("PSN PPSN PARSED",$J,"DATANT")),PSNTMPN="DATANT"

 F  S FILE=$O(@GROOT@(FILE)) Q:'FILE  D CTRLFILE^PSNPPSMS(FILE) S ROOT=$$ROOT^DILFD(FILE) I ROOT]"" S GROOT1=$NA(@GROOT@(FILE)) F JJ=1:2 Q:'$D(@GROOT1@(JJ))  D

 .S (DIA,NEW)=""

 .S DIA=@GROOT1@(JJ) I $G(@GROOT1@(JJ+1))]"" S NEW=@GROOT1@(JJ+1)

 .D CTRLSS^PSNPPSMS($TR(GROOT1,"^")_","_JJ)

 .S DA=+DIA K FDA,IENS

 .I FILE=50.68 S ^TMP("PSN PPSN PARSED",$J,"AE_PRODUCTS",DA)="" S:$P(DIA,"^",3)=.01 ^TMP("PSN PPSN PARSED",$J,"NEW PRODUCTS",DA)=""

 .;

 .I PSNPS="N",FILE=50.416 D INGRED^PSNPPSNK

 .I PSNPS="N",FILE=56 D

 ..K STAT

 ..S STAT="A"

 ..I $D(^PS(56,DA)) S STAT="E" S:$$GET1^DIQ(56,DA,7)'="" STAT="I"

 ..S ^TMP("PSN PPSN PARSED",$J,"POST_RUN",5000.56,FILE,DA,.01)=STAT

 .;

 .I PSNPS="N",FILE=50.68 D

 ..D NDFK^PSNPPSNK

 ..K FDA,ORD,ERROR

 ..S ORD=""

 ..I $D(^PSNDF(50.68,DA)) S ORD=$$GET1^DIQ(FILE,DA_",",31,"I","ERROR")

 ..S ^TMP("PSN PPSN PARSED",$J,"POST_RUN",5000.608,FILE,DA,.01)=ORD

 .;

 .I $$GET1^DIQ(FILE,DA,.01)]"" S FDA(FILE,DA_",",.01)=NEW D FILE^DIE("","FDA"),CTRLIEN^PSNPPSMS(DA) Q

 .S DINUM=DA,X=NEW,DIC=ROOT,DIC(0)="L",DIC("DR")="S Y=0" K DD,DO D FILE^DICN

 ;

 D DATAN^PSNPPSI2

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSNPPSI1   1623     printed  Apr 23, 2025@18:38:58                                                                                                                                                                                                    Page 2

PSNPPSI1  ;HP/MJE-PPSN update NDF data for parsing DATANT records ; 05 Mar 2014  1:20 PM

 +1       ;;4.0;NATIONAL DRUG FILE;**513**; 30 Oct 98;Build 53

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ;This routine parses DATANT records which add .01 fields to files and sub-files

DATANT    ;

 +1        KILL FDA

 +2        SET FDA(57.231,CTRLXIEN_","_CTRLIEN_",",6)="DATANT"

 +3        DO UPDATE^DIE("","FDA","CTRLIEN")

 +4        KILL FDA

 +5        DO CTRLFILE^PSNPPSMS(0)

 +6        DO CTRLSS^PSNPPSMS(0)

 +7        DO CTRLIEN^PSNPPSMS(0)

 +8        SET FILE=0

           SET GROOT=$NAME(^TMP("PSN PPSN PARSED",$JOB,"DATANT"))

           SET PSNTMPN="DATANT"

 +9        FOR 

               SET FILE=$ORDER(@GROOT@(FILE))

               if 'FILE

                   QUIT 

               DO CTRLFILE^PSNPPSMS(FILE)

               SET ROOT=$$ROOT^DILFD(FILE)

               IF ROOT]""

                   SET GROOT1=$NAME(@GROOT@(FILE))

                   FOR JJ=1:2

                       if '$DATA(@GROOT1@(JJ))

                           QUIT 

                       Begin DoDot:1

 +10                       SET (DIA,NEW)=""

 +11                       SET DIA=@GROOT1@(JJ)

                           IF $GET(@GROOT1@(JJ+1))]""

                               SET NEW=@GROOT1@(JJ+1)

 +12                       DO CTRLSS^PSNPPSMS($TRANSLATE(GROOT1,"^")_","_JJ)

 +13                       SET DA=+DIA

                           KILL FDA,IENS

 +14                       IF FILE=50.68

                               SET ^TMP("PSN PPSN PARSED",$JOB,"AE_PRODUCTS",DA)=""

                               if $PIECE(DIA,"^",3)=.01

                                   SET ^TMP("PSN PPSN PARSED",$JOB,"NEW PRODUCTS",DA)=""

 +15      ;

 +16                       IF PSNPS="N"

                               IF FILE=50.416

                                   DO INGRED^PSNPPSNK

 +17                       IF PSNPS="N"

                               IF FILE=56

                                   Begin DoDot:2

 +18                                   KILL STAT

 +19                                   SET STAT="A"

 +20                                   IF $DATA(^PS(56,DA))

                                           SET STAT="E"

                                           if $$GET1^DIQ(56,DA,7)'=""

                                               SET STAT="I"

 +21                                   SET ^TMP("PSN PPSN PARSED",$JOB,"POST_RUN",5000.56,FILE,DA,.01)=STAT

                                   End DoDot:2

 +22      ;

 +23                       IF PSNPS="N"

                               IF FILE=50.68

                                   Begin DoDot:2

 +24                                   DO NDFK^PSNPPSNK

 +25                                   KILL FDA,ORD,ERROR

 +26                                   SET ORD=""

 +27                                   IF $DATA(^PSNDF(50.68,DA))

                                           SET ORD=$$GET1^DIQ(FILE,DA_",",31,"I","ERROR")

 +28                                   SET ^TMP("PSN PPSN PARSED",$JOB,"POST_RUN",5000.608,FILE,DA,.01)=ORD

                                   End DoDot:2

 +29      ;

 +30                       IF $$GET1^DIQ(FILE,DA,.01)]""

                               SET FDA(FILE,DA_",",.01)=NEW

                               DO FILE^DIE("","FDA")

                               DO CTRLIEN^PSNPPSMS(DA)

                               QUIT 

 +31                       SET DINUM=DA

                           SET X=NEW

                           SET DIC=ROOT

                           SET DIC(0)="L"

                           SET DIC("DR")="S Y=0"

                           KILL DD,DO

                           DO FILE^DICN

                       End DoDot:1

 +32      ;

 +33       DO DATAN^PSNPPSI2

 +34       QUIT