source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9X.m@ 1042

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

initial load of WorldVistAEHR
File size: 2.6 KB
RevLine 
[613]1RMPR9X ;HOIFO/HNC - X-REF SUSPENSE FILE ;5/6/03 08:08
2 ;;3.0;PROSTHETICS;**59**;Feb 09, 1996
3 ;
4 Q
5EN02 ;Date Closed and number of processing days
6 N RMPRDAYS S RMPRCD=""
7 S RMPRCD=$P($P(^RMPR(668,DA,0),U,5),".",1)
8 N X
9 S RMPRDAYS=$$PDAY^RMPREOU(DA)
10 S ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)=""
11 Q
12KILL02 ;
13 N RMPRDAYS,RMPRCD
14 S RMPRCD=$P(X,".",1)
15 S RMPRDAYS=$$PDAY^RMPREOU(DA)
16 K ^RMPR(668,"CD",RMPRCD,RMPRDAYS,DA)
17 Q
18EN01 ;L1 x-ref
19 I X="" Q
20 N L2,L3,M3
21 ;L2 last 2 ssn
22 ;L3 status
23 ;M3 old status
24 S DFN=$P($G(^RMPR(668,DA,0)),U,2)
25 Q:DFN=""
26 D DEM^VADPT
27 S L2=$E($P(VADM(2),U,1),8,9)
28 S L3=$P($G(^RMPR(668,DA,0)),U,10)
29 Q:L3=""
30 ;last 2 SSN, status, ien
31 S M3=""
32 F S M3=$O(^RMPR(668,"L1",L2,M3)) Q:M3="" D
33 .I $D(^RMPR(668,"L1",L2,M3,DA)) K ^RMPR(668,"L1",L2,M3,DA)
34 S ^RMPR(668,"L1",L2,L3,DA)=""
35 K VADM
36 Q
37KILL01 ;kill L1 x-ref
38 N L2,L3,M3
39 ;L2 last 2 ssn
40 ;L3 status
41 ;M3 old status
42 S DFN=$P($G(^RMPR(668,DA,0)),U,2)
43 Q:DFN=""
44 D DEM^VADPT
45 S L2=$E($P(VADM(2),U,1),8,9)
46 S L3=$P($G(^RMPR(668,DA,0)),U,10)
47 Q:L3=""
48 ;last 2 SSN, status, ien
49 S M3=""
50 F S M3=$O(^RMPR(668,"L1",L2,M3)) Q:M3="" D
51 .I $D(^RMPR(668,"L1",L2,M3,DA)) K ^RMPR(668,"L1",L2,M3,DA)
52 K VADM
53 Q
54EN0 ;L x-ref
55 I X="" Q
56 N L2,L3,L4,M3,M4
57 S DFN=$P($G(^RMPR(668,DA,0)),U,2)
58 Q:DFN=""
59 D DEM^VADPT
60 S L2=$E($P(VADM(2),U,1),8,9)
61 S L3=$P($G(^RMPR(668,DA,0)),U,10)
62 Q:L3=""
63 S L4=$P($P(^RMPR(668,DA,0),U,1),".",1)
64 ;last 2 SSN, date no time, status, ien
65 S M4=0
66 F S M4=$O(^RMPR(668,"L",L2,M4)) Q:M4'>0 D
67 .S M3=""
68 .F S M3=$O(^RMPR(668,"L",L2,M4,M3)) Q:M3="" D
69 . .I $D(^RMPR(668,"L",L2,M4,M3,DA)) K ^RMPR(668,"L",L2,M4,M3,DA)
70 S ^RMPR(668,"L",L2,L4,L3,DA)=""
71 K VADM
72 Q
73KILL0 ;
74 N L2,L3,M3,M4
75 S DFN=$P($G(^RMPR(668,DA,0)),U,2)
76 Q:DFN=""
77 S L3=$P(^RMPR(668,DA,0),U,10)
78 D DEM^VADPT
79 S L2=$E($P(VADM(2),U,1),8,9)
80 ;unknown status
81 S M4=0
82 F S M4=$O(^RMPR(668,"L",L2,M4)) Q:M4'>0 D
83 .S M3=""
84 .F S M3=$O(^RMPR(668,"L",L2,M4,M3)) Q:M3="" D
85 . .I $D(^RMPR(668,"L",L2,M4,M3,DA)) K ^RMPR(668,"L",L2,M4,M3,DA)
86 Q
87EN ;Create Entry point
88 I X="C" D KILL Q
89 I X="X" D KILL Q
90 I X="" Q
91 N L2
92 S DFN=$P($G(^RMPR(668,DA,0)),U,2)
93 Q:DFN=""
94 D DEM^VADPT
95 S L2=$E($P(VADM(2),U,1),8,9)
96 S ^RMPR(668,"I",L2,DA)=""
97 K VADM
98 Q
99KILL ;Kill entry point
100 N L2
101 S DFN=$P($G(^RMPR(668,DA,0)),U,2)
102 Q:DFN=""
103 D DEM^VADPT
104 S L2=$E($P(VADM(2),U,1),8,9)
105 K ^RMPR(668,"I",L2,DA)
106 Q
107EN1 ;
108 S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
109 S ^RMPR(669.9,"PA",WHOZ,DA(1))=""
110 Q
111KILL1 ;
112 S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
113 K ^RMPR(669.9,"PA",WHOZ,DA(1))
114 Q
115EN2 ;PCARD CROSS REFERENCE
116 S WHOZ=$P(^RMPR(669.9,DA(1),5,DA,0),U,1)
117 S PCRD=$P(^RMPR(669.9,DA(1),5,DA,0),U,5)
118 S ^RMPR(669.9,"PCRD",WHOZ,PCRD,DA(1))=""
119 Q
120KILL2 ;PCARD CROSS REFERENCE
121 Q
122 ;END
Note: See TracBrowser for help on using the repository browser.