LRWU6 ;SLC/RWF/BA - MODIFY AN EXISTING DATA NAME ; 13-Aug-2013 09:14 ; MKK
;;5.2;LAB SERVICE;**1013,1021,316,1027,402,1033**;NOV 01, 1997
;
ACCESS I '$D(^XUSEC("LRLIASON",DUZ)) W $C(7),!,"You do not have access to this option" Q
BEGIN S U="^",DTIME=$S($D(DTIME):DTIME,1:300) W !!,"This option allows modifying an existing data name." D DT^LRX,TEST
END K %,DA,DIC,DIK,I,LRDEC,LRHI,LRLO,LRMAX,LRMIN,LRNAME,LROK,LRPIECE,LRSET,LRTYPE,LROK1,Q1,Q2,Q3,Q4,Q5,X,Y
Q
TEST S LROK=1,DIC="^DD(63.04,",DIC(0)="AEM",DIC("S")="I Y>1.999999" D ^DIC Q:Y'>0 S DA=+Y,LRNAME=$P(^DD(63.04,DA,0),U)
D DISPLAY W ! F I=0:0 W !,"Do you wish to modify this data name" S %=2 D YN^DICN Q:% W "Answer 'Y'es or 'N'o"
Q:%'=1
F I=0:0 W !,"Enter data type for ",LRNAME,": (N)umeric, (S)et of Codes, or (F)ree text? " R X:DTIME Q:X[U!(X="")!(X="N")!(X="S")!(X="F") W !,"Enter 'N', 'S', 'F', or '^'"
I X=""!(X[U) Q
;VMP OIFO BAY PINES;VGF;LR*5.2*316;ADDED H 5 SO USER CAN SEE ERROR MSG
S Q1=X D @$S(Q1="N":"NUM^LRWU5",Q1="S":"CODES^LRWU5",1:"FREE^LRWU5") I 'LROK W !,"Nothing has been changed." H 5 Q
S DIK="^DD(63.04,",DA(1)=63.04 D IX1^DIK
W !!,"'",LRNAME,"' has been modified to:" D DISPLAY
Q
DISPLAY S LRTYPE=$P(^DD(63.04,DA,0),U,2) D @$S(LRTYPE["N":"NUM",LRTYPE["S":"SET",1:"FREE")
Q
NUM S Q2=$P(^DD(63.04,DA,0),U,5,99) W !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: NUMERIC",!,"Input Transform: ",Q2
I Q2["S Q9=" S Q1=$P($P(Q2,"S Q9=",2),"""",2),LRLO=$P(Q1,","),LRHI=$P(Q1,",",2),LRDEC=$P(Q1,",",3)
I Q2'["S Q9=" S LRLO=$S(Q2["X<":+$P(Q2,"X<",2),1:""),LRHI=$S(Q2["X>":+$P(Q2,"X>",2),1:""),LRDEC=$S(Q2["X?.E1"".""":-1+$P(Q2,"X?.E1"".""",2),1:"")
W !,"Minimum value: ",LRLO,!,"Maximum value: ",LRHI,!,"Maximum # decimal digits: ",LRDEC
Q
FREE S Q2=$P(^DD(63.04,DA,0),U,5,99) W !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: FREE TEXT",!,"Input Transform: ",Q2
S LRMIN=$S(Q2["$L(X)<":+$P(Q2,"$L(X)<",2),1:""),LRMAX=$S(Q2["$L(X)>":+$P(Q2,"$L(X)>",2),1:"")
W !,"Minimum length: ",LRMIN,!,"Maximum length: ",LRMAX
Q
SET S Q2=$P(^DD(63.04,DA,0),U,3) W !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: SET OF CODES"
F LRPIECE=1:1 S LRSET=$P(Q2,";",LRPIECE) Q:LRSET'[":" W !,$P(LRSET,":")," - ",$P(LRSET,":",2)
Q
FIX S P=0 F I=0:0 S P=$O(^LR(P)) Q:P<1 S T=0 F I=0:0 S T=$O(^LR(P,"CH",T)) Q:T<1 I $D(^LR(P,"CH",T,O))&('$D(^(N))) S ^(N)=^(O) K ^(O) W "."
K P,T,O,N,I
Q
LRWU6 ;SLC/RWF/BA - MODIFY AN EXISTING DATA NAME ; 13-Aug-2013 09:14 ; MKK
+1 ;;5.2;LAB SERVICE;**1013,1021,316,1027,402,1033**;NOV 01, 1997
+2 ;
ACCESS IF '$DATA(^XUSEC("LRLIASON",DUZ))
WRITE $CHAR(7),!,"You do not have access to this option"
QUIT
BEGIN SET U="^"
SET DTIME=$SELECT($DATA(DTIME):DTIME,1:300)
WRITE !!,"This option allows modifying an existing data name."
DO DT^LRX
DO TEST
END KILL %,DA,DIC,DIK,I,LRDEC,LRHI,LRLO,LRMAX,LRMIN,LRNAME,LROK,LRPIECE,LRSET,LRTYPE,LROK1,Q1,Q2,Q3,Q4,Q5,X,Y
+1 QUIT
TEST SET LROK=1
SET DIC="^DD(63.04,"
SET DIC(0)="AEM"
SET DIC("S")="I Y>1.999999"
DO ^DIC
IF Y'>0
QUIT
SET DA=+Y
SET LRNAME=$PIECE(^DD(63.04,DA,0),U)
+1 DO DISPLAY
WRITE !
FOR I=0:0
WRITE !,"Do you wish to modify this data name"
SET %=2
DO YN^DICN
IF %
QUIT
WRITE "Answer 'Y'es or 'N'o"
+2 IF %'=1
QUIT
+3 FOR I=0:0
WRITE !,"Enter data type for ",LRNAME,": (N)umeric, (S)et of Codes, or (F)ree text? "
READ X:DTIME
IF X[U!(X="")!(X="N")!(X="S")!(X="F")
QUIT
WRITE !,"Enter 'N', 'S', 'F', or '^'"
+4 IF X=""!(X[U)
QUIT
+5 ;VMP OIFO BAY PINES;VGF;LR*5.2*316;ADDED H 5 SO USER CAN SEE ERROR MSG
+6 SET Q1=X
DO @$SELECT(Q1="N":"NUM^LRWU5",Q1="S":"CODES^LRWU5",1:"FREE^LRWU5")
IF 'LROK
WRITE !,"Nothing has been changed."
HANG 5
QUIT
+7 SET DIK="^DD(63.04,"
SET DA(1)=63.04
DO IX1^DIK
+8 WRITE !!,"'",LRNAME,"' has been modified to:"
DO DISPLAY
+9 QUIT
DISPLAY SET LRTYPE=$PIECE(^DD(63.04,DA,0),U,2)
DO @$SELECT(LRTYPE["N":"NUM",LRTYPE["S":"SET",1:"FREE")
+1 QUIT
NUM SET Q2=$PIECE(^DD(63.04,DA,0),U,5,99)
WRITE !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: NUMERIC",!,"Input Transform: ",Q2
+1 IF Q2["S Q9="
SET Q1=$PIECE($PIECE(Q2,"S Q9=",2),"""",2)
SET LRLO=$PIECE(Q1,",")
SET LRHI=$PIECE(Q1,",",2)
SET LRDEC=$PIECE(Q1,",",3)
+2 IF Q2'["S Q9="
SET LRLO=$SELECT(Q2["X<":+$PIECE(Q2,"X<",2),1:"")
SET LRHI=$SELECT(Q2["X>":+$PIECE(Q2,"X>",2),1:"")
SET LRDEC=$SELECT(Q2["X?.E1"".""":-1+$PIECE(Q2,"X?.E1"".""",2),1:"")
+3 WRITE !,"Minimum value: ",LRLO,!,"Maximum value: ",LRHI,!,"Maximum # decimal digits: ",LRDEC
+4 QUIT
FREE SET Q2=$PIECE(^DD(63.04,DA,0),U,5,99)
WRITE !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: FREE TEXT",!,"Input Transform: ",Q2
+1 SET LRMIN=$SELECT(Q2["$L(X)<":+$PIECE(Q2,"$L(X)<",2),1:"")
SET LRMAX=$SELECT(Q2["$L(X)>":+$PIECE(Q2,"$L(X)>",2),1:"")
+2 WRITE !,"Minimum length: ",LRMIN,!,"Maximum length: ",LRMAX
+3 QUIT
SET SET Q2=$PIECE(^DD(63.04,DA,0),U,3)
WRITE !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: SET OF CODES"
+1 FOR LRPIECE=1:1
SET LRSET=$PIECE(Q2,";",LRPIECE)
IF LRSET'["
QUIT
WRITE !,$PIECE(LRSET,":")," - ",$PIECE(LRSET,":",2)
+2 QUIT
FIX SET P=0
FOR I=0:0
SET P=$ORDER(^LR(P))
IF P<1
QUIT
SET T=0
FOR I=0:0
SET T=$ORDER(^LR(P,"CH",T))
IF T<1
QUIT
IF $DATA(^LR(P,"CH",T,O))&('$DATA(^(N)))
SET ^(N)=^(O)
KILL ^(O)
WRITE "."
+1 KILL P,T,O,N,I
+2 QUIT
