| 1 | DICATTD6 ;GFT;09:51 AM 3 Dec 2002;COMPUTED FIELD
|
|---|
| 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 | ;78 = COMPUTED EXPRESSION
|
|---|
| 6 | ;79 = TYPE OF RESULT
|
|---|
| 7 | ;80 = NUMBER OF FRACTIONAL DIGITS
|
|---|
| 8 | ;81 = ROUNDED?
|
|---|
| 9 | ;82 = TOTALLING SUMS
|
|---|
| 10 | ;83 = LENGTH
|
|---|
| 11 | ;83.1 = POINT TO FILE
|
|---|
| 12 | ;
|
|---|
| 13 | VAL6 ;validate COMPUTED EXPRESSION (78)
|
|---|
| 14 | Q:X=""
|
|---|
| 15 | N A,DA,I,J,DQI,DICMX,DICM,DICOMP,DICOMPX,XSAVE
|
|---|
| 16 | S DQI="Y("_DICATTA_","_DICATTF_",",XSAVE=X
|
|---|
| 17 | D DICOMP I '$D(X) S DDSBR=78 D PUT^DDSVALF(78,,,DDSOLD) Q
|
|---|
| 18 | I DUZ(0)="@" K DQI S DQI(1)="TRANSLATES TO THE FOLLOWING CODE:",DQI(2)=X D HLP^DDSUTL(.DQI)
|
|---|
| 19 | S DICATT5=X,DICM=Y["m"
|
|---|
| 20 | F I=80:1:83 D UNED^DDSUTL(I,"DICATT6",2.6,DICM) ;If multiple, don't ask other questions
|
|---|
| 21 | D UNED^DDSUTL(83.1,"DICATT6",2.6,Y'["p")
|
|---|
| 22 | K DICATT5N M DICATT5N=X S DICATT5N(9)="^",DICATT5N(9.1)=XSAVE,DICATT5N(9.01)=DICOMPX ;remember all the stuff in DICATT5N array
|
|---|
| 23 | TYPE S DICATT2N=$S(Y["D":"D",Y["B":"B",1:"")_"C"_$S('DICM:$S(Y["B":"J1",1:"J"),1:"m"_$E("w",Y["w"))_$S(Y["p":"p"_$S($P(Y,"p",2):+$P(Y,"p",2),1:""),1:"")
|
|---|
| 24 | I DICATT2N="CJ" D ;may be numeric for TOTALLING
|
|---|
| 25 | .K DICOMPX
|
|---|
| 26 | .F Y=1:1 S %=$P(DICATT5N(9.01),";",Y) Q:'% S DICOMPX(1,+%,+$P(%,U,2))="S("""_%_""")"
|
|---|
| 27 | .Q:Y<2 I DICATT5'["/",DICATT5'["\" Q:DICATT5'["*"!(Y<3)
|
|---|
| 28 | .S DQI="Y(",X=XSAVE D DICOMP
|
|---|
| 29 | .I $D(X)=1 S DICATT5N(9.02)=X_" S Y=X"
|
|---|
| 30 | D CUNED(DICATT2N) ;Re-prompt TYPE
|
|---|
| 31 | D UNED^DDSUTL(82,"DICATT6",2.6,'$D(DICATT5N(9.02))) ;If no components, don't ask 'SUMS' question
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | CUNED(S) ;also called by DICATTD
|
|---|
| 35 | D PUT^DDSVALF(79,"DICATT6",2.6,$$TYPE^DICATT3(S))
|
|---|
| 36 | N DICUNED F DICUNED=18,3,4,6,7,8,98,99 D UNED^DDSUTL(DICUNED,"DICATT",1,1) ;Make 'MANDATORY?',etc. uneditable
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | DICOMP S A=DICATTA,DA=DICATTF,DICOMPX="",DICOMP="I",DICMX="X DICMX"
|
|---|
| 40 | D IJ^DIUTL(A)
|
|---|
| 41 | D ^DICOMP Q
|
|---|
| 42 | ;
|
|---|
| 43 | ;
|
|---|
| 44 | BR79 ;branch from TYPE
|
|---|
| 45 | N A,S
|
|---|
| 46 | D UNED^DDSUTL(83.1,"DICATT6",2.6,X'["p")
|
|---|
| 47 | S A="" I X["p" S A=$P($G(DICATT2N),"p",2) S:'A A=$P(DICATT2,"p",2) S:A A=$P($G(^DIC(+A,0)),U)
|
|---|
| 48 | D PUT^DDSVALF(83.1,,,A)
|
|---|
| 49 | S S=X["D"!(X["B")!(X["m")!(X["p")
|
|---|
| 50 | F A=80:1:83 D UNED^DDSUTL(A,"DICATT6",2.6,S) I S D PUT^DDSVALF(A,,,"") ;for DATE, BOOLEAN POINTER, & MULTIPLE, don't ask other questions
|
|---|
| 51 | I $$G(79)="" D PUT^DDSVALF(83,,,8) ;default length of field=8
|
|---|
| 52 | Q:X="N"
|
|---|
| 53 | F A=80,81,82 D PUT^DDSVALF(A,,,""),UNED^DDSUTL(A,"DICATT6",2.6,1)
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | ;
|
|---|
| 57 | POST6 ;POST ACTION of Page 2.6
|
|---|
| 58 | N T,I
|
|---|
| 59 | I $$G(82)=0 K DICATT5N(9.02)
|
|---|
| 60 | S T=$$G(79)
|
|---|
| 61 | F I="D","B","m","mp","p" I T=I S:T["p" T=T_$$G(83.1) S DICATT2N="C"_T G CHNGD
|
|---|
| 62 | S I="" I T="N" S I=$$G(80) ;if numeric, get fractional digits
|
|---|
| 63 | S DICATT2N="CJ"_$$G(83) ;length of field
|
|---|
| 64 | S T=" S X=$J(X,0,"
|
|---|
| 65 | S DICATT5N=$S($D(DICATT5N)#2:DICATT5N,1:$P(DICATT5,T))
|
|---|
| 66 | I I D
|
|---|
| 67 | .S DICATT2N=DICATT2N_","_I
|
|---|
| 68 | .I $$G(81) S DICATT5N=DICATT5N_T_I_")"
|
|---|
| 69 | CHNGD S DICATTMN=""
|
|---|
| 70 | D UNED^DDSUTL(20.5,"DICATT",1,1) ;don't ask multiple
|
|---|
| 71 | S DICATT4N=" ; " ;Computed Field is stored nowhere!
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | G(I) Q $$GET^DDSVALF(I,"DICATT6",2.6,"I","")
|
|---|
