source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPREOS.m@ 1700

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

WorldVistAEHR overlayed on FOIAVistA
File size: 9.2 KB
Line 
1RMPREOS ;HINES-CIOFO/HNC -Suspense Processing ; 2/25/04 10:26am
2 ;;3.0;PROSTHETICS;**45,50,52,55,57,62,80,85,97**;Feb 09, 1996
3 ;
4 ; HNC - patch 52 - 9/22/00 Modify EN2 not to check for RMPRFLAG
5 ; RMPRCLOS, or FLAG.
6 ;
7 ; HNC - patch 55 - 3/12/01 allow other note without initial
8 ;
9 ; HNC - patch 57 - 5/8/01 close out note message
10 ;
11 ; RVD - patch 62 - 8/13/01 link suspense to 2319 records.
12 ;
13 ; HNC - patch 80 - 8/28/03 Type to allow Editing, CLOSE SUSPENSE NOT
14 ; CLOSED Screen Service for Consult Tracking
15 ; (per Jerry)
16 ;
17 ; TH - patch 85 - 2/20/04 Fix bug-overwrite Initial Action Date,
18 ; Note, and DUZ problem.
19 ;
20 ; KAM - patch 85 - 3/16/04 Allow forwarding of a consult to a "Tracker
21 ; Only" service
22 ; KAM - patch 97 - 8/19/04 Stop canceling the original consult when
23 ; canceling the clone (in file 123)
24 ;
25 ;Patch 80 -Read File 123.5 DBIA 3861
26 ;
27EN ;Add Manual Suspense
28 ;
29 D NOW^%DTC S X=%
30 S DIC="^RMPR(668,",DIC(0)="AEQLM",DLAYGO=668
31 S DIC("DR")="1////^S X=RMPRDFN;22R;14////^S X=""O"";8////^S X=DUZ;9////^S X=5;3////^S X=9;2////^S X=RMPR(""STA"")"
32 K DINUM,D0,DD,DO D FILE^DICN K DLAYGO G:Y'>0 EX S (RDA,DA)=+Y
33 S DIE="^RMPR(668,",DR="13;4"
34 L +^RMPR(668,RDA,0):1 I $T=0 W $C(7),?5,!,"Someone else is editing this record" G EX
35 D ^DIE L -^RMPR(668,RDA,0)
36 I '$P(^RMPR(668,RDA,0),U,3) S DA=RDA,DIK="^RMPR(668," D ^DIK W !,$C(7),?5,"Deleted..."
37EX K X,DIC,DIE,DR,Y
38 Q
39 ;
40EN2 ;edit MANUAL suspense record
41 ;DA must be defined
42 ;
43 I $P(^RMPR(668,DA,0),U,8)'>4 W !!!,"Can Not Edit This Suspense Record!",!! H 2 Q
44PROC L +^RMPR(668,DA):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
45 S RO=$G(^RMPR(668,DA,0)),Y=$P(^(0),U,1) X ^DD("DD")
46 W " ",Y," ",$E($P(^DPT($P(RO,U,2),0),U,1),1,20)
47 ;
48 S RZ="S RX=$P(RO,U,3),RR=$S(RX=1:""PSC"",RX=2:""2421"",RX=3:""2237"",RX=4:""2529-3"",RX=5:""2529-7"",RX=6:""2474"",RX=7:""2431"",RX=8:""2914"",RX=9:""OTHER"",RX=10:""2520"",RX=11:""STOCK ISSUE"",1:""NONE"")"
49 X RZ
50 W " ",RR," ",$S($P(RO,U,5)?7N.N:"CLOSED",1:"OPEN")
51 S DIE="^RMPR(668,"
52 ;Q:$D(RMPRFLAG)!$D(RMPRCLOS)!$D(FLAG)
53 S DR="2R;22R;3;13;4"
54 D ^DIE
55 L -^RMPR(668,DA)
56 Q
57ENIA ;initial action note
58 ;
59 I $D(^RMPR(668,DA,3)) W !!!,"Initial Action Note Already Posted!",!! H 2 Q
60 L +^RMPR(668,DA):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
61 D NOW^%DTC S RMPREODT=%
62 ;link suspense to 2319 record, patch #62
63 I $D(^TMP($J,"RMPRPCE",660)) S ^TMP($J,"RMPRPCE",668,DA)="" D SEL60^RMPRPCEL
64 S DIE="^RMPR(668,"
65 S DR="7"
66 D ^DIE
67 I $D(^RMPR(668,DA,3)) S DR="10////^S X=RMPREODT;16////^S X=DUZ;14///^S X=""P""" D ^DIE
68 L -^RMPR(668,DA)
69 ;check for a note here
70 I '$D(^RMPR(668,DA,3)) Q
71 ;consult ien
72 S GMRCO=$P(^RMPR(668,DA,0),U,15) Q:GMRCO=""
73 ;note in array
74 S RMPRCMT=0
75 F S RMPRCMT=$O(^RMPR(668,DA,3,RMPRCMT)) Q:RMPRCMT="" D
76 .S GMRCMT(RMPRCMT)=^RMPR(668,DA,3,RMPRCMT,0)
77 I $G(GMRCMT)="" S GMRCMT="nothing noted"
78 ;call api
79 S RMGMRCO=$$RC^GMRCGUIA(.GMRCO,DUZ,RMPREODT,.GMRCMT,DUZ)
80 K RMPREODT,GMRCO,RMGMRCO,GMRCMT,RMPRCMT
81 Q
82FORW ;forward consult
83 I $P(^RMPR(668,DA,0),U,8)>4 W !!!,"Can Not Forward.",!! H 2 Q
84 I $D(^RMPR(668,DA,4,1,0)) W !!!,"Completion Note Already Posted!",!! H 2 Q
85 D NOW^%DTC S RMPREODT=%,GMRCAD=%
86 ;lookup service to forward consult
87 ;S DIC("S")="I '$P(^(0),U,2),'+$G(^GMR(123.5,+Y,""IFC""))" ;*85
88 S DIC("S")="I $$SCR^RMPREOS(+Y,DUZ)" ;*85
89 S DIC="^GMR(123.5,",DIC(0)="AEQ"
90 S DIC("A")="Select Service To Forward Consult: "
91 D ^DIC
92 I (+Y'>0)!($D(DTOUT))!$D(DUOUT) W !!,"Not Forwarded! No Service Selected ." H 2 K DIC Q
93 S GMRCSS=+Y
94 L +^RMPR(668,DA):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!"
95 S DIE="^RMPR(668,"
96 ;stuff Consult forward service
97 S DR="23////^S X=GMRCSS"
98 D ^DIE
99 Q:'$P($G(^RMPR(668,DA,8)),U,6)
100 S DR="12"
101 D ^DIE
102 I $D(^RMPR(668,DA,4,1,0)) S DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C""" D ^DIE
103 ;must have a note
104 I '$D(^RMPR(668,DA,4,1,0)) W !!,"Must Have Note to Forward. Consult Not Forwarded." S $P(^RMPR(668,DA,8),U,6)="" H 2 Q
105 ;
106 ; set initial action note if null
107 ;I '$P(^RMPR(668,DA,0),U,10) D
108 ;
109 ; Check if Initial Action Date is null
110 I $P(^RMPR(668,DA,0),U,9)="" D
111 .S DIE="^RMPR(668,"
112 .; Set Initial Action Note
113 .S DR="7///^S X=""See Completion Note, this was forwarded to another service."""
114 .D ^DIE
115 .; Set Initial Action Date and Initial Action By
116 .;S DR="10////^S X=RMPREODT;16////^S X=DUZ;24////^S X=DUZ" D ^DIE
117 .S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE
118 ;
119 ; Set Forwarded By
120 S DR="24////^S X=DUZ" D ^DIE
121 ;
122 L -^RMPR(668,DA)
123 K RMPREODT
124 S GMRCO=$P(^RMPR(668,DA,0),U,15)
125 Q:GMRCO=""
126 ;note in array
127 S RMPRCOM=0
128 F S RMPRCOM=$O(^RMPR(668,DA,4,RMPRCOM)) Q:RMPRCOM="" D
129 .S GMRCOM(RMPRCOM)=^RMPR(668,DA,4,RMPRCOM,0)
130 I $G(GMRCOM)="" S GMRCOM="not noted"
131 S GMRCORNP=DUZ
132 S GMRCURGI=""
133 S GMRCATTN=""
134 S BDC=$$FR^GMRCGUIA(.GMRCO,.GMRCSS,.GMRCORNP,.GMRCATTN,.GMRCURGI,.GMRCOM,.GMRCAD)
135 I +BDC=1 W !!,"ERROR, DID NOT FORWARD!" H 2
136 W !!,"Consult Forwarded." H 2
137 K GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,GMRCOM,GMRCAD
138 Q
139CLNT ;post closed note
140 ;
141 I $P(^RMPR(668,DA,0),U,10)="C" W !!!,"Completion Note Already Posted!",!! H 2 Q
142 L +^RMPR(668,DA):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
143 D NOW^%DTC S RMPREODT=%,GMRCAD=%
144 ;link suspense to 2319 record, patch #62
145 I $D(^TMP($J,"RMPRPCE",660)) S ^TMP($J,"RMPRPCE",668,DA)="" D SEL60^RMPRPCEL
146 S DIE="^RMPR(668,"
147 S DR="12"
148 D ^DIE
149 I '$D(^RMPR(668,DA,4)) Q
150 I $D(^RMPR(668,DA,4)) S DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C""" D ^DIE
151 ;set initial action note if null
152 I '$P(^RMPR(668,DA,0),U,9) D
153 .S DIE="^RMPR(668,"
154 .S DR="7///^S X=""See Completion Note for Initial Action Taken."""
155 .D ^DIE
156 .S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE
157 ;added by #62. Once closed, update all 2319 record for initial and
158 ;completion date
159 D ICDT^RMPRPCEL(DA)
160 ;
161 L -^RMPR(668,DA)
162 K RMPREODT
163 S GMRCO=$P(^RMPR(668,DA,0),U,15)
164 Q:GMRCO=""
165 ;note in array
166 S RMPRCOM=0
167 F S RMPRCOM=$O(^RMPR(668,DA,4,RMPRCOM)) Q:RMPRCOM="" D
168 .S GMRCOM(RMPRCOM)=^RMPR(668,DA,4,RMPRCOM,0)
169 I $G(GMRCOM)="" S GMRCOM="not noted"
170 S GMRCSF="U"
171 S GMRCA=10
172 S GMRCALF="N"
173 S GMRCATO=""
174 S (GMRCORNP,GMRCDUZ)=DUZ
175 S BDC=$$SFILE^GMRCGUIB(.GMRCO,.GMRCA,.GMRCSF,.GMRCORNP,.GMRCDUZ,.GMRCOM,.GMRCALF,.GMRCATO,.GMRCAD)
176 I +BDC=1 W !!,$P(BDC,U,2) H 2
177 K GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD
178 Q
179OACT ;other notes - no initial needed 3/12/01
180 ;stuff date/time in.01
181 ;delete if no note
182 ;I '$D(^RMPR(668,DA,3,1,0)) W !!!,"No Initial Action Taken... ",!! H 2 Q
183 ;
184 L +^RMPR(668,DA):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
185 ;link suspense to 2319 record, patch #62
186 I $D(^TMP($J,"RMPRPCE",660)) S ^TMP($J,"RMPRPCE",668,DA)="" D SEL60^RMPRPCEL
187 S DA(1)=DA,RMPRDA1=DA
188 S DIC="^RMPR(668,"_DA(1)_",1,"
189 S DIC(0)="CQL"
190 S DIC("P")=$P(^DD(668,11,0),U,2)
191 D NOW^%DTC S X=%,GMRCWHN=%
192 S DLAYGO=688
193 D ^DIC
194 I Y=-1 K DIC,DA Q
195 S DIE=DIC K DIC
196 S (DA,RMPRDA2)=+Y
197 S DR="1" D ^DIE
198 K DIE,DR,Y
199 I '$D(^RMPR(668,RMPRDA1,1,RMPRDA2,1,0)) D Q
200 .;delete the record if no note
201 .S DIK="^RMPR(668,RMPRDA1,1,"
202 .S DA=RMPRDA2
203 .D ^DIK
204 .K DA,DIA,RMPRDA1,RMPRDA2,GMRCWHN
205 ;send data to consults if note
206 S GMRCO=$P(^RMPR(668,RMPRDA1,0),U,15)
207 I GMRCO="" Q
208 ;GMRCOM is comment array
209 S RMPRCOM=0
210 F S RMPRCOM=$O(^RMPR(668,RMPRDA1,1,RMPRDA2,1,RMPRCOM)) Q:RMPRCOM="" D
211 .S GMRCOM(RMPRCOM)=^RMPR(668,RMPRDA1,1,RMPRDA2,1,RMPRCOM,0)
212 ;
213 L -^RMPR(668,RMPRDA1)
214 ;GMRCWHN was set to date/time
215 D CMT^GMRCGUIB(.GMRCO,.GMRCOM,"",.GMRCWHN,DUZ)
216 ;check ok
217 K DA,DIK,RMPRDA1,RMPRDA2,RMPRCOM,GMRCOM,GMRCO,GMRCWHN
218 Q
219CANCEL ;cancel suspense
220 ;set status to X and cancelled by to duz, date/time.
221 ;start
222 ;
223 I $P(^RMPR(668,DA,0),U,5)'="" W !!!,"This has already been completed, cannot cancel!",!! H 2 Q
224 L +^RMPR(668,DA):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
225 K Y
226 S DIR(0)="Y",DIR("B")="N"
227 W !!!,"This will CANCEL/DELETE this Suspense Request."
228 S DIR("A")="Are you sure you want to CANCEL/DELETE this Suspense Request? (Y/N) "
229 D ^DIR I $D(DTOUT)!$D(DUOUT)!(Y="^")!(Y=0) W !!,"Suspense Not Cancelled!" H 2 Q
230 D NOW^%DTC S RMPREODT=%
231 S DIE="^RMPR(668,"
232 S DR="14///^S X=""X"";17////^S X=DUZ;18////^S X=RMPREODT;9"
233 D ^DIE
234 W !!,?5,"DELETED/CANCELLED!" H 2
235 L -^RMPR(668,DA)
236 ;consult ien
237 S GMRCO=$P(^RMPR(668,DA,0),U,15) Q:GMRCO=""
238 ;note in array
239 S RMPRCMT=0
240 F S RMPRCMT=$O(^RMPR(668,DA,9,RMPRCMT)) Q:RMPRCMT="" D
241 .S GMRCMT(RMPRCMT)=^RMPR(668,DA,9,RMPRCMT,0)
242 I $G(GMRCMT)="" S GMRCMT="nothing noted"
243 ;call api
244 ;DY for cancelled, deny
245 S GMRCACTM="DY"
246 ; PATCH RMPR*3*97 if canceling a clone do not update file 123 7=clone
247 I $P(^RMPR(668,DA,0),U,8)'=7 D
248 . S RMGMRCO=$$DC^GMRCGUIA(.GMRCO,DUZ,RMPREODT,.GMRCACTM,.GMRCMT)
249 K RMPREODT,GMRCMT,RMPRCMT,GMRCACTM
250 Q
251 ;
252LINK60 ;link suspense to 2319 records
253 S RMSERR=0
254 F RMSI=0:0 S RMSI=$O(^TMP($J,"RMPRPCE",660,RMSI)) Q:RMSI'>0 D
255 .S RMSAMIS=$G(^TMP($J,"RMPRPCE",660,RMSI))
256 .;call update 668
257 .S RMSERR=$$UP68^RMPRPCE1(RMSI,DA,+RMSAMIS)
258 Q:RMSERR=1
259 S ^TMP($J,"RMPRPCE",668,DA)=""
260 Q
261 ;end
262SCR(SERV,USR) ; SCREEN SERVICES THAT CAN BE FORWARDED TO ,RMPR*3*85
263 N USAGE
264 S USAGE=$P(^GMR(123.5,SERV,0),U,2)
265 I USAGE=9!(USAGE=1) Q 0 ;disabled or grouper service
266 I USAGE=2 Q $$VALIDU^GMRCAU(SERV,USR) ;tracking and check update user
267 Q 1 ;service usage must be null = O
Note: See TracBrowser for help on using the repository browser.