1 | YSD40060 ;DALISC/LJA - Restore Files Using Conversion File ;[ 07/13/94 2:38 PM ]
|
---|
2 | ;;5.01;MENTAL HEALTH;;Dec 30, 1994
|
---|
3 | ;;
|
---|
4 | ;
|
---|
5 | QUIT
|
---|
6 | ;
|
---|
7 | ALL ;
|
---|
8 | W !!,"The use of this option will restore the entries in the Medical Record,"
|
---|
9 | W !,"Diagnostic Results, and Generic Progress Notes files to their original"
|
---|
10 | W !,"condition. When this occurs, the Conversion file entry used during the"
|
---|
11 | W !,"restoration process will be deleted...",!!
|
---|
12 | W !!,"Note: Only those entries which have completed the initial conversion will be"
|
---|
13 | W !,"restored. (These entries have a status of <C>onverted.)",!!
|
---|
14 | N DIR
|
---|
15 | S DIR(0)="Y",DIR("A")="OK to start restoration process",DIR("B")="No"
|
---|
16 | D ^DIR
|
---|
17 | QUIT:+Y'=1 ;->
|
---|
18 | W !!,"Starting restoration..."
|
---|
19 | ;
|
---|
20 | K ^TMP($J) S (YSD4CT,YSD4GCT)=0
|
---|
21 | S YSD4CIEN=0
|
---|
22 | F S YSD4CIEN=$O(^YSD(627.99,YSD4CIEN)) QUIT:YSD4CIEN'>0 D RESTORE
|
---|
23 | ;
|
---|
24 | W !!,"Restoration complete..."
|
---|
25 | W !!,"# Progress Notes Restored: ",?40,$J($G(^TMP($J,"GPN")),6)
|
---|
26 | W !,"# Diagnostic Results Restored: ",?40,$J($G(^TMP($J,"DR")),6)
|
---|
27 | W !,"# Medical Records Restored: ",?40,$J($G(^TMP($J,"MR")),6)
|
---|
28 | K ^TMP($J)
|
---|
29 | QUIT
|
---|
30 | ONE ;
|
---|
31 | K ^TMP($J)
|
---|
32 | ONE1 ;
|
---|
33 | W !!
|
---|
34 | N DIR
|
---|
35 | S DIR(0)="N",DIR("A")="Enter Conversion file number"
|
---|
36 | D ^DIR
|
---|
37 | I +Y'>0 K ^TMP($J) QUIT ;->
|
---|
38 | S YSD4CIEN=+Y
|
---|
39 | I $G(^YSD(627.99,+YSD4CIEN,0))']"" D G ONE ;->
|
---|
40 | . W !,"No data found..."
|
---|
41 | D RESTORE
|
---|
42 | G ONE1
|
---|
43 | ;
|
---|
44 | RESTORE ; Restore entries to pre-conversion state...
|
---|
45 | ; YSD4CIEN -- required -- YSD4RFLG (Restored flag)
|
---|
46 | ;
|
---|
47 | ; Assume restoration failure. Set to 'success' at end...
|
---|
48 | S YSD4RFLG=0
|
---|
49 | S YSD4GCT=YSD4GCT+1 W:'(YSD4GCT#30) "."
|
---|
50 | ;
|
---|
51 | ; IEN passed?
|
---|
52 | I $G(YSD4CIEN)'>0 D QUIT ;->
|
---|
53 | . W !,"Entry number not available. Entry not restored!"
|
---|
54 | ;
|
---|
55 | ; OK. Now, restore...
|
---|
56 | S YSD40=$G(^YSD(627.99,+YSD4CIEN,0))
|
---|
57 | I YSD40?1.N1";GMR(121,"1"^"1U D GPN QUIT ;->
|
---|
58 | I YSD40?1.N1";YSD(627.8,"1"^"1U D DR^YSD40061 QUIT ;->
|
---|
59 | I YSD40?1.N1";MR("1"^"1U D MR^YSD40062 QUIT ;->
|
---|
60 | ;
|
---|
61 | ; Invalid 0 node!!
|
---|
62 | W !,"#",YSD4CIEN," has an invalid 0 node!!!"
|
---|
63 | ;
|
---|
64 | QUIT
|
---|
65 | ;
|
---|
66 | GPN ;
|
---|
67 | N YSD430,YSD4IEN
|
---|
68 | ;
|
---|
69 | ; Set Reference...
|
---|
70 | S YSD4REF=$P(YSD40,U)
|
---|
71 | ;
|
---|
72 | ; Quit if not Converted...
|
---|
73 | QUIT:$P(YSD40,U,2)'="C" ;->
|
---|
74 | ;
|
---|
75 | ; Plusing gives GPN's IEN
|
---|
76 | S YSD4IEN=+YSD40
|
---|
77 | ;
|
---|
78 | ; Get 30 node...
|
---|
79 | S YSD430=$G(^YSD(627.99,+YSD4CIEN,30))
|
---|
80 | ;
|
---|
81 | ; Quit if not valid DSM-III-R pointer...
|
---|
82 | QUIT:YSD430'["DIC(627.5," ;->
|
---|
83 | ;
|
---|
84 | ; OK. Reset GPN data. (No xrefs exist...)
|
---|
85 | S ^GMR(121,+YSD4IEN,30)=+YSD430_";DIC(627.5,"
|
---|
86 | ;
|
---|
87 | ; Delete Conversion entry
|
---|
88 | K ^YSD(627.99,+YSD4CIEN),^YSD(627.99,"B",YSD4REF,+YSD4CIEN)
|
---|
89 | S X=$P(^YSD(627.99,0),U,4)-1,X=$S(X>0:X,1:0),$P(^YSD(627.99,0),U,4)=X
|
---|
90 | ;
|
---|
91 | ; Up counter and "dot"
|
---|
92 | S ^TMP($J,"GPN")=$G(^TMP($J,"GPN"))+1
|
---|
93 | D DOT
|
---|
94 | ;
|
---|
95 | ; If any entries are restored, kill "GPN" nodes...
|
---|
96 | K ^YSD(627.99,"AS","GPN CONVERSION COMPLETED")
|
---|
97 | K ^YSD(627.99,"AS","GPN CONVERSION STARTED")
|
---|
98 | K ^YSD(627.99,"AS","GPN LAST STARTED")
|
---|
99 | K ^YSD(627.99,"AS","GPN NUMBER CONVERTED")
|
---|
100 | QUIT
|
---|
101 | ;
|
---|
102 | DOT ;
|
---|
103 | S YSD4CT=YSD4CT+1 W:'(YSD4CT#100) "."
|
---|
104 | QUIT
|
---|
105 | ;
|
---|
106 | EOR ;YSD40060 - Restore Files Using Conversion File ;12/7/93 15:12
|
---|