A4A7P601 ; ; 14-JUL-1993
;;1.01;A4A7;**6**;JUL 14, 1993
F I=1:2 S X=$T(Q+I) Q:X="" S Y=$E($T(Q+I+1),4,999),X=$E(X,4,999) S:$A(Y)=126 I=I+1,Y=$E(Y,2,999)_$E($T(Q+I+1),5,99) S:$A(Y)=61 Y=$E(Y,2,999) S @X=Y
Q Q
;;^DD(6,.01,1,2,0)
;;=6^AC^MUMPS
;;^DD(6,.01,1,2,1)
;;=S ^DIC(16,+X,"A6")=DA
;;^DD(6,.01,1,2,2)
;;=K ^DIC(16,+X,"A6")
;;^DD(6,.01,1,3,0)
;;=6^AK^MUMPS
;;^DD(6,.01,1,3,1)
;;=G F6S^XUA4A7
;;^DD(6,.01,1,3,2)
;;=G F6K^XUA4A7
;;^DD(6,.01,1,3,3)
;;=Used to link providers to new person keys.
;;^DD(6,.01,1,3,"%D",0)
;;=^^2^2^2910916^
;;^DD(6,.01,1,3,"%D",1,0)
;;=This X-ref will see that the provider also has the 'VA Provider'
;;^DD(6,.01,1,3,"%D",2,0)
;;=key in the New Person file.
;;^DD(6,.01,1,3,"DT")
;;=2910916
;;^DD(6,.111,1,0)
;;=^.1
;;^DD(6,.111,1,1,0)
;;=6^ACX1^MUMPS
;;^DD(6,.111,1,1,1)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",1)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",1)=X
;;^DD(6,.111,1,1,2)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",1)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",1)=""
;;^DD(6,.111,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,.112,1,0)
;;=^.1
;;^DD(6,.112,1,1,0)
;;=6^ACX2^MUMPS
;;^DD(6,.112,1,1,1)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",2)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",2)=X
;;^DD(6,.112,1,1,2)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",2)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",2)=""
;;^DD(6,.112,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,.113,1,0)
;;=^.1
;;^DD(6,.113,1,1,0)
;;=6^ACX3^MUMPS
;;^DD(6,.113,1,1,1)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",3)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",3)=X
;;^DD(6,.113,1,1,2)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",3)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",3)=""
;;^DD(6,.113,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,.114,1,0)
;;=^.1
;;^DD(6,.114,1,1,0)
;;=6^ACX4^MUMPS
;;^DD(6,.114,1,1,1)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",4)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",4)=X
;;^DD(6,.114,1,1,2)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",4)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",4)=""
;;^DD(6,.114,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,.115,1,0)
;;=^.1
;;^DD(6,.115,1,1,0)
;;=6^ACX5^MUMPS
;;^DD(6,.115,1,1,1)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",5)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",5)=X
;;^DD(6,.115,1,1,2)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",5)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",5)=""
;;^DD(6,.115,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,.116,1,0)
;;=^.1
;;^DD(6,.116,1,1,0)
;;=6^ACX6^MUMPS
;;^DD(6,.116,1,1,1)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",6)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",6)=X
;;^DD(6,.116,1,1,2)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",6)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",6)=""
;;^DD(6,.116,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,1,1,0)
;;=^.1
;;^DD(6,1,1,1,0)
;;=6^C
;;^DD(6,1,1,1,1)
;;=S ^DIC(6,"C",$E(X,1,30),DA)=""
;;^DD(6,1,1,1,2)
;;=K ^DIC(6,"C",$E(X,1,30),DA)
;;^DD(6,1,1,2,0)
;;=6^ACX7^MUMPS
;;^DD(6,1,1,2,1)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,20),"^",1)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,0),"^",2)=X,^VA(200,"C",X,X1)="",$P(^DIC(3,X1,0),"^",2)=X,^DIC(3,"C",X,X1)=""
;;^DD(6,1,1,2,2)
;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,20),"^",1)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,0),"^",2)="",$P(^DIC(3,X1,0),"^",2)="" K ^VA(200,"C",X,X1),^DIC(3,"C",X,X1)
;;^DD(6,1,1,2,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,2,1,0)
;;=^.1
;;^DD(6,2,1,1,0)
;;=6^ACX36^MUMPS
;;^DD(6,2,1,1,1)
;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,5)=X
;;^DD(6,2,1,1,2)
;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,5)=""
;;^DD(6,2,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,2,1,1,"DT")
;;=2920629
;;^DD(6,3,1,0)
;;=^.1
;;^DD(6,3,1,1,0)
;;=6^ACX37^MUMPS
;;^DD(6,3,1,1,1)
;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,6)=X
;;^DD(6,3,1,1,2)
;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,6)=""
;;^DD(6,3,1,1,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(6,3,1,1,"DT")
;;=2920629
A4A7P601 ; ; 14-JUL-1993
+1 ;;1.01;A4A7;**6**;JUL 14, 1993
+2 FOR I=1:2
SET X=$TEXT(Q+I)
IF X=""
QUIT
SET Y=$EXTRACT($TEXT(Q+I+1),4,999)
SET X=$EXTRACT(X,4,999)
IF $ASCII(Y)=126
SET I=I+1
SET Y=$EXTRACT(Y,2,999)_$EXTRACT($TEXT(Q+I+1),5,99)
IF $ASCII(Y)=61
SET Y=$EXTRACT(Y,2,999)
SET @X=Y
Q QUIT
+1 ;;^DD(6,.01,1,2,0)
+2 ;;=6^AC^MUMPS
+3 ;;^DD(6,.01,1,2,1)
+4 ;;=S ^DIC(16,+X,"A6")=DA
+5 ;;^DD(6,.01,1,2,2)
+6 ;;=K ^DIC(16,+X,"A6")
+7 ;;^DD(6,.01,1,3,0)
+8 ;;=6^AK^MUMPS
+9 ;;^DD(6,.01,1,3,1)
+10 ;;=G F6S^XUA4A7
+11 ;;^DD(6,.01,1,3,2)
+12 ;;=G F6K^XUA4A7
+13 ;;^DD(6,.01,1,3,3)
+14 ;;=Used to link providers to new person keys.
+15 ;;^DD(6,.01,1,3,"%D",0)
+16 ;;=^^2^2^2910916^
+17 ;;^DD(6,.01,1,3,"%D",1,0)
+18 ;;=This X-ref will see that the provider also has the 'VA Provider'
+19 ;;^DD(6,.01,1,3,"%D",2,0)
+20 ;;=key in the New Person file.
+21 ;;^DD(6,.01,1,3,"DT")
+22 ;;=2910916
+23 ;;^DD(6,.111,1,0)
+24 ;;=^.1
+25 ;;^DD(6,.111,1,1,0)
+26 ;;=6^ACX1^MUMPS
+27 ;;^DD(6,.111,1,1,1)
+28 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",1)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",1)=X
+29 ;;^DD(6,.111,1,1,2)
+30 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",1)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",1)=""
+31 ;;^DD(6,.111,1,1,3)
+32 ;;=Used to keep 3-16-200 in sync.
+33 ;;^DD(6,.112,1,0)
+34 ;;=^.1
+35 ;;^DD(6,.112,1,1,0)
+36 ;;=6^ACX2^MUMPS
+37 ;;^DD(6,.112,1,1,1)
+38 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",2)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",2)=X
+39 ;;^DD(6,.112,1,1,2)
+40 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",2)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",2)=""
+41 ;;^DD(6,.112,1,1,3)
+42 ;;=Used to keep 3-16-200 in sync.
+43 ;;^DD(6,.113,1,0)
+44 ;;=^.1
+45 ;;^DD(6,.113,1,1,0)
+46 ;;=6^ACX3^MUMPS
+47 ;;^DD(6,.113,1,1,1)
+48 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",3)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",3)=X
+49 ;;^DD(6,.113,1,1,2)
+50 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",3)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",3)=""
+51 ;;^DD(6,.113,1,1,3)
+52 ;;=Used to keep 3-16-200 in sync.
+53 ;;^DD(6,.114,1,0)
+54 ;;=^.1
+55 ;;^DD(6,.114,1,1,0)
+56 ;;=6^ACX4^MUMPS
+57 ;;^DD(6,.114,1,1,1)
+58 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",4)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",4)=X
+59 ;;^DD(6,.114,1,1,2)
+60 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",4)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",4)=""
+61 ;;^DD(6,.114,1,1,3)
+62 ;;=Used to keep 3-16-200 in sync.
+63 ;;^DD(6,.115,1,0)
+64 ;;=^.1
+65 ;;^DD(6,.115,1,1,0)
+66 ;;=6^ACX5^MUMPS
+67 ;;^DD(6,.115,1,1,1)
+68 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",5)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",5)=X
+69 ;;^DD(6,.115,1,1,2)
+70 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",5)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",5)=""
+71 ;;^DD(6,.115,1,1,3)
+72 ;;=Used to keep 3-16-200 in sync.
+73 ;;^DD(6,.116,1,0)
+74 ;;=^.1
+75 ;;^DD(6,.116,1,1,0)
+76 ;;=6^ACX6^MUMPS
+77 ;;^DD(6,.116,1,1,1)
+78 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",6)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",6)=X
+79 ;;^DD(6,.116,1,1,2)
+80 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,.11),"^",6)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,.11),"^",6)=""
+81 ;;^DD(6,.116,1,1,3)
+82 ;;=Used to keep 3-16-200 in sync.
+83 ;;^DD(6,1,1,0)
+84 ;;=^.1
+85 ;;^DD(6,1,1,1,0)
+86 ;;=6^C
+87 ;;^DD(6,1,1,1,1)
+88 ;;=S ^DIC(6,"C",$E(X,1,30),DA)=""
+89 ;;^DD(6,1,1,1,2)
+90 ;;=K ^DIC(6,"C",$E(X,1,30),DA)
+91 ;;^DD(6,1,1,2,0)
+92 ;;=6^ACX7^MUMPS
+93 ;;^DD(6,1,1,2,1)
+94 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,20),"^",1)=X,X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,0),"^",2)=X,^VA(200,"C",X,X1)="",$P(^DIC(3,X1,0),"^",2)=X,^DIC(3,"C",X,X1)=""
+95 ;;^DD(6,1,1,2,2)
+96 ;;=S X1=+$P(^DIC(6,DA,0),"^",1),$P(^DIC(16,X1,20),"^",1)="",X1=$S($D(^DIC(16,X1,"A3")):^("A3"),1:"") I X1>0 S $P(^VA(200,X1,0),"^",2)="",$P(^DIC(3,X1,0),"^",2)="" K ^VA(200,"C",X,X1),^DIC(3,"C",X,X1)
+97 ;;^DD(6,1,1,2,3)
+98 ;;=Used to keep 3-16-200 in sync.
+99 ;;^DD(6,2,1,0)
+100 ;;=^.1
+101 ;;^DD(6,2,1,1,0)
+102 ;;=6^ACX36^MUMPS
+103 ;;^DD(6,2,1,1,1)
+104 ;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,5)=X
+105 ;;^DD(6,2,1,1,2)
+106 ;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,5)=""
+107 ;;^DD(6,2,1,1,3)
+108 ;;=Used to keep 3-16-200 in sync.
+109 ;;^DD(6,2,1,1,"DT")
+110 ;;=2920629
+111 ;;^DD(6,3,1,0)
+112 ;;=^.1
+113 ;;^DD(6,3,1,1,0)
+114 ;;=6^ACX37^MUMPS
+115 ;;^DD(6,3,1,1,1)
+116 ;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,6)=X
+117 ;;^DD(6,3,1,1,2)
+118 ;;=N % S %=$G(^DIC(16,DA,"A3")) S:% $P(^VA(200,%,"PS"),U,6)=""
+119 ;;^DD(6,3,1,1,3)
+120 ;;=Used to keep 3-16-200 in sync.
+121 ;;^DD(6,3,1,1,"DT")
+122 ;;=2920629
