- DIU31 ;SFISC/GFT - UNEDITABLE, INPUT TRANS., OUTPUT TRANS. ;24OCT2016
- ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
- ;;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.
- ;;GFT;**127,1046,1051,MSC,1702**
- ;
- 9 ;
- S %=2,DA=+Y
- I $P(Y(0),U,2)["I" W !,$C(7),"FIELD IS ALREADY UNEDITABLE",!,"DO YOU WANT TO ALLOW EDITING AGAIN" D YN^DICN Q:%-1 S X=$P(^(0),U,2),^(0)=$P(^(0),U,1)_U_$P(X,"I",1)_$P(X,"I",2)_$P(X,"I",3)_U_$P(^(0),U,3,99) W " ..OK" S %=1 G 2
- W !,"WANT TO PREVENT ALL USERS FROM CHANGING OR DELETING DATA VALUES",!
- W "THAT ARE ENTERED FOR THE '"_$P(Y,U,2)_"' FIELD" D YN^DICN Q:%-1 S ^(0)=$P(^(0),U,1,2)_"I^"_$P(^(0),U,3,99) W $C(7),!?9,"...FIELD IS NOW UNEDITABLE!" S %=2
- 2 I $D(DDA) S A0="UNEDITABLE^",(A1,A2)="",@("A"_%)="I" D IT^DICATTA
- G DIEZ^DIU0
- ;
- 5 ;FROM 5+1^DIU
- I $P($P(Y(0),U,2),"t",2) D EXTENDED G Q
- W !,$P(Y,U,2) S DA=+Y,Y=$P(Y(0),U,5,99) S:$D(DDA) DDA=Y
- W " INPUT TRANSFORM: ",Y D RW^DIR2 G MORE:X="" S %=$L($P(Y(0),U,1,4))+$L(X) I %>244 W !!?5,$C(7),"Input Transform is TOO LONG by ",%-244," characters.",! K X S Y=DA_U_$P(Y(0),U) G 5
- I $P(Y(0),U,2)["K",X'[" ^DIM" K X S Y=DA_U_$P(Y(0),U) W $C(7),!?5,"Input Transform must contain D ^DIM",! G 5
- I $P(Y(0),U,2)["F",X["DINUM" W $C(7),!?5,"DINUM on a Freetext field can cause database",!?5,"problems unless you are sure DINUM is numeric."
- D ^DIM I '$D(X) W $C(7),"??" S Y=DA_U_$P(Y(0),U) G 5
- S ^DD(DI,DA,0)=$P(Y(0),U,1,2)_$E("X",$P(Y(0),U,2)'["X")_U_$P(Y(0),U,3,4)_U_X
- I $D(DDA),DDA'=X S A0="INPUT TRANSFORM^.5",A1=DDA,A2=X D IT^DICATTA
- I $P(Y(0),U,2)["C" D PZ^DIU0 G Q
- MORE I $P(Y(0),U,2)["C" G Q
- S DIE=DIC,DR="3:4" I $P(Y(0),U,2)["P" S %=$F(X," D ^DIC") I % S X=$E(X,1,%-8),%=$F(X,"DIC(""S"")=") I % S X=$E(X,%-9,$L(X)),^(12.1)="S "_X,DR=DR_";12EXPLANATION OF SCREEN"
- F %=3,4,12.1 S:$D(^DD(DI,DA,%)) ^UTILITY("DDA",$J,DI,DA,%)=^(%)
- D D IT1^DICATTA,DIEZ^DIU0,LENGTH^DICATT2(DI,DA) G Q
- .N DI D ^DIE
- ;
- O ;FROM 7+1^DIU
- I $P($P(Y(0),U,2),"t",2) D EXTENDED G Q
- S DIK=1,DJJ=+Y W !,$P(Y,U,2)_" OUTPUT TRANSFORM: "
- I '$D(^DD(DI,DJJ,2)) R X:DTIME I '$T S DTOUT=1 G Q
- I $D(^(2)) S (DIK,Y)=^(2) S:$D(DDA) DDA=Y S:$D(^(2.1)) Y=^(2.1) W Y D RW^DIR2 I X="@" W !?9,"DELETED!" K ^DD(DI,DJJ,2),^(2.1) S Y=$P(^(0),U,2),$P(^(0),U,2)=$P(Y,"O")_$P(Y,"O",2),%="" G EX
- G Q:X="" I X?."?" S Y=DJJ_U_$P(^(0),U) W !?4,"Enter a computed-field expression using '"_$P(Y,U,2)_"'",! W:DUZ(0)="@" ?4,"or MUMPS code that takes Y and transforms it to a different Y.",! G O
- K ^DD(DI,DJJ,2) S DICOMPX(1,DI,DJJ)="Y(0)",DA=DIC_DJJ_",2,",DGG=X,DQI="Y(" ;!!!!! NAKED ^(2) KILLED ^DD(2)!!!!!
- D ^DICOMP K DQI,DICOMPX F %=9.2:.1 Q:'$D(X(%)) S @(DA_"%)=X(%)")
- I $D(X) S ^DD(DI,DJJ,2)="S Y(0)=Y "_X_$P(" S Y=X",U,Y'["X"),^(2.1)=DGG S:$P(^(0),U,2)'["O" $P(^(0),U,2)=$P(^(0),U,2)_"O" S %=^(2) G EX
- S:'DIK ^DD(DI,DJJ,2)=DIK
- X W $C(7),"??" Q
- ;
- EX S DA=DJJ I $D(DDA),DDA'=% S A1=DDA,A2=%,A0="OUTPUT TRANSFORM^2" D IT^DICATTA ;AUDIT CHANGE TO OUTPUT TRANSFORM
- D PZ^DIU0
- Q G Q^DIU
- ;
- ;
- ;
- EXTENDED W !!,"THIS FIELD IS DEFINED AS AN EXTENDED DATA TYPE (",$P($G(^DI(.81,+$P($P(Y(0),U,2),"t",2),0)),U),")."
- W !,"ITS INPUT AND OUTPUT TRANSFORMS ARE PART OF THE DEFINITION OF THAT DATA TYPE." Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIU31 3402 printed Feb 19, 2025@00:20:53 Page 2
- DIU31 ;SFISC/GFT - UNEDITABLE, INPUT TRANS., OUTPUT TRANS. ;24OCT2016
- +1 ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
- +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 ;;GFT;**127,1046,1051,MSC,1702**
- +7 ;
- 9 ;
- +1 SET %=2
- SET DA=+Y
- +2 IF $PIECE(Y(0),U,2)["I"
- WRITE !,$CHAR(7),"FIELD IS ALREADY UNEDITABLE",!,"DO YOU WANT TO ALLOW EDITING AGAIN"
- DO YN^DICN
- if %-1
- QUIT
- SET X=$PIECE(^(0),U,2)
- SET ^(0)=$PIECE(^(0),U,1)_U_$PIECE(X,"I",1)_$PIECE(X,"I",2)_$PIECE(X,"I",3)_U_$PIECE(^(0),U,3,99)
- WRITE " ..OK"
- SET %=1
- GOTO 2
- +3 WRITE !,"WANT TO PREVENT ALL USERS FROM CHANGING OR DELETING DATA VALUES",!
- +4 WRITE "THAT ARE ENTERED FOR THE '"_$PIECE(Y,U,2)_"' FIELD"
- DO YN^DICN
- if %-1
- QUIT
- SET ^(0)=$PIECE(^(0),U,1,2)_"I^"_$PIECE(^(0),U,3,99)
- WRITE $CHAR(7),!?9,"...FIELD IS NOW UNEDITABLE!"
- SET %=2
- 2 IF $DATA(DDA)
- SET A0="UNEDITABLE^"
- SET (A1,A2)=""
- SET @("A"_%)="I"
- DO IT^DICATTA
- +1 GOTO DIEZ^DIU0
- +2 ;
- 5 ;FROM 5+1^DIU
- +1 IF $PIECE($PIECE(Y(0),U,2),"t",2)
- DO EXTENDED
- GOTO Q
- +2 WRITE !,$PIECE(Y,U,2)
- SET DA=+Y
- SET Y=$PIECE(Y(0),U,5,99)
- if $DATA(DDA)
- SET DDA=Y
- +3 WRITE " INPUT TRANSFORM: ",Y
- DO RW^DIR2
- if X=""
- GOTO MORE
- SET %=$LENGTH($PIECE(Y(0),U,1,4))+$LENGTH(X)
- IF %>244
- WRITE !!?5,$CHAR(7),"Input Transform is TOO LONG by ",%-244," characters.",!
- KILL X
- SET Y=DA_U_$PIECE(Y(0),U)
- GOTO 5
- +4 IF $PIECE(Y(0),U,2)["K"
- IF X'[" ^DIM"
- KILL X
- SET Y=DA_U_$PIECE(Y(0),U)
- WRITE $CHAR(7),!?5,"Input Transform must contain D ^DIM",!
- GOTO 5
- +5 IF $PIECE(Y(0),U,2)["F"
- IF X["DINUM"
- WRITE $CHAR(7),!?5,"DINUM on a Freetext field can cause database",!?5,"problems unless you are sure DINUM is numeric."
- +6 DO ^DIM
- IF '$DATA(X)
- WRITE $CHAR(7),"??"
- SET Y=DA_U_$PIECE(Y(0),U)
- GOTO 5
- +7 SET ^DD(DI,DA,0)=$PIECE(Y(0),U,1,2)_$EXTRACT("X",$PIECE(Y(0),U,2)'["X")_U_$PIECE(Y(0),U,3,4)_U_X
- +8 IF $DATA(DDA)
- IF DDA'=X
- SET A0="INPUT TRANSFORM^.5"
- SET A1=DDA
- SET A2=X
- DO IT^DICATTA
- +9 IF $PIECE(Y(0),U,2)["C"
- DO PZ^DIU0
- GOTO Q
- MORE IF $PIECE(Y(0),U,2)["C"
- GOTO Q
- +1 SET DIE=DIC
- SET DR="3:4"
- IF $PIECE(Y(0),U,2)["P"
- SET %=$FIND(X," D ^DIC")
- IF %
- SET X=$EXTRACT(X,1,%-8)
- SET %=$FIND(X,"DIC(""S"")=")
- IF %
- SET X=$EXTRACT(X,%-9,$LENGTH(X))
- SET ^(12.1)="S "_X
- SET DR=DR_";12EXPLANATION OF SCREEN"
- +2 FOR %=3,4,12.1
- if $DATA(^DD(DI,DA,%))
- SET ^UTILITY("DDA",$JOB,DI,DA,%)=^(%)
- +3 Begin DoDot:1
- +4 NEW DI
- DO ^DIE
- End DoDot:1
- DO IT1^DICATTA
- DO DIEZ^DIU0
- DO LENGTH^DICATT2(DI,DA)
- GOTO Q
- +5 ;
- O ;FROM 7+1^DIU
- +1 IF $PIECE($PIECE(Y(0),U,2),"t",2)
- DO EXTENDED
- GOTO Q
- +2 SET DIK=1
- SET DJJ=+Y
- WRITE !,$PIECE(Y,U,2)_" OUTPUT TRANSFORM: "
- +3 IF '$DATA(^DD(DI,DJJ,2))
- READ X:DTIME
- IF '$TEST
- SET DTOUT=1
- GOTO Q
- +4 IF $DATA(^(2))
- SET (DIK,Y)=^(2)
- if $DATA(DDA)
- SET DDA=Y
- if $DATA(^(2.1))
- SET Y=^(2.1)
- WRITE Y
- DO RW^DIR2
- IF X="@"
- WRITE !?9,"DELETED!"
- KILL ^DD(DI,DJJ,2),^(2.1)
- SET Y=$PIECE(^(0),U,2)
- SET $PIECE(^(0),U,2)=$PIECE(Y,"O")_$PIECE(Y,"O",2)
- SET %=""
- GOTO EX
- +5 if X=""
- GOTO Q
- IF X?."?"
- SET Y=DJJ_U_$PIECE(^(0),U)
- WRITE !?4,"Enter a computed-field expression using '"_$PIECE(Y,U,2)_"'",!
- if DUZ(0)="@"
- WRITE ?4,"or MUMPS code that takes Y and transforms it to a different Y.",!
- GOTO O
- +6 ;!!!!! NAKED ^(2) KILLED ^DD(2)!!!!!
- KILL ^DD(DI,DJJ,2)
- SET DICOMPX(1,DI,DJJ)="Y(0)"
- SET DA=DIC_DJJ_",2,"
- SET DGG=X
- SET DQI="Y("
- +7 DO ^DICOMP
- KILL DQI,DICOMPX
- FOR %=9.2:.1
- if '$DATA(X(%))
- QUIT
- SET @(DA_"%)=X(%)")
- +8 IF $DATA(X)
- SET ^DD(DI,DJJ,2)="S Y(0)=Y "_X_$PIECE(" S Y=X",U,Y'["X")
- SET ^(2.1)=DGG
- if $PIECE(^(0),U,2)'["O"
- SET $PIECE(^(0),U,2)=$PIECE(^(0),U,2)_"O"
- SET %=^(2)
- GOTO EX
- +9 if 'DIK
- SET ^DD(DI,DJJ,2)=DIK
- X WRITE $CHAR(7),"??"
- QUIT
- +1 ;
- EX ;AUDIT CHANGE TO OUTPUT TRANSFORM
- SET DA=DJJ
- IF $DATA(DDA)
- IF DDA'=%
- SET A1=DDA
- SET A2=%
- SET A0="OUTPUT TRANSFORM^2"
- DO IT^DICATTA
- +1 DO PZ^DIU0
- Q GOTO Q^DIU
- +1 ;
- +2 ;
- +3 ;
- EXTENDED WRITE !!,"THIS FIELD IS DEFINED AS AN EXTENDED DATA TYPE (",$PIECE($GET(^DI(.81,+$PIECE($PIECE(Y(0),U,2),"t",2),0)),U),")."
- +1 WRITE !,"ITS INPUT AND OUTPUT TRANSFORMS ARE PART OF THE DEFINITION OF THAT DATA TYPE."
- QUIT
