source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSD40062.m@ 619

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1YSD40062 ;DALISC/LJA - Restore Medical Records ; [ 07/13/94 2:06 PM ]
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;;
4 ;
5MR ;
6 ; YSD40, YSD4CIEN -- req
7 ;
8 ; Counter variable
9 S (YSD4CT,YSD4GCT)=0
10 ; Quit if not Converted...
11 QUIT:$P(YSD40,U,2)'="C" ;->
12 ;
13 ; If any entries are restored, kill "MR" nodes...
14 K ^YSD(627.99,"AS","MR CONVERSION COMPLETED")
15 K ^YSD(627.99,"AS","MR CONVERSION STARTED")
16 K ^YSD(627.99,"AS","MR LAST STARTED")
17 K ^YSD(627.99,"AS","MR NUMBER CONVERTED")
18 ;
19 ; Set needed vars for xrefs, etc
20 S YSD4REF=$P(YSD40,U) ;Reference to Medical Record
21 S YSD4IEN=+YSD4REF ;Medical Record's IEN
22 ;
23 ; Loop thru nodes...
24 S YSD4NODE=0,YSD4CT=0
25 F S YSD4NODE=$O(^YSD(627.99,+YSD4CIEN,YSD4NODE)) QUIT:'$$OKNODE(YSD4NODE) D
26 . S YSD4CT=YSD4CT+1 W:'(YSD4CT#50) "."
27 . D @YSD4NODE
28 K ^YSD(627.99,+YSD4CIEN)
29 K ^YSD(627.99,"B",YSD4REF,+YSD4CIEN)
30 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
31 ;
32 ; Up counter and dot
33 S ^TMP($J,"MR")=$G(^TMP($J,"MR"))+1
34 S YSD4GCT=YSD4GCT+1 W:'(YSD4GCT#50) "."
35 ;
36 QUIT
37 ;
38DX ;
39 S YSD4DXNO=0
40 F S YSD4DXNO=$O(^YSD(627.99,+YSD4CIEN,"DX",YSD4DXNO)) QUIT:YSD4DXNO'>0 D
41 . S YSD4ODX=$G(^YSD(627.99,+YSD4CIEN,"DX",+YSD4DXNO,0))
42 . QUIT:YSD4ODX']"" ;->
43 . S YSD4NDX=$P($G(^MR(+YSD4IEN,"DX",+YSD4DXNO,0)),U)
44 . QUIT:YSD4NDX']"" ;->
45 . K ^MR(+YSD4IEN,"DX","B",+YSD4NDX,+YSD4DXNO)
46 . S ^MR(+YSD4IEN,"DX","B",+YSD4ODX,+YSD4DXNO)=""
47 . S $P(^MR(+YSD4IEN,"DX",+YSD4DXNO,0),U)=YSD4ODX
48 . K ^YSD(627.99,+YSD4CIEN,"DX",+YSD4DXNO)
49 QUIT
50 ;
51DX1 ;
52 S YSD4ODX1=$G(^YSD(627.99,+YSD4CIEN,"DX1"))
53 QUIT:$P(YSD4ODX1,U,2)']""&($P(YSD4ODX1,U,4)']"") ;->
54 F YSD4P=2,4 D
55 . S YSD4ODX=$P(YSD4ODX1,U,+YSD4P)
56 . QUIT:YSD4ODX']"" ;->
57 . S $P(^MR(+YSD4IEN,"DX1"),U,+YSD4P)=YSD4ODX
58 K ^YSD(627.99,+YSD4CIEN,"DX1")
59 QUIT
60 ;
61PDX ;
62 S YSD4PDX=0
63 F S YSD4PDX=$O(^YSD(627.99,+YSD4CIEN,"PDX",YSD4PDX)) QUIT:YSD4PDX'>0 D
64 . S YSD4ODX=$P($G(^YSD(627.99,+YSD4CIEN,"PDX",+YSD4PDX,0)),U)
65 . QUIT:YSD4ODX']"" ;->
66 . S $P(^MR(+YSD4IEN,"PDX",+YSD4PDX,0),U)=YSD4ODX
67 . K ^YSD(627.99,+YSD4CIEN,"PDX",+YSD4PDX)
68 QUIT
69 ;
70XDX ;
71 S YSD4PDX=0
72 F S YSD4PDX=$O(^YSD(627.99,+YSD4CIEN,"XDX",YSD4PDX)) QUIT:YSD4PDX'>0 D
73 . S YSD4ODX=$P($G(^YSD(627.99,+YSD4CIEN,"XDX",+YSD4PDX,0)),U)
74 . QUIT:YSD4ODX']"" ;->
75 . S $P(^MR(+YSD4IEN,"XDX",+YSD4PDX,0),U)=YSD4ODX
76 . K ^YSD(627.99,+YSD4CIEN,"XDX",+YSD4PDX)
77 QUIT
78 ;
79OKNODE(NODE) ;
80 QUIT:$G(NODE)']"" 0
81 QUIT NODE["DX"!(NODE["DX1")!(NODE["PDX")!(NODE["XDX")
82 ;
83EOR ;YSD40061 - Restore Medical Records ; 4/8/94 13:20
Note: See TracBrowser for help on using the repository browser.