source: FOIAVistA/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIEKMSG.m@ 897

Last change on this file since 897 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1DIEKMSG ;SFISC/MKO-PRINT MESSAGE ABOUT BAD KEYS ;12:47 PM 18 Feb 1998
2 ;;22.0;VA FileMan;;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4MSG(DIEBADK,DIEREST) ;Print message
5 Q:$D(DIEBADK)<2
6 ;
7 N ANS,FIL,FINFO,FLD,KEY,LEV,MSG,NEW,OLD,REC,RFIL,TXT,DIERR
8 K ^TMP("DIEMSG",$J)
9 ;
10 D PROMPT(DIEREST,.ANS) Q:'ANS
11 ;
12 W !
13 I DIEREST D
14 . D L("The following field(s) have been restored to their pre-edited values:")
15 E D L("The following field values are not valid:")
16 D L("")
17 ;
18 ;Loop through root files
19 S RFIL=0 F S RFIL=$O(DIEBADK(RFIL)) Q:'RFIL D
20 . D FILENAME^DIKCU1(RFIL,.TXT,.FINFO) Q:'$D(FINFO)
21 . D FILELN(.TXT,FINFO)
22 . ;
23 . ;Loop through keys
24 . S KEY=0 F S KEY=$O(DIEBADK(RFIL,KEY)) Q:'KEY D
25 .. D L(" Key: "_$P(^DD("KEY",KEY,0),U,2))
26 .. ;
27 .. ;Loop through files
28 .. S FIL=0 F S FIL=$O(DIEBADK(RFIL,KEY,FIL)) Q:'FIL D
29 ... ;
30 ... ;Loop through records
31 ... S REC=0 F S REC=$O(DIEBADK(RFIL,KEY,FIL,REC)) Q:'REC D
32 .... D RECNAME^DIKCU1("",REC,.TXT,.FINFO)
33 .... D RECLN(.TXT,FINFO)
34 .... ;
35 .... ;Loop through fields
36 .... S FLD=0 F S FLD=$O(DIEBADK(RFIL,KEY,FIL,REC,FLD)) Q:'FLD D
37 ..... S OLD=$G(DIEBADK(RFIL,KEY,FIL,REC,FLD,"O"))
38 ..... S NEW=$G(DIEBADK(RFIL,KEY,FIL,REC,FLD,"N"))
39 ..... S OLD=$S(OLD]"":$$EXTERNAL^DILFD(FIL,FLD,"",OLD,"MSG"),1:"<null>")
40 ..... S NEW=$S(NEW]"":$$EXTERNAL^DILFD(FIL,FLD,"",NEW,"MSG"),1:"<null>")
41 ..... I $G(DIERR) K DIERR,MSG Q
42 ..... D L("")
43 ..... D L($J("",14)_"Field: "_$P(^DD(FIL,FLD,0),U)_" (#"_FLD_")")
44 ..... D L($J("",6)_"Invalid value: "),L(NEW,1,21)
45 ..... D:$G(DIEREST) L($J("",8)_"Restored to: "),L(OLD,1,21)
46 .... D L("")
47 ;
48 I $D(^TMP("DIEMSG",$J)) D PRINT
49 K ^TMP("DIEMSG",$J)
50 Q
51 ;
52FILELN(TXT,LEV) ;
53 N I,MAR
54 S MAR=$S($G(IOM)<40:80,1:IOM)-1
55 ;
56 S TXT=$S(LEV:"Subfile",1:"File")_": "_TXT
57 D WRAP^DIKCU2(.TXT,MAR-9,MAR)
58 D L(TXT) F I=1:1 Q:'$D(TXT(I)) D L($J("",9)_TXT(I))
59 Q
60 ;
61RECLN(TXT,LEV) ;
62 N I,MAR
63 S MAR=$S($G(IOM)<40:80,1:IOM)-1
64 ;
65 S TXT=" Record: "_TXT
66 D WRAP^DIKCU2(.TXT,MAR-12,MAR)
67 D L(TXT) F I=1:1 Q:'$D(TXT(I)) D L($J("",12)_TXT(I))
68 Q
69 ;
70L(X,A,LM) ;Add X to the DIEMSG array
71 N LC
72 S LC=$O(^TMP("DIEMSG",$J,""),-1)
73 ;
74 I '$G(LM) D Q
75 . I '$G(A) S ^TMP("DIEMSG",$J,LC+1)=X
76 . E S ^(LC)=^TMP("DIEMSG",$J,LC)_X
77 ;
78 N I,M,T
79 S M=$S($G(IOM)<40:80,1:IOM)-1 S:M'>LM LM=0
80 F I=1:1 D Q:X=""
81 . S T=$E(X,1,M-LM),X=$E(X,M-LM+1,999)
82 . I I=1,$G(A) S ^(LC)=^TMP("DIEMSG",$J,LC)_T
83 . E S LC=LC+1,^TMP("DIEMSG",$J,LC)=$J("",LM)_T
84 Q
85 ;
86PRINT ;Print lines stored in ^TMP("DIEMSG",$J)
87 N I,LC,SL
88 S SL=$S($G(IOSL)<4:24,1:IOSL)
89 S (I,LC)=0 F S I=$O(^TMP("DIEMSG",$J,I)) Q:'I D
90 . S LC=LC+1
91 . W ^TMP("DIEMSG",$J,I),!
92 . I LC'<(SL-2) D
93 .. N DIR,DUOUT,DTOUT,DIRUT,DIROUT,X,Y
94 .. S DIR(0)="E" D ^DIR W !!
95 .. S LC=0
96 Q
97 ;
98PROMPT(DIEREST,ANS) ;Ask user whether to print report
99 N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT
100 W !!,$C(7)_"***** NOTE *****"
101 W !!,"Some of the previous edits are not valid because they create one or more"
102 W !,"duplicate keys."
103 I $G(DIEREST) D
104 . W " Some fields have been restored to their pre-edited"
105 . W !,"values."
106 W !
107 ;
108 S DIR(0)="Y",DIR("B")="YES"
109 S DIR("A")="Do you want to see a list of those fields"
110 D ^DIR W !
111 S ANS=Y=1
112 Q
Note: See TracBrowser for help on using the repository browser.