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

A4A7164.m

Go to the documentation of this file. 
  1. A4A7164 ; GLRISC/REL - Move Data fields into 200 ;1/17/91  13:42
  1.  ;;1.01;;**2**;
  1.  W !!,"Moving data which has not already been moved"
  1.  W !,"from Files 3,6 & 16 into File 200 ..."
  1.  F K=0:0 S K=$N(^DIC(3,K)) Q:K'>0  D MOV
  1.  Q
  1. MOV K X S P3=K,Y=$S($D(^DIC(3,P3,0))#2:^(0),1:"") Q:Y=""  S P16=$P(Y,"^",16)
  1.  S NAM=$P(Y,"^",1)
  1.  S X(0)=$S($D(^VA(200,P3,0))#2:^(0),1:"") Q:X(0)=""
  1.  S X(1)=$S($D(^VA(200,P3,1))#2:^(1),1:"") K:X(1)="" X(1)
  1.  F L=2,4,9,11 S Z=$P(Y,"^",L) S:Z'="" $P(X(0),"^",L)=Z
  1.  S Y=$S($D(^DIC(3,P3,5))#2:$P(^(5),"^",1,2),1:"") I "^"'[Y S X(5)=Y
  1.  S Y=$S($D(^DIC(3,P3,.1))#2:$P(^(.1),"^",4),1:"") S:Y'="" $P(X(.1),"^",4)=Y
  1.  G:'P16 M1
  1.  S Y=$S($D(^DIC(16,P16,0))#2:$P(^(0),"^",1),1:"") I Y'=NAM D NAM
  1.  S Y=$S($D(^DIC(16,P16,.11))#2:$P(^(.11),"^",1,6),1:"") I "^^^^^"'[Y S X(.11)=Y
  1.  S Y=$S($D(^DIC(16,P16,.121))#2:$P(^(.121),"^",1,8),1:"") I "^^^^^^^"'[Y S X(.121)=Y
  1.  S Y=$S($D(^DIC(16,P16,.13))#2:$P(^(.13),"^",1,4),1:"") I "^^^"'[Y S X(.13)=Y
  1.  S Y=$S($D(^DIC(16,P16,20))#2:$P(^(20),"^",1,4),1:"") I "^^"'[$P(Y,"^",2,4) S X(20)="^"_$P(Y,"^",2,4)
  1.  S Y=$P(Y,"^",1) S:Y'="" $P(X(0),"^",2)=Y
  1.  S Y=$S($D(^DIC(16,P16,0))#2:$P(^(0),"^",2,3),1:"")
  1.  I "^"'[Y S:Y'["^" Y=Y_"^" S $P(X(1),"^",2,3)=Y
  1.  S P6=$S($D(^DIC(16,P16,"A6"))#2:^("A6"),1:"") G:P6<1 M1 I '$D(^DIC(6,P6,0))#2 K ^DIC(16,P16,"A6") G M1
  1.  S Y=$S($D(^DIC(6,P6,.11))#2:$P(^(.11),"^",1,6),1:"") I "^^^^^"'[Y S:$D(X(.11)) $P(^DIC(16,P16,.11),"^",1,6)=$P(Y_"^^^^^","^",1,6) S X(.11)=Y
  1.  S Y=$S($D(^DIC(6,P6,0))#2:$P(^(0),"^",2),1:"") S:Y'="" $P(X(0),"^",2)=Y
  1.  S Y=$S($D(^DIC(6,P6,"I"))#2:$P(^("I"),"^",1),1:"") S:Y'="" X("I")=Y
  1. M1 S Z="" F L=0:0 S Z=$O(X(Z)) Q:Z=""  S ^VA(200,P3,Z)=X(Z)
  1.  Q
  1. NAM S $P(^DIC(16,P16,0),"^",1)=NAM K ^DIC(16,"B",$E(Y,1,30),P16)
  1.  S ^DIC(16,"B",$E(NAM,1,30),P16)="" I $E(NAM,1)=$E(Y,1) G N1
  1.  S SSN=$S($D(^DIC(16,P16,0))#2:$P(^(0),"^",9),1:"") G:SSN="" N1
  1.  K ^DIC(16,"BS5",$E(Y,1)_$E(SSN,6,9),P16) S ^DIC(16,"BS5",$E(NAM,1)_$E(SSN,6,9),P16)=""
  1. N1 S $P(^DIC(16,P16,20),"^",2)=$E(NAM,",",2)_" "_$P(NAM,",",1) Q