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