Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSN447P

PSN447P.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. BUILD ;MATCH PRODUCTS
  1. I '$D(XPDGREF) Q
  1. N DA,I,J,K,LINE,PSN,ROOT,X
  1. S ROOT=$NA(@XPDGREF@("DATA")),J=0
  1. K ^TMP($J)
  1. 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)
  1. 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
  1. K ^TMP($J)
  1. K DA,I,J,K,LINE,PSN,ROOT,X
  1. Q