| 1 | DICATTDM ;GFT ;04:56 PM 17 Dec 2002
|
|---|
| 2 | ;;22.0;VA FileMan;**42,118**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | SUBDEF ;
|
|---|
| 6 | S Y=$O(^DD(DICATTA,"GL",""),-1)
|
|---|
| 7 | I $$CHKSUB(Y) Q
|
|---|
| 8 | NXT I Y S Y=Y+1 Q
|
|---|
| 9 | F Y=+$O(^DD(DICATTA,"GL","A"),-1):1 Q:'$D(^(Y))
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | PIECDEF ;
|
|---|
| 13 | I $E($G(DICATT2N))="K" S Y="E1,245" Q
|
|---|
| 14 | S Y=$$G(16) I Y]"" S Y=$$P(Y)
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | P(Y) ;given SUBSCRIPT Y, return PIECE prompt
|
|---|
| 18 | N P,X,%
|
|---|
| 19 | S X=0,%=1,P=0
|
|---|
| 20 | PC S X=$O(^DD(DICATTA,"GL",Y,X)) I X'="" S P=$P(X,",",2),%=$S(%>P:%,1:P+1) G PC
|
|---|
| 21 | I P S %="E"_%_","_(DICATTLN+%-1)
|
|---|
| 22 | E S %=$O(^(99999),-1)+1
|
|---|
| 23 | Q %
|
|---|
| 24 | ;
|
|---|
| 25 | SUBHELP ;
|
|---|
| 26 | S Y=$E($G(DICATT2N))="K" D UNED^DDSUTL(17,"DICATTM",3,Y)
|
|---|
| 27 | N X,Y,T
|
|---|
| 28 | S X(1)="Enter name of MUMPS Global subscript where this Field's data will be stored."
|
|---|
| 29 | S X(2)="Already assigned:"
|
|---|
| 30 | S Y="",T=3
|
|---|
| 31 | F S Y=$O(^DD(DICATTA,"GL",Y)) Q:Y="" S X(T)=$G(X(T))_$J(Y,9) I $L(X(T))>66 S T=T+1
|
|---|
| 32 | D HLP^DDSUTL(.X)
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | CHKSUB(X) ;used as INPUT TRANSFORM for Fields 16 & 76
|
|---|
| 36 | N M
|
|---|
| 37 | S M=$$GET^DDSVALF(20.5,"DICATT",1,"","")
|
|---|
| 38 | I $D(^DD(DICATTA,"GL",X)),M Q "Another Field is already stored at '"_X_"'"
|
|---|
| 39 | I $D(^(X,0)) Q "A multiple field is already stored at '"_X_"'"
|
|---|
| 40 | I $G(DICATTLN),$$MAX(DICATTLN,X)>250 Q "Too much to store at the '"_X_"' subscript"
|
|---|
| 41 | Q 1
|
|---|
| 42 | ;
|
|---|
| 43 | MAX(L,Y) ;given L=length of new data, Y=subscript name
|
|---|
| 44 | N T,A,DP,N,W
|
|---|
| 45 | S A=DICATTA,DP=DICATTF
|
|---|
| 46 | D MAX^DICATT1 Q T ;returns maximum length of subscript's data
|
|---|
| 47 | ;
|
|---|
| 48 | CHKPIEC(P) ;
|
|---|
| 49 | N N,S
|
|---|
| 50 | S S=$$G(16) I S="" Q S ;must have subscript
|
|---|
| 51 | I P?1"E"1.N1","1.N S N=$P(P,",",2)-$E(P,2,9)+1 G USED:N'<$G(DICATTLN) Q "Can't be less than "_DICATTLN
|
|---|
| 52 | I P>0,P<100,P?.N,+P=P G USED
|
|---|
| 53 | Q ""
|
|---|
| 54 | USED I $D(^DD(DICATTA,"GL",S,P)) Q "Already used for '"_$P(^DD(DICATTA,$O(^(P,0)),0),U)_"'"
|
|---|
| 55 | I P["E",$O(^(0)) Q "Can't store by $EXTRACT in the same subscript with $PIECES"
|
|---|
| 56 | Q 1
|
|---|
| 57 | ;
|
|---|
| 58 | PIECHELP ;
|
|---|
| 59 | N X,G,Y,P,T
|
|---|
| 60 | S X(1)="Type a number from 1 to 99"
|
|---|
| 61 | S G=$$G(16) Q:G=""
|
|---|
| 62 | I '$D(^DD(DICATTA,"GL",G)) S X(1)=X(1)_" or an $EXTRACT range such as ""E2,4""." Q
|
|---|
| 63 | S X(1)=X(1)_".",X(2)="Currently assigned: ",Y="",T=2
|
|---|
| 64 | F S Y=$O(^DD(DICATTA,"GL",G,Y)) Q:Y="" S P=$O(^(Y,0)) I $D(^DD(DICATTA,P,0)) S X(T)=$G(X(T))_$J(Y,7) I $L(X(T))>66 S T=T+1
|
|---|
| 65 | D HLP^DDSUTL(.X)
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | POST ;POST-ACTION of Page 3
|
|---|
| 69 | N %
|
|---|
| 70 | S %=$$CHKPIEC($$G(17)) I '% S DDSBR=% K % S %(1)=DDSBR,DDSBR=16 D H(.%)
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | H(%) S %($O(%(""),-1)+1)="$$EOP"
|
|---|
| 74 | D HLP^DDSUTL(.%)
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | G(I) Q $$GET^DDSVALF(I,"DICATTM",3,"","")
|
|---|
