- 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 Feb 18, 2025@23:49:12 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