PSN447P ;BIR/WRT-Unwind Transport Global and set pieces in VA PRODUCT file ; 01 Jul 2015 11:37 AM
;;4.0;NATIONAL DRUG FILE;**447**; 30 Oct 98;Build 100
;
BUILD ;MATCH PRODUCTS
I '$D(XPDGREF) Q
N DA,I,J,K,LINE,PSN,ROOT,X
S ROOT=$NA(@XPDGREF@("DATA")),J=0
K ^TMP($J)
F S J=$O(@ROOT@(J)) Q:'J S LINE=^(J),K=$L(LINE,"|")-1 F I=1:1:K S X=$P(LINE,"|",I),^TMP($J,$P(X,"^"))=$P(X,"^",2,4)
S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S X=$P($G(^(DA,1)),"^",1,4) S:$D(^TMP($J,DA)) X=X_"^"_^(DA) S ^PSNDF(50.68,DA,1)=X
K ^TMP($J)
K DA,I,J,K,LINE,PSN,ROOT,X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSN447P 574 printed Oct 16, 2024@18:22:11 Page 2
PSN447P ;BIR/WRT-Unwind Transport Global and set pieces in VA PRODUCT file ; 01 Jul 2015 11:37 AM
+1 ;;4.0;NATIONAL DRUG FILE;**447**; 30 Oct 98;Build 100
+2 ;
BUILD ;MATCH PRODUCTS
+1 IF '$DATA(XPDGREF)
QUIT
+2 NEW DA,I,J,K,LINE,PSN,ROOT,X
+3 SET ROOT=$NAME(@XPDGREF@("DATA"))
SET J=0
+4 KILL ^TMP($JOB)
+5 FOR
SET J=$ORDER(@ROOT@(J))
if 'J
QUIT
SET LINE=^(J)
SET K=$LENGTH(LINE,"|")-1
FOR I=1:1:K
SET X=$PIECE(LINE,"|",I)
SET ^TMP($JOB,$PIECE(X,"^"))=$PIECE(X,"^",2,4)
+6 SET DA=0
FOR
SET DA=$ORDER(^PSNDF(50.68,DA))
if 'DA
QUIT
SET X=$PIECE($GET(^(DA,1)),"^",1,4)
if $DATA(^TMP($JOB,DA))
SET X=X_"^"_^(DA)
SET ^PSNDF(50.68,DA,1)=X
+7 KILL ^TMP($JOB)
+8 KILL DA,I,J,K,LINE,PSN,ROOT,X
+9 QUIT
