LRWU6 ;DALOI/STAFF - MODIFY AN EXISTING DATA NAME ;11/04/11 10:19
;;5.2;LAB SERVICE;**316,402,350,519**;Sep 27, 1994;Build 16
;
; Reference to ^DD(63.04 supported by DBIA #7053
; Reference to ^XUSEC supported by DBIA #10076
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
;
;
ACCESS ;
N %,DA,DIC,DIK,I,LRDEC,LRFIX,LRHI,LRLO,LRMAX,LRMIN,LRNAME,LROK
N LRPIECE,LRSET,LRTYPE,LROK1,Q1,Q2,Q3,Q4,Q5,X,Y,LRMOD
;
;ZEXCEPT: DTIME
;
I '$D(^XUSEC("LRLIASON",DUZ)) W $C(7),!,"You do not have access to this option" Q
;
BEGIN ;
;Variable LRMOD is used by LRWU5 in determining whether the "add" or "modify"
;option is being invoked
S U="^",DTIME=$$DTIME^XUP(DUZ),LRMOD=1
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
I $G(DA)]"" L -^DD(63.04,DA)
Q
;
;
TEST ;
;
;ZEXCEPT: %,DA,DIC,DIK,LRFIX,LRNAME,LROK,Q1,X,Y
;
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
D LOCK
Q:'LROK
W !
F 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 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
;
DDFIX ;Called from LRWU9 to fix piece position of data name
N LRSPACE
S $P(LRSPACE," ",80)=""
S DIK="^DD(63.04,",DA(1)=63.04 D IX2^DIK
I $G(LRFIX) S $P(^DD(63.04,DA,0),U,4)=DA_";1"
;
S DIK="^DD(63.04,",DA(1)=63.04 D IX1^DIK
I $G(LRFIX) D
.Q:+$G(INSTALL)
.D SAY^XGF(24,1,LRSPACE)
.D SAY^XGF(24,1,"'"_LRNAME_"' has been modified to:")
E W:'+$G(INSTALL) !!,"'",LRNAME,"' has been modified to:"
D:'+$G(INSTALL) DISPLAY
Q
;
LOCK ;
;is another session also editing this entry
L +^DD(63.04,DA):$G(DILOCKTM,5)
I '$T D
. S LROK=0
. W !,$C(7),"Someone else is editing this data name."
Q
;
DISPLAY ;
;
;ZEXCEPT: DA,LRTYPE
;
S LRTYPE=$P(^DD(63.04,DA,0),U,2) D @$S(LRTYPE["N":"NUM",LRTYPE["S":"SET",1:"FREE")
Q
;
;
NUM ; Numeric data type
;
;ZEXCEPT: DA,LRDEC,LRHI,LRLO,LRNAME,Q1,Q2
;
S Q2=$P(^DD(63.04,DA,0),U,5,99)
I $G(LRFIX) D
.D SAY^XGF(24,1,LRSPACE)
.D SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: NUMERIC Input Transform: "_Q2)
E 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:"")
I $G(LRFIX) D
.D SAY^XGF(24,1,LRSPACE)
.D SAY^XGF(24,1,"Minimum value: "_LRLO_" Maximum value: "_LRHI_" Maximum # decimal digits: "_LRDEC)
E W !,"Minimum value: ",LRLO,!,"Maximum value: ",LRHI,!,"Maximum # decimal digits: ",LRDEC
Q
;
;
FREE ; Free Text datatype
;
;ZEXCEPT: DA,LRMAX,LRMIN,LRNAME,Q2
;
S Q2=$P(^DD(63.04,DA,0),U,5,99)
I $G(LRFIX) D
.D SAY^XGF(24,1,LRSPACE)
.D SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: FREE TEXT Input Transform: "_Q2)
E 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:"")
I $G(LRFIX) D
.D SAY^XGF(24,1,LRSPACE)
.D SAY^XGF(24,1,"Minimum length: "_LRMIN_" Maximum length: "_LRMAX)
E W !,"Minimum length: ",LRMIN,!,"Maximum length: ",LRMAX
Q
;
;
SET ; Set of codes data type
;
;ZEXCEPT: DA,LRNAME,LRPIECE,LRSET,Q2
;
S Q2=$P(^DD(63.04,DA,0),U,3)
I $G(LRFIX) D
.D SAY^XGF(24,1,LRSPACE)
.D SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: SET OF CODES")
E W !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: SET OF CODES"
F LRPIECE=1:1 S LRSET=$P(Q2,";",LRPIECE) Q:LRSET'[":" D
.I $G(LRFIX) D
..D SAY^XGF(24,1,LRSPACE)
..D SAY^XGF(24,1,$P(LRSET,":")_" - "_$P(LRSET,":",2))
.E W !,$P(LRSET,":")," - ",$P(LRSET,":",2)
Q
;
;
FIX ;
;
;ZEXCEPT: I,N,O,P,T
;
S P=0
F S P=$O(^LR(P)) Q:P<1 S T=0 F 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRWU6 4717 printed Nov 22, 2024@17:33:24 Page 2
LRWU6 ;DALOI/STAFF - MODIFY AN EXISTING DATA NAME ;11/04/11 10:19
+1 ;;5.2;LAB SERVICE;**316,402,350,519**;Sep 27, 1994;Build 16
+2 ;
+3 ; Reference to ^DD(63.04 supported by DBIA #7053
+4 ; Reference to ^XUSEC supported by DBIA #10076
+5 ;
+6 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+7 ; used in conjunction with Eclipse M-editor.
+8 ;
+9 ;
ACCESS ;
+1 NEW %,DA,DIC,DIK,I,LRDEC,LRFIX,LRHI,LRLO,LRMAX,LRMIN,LRNAME,LROK
+2 NEW LRPIECE,LRSET,LRTYPE,LROK1,Q1,Q2,Q3,Q4,Q5,X,Y,LRMOD
+3 ;
+4 ;ZEXCEPT: DTIME
+5 ;
+6 IF '$DATA(^XUSEC("LRLIASON",DUZ))
WRITE $CHAR(7),!,"You do not have access to this option"
QUIT
+7 ;
BEGIN ;
+1 ;Variable LRMOD is used by LRWU5 in determining whether the "add" or "modify"
+2 ;option is being invoked
+3 SET U="^"
SET DTIME=$$DTIME^XUP(DUZ)
SET LRMOD=1
+4 WRITE !!,"This option allows modifying an existing data name."
+5 DO DT^LRX
DO TEST
+6 ;
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 IF $GET(DA)]""
LOCK -^DD(63.04,DA)
+2 QUIT
+3 ;
+4 ;
TEST ;
+1 ;
+2 ;ZEXCEPT: %,DA,DIC,DIK,LRFIX,LRNAME,LROK,Q1,X,Y
+3 ;
+4 SET LROK=1
SET DIC="^DD(63.04,"
SET DIC(0)="AEM"
SET DIC("S")="I Y>1.999999"
+5 DO ^DIC
if Y'>0
QUIT
+6 SET DA=+Y
SET LRNAME=$PIECE(^DD(63.04,DA,0),U)
+7 ;
+8 DO DISPLAY
+9 DO LOCK
+10 if 'LROK
QUIT
+11 WRITE !
+12 FOR
WRITE !,"Do you wish to modify this data name"
SET %=2
DO YN^DICN
if %
QUIT
WRITE "Answer 'Y'es or 'N'o"
+13 if %'=1
QUIT
+14 ;
+15 FOR
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 '^'"
+16 IF X=""!(X[U)
QUIT
+17 ;
+18 ;VMP OIFO BAY PINES;VGF;LR*5.2*316;ADDED H 5 SO USER CAN SEE ERROR MSG
+19 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
+20 ;
DDFIX ;Called from LRWU9 to fix piece position of data name
+1 NEW LRSPACE
+2 SET $PIECE(LRSPACE," ",80)=""
+3 SET DIK="^DD(63.04,"
SET DA(1)=63.04
DO IX2^DIK
+4 IF $GET(LRFIX)
SET $PIECE(^DD(63.04,DA,0),U,4)=DA_";1"
+5 ;
+6 SET DIK="^DD(63.04,"
SET DA(1)=63.04
DO IX1^DIK
+7 IF $GET(LRFIX)
Begin DoDot:1
+8 if +$GET(INSTALL)
QUIT
+9 DO SAY^XGF(24,1,LRSPACE)
+10 DO SAY^XGF(24,1,"'"_LRNAME_"' has been modified to:")
End DoDot:1
+11 IF '$TEST
if '+$GET(INSTALL)
WRITE !!,"'",LRNAME,"' has been modified to:"
+12 if '+$GET(INSTALL)
DO DISPLAY
+13 QUIT
+14 ;
LOCK ;
+1 ;is another session also editing this entry
+2 LOCK +^DD(63.04,DA):$GET(DILOCKTM,5)
+3 IF '$TEST
Begin DoDot:1
+4 SET LROK=0
+5 WRITE !,$CHAR(7),"Someone else is editing this data name."
End DoDot:1
+6 QUIT
+7 ;
DISPLAY ;
+1 ;
+2 ;ZEXCEPT: DA,LRTYPE
+3 ;
+4 SET LRTYPE=$PIECE(^DD(63.04,DA,0),U,2)
DO @$SELECT(LRTYPE["N":"NUM",LRTYPE["S":"SET",1:"FREE")
+5 QUIT
+6 ;
+7 ;
NUM ; Numeric data type
+1 ;
+2 ;ZEXCEPT: DA,LRDEC,LRHI,LRLO,LRNAME,Q1,Q2
+3 ;
+4 SET Q2=$PIECE(^DD(63.04,DA,0),U,5,99)
+5 IF $GET(LRFIX)
Begin DoDot:1
+6 DO SAY^XGF(24,1,LRSPACE)
+7 DO SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: NUMERIC Input Transform: "_Q2)
End DoDot:1
+8 IF '$TEST
WRITE !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: NUMERIC",!,"Input Transform: ",Q2
+9 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)
+10 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:"")
+11 IF $GET(LRFIX)
Begin DoDot:1
+12 DO SAY^XGF(24,1,LRSPACE)
+13 DO SAY^XGF(24,1,"Minimum value: "_LRLO_" Maximum value: "_LRHI_" Maximum # decimal digits: "_LRDEC)
End DoDot:1
+14 IF '$TEST
WRITE !,"Minimum value: ",LRLO,!,"Maximum value: ",LRHI,!,"Maximum # decimal digits: ",LRDEC
+15 QUIT
+16 ;
+17 ;
FREE ; Free Text datatype
+1 ;
+2 ;ZEXCEPT: DA,LRMAX,LRMIN,LRNAME,Q2
+3 ;
+4 SET Q2=$PIECE(^DD(63.04,DA,0),U,5,99)
+5 IF $GET(LRFIX)
Begin DoDot:1
+6 DO SAY^XGF(24,1,LRSPACE)
+7 DO SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: FREE TEXT Input Transform: "_Q2)
End DoDot:1
+8 IF '$TEST
WRITE !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: FREE TEXT",!,"Input Transform: ",Q2
+9 SET LRMIN=$SELECT(Q2["$L(X)<":+$PIECE(Q2,"$L(X)<",2),1:"")
SET LRMAX=$SELECT(Q2["$L(X)>":+$PIECE(Q2,"$L(X)>",2),1:"")
+10 IF $GET(LRFIX)
Begin DoDot:1
+11 DO SAY^XGF(24,1,LRSPACE)
+12 DO SAY^XGF(24,1,"Minimum length: "_LRMIN_" Maximum length: "_LRMAX)
End DoDot:1
+13 IF '$TEST
WRITE !,"Minimum length: ",LRMIN,!,"Maximum length: ",LRMAX
+14 QUIT
+15 ;
+16 ;
SET ; Set of codes data type
+1 ;
+2 ;ZEXCEPT: DA,LRNAME,LRPIECE,LRSET,Q2
+3 ;
+4 SET Q2=$PIECE(^DD(63.04,DA,0),U,3)
+5 IF $GET(LRFIX)
Begin DoDot:1
+6 DO SAY^XGF(24,1,LRSPACE)
+7 DO SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: SET OF CODES")
End DoDot:1
+8 IF '$TEST
WRITE !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: SET OF CODES"
+9 FOR LRPIECE=1:1
SET LRSET=$PIECE(Q2,";",LRPIECE)
if LRSET'["
QUIT
Begin DoDot:1
+10 IF $GET(LRFIX)
Begin DoDot:2
+11 DO SAY^XGF(24,1,LRSPACE)
+12 DO SAY^XGF(24,1,$PIECE(LRSET,":")_" - "_$PIECE(LRSET,":",2))
End DoDot:2
+13 IF '$TEST
WRITE !,$PIECE(LRSET,":")," - ",$PIECE(LRSET,":",2)
End DoDot:1
+14 QUIT
+15 ;
+16 ;
FIX ;
+1 ;
+2 ;ZEXCEPT: I,N,O,P,T
+3 ;
+4 SET P=0
+5 FOR
SET P=$ORDER(^LR(P))
if P<1
QUIT
SET T=0
FOR
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 "."
+6 KILL P,T,O,N,I
+7 QUIT
