- DICATTD6 ;GFT/GFT - Computed Field;12:54 PM 21 Mar 2001
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- ;78 = COMPUTED EXPRESSION
- ;79 = TYPE OF RESULT
- ;80 = NUMBER OF FRACTIONAL DIGITS
- ;81 = ROUNDED?
- ;82 = TOTALLING SUMS
- ;83 = LENGTH
- ;83.1 = POINT TO FILE
- ;
- VAL6 ;validate COMPUTED EXPRESSION (78)
- Q:X=""
- N A,DA,I,J,DQI,DICMX,DICM,DICOMP,DICOMPX,XSAVE
- S DQI="Y("_DICATTA_","_DICATTF_",",XSAVE=X
- D DICOMP I '$D(X) S DDSBR=78 D PUT^DDSVALF(78,,,DDSOLD) Q
- I DUZ(0)="@" K DQI S DQI(1)="TRANSLATES TO THE FOLLOWING CODE:",DQI(2)=X D HLP^DDSUTL(.DQI)
- S DICATT5=X,DICM=Y["m"
- F I=80:1:83 D UNED^DDSUTL(I,"DICATT6",2.6,DICM) ;If multiple, don't ask other questions
- D UNED^DDSUTL(83.1,"DICATT6",2.6,Y'["p")
- K DICATT5N M DICATT5N=X S DICATT5N(9)="^",DICATT5N(9.1)=XSAVE,DICATT5N(9.01)=DICOMPX ;remember all the stuff in DICATT5N array
- 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:"")
- I DICATT2N="CJ" D ;may be numeric for TOTALLING
- .K DICOMPX
- .F Y=1:1 S %=$P(DICATT5N(9.01),";",Y) Q:'% S DICOMPX(1,+%,+$P(%,U,2))="S("""_%_""")"
- .Q:Y<2 I DICATT5'["/",DICATT5'["\" Q:DICATT5'["*"!(Y<3)
- .S DQI="Y(",X=XSAVE D DICOMP
- .I $D(X)=1 S DICATT5N(9.02)=X_" S Y=X"
- D CUNED(DICATT2N) ;Re-prompt TYPE
- D UNED^DDSUTL(82,"DICATT6",2.6,'$D(DICATT5N(9.02))) ;If no components, don't ask 'SUMS' question
- Q
- ;
- CUNED(S) ;also called by DICATTD
- D PUT^DDSVALF(79,"DICATT6",2.6,$$TYPE^DICATT3(S))
- N DICUNED F DICUNED=18,3,4,6,7,8,98,99 D UNED^DDSUTL(DICUNED,"DICATT",1,1) ;Make 'MANDATORY?',etc. uneditable
- Q
- ;
- DICOMP S A=DICATTA,DA=DICATTF,DICOMPX="",DICOMP="I",DICMX="X DICMX"
- D IJ^DIUTL(A)
- D ^DICOMP Q
- ;
- ;
- BR79 ;branch from TYPE
- N A,S
- D UNED^DDSUTL(83.1,"DICATT6",2.6,X'["p")
- 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)
- D PUT^DDSVALF(83.1,,,A)
- S S=X["D"!(X["B")!(X["m")!(X["p")
- 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
- I $$G(79)="" D PUT^DDSVALF(83,,,8) ;default length of field=8
- Q:X="N"
- F A=80,81,82 D PUT^DDSVALF(A,,,""),UNED^DDSUTL(A,"DICATT6",2.6,1)
- Q
- ;
- ;
- POST6 ;POST ACTION of Page 2.6
- N T,I
- I $$G(82)=0 K DICATT5N(9.02)
- S T=$$G(79)
- F I="D","B","m","mp","p" I T=I S:T["p" T=T_$$G(83.1) S DICATT2N="C"_T G CHNGD
- S I="" I T="N" S I=$$G(80) ;if numeric, get fractional digits
- S DICATT2N="CJ"_$$G(83) ;length of field
- S T=" S X=$J(X,0,"
- S DICATT5N=$S($D(DICATT5N)#2:DICATT5N,1:$P(DICATT5,T))
- I I D
- .S DICATT2N=DICATT2N_","_I
- .I $$G(81) S DICATT5N=DICATT5N_T_I_")"
- CHNGD S DICATTMN=""
- D UNED^DDSUTL(20.5,"DICATT",1,1) ;don't ask multiple
- S DICATT4N=" ; " ;Computed Field is stored nowhere!
- Q
- ;
- G(I) Q $$GET^DDSVALF(I,"DICATT6",2.6,"I","")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICATTD6 3154 printed Dec 13, 2024@02:45:43 Page 2
- DICATTD6 ;GFT/GFT - Computed Field;12:54 PM 21 Mar 2001
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- +7 ;78 = COMPUTED EXPRESSION
- +8 ;79 = TYPE OF RESULT
- +9 ;80 = NUMBER OF FRACTIONAL DIGITS
- +10 ;81 = ROUNDED?
- +11 ;82 = TOTALLING SUMS
- +12 ;83 = LENGTH
- +13 ;83.1 = POINT TO FILE
- +14 ;
- VAL6 ;validate COMPUTED EXPRESSION (78)
- +1 if X=""
- QUIT
- +2 NEW A,DA,I,J,DQI,DICMX,DICM,DICOMP,DICOMPX,XSAVE
- +3 SET DQI="Y("_DICATTA_","_DICATTF_","
- SET XSAVE=X
- +4 DO DICOMP
- IF '$DATA(X)
- SET DDSBR=78
- DO PUT^DDSVALF(78,,,DDSOLD)
- QUIT
- +5 IF DUZ(0)="@"
- KILL DQI
- SET DQI(1)="TRANSLATES TO THE FOLLOWING CODE:"
- SET DQI(2)=X
- DO HLP^DDSUTL(.DQI)
- +6 SET DICATT5=X
- SET DICM=Y["m"
- +7 ;If multiple, don't ask other questions
- FOR I=80:1:83
- DO UNED^DDSUTL(I,"DICATT6",2.6,DICM)
- +8 DO UNED^DDSUTL(83.1,"DICATT6",2.6,Y'["p")
- +9 ;remember all the stuff in DICATT5N array
- KILL DICATT5N
- MERGE DICATT5N=X
- SET DICATT5N(9)="^"
- SET DICATT5N(9.1)=XSAVE
- SET DICATT5N(9.01)=DICOMPX
- TYPE SET DICATT2N=$SELECT(Y["D":"D",Y["B":"B",1:"")_"C"_$SELECT('DICM:$SELECT(Y["B":"J1",1:"J"),1:"m"_$EXTRACT("w",Y["w"))_$SELECT(Y["p":"p"_$SELECT($PIECE(Y,"p",2):+$PIECE(Y,"p",2),1:""),1:"")
- +1 ;may be numeric for TOTALLING
- IF DICATT2N="CJ"
- Begin DoDot:1
- +2 KILL DICOMPX
- +3 FOR Y=1:1
- SET %=$PIECE(DICATT5N(9.01),";",Y)
- if '%
- QUIT
- SET DICOMPX(1,+%,+$PIECE(%,U,2))="S("""_%_""")"
- +4 if Y<2
- QUIT
- IF DICATT5'["/"
- IF DICATT5'["\"
- if DICATT5'["*"!(Y<3)
- QUIT
- +5 SET DQI="Y("
- SET X=XSAVE
- DO DICOMP
- +6 IF $DATA(X)=1
- SET DICATT5N(9.02)=X_" S Y=X"
- End DoDot:1
- +7 ;Re-prompt TYPE
- DO CUNED(DICATT2N)
- +8 ;If no components, don't ask 'SUMS' question
- DO UNED^DDSUTL(82,"DICATT6",2.6,'$DATA(DICATT5N(9.02)))
- +9 QUIT
- +10 ;
- CUNED(S) ;also called by DICATTD
- +1 DO PUT^DDSVALF(79,"DICATT6",2.6,$$TYPE^DICATT3(S))
- +2 ;Make 'MANDATORY?',etc. uneditable
- NEW DICUNED
- FOR DICUNED=18,3,4,6,7,8,98,99
- DO UNED^DDSUTL(DICUNED,"DICATT",1,1)
- +3 QUIT
- +4 ;
- DICOMP SET A=DICATTA
- SET DA=DICATTF
- SET DICOMPX=""
- SET DICOMP="I"
- SET DICMX="X DICMX"
- +1 DO IJ^DIUTL(A)
- +2 DO ^DICOMP
- QUIT
- +3 ;
- +4 ;
- BR79 ;branch from TYPE
- +1 NEW A,S
- +2 DO UNED^DDSUTL(83.1,"DICATT6",2.6,X'["p")
- +3 SET A=""
- IF X["p"
- SET A=$PIECE($GET(DICATT2N),"p",2)
- if 'A
- SET A=$PIECE(DICATT2,"p",2)
- if A
- SET A=$PIECE($GET(^DIC(+A,0)),U)
- +4 DO PUT^DDSVALF(83.1,,,A)
- +5 SET S=X["D"!(X["B")!(X["m")!(X["p")
- +6 ;for DATE, BOOLEAN POINTER, & MULTIPLE, don't ask other questions
- FOR A=80:1:83
- DO UNED^DDSUTL(A,"DICATT6",2.6,S)
- IF S
- DO PUT^DDSVALF(A,,,"")
- +7 ;default length of field=8
- IF $$G(79)=""
- DO PUT^DDSVALF(83,,,8)
- +8 if X="N"
- QUIT
- +9 FOR A=80,81,82
- DO PUT^DDSVALF(A,,,"")
- DO UNED^DDSUTL(A,"DICATT6",2.6,1)
- +10 QUIT
- +11 ;
- +12 ;
- POST6 ;POST ACTION of Page 2.6
- +1 NEW T,I
- +2 IF $$G(82)=0
- KILL DICATT5N(9.02)
- +3 SET T=$$G(79)
- +4 FOR I="D","B","m","mp","p"
- IF T=I
- if T["p"
- SET T=T_$$G(83.1)
- SET DICATT2N="C"_T
- GOTO CHNGD
- +5 ;if numeric, get fractional digits
- SET I=""
- IF T="N"
- SET I=$$G(80)
- +6 ;length of field
- SET DICATT2N="CJ"_$$G(83)
- +7 SET T=" S X=$J(X,0,"
- +8 SET DICATT5N=$SELECT($DATA(DICATT5N)#2:DICATT5N,1:$PIECE(DICATT5,T))
- +9 IF I
- Begin DoDot:1
- +10 SET DICATT2N=DICATT2N_","_I
- +11 IF $$G(81)
- SET DICATT5N=DICATT5N_T_I_")"
- End DoDot:1
- CHNGD SET DICATTMN=""
- +1 ;don't ask multiple
- DO UNED^DDSUTL(20.5,"DICATT",1,1)
- +2 ;Computed Field is stored nowhere!
- SET DICATT4N=" ; "
- +3 QUIT
- +4 ;
- G(I) QUIT $$GET^DDSVALF(I,"DICATT6",2.6,"I","")