A4A7P603 ; ; 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(200,0,"IX","PS1",200,53.2)
;;=
;;^DD(200,0,"IX","PS2",200,53.3)
;;=
;;^DD(200,.01,1,10,0)
;;=200^AH^MUMPS
;;^DD(200,.01,1,10,1)
;;=N % S:'$P(^VA(200,DA,0),U,16) %=$P($G(^DIC(3,DA,0)),U,16) S:$G(%) $P(^VA(200,DA,0),U,16)=%,^VA(200,"A16",%,DA)=""
;;^DD(200,.01,1,10,2)
;;=I 0 S X=X
;;^DD(200,.01,1,10,3)
;;=Special PERSON FILE POINTER
;;^DD(200,.01,1,10,"%D",0)
;;=^^2^2^2920810^
;;^DD(200,.01,1,10,"%D",1,0)
;;=This MUMPS cross-reference sets the PERSON FILE POINTER in place and sets
;;^DD(200,.01,1,10,"%D",2,0)
;;=the 'A16' X-ref of that field. See the field description for more details.
;;^DD(200,.01,1,10,"DT")
;;=2920810
;;^DD(200,53.2,0)
;;=DEA#^FX^^PS;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>9!($L(X)<9)!'(X?2U7N) X I $D(X),$D(^VA(200,"PS1",X)),$O(^(X,0))'=DA W !,*7,?5,"DUPLICATE DEA NUMBER",! K X
;;^DD(200,53.2,1,0)
;;=^.1
;;^DD(200,53.2,1,1,0)
;;=200^PS1
;;^DD(200,53.2,1,1,1)
;;=S ^VA(200,"PS1",$E(X,1,30),DA)=""
;;^DD(200,53.2,1,1,2)
;;=K ^VA(200,"PS1",$E(X,1,30),DA)
;;^DD(200,53.2,1,1,3)
;;=Lookup providers by there DEA number
;;^DD(200,53.2,1,1,"%D",0)
;;=^^1^1^2930924^
;;^DD(200,53.2,1,1,"%D",1,0)
;;=This was 'APS1' before. Also used to stop duplicate numbers.
;;^DD(200,53.2,1,1,"DT")
;;=2930924
;;^DD(200,53.2,1,2,0)
;;=200^ACX38^MUMPS
;;^DD(200,53.2,1,2,1)
;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,3)=X
;;^DD(200,53.2,1,2,2)
;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,3)=""
;;^DD(200,53.2,1,2,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(200,53.2,1,2,"DT")
;;=2920629
;;^DD(200,53.2,3)
;;=Enter the DEA number 2 letters 7 numbers.
;;^DD(200,53.2,4)
;;=W:$X>5 ! W ?5,"Enter the DEA number as two upper case letters followed by 7 digits",!,?5,"e.g. AA1234567. Each provider must have a unique number.",!
;;^DD(200,53.2,20,0)
;;=^.3LA^1^1
;;^DD(200,53.2,20,1,0)
;;=PS
;;^DD(200,53.2,21,0)
;;=^^1^1^2930506^
;;^DD(200,53.2,21,1,0)
;;=This field is used to enter the drug enforcement agency number.
;;^DD(200,53.2,"DT")
;;=2930924
;;^DD(200,53.3,0)
;;=VA#^FX^^PS;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>10!($L(X)<3) X I $D(X),$D(^VA(200,"PS2",X)),$O(^(X,0))'=DA,$S('$D(^VA(200,+$O(^VA(200,"PS2",X,0)),"PS")):0,'$P(^("PS"),"^",4):1,1:$P(^("PS"),"^",4)'<DT) K X W !,*7,?5,"DUPLICATE VA #",!
;;^DD(200,53.3,1,0)
;;=^.1
;;^DD(200,53.3,1,1,0)
;;=200^PS2
;;^DD(200,53.3,1,1,1)
;;=S ^VA(200,"PS2",$E(X,1,30),DA)=""
;;^DD(200,53.3,1,1,2)
;;=K ^VA(200,"PS2",$E(X,1,30),DA)
;;^DD(200,53.3,1,1,3)
;;=Lookup providers by there VA number
;;^DD(200,53.3,1,1,"%D",0)
;;=^^1^1^2930924^
;;^DD(200,53.3,1,1,"%D",1,0)
;;=This was 'APS2' before. Also used to stop duplicate numbers.
;;^DD(200,53.3,1,1,"DT")
;;=2930924
;;^DD(200,53.3,1,2,0)
;;=200^ACX39^MUMPS
;;^DD(200,53.3,1,2,1)
;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,6)=X
;;^DD(200,53.3,1,2,2)
;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,6)=""
;;^DD(200,53.3,1,2,3)
;;=Used to keep 3-16-200 in sync.
;;^DD(200,53.3,1,2,"DT")
;;=2920629
;;^DD(200,53.3,3)
;;=Enter the VA number 3 to 10 characters.
;;^DD(200,53.3,4)
;;=W !,?5,"Enter the VA number. VA number must be unique among active providers.",!
;;^DD(200,53.3,20,0)
;;=^.3LA^1^1
;;^DD(200,53.3,20,1,0)
;;=PS
;;^DD(200,53.3,21,0)
;;=^^1^1^2930506^
;;^DD(200,53.3,21,1,0)
;;=This field is used to enter the VA number.
;;^DD(200,53.3,"DT")
;;=2930924
A4A7P603 ; ; 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(200,0,"IX","PS1",200,53.2)
+2 ;;=
+3 ;;^DD(200,0,"IX","PS2",200,53.3)
+4 ;;=
+5 ;;^DD(200,.01,1,10,0)
+6 ;;=200^AH^MUMPS
+7 ;;^DD(200,.01,1,10,1)
+8 ;;=N % S:'$P(^VA(200,DA,0),U,16) %=$P($G(^DIC(3,DA,0)),U,16) S:$G(%) $P(^VA(200,DA,0),U,16)=%,^VA(200,"A16",%,DA)=""
+9 ;;^DD(200,.01,1,10,2)
+10 ;;=I 0 S X=X
+11 ;;^DD(200,.01,1,10,3)
+12 ;;=Special PERSON FILE POINTER
+13 ;;^DD(200,.01,1,10,"%D",0)
+14 ;;=^^2^2^2920810^
+15 ;;^DD(200,.01,1,10,"%D",1,0)
+16 ;;=This MUMPS cross-reference sets the PERSON FILE POINTER in place and sets
+17 ;;^DD(200,.01,1,10,"%D",2,0)
+18 ;;=the 'A16' X-ref of that field. See the field description for more details.
+19 ;;^DD(200,.01,1,10,"DT")
+20 ;;=2920810
+21 ;;^DD(200,53.2,0)
+22 ;;=DEA#^FX^^PS;2^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>9!($L(X)<9)!'(X?2U7N) X I $D(X),$D(^VA(200,"PS1",X)),$O(^(X,0))'=DA W !,*7,?5,"DUPLICATE DEA NUMBER",! K X
+23 ;;^DD(200,53.2,1,0)
+24 ;;=^.1
+25 ;;^DD(200,53.2,1,1,0)
+26 ;;=200^PS1
+27 ;;^DD(200,53.2,1,1,1)
+28 ;;=S ^VA(200,"PS1",$E(X,1,30),DA)=""
+29 ;;^DD(200,53.2,1,1,2)
+30 ;;=K ^VA(200,"PS1",$E(X,1,30),DA)
+31 ;;^DD(200,53.2,1,1,3)
+32 ;;=Lookup providers by there DEA number
+33 ;;^DD(200,53.2,1,1,"%D",0)
+34 ;;=^^1^1^2930924^
+35 ;;^DD(200,53.2,1,1,"%D",1,0)
+36 ;;=This was 'APS1' before. Also used to stop duplicate numbers.
+37 ;;^DD(200,53.2,1,1,"DT")
+38 ;;=2930924
+39 ;;^DD(200,53.2,1,2,0)
+40 ;;=200^ACX38^MUMPS
+41 ;;^DD(200,53.2,1,2,1)
+42 ;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,3)=X
+43 ;;^DD(200,53.2,1,2,2)
+44 ;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,3)=""
+45 ;;^DD(200,53.2,1,2,3)
+46 ;;=Used to keep 3-16-200 in sync.
+47 ;;^DD(200,53.2,1,2,"DT")
+48 ;;=2920629
+49 ;;^DD(200,53.2,3)
+50 ;;=Enter the DEA number 2 letters 7 numbers.
+51 ;;^DD(200,53.2,4)
+52 ;;=W:$X>5 ! W ?5,"Enter the DEA number as two upper case letters followed by 7 digits",!,?5,"e.g. AA1234567. Each provider must have a unique number.",!
+53 ;;^DD(200,53.2,20,0)
+54 ;;=^.3LA^1^1
+55 ;;^DD(200,53.2,20,1,0)
+56 ;;=PS
+57 ;;^DD(200,53.2,21,0)
+58 ;;=^^1^1^2930506^
+59 ;;^DD(200,53.2,21,1,0)
+60 ;;=This field is used to enter the drug enforcement agency number.
+61 ;;^DD(200,53.2,"DT")
+62 ;;=2930924
+63 ;;^DD(200,53.3,0)
+64 ;;=VA#^FX^^PS;3^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>10!($L(X)<3) X I $D(X),$D(^VA(200,"PS2",X)),$O(^(X,0))'=DA,$S('$D(^VA(200,+$O(^VA(200,"PS2",X,0)),"PS")):0,'$P(^("PS"),"^",4):1,1:$P(^("PS"),"^",4)'<DT) K X W !,*7,?5,"DUPLICATE VA #",!
+65 ;;^DD(200,53.3,1,0)
+66 ;;=^.1
+67 ;;^DD(200,53.3,1,1,0)
+68 ;;=200^PS2
+69 ;;^DD(200,53.3,1,1,1)
+70 ;;=S ^VA(200,"PS2",$E(X,1,30),DA)=""
+71 ;;^DD(200,53.3,1,1,2)
+72 ;;=K ^VA(200,"PS2",$E(X,1,30),DA)
+73 ;;^DD(200,53.3,1,1,3)
+74 ;;=Lookup providers by there VA number
+75 ;;^DD(200,53.3,1,1,"%D",0)
+76 ;;=^^1^1^2930924^
+77 ;;^DD(200,53.3,1,1,"%D",1,0)
+78 ;;=This was 'APS2' before. Also used to stop duplicate numbers.
+79 ;;^DD(200,53.3,1,1,"DT")
+80 ;;=2930924
+81 ;;^DD(200,53.3,1,2,0)
+82 ;;=200^ACX39^MUMPS
+83 ;;^DD(200,53.3,1,2,1)
+84 ;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,6)=X
+85 ;;^DD(200,53.3,1,2,2)
+86 ;;=N % S %=$P(^DIC(3,DA,0),U,16) I %,$D(^DIC(6,%,0)) S $P(^DIC(6,%,0),U,6)=""
+87 ;;^DD(200,53.3,1,2,3)
+88 ;;=Used to keep 3-16-200 in sync.
+89 ;;^DD(200,53.3,1,2,"DT")
+90 ;;=2920629
+91 ;;^DD(200,53.3,3)
+92 ;;=Enter the VA number 3 to 10 characters.
+93 ;;^DD(200,53.3,4)
+94 ;;=W !,?5,"Enter the VA number. VA number must be unique among active providers.",!
+95 ;;^DD(200,53.3,20,0)
+96 ;;=^.3LA^1^1
+97 ;;^DD(200,53.3,20,1,0)
+98 ;;=PS
+99 ;;^DD(200,53.3,21,0)
+100 ;;=^^1^1^2930506^
+101 ;;^DD(200,53.3,21,1,0)
+102 ;;=This field is used to enter the VA number.
+103 ;;^DD(200,53.3,"DT")
+104 ;;=2930924
