DICATT2 ;SFISC/GFT,XAK-DEFINING MULTIPLES ;9APR2007
;;22.0;VA FileMan;**89,152**;Mar 30, 1999;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
S T=$E(Z) G CHECK^DICATT:$D(DTOUT)
F P="I","O","L","x" S:$P(O,U,2)[P Z=$P(Z,U)_P_U_$P(Z,U,2)
1 K DS S:$P(Z,U)'["K" V=W[";0"
S P=0,N=DICL,DQ=4,DP=6,DQI=" S:$D(X) DINUM=+X",DREF=$F(O,DQI)-1=$L(O),DE(7,0)="NO",DG(7)="N"
S:T="*" T=$S($P(Z,U)["S":"S",1:"P") G 1^DICATT22:DA=.001
G W:T="W" S:$D(DTIME)[0 DTIME=300
I T'["F",T'["S",T'["K",'O!DREF S:DREF DE(7,0)="YES",DG(7)="Y"
S F Y=4:1:6 S DQ(Y)=$P($T(DQ+Y),";",3)_F_$P($T(DQ+Y),";",4)_" (Y/N)^RS^Y:YES;N:NO^"_Y_"^Q" I 'V,DA-.01!'N Q
S DG(5)="Y",DE(4,0)="NO",DP=-1,DL=1
I T["P"!(T["N") S DE(5,0)="YES"
I O S DE(6,0)=$E("NY",$P(O,U,2)["M"+1) S:$P(O,U,2)["R" DE(4,0)="Y" I DA=.01,N S P=$O(^DD(J(N-1),"SB",A,0)) S:P="" P=-1 S Y=$P(^DD(J(N-1),P,0),U,2),DE(5,0)=$E("YN",Y["A"+1)
K Y S DIFLD=-1 D RE^DIED K DQ,DIFLD G:$D(Y) N^DICATT:$P(Z,U)["X",CHECK^DICATT I $D(DTOUT) K DTOUT G CHECK^DICATT
S:DG(5)="N" T=T_"A" I DG(4)="Y",$P(Z,U)'["R" S Z="R"_Z
I $D(DG(6)),DG(6)="Y",$P(Z,U)'["M" S Z="M"_Z
G S DIZ=Z G ^DICATT22
Q ;
K T,B,A,J,DA,DIC,E,DR,W,S,Q,P,N,V,I,L,F,DQI,DIK,C,Z,Y,DE,O,DICS,DICL,DDA Q
;
W S %=Z["L"+1 W !,"SHALL THIS TEXT NORMALLY APPEAR IN WORD-WRAP MODE" D YN^DICN
G CHECK^DICATT:%<0 I % S Z=$P($TR(Z,"L"),U)_$E("L",%=2)_U G WINDOW
W !,"ANSWER 'YES' IF THE INTERNALLY-STORED '"_F_"' TEXT"
W !?5,"SHOULD NORMALLY BE PRINTED OUT IN FULL LINES, BREAKING AT WORD BOUNDARIES."
W !?2,"ANSWER 'NO' IF THE INTERNAL TEXT SHOULD NORMALLY BE PRINTED OUT"
W !?5,"LINE-FOR-LINE AS IT STANDS.",! G W
;
;
WINDOW S %=2-(Z["x"!'O) W !,"SHALL ""|"" CHARACTERS IN THIS TEXT BE TREATED LIKE ANY OTHER CHARACTERS" D YN^DICN
G CHECK^DICATT:%<0 I % S Z=$P($TR(Z,"x"),U)_$E("x",%=1)_U G G
W !,"ANSWER 'YES' IF THE INTERNALLY-STORED '"_F_"' TEXT MAY HAVE ""|"" CHARACTERS"
W !?3,"IN IT (SUCH AS HL7 MESSAGES) THAT NEED TO DISPLAY EXACTLY AS THEY ARE STORED."
W !,"ANSWER 'NO' IF THE INTERNAL TEXT SHOULD NORMALLY BE PRINTED OUT WITH ANYTHING"
W !?3,"THAT IS DELIMITED BY ""|"" CHARACTERS INTERPRETED AS VARIABLE TEXT.",! G WINDOW
;
;
;
X ;
W " (FIELD DEFINITION IS NOT EDITABLE)" S T=$E(^(0)),Z=$P(Y,U,2),Z=$P(Z,"M")_$P(Z,"M",2),Z=$P(Z,"R")_$P(Z,"R",2)_U_$P(Y,U,3),W=$P(Y,U,4),C=$P(Y,U,5,99) S:Z["K" V=0 G N^DICATT:N=6,1
;
NO ;
W !,$C(7)," <DATA DEFINITION UNCHANGED>" I $P(Z,U)["K"&(DUZ(0)'="@") G N^DICATT
TYPE K Y,M,DE,DIE,DQ,DG G Q^DIB:$D(DTOUT) S N=0,DQI=DICL+9,Y=^DD(A,DA,0),F=$P(Y,U),Z="" W !!,"DATA TYPE OF ",F,": " I 'O R X:DTIME S:'$T DTOUT=1 G X^DICATT:X[U!'$T S:DUZ(0)'="@" DIC("S")="I Y-9" S:DA=.001 DIC("S")="I Y<4!(Y=7)" G NEW
F N=9:-1:5,1:1:4 Q:$P(Y,U,2)[$E("DNSFWCPVK",N)
W $P(^DOPT("DICATT",N,0),U) G X:$P(Y,U,2)["K"&(DUZ(0)'="@")
G X:$P(Y,U,2)["X",6^DICATT:N=6 R "// ",X:DTIME S:'$T DTOUT=1 G N^DICATT:X[U!'$T,0^DICATT:X="" S DIC("S")="I Y-6,Y-9"_$P(",Y-5",U,N\2-2!(A=B)!(DA-.01)!$O(^DD(A,DA))>0),DIC("S")=DIC("S")_$S(N=7:",Y-8",N=8:",Y-7",1:"")
NEW I 'O,X=" ",E,$P(^DD(A,E,0),U,2)'["P",$P(^(0),U,2)'["V" W " <",$C(7) D E^DICATT W " DUPLICATED>" S DIZ=$S($D(DIZ):DIZ,1:DIZZ) G E^DICATT1
S DIC(0)="QEI",DIC="^DOPT(""DICATT""," D ^DIC I Y>0 S:N-Y&O M="",O=$P(O,U,1,2)_U_U_$P(O,U,4) S N=+Y G 0^DICATT
I 'O,X["?",E,$P(^DD(A,E,0),U,2)'["P",$P(^(0),U,2)'["V" D DICATT^DIQQQ,E^DICATT W ", JUST HIT THE SPACE KEY"
G TYPE
;
DQ ;;
;
;
;
;;IS ; ENTRY MANDATORY
;;SHOULD USER SEE AN "ADDING A NEW ;?" MESSAGE FOR NEW ENTRIES
;;HAVING ENTERED OR EDITED ONE ;, SHOULD USER BE ASKED ANOTHER
DICATT2 ;SFISC/GFT,XAK-DEFINING MULTIPLES ;9APR2007
+1 ;;22.0;VA FileMan;**89,152**;Mar 30, 1999;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 SET T=$EXTRACT(Z)
IF $DATA(DTOUT)
GOTO CHECK^DICATT
+4 FOR P="I","O","L","x"
IF $PIECE(O,U,2)[P
SET Z=$PIECE(Z,U)_P_U_$PIECE(Z,U,2)
1 KILL DS
IF $PIECE(Z,U)'["K"
SET V=W[";0"
+1 SET P=0
SET N=DICL
SET DQ=4
SET DP=6
SET DQI=" S:$D(X) DINUM=+X"
SET DREF=$FIND(O,DQI)-1=$LENGTH(O)
SET DE(7,0)="NO"
SET DG(7)="N"
+2 IF T="*"
SET T=$SELECT($PIECE(Z,U)["S":"S",1:"P")
IF DA=.001
GOTO 1^DICATT22
+3 IF T="W"
GOTO W
IF $DATA(DTIME)[0
SET DTIME=300
+4 IF T'["F"
IF T'["S"
IF T'["K"
IF 'O!DREF
IF DREF
SET DE(7,0)="YES"
SET DG(7)="Y"
S FOR Y=4:1:6
SET DQ(Y)=$PIECE($TEXT(DQ+Y),";",3)_F_$PIECE($TEXT(DQ+Y),";",4)_" (Y/N)^RS^Y:YES;N:NO^"_Y_"^Q"
IF 'V
IF DA-.01!'N
QUIT
+1 SET DG(5)="Y"
SET DE(4,0)="NO"
SET DP=-1
SET DL=1
+2 IF T["P"!(T["N")
SET DE(5,0)="YES"
+3 IF O
SET DE(6,0)=$EXTRACT("NY",$PIECE(O,U,2)["M"+1)
IF $PIECE(O,U,2)["R"
SET DE(4,0)="Y"
IF DA=.01
IF N
SET P=$ORDER(^DD(J(N-1),"SB",A,0))
IF P=""
SET P=-1
SET Y=$PIECE(^DD(J(N-1),P,0),U,2)
SET DE(5,0)=$EXTRACT("YN",Y["A"+1)
+4 KILL Y
SET DIFLD=-1
DO RE^DIED
KILL DQ,DIFLD
IF $DATA(Y)
IF $PIECE(Z,U)["X"
GOTO N^DICATT
GOTO CHECK^DICATT
IF $DATA(DTOUT)
KILL DTOUT
GOTO CHECK^DICATT
+5 IF DG(5)="N"
SET T=T_"A"
IF DG(4)="Y"
IF $PIECE(Z,U)'["R"
SET Z="R"_Z
+6 IF $DATA(DG(6))
IF DG(6)="Y"
IF $PIECE(Z,U)'["M"
SET Z="M"_Z
G SET DIZ=Z
GOTO ^DICATT22
Q ;
+1 KILL T,B,A,J,DA,DIC,E,DR,W,S,Q,P,N,V,I,L,F,DQI,DIK,C,Z,Y,DE,O,DICS,DICL,DDA
QUIT
+2 ;
W SET %=Z["L"+1
WRITE !,"SHALL THIS TEXT NORMALLY APPEAR IN WORD-WRAP MODE"
DO YN^DICN
+1 IF %<0
GOTO CHECK^DICATT
IF %
SET Z=$PIECE($TRANSLATE(Z,"L"),U)_$EXTRACT("L",%=2)_U
GOTO WINDOW
+2 WRITE !,"ANSWER 'YES' IF THE INTERNALLY-STORED '"_F_"' TEXT"
+3 WRITE !?5,"SHOULD NORMALLY BE PRINTED OUT IN FULL LINES, BREAKING AT WORD BOUNDARIES."
+4 WRITE !?2,"ANSWER 'NO' IF THE INTERNAL TEXT SHOULD NORMALLY BE PRINTED OUT"
+5 WRITE !?5,"LINE-FOR-LINE AS IT STANDS.",!
GOTO W
+6 ;
+7 ;
WINDOW SET %=2-(Z["x"!'O)
WRITE !,"SHALL ""|"" CHARACTERS IN THIS TEXT BE TREATED LIKE ANY OTHER CHARACTERS"
DO YN^DICN
+1 IF %<0
GOTO CHECK^DICATT
IF %
SET Z=$PIECE($TRANSLATE(Z,"x"),U)_$EXTRACT("x",%=1)_U
GOTO G
+2 WRITE !,"ANSWER 'YES' IF THE INTERNALLY-STORED '"_F_"' TEXT MAY HAVE ""|"" CHARACTERS"
+3 WRITE !?3,"IN IT (SUCH AS HL7 MESSAGES) THAT NEED TO DISPLAY EXACTLY AS THEY ARE STORED."
+4 WRITE !,"ANSWER 'NO' IF THE INTERNAL TEXT SHOULD NORMALLY BE PRINTED OUT WITH ANYTHING"
+5 WRITE !?3,"THAT IS DELIMITED BY ""|"" CHARACTERS INTERPRETED AS VARIABLE TEXT.",!
GOTO WINDOW
+6 ;
+7 ;
+8 ;
X ;
+1 WRITE " (FIELD DEFINITION IS NOT EDITABLE)"
SET T=$EXTRACT(^(0))
SET Z=$PIECE(Y,U,2)
SET Z=$PIECE(Z,"M")_$PIECE(Z,"M",2)
SET Z=$PIECE(Z,"R")_$PIECE(Z,"R",2)_U_$PIECE(Y,U,3)
SET W=$PIECE(Y,U,4)
SET C=$PIECE(Y,U,5,99)
IF Z["K"
SET V=0
IF N=6
GOTO N^DICATT
GOTO 1
+2 ;
NO ;
+1 WRITE !,$CHAR(7)," <DATA DEFINITION UNCHANGED>"
IF $PIECE(Z,U)["K"&(DUZ(0)'="@")
GOTO N^DICATT
TYPE KILL Y,M,DE,DIE,DQ,DG
IF $DATA(DTOUT)
GOTO Q^DIB
SET N=0
SET DQI=DICL+9
SET Y=^DD(A,DA,0)
SET F=$PIECE(Y,U)
SET Z=""
WRITE !!,"DATA TYPE OF ",F,": "
IF 'O
READ X:DTIME
IF '$TEST
SET DTOUT=1
IF X[U!'$TEST
GOTO X^DICATT
IF DUZ(0)'="@"
SET DIC("S")="I Y-9"
IF DA=.001
SET DIC("S")="I Y<4!(Y=7)"
GOTO NEW
+1 FOR N=9:-1:5,1:1:4
IF $PIECE(Y,U,2)[$EXTRACT("DNSFWCPVK",N)
QUIT
+2 WRITE $PIECE(^DOPT("DICATT",N,0),U)
IF $PIECE(Y,U,2)["K"&(DUZ(0)'="@")
GOTO X
+3 IF $PIECE(Y,U,2)["X"
GOTO X
IF N=6
GOTO 6^DICATT
READ "// ",X:DTIME
IF '$TEST
SET DTOUT=1
IF X[U!'$TEST
GOTO N^DICATT
IF X=""
GOTO 0^DICATT
SET DIC("S")="I Y-6,Y-9"_$PIECE(",Y-5",U,N\2-2!(A=B)!(DA-.01)!$ORDER(^DD(A,DA))>0)
SET DIC("S")=DIC("S")_$SELECT(N=7:",Y-8",N=8:",Y-7",1:"")
NEW IF 'O
IF X=" "
IF E
IF $PIECE(^DD(A,E,0),U,2)'["P"
IF $PIECE(^(0),U,2)'["V"
WRITE " <",$CHAR(7)
DO E^DICATT
WRITE " DUPLICATED>"
SET DIZ=$SELECT($DATA(DIZ):DIZ,1:DIZZ)
GOTO E^DICATT1
+1 SET DIC(0)="QEI"
SET DIC="^DOPT(""DICATT"","
DO ^DIC
IF Y>0
IF N-Y&O
SET M=""
SET O=$PIECE(O,U,1,2)_U_U_$PIECE(O,U,4)
SET N=+Y
GOTO 0^DICATT
+2 IF 'O
IF X["?"
IF E
IF $PIECE(^DD(A,E,0),U,2)'["P"
IF $PIECE(^(0),U,2)'["V"
DO DICATT^DIQQQ
DO E^DICATT
WRITE ", JUST HIT THE SPACE KEY"
+3 GOTO TYPE
+4 ;
DQ ;;
+1 ;
+2 ;
+3 ;
+4 ;;IS ; ENTRY MANDATORY
+5 ;;SHOULD USER SEE AN "ADDING A NEW ;?" MESSAGE FOR NEW ENTRIES
+6 ;;HAVING ENTERED OR EDITED ONE ;, SHOULD USER BE ASKED ANOTHER
