source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPR9CA.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: 7.3 KB
Line 
1RMPR9CA ;OI-HINES/HNC -SUSPENSE RPC;12/27/2004
2 ;;3.0;PROSTHETICS;**90,135,141**;Feb 09, 1996;Build 5
3A1 ;roll and scroll entry point
4 G A2
5EN(RESULTS,RMIE68,RMPRDUZ,RMSUSTAT,RMPR664,RMPRTXT) ;RPC entry point
6A2 ;
7 S RESULTS(0)=""
8 K ^TMP($J)
9 ;
10CONT ;RMSUSTAT is status 1=complete or 0=incomplete or 2=pending (incomplete)
11 ;
12 S RMIE=0
13 F S RMIE=$O(^RMPR(664,RMPR664,1,RMIE)) Q:RMIE'>0 D
14 .S RMIE60=$P(^RMPR(664,RMPR664,1,RMIE,0),U,13)
15 .S ^TMP($J,RMIE60)=""
16 .D FD,UPD
17 I RMSUSTAT=1 D CNOTE,FD
18 I RMSUSTAT=0 D INOTE,FD
19 I RMSUSTAT=2 D ONOTE,FD
20 ;set status
21 Q
22CNOTE ;(#12) COMPLETION NOTE
23 ;set file 668
24 ;^RMPR(668,D0,4,0)=^668.012^^
25 ;if status is close, or 1
26 ;RMPRTXT ;load into field #12
27 ;^RMPR(668,D0,4,D1,0)
28 ;
29 I $P(^RMPR(668,RMIE68,0),U,10)="C" S RESULTS(0)="0^This Suspense has already been Closed!"
30 S DA=RMIE68
31 D NOW^%DTC S RMPREODT=%,GMRCAD=%
32 S DIE="^RMPR(668,"
33 S DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C""" D ^DIE
34 N RMPRC
35 S L="",LN=0
36 F S L=$O(RMPRTXT(L)) Q:L="" D
37 . I 'LN D Q:RMPRC="" ;strip leading space from 1st line, ignore blank line
38 .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char
39 .. S:RMPRC'="" RMPRTXT(L)=$E(RMPRTXT(L),$F(RMPRTXT(L),RMPRC)-1,$L(RMPRTXT(L))) ;extract from 1st non space char to end of line
40 .. Q
41 . S LN=LN+1,^RMPR(668,RMIE68,4,LN,0)=RMPRTXT(L)
42 . Q
43 S $P(^RMPR(668,RMIE68,4,0),"^",3)=LN
44 K L,LN
45 ;S DA=RMIE68,DIK="^RMPR(668," D IX1^DIK
46 I '$P(^RMPR(668,DA,0),U,9) D
47 .S DIE="^RMPR(668,"
48 .S DR="7///^S X=""See Completion Note for Initial Action Taken."""
49 .D ^DIE
50 .S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE
51 K RMPREODT
52 S GMRCO=$P(^RMPR(668,RMIE68,0),U,15)
53 I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action. Suspense status has been updated to CLOSED." Q
54 S RMPRCOM=0
55 F S RMPRCOM=$O(^RMPR(668,RMIE68,4,RMPRCOM)) Q:RMPRCOM="" D
56 .S GMRCOM(RMPRCOM)=^RMPR(668,RMIE68,4,RMPRCOM,0)
57 I $G(GMRCOM)="" S GMRCOM="Not Noted"
58 S GMRCSF="U"
59 S GMRCA=10
60 S GMRCALF="N"
61 S GMRCATO=""
62 S (GMRCORNP,GMRCDUZ)=DUZ
63 S BDC=$$SFILE^GMRCGUIB(.GMRCO,.GMRCA,.GMRCSF,.GMRCORNP,.GMRCDUZ,.GMRCOM,.GMRCALF,.GMRCATO,.GMRCAD)
64 I +BDC=1 S RESULTS(0)=1_"^"_$P(BDC,U,2)
65 K GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD
66 I RESULTS(0)="" S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult. Suspense status has been updated to CLOSED."
67 Q
68ONOTE ;Other note
69 ;set file 668
70 ;^RMPR(668,D0,4,0)=^668.012^^
71 ;if status is pending, and already initial action note or 0
72 ;^RMPR(668,D0,1,D1,0)= (#.01) ACTION DATE [1D]
73 ;RMPRTXT ;load into field #11, #1
74 ;^RMPR(668,D0,1,D1,1,0)=^668.111^^
75 ;
76 S RMPRDA1=RMIE68,DA(1)=RMIE68,DA=RMIE68
77 D NOW^%DTC S X=%,GMRCWHN=%
78 S DIC="^RMPR(668,"_RMIE68_",1,"
79 S DIC(0)="CQL"
80 S DIC("P")="668.011DA"
81 S DLAYGO=668
82 D ^DIC
83 I Y=-1 S RESULTS(0)="1^Error Modifying Record!" Q
84 ;S DIE=DIC K DIC
85 S (DA,RMPRDA2)=+Y
86 ;S DR="1" D ^DIE
87 K DIE,DR,Y
88 ;S ^RMPR(668,RMIE68,1,0)="^668.011DA^1^1"
89 N RMPRC
90 S L="",LN=0
91 F S L=$O(RMPRTXT(L)) Q:L="" D
92 . I 'LN D Q:RMPRC="" ;strip leading space from 1st line, ignore blank line
93 .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char
94 .. S:RMPRC'="" RMPRTXT(L)=$E(RMPRTXT(L),$F(RMPRTXT(L),RMPRC)-1,$L(RMPRTXT(L))) ;extract from 1st non space char to end of line
95 .. Q
96 . S LN=LN+1,^RMPR(668,RMIE68,1,RMPRDA2,1,LN,0)=RMPRTXT(L)
97 . Q
98 S $P(^RMPR(668,RMIE68,1,RMPRDA2,1,0),"^",3)=LN
99 K L,LN
100 S GMRCO=$P(^RMPR(668,RMIE68,0),U,15)
101 I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action. Suspense status has not changed." Q
102 S RMPRCOM=0
103 F S RMPRCOM=$O(^RMPR(668,RMIE68,1,RMPRDA2,1,RMPRCOM)) Q:RMPRCOM="" D
104 .S GMRCOM(RMPRCOM)=^RMPR(668,RMIE68,1,RMPRDA2,1,RMPRCOM,0)
105 D CMT^GMRCGUIB(.GMRCO,.GMRCOM,"",GMRCWHN,DUZ)
106 K DA,RMPRDA1,RMPRDA2,RMPRCOM,GMRCOM,GMRCO,GMRCWHN
107 S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult. Suspense status has not changed."
108 Q
109INOTE ;initial action note
110 ;set file 668
111 ;^RMPR(668,D0,3,0)=^668.07^^
112 ;if status is pending, or 0
113 ;RMPRTXT ;load into field #7
114 ;^RMPR(668,D0,3,0)=^668.07^^
115 ;
116 I $D(^RMPR(668,RMIE68,3,1,0)) S RESULTS(0)="1^Initial Action Note Already Posted!" Q
117 D NOW^%DTC S RMPREODT=%
118 N RMPRC
119 S ^RMPR(668,RMIE68,3,0)="^^^"_DT_"^"
120 S L="",LN=0
121 F S L=$O(RMPRTXT(L)) Q:L="" D
122 . I 'LN D Q:RMPRC="" ;strip leading space from 1st line, ignore blank line
123 .. S RMPRC=$E($TR(RMPRTXT(L)," ","")) ;1st non space char
124 .. S:RMPRC'="" RMPRTXT(L)=$E(RMPRTXT(L),$F(RMPRTXT(L),RMPRC)-1,$L(RMPRTXT(L))) ;extract from 1st non space char to end of line
125 .. Q
126 . S LN=LN+1,^RMPR(668,RMIE68,3,LN,0)=RMPRTXT(L)
127 . Q
128 S $P(^RMPR(668,RMIE68,3,0),"^",3)=LN
129 K L,LN
130 S DIE="^RMPR(668,"
131 S DA=RMIE68
132 S DR="10////^S X=RMPREODT;16////^S X=DUZ;14///^S X=""P"""
133 D ^DIE
134 S GMRCO=$P(^RMPR(668,RMIE68,0),U,15)
135 I GMRCO="" S RESULTS(0)="0^Completed Manual Suspense Action. Suspense status has been updated to PENDING" Q
136 S RMPRCMT=0
137 F S RMPRCMT=$O(^RMPR(668,RMIE68,3,RMPRCMT)) Q:RMPRCMT="" D
138 .S GMRCMT(RMPRCMT)=^RMPR(668,RMIE68,3,RMPRCMT,0)
139 D CMT^GMRCGUIB(GMRCO,.GMRCMT,DUZ,RMPREODT,DUZ)
140 K RMPREODT,GMRCO,RMGMRCO,GMRCMT,RMPRCMT
141 S RESULTS(0)="0^Completed Suspense Action, and Posted note to CPRS Consult. Suspense status has changed to PENDING."
142 Q
143 ;
144FD ;file date
145 N DIE,DIC,I,J,Y,RMDFN,RMI,RMDATE,RM680,RM6810,RMERROR,RM60L,RC
146 N RMERR,RMCHK,DLAYGO,X,DR,RM668,RM60DAT,RMSTATUS
147 N RM68CNT,RM60CNT,RMSI,RMSAMIS,RM68IEN,RM60IEN,RMSUS60,RMSUS68,RMD
148 N RM68DATA,RM60TYP,RM68D,RM68TRAN,RMPRPRC,RM60IT,RMENTSUS,RMQUIT
149 ;
150 S RMERR=0
151 S:RMSUSTAT="" RMSUSTAT=0
152 L +^RMPR(660,RMIE60):2
153 I $T=0 S RESULTS(0)="1^Someone else is Editing this entry!" G EXIT
154 S RM680=$G(^RMPR(668,RMIE68,0))
155 S RM688=$G(^RMPR(668,RMIE68,8))
156 S RM6810=$G(^RMPR(668,RMIE68,10))
157 S RMAMIS=$P($G(^RMPR(660,RMIE60,"AMS")),U,1)
158 ;code here for 668 fields
159 S RMDATE=$P(RM680,U,1)
160 S RMCODT=$P(RM680,U,5)
161 S RMINDT=$P(RM680,U,9)
162 S RMPRCO=$P(RM680,U,15)
163 S RMDWRT=$P(RM680,U,16)
164 S RMSTAT=$P(RM680,U,7)
165 S RMTRES=$P(RM680,U,8)
166 S RMTYRE=$S(RMTRES=1:"ROUTINE",RMTRES=2:"EYEGLASS",RMTRES=3:"CONTACT LENS",RMTRES=4:"OXYGEN",RMTRES=5:"MANUAL",1:"")
167 S RMREQU=$P(RM680,U,11)
168 S RMSERV=""
169 I $G(RMREQU) D GETS^DIQ(200,RMREQU,"29","E","RMAA") S RMSERV=RMAA(200,RMREQU_",",29,"E")
170 S RMPRDI=$E($P(RM688,U,2),1,16)
171 S RMICD9=$P(RM688,U,3)
172 ;
173 S RMDAT(660,RMIE60_",",8.1)=RMDATE
174 S RMDAT(660,RMIE60_",",8.2)=RMDWRT
175 S RMDAT(660,RMIE60_",",8.3)=RMINDT
176 S RMDAT(660,RMIE60_",",8.4)=RMCODT
177 S RMDAT(660,RMIE60_",",8.5)=RMTYRE
178 S RMDAT(660,RMIE60_",",8.6)=RMREQU
179 S RMDAT(660,RMIE60_",",8.61)=RMSERV
180 S RMDAT(660,RMIE60_",",8.7)=RMPRDI
181 S RMDAT(660,RMIE60_",",8.8)=RMICD9
182 S RMDAT(660,RMIE60_",",8.9)=RMPRCO
183 S RMDAT(660,RMIE60_",",8.11)=RMSTAT
184 I RMSUSTAT=2 S RMDAT(660,RMIE60_",",8.14)=0
185 I RMSUSTAT'=2 S RMDAT(660,RMIE60_",",8.14)=RMSUSTAT
186 D FILE^DIE("","RMDAT","RMERROR")
187 I $D(RMERROR) S RMERR=1 D ERR
188 ;
189 L -^RMPR(660,RMIE60)
190 Q
191UPD ;update file 668 with 2319 records
192 S DA(1)=RMIE68 K DD,DO,DIC
193 S DIC="^RMPR(668,"_DA(1)_","_"10,"
194 S DIC(0)="L",DLAYGO=668,X=RMIE60
195 D FILE^DICN
196 K X,DD,DO,DIC
197 S DA(1)=RMIE68,DIC(0)="L",DLAYGO=668
198 S DIC="^RMPR(668,"_DA(1)_","_"11,"
199 S X=RMAMIS
200 D FILE^DICN
201 K DIC,X,DLAYGO,DD,DO
202 Q
203A3 G A4
204EN1(RESULTS,DA) ;Broker entry to kill PO
205 ;DA is passed
206 S DIK="^RMPR(664," D ^DIK
207 K DIK
208A4 ;
209 Q
210ERR ;exit on error
211EXIT ;
212 K RMTYRE,RMTRES,RMSUSTAT,RMSTAT,RMSERV,RMEQU,RMPRTST,RMPRDUZ,RMPRDI,RMPRCO,RMPR664,RMIE68
213 K RMIE60,RMIE,RMICD9,RMDWRT,RMDAT,RMCODT,RMAMIS,RMAA,RM688,RMPRTXT
214 K BDC,BAD,%,RMINDT,RMPREQU
Note: See TracBrowser for help on using the repository browser.