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 Dec 13, 2024@02:54:38 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
