- 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/RMPR9CA.m
r613 r623 1 RMPR9CA ;OI-HINES/HNC -SUSPENSE RPC;12/27/2004 2 ;;3.0;PROSTHETICS;**90,135,141**;Feb 09, 1996;Build 5 3 A1 ;roll and scroll entry point 4 G A2 5 EN(RESULTS,RMIE68,RMPRDUZ,RMSUSTAT,RMPR664,RMPRTXT) ;RPC entry point 6 A2 ; 7 S RESULTS(0)="" 8 K ^TMP($J) 9 ; 10 CONT ;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 22 CNOTE ;(#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 68 ONOTE ;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 109 INOTE ;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 ; 144 FD ;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 191 UPD ;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 203 A3 G A4 204 EN1(RESULTS,DA) ;Broker entry to kill PO 205 ;DA is passed 206 S DIK="^RMPR(664," D ^DIK 207 K DIK 208 A4 ; 209 Q 210 ERR ;exit on error 211 EXIT ; 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 1 RMPR9CA ;OI-HINES/HNC -SUSPENSE RPC;12/27/2004 2 ;;3.0;PROSTHETICS;**90**;Feb 09, 1996 3 A1 ;roll and scroll entry point 4 G A2 5 EN(RESULTS,RMIE68,RMPRDUZ,RMSUSTAT,RMPR664,RMPRTXT) ;RPC entry point 6 A2 ; 7 S RESULTS(0)="" 8 K ^TMP($J) 9 ; 10 CONT ;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 22 CNOTE ;(#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 68 ONOTE ;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 109 INOTE ;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 S RMGMRCO=$$RC^GMRCGUIA(.GMRCO,DUZ,RMPREODT,.GMRCMT,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 ; 144 FD ;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 191 UPD ;update file 668 with 2319 records 192 S DA(1)=RMIE68 193 S DIC="^RMPR(668,"_DA(1)_","_"10," 194 S DIC(0)="L",DLAYGO=668,X=RMIE60 195 D FILE^DICN 196 S DA(1)=RMIE68 197 S DIC="^RMPR(668,"_DA(1)_","_"11," 198 S X=RMAMIS 199 D FILE^DICN 200 K DIC,X,DLAYGO 201 Q 202 A3 G A4 203 EN1(RESULTS,DA) ;Broker entry to kill PO 204 ;DA is passed 205 S DIK="^RMPR(664," D ^DIK 206 K DIK 207 A4 ; 208 Q 209 ERR ;exit on error 210 EXIT ; 211 K RMTYRE,RMTRES,RMSUSTAT,RMSTAT,RMSERV,RMEQU,RMPRTST,RMPRDUZ,RMPRDI,RMPRCO,RMPR664,RMIE68 212 K RMIE60,RMIE,RMICD9,RMDWRT,RMDAT,RMCODT,RMAMIS,RMAA,RM688,RMPRTXT 213 K BDC,BAD,%,RMINDT,RMPREQU
Note:
See TracChangeset
for help on using the changeset viewer.
