Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRWU6

LRWU6.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to ^DD(63.04 supported by DBIA #7053
  1. ; Reference to ^XUSEC supported by DBIA #10076
  1. ;
  1. ; ZEXCEPT is used to identify variables which are external to a specific TAG
  1. ; used in conjunction with Eclipse M-editor.
  1. ;
  1. ;
  1. ACCESS ;
  1. N %,DA,DIC,DIK,I,LRDEC,LRFIX,LRHI,LRLO,LRMAX,LRMIN,LRNAME,LROK
  1. N LRPIECE,LRSET,LRTYPE,LROK1,Q1,Q2,Q3,Q4,Q5,X,Y,LRMOD
  1. ;
  1. ;ZEXCEPT: DTIME
  1. ;
  1. I '$D(^XUSEC("LRLIASON",DUZ)) W $C(7),!,"You do not have access to this option" Q
  1. ;
  1. BEGIN ;
  1. ;Variable LRMOD is used by LRWU5 in determining whether the "add" or "modify"
  1. ;option is being invoked
  1. S U="^",DTIME=$$DTIME^XUP(DUZ),LRMOD=1
  1. W !!,"This option allows modifying an existing data name."
  1. D DT^LRX,TEST
  1. ;
  1. END K %,DA,DIC,DIK,I,LRDEC,LRHI,LRLO,LRMAX,LRMIN,LRNAME,LROK,LRPIECE,LRSET,LRTYPE,LROK1,Q1,Q2,Q3,Q4,Q5,X,Y
  1. I $G(DA)]"" L -^DD(63.04,DA)
  1. Q
  1. ;
  1. ;
  1. TEST ;
  1. ;
  1. ;ZEXCEPT: %,DA,DIC,DIK,LRFIX,LRNAME,LROK,Q1,X,Y
  1. ;
  1. S LROK=1,DIC="^DD(63.04,",DIC(0)="AEM",DIC("S")="I Y>1.999999"
  1. D ^DIC Q:Y'>0
  1. S DA=+Y,LRNAME=$P(^DD(63.04,DA,0),U)
  1. ;
  1. D DISPLAY
  1. D LOCK
  1. Q:'LROK
  1. W !
  1. F W !,"Do you wish to modify this data name" S %=2 D YN^DICN Q:% W "Answer 'Y'es or 'N'o"
  1. Q:%'=1
  1. ;
  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 '^'"
  1. I X=""!(X[U) Q
  1. ;
  1. ;VMP OIFO BAY PINES;VGF;LR*5.2*316;ADDED H 5 SO USER CAN SEE ERROR MSG
  1. 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
  1. ;
  1. DDFIX ;Called from LRWU9 to fix piece position of data name
  1. N LRSPACE
  1. S $P(LRSPACE," ",80)=""
  1. S DIK="^DD(63.04,",DA(1)=63.04 D IX2^DIK
  1. I $G(LRFIX) S $P(^DD(63.04,DA,0),U,4)=DA_";1"
  1. ;
  1. S DIK="^DD(63.04,",DA(1)=63.04 D IX1^DIK
  1. I $G(LRFIX) D
  1. .Q:+$G(INSTALL)
  1. .D SAY^XGF(24,1,LRSPACE)
  1. .D SAY^XGF(24,1,"'"_LRNAME_"' has been modified to:")
  1. E W:'+$G(INSTALL) !!,"'",LRNAME,"' has been modified to:"
  1. D:'+$G(INSTALL) DISPLAY
  1. Q
  1. ;
  1. LOCK ;
  1. ;is another session also editing this entry
  1. L +^DD(63.04,DA):$G(DILOCKTM,5)
  1. I '$T D
  1. . S LROK=0
  1. . W !,$C(7),"Someone else is editing this data name."
  1. Q
  1. ;
  1. DISPLAY ;
  1. ;
  1. ;ZEXCEPT: DA,LRTYPE
  1. ;
  1. S LRTYPE=$P(^DD(63.04,DA,0),U,2) D @$S(LRTYPE["N":"NUM",LRTYPE["S":"SET",1:"FREE")
  1. Q
  1. ;
  1. ;
  1. NUM ; Numeric data type
  1. ;
  1. ;ZEXCEPT: DA,LRDEC,LRHI,LRLO,LRNAME,Q1,Q2
  1. ;
  1. S Q2=$P(^DD(63.04,DA,0),U,5,99)
  1. I $G(LRFIX) D
  1. .D SAY^XGF(24,1,LRSPACE)
  1. .D SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: NUMERIC Input Transform: "_Q2)
  1. E W !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: NUMERIC",!,"Input Transform: ",Q2
  1. I Q2["S Q9=" S Q1=$P($P(Q2,"S Q9=",2),"""",2),LRLO=$P(Q1,","),LRHI=$P(Q1,",",2),LRDEC=$P(Q1,",",3)
  1. 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:"")
  1. I $G(LRFIX) D
  1. .D SAY^XGF(24,1,LRSPACE)
  1. .D SAY^XGF(24,1,"Minimum value: "_LRLO_" Maximum value: "_LRHI_" Maximum # decimal digits: "_LRDEC)
  1. E W !,"Minimum value: ",LRLO,!,"Maximum value: ",LRHI,!,"Maximum # decimal digits: ",LRDEC
  1. Q
  1. ;
  1. ;
  1. FREE ; Free Text datatype
  1. ;
  1. ;ZEXCEPT: DA,LRMAX,LRMIN,LRNAME,Q2
  1. ;
  1. S Q2=$P(^DD(63.04,DA,0),U,5,99)
  1. I $G(LRFIX) D
  1. .D SAY^XGF(24,1,LRSPACE)
  1. .D SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: FREE TEXT Input Transform: "_Q2)
  1. E W !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: FREE TEXT",!,"Input Transform: ",Q2
  1. S LRMIN=$S(Q2["$L(X)<":+$P(Q2,"$L(X)<",2),1:""),LRMAX=$S(Q2["$L(X)>":+$P(Q2,"$L(X)>",2),1:"")
  1. I $G(LRFIX) D
  1. .D SAY^XGF(24,1,LRSPACE)
  1. .D SAY^XGF(24,1,"Minimum length: "_LRMIN_" Maximum length: "_LRMAX)
  1. E W !,"Minimum length: ",LRMIN,!,"Maximum length: ",LRMAX
  1. Q
  1. ;
  1. ;
  1. SET ; Set of codes data type
  1. ;
  1. ;ZEXCEPT: DA,LRNAME,LRPIECE,LRSET,Q2
  1. ;
  1. S Q2=$P(^DD(63.04,DA,0),U,3)
  1. I $G(LRFIX) D
  1. .D SAY^XGF(24,1,LRSPACE)
  1. .D SAY^XGF(24,1,"Data Name: "_LRNAME_" Subfield #: "_DA_" Type: SET OF CODES")
  1. E W !!,"Data Name: ",LRNAME," Subfield #: ",DA," Type: SET OF CODES"
  1. F LRPIECE=1:1 S LRSET=$P(Q2,";",LRPIECE) Q:LRSET'[":" D
  1. .I $G(LRFIX) D
  1. ..D SAY^XGF(24,1,LRSPACE)
  1. ..D SAY^XGF(24,1,$P(LRSET,":")_" - "_$P(LRSET,":",2))
  1. .E W !,$P(LRSET,":")," - ",$P(LRSET,":",2)
  1. Q
  1. ;
  1. ;
  1. FIX ;
  1. ;
  1. ;ZEXCEPT: I,N,O,P,T
  1. ;
  1. S P=0
  1. 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 "."
  1. K P,T,O,N,I
  1. Q