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 ---[H[J[2J[HPSNPPSI1 1623 printed Sep 15, 2024@21:48:48 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
