Produced by Araxis Merge on 11/13/2017 2:02:38 PM Eastern Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
| # | Location | File | Last Modified |
|---|---|---|---|
| 1 | National Clozapine Coordination.zip\National Clozapine Coordination | MH_NCC_PROJECT_5_01_T7_1_0.KID | Thu Oct 26 16:24:36 2017 UTC |
| 2 | National Clozapine Coordination.zip\National Clozapine Coordination | MH_NCC_PROJECT_5_01_T7_1_0.KID | Mon Nov 13 18:56:45 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 15 | 48928 |
| Changed | 14 | 28 |
| Inserted | 0 | 0 |
| Removed | 0 | 0 |
| Whitespace | |
|---|---|
| Character case | Differences in character case are significant |
| Line endings | Differences in line endings (CR and LF characters) are ignored |
| CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
| 1 | KIDS Distr ibution sa ved on Oct 26, 2017@ 11:01:05 | |
| 2 | MENTAL HEA LTH NCC PR OJECT 5.01 T7.1.0 | |
| 3 | **KIDS**:Y S*5.01*122 ^PSO*7.0*4 57^PSJ*5.0 *327^OR*3. 0*427^ | |
| 4 | ||
| 5 | **INSTALL NAME** | |
| 6 | YS*5.01*12 2 | |
| 7 | "BLD",1003 3,0) | |
| 8 | YS*5.01*12 2^MENTAL H EALTH^0^31 71026^y | |
| 9 | "BLD",1003 3,1,0) | |
| 10 | ^^1^1^3160 301^^ | |
| 11 | "BLD",1003 3,1,1,0) | |
| 12 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 13 | "BLD",1003 3,4,0) | |
| 14 | ^9.64PA^60 3.03^1 | |
| 15 | "BLD",1003 3,4,603.03 ,0) | |
| 16 | 603.03 | |
| 17 | "BLD",1003 3,4,603.03 ,2,0) | |
| 18 | ^9.641^603 .03^1 | |
| 19 | "BLD",1003 3,4,603.03 ,2,603.03, 0) | |
| 20 | CLOZAPINE PARAMETERS (File-to p level) | |
| 21 | "BLD",1003 3,4,603.03 ,2,603.03, 1,0) | |
| 22 | ^9.6411^11 ^4 | |
| 23 | "BLD",1003 3,4,603.03 ,2,603.03, 1,8,0) | |
| 24 | RX LAB PRO D LISTENER | |
| 25 | "BLD",1003 3,4,603.03 ,2,603.03, 1,9,0) | |
| 26 | DEMOGRAPHI C PROD LIS TENER | |
| 27 | "BLD",1003 3,4,603.03 ,2,603.03, 1,10,0) | |
| 28 | RX LAB TES T LISTENER | |
| 29 | "BLD",1003 3,4,603.03 ,2,603.03, 1,11,0) | |
| 30 | DEMOGRAPHI C TEST LIS TENER | |
| 31 | "BLD",1003 3,4,603.03 ,222) | |
| 32 | y^y^p^^^^n ^^n | |
| 33 | "BLD",1003 3,4,603.03 ,224) | |
| 34 | ||
| 35 | "BLD",1003 3,4,"APDD" ,603.03,60 3.03) | |
| 36 | ||
| 37 | "BLD",1003 3,4,"APDD" ,603.03,60 3.03,8) | |
| 38 | ||
| 39 | "BLD",1003 3,4,"APDD" ,603.03,60 3.03,9) | |
| 40 | ||
| 41 | "BLD",1003 3,4,"APDD" ,603.03,60 3.03,10) | |
| 42 | ||
| 43 | "BLD",1003 3,4,"APDD" ,603.03,60 3.03,11) | |
| 44 | ||
| 45 | "BLD",1003 3,4,"B",60 3.03,603.0 3) | |
| 46 | ||
| 47 | "BLD",1003 3,6.3) | |
| 48 | 61 | |
| 49 | "BLD",1003 3,"ABPKG") | |
| 50 | n | |
| 51 | "BLD",1003 3,"INI") | |
| 52 | BKGRD^YSCL TEST | |
| 53 | "BLD",1003 3,"INID") | |
| 54 | ^n^n | |
| 55 | "BLD",1003 3,"INIT") | |
| 56 | START^YSCL 122P | |
| 57 | "BLD",1003 3,"KRN",0) | |
| 58 | ^9.67PA^77 9.2^20 | |
| 59 | "BLD",1003 3,"KRN",.4 ,0) | |
| 60 | .4 | |
| 61 | "BLD",1003 3,"KRN",.4 01,0) | |
| 62 | .401 | |
| 63 | "BLD",1003 3,"KRN",.4 02,0) | |
| 64 | .402 | |
| 65 | "BLD",1003 3,"KRN",.4 03,0) | |
| 66 | .403 | |
| 67 | "BLD",1003 3,"KRN",.5 ,0) | |
| 68 | .5 | |
| 69 | "BLD",1003 3,"KRN",.8 4,0) | |
| 70 | .84 | |
| 71 | "BLD",1003 3,"KRN",3. 6,0) | |
| 72 | 3.6 | |
| 73 | "BLD",1003 3,"KRN",3. 8,0) | |
| 74 | 3.8 | |
| 75 | "BLD",1003 3,"KRN",9. 2,0) | |
| 76 | 9.2 | |
| 77 | "BLD",1003 3,"KRN",9. 8,0) | |
| 78 | 9.8 | |
| 79 | "BLD",1003 3,"KRN",9. 8,"NM",0) | |
| 80 | ^9.68A^9^9 | |
| 81 | "BLD",1003 3,"KRN",9. 8,"NM",1,0 ) | |
| 82 | YSCLTST2^^ 0^B1123883 30 | |
| 83 | "BLD",1003 3,"KRN",9. 8,"NM",2,0 ) | |
| 84 | YSCLSERV^^ 0^B1075281 31 | |
| 85 | "BLD",1003 3,"KRN",9. 8,"NM",3,0 ) | |
| 86 | YSCLDIS^^0 ^B31390614 | |
| 87 | "BLD",1003 3,"KRN",9. 8,"NM",4,0 ) | |
| 88 | YSCLTST3^^ 0^B6870017 7 | |
| 89 | "BLD",1003 3,"KRN",9. 8,"NM",5,0 ) | |
| 90 | YSCLTST5^^ 0^B1356575 62 | |
| 91 | "BLD",1003 3,"KRN",9. 8,"NM",6,0 ) | |
| 92 | YSCLTST6^^ 0^B3330772 0 | |
| 93 | "BLD",1003 3,"KRN",9. 8,"NM",7,0 ) | |
| 94 | YSCLSRV1^^ 0^B2762283 | |
| 95 | "BLD",1003 3,"KRN",9. 8,"NM",8,0 ) | |
| 96 | YSCL122P^^ 0^B1417520 | |
| 97 | "BLD",1003 3,"KRN",9. 8,"NM",9,0 ) | |
| 98 | YSCLTST4^^ 0^B1936062 7 | |
| 99 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCL122P ",8) | |
| 100 | ||
| 101 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLDIS" ,3) | |
| 102 | ||
| 103 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLSERV ",2) | |
| 104 | ||
| 105 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLSRV1 ",7) | |
| 106 | ||
| 107 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLTST2 ",1) | |
| 108 | ||
| 109 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLTST3 ",4) | |
| 110 | ||
| 111 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLTST4 ",9) | |
| 112 | ||
| 113 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLTST5 ",5) | |
| 114 | ||
| 115 | "BLD",1003 3,"KRN",9. 8,"NM","B" ,"YSCLTST6 ",6) | |
| 116 | ||
| 117 | "BLD",1003 3,"KRN",19 ,0) | |
| 118 | 19 | |
| 119 | "BLD",1003 3,"KRN",19 ,"NM",0) | |
| 120 | ^9.68A^3^3 | |
| 121 | "BLD",1003 3,"KRN",19 ,"NM",1,0) | |
| 122 | YSCL DAILY TRANSMISS ION^^0 | |
| 123 | "BLD",1003 3,"KRN",19 ,"NM",2,0) | |
| 124 | YSCL WEEKL Y TRANSMIS SION^^0 | |
| 125 | "BLD",1003 3,"KRN",19 ,"NM",3,0) | |
| 126 | YSCL TRANS MIT DEMOGR APHICS^^0 | |
| 127 | "BLD",1003 3,"KRN",19 ,"NM","B", "YSCL DAIL Y TRANSMIS SION",1) | |
| 128 | ||
| 129 | "BLD",1003 3,"KRN",19 ,"NM","B", "YSCL TRAN SMIT DEMOG RAPHICS",3 ) | |
| 130 | ||
| 131 | "BLD",1003 3,"KRN",19 ,"NM","B", "YSCL WEEK LY TRANSMI SSION",2) | |
| 132 | ||
| 133 | "BLD",1003 3,"KRN",19 .1,0) | |
| 134 | 19.1 | |
| 135 | "BLD",1003 3,"KRN",10 1,0) | |
| 136 | 101 | |
| 137 | "BLD",1003 3,"KRN",40 9.61,0) | |
| 138 | 409.61 | |
| 139 | "BLD",1003 3,"KRN",77 1,0) | |
| 140 | 771 | |
| 141 | "BLD",1003 3,"KRN",77 9.2,0) | |
| 142 | 779.2 | |
| 143 | "BLD",1003 3,"KRN",87 0,0) | |
| 144 | 870 | |
| 145 | "BLD",1003 3,"KRN",89 89.51,0) | |
| 146 | 8989.51 | |
| 147 | "BLD",1003 3,"KRN",89 89.52,0) | |
| 148 | 8989.52 | |
| 149 | "BLD",1003 3,"KRN",89 94,0) | |
| 150 | 8994 | |
| 151 | "BLD",1003 3,"KRN","B ",.4,.4) | |
| 152 | ||
| 153 | "BLD",1003 3,"KRN","B ",.401,.40 1) | |
| 154 | ||
| 155 | "BLD",1003 3,"KRN","B ",.402,.40 2) | |
| 156 | ||
| 157 | "BLD",1003 3,"KRN","B ",.403,.40 3) | |
| 158 | ||
| 159 | "BLD",1003 3,"KRN","B ",.5,.5) | |
| 160 | ||
| 161 | "BLD",1003 3,"KRN","B ",.84,.84) | |
| 162 | ||
| 163 | "BLD",1003 3,"KRN","B ",3.6,3.6) | |
| 164 | ||
| 165 | "BLD",1003 3,"KRN","B ",3.8,3.8) | |
| 166 | ||
| 167 | "BLD",1003 3,"KRN","B ",9.2,9.2) | |
| 168 | ||
| 169 | "BLD",1003 3,"KRN","B ",9.8,9.8) | |
| 170 | ||
| 171 | "BLD",1003 3,"KRN","B ",19,19) | |
| 172 | ||
| 173 | "BLD",1003 3,"KRN","B ",19.1,19. 1) | |
| 174 | ||
| 175 | "BLD",1003 3,"KRN","B ",101,101) | |
| 176 | ||
| 177 | "BLD",1003 3,"KRN","B ",409.61,4 09.61) | |
| 178 | ||
| 179 | "BLD",1003 3,"KRN","B ",771,771) | |
| 180 | ||
| 181 | "BLD",1003 3,"KRN","B ",779.2,77 9.2) | |
| 182 | ||
| 183 | "BLD",1003 3,"KRN","B ",870,870) | |
| 184 | ||
| 185 | "BLD",1003 3,"KRN","B ",8989.51, 8989.51) | |
| 186 | ||
| 187 | "BLD",1003 3,"KRN","B ",8989.52, 8989.52) | |
| 188 | ||
| 189 | "BLD",1003 3,"KRN","B ",8994,899 4) | |
| 190 | ||
| 191 | "BLD",1003 3,"QDEF") | |
| 192 | ^^^^NO^^^^ YES^^NO | |
| 193 | "BLD",1003 3,"QUES",0 ) | |
| 194 | ^9.62^^ | |
| 195 | "BLD",1003 3,"REQB",0 ) | |
| 196 | ^9.611^2^2 | |
| 197 | "BLD",1003 3,"REQB",1 ,0) | |
| 198 | YS*5.01*90 ^2 | |
| 199 | "BLD",1003 3,"REQB",2 ,0) | |
| 200 | YS*5.01*92 ^2 | |
| 201 | "BLD",1003 3,"REQB"," B","YS*5.0 1*90",1) | |
| 202 | ||
| 203 | "BLD",1003 3,"REQB"," B","YS*5.0 1*92",2) | |
| 204 | ||
| 205 | "FIA",603. 03) | |
| 206 | CLOZAPINE PARAMETERS | |
| 207 | "FIA",603. 03,0) | |
| 208 | ^YSCL(603. 03, | |
| 209 | "FIA",603. 03,0,0) | |
| 210 | 603.03S | |
| 211 | "FIA",603. 03,0,1) | |
| 212 | y^y^p^^^^n ^^n | |
| 213 | "FIA",603. 03,0,10) | |
| 214 | ||
| 215 | "FIA",603. 03,0,11) | |
| 216 | ||
| 217 | "FIA",603. 03,0,"RLRO ") | |
| 218 | ||
| 219 | "FIA",603. 03,0,"VR") | |
| 220 | 5.01^YS | |
| 221 | "FIA",603. 03,603.03) | |
| 222 | 1 | |
| 223 | "FIA",603. 03,603.03, 8) | |
| 224 | ||
| 225 | "FIA",603. 03,603.03, 9) | |
| 226 | ||
| 227 | "FIA",603. 03,603.03, 10) | |
| 228 | ||
| 229 | "FIA",603. 03,603.03, 11) | |
| 230 | ||
| 231 | "INI") | |
| 232 | BKGRD^YSCL TEST | |
| 233 | "INIT") | |
| 234 | START^YSCL 122P | |
| 235 | "KRN",19,2 916252,-1) | |
| 236 | 0^2 | |
| 237 | "KRN",19,2 916252,0) | |
| 238 | YSCL WEEKL Y TRANSMIS SION^Weekl y Clozapin e Report^R eplaced by YSCL DAIL Y TRANSMIS SION^R^^^^ ^^^^ | |
| 239 | "KRN",19,2 916252,1,0 ) | |
| 240 | ^19.06^3^3 ^3160726^^ | |
| 241 | "KRN",19,2 916252,1,1 ,0) | |
| 242 | This optio n should b e queued o nce to run every 7 d ays (on Tu esday morn ing | |
| 243 | "KRN",19,2 916252,1,2 ,0) | |
| 244 | prior to t he start o f business ) to trans mit Clozap ine dispen sing data to | |
| 245 | "KRN",19,2 916252,1,3 ,0) | |
| 246 | the Clozap ine Roll-U p database located i n Hines. | |
| 247 | "KRN",19,2 916252,25) | |
| 248 | YSCLTEST | |
| 249 | "KRN",19,2 916252,"U" ) | |
| 250 | WEEKLY CLO ZAPINE REP ORT | |
| 251 | "KRN",19,2 916254,-1) | |
| 252 | 0^3 | |
| 253 | "KRN",19,2 916254,0) | |
| 254 | YSCL TRANS MIT DEMOGR APHICS^Tra nsmit Cloz apine Demo graphics^R eplaced by YSCL DAIL Y TRANSMIS SION.^R^^^ ^^^^^ | |
| 255 | "KRN",19,2 916254,1,0 ) | |
| 256 | ^^3^3^2981 130^ | |
| 257 | "KRN",19,2 916254,1,1 ,0) | |
| 258 | This optio n should b e queued t o run on T uesday mor ning prior to the st art | |
| 259 | "KRN",19,2 916254,1,2 ,0) | |
| 260 | of busines s to trans mit Clozap ine patien t demograp hics to th e Clozpain e | |
| 261 | "KRN",19,2 916254,1,3 ,0) | |
| 262 | Roll-Up da tabase loc ated in Hi nes. | |
| 263 | "KRN",19,2 916254,25) | |
| 264 | YSCLTST3 | |
| 265 | "KRN",19,2 916254,"U" ) | |
| 266 | TRANSMIT C LOZAPINE D EMOGRAPHIC | |
| 267 | "KRN",19,2 921816,-1) | |
| 268 | 0^1 | |
| 269 | "KRN",19,2 921816,0) | |
| 270 | YSCL DAILY TRANSMISS ION^Daily Clozapine Transmissi on^^R^^^^^ ^^^MENTAL HEALTH^^1 | |
| 271 | "KRN",19,2 921816,1,0 ) | |
| 272 | ^19.06^2^2 ^3160519^^ | |
| 273 | "KRN",19,2 921816,1,1 ,0) | |
| 274 | This optio n is used to transmi t the dail y Clozapin e patient demographi cs | |
| 275 | "KRN",19,2 921816,1,2 ,0) | |
| 276 | to the Clo zpaine Rol l-Up datab ase locate d in Hines . | |
| 277 | "KRN",19,2 921816,20) | |
| 278 | D XMIT^YSC LTST5 | |
| 279 | "KRN",19,2 921816,25) | |
| 280 | YSCLTST5 | |
| 281 | "KRN",19,2 921816,"U" ) | |
| 282 | DAILY CLOZ APINE TRAN SMISSION | |
| 283 | "MBREQ") | |
| 284 | 0 | |
| 285 | "ORD",18,1 9) | |
| 286 | 19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA | |
| 287 | "ORD",18,1 9,0) | |
| 288 | OPTION | |
| 289 | "PKG",200, -1) | |
| 290 | 1^1 | |
| 291 | "PKG",200, 0) | |
| 292 | MENTAL HEA LTH^YS^Ver sion 5.01 of Mental Health | |
| 293 | "PKG",200, 22,0) | |
| 294 | ^9.49I^1^1 | |
| 295 | "PKG",200, 22,1,0) | |
| 296 | 5.01^29412 30^2950417 | |
| 297 | "PKG",200, 22,1,"PAH" ,1,0) | |
| 298 | 122^317102 6^52073644 9 | |
| 299 | "PKG",200, 22,1,"PAH" ,1,1,0) | |
| 300 | ^^1^1^3171 026 | |
| 301 | "PKG",200, 22,1,"PAH" ,1,1,1,0) | |
| 302 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 303 | "QUES","XP F1",0) | |
| 304 | Y | |
| 305 | "QUES","XP F1","??") | |
| 306 | ^D REP^XPD H | |
| 307 | "QUES","XP F1","A") | |
| 308 | Shall I wr ite over y our |FLAG| File | |
| 309 | "QUES","XP F1","B") | |
| 310 | YES | |
| 311 | "QUES","XP F1","M") | |
| 312 | D XPF1^XPD IQ | |
| 313 | "QUES","XP F2",0) | |
| 314 | Y | |
| 315 | "QUES","XP F2","??") | |
| 316 | ^D DTA^XPD H | |
| 317 | "QUES","XP F2","A") | |
| 318 | Want my da ta |FLAG| yours | |
| 319 | "QUES","XP F2","B") | |
| 320 | YES | |
| 321 | "QUES","XP F2","M") | |
| 322 | D XPF2^XPD IQ | |
| 323 | "QUES","XP I1",0) | |
| 324 | YO | |
| 325 | "QUES","XP I1","??") | |
| 326 | ^D INHIBIT ^XPDH | |
| 327 | "QUES","XP I1","A") | |
| 328 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
| 329 | "QUES","XP I1","B") | |
| 330 | NO | |
| 331 | "QUES","XP I1","M") | |
| 332 | D XPI1^XPD IQ | |
| 333 | "QUES","XP M1",0) | |
| 334 | PO^VA(200, :EM | |
| 335 | "QUES","XP M1","??") | |
| 336 | ^D MG^XPDH | |
| 337 | "QUES","XP M1","A") | |
| 338 | Enter the Coordinato r for Mail Group '|F LAG|' | |
| 339 | "QUES","XP M1","B") | |
| 340 | ||
| 341 | "QUES","XP M1","M") | |
| 342 | D XPM1^XPD IQ | |
| 343 | "QUES","XP O1",0) | |
| 344 | Y | |
| 345 | "QUES","XP O1","??") | |
| 346 | ^D MENU^XP DH | |
| 347 | "QUES","XP O1","A") | |
| 348 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
| 349 | "QUES","XP O1","B") | |
| 350 | YES | |
| 351 | "QUES","XP O1","M") | |
| 352 | D XPO1^XPD IQ | |
| 353 | "QUES","XP Z1",0) | |
| 354 | Y | |
| 355 | "QUES","XP Z1","??") | |
| 356 | ^D OPT^XPD H | |
| 357 | "QUES","XP Z1","A") | |
| 358 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
| 359 | "QUES","XP Z1","B") | |
| 360 | NO | |
| 361 | "QUES","XP Z1","M") | |
| 362 | D XPZ1^XPD IQ | |
| 363 | "QUES","XP Z2",0) | |
| 364 | Y | |
| 365 | "QUES","XP Z2","??") | |
| 366 | ^D RTN^XPD H | |
| 367 | "QUES","XP Z2","A") | |
| 368 | Want to MO VE routine s to other CPUs | |
| 369 | "QUES","XP Z2","B") | |
| 370 | NO | |
| 371 | "QUES","XP Z2","M") | |
| 372 | D XPZ2^XPD IQ | |
| 373 | "RTN") | |
| 374 | 10 | |
| 375 | "RTN","YSC L122P") | |
| 376 | 0^8^B14175 20 | |
| 377 | "RTN","YSC L122P",1,0 ) | |
| 378 | YSCL122P ; ALB/RTW - NCC POST INSTALL;Ju l 14, 2017 @09:00:07 | |
| 379 | "RTN","YSC L122P",2,0 ) | |
| 380 | ;;5.01;ME NTAL HEALT H;**122**; Dec 30, 19 94;Build 6 1 | |
| 381 | "RTN","YSC L122P",3,0 ) | |
| 382 | ;THIS ROU TINE IS DE SIGNED TO GO THROUGH THE CLOZA PINE PATIE NTS IN FIL E PS(55 PH ARMACY PAT IEN FILE | |
| 383 | "RTN","YSC L122P",4,0 ) | |
| 384 | ;discover active cl ozapine pa tients reg istered lo nger than 57 days ag o that do not have a recent cl ozapine | |
| 385 | "RTN","YSC L122P",5,0 ) | |
| 386 | ;prescrip tion or or der, set t hem to dis continued and send a report to the NCC. | |
| 387 | "RTN","YSC L122P",6,0 ) | |
| 388 | ;the NCC software w ill mainta in the fil e in real time from this point on. | |
| 389 | "RTN","YSC L122P",7,0 ) | |
| 390 | START ; | |
| 391 | "RTN","YSC L122P",8,0 ) | |
| 392 | ;INITIALI ZE ^XTMP(" YSCLDEM" a nd ^XTMP(" YSCLTRN" | |
| 393 | "RTN","YSC L122P",9,0 ) | |
| 394 | N DIE,DA, DR S DR="" ,DIE="^YSC L(603.03," ,DA=1,U="^ " | |
| 395 | "RTN","YSC L122P",10, 0) | |
| 396 | I $$GET1^ DIQ(8989.3 ,1,501,"I" ) S DR="3/ //0;" ;S $P(^YSCL( 603.03,1,0 ),"^",3)=0 | |
| 397 | "RTN","YSC L122P",11, 0) | |
| 398 | S DR=DR_" 8///S. D N
|
|
| 399 | "RTN","YSC L122P",12, 0) | |
| 400 | S DR=DR_" 10///G.CLO ZAPINE D N S. URL ;11///G.CL OZAPINE D N S. URL " | |
| 401 | "RTN","YSC L122P",13, 0) | |
| 402 | D ^DIE | |
| 403 | "RTN","YSC L122P",14, 0) | |
| 404 | N X,X1,X2 S X1=DT,X 2=365 D C^ %DTC | |
| 405 | "RTN","YSC L122P",15, 0) | |
| 406 | F VAR="YS CLDEM","YS CLTRN" D | |
| 407 | "RTN","YSC L122P",16, 0) | |
| 408 | .S ^XTMP( VAR,0)=X_U _DT_U_"CLO ZAPINE DAI LY ROLLUP DATA"_U_(D T-1_".0000 01") | |
| 409 | "RTN","YSC L122P",17, 0) | |
| 410 | D START^Y SCLDIS | |
| 411 | "RTN","YSC L122P",18, 0) | |
| 412 | Q | |
| 413 | "RTN","YSC LDIS") | |
| 414 | 0^3^B31390 614 | |
| 415 | "RTN","YSC LDIS",1,0) | |
| 416 | YSCLDIS ;H INOI/RTW-D ISCONTINUE CLOZAPINE PATIENT S TATUS ;Jul 14, 2017@ 09:00:07 | |
| 417 | "RTN","YSC LDIS",2,0) | |
| 418 | ;;5.01;ME NTAL HEALT H;**122**; Dec 30, 19 94;Build 6 1 | |
| 419 | "RTN","YSC LDIS",3,0) | |
| 420 | ; Referen ce to ^DPT supported by IA #10 035 | |
| 421 | "RTN","YSC LDIS",4,0) | |
| 422 | ; Referen ce to ^PS( 55 support ed by IA # 787 | |
| 423 | "RTN","YSC LDIS",5,0) | |
| 424 | ; Referen ce to $$SI TE^VASITE supported by IA #101 12 | |
| 425 | "RTN","YSC LDIS",6,0) | |
| 426 | ; | |
| 427 | "RTN","YSC LDIS",7,0) | |
| 428 | ;This rou tine will loop throu gh ^PS(55, DFN,"ASAND " and chec k the last prescript ion | |
| 429 | "RTN","YSC LDIS",8,0) | |
| 430 | ; enddate and/or th e the Inpa tient Orde r stop dat e. If the patient ha s not had an active | |
| 431 | "RTN","YSC LDIS",9,0) | |
| 432 | ; prescri ption or I npatent Cl ozapine Or der in the last 56 d ays, the A ctive Trea tment will STOP | |
| 433 | "RTN","YSC LDIS",10,0 ) | |
| 434 | ; YSCLFLA G changes from 0 to 1 if crite ria to avo id discont inue | |
| 435 | "RTN","YSC LDIS",11,0 ) | |
| 436 | Q | |
| 437 | "RTN","YSC LDIS",12,0 ) | |
| 438 | START ; | |
| 439 | "RTN","YSC LDIS",13,0 ) | |
| 440 | N YSLN,DF N,YSCLREGN ,YSCLREGD, YSCLREGA,Y SCLFLAG,YS ARR | |
| 441 | "RTN","YSC LDIS",14,0 ) | |
| 442 | S U="^" S :'$G(DT) D T=$P($$NOW ^XLFDT,"." ) K ^XTMP( "YSCLDIS", DT),^XTMP( "YSCLDATA" ) | |
| 443 | "RTN","YSC LDIS",15,0 ) | |
| 444 | D LIST^DI C(603.01,, 1,"I",,,,, ,,"YSARR") | |
| 445 | "RTN","YSC LDIS",16,0 ) | |
| 446 | F YSLN=1: 1 Q:'$D(YS ARR("DILIS T","ID",YS LN)) S DF N=YSARR("D ILIST","ID ",YSLN,1) D:DFN | |
| 447 | "RTN","YSC LDIS",17,0 ) | |
| 448 | .S YSCLRE GN=$$GET1^ DIQ(55,DFN ,53) Q:YSC LREGN="" | |
| 449 | "RTN","YSC LDIS",18,0 ) | |
| 450 | .Q:$$GET1 ^DIQ(55,DF N,54,"I")= "D" ;Not checking those alre ady discon tinued | |
| 451 | "RTN","YSC LDIS",19,0 ) | |
| 452 | .N YSCLDI S2,YSCLNEW ,X,X1,X2 | |
| 453 | "RTN","YSC LDIS",20,0 ) | |
| 454 | .S YSCLRE GD=$$GET1^ DIQ(55,DFN ,58,"I") | |
| 455 | "RTN","YSC LDIS",21,0 ) | |
| 456 | .S X1=DT, X2=YSCLREG D D ^%DTC S YSCLREGA =X | |
| 457 | "RTN","YSC LDIS",22,0 ) | |
| 458 | .I YSCLRE GN?1U6N D: YSCLREGA>4 Q ;tem ps greater than 4 da ys since r egistratio n | |
| 459 | "RTN","YSC LDIS",23,0 ) | |
| 460 | ..S YSCLD IS2=3 D SE T,DC,DMG^Y SCLTST5 | |
| 461 | "RTN","YSC LDIS",24,0 ) | |
| 462 | .Q:YSCLRE GA<28 ;Not checking those regi stered 27 days or le ss | |
| 463 | "RTN","YSC LDIS",25,0 ) | |
| 464 | .S ^XTMP( "YSCLDATA" ,DT,DFN)=Y SCLREGN_U_ YSCLREGD,Y SCLFLAG=0 | |
| 465 | "RTN","YSC LDIS",26,0 ) | |
| 466 | .S YSCLNE W=1 ;Reg istration is new unl ess clozap ine orders are found | |
| 467 | "RTN","YSC LDIS",27,0 ) | |
| 468 | .D OPT Q: YSCLFLAG=1 ;Not checking further | |
| 469 | "RTN","YSC LDIS",28,0 ) | |
| 470 | .D INP Q: YSCLFLAG=1 | |
| 471 | "RTN","YSC LDIS",29,0 ) | |
| 472 | .S YSCLDI S2=$S(YSCL NEW:1,1:2) | |
| 473 | "RTN","YSC LDIS",30,0 ) | |
| 474 | .D SET,DC ,DMG^YSCLT ST5 | |
| 475 | "RTN","YSC LDIS",31,0 ) | |
| 476 | D:$D(^XTM P("YSCLDIS ")) TR | |
| 477 | "RTN","YSC LDIS",32,0 ) | |
| 478 | Q | |
| 479 | "RTN","YSC LDIS",33,0 ) | |
| 480 | OPT ; Outp atient ord ers | |
| 481 | "RTN","YSC LDIS",34,0 ) | |
| 482 | N YSARRAY ,YSCLOPT,Y SCLRX,YSCL DRG,YSCLFL DT,YSCLSPD T,X,X1,X2, YSCLFLDA | |
| 483 | "RTN","YSC LDIS",35,0 ) | |
| 484 | D LIST^DI C(55.03,", "_DFN_",", ,"I",,,,,, ,"YSARRAY" ) | |
| 485 | "RTN","YSC LDIS",36,0 ) | |
| 486 | S YSCLOPT ="A" F S YSCLOPT=$O (YSARRAY(" DILIST",1, YSCLOPT),- 1) Q:'YSCL OPT D Q: YSCLFLAG | |
| 487 | "RTN","YSC LDIS",37,0 ) | |
| 488 | .S YSCLRX =YSARRAY(" DILIST",1, YSCLOPT),Y SCLDRG=$$G ET1^DIQ(52 ,YSCLRX,6, "I") Q:'YS CLDRG | |
| 489 | "RTN","YSC LDIS",38,0 ) | |
| 490 | .Q:'$L($$ GET1^DIQ(5 0,YSCLDRG, 17.5)) ;' $D(^PSDRUG ("ACLOZ",+ YSCLDRG)) | |
| 491 | "RTN","YSC LDIS",39,0 ) | |
| 492 | .S YSCLFL DT=$$GET1^ DIQ(52,YSC LRX,22,"I" ) Q:YSCLFL DT<YSCLREG D ;Fill Date befor e Registra tion | |
| 493 | "RTN","YSC LDIS",40,0 ) | |
| 494 | .S YSCLNE W=0 ;Not a new Regis tration | |
| 495 | "RTN","YSC LDIS",41,0 ) | |
| 496 | .S YSCLSP DT=$$GET1^ DIQ(52,YSC LRX,26,"I" ) | |
| 497 | "RTN","YSC LDIS",42,0 ) | |
| 498 | .I YSCLSP DT'<DT S Y SCLFLAG=1 Q ;Not E xpired yet | |
| 499 | "RTN","YSC LDIS",43,0 ) | |
| 500 | .S X1=DT, X2=YSCLFLD T D ^%DTC S YSCLFLDA =X | |
| 501 | "RTN","YSC LDIS",44,0 ) | |
| 502 | .I YSCLFL DA<56 S YS CLFLAG=1 | |
| 503 | "RTN","YSC LDIS",45,0 ) | |
| 504 | Q | |
| 505 | "RTN","YSC LDIS",46,0 ) | |
| 506 | INP ;Inpat ient Order s | |
| 507 | "RTN","YSC LDIS",47,0 ) | |
| 508 | N YSARRAY ,YSARRAY1, YSCLIPT,YS LINE,YSCLD RG,YSCLORD T,YSCLSPDT ,YSCLORDA, X,X1,X2 | |
| 509 | "RTN","YSC LDIS",48,0 ) | |
| 510 | D LIST^DI C(55.06,", "_DFN_",", ,"I",,,,,, ,"YSARRAY" ) | |
| 511 | "RTN","YSC LDIS",49,0 ) | |
| 512 | S YSCLIPT ="A" F S YSCLIPT=$O (YSARRAY(" DILIST",1, YSCLIPT),- 1) Q:'YSCL IPT D Q: YSCLFLAG | |
| 513 | "RTN","YSC LDIS",50,0 ) | |
| 514 | .S YSLINE =YSARRAY(" DILIST",2, YSCLIPT) | |
| 515 | "RTN","YSC LDIS",51,0 ) | |
| 516 | .D LIST^D IC(55.07," ,"_YSLINE_ ","_DFN_", ",,"I",,,, ,,,"YSARRA Y1") | |
| 517 | "RTN","YSC LDIS",52,0 ) | |
| 518 | .S YSCLDR G=+$G(YSAR RAY1("DILI ST",1,1)) Q:'$G(YSCL DRG) | |
| 519 | "RTN","YSC LDIS",53,0 ) | |
| 520 | .Q:$$GET1 ^DIQ(50,YS CLDRG,17.5 )'="PSOCLO 1" | |
| 521 | "RTN","YSC LDIS",54,0 ) | |
| 522 | .S YSCLOR DT=$$GET1^ DIQ(55.06, YSLINE_"," _DFN,27,"I ") Q:YSCLO RDT<YSCLRE GD ;Order date befo re Registr ation | |
| 523 | "RTN","YSC LDIS",55,0 ) | |
| 524 | .S YSCLNE W=0 ;Not a new Regis tration | |
| 525 | "RTN","YSC LDIS",56,0 ) | |
| 526 | .S YSCLSP DT=$$GET1^ DIQ(55.06, YSLINE_"," _DFN,34,"I ") | |
| 527 | "RTN","YSC LDIS",57,0 ) | |
| 528 | .I YSCLSP DT'<DT S Y SCLFLAG=1 Q ;Not S topped yet | |
| 529 | "RTN","YSC LDIS",58,0 ) | |
| 530 | .S X1=DT, X2=YSCLORD T D ^%DTC S YSCLORDA =X | |
| 531 | "RTN","YSC LDIS",59,0 ) | |
| 532 | .I YSCLOR DA<56 S YS CLFLAG=1 | |
| 533 | "RTN","YSC LDIS",60,0 ) | |
| 534 | Q | |
| 535 | "RTN","YSC LDIS",61,0 ) | |
| 536 | ; | |
| 537 | "RTN","YSC LDIS",62,0 ) | |
| 538 | SET ;XTMP BUILD USED FOR TESTI NG | |
| 539 | "RTN","YSC LDIS",63,0 ) | |
| 540 | S ^XTMP(" YSCLDIS",D T,DFN,0)=Y SCLDIS2 | |
| 541 | "RTN","YSC LDIS",64,0 ) | |
| 542 | Q | |
| 543 | "RTN","YSC LDIS",65,0 ) | |
| 544 | DC ; | |
| 545 | "RTN","YSC LDIS",66,0 ) | |
| 546 | N DIE,DR | |
| 547 | "RTN","YSC LDIS",67,0 ) | |
| 548 | S DIE="^P S(55,",DA= DFN,DR="54 ///"_"D"_" ;56///1" D ^DIE | |
| 549 | "RTN","YSC LDIS",68,0 ) | |
| 550 | Q | |
| 551 | "RTN","YSC LDIS",69,0 ) | |
| 552 | ; | |
| 553 | "RTN","YSC LDIS",70,0 ) | |
| 554 | TR ; | |
| 555 | "RTN","YSC LDIS",71,0 ) | |
| 556 | K ^TMP("Y SCL",$J) X ^%ZOSF("U CI") | |
| 557 | "RTN","YSC LDIS",72,0 ) | |
| 558 | D YSCLDRS N K XMY | |
| 559 | "RTN","YSC LDIS",73,0 ) | |
| 560 | I $$GET1^ DIQ(8989.3 ,1,501,"I" ) S XMY("G .CLOZAPINE ROLL-UP@F ORUM.VA.GO V")="" | |
| 561 | "RTN","YSC LDIS",74,0 ) | |
| 562 | E S XMY( "G.PSOCLOZ ")="" | |
| 563 | "RTN","YSC LDIS",75,0 ) | |
| 564 | D YSXMTEX T | |
| 565 | "RTN","YSC LDIS",76,0 ) | |
| 566 | S XMDUZ=" CLOZAPINE MONITOR",D T=$$NOW^XL FDT | |
| 567 | "RTN","YSC LDIS",77,0 ) | |
| 568 | S ^TMP("Y SCL",$J,1, 0)="Clozap ine Discon tinued Pat ient(s) Da ta was tra nsmitted, "_YSCLLN | |
| 569 | "RTN","YSC LDIS",78,0 ) | |
| 570 | S ^(0)=^T MP("YSCL", $J,1,0)_" records we re sent." | |
| 571 | "RTN","YSC LDIS",79,0 ) | |
| 572 | S XMSUB=$ P($$SITE^V ASITE,U,2) _" Discont inued Stat us",^TMP(" YSCL",$J,2 ,0)=" " | |
| 573 | "RTN","YSC LDIS",80,0 ) | |
| 574 | S XMTEXT= "^TMP(""YS CL"",$J," D ^XMD | |
| 575 | "RTN","YSC LDIS",81,0 ) | |
| 576 | S $P(^YSC L(603.03,1 ,0),U,6)=D T | |
| 577 | "RTN","YSC LDIS",82,0 ) | |
| 578 | K ^TMP("Y SCL",$J) | |
| 579 | "RTN","YSC LDIS",83,0 ) | |
| 580 | Q | |
| 581 | "RTN","YSC LDIS",84,0 ) | |
| 582 | ; | |
| 583 | "RTN","YSC LDIS",85,0 ) | |
| 584 | YSXMTEXT ; CALLED BY YSCLTST3 / RTW Start: Added to build mess age of dis continued clozapine patients d ata for NC C | |
| 585 | "RTN","YSC LDIS",86,0 ) | |
| 586 | S (YSCLLN ,YSCLDATE) =0,YSCLCNT =2 | |
| 587 | "RTN","YSC LDIS",87,0 ) | |
| 588 | F S YSCL DATE=$O(^X TMP("YSCLD IS",YSCLDA TE)) Q:'YS CLDATE D | |
| 589 | "RTN","YSC LDIS",88,0 ) | |
| 590 | .S YSCLDF N=0 F S Y SCLDFN=$O( ^XTMP("YSC LDIS",YSCL DATE,YSCLD FN)) Q:'YS CLDFN D | |
| 591 | "RTN","YSC LDIS",89,0 ) | |
| 592 | ..I $$GET 1^DIQ(55,D FN,54,"I") '="D" Q ; quit if p atient was n't Discon tinued | |
| 593 | "RTN","YSC LDIS",90,0 ) | |
| 594 | ..S PSOLA ST4=$E($$G ET1^DIQ(2, YSCLDFN,.0 9),6,9),YS CLLN=YSCLL N+1 | |
| 595 | "RTN","YSC LDIS",91,0 ) | |
| 596 | ..S YSCLM ESG=$$GET1 ^DIQ(2,YSC LDFN,.01)_ " ("_PSOLA ST4_")" | |
| 597 | "RTN","YSC LDIS",92,0 ) | |
| 598 | ..S YSCLD IS2=$P(^XT MP("YSCLDI S",YSCLDAT E,YSCLDFN, 0),U) | |
| 599 | "RTN","YSC LDIS",93,0 ) | |
| 600 | ..S MSG1= $S(YSCLDIS 2=1:YSCLD1 ,YSCLDIS2= 2:YSCLD2,1 :YSCLD3) | |
| 601 | "RTN","YSC LDIS",94,0 ) | |
| 602 | ..S MSG2= $S(YSCLDIS 2=1:YSCLD1 1,YSCLDIS2 =2:YSCLD22 ,1:YSCLD33 ) | |
| 603 | "RTN","YSC LDIS",95,0 ) | |
| 604 | ..S MSG3= $S(YSCLDIS 2=1:YSCLD1 11,YSCLDIS 2=2:YSCLD2 22,1:YSCLD 333) | |
| 605 | "RTN","YSC LDIS",96,0 ) | |
| 606 | ..S ^TMP( "YSCL",$J, $I(YSCLCNT ),0)=YSCLM ESG ;messa ge from YS CLDRSN | |
| 607 | "RTN","YSC LDIS",97,0 ) | |
| 608 | ..S ^TMP( "YSCL",$J, $I(YSCLCNT ),0)=MSG1 | |
| 609 | "RTN","YSC LDIS",98,0 ) | |
| 610 | ..S ^TMP( "YSCL",$J, $I(YSCLCNT ),0)=MSG2 | |
| 611 | "RTN","YSC LDIS",99,0 ) | |
| 612 | ..S ^TMP( "YSCL",$J, $I(YSCLCNT ),0)=MSG3 | |
| 613 | "RTN","YSC LDIS",100, 0) | |
| 614 | ..S ^TMP( "YSCL",$J, $I(YSCLCNT ),0)="" ;b lank line | |
| 615 | "RTN","YSC LDIS",101, 0) | |
| 616 | Q | |
| 617 | "RTN","YSC LDIS",102, 0) | |
| 618 | YSCLDRSN ; CALLED BY YSCLTST3 discontinu ed reasons | |
| 619 | "RTN","YSC LDIS",103, 0) | |
| 620 | S YSCLD1= "The patie nt status has change d to 'Disc ontinued' because th e new cloz apine" | |
| 621 | "RTN","YSC LDIS",104, 0) | |
| 622 | S YSCLD11 ="patient has not fi lled the p rescriptio n/order wi thin 28 da ys of bein g marked " | |
| 623 | "RTN","YSC LDIS",105, 0) | |
| 624 | S YSCLD11 1="'Active '. " | |
| 625 | "RTN","YSC LDIS",106, 0) | |
| 626 | S YSCLD2= "The patie nt status has change d to 'Disc ontinued' because th e active c lozapine" | |
| 627 | "RTN","YSC LDIS",107, 0) | |
| 628 | S YSCLD22 ="patient has not fi lled the p rescriptio n/order wi thin 56 da ys of bein g " | |
| 629 | "RTN","YSC LDIS",108, 0) | |
| 630 | S YSCLD22 2="prescri bed/ordere d." | |
| 631 | "RTN","YSC LDIS",109, 0) | |
| 632 | S YSCLD3= "The patie nt status has change d to 'Disc ontinued' because th e temporar y local " | |
| 633 | "RTN","YSC LDIS",110, 0) | |
| 634 | S YSCLD33 ="authoriz ation numb er assigne d has expi red and NC CC has not issued a new " | |
| 635 | "RTN","YSC LDIS",111, 0) | |
| 636 | S YSCLD33 3="authori zation num ber. " | |
| 637 | "RTN","YSC LDIS",112, 0) | |
| 638 | Q | |
| 639 | "RTN","YSC LSERV") | |
| 640 | 0^2^B10752 8131 | |
| 641 | "RTN","YSC LSERV",1,0 ) | |
| 642 | YSCLSERV ; DALOI/RLM- Clozapine data serve r ;Jul 14, 2017@09:0 0:07 | |
| 643 | "RTN","YSC LSERV",2,0 ) | |
| 644 | ;;5.01;ME NTAL HEALT H;**18,22, 26,47,61,6 9,74,90,92 ,122**;Dec 30, 1994; Build 61 | |
| 645 | "RTN","YSC LSERV",3,0 ) | |
| 646 | ; Referen ce to ^%ZO SF support ed by IA # 10096 | |
| 647 | "RTN","YSC LSERV",4,0 ) | |
| 648 | ; Referen ce to ^DPT supported by IA #10 035 | |
| 649 | "RTN","YSC LSERV",5,0 ) | |
| 650 | ; Referen ce to ^DD( "DD" suppo rted by IA #10017 | |
| 651 | "RTN","YSC LSERV",6,0 ) | |
| 652 | ; Referen ce to ^PS( 55 support ed by IA # 787 | |
| 653 | "RTN","YSC LSERV",7,0 ) | |
| 654 | ; Referen ce to ^PSD RUG suppor ted by IA #25 | |
| 655 | "RTN","YSC LSERV",8,0 ) | |
| 656 | ; Referen ce to ^PSR X supporte d by IA #7 80 | |
| 657 | "RTN","YSC LSERV",9,0 ) | |
| 658 | ; Referen ce to ^VA( 200 suppor ted by IA #10060 | |
| 659 | "RTN","YSC LSERV",10, 0) | |
| 660 | ; Referen ce to $$SI TE^VASITE supported by IA #101 12 | |
| 661 | "RTN","YSC LSERV",11, 0) | |
| 662 | ; Referen ce to $$FM TE^XLFDT() supported by IA #10 103 | |
| 663 | "RTN","YSC LSERV",12, 0) | |
| 664 | ; Referen ce to ^PSD RUG suppor ted by IA #221 | |
| 665 | "RTN","YSC LSERV",13, 0) | |
| 666 | ; Referen ce to ^XMD supported by IA #10 070 | |
| 667 | "RTN","YSC LSERV",14, 0) | |
| 668 | START ; | |
| 669 | "RTN","YSC LSERV",15, 0) | |
| 670 | K ^TMP($J ,"YSCLDATA ") | |
| 671 | "RTN","YSC LSERV",16, 0) | |
| 672 | S YSDEBUG =$$GET1^DI Q(603.03,1 ,3,"I") | |
| 673 | "RTN","YSC LSERV",17, 0) | |
| 674 | S YSCLST= $P($$SITE^ VASITE,"^" ,3) | |
| 675 | "RTN","YSC LSERV",18, 0) | |
| 676 | S YSCLSTN =$P($$SITE ^VASITE,"^ ",2) | |
| 677 | "RTN","YSC LSERV",19, 0) | |
| 678 | ;Determin e station number | |
| 679 | "RTN","YSC LSERV",20, 0) | |
| 680 | I $G(PSCL OZ) G UNRE G | |
| 681 | "RTN","YSC LSERV",21, 0) | |
| 682 | S X=XQSUB X ^%ZOSF( "UPPERCASE ") S YSCLS UB=Y | |
| 683 | "RTN","YSC LSERV",22, 0) | |
| 684 | S ^TMP($J ,"YSCLDATA ",1)=$S(YS DEBUG:"DEB UG ",1:"") _YSCLSUB_" triggered at "_YSCL ST_" by "_ XMFROM_" o n "_XQDATE | |
| 685 | "RTN","YSC LSERV",23, 0) | |
| 686 | ;The firs t line of the messag e tells wh o requeste d the acti on and whe n | |
| 687 | "RTN","YSC LSERV",24, 0) | |
| 688 | D | |
| 689 | "RTN","YSC LSERV",25, 0) | |
| 690 | .S YSACTI ON=$S(YSCL SUB["REMOV E"!(YSCLSU B["DELETE" ):"data de leted",YSC LSUB["REPO RT":"repor t generate d",YSCLSUB ["REBUILD" :"data ver ified",YSC LSUB["UPDA TE":"data updated",Y SCLSUB["DA TESET":"da te set",1: "CONT") | |
| 691 | "RTN","YSC LSERV",26, 0) | |
| 692 | .I YSACTI ON="CONT" S YSACTION =$S(YSCLSU B["DEMOG R ESET":"Dem ographics Flag Reset ",YSCLSUB[ "DEBUG":"D ebug Mode set",YSCLS UB["AUTH": "Authoriza tion",YSCL SUB["LOCK" :"Lock",1: "Site Lock ") | |
| 693 | "RTN","YSC LSERV",27, 0) | |
| 694 | .S ^TMP($ J,"YSCLDAT A",2)="No "_$S(YSDEB UG:"DEBUG ",1:"")_YS ACTION_" a t "_YSCLST | |
| 695 | "RTN","YSC LSERV",28, 0) | |
| 696 | ;The seco nd line te lls when t he server is activat ed and no data can b e | |
| 697 | "RTN","YSC LSERV",29, 0) | |
| 698 | ;gathered from the MailMan me ssage. Th is line ge ts replace d if the | |
| 699 | "RTN","YSC LSERV",30, 0) | |
| 700 | ;server f inds somet hing to do . | |
| 701 | "RTN","YSC LSERV",31, 0) | |
| 702 | S YSCLLNT =1 I YSCLS UB["REMOVE "!(YSCLSUB ["DELETE") G DELETE | |
| 703 | "RTN","YSC LSERV",32, 0) | |
| 704 | ;If the s ubject con tains the word REMOV E or DELET E delete t hose entri es from th e list. | |
| 705 | "RTN","YSC LSERV",33, 0) | |
| 706 | I YSCLSUB ["REPORT" G REPORT | |
| 707 | "RTN","YSC LSERV",34, 0) | |
| 708 | ;If the s ubject con tains "REP ORT" send a report o f the curr ently regi stered pat ients to t he Clozapi ne group o n Forum | |
| 709 | "RTN","YSC LSERV",35, 0) | |
| 710 | ;I YSCLSU B["REBUILD " G REBUIL D | |
| 711 | "RTN","YSC LSERV",36, 0) | |
| 712 | I YSCLSUB ["RESEND" G RESEND | |
| 713 | "RTN","YSC LSERV",37, 0) | |
| 714 | I YSCLSUB ["UPDATE" G UPDATE | |
| 715 | "RTN","YSC LSERV",38, 0) | |
| 716 | ;I YSCLSU B["CHECKSU M" G CSUM^ YSCLSRV1 | |
| 717 | "RTN","YSC LSERV",39, 0) | |
| 718 | I YSCLSUB ["DATESET" G DSET | |
| 719 | "RTN","YSC LSERV",40, 0) | |
| 720 | I YSCLSUB ["DEBUG" G DEBUG | |
| 721 | "RTN","YSC LSERV",41, 0) | |
| 722 | I YSCLSUB ["PATIENT" G ^YSCLSR V3 | |
| 723 | "RTN","YSC LSERV",42, 0) | |
| 724 | I YSCLSUB ["LOCKOUT" G LOCK^YS CLSRV3 | |
| 725 | "RTN","YSC LSERV",43, 0) | |
| 726 | I YSCLSUB ="DEMOG RE SET" G DEM OG^YSCLSRV 3 | |
| 727 | "RTN","YSC LSERV",44, 0) | |
| 728 | I YSCLSUB ["AUTHORIZ E" G AUTH^ YSCLSRV3 | |
| 729 | "RTN","YSC LSERV",45, 0) | |
| 730 | I YSCLSUB ="OVERRIDE " G OVRRID ^YSCLSRV2 | |
| 731 | "RTN","YSC LSERV",46, 0) | |
| 732 | I YSCLSUB ="CLAPI" G CLAPI^YSC LSRV2 | |
| 733 | "RTN","YSC LSERV",47, 0) | |
| 734 | I YSCLSUB ="CL1API" G CL1API^Y SCLSRV2 | |
| 735 | "RTN","YSC LSERV",48, 0) | |
| 736 | I YSCLSUB ["DISCON" G DCON^YSC LSRV2 | |
| 737 | "RTN","YSC LSERV",49, 0) | |
| 738 | F X XMRE C Q:XMER<0 S XMRG=$ TR(XMRG,"- ","") D | |
| 739 | "RTN","YSC LSERV",50, 0) | |
| 740 | . ;Verify that + of site numb er matches local sit e number | |
| 741 | "RTN","YSC LSERV",51, 0) | |
| 742 | . I XMRG' ?2U5N1","9 N1","1U S YSCLER=" i s in error and was n ot added a t " D OUT Q | |
| 743 | "RTN","YSC LSERV",52, 0) | |
| 744 | . I $P(XM RG,",")'?2 U5N S YSCL ER=" is no t a valid Clozapine number " D OUT Q | |
| 745 | "RTN","YSC LSERV",53, 0) | |
| 746 | . I $P(XM RG,",",2)' ?9N S YSCL ER=" An SS N must be 9 numbers " D OUT Q | |
| 747 | "RTN","YSC LSERV",54, 0) | |
| 748 | . I $P(XM RG,",",3)' ="B",$P(XM RG,",",3)' ="W",$P(XM RG,",",3)' ="M" S YSC LER=" You must speci fy Weekly, Biweekly, or Monthl y " D OUT Q | |
| 749 | "RTN","YSC LSERV",55, 0) | |
| 750 | . ;Valida te the for mat of the data in t he message and repor t the erro r. | |
| 751 | "RTN","YSC LSERV",56, 0) | |
| 752 | . ;Do not add data for record s where th e SSN sent is not in the local database | |
| 753 | "RTN","YSC LSERV",57, 0) | |
| 754 | . S DIC=" ^DPT(",DIC (0)="X",D= "SSN",X=$P (XMRG,",", 2) | |
| 755 | "RTN","YSC LSERV",58, 0) | |
| 756 | . N ARRAY D LIST^DI C(2,,.09,, ,,X,"SSN", ,,"ARRAY") | |
| 757 | "RTN","YSC LSERV",59, 0) | |
| 758 | . S DFN=$ G(ARRAY("D ILIST",2,1 )) I DFN=" " S YSCLER =" SSN doe s not exis t at " D O UT Q | |
| 759 | "RTN","YSC LSERV",60, 0) | |
| 760 | . ;I '$D( ^DPT("SSN" ,X)) S YSC LER=" SSN does not e xist at " D OUT Q | |
| 761 | "RTN","YSC LSERV",61, 0) | |
| 762 | . K ARRAY D LIST^DI C(603.01,, 1,,,,$P(XM RG,","),,, ,"ARRAY") | |
| 763 | "RTN","YSC LSERV",62, 0) | |
| 764 | . I $D(AR RAY("DILIS T","ID",1, 1)) D D O UT Q | |
| 765 | "RTN","YSC LSERV",63, 0) | |
| 766 | . . S YSC LER=" Cloz apine # is in use by "_ARRAY(" DILIST","I D",1,1)_" at " | |
| 767 | "RTN","YSC LSERV",64, 0) | |
| 768 | . ;I $D(^ YSCL(603.0 1,"B",$P(X MRG,","))) S YSCLX=$ O(^YSCL(60 3.01,"B",$ P(XMRG,"," ),"")) S:Y SCLX]"" YS CLX=$P(^YS CL(603.01, YSCLX,0)," ^",2),YSCL ER=" Cloza pine # is in use by "_$P($G(^D PT(YSCLX,0 )),"^")_" at " D OUT Q | |
| 769 | "RTN","YSC LSERV",65, 0) | |
| 770 | . D MIX^D IC1 S YSCL PT=+Y I Y= -1 S YSCLE R=" could not be add ed at " D OUT Q | |
| 771 | "RTN","YSC LSERV",66, 0) | |
| 772 | . ;Add th e data and report an y errors t o the Roll -Up group at Forum. | |
| 773 | "RTN","YSC LSERV",67, 0) | |
| 774 | . K DD S DIC="^YSCL (603.01,", X=$P(XMRG, ","),DIC(" DR")="1/// /"_YSCLPT_ ";2////W" K DO D FIL E^DICN | |
| 775 | "RTN","YSC LSERV",68, 0) | |
| 776 | . K ARRAY D LIST^DI C(603.01,, 1,,,,$P(XM RG,","),,, ,"ARRAY") | |
| 777 | "RTN","YSC LSERV",69, 0) | |
| 778 | . I $D(AR RAY("DILIS T","ID",1, 1)) S YSCL ER=" assig ned to "_A RRAY("DILI ST","ID",1 ,1)_" at " D OUT | |
| 779 | "RTN","YSC LSERV",70, 0) | |
| 780 | . ;S YSCL X=$O(^YSCL (603.01,"B ",$P(XMRG, ","),"")) S:YSCLX]"" YSCLX=$P( ^YSCL(603. 01,YSCLX,0 ),"^",2),Y SCLER=" as signed to "_$P($G(^D PT(YSCLX,0 )),"^")_" at " D OUT | |
| 781 | "RTN","YSC LSERV",71, 0) | |
| 782 | EXIT ;If a ll went we ll, report that too. | |
| 783 | "RTN","YSC LSERV",72, 0) | |
| 784 | S YSDEBUG =$$GET1^DI Q(603.03,1 ,3,"I") | |
| 785 | "RTN","YSC LSERV",73, 0) | |
| 786 | S %H=$H D YMD^%DTC S XMDUN="N CCC LOGGER ",XMDUZ=". 5",XMSUB=$ S(YSDEBUG: "DEBUG ",Y SCLSUB["DE BUG":"DEBU G ",1:"")_ YSCLST_" N CCC ENROLL ER ("_X_%_ ")",XMTEXT ="^TMP($J, ""YSCLDATA ""," | |
| 787 | "RTN","YSC LSERV",74, 0) | |
| 788 | ;/MZR -Be gin modifi cations fo r YS*5.01* 122 | |
| 789 | "RTN","YSC LSERV",75, 0) | |
| 790 | K XMY I $ $GET1^DIQ( 8989.3,1,5 01,"I") D: YSCLLNT | |
| 791 | "RTN","YSC LSERV",76, 0) | |
| 792 | . I 'YSDE BUG S XMY( "G.CLOZAPI NE ROLL-UP @FORUM.VA. GOV")="" | |
| 793 | "RTN","YSC LSERV",77, 0) | |
| 794 | . E S XMY("G.C LOZAPINE D N S. URL ")="" | |
| 795 | "RTN","YSC LSERV",78, 0) | |
| 796 | E D:YSCL LNT | |
| 797 | "RTN","YSC LSERV",79, 0) | |
| 798 | . I 'YSDE BUG S XMY( "G.CLOZAPI NE ROLL-UP ")="" | |
| 799 | "RTN","YSC LSERV",80, 0) | |
| 800 | . E S XM Y("G.CLOZA PINE DEBUG ")="" | |
| 801 | "RTN","YSC LSERV",81, 0) | |
| 802 | ;/MZR - E nd modific ations for YS*5.01*1 22 | |
| 803 | "RTN","YSC LSERV",82, 0) | |
| 804 | D ^XMD | |
| 805 | "RTN","YSC LSERV",83, 0) | |
| 806 | ;Mail the errors an d successe s back to the Roll-U p group at Forum. | |
| 807 | "RTN","YSC LSERV",84, 0) | |
| 808 | K ^TMP($J ,"YSCLDATA ") | |
| 809 | "RTN","YSC LSERV",85, 0) | |
| 810 | K %,%DT,% H,D,DA,DD, DIC,DIE,DI K,RET,X,XM DUN,XMDUZ, XMER,XMFRO M | |
| 811 | "RTN","YSC LSERV",86, 0) | |
| 812 | K XMREC,X MRG,XMSUB, XMTEXT,XMY ,XMZ,XQDAT E,XQSUB,Y, YSA,YSACTI ON,YSCLTYP E | |
| 813 | "RTN","YSC LSERV",87, 0) | |
| 814 | K YSCL28, YSCLA,YSCL AA,YSCLB,Y SCLC,YSCLD A,YSCLDA1, YSCLDATA,Y SCLDEA1 | |
| 815 | "RTN","YSC LSERV",88, 0) | |
| 816 | K YSCLDFN ,YSCLDM,YS CLDOC,YSCL DOM,YSCLDR ,YSCLDRA,Y SCLDRB,YSC LDTA,YSCLE RR | |
| 817 | "RTN","YSC LSERV",89, 0) | |
| 818 | K YSCLDUZ ,YSCLED,YS CLER,YSCLF DA,YSCLFRQ ,YSCLLNT,Y SCLNM,YSCL OVR,YSCLSI TE | |
| 819 | "RTN","YSC LSERV",90, 0) | |
| 820 | K YSCLPT, YSCLRPT,YS CLSD1,YSCL SDT,YSCLSS N,YSCLST,Y SCLSTN,YSC LSUB,YSCLT C | |
| 821 | "RTN","YSC LSERV",91, 0) | |
| 822 | K YSCLRX, YSCLSAND,Y SCLWB,YSCL X,YSCLYN,Y SDEBUG,YSI ,YSOFF,YSP R,ZTQUEUED ,ZTSK | |
| 823 | "RTN","YSC LSERV",92, 0) | |
| 824 | Q | |
| 825 | "RTN","YSC LSERV",93, 0) | |
| 826 | ;/RBN Beg in mods - YS*5.01*12 2 | |
| 827 | "RTN","YSC LSERV",94, 0) | |
| 828 | UNREG I $G (PSCLOZ) D Q | |
| 829 | "RTN","YSC LSERV",95, 0) | |
| 830 | . ;Verify that + of site numb er matches local sit e number | |
| 831 | "RTN","YSC LSERV",96, 0) | |
| 832 | . I XMRG' ?1U4.6N1", ".U1",".U1 ","4N S YS CLER=" is in error a nd was not added at " D OUT Q | |
| 833 | "RTN","YSC LSERV",97, 0) | |
| 834 | . I $P(XM RG,",")'?1 U4.6N S YS CLER=" is not a vali d Clozapin e number " D OUT Q | |
| 835 | "RTN","YSC LSERV",98, 0) | |
| 836 | . I $P(XM RG,",",4)' ?4N S YSCL ER=" An SS N must be 4 numbers " D OUT Q | |
| 837 | "RTN","YSC LSERV",99, 0) | |
| 838 | . ;Valida te the for mat of the data in t he message and repor t the erro r. | |
| 839 | "RTN","YSC LSERV",100 ,0) | |
| 840 | . ;Do not add data for record s where th e SSN sent is not in the local database | |
| 841 | "RTN","YSC LSERV",101 ,0) | |
| 842 | . S DIC=" ^DPT(",DIC (0)="X",D= "SSN",X=SS N | |
| 843 | "RTN","YSC LSERV",102 ,0) | |
| 844 | . N ARRAY D LIST^DI C(2,,.09,, ,,X,"SSN", ,,"ARRAY") | |
| 845 | "RTN","YSC LSERV",103 ,0) | |
| 846 | . S DFN=$ G(ARRAY("D ILIST",2,1 )) I DFN=" " S YSCLER =" SSN doe s not exis t at " D O UT Q | |
| 847 | "RTN","YSC LSERV",104 ,0) | |
| 848 | . K ARRAY D LIST^DI C(603.01,, 1,,,,$P(XM RG,","),,, ,"ARRAY") | |
| 849 | "RTN","YSC LSERV",105 ,0) | |
| 850 | . I $D(AR RAY("DILIS T","ID",1, 1)) D D O UT Q | |
| 851 | "RTN","YSC LSERV",106 ,0) | |
| 852 | . . S YSC LER=" Cloz apine # is in use by "_ARRAY(" DILIST","I D",1,1)_" at " | |
| 853 | "RTN","YSC LSERV",107 ,0) | |
| 854 | . D MIX^D IC1 S YSCL PT=+Y I Y= -1 S YSCLE R=" could not be add ed at " D OUT Q | |
| 855 | "RTN","YSC LSERV",108 ,0) | |
| 856 | . ;Add th e data and report an y errors t o the Roll -Up group at Forum. | |
| 857 | "RTN","YSC LSERV",109 ,0) | |
| 858 | . K DD S DIC="^YSCL (603.01,", X=$P(XMRG, ","),DIC(" DR")="1/// /"_YSCLPT_ ";2////"_" W" K DO D FILE^DICN | |
| 859 | "RTN","YSC LSERV",110 ,0) | |
| 860 | . K ARRAY D LIST^DI C(603.01,, 1,,,,$P(XM RG,","),,, ,"ARRAY") | |
| 861 | "RTN","YSC LSERV",111 ,0) | |
| 862 | . I $D(AR RAY("DILIS T","ID",1, 1)) S YSCL ER=" assig ned to "_A RRAY("DILI ST","ID",1 ,1)_" at " D OUT | |
| 863 | "RTN","YSC LSERV",112 ,0) | |
| 864 | ;/RBN End mods - YS *5.01*122 | |
| 865 | "RTN","YSC LSERV",113 ,0) | |
| 866 | Q | |
| 867 | "RTN","YSC LSERV",114 ,0) | |
| 868 | DELETE ;Al low the NC CC users t o delete c lozapine r egistratio n at the i ndividual sites | |
| 869 | "RTN","YSC LSERV",115 ,0) | |
| 870 | S YSCLLNT =1 F X XM REC Q:XMER <0 S XMRG =$TR(XMRG, "- ","") D | |
| 871 | "RTN","YSC LSERV",116 ,0) | |
| 872 | . I XMRG ="**++**DE LETEALL**+ +**" D DEL ALL Q | |
| 873 | "RTN","YSC LSERV",117 ,0) | |
| 874 | . N ARRA Y D LIST^D IC(603.01, ,1,,,,$P(X MRG,","),, ,,"ARRAY") | |
| 875 | "RTN","YSC LSERV",118 ,0) | |
| 876 | . I '$D( ARRAY("DIL IST","ID", 1,1)) S YS CLER=" "_$ P(XMRG,"," )_" is not registere d at " D O UT Q | |
| 877 | "RTN","YSC LSERV",119 ,0) | |
| 878 | . ;I '$D (^YSCL(603 .01,"B",$P (XMRG,",") )) S YSCLE R=" "_$P(X MRG,",")_" is not re gistered a t " D OUT Q | |
| 879 | "RTN","YSC LSERV",120 ,0) | |
| 880 | . N ARRA Y D LIST^D IC(2,,.09, ,,,$P(XMRG ,",",2),"S SN",,,"ARR AY") | |
| 881 | "RTN","YSC LSERV",121 ,0) | |
| 882 | . S YSCL DFN=$G(ARR AY("DILIST ",2,1)) I YSCLDFN="" S YSCLER= " "_$P(XMR G,",",2)_" is not a valid SSN at " D OUT Q | |
| 883 | "RTN","YSC LSERV",122 ,0) | |
| 884 | . ;S YSC LDFN=$O(^D PT("SSN",$ P(XMRG,"," ,2),"")) I YSCLDFN=" " S YSCLER =" "_$P(XM RG,",")_" is not a v alid SSN a t " D OUT Q | |
| 885 | "RTN","YSC LSERV",123 ,0) | |
| 886 | . K ARRA Y D LIST^D IC(603.01, ,1,"I",,,Y SCLDFN,,,, "ARRAY") | |
| 887 | "RTN","YSC LSERV",124 ,0) | |
| 888 | . I '$D( ARRAY("DIL IST","ID", 1,1)) S YS CLER=" "_$ P(XMRG,"," ,2)_" is n ot registe red at " D OUT Q | |
| 889 | "RTN","YSC LSERV",125 ,0) | |
| 890 | . ;I '$D (^YSCL(603 .01,"C",YS CLDFN)) S YSCLER=" " _$P(XMRG," ,",2)_" is not regis tered at " D OUT Q | |
| 891 | "RTN","YSC LSERV",126 ,0) | |
| 892 | . S YSCL A=ARRAY("D ILIST",2,1 ) ;I YSCLA ="" S YSCL ER=" "_$P( XMRG,",")_ " is not a valid ent ry at " D OUT Q | |
| 893 | "RTN","YSC LSERV",127 ,0) | |
| 894 | . ;K ^YS CL(603.01, YSCLA),^YS CL(603.01, "B",$P(XMR G,","),YSC LA),^YSCL( 603.01,"C" ,YSCLDFN,Y SCLA) | |
| 895 | "RTN","YSC LSERV",128 ,0) | |
| 896 | . S DIK= "^YSCL(603 .01,",DA=Y SCLA D ^DI K | |
| 897 | "RTN","YSC LSERV",129 ,0) | |
| 898 | . S YSCL ER=" remov ed at " D OUT | |
| 899 | "RTN","YSC LSERV",130 ,0) | |
| 900 | . ;I $D( ^YSCL(603. 01,"C",+Y) ) K ^YSCL( 603.01,YSC LA),^YSCL( 603.01,"B" ,$P(XMRG," ,"),YSCLA) ,^YSCL(603 .01,"C",YS CLDFN,YSCL A) S YSCLE R=" remove d at " D O UT Q ;RLM 9-29-99 A DDED QUIT | |
| 901 | "RTN","YSC LSERV",131 ,0) | |
| 902 | G EXIT | |
| 903 | "RTN","YSC LSERV",132 ,0) | |
| 904 | DELALL ;De lete all p atients in file 603. 01 | |
| 905 | "RTN","YSC LSERV",133 ,0) | |
| 906 | N ARRAY,D FN,YSCLA,Y SCLREGN | |
| 907 | "RTN","YSC LSERV",134 ,0) | |
| 908 | D LIST^DI C(603.01,, "1;2","I", ,,,"C",,," ARRAY") | |
| 909 | "RTN","YSC LSERV",135 ,0) | |
| 910 | F I=1:1 Q :'$D(ARRAY ("DILIST", 2,I)) S Y SCLA=ARRAY ("DILIST", 2,I) D:YSC LA | |
| 911 | "RTN","YSC LSERV",136 ,0) | |
| 912 | . S DFN=A RRAY("DILI ST",1,I),Y SCLREGN=AR RAY("DILIS T","ID",I, .01) | |
| 913 | "RTN","YSC LSERV",137 ,0) | |
| 914 | . S YSCLE R=YSCLREGN _", "_$$GE T1^DIQ(2,D FN,.09)_", ("_ARRAY( "DILIST"," ID",I,2)_" ) gdeleted at " D OU T | |
| 915 | "RTN","YSC LSERV",138 ,0) | |
| 916 | . S DIK=" ^YSCL(603. 01,",DA=YS CLA D ^DIK ;K ^YSCL( 603.01,YSC LA) | |
| 917 | "RTN","YSC LSERV",139 ,0) | |
| 918 | Q | |
| 919 | "RTN","YSC LSERV",140 ,0) | |
| 920 | REPORT ;se nd report of current registrat ions to th e Clozapin e group on Forum | |
| 921 | "RTN","YSC LSERV",141 ,0) | |
| 922 | D REPORT^ YSCLSRV2 G EXIT | |
| 923 | "RTN","YSC LSERV",142 ,0) | |
| 924 | OUT S YSCL LNT=$G(YSC LLNT)+1,^T MP($J,"YSC LDATA",YSC LLNT)=XMRG _YSCLER_YS CLST Q | |
| 925 | "RTN","YSC LSERV",143 ,0) | |
| 926 | ;Build th e text for the retur n message here. | |
| 927 | "RTN","YSC LSERV",144 ,0) | |
| 928 | REBUILD ; | |
| 929 | "RTN","YSC LSERV",145 ,0) | |
| 930 | D REBUILD ^YSCLSRV2 G EXIT | |
| 931 | "RTN","YSC LSERV",146 ,0) | |
| 932 | UPDATE ;Up date recor d with Mon thly, Week ly or Bi-w eekly stat us | |
| 933 | "RTN","YSC LSERV",147 ,0) | |
| 934 | N YSARRAY D LIST^DI C(603.01,, ,"I",,,,,, ,"YSARRAY" ) | |
| 935 | "RTN","YSC LSERV",148 ,0) | |
| 936 | F I=1:1 Q :'$D(YSARR AY("DILIST ",2,I)) D | |
| 937 | "RTN","YSC LSERV",149 ,0) | |
| 938 | .S YSARRA Y(YSARRAY( "DILIST",2 ,I))=YSARR AY("DILIST ",1,I) | |
| 939 | "RTN","YSC LSERV",150 ,0) | |
| 940 | .S YSARRA Y("B",YSAR RAY("DILIS T",1,I))=Y SARRAY("DI LIST",2,I) | |
| 941 | "RTN","YSC LSERV",151 ,0) | |
| 942 | K YSARRAY ("DILIST") | |
| 943 | "RTN","YSC LSERV",152 ,0) | |
| 944 | F X XMRE C Q:XMER<0 S XMRG=$ TR(XMRG,"- ","") D | |
| 945 | "RTN","YSC LSERV",153 ,0) | |
| 946 | . I XMRG '?2U5N1"," 9N1","1U S YSCLER=" is in erro r and was not added at " D OUT Q | |
| 947 | "RTN","YSC LSERV",154 ,0) | |
| 948 | . I $P(X MRG,",")'? 2U5N S YSC LER=" is n ot a valid Clozapine number fo rmat " D O UT Q | |
| 949 | "RTN","YSC LSERV",155 ,0) | |
| 950 | . I $P(X MRG,",",2) '?9N S YSC LER=" An S SN must be 9 numbers " D OUT Q | |
| 951 | "RTN","YSC LSERV",156 ,0) | |
| 952 | . I $P(X MRG,",",3) '="B",$P(X MRG,",",3) '="W",$P(X MRG,",",3) '="M" S YS CLER=" You must spec ify Monthl y, Weekly or Biweekl y " D OUT Q ;RLM 06 /15/05 | |
| 953 | "RTN","YSC LSERV",157 ,0) | |
| 954 | . S YSCL NM=$P(XMRG ,","),YSCL SSN=$P(XMR G,",",2),Y SCLWB=$P(X MRG,",",3) | |
| 955 | "RTN","YSC LSERV",158 ,0) | |
| 956 | . I '$D( YSARRAY("B ",YSCLNM)) S YSCLER= " does not exist at " D OUT Q | |
| 957 | "RTN","YSC LSERV",159 ,0) | |
| 958 | . N ARRA Y D LIST^D IC(2,,.09, ,,,YSCLSSN ,"SSN",,," ARRAY") | |
| 959 | "RTN","YSC LSERV",160 ,0) | |
| 960 | . S YSCL DA=$G(ARRA Y("DILIST" ,2,1)) I ' YSCLDA S Y SCLER=" SS N does not exist at " D OUT Q | |
| 961 | "RTN","YSC LSERV",161 ,0) | |
| 962 | . K ARRA Y D LIST^D IC(603.01, ,1,"I",,,Y SCLDA,"C", ,,"ARRAY") | |
| 963 | "RTN","YSC LSERV",162 ,0) | |
| 964 | . S YSCL DA1=$G(ARR AY("DILIST ",2,1)) I 'YSCLDA1 S YSCLER=" SSN not in Clozapine file " D OUT Q | |
| 965 | "RTN","YSC LSERV",163 ,0) | |
| 966 | . D | |
| 967 | "RTN","YSC LSERV",164 ,0) | |
| 968 | . . S DI E=603.01,D A=YSCLDA1, DR="2////" _YSCLWB D ^DIE | |
| 969 | "RTN","YSC LSERV",165 ,0) | |
| 970 | . . S YS CLER=" "_Y SCLNM_" (" _$$GET1^DI Q(2,YSCLDA ,.09)_") u pdated to "_$S(YSCLW B="M":"Mon thly",YSCL WB="W":"We ekly",YSCL WB="B":"Bi -weekly",1 :"Unknown" )_" at " D OUT ;06/1 5/05 | |
| 971 | "RTN","YSC LSERV",166 ,0) | |
| 972 | G EXIT | |
| 973 | "RTN","YSC LSERV",167 ,0) | |
| 974 | RESEND ;Tr igger retr ansmission of Clozap ine data | |
| 975 | "RTN","YSC LSERV",168 ,0) | |
| 976 | X XMREC | |
| 977 | "RTN","YSC LSERV",169 ,0) | |
| 978 | I $L(XMRG ,"^")<1!($ L(XMRG,"^" )>2) S YSC LER=" is a n invalid date(s), R ESEND not triggered at " D OUT G EXIT | |
| 979 | "RTN","YSC LSERV",170 ,0) | |
| 980 | S YSCLSTD T=$P(XMRG, "^",1) | |
| 981 | "RTN","YSC LSERV",171 ,0) | |
| 982 | K %DT S X =YSCLSTDT, %DT="P" D ^%DT I Y=- 1 S YSCLER =" is an i nvalid sta rt date, R ESEND not triggered at " D OUT G EXIT | |
| 983 | "RTN","YSC LSERV",172 ,0) | |
| 984 | S X1=Y,X2 =-1 D C^%D TC S YSCLS TDT=X | |
| 985 | "RTN","YSC LSERV",173 ,0) | |
| 986 | I $L(XMRG ,"^")>1 S YSCLEDDT=$ P(XMRG,"^" ,2) K %DT S X=YSCLED DT,%DT="P" D ^%DT I Y=-1 S YSC LER=" is a n invalid end date, RESEND not triggered at " D OU T G EXIT | |
| 987 | "RTN","YSC LSERV",174 ,0) | |
| 988 | S X1=Y,X2 =1 D C^%DT C S YSCLED DT=X | |
| 989 | "RTN","YSC LSERV",175 ,0) | |
| 990 | I $L(XMRG ,"^")=1 S X1=YSCLSTD T,X2=2 D C ^%DTC S YS CLEDDT=X | |
| 991 | "RTN","YSC LSERV",176 ,0) | |
| 992 | S X1=YSCL EDDT,X2=YS CLSTDT D ^ %DTC I X<0 S YSCLER= " ending d ate cannot be less t han start date, RESE ND not tri ggered at " D OUT G EXIT | |
| 993 | "RTN","YSC LSERV",177 ,0) | |
| 994 | N YSCLREX | |
| 995 | "RTN","YSC LSERV",178 ,0) | |
| 996 | S YSCLREX =1 | |
| 997 | "RTN","YSC LSERV",179 ,0) | |
| 998 | S (YSCLTR DT,YSCLSDT )=YSCLSTDT | |
| 999 | "RTN","YSC LSERV",180 ,0) | |
| 1000 | D REXMIT^ YSCLTST5 | |
| 1001 | "RTN","YSC LSERV",181 ,0) | |
| 1002 | S Y=YSCLS DT X ^DD(" DD") S YSC LER=" - Re send trigg ered (loca l task #"_ $G(ZTSK)_" ) by "_XMF ROM_" for "_Y_" at " D OUT | |
| 1003 | "RTN","YSC LSERV",182 ,0) | |
| 1004 | G EXIT | |
| 1005 | "RTN","YSC LSERV",183 ,0) | |
| 1006 | DSET ;Set the day of the week for the ro ll-up to r un. | |
| 1007 | "RTN","YSC LSERV",184 ,0) | |
| 1008 | X XMREC Q :XMER<0 S X=$TR(XMR G,"- ","") | |
| 1009 | "RTN","YSC LSERV",185 ,0) | |
| 1010 | S YSOFF=$ S(X="SUNDA Y":0,X="MO NDAY":1,X= "TUESDAY": 2,X="WEDNE SDAY":3,X= "THURSDAY" :4,X="FRID AY":5,X="S ATURDAY":6 ,1:7) | |
| 1011 | "RTN","YSC LSERV",186 ,0) | |
| 1012 | I YSOFF>6 S YSCLLNT =$G(YSCLLN T)+1,^TMP( $J,"YSCLDA TA",YSCLLN T)=X_" isn 't a valid day of th e week." G EXIT | |
| 1013 | "RTN","YSC LSERV",187 ,0) | |
| 1014 | S DIE="^Y SCL(603.03 ,",DA=1,DR ="2////"_X D ^DIE ; S $P(^YSCL (603.03,1, 0),"^",2)= X | |
| 1015 | "RTN","YSC LSERV",188 ,0) | |
| 1016 | S YSCLLNT =$G(YSCLLN T)+1,^TMP( $J,"YSCLDA TA",YSCLLN T)="Run da y set to " _X | |
| 1017 | "RTN","YSC LSERV",189 ,0) | |
| 1018 | G EXIT | |
| 1019 | "RTN","YSC LSERV",190 ,0) | |
| 1020 | Q | |
| 1021 | "RTN","YSC LSERV",191 ,0) | |
| 1022 | DEBUG ;Tur n debug mo de on and off. | |
| 1023 | "RTN","YSC LSERV",192 ,0) | |
| 1024 | I YSCLSUB ["DEBUG ON " D | |
| 1025 | "RTN","YSC LSERV",193 ,0) | |
| 1026 | . S YSCL LNT=$G(YSC LLNT)+1,^T MP($J,"YSC LDATA",YSC LLNT)="Deb ug Mode is "_$S(YSDE BUG:"alrea dy",1:"now ")_" ON at "_YSCLSTN | |
| 1027 | "RTN","YSC LSERV",194 ,0) | |
| 1028 | . S DIE= "^YSCL(603 .03,",DA=1 ,DR="3//// 1" D ^DIE ;S $P(^Y SCL(603.03 ,1,0),"^", 3)=1 | |
| 1029 | "RTN","YSC LSERV",195 ,0) | |
| 1030 | I YSCLSUB ["DEBUG OF F" D | |
| 1031 | "RTN","YSC LSERV",196 ,0) | |
| 1032 | . S YSCL LNT=$G(YSC LLNT)+1,^T MP($J,"YSC LDATA",YSC LLNT)="Deb ug Mode is "_$S('YSD EBUG:"alre ady",1:"no w")_" OFF at "_YSCLS TN | |
| 1033 | "RTN","YSC LSERV",197 ,0) | |
| 1034 | . S DIE= "^YSCL(603 .03,",DA=1 ,DR="3//// 0" D ^DIE ;S $P(^Y SCL(603.03 ,1,0),"^", 3)=0 | |
| 1035 | "RTN","YSC LSERV",198 ,0) | |
| 1036 | G EXIT | |
| 1037 | "RTN","YSC LSERV",199 ,0) | |
| 1038 | ZEOR ;YSCL SERV | |
| 1039 | "RTN","YSC LSRV1") | |
| 1040 | 0^7^B27622 83 | |
| 1041 | "RTN","YSC LSRV1",1,0 ) | |
| 1042 | YSCLSRV1 ; DALOI/RLM- Clozapine data serve r ;Jul 14, 2017@09:0 0:07 | |
| 1043 | "RTN","YSC LSRV1",2,0 ) | |
| 1044 | ;;5.01;ME NTAL HEALT H;**61,69, 74,90,122* *;Dec 30, 1994;Build 61 | |
| 1045 | "RTN","YSC LSRV1",3,0 ) | |
| 1046 | ; Referen ce to ^%ZO SF support ed by IA # 10096 | |
| 1047 | "RTN","YSC LSRV1",4,0 ) | |
| 1048 | ; Referen ce to ^XMD supported by IA #10 070 | |
| 1049 | "RTN","YSC LSRV1",5,0 ) | |
| 1050 | CSUM ;Calc ulate chec ksum for r outines an d transmit errors to Forum | |
| 1051 | "RTN","YSC LSRV1",6,0 ) | |
| 1052 | S X=$T(+0 ) X ^%ZOSF ("RSUM") S ^TMP("YSC L",$J,2,0) ="YSCLSRV1 at "_YSCL ST_" = "_Y | |
| 1053 | "RTN","YSC LSRV1",7,0 ) | |
| 1054 | F YSI=1:1 S YSA=$T( ROU+YSI) Q :YSA["***" S X=$P($ P(YSA,",") ,";",3) D | |
| 1055 | "RTN","YSC LSRV1",8,0 ) | |
| 1056 | . X ^%ZOS F("TEST") I '$T S ^T MP("YSCL", $J,YSI+3,0 )=X_" is m issing." Q | |
| 1057 | "RTN","YSC LSRV1",9,0 ) | |
| 1058 | . X ^%ZOS F("RSUM") S ^TMP("YS CL",$J,YSI +3,0)=X_" should be "_$P(YSA," ,",2)_" is "_Y | |
| 1059 | "RTN","YSC LSRV1",10, 0) | |
| 1060 | ;/RBN - B egin modif ications f or YS*5.01 *122 | |
| 1061 | "RTN","YSC LSRV1",11, 0) | |
| 1062 | K XMY I $ $GET1^DIQ( 8989.3,1,5 01,"I") D | |
| 1063 | "RTN","YSC LSRV1",12, 0) | |
| 1064 | . I 'YSDE BUG S XMY( "G.CLOZAPI NE ROLL-UP @FORUM.VA. GOV")="" | |
| 1065 | "RTN","YSC LSRV1",13, 0) | |
| 1066 | . E S XMY("G.C LOZAPINE D N S. URL ")="" | |
| 1067 | "RTN","YSC LSRV1",14, 0) | |
| 1068 | E D | |
| 1069 | "RTN","YSC LSRV1",15, 0) | |
| 1070 | . I 'YSDE BUG S XMY( "G.CLOZAPI NE ROLL-UP ")="" | |
| 1071 | "RTN","YSC LSRV1",16, 0) | |
| 1072 | . E S XM Y("G.CLOZA PINE DEBUG ")="" | |
| 1073 | "RTN","YSC LSRV1",17, 0) | |
| 1074 | ;/RBN - E nd modific ations for YS*5.01*1 22 | |
| 1075 | "RTN","YSC LSRV1",18, 0) | |
| 1076 | S XMSUB=$ S(YSDEBUG: "DEBUG ",1 :"")_"Cloz apine Chec ksum data at "_YSCLS T_" run on "_XQDATE | |
| 1077 | "RTN","YSC LSRV1",19, 0) | |
| 1078 | S XMTEXT= "^TMP(""YS CL"",$J,", XMDUZ="CLO ZAPINE MON ITOR" D ^X MD | |
| 1079 | "RTN","YSC LSRV1",20, 0) | |
| 1080 | K %DT,YSA ,YSCLST,YS I,X,XMDUZ, XMSUB,XMTE XT,Y | |
| 1081 | "RTN","YSC LSRV1",21, 0) | |
| 1082 | K ^TMP("Y SCL",$J) | |
| 1083 | "RTN","YSC LSRV1",22, 0) | |
| 1084 | Q | |
| 1085 | "RTN","YSC LSRV1",23, 0) | |
| 1086 | ROU ; | |
| 1087 | "RTN","YSC LSRV1",24, 0) | |
| 1088 | ;;YSCLDIS ,62418722 | |
| 1089 | "RTN","YSC LSRV1",25, 0) | |
| 1090 | ;;YSCLSER V,90753877 | |
| 1091 | "RTN","YSC LSRV1",26, 0) | |
| 1092 | ;;YSCLSRV 2,24723007 | |
| 1093 | "RTN","YSC LSRV1",27, 0) | |
| 1094 | ;;YSCLSRV 3,24872037 | |
| 1095 | "RTN","YSC LSRV1",28, 0) | |
| 1096 | ;;YSCLTES T,21727247 | |
| 1097 | "RTN","YSC LSRV1",29, 0) | |
| 1098 | ;;YSCLTST 1,11839450 | |
| 1099 | "RTN","YSC LSRV1",30, 0) | |
| 1100 | ;;YSCLTST 2,11245868 8 | |
| 1101 | "RTN","YSC LSRV1",31, 0) | |
| 1102 | ;;YSCLTST 3,69598047 | |
| 1103 | "RTN","YSC LSRV1",32, 0) | |
| 1104 | ;;YSCLTST 5,12972011 0 | |
| 1105 | "RTN","YSC LSRV1",33, 0) | |
| 1106 | ;;YSCLTST 6,26876020 | |
| 1107 | "RTN","YSC LSRV1",34, 0) | |
| 1108 | ;;*** | |
| 1109 | "RTN","YSC LSRV1",35, 0) | |
| 1110 | ZEOR ;YSCL SRV1 | |
| 1111 | "RTN","YSC LTEST") | |
| 1112 | 0^^B195928 94 | |
| 1113 | "RTN","YSC LTEST",1,0 ) | |
| 1114 | YSCLTEST ; DALOI/LB/R LM-COLLECT RX AND LA B DATA FOR CLOZAPINE ;Jul 14, 2017@09:00 :07 | |
| 1115 | "RTN","YSC LTEST",2,0 ) | |
| 1116 | ;;5.01;ME NTAL HEALT H;**18,22, 26,47,61,6 9,74,90,12 2**;Dec 30 , 1994;Bui ld 61 | |
| 1117 | "RTN","YSC LTEST",3,0 ) | |
| 1118 | ; Referen ce to ^DPT supported by IA #10 035 | |
| 1119 | "RTN","YSC LTEST",4,0 ) | |
| 1120 | ; Referen ce to ^DIC (5 support ed by IA # 10056 | |
| 1121 | "RTN","YSC LTEST",5,0 ) | |
| 1122 | ; Referen ce to ^PS( 55 support ed by IA # 787 | |
| 1123 | "RTN","YSC LTEST",6,0 ) | |
| 1124 | ; Referen ce to ^PSD RUG suppor ted by IA #25 | |
| 1125 | "RTN","YSC LTEST",7,0 ) | |
| 1126 | ; Referen ce to ^PSR X supporte d by IA #7 80 | |
| 1127 | "RTN","YSC LTEST",8,0 ) | |
| 1128 | ; Referen ce to ^XMD supported by IA #10 070 | |
| 1129 | "RTN","YSC LTEST",9,0 ) | |
| 1130 | BKGRD ;Nor mal entry for weekly backgroun d job - da tes from T -10 to T-3 | |
| 1131 | "RTN","YSC LTEST",10, 0) | |
| 1132 | Q ; << N CC REMEDIA TION - THI S ENTRY PO INT IS NOL ONGER USED *122/RJS | |
| 1133 | "RTN","YSC LTEST",11, 0) | |
| 1134 | S X=DT D DW^%DTC Q: X'=$$GET1^ DIQ(603.03 ,1,2) ;Ma ke the day to run a parameter settable b y the serv er. | |
| 1135 | "RTN","YSC LTEST",12, 0) | |
| 1136 | S YSOFF=$ S(X="SUNDA Y":0,X="MO NDAY":1,X= "TUESDAY": 2,X="WEDNE SDAY":3,X= "THURSDAY" :4,X="FRID AY":5,X="S ATURDAY":6 ,1:7) Q:YS OFF>6 | |
| 1137 | "RTN","YSC LTEST",13, 0) | |
| 1138 | S X="T-"_ YSOFF D ^% DT S YSCLE D=Y,YSCLRE T="" | |
| 1139 | "RTN","YSC LTEST",14, 0) | |
| 1140 | ;S YSCL=$ H#7-2 S:YS CL<1 YSCL= YSCL+7 S X ="T-"_(YSC L+7) D ^%D T S YSCLED =Y,YSCLRET ="" K YSCL ;Make sur e it's a S unday endi ng date. | |
| 1141 | "RTN","YSC LTEST",15, 0) | |
| 1142 | RUN ; entr y from abo ve for nor mal or bel ow for req ueue | |
| 1143 | "RTN","YSC LTEST",16, 0) | |
| 1144 | Q ; << N CC REMEDIA TION - THI S ENTRY PO INT IS NOL ONGER USED *122/RJS | |
| 1145 | "RTN","YSC LTEST",17, 0) | |
| 1146 | S YSDEBUG =$P(^YSCL( 603.03,1,0 ),"^",3) | |
| 1147 | "RTN","YSC LTEST",18, 0) | |
| 1148 | ;I $G(^YS CL(603.02, 1,0))'?1.N 1"^"1.N G FLERR^YSCL TST3 ;Chec k for entr y in file 603.02, re port an er ror if eit her entry is missing . | |
| 1149 | "RTN","YSC LTEST",19, 0) | |
| 1150 | D DMG^YSC LTST3 | |
| 1151 | "RTN","YSC LTEST",20, 0) | |
| 1152 | S YSCLSIT E=$P($$SIT E^VASITE," ^",2) | |
| 1153 | "RTN","YSC LTEST",21, 0) | |
| 1154 | K XMY | |
| 1155 | "RTN","YSC LTEST",22, 0) | |
| 1156 | S XMY("G. CLOZAPINE ROLL-UP")= "" | |
| 1157 | "RTN","YSC LTEST",23, 0) | |
| 1158 | I YSDEBUG K XMY S X MY("G.CLOZ APINE DEBU G")="" | |
| 1159 | "RTN","YSC LTEST",24, 0) | |
| 1160 | S %DT="T" ,X="NOW" D ^%DT S YS CLNOW=$P(Y ,".",2) | |
| 1161 | "RTN","YSC LTEST",25, 0) | |
| 1162 | S XMSUB=$ S(YSDEBUG: "DEBUG ",1 :"")_"Cloz apine lab data start ed at "_YS CLSITE_" o n "_DT_" a t "_YSCLNO W,^TMP("YS CL",$J,1,0 )=" ",^TMP ("YSCL",$J ,2,0)="+++ Clozapine data coll ection sta rted at "_ YSCLSITE_" on "_DT_" +++",^TMP ("YSCL",$J ,3,0)=" " | |
| 1163 | "RTN","YSC LTEST",26, 0) | |
| 1164 | S XMTEXT= "^TMP(""YS CL"",$J,", XMDUZ="Clo zapine MON ITOR" D ^X MD | |
| 1165 | "RTN","YSC LTEST",27, 0) | |
| 1166 | S $P(^YSC L(603.03,1 ,0),"^",4) =$$NOW^XLF DT | |
| 1167 | "RTN","YSC LTEST",28, 0) | |
| 1168 | ;send MM message wh en routine started. | |
| 1169 | "RTN","YSC LTEST",29, 0) | |
| 1170 | S YSCLLN= 0,YSCLLLN= 3,X1=$P(YS CLED,"."), X2=-60 D C ^%DTC S YS CLM28=X,X1 =$P(YSCLED ,"."),X2=- 28 D C^%DT C S YSCLM7 =X,YSCLED= YSCLED+.5 ;28 TO 60 and 14 to 28 6/15/05 | |
| 1171 | "RTN","YSC LTEST",30, 0) | |
| 1172 | S X1=$P(Y SCLED,".") ,X2=-180 D C^%DTC S YSCLM180=X | |
| 1173 | "RTN","YSC LTEST",31, 0) | |
| 1174 | S X1=$P(Y SCLED,".") ,X2=-56 D C^%DTC S Y SCLM56=X | |
| 1175 | "RTN","YSC LTEST",32, 0) | |
| 1176 | S YSCLIF= +$$SITE^VA SITE_"," | |
| 1177 | "RTN","YSC LTEST",33, 0) | |
| 1178 | D GETS^DI Q(4,YSCLIF ,"1.01;1.0 2;1.03;.02 ;1.04","I" ,"YSCLFF") | |
| 1179 | "RTN","YSC LTEST",34, 0) | |
| 1180 | S $P(YSCL DEMO,"^",1 )=YSCLFF(4 ,YSCLIF,1. 01,"I") | |
| 1181 | "RTN","YSC LTEST",35, 0) | |
| 1182 | S $P(YSCL DEMO,"^",2 )=YSCLFF(4 ,YSCLIF,1. 02,"I") | |
| 1183 | "RTN","YSC LTEST",36, 0) | |
| 1184 | S $P(YSCL DEMO,"^",3 )=YSCLFF(4 ,YSCLIF,1. 03,"I") | |
| 1185 | "RTN","YSC LTEST",37, 0) | |
| 1186 | S $P(YSCL DEMO,"^",4 )=$P(^DIC( 5,YSCLFF(4 ,YSCLIF,.0 2,"I"),0), "^",2) | |
| 1187 | "RTN","YSC LTEST",38, 0) | |
| 1188 | S $P(YSCL DEMO,"^",5 )=YSCLFF(4 ,YSCLIF,1. 04,"I") | |
| 1189 | "RTN","YSC LTEST",39, 0) | |
| 1190 | S $P(YSCL DEMO,"^",6 )="" | |
| 1191 | "RTN","YSC LTEST",40, 0) | |
| 1192 | K J,YSCLF ,YSCLFF,YS CLIF,X | |
| 1193 | "RTN","YSC LTEST",41, 0) | |
| 1194 | ;YSCLDEMO =street1^s treet2^cit y^state(2 letter)^ZI P^phone | |
| 1195 | "RTN","YSC LTEST",42, 0) | |
| 1196 | K ^TMP($J ),^TMP("YS CL",$J) S (DFN,YSCLI EN)=0 | |
| 1197 | "RTN","YSC LTEST",43, 0) | |
| 1198 | F K YSCL A S YSCLIE N=$O(^YSCL (603.01,YS CLIEN)),YS CLLD=0 Q:' YSCLIEN S DFN=$P($G (^YSCL(603 .01,YSCLIE N,0)),"^", 2) S $P(YS STOP,",",1 )=1 Q:$$S^ %ZTLOAD D :DFN | |
| 1199 | "RTN","YSC LTEST",44, 0) | |
| 1200 | . I $D(^ DPT(DFN,0) ),$D(^YSCL (603.01,YS CLIEN,0)) S YSCLSAND =$P($G(^YS CL(603.01, YSCLIEN,0) ),"^",2),Y SCL=^DPT(D FN,0),YSCL X=$E($P($P (YSCL,"^") ,",",2))_$ E(YSCL)_"^ "_$P(YSCL, "^",9) D | |
| 1201 | "RTN","YSC LTEST",45, 0) | |
| 1202 | . . S YS CLLAB="" D GET I YSC LLAB]"" D CHECK^YSCL TST1 I YSC LT D LOAD^ YSCLTST1 | |
| 1203 | "RTN","YSC LTEST",46, 0) | |
| 1204 | G TRANSMI T^YSCLTST2 | |
| 1205 | "RTN","YSC LTEST",47, 0) | |
| 1206 | GET ;presc riptions | |
| 1207 | "RTN","YSC LTEST",48, 0) | |
| 1208 | Q:$$S^%ZT LOAD | |
| 1209 | "RTN","YSC LTEST",49, 0) | |
| 1210 | N YSARRAY D LIST^DI C(55.03,", "_DFN_",", ,"I",,,,,, ,"YSARRAY" ) | |
| 1211 | "RTN","YSC LTEST",50, 0) | |
| 1212 | S YSCLPHY ="",$P(YSC LX,"^",6)= $P(YSCLDEM O,"^",5),$ P(YSCLX,"^ ",11)=$$GE T1^DIQ(603 .01,YSCLIE N,.01),$P( YSCLX,"^", 16)=DT | |
| 1213 | "RTN","YSC LTEST",51, 0) | |
| 1214 | ;site zip (p6),regis tration nu mber (p11) , today (p 16) | |
| 1215 | "RTN","YSC LTEST",52, 0) | |
| 1216 | F YSCL=1: 1 Q:'$D(YS ARRAY("DIL IST",1,YSC L)) S YSC L1=YSARRAY ("DILIST", 1,YSCL) D | |
| 1217 | "RTN","YSC LTEST",53, 0) | |
| 1218 | . D ACTIV E Q:YSACT' =0 S YSDR G=$$GET1^D IQ(52,YSCL 1,6,"I") Q :$$GET1^DI Q(50,YSDRG ,17.5)'="P SOCLO1" | |
| 1219 | "RTN","YSC LTEST",54, 0) | |
| 1220 | . N YSARR AY1 D LIST ^DIC(50.02 ,","_YSDRG _",",3,"I" ,,,,,,,"YS ARRAY1") | |
| 1221 | "RTN","YSC LTEST",55, 0) | |
| 1222 | . F YSCL2 =1:1 Q:'$D (YSARRAY1( "DILIST"," ID",YSCL2) ) I $G(YS ARRAY1("DI LIST","ID" ,YSCL2,3)) =1 D Q | |
| 1223 | "RTN","YSC LTEST",56, 0) | |
| 1224 | . . S YSC LID=$$GET1 ^DIQ(52,YS CL1,1,"I") S:YSCLID> $G(YSCLLD) YSCLLD=YS CLID | |
| 1225 | "RTN","YSC LTEST",57, 0) | |
| 1226 | . . I YSC LID'>DT,YS CLID'<$G(Y SCLM28) S YSCLA(-YSC LID,-YSCL1 )="" ;Chan ged YSCLED to DT RL M | |
| 1227 | "RTN","YSC LTEST",58, 0) | |
| 1228 | Q | |
| 1229 | "RTN","YSC LTEST",59, 0) | |
| 1230 | ACTIVE ;Te st for Act ive prescr iptions | |
| 1231 | "RTN","YSC LTEST",60, 0) | |
| 1232 | S YSACT=$ $GET1^DIQ( 52,YSCL1,1 00,"I") | |
| 1233 | "RTN","YSC LTEST",61, 0) | |
| 1234 | Q | |
| 1235 | "RTN","YSC LTEST",62, 0) | |
| 1236 | REXMIT ;Re send Cloza pine data | |
| 1237 | "RTN","YSC LTEST",63, 0) | |
| 1238 | S X1=YSCL ED,X2=-3 D C^%DTC S YSCLED=X,Y SCLRET=1,Z TREQ="@" G RUN | |
| 1239 | "RTN","YSC LTEST",64, 0) | |
| 1240 | Q | |
| 1241 | "RTN","YSC LTEST",65, 0) | |
| 1242 | ABORT ; | |
| 1243 | "RTN","YSC LTEST",66, 0) | |
| 1244 | K XMY | |
| 1245 | "RTN","YSC LTEST",67, 0) | |
| 1246 | S XMY("G. CLOZAPINE ROLL-UP@") ="" | |
| 1247 | "RTN","YSC LTEST",68, 0) | |
| 1248 | I YSDEBUG K XMY S X MY("G.CLOZ APINE DEBU G@")="" | |
| 1249 | "RTN","YSC LTEST",69, 0) | |
| 1250 | S %DT="T" ,X="NOW" D ^%DT S YS CLNOW=$P(Y ,".",2) | |
| 1251 | "RTN","YSC LTEST",70, 0) | |
| 1252 | S YSCLSIT E=$P($$SIT E^VASITE," ^",2) | |
| 1253 | "RTN","YSC LTEST",71, 0) | |
| 1254 | S XMSUB=" Clozapine Roll-Up ab orted ["_$ G(YSSTOP)_ "] at "_YS CLSITE_" o n "_DT | |
| 1255 | "RTN","YSC LTEST",72, 0) | |
| 1256 | S YSTEXT( 1,0)=" " | |
| 1257 | "RTN","YSC LTEST",73, 0) | |
| 1258 | S YSTEXT( 2,0)=$S(YS DEBUG:"DEB UG ",1:"") _"Clozapin e Roll-Up aborted [" _$G(YSSTOP )_"] at "_ YSCLSITE_" on "_DT_" at "_YSCL NOW,^TMP(" YSCL",$J,1 ,0)=" " | |
| 1259 | "RTN","YSC LTEST",74, 0) | |
| 1260 | S XMTEXT= "YSTEXT(", XMDUZ="Clo zapine MON ITOR" D ^X MD | |
| 1261 | "RTN","YSC LTEST",75, 0) | |
| 1262 | S ZTSTOP= 1 Q | |
| 1263 | "RTN","YSC LTEST",76, 0) | |
| 1264 | ZEOR ;YSCL TEST | |
| 1265 | "RTN","YSC LTST2") | |
| 1266 | 0^1^B11238 8330 | |
| 1267 | "RTN","YSC LTST2",1,0 ) | |
| 1268 | YSCLTST2 ; DALOI/LB/R LM-TRANSMI T RX AND l AB DATA FO R CLOZAPIN E ;Jul 14, 2017@09:0 0:07 | |
| 1269 | "RTN","YSC LTST2",2,0 ) | |
| 1270 | ;;5.01;ME NTAL HEALT H;**18,22, 26,47,61,6 9,74,90,92 ,122**;Dec 30, 1994; Build 61 | |
| 1271 | "RTN","YSC LTST2",3,0 ) | |
| 1272 | ; Referen ce to ^LAB (60 suppor ted by IA #333 | |
| 1273 | "RTN","YSC LTST2",4,0 ) | |
| 1274 | ; Referen ce to ^PSD RUG suppor ted by IA #25 | |
| 1275 | "RTN","YSC LTST2",5,0 ) | |
| 1276 | ; Referen ce to ^PS( 55 support ed by IA # 787 | |
| 1277 | "RTN","YSC LTST2",6,0 ) | |
| 1278 | ; Referen ce to ^XMD supported by IA #10 070 | |
| 1279 | "RTN","YSC LTST2",7,0 ) | |
| 1280 | ; Referen ce to ^LR7 OR1 suppor ted by IA #2503 | |
| 1281 | "RTN","YSC LTST2",8,0 ) | |
| 1282 | ; | |
| 1283 | "RTN","YSC LTST2",9,0 ) | |
| 1284 | TRANSMIT ; send remo te and loc al, kill a nd quit | |
| 1285 | "RTN","YSC LTST2",10, 0) | |
| 1286 | K XMZ S % DT="T",X=" NOW" D ^%D T S YSCLNO W=$P(Y,"." ,2),YSCLSI TE=$P($$SI TE^VASITE, "^",2) | |
| 1287 | "RTN","YSC LTST2",11, 0) | |
| 1288 | S $P(YSST OP,",",7)= 7 I $$S^%Z TLOAD D AB ORT^YSCLTE ST G END | |
| 1289 | "RTN","YSC LTST2",12, 0) | |
| 1290 | S YSDEBUG =$$GET1^DI Q(603.03,1 ,3,"I"),YS PROD=$$GET 1^DIQ(8989 .3,1,501," I") | |
| 1291 | "RTN","YSC LTST2",13, 0) | |
| 1292 | S YSPRODS T=$$GET1^D IQ(603.03, 1,8) ;S:YS PRODST="" YSPRODST=" S. D N
|
|
| 1293 | "RTN","YSC LTST2",14, 0) | |
| 1294 | S YSDBGST =$$GET1^DI Q(603.03,1 ,10) ;S:YS DBGST="" Y SDBGST="G. CLOZAPINE D N S. URL " | |
| 1295 | "RTN","YSC LTST2",15, 0) | |
| 1296 | ;/RBN - B egin modif ications f or YS*5.01 *122 | |
| 1297 | "RTN","YSC LTST2",16, 0) | |
| 1298 | I $G(YSCL LN) D | |
| 1299 | "RTN","YSC LTST2",17, 0) | |
| 1300 | .K XMY | |
| 1301 | "RTN","YSC LTST2",18, 0) | |
| 1302 | .I YSPROD D | |
| 1303 | "RTN","YSC LTST2",19, 0) | |
| 1304 | ..I 'YSDE BUG S XMY( YSPRODST)= "" ;XMY("G .CLOZAPINE ROLL-UP") ="" ;, | |
| 1305 | "RTN","YSC LTST2",20, 0) | |
| 1306 | ..E S XMY("G.C LOZAPINE D N S. URL ")="",XMY( "G.
|
|
| 1307 | "RTN","YSC LTST2",21, 0) | |
| 1308 | .E D | |
| 1309 | "RTN","YSC LTST2",22, 0) | |
| 1310 | ..I 'YSDE BUG S XMY( YSDBGST)=" " | |
| 1311 | "RTN","YSC LTST2",23, 0) | |
| 1312 | ..E S XM Y("G.CLOZA PINE DEBUG ")="" | |
| 1313 | "RTN","YSC LTST2",24, 0) | |
| 1314 | .S XMDUZ= "Clozapine MONITOR", XMTEXT="^T MP($J,",XM SUB=$S(YSD EBUG:"DEBU G ",1:"")_ "Clozapine lab data @ "_YSCLSI TE_" on "_ DT_" at "_ YSCLNOW D ^XMD | |
| 1315 | "RTN","YSC LTST2",25, 0) | |
| 1316 | K XMY | |
| 1317 | "RTN","YSC LTST2",26, 0) | |
| 1318 | S ^TMP("Y SCL",$J,2, 0)=" ",^TM P("YSCL",$ J,3,0)="In message # "_$S($D(X MZ):XMZ,1: "no data s ent") | |
| 1319 | "RTN","YSC LTST2",27, 0) | |
| 1320 | I 'YSDEBU G S XMY("G .PSOCLOZ") ="" S:YSPR OD XMY("G. CLOZAPINE ROLL-UP@FO RUM.VA.GOV ")="" | |
| 1321 | "RTN","YSC LTST2",28, 0) | |
| 1322 | E S XMY("G.C LOZAPINE D EBUG")="" S:YSPROD X MY("G.CLOZ APINE D N S. URL ")="" | |
| 1323 | "RTN","YSC LTST2",29, 0) | |
| 1324 | S XMSUB=$ S(YSDEBUG: "DEBUG ",1 :"")_"Cloz apine lab data @ "_Y SCLSITE_" on "_DT_" at "_YSCLN OW | |
| 1325 | "RTN","YSC LTST2",30, 0) | |
| 1326 | K XMZ S ^ TMP("YSCL" ,$J,1,0)=" Clozapine lab data w as transmi tted, "_YS CLLN_" rec ords were sent",XMTE XT="^TMP(" "YSCL"",$J ," D ^XMD | |
| 1327 | "RTN","YSC LTST2",31, 0) | |
| 1328 | S DIE="^Y SCL(603.03 ,",DA=1,DR ="5////"_$ $NOW^XLFDT D ^DIE ; S $P(^YSCL (603.03,1, 0),"^",5)= $$NOW^XLFD T | |
| 1329 | "RTN","YSC LTST2",32, 0) | |
| 1330 | ;/RBN - E nd modific ations for YS*5.01*1 22 | |
| 1331 | "RTN","YSC LTST2",33, 0) | |
| 1332 | END ; | |
| 1333 | "RTN","YSC LTST2",34, 0) | |
| 1334 | G END1^YS CLTST3 | |
| 1335 | "RTN","YSC LTST2",35, 0) | |
| 1336 | Q | |
| 1337 | "RTN","YSC LTST2",36, 0) | |
| 1338 | ; | |
| 1339 | "RTN","YSC LTST2",37, 0) | |
| 1340 | REXMIT ; r etransmit lab and RX data | |
| 1341 | "RTN","YSC LTST2",38, 0) | |
| 1342 | ; must be a tuesday | |
| 1343 | "RTN","YSC LTST2",39, 0) | |
| 1344 | S DIR(0)= "Y",DIR("A ")="Are yo u sure you wish to r etransmit lab data" | |
| 1345 | "RTN","YSC LTST2",40, 0) | |
| 1346 | D ^DIR K DIR I Y'=1 K Y Q | |
| 1347 | "RTN","YSC LTST2",41, 0) | |
| 1348 | ;/RBN Beg in modific ation for YS*122 | |
| 1349 | "RTN","YSC LTST2",42, 0) | |
| 1350 | D REX^YSC LTST5 | |
| 1351 | "RTN","YSC LTST2",43, 0) | |
| 1352 | ;/RBN End modificat ion for YS *122 | |
| 1353 | "RTN","YSC LTST2",44, 0) | |
| 1354 | Q | |
| 1355 | "RTN","YSC LTST2",45, 0) | |
| 1356 | ; | |
| 1357 | "RTN","YSC LTST2",46, 0) | |
| 1358 | DATE S %DT ="AEXP",%D T(0)=-DT,% DT("A")="E nding date for data collection ." | |
| 1359 | "RTN","YSC LTST2",47, 0) | |
| 1360 | D ^%DT K %DT G END: X="^",END: X="^" I Y= -1 G DATE | |
| 1361 | "RTN","YSC LTST2",48, 0) | |
| 1362 | ;/RBN Beg in modific ations for *122 | |
| 1363 | "RTN","YSC LTST2",49, 0) | |
| 1364 | S ZTDESC= "Server tr iggered re transmissi on" | |
| 1365 | "RTN","YSC LTST2",50, 0) | |
| 1366 | S ZTSAVE( "YSCLED")= "",ZTIO="" ,ZTRTN="RE XMIT^YSCLT ST5",ZTDTH =$H | |
| 1367 | "RTN","YSC LTST2",51, 0) | |
| 1368 | D REXMIT^ YSCLTST5 G END | |
| 1369 | "RTN","YSC LTST2",52, 0) | |
| 1370 | ;/RBN End modificat ions for * 122 | |
| 1371 | "RTN","YSC LTST2",53, 0) | |
| 1372 | FLSET ;Set up file 6 03.02 | |
| 1373 | "RTN","YSC LTST2",54, 0) | |
| 1374 | W @IOF,"T his option specifies the blood tests ass ociated wi th the Clo zapine" | |
| 1375 | "RTN","YSC LTST2",55, 0) | |
| 1376 | W !,"repo rting soft ware. Two tests mus t be defin ed. The f irst is th e White" | |
| 1377 | "RTN","YSC LTST2",56, 0) | |
| 1378 | W !,"Bloo d Count. The second is the Gr anulocyte (or Neutro phil) perc entage." | |
| 1379 | "RTN","YSC LTST2",57, 0) | |
| 1380 | K DIR W ! ! S DIR(0) ="PA^64:EM Z",DIR("A" ,1)="Enter the test that will be used to record th e White Bl ood Count for the",D IR("A")="C lozapine p atients: " D ^DIR | |
| 1381 | "RTN","YSC LTST2",58, 0) | |
| 1382 | Q:Y=-1!($ D(DUOUT))! ($D(DTOUT) )!($D(DIRU T))!($D(DI ROUT)) | |
| 1383 | "RTN","YSC LTST2",59, 0) | |
| 1384 | S YSCLWBC =+Y | |
| 1385 | "RTN","YSC LTST2",60, 0) | |
| 1386 | K DIR W ! ! S DIR(0) ="PA^64:EM Z",DIR("A" ,1)="Enter the test that will be used to record th e Neutroph il Count ( percentage )",DIR("A" )=" for th e Clozapin e patients : " D ^DIR | |
| 1387 | "RTN","YSC LTST2",61, 0) | |
| 1388 | Q:Y=-1!($ D(DUOUT))! ($D(DTOUT) )!($D(DIRU T))!($D(DI ROUT)) | |
| 1389 | "RTN","YSC LTST2",62, 0) | |
| 1390 | S YSCLGRN =+Y | |
| 1391 | "RTN","YSC LTST2",63, 0) | |
| 1392 | I YSCLWBC ,YSCLGRN D | |
| 1393 | "RTN","YSC LTST2",64, 0) | |
| 1394 | .K DD S D IC="^YSCL( 603.02,",X =YSCLWBC,D IC("DR")=" 1////"_YSC LGRN K DO D FILE^DIC N | |
| 1395 | "RTN","YSC LTST2",65, 0) | |
| 1396 | ;Only one entry is allowed. | |
| 1397 | "RTN","YSC LTST2",66, 0) | |
| 1398 | K DIR,X,Y ,YSCLWBC,Y SCLGRN,ZTD ESC | |
| 1399 | "RTN","YSC LTST2",67, 0) | |
| 1400 | Q | |
| 1401 | "RTN","YSC LTST2",68, 0) | |
| 1402 | EN(DRG) ; | |
| 1403 | "RTN","YSC LTST2",69, 0) | |
| 1404 | K LAB ;I $P($G(^PSD RUG(DRG,"C LOZ1")),"^ ")'="PSOCL O1" S LAB( "NOT")=0 Q | |
| 1405 | "RTN","YSC LTST2",70, 0) | |
| 1406 | I $$GET1^ DIQ(50,DRG ,17.5)'="P SOCLO1" S LAB("NOT") =0 Q | |
| 1407 | "RTN","YSC LTST2",71, 0) | |
| 1408 | N YSARRAY D LIST^DI C(50.02,", "_YSDRG_", ",3,"I",,, ,,,,"YSARR AY") | |
| 1409 | "RTN","YSC LTST2",72, 0) | |
| 1410 | S (CNT,I) =0 F S I= $O(YSARRAY ("DILIST", 2,I)) Q:'I S CNT=$G (CNT)+1 | |
| 1411 | "RTN","YSC LTST2",73, 0) | |
| 1412 | I CNT'=2 S LAB("BAD TEST")=0 K CNT Q | |
| 1413 | "RTN","YSC LTST2",74, 0) | |
| 1414 | K CNT F I =1:1 Q:'$D (YSARRAY(" DILIST","I D",I)) D | |
| 1415 | "RTN","YSC LTST2",75, 0) | |
| 1416 | .S LABT=$ S(YSARRAY( "DILIST"," ID",I,3)=1 :"WBC",1:" ANC"),YSLN =YSARRAY(" DILIST",2, I) | |
| 1417 | "RTN","YSC LTST2",76, 0) | |
| 1418 | .S LAB(LA BT)=$$GET1 ^DIQ(50.02 ,YSLN_","_ DRG,.01,"I ")_"^"_$$G ET1^DIQ(50 .02,YSLN_" ,"_DRG,2," I")_"^"_$$ GET1^DIQ(5 0.02,YSLN_ ","_DRG,3, "I") | |
| 1419 | "RTN","YSC LTST2",77, 0) | |
| 1420 | K LABT,I | |
| 1421 | "RTN","YSC LTST2",78, 0) | |
| 1422 | Q | |
| 1423 | "RTN","YSC LTST2",79, 0) | |
| 1424 | CL1(DFN,DA YS) ;The r outine was split due to size | |
| 1425 | "RTN","YSC LTST2",80, 0) | |
| 1426 | G CL1^YSC LTST4 | |
| 1427 | "RTN","YSC LTST2",81, 0) | |
| 1428 | Q | |
| 1429 | "RTN","YSC LTST2",82, 0) | |
| 1430 | ; | |
| 1431 | "RTN","YSC LTST2",83, 0) | |
| 1432 | CL(DFN) ; | |
| 1433 | "RTN","YSC LTST2",84, 0) | |
| 1434 | K ^TMP("L RRR",$J) N RESULTS,Y SCLYWBC,YS CLRANC,YSC LYANC,YSCL XANC,YSCLX WBC,YSCLRW BC,YSCLFRQ ,YSCLIEN | |
| 1435 | "RTN","YSC LTST2",85, 0) | |
| 1436 | I 'DFN Q "-1^-1^-1^ -1^-1^-1^- 1" | |
| 1437 | "RTN","YSC LTST2",86, 0) | |
| 1438 | N ARRAY D LIST^DIC( 603.01,,1, "I",,,DFN, "C",,,"ARR AY") | |
| 1439 | "RTN","YSC LTST2",87, 0) | |
| 1440 | ;I '$D(^Y SCL(603.01 ,"C",DFN)) Q "-1^-1^ -1^-1^-1^- 1^-1" | |
| 1441 | "RTN","YSC LTST2",88, 0) | |
| 1442 | I '$D(ARR AY("DILIST ","ID")) Q "-1^-1^-1 ^-1^-1^-1^ -1" | |
| 1443 | "RTN","YSC LTST2",89, 0) | |
| 1444 | S YSCLIEN =ARRAY("DI LIST",2,1) ,YSCLFRQ=" " ;$O(^YSC L(603.01," C",DFN,"") ),YSCLFRQ= "" | |
| 1445 | "RTN","YSC LTST2",90, 0) | |
| 1446 | I YSCLIEN S YSCLFRQ =$$GET1^DI Q(603.01,Y SCLIEN,2," I") | |
| 1447 | "RTN","YSC LTST2",91, 0) | |
| 1448 | I $$GET1^ DIQ(603.03 ,1,7,"I")= 1!(YSCLFRQ ="") Q "- 1^0^0^0^0^ 0^"_YSCLFR Q | |
| 1449 | "RTN","YSC LTST2",92, 0) | |
| 1450 | I $$GET1^ DIQ(55,DFN ,54,"I")'= "A" Q "-1 ^0^0^0^0^0 ^"_YSCLFRQ | |
| 1451 | "RTN","YSC LTST2",93, 0) | |
| 1452 | S X1=DT,X 2="-7" D C ^%DTC S YS CLSD=X | |
| 1453 | "RTN","YSC LTST2",94, 0) | |
| 1454 | K ARRAY D LIST^DIC( 603.41,",1 ,",,"I",,, ,,,,"ARRAY ") | |
| 1455 | "RTN","YSC LTST2",95, 0) | |
| 1456 | F I=1:1 Q :'$D(ARRAY ("DILIST", 2,I)) S Y SCLA=ARRAY ("DILIST", 2,I) D | |
| 1457 | "RTN","YSC LTST2",96, 0) | |
| 1458 | . N YSCLT NM,YSCLTTP ,YSCLTFR S YSCLTNM=$ $GET1^DIQ( 603.41,YSC LA_",1,",. 01,"I") | |
| 1459 | "RTN","YSC LTST2",97, 0) | |
| 1460 | . S YSCLT TP=$$GET1^ DIQ(603.41 ,YSCLA_",1 ,",1,"I") | |
| 1461 | "RTN","YSC LTST2",98, 0) | |
| 1462 | . S YSCLT FR=$$GET1^ DIQ(603.41 ,YSCLA_",1 ,",2,"I") | |
| 1463 | "RTN","YSC LTST2",99, 0) | |
| 1464 | . S YSCLT LS(YSCLTTP ,YSCLTNM)= YSCLTFR | |
| 1465 | "RTN","YSC LTST2",100 ,0) | |
| 1466 | F I=1:1 Q :'$D(ARRAY ("DILIST", 1,I)) S Y SCLTL=ARRA Y("DILIST" ,1,I) D | |
| 1467 | "RTN","YSC LTST2",101 ,0) | |
| 1468 | . D RR^LR 7OR1(DFN,, YSCLSD,DT, ,YSCLTL,"L ") | |
| 1469 | "RTN","YSC LTST2",102 ,0) | |
| 1470 | . S YSCLS B1="" F S YSCLSB1=$ O(^TMP("LR RR",$J,DFN ,YSCLSB1)) Q:YSCLSB1 ="" D | |
| 1471 | "RTN","YSC LTST2",103 ,0) | |
| 1472 | . . S YSC LTDT="" F S YSCLTDT =$O(^TMP(" LRRR",$J,D FN,YSCLSB1 ,YSCLTDT)) Q:YSCLTDT ="" I $P( YSCLTDT,". ",2)]"" D | |
| 1473 | "RTN","YSC LTST2",104 ,0) | |
| 1474 | . . . S Y SCLTA="" F S YSCLTA =$O(^TMP(" LRRR",$J,D FN,YSCLSB1 ,YSCLTDT,Y SCLTA)) Q: YSCLTA="" I YSCLTA D | |
| 1475 | "RTN","YSC LTST2",105 ,0) | |
| 1476 | . . . . S RESULTS1= ^TMP("LRRR ",$J,DFN,Y SCLSB1,YSC LTDT,YSCLT A) | |
| 1477 | "RTN","YSC LTST2",106 ,0) | |
| 1478 | . . . . S RESULTS(Y SCLTL,YSCL TDT)=$P(RE SULTS1,"^" ,2) | |
| 1479 | "RTN","YSC LTST2",107 ,0) | |
| 1480 | ;Find all entries f or WBC and sort by i nverse dat e. | |
| 1481 | "RTN","YSC LTST2",108 ,0) | |
| 1482 | S YSCLA=" " F S YSC LA=$O(YSCL TLS("W",YS CLA)) Q:'Y SCLA S YS CLXWBC(YSC LA)="" D | |
| 1483 | "RTN","YSC LTST2",109 ,0) | |
| 1484 | . S YSCL A1="" F S YSCLA1=$O (RESULTS(Y SCLA,YSCLA 1)) Q:'YSC LA1 S YSC LYWBC(YSCL A1)=RESULT S(YSCLA,YS CLA1)_"^"_ $$GET1^DIQ (60,YSCLA, .01)_"^"_Y SCLTLS("W" ,YSCLA) | |
| 1485 | "RTN","YSC LTST2",110 ,0) | |
| 1486 | I '$D(YSC LYWBC) G A LTANC | |
| 1487 | "RTN","YSC LTST2",111 ,0) | |
| 1488 | I $D(YSCL XWBC),$D(Y SCLYWBC) D | |
| 1489 | "RTN","YSC LTST2",112 ,0) | |
| 1490 | .S YSCLRW BC=$O(YSCL YWBC(0)) I 'YSCLRWBC ;D KILL Q "0^^^^^^" _YSCLFRQ | |
| 1491 | "RTN","YSC LTST2",113 ,0) | |
| 1492 | .S YSCLMU LT=$P(YSCL YWBC(YSCLR WBC),"^",3 ),YSCLMULT =$S(YSCLMU LT:1000,1: 1) | |
| 1493 | "RTN","YSC LTST2",114 ,0) | |
| 1494 | .S YSCLRW BC(YSCLRWB C)=($P(YSC LYWBC(YSCL RWBC),"^") *YSCLMULT) _"^"_$P(YS CLYWBC(YSC LRWBC),"^" ,2) | |
| 1495 | "RTN","YSC LTST2",115 ,0) | |
| 1496 | .;Scan fo r Neutroph il count o n same day and time as most re cent WBC | |
| 1497 | "RTN","YSC LTST2",116 ,0) | |
| 1498 | .S YSCLMT CH=0 F YSC LA="A","N" ,"S","T" S YSCLTPT=" " Q:YSCLMT CH F S Y SCLTPT=$O( YSCLTLS(YS CLA,YSCLTP T)) Q:'YSC LTPT D Q :YSCLMTCH | |
| 1499 | "RTN","YSC LTST2",117 ,0) | |
| 1500 | ..S YSCLM ULT=YSCLTL S(YSCLA,YS CLTPT),YSC LMULT=$S(Y SCLMULT:10 00,1:1) | |
| 1501 | "RTN","YSC LTST2",118 ,0) | |
| 1502 | ..I $G(R ESULTS(YSC LTPT,YSCLR WBC)),YSCL A="A",RESU LTS(YSCLTP T,YSCLRWBC )'?1A.E S YSCLMTCH=1 ,YSCLRANC( YSCLRWBC)= RESULTS(YS CLTPT,YSCL RWBC)*YSCL MULT_"^"_$ $GET1^DIQ( 60,YSCLTPT ,.01) Q | |
| 1503 | "RTN","YSC LTST2",119 ,0) | |
| 1504 | ..I $G(R ESULTS(YSC LTPT,YSCLR WBC)),YSCL A="N",RESU LTS(YSCLTP T,YSCLRWBC )'?1A.E S YSCLMTCH=1 ,YSCLRANC( YSCLRWBC)= YSCLRWBC(Y SCLRWBC)*( (RESULTS(Y SCLTPT,YSC LRWBC))*.0 1)_"^"_$$G ET1^DIQ(60 ,YSCLTPT,. 01) Q | |
| 1505 | "RTN","YSC LTST2",120 ,0) | |
| 1506 | ..I $G(R ESULTS(YSC LTPT,YSCLR WBC)),YSCL A="S",RESU LTS(YSCLTP T,YSCLRWBC )'?1A.E D | |
| 1507 | "RTN","YSC LTST2",121 ,0) | |
| 1508 | ...S YSC LSGS="" F S YSCLSGS =$O(YSCLTL S("B",YSCL SGS)) D Q :YSCLMTCH! 'YSCLSGS | |
| 1509 | "RTN","YSC LTST2",122 ,0) | |
| 1510 | ....S:'Y SCLSGS YSC LSGS="Z" I '$D(RESUL TS(YSCLSGS ,YSCLRWBC) ) S RESULT S(YSCLSGS, YSCLRWBC)= 0 | |
| 1511 | "RTN","YSC LTST2",123 ,0) | |
| 1512 | ....S YS CLMTCH=1,Y SCLRANC(YS CLRWBC)=YS CLRWBC(YSC LRWBC)*((R ESULTS(YSC LTPT,YSCLR WBC)*.01)+ (RESULTS(Y SCLSGS,YSC LRWBC)*.01 ))_"^"_$$G ET1^DIQ(60 ,YSCLTPT,. 01)_"/"_$$ GET1^DIQ(6 0,YSCLSGS, .01) Q | |
| 1513 | "RTN","YSC LTST2",124 ,0) | |
| 1514 | ..I $G(R ESULTS(YSC LTPT,YSCLR WBC)),YSCL A="C",RESU LTS(YSCLTP T,YSCLRWBC )'?1A.E D | |
| 1515 | "RTN","YSC LTST2",125 ,0) | |
| 1516 | ...S YSC LSGS="" F S YSCLSGS =$O(YSCLTL S("T",YSCL SGS)) D Q :YSCLMTCH! 'YSCLSGS | |
| 1517 | "RTN","YSC LTST2",126 ,0) | |
| 1518 | ....S:'Y SCLSGS YSC LSGS="Z" I '$D(RESUL TS(YSCLSGS ,YSCLRWBC) ) S RESULT S(YSCLSGS, YSCLRWBC)= 0 | |
| 1519 | "RTN","YSC LTST2",127 ,0) | |
| 1520 | ....S YS CLMTCH=1,Y SCLRANC(YS CLRWBC)=(( RESULTS(YS CLTPT,YSCL RWBC)*YSCL MULT)+(RES ULTS(YSCLS GS,YSCLRWB C)*YSCLMUL T))_"^"_$P (^LAB(60,Y SCLTPT,0), "^")_"/"_$ P($G(^LAB( 60,YSCLSGS ,0)),"^") Q | |
| 1521 | "RTN","YSC LTST2",128 ,0) | |
| 1522 | D KILL | |
| 1523 | "RTN","YSC LTST2",129 ,0) | |
| 1524 | I '$G(YSC LRWBC(YSCL RWBC)),'+$ G(YSCLRANC (YSCLRWBC) ) Q "0^^^^ ^^"_YSCLFR Q | |
| 1525 | "RTN","YSC LTST2",130 ,0) | |
| 1526 | I $G(YSCL RWBC(YSCLR WBC)),+$G( YSCLRANC(Y SCLRWBC))< 1000 Q "0^ "_$G(YSCLR WBC(YSCLRW BC))_"^"_$ S($G(YSCLR ANC(YSCLRW BC))="":"^ ",1:$G(YSC LRANC(YSCL RWBC)))_"^ "_(9999999 -YSCLRWBC) _"^"_YSCLF RQ | |
| 1527 | "RTN","YSC LTST2",131 ,0) | |
| 1528 | I '$G(YSC LRWBC(YSCL RWBC)),+$G (YSCLRANC( YSCLRWBC)) <1000 Q "0 ^"_$G(YSCL RWBC(YSCLR WBC))_"^"_ $S($G(YSCL RANC(YSCLR WBC))="":" ^",1:$G(YS CLRANC(YSC LRWBC)))_" ^"_(999999 9-YSCLRWBC )_"^"_YSCL FRQ | |
| 1529 | "RTN","YSC LTST2",132 ,0) | |
| 1530 | I '$G(YSC LRWBC(YSCL RWBC)),+$G (YSCLRANC( YSCLRWBC)) Q "0^"_$G (YSCLRWBC( YSCLRWBC)) _"^"_$S($G (YSCLRANC( YSCLRWBC)) ="":"^",1: $G(YSCLRAN C(YSCLRWBC )))_"^"_(9 999999-YSC LRWBC)_"^" _YSCLFRQ | |
| 1531 | "RTN","YSC LTST2",133 ,0) | |
| 1532 | I $G(YSCL RWBC(YSCLR WBC)),+$G( YSCLRANC(Y SCLRWBC))< 1500 Q "2^ "_$G(YSCLR WBC(YSCLRW BC))_"^"_$ S($G(YSCLR ANC(YSCLRW BC))="":"^ ",1:$G(YSC LRANC(YSCL RWBC)))_"^ "_(9999999 -YSCLRWBC) _"^"_YSCLF RQ | |
| 1533 | "RTN","YSC LTST2",134 ,0) | |
| 1534 | ;;END NCC REMEDIATI ON << RJS* 122 | |
| 1535 | "RTN","YSC LTST2",135 ,0) | |
| 1536 | Q "1^"_YS CLRWBC(YSC LRWBC)_"^" _YSCLRANC( YSCLRWBC)_ "^"_(99999 99-YSCLRWB C)_"^"_YSC LFRQ | |
| 1537 | "RTN","YSC LTST2",136 ,0) | |
| 1538 | ; | |
| 1539 | "RTN","YSC LTST2",137 ,0) | |
| 1540 | ;;START N CC REMEDIA TION >> RJ S*122 | |
| 1541 | "RTN","YSC LTST2",138 ,0) | |
| 1542 | ALTANC ; | |
| 1543 | "RTN","YSC LTST2",139 ,0) | |
| 1544 | S YSCLA=0 F S YSCL A=$O(YSCLT LS("A",YSC LA)) Q:'YS CLA S YSC LXANC(YSCL A)="" D | |
| 1545 | "RTN","YSC LTST2",140 ,0) | |
| 1546 | .S YSCLA1 =0 F S YS CLA1=$O(RE SULTS(YSCL A,YSCLA1)) Q:'YSCLA1 S YSCLYA NC(YSCLA1) =RESULTS(Y SCLA,YSCLA 1)_"^"_$$G ET1^DIQ(60 ,YSCLA,.01 )_"^"_YSCL TLS("A",YS CLA) | |
| 1547 | "RTN","YSC LTST2",141 ,0) | |
| 1548 | I $D(YSCL YANC) D | |
| 1549 | "RTN","YSC LTST2",142 ,0) | |
| 1550 | .S (YSCLR ANC,YSCLRW BC)=$O(YSC LYANC(0)) I 'YSCLRAN C ;D KILL Q "0^^^^^^ "_YSCLFRQ | |
| 1551 | "RTN","YSC LTST2",143 ,0) | |
| 1552 | .S YSCLMU LT=$P(YSCL YANC(YSCLR ANC),"^",3 ),YSCLMULT =$S(YSCLMU LT:1000,1: 1) | |
| 1553 | "RTN","YSC LTST2",144 ,0) | |
| 1554 | .S YSCLRA NC(YSCLRAN C)=($P(YSC LYANC(YSCL RANC),"^") *YSCLMULT) _"^"_$P(YS CLYANC(YSC LRANC),"^" ,2) | |
| 1555 | "RTN","YSC LTST2",145 ,0) | |
| 1556 | .;Scan fo r Neutroph il count o n same day and time as most re cent ANC | |
| 1557 | "RTN","YSC LTST2",146 ,0) | |
| 1558 | .S YSCLMT CH=0 F YSC LA="A","N" ,"S","T" S YSCLTPT=" " Q:YSCLMT CH F S Y SCLTPT=$O( YSCLTLS(YS CLA,YSCLTP T)) Q:'YSC LTPT D Q :YSCLMTCH | |
| 1559 | "RTN","YSC LTST2",147 ,0) | |
| 1560 | ..S YSCLM ULT=YSCLTL S(YSCLA,YS CLTPT),YSC LMULT=$S(Y SCLMULT:10 00,1:1) | |
| 1561 | "RTN","YSC LTST2",148 ,0) | |
| 1562 | ..I $D(RE SULTS(YSCL TPT,YSCLRA NC)),YSCLA ="A",RESUL TS(YSCLTPT ,YSCLRANC) '?1A.E S Y SCLMTCH=1, YSCLRANC(Y SCLRANC)=R ESULTS(YSC LTPT,YSCLR ANC)*YSCLM ULT_"^"_$$ GET1^DIQ(6 0,YSCLTPT, .01) Q | |
| 1563 | "RTN","YSC LTST2",149 ,0) | |
| 1564 | ..I $D(RE SULTS(YSCL TPT,YSCLRA NC)),YSCLA ="N",RESUL TS(YSCLTPT ,YSCLRANC) '?1A.E S Y SCLMTCH=1, YSCLRANC(Y SCLRANC)=Y SCLRANC(YS CLRANC)*(( RESULTS(YS CLTPT,YSCL RANC))*.01 )_"^"_$$GE T1^DIQ(60, YSCLTPT,.0 1) Q | |
| 1565 | "RTN","YSC LTST2",150 ,0) | |
| 1566 | ..I $D(RE SULTS(YSCL TPT,YSCLRA NC)),YSCLA ="S",RESUL TS(YSCLTPT ,YSCLRANC) '?1A.E D | |
| 1567 | "RTN","YSC LTST2",151 ,0) | |
| 1568 | ...S YSCL SGS="" F S YSCLSGS= $O(YSCLTLS ("B",YSCLS GS)) D Q: YSCLMTCH | |
| 1569 | "RTN","YSC LTST2",152 ,0) | |
| 1570 | ....S:'YS CLSGS YSCL SGS="Z" I '$D(RESULT S(YSCLSGS, YSCLRANC)) S RESULTS (YSCLSGS,Y SCLRANC)=0 | |
| 1571 | "RTN","YSC LTST2",153 ,0) | |
| 1572 | ....S YSC LMTCH=1,YS CLRANC(YSC LRANC)=YSC LRANC(YSCL RANC)*((RE SULTS(YSCL TPT,YSCLRA NC)*.01)+( RESULTS(YS CLSGS,YSCL RANC)*.01) )_"^"_$$GE T1^DIQ(60, YSCLTPT,.0 1)_"/"_$$G ET1^DIQ(60 ,YSCLSGS,. 01) Q | |
| 1573 | "RTN","YSC LTST2",154 ,0) | |
| 1574 | ..I $D(RE SULTS(YSCL TPT,YSCLRA NC)),YSCLA ="C",RESUL TS(YSCLTPT ,YSCLRANC) '?1A.E D | |
| 1575 | "RTN","YSC LTST2",155 ,0) | |
| 1576 | ...S YSCL SGS="" F S YSCLSGS= $O(YSCLTLS ("T",YSCLS GS)) D Q: YSCLMTCH | |
| 1577 | "RTN","YSC LTST2",156 ,0) | |
| 1578 | ....S:'YS CLSGS YSCL SGS="Z" I '$D(RESULT S(YSCLSGS, YSCLRANC)) S RESULTS (YSCLSGS,Y SCLRANC)=0 | |
| 1579 | "RTN","YSC LTST2",157 ,0) | |
| 1580 | ....S YSC LMTCH=1,YS CLRANC(YSC LRANC)=((R ESULTS(YSC LTPT,YSCLR ANC)*YSCLM ULT)+(RESU LTS(YSCLSG S,YSCLRANC )*YSCLMULT ))_"^"_$P( ^LAB(60,YS CLTPT,0)," ^")_"/"_$P ($G(^LAB(6 0,YSCLSGS, 0)),"^") Q | |
| 1581 | "RTN","YSC LTST2",158 ,0) | |
| 1582 | .S YSCLRW BC(YSCLRWB C)="^WBC" | |
| 1583 | "RTN","YSC LTST2",159 ,0) | |
| 1584 | D KILL | |
| 1585 | "RTN","YSC LTST2",160 ,0) | |
| 1586 | I '$G(YSC LRANC(+$G( YSCLRWBC)) ) Q "0^^^^ ^^"_YSCLFR Q | |
| 1587 | "RTN","YSC LTST2",161 ,0) | |
| 1588 | I +$G(YSC LRANC(YSCL RWBC))<100 0 Q "0^"_$ G(YSCLRWBC (YSCLRWBC) )_"^"_$S($ G(YSCLRANC (YSCLRWBC) )="":"^",1 :$G(YSCLRA NC(YSCLRWB C)))_"^"_( 9999999-YS CLRWBC)_"^ "_YSCLFRQ | |
| 1589 | "RTN","YSC LTST2",162 ,0) | |
| 1590 | I +$G(YSC LRANC(YSCL RWBC))<150 0 Q "0^"_$ G(YSCLRWBC (YSCLRWBC) )_"^"_$S($ G(YSCLRANC (YSCLRWBC) )="":"^",1 :$G(YSCLRA NC(YSCLRWB C)))_"^"_( 9999999-YS CLRWBC)_"^ "_YSCLFRQ | |
| 1591 | "RTN","YSC LTST2",163 ,0) | |
| 1592 | Q "0^"_$G (YSCLRWBC( YSCLRWBC)) _"^"_$S($G (YSCLRANC( YSCLRWBC)) ="":"^",1: $G(YSCLRAN C(YSCLRWBC )))_"^"_(9 999999-YSC LRWBC)_"^" _YSCLFRQ | |
| 1593 | "RTN","YSC LTST2",164 ,0) | |
| 1594 | ;;END NCC REMEDIATI ON << RJS* 122 | |
| 1595 | "RTN","YSC LTST2",165 ,0) | |
| 1596 | ; | |
| 1597 | "RTN","YSC LTST2",166 ,0) | |
| 1598 | KILL ; | |
| 1599 | "RTN","YSC LTST2",167 ,0) | |
| 1600 | ;Q:$D(PSL AST7) ;RT W | |
| 1601 | "RTN","YSC LTST2",168 ,0) | |
| 1602 | K FDA,YSC LSGS,Y15,R ESULTS,RES ULTS1,YSCL A,YSCLA1,Y SCLMTCH,YS CLSB1,YSCL SD,YSCLTA, YSCLMULT | |
| 1603 | "RTN","YSC LTST2",169 ,0) | |
| 1604 | K YSCLTL, YSCLTLS,X1 ,X2 | |
| 1605 | "RTN","YSC LTST2",170 ,0) | |
| 1606 | Q | |
| 1607 | "RTN","YSC LTST2",171 ,0) | |
| 1608 | ; | |
| 1609 | "RTN","YSC LTST2",172 ,0) | |
| 1610 | OVERRIDE(D FN) ;Check for an ov er-ride. SEE RQ12. 11 | |
| 1611 | "RTN","YSC LTST2",173 ,0) | |
| 1612 | N YSCLIEN ,YSCLOVRD, ARRAY ;S Y SCLIEN=$O( ^YSCL(603. 01,"C",DFN ,0)) Q:YSC LIEN="" 0 | |
| 1613 | "RTN","YSC LTST2",174 ,0) | |
| 1614 | S YSCLIEN =$$FIND1^D IC(603.01, ,"Q",DFN," C") Q:YSCL IEN="" 0 | |
| 1615 | "RTN","YSC LTST2",175 ,0) | |
| 1616 | S YSCLOVR D=$$GET1^D IQ(603.01, YSCLIEN,3, "I") | |
| 1617 | "RTN","YSC LTST2",176 ,0) | |
| 1618 | S:YSCLOVR D'=DT ANQR E="" | |
| 1619 | "RTN","YSC LTST2",177 ,0) | |
| 1620 | I '$G(PSG CFLG),$G(Y SCLOVRD),D T>YSCLOVRD S X=YSCLO VRD,YSCXDA TE=$$FMTE^ XLFDT(X,"D ") W !,"Na tional Ove rride expi red at mid night on " _YSCXDATE | |
| 1621 | "RTN","YSC LTST2",178 ,0) | |
| 1622 | Q YSCLOVR D=DT | |
| 1623 | "RTN","YSC LTST2",179 ,0) | |
| 1624 | ZEOR ;YSCL TST2 | |
| 1625 | "RTN","YSC LTST3") | |
| 1626 | 0^4^B68700 177 | |
| 1627 | "RTN","YSC LTST3",1,0 ) | |
| 1628 | YSCLTST3 ; DALOI/LB/R LM-TRANSMI SSION FOR CLOZAPINE REPORTING SYSTEM ;Ju l 14, 2017 @09:00:07 | |
| 1629 | "RTN","YSC LTST3",2,0 ) | |
| 1630 | ;;5.01;ME NTAL HEALT H;**18,22, 25,26,47,6 1,69,74,90 ,122**;Dec 30, 1994; Build 61 | |
| 1631 | "RTN","YSC LTST3",3,0 ) | |
| 1632 | ; Referen ce to ^DPT supported by IA #10 035 | |
| 1633 | "RTN","YSC LTST3",4,0 ) | |
| 1634 | ; Referen ce to ^PS( 55 support ed by IA # 787 | |
| 1635 | "RTN","YSC LTST3",5,0 ) | |
| 1636 | ; Referen ce to ^PS( 59 support ed by IA # 783 | |
| 1637 | "RTN","YSC LTST3",6,0 ) | |
| 1638 | ; Referen ce to ^VA( 200 suppor ted by IA #10060 | |
| 1639 | "RTN","YSC LTST3",7,0 ) | |
| 1640 | ; Referen ce to ^LAB (60 suppor ted by IA #333 | |
| 1641 | "RTN","YSC LTST3",8,0 ) | |
| 1642 | ; Referen ce to ^XMD supported by IA #10 070 | |
| 1643 | "RTN","YSC LTST3",9,0 ) | |
| 1644 | DEMOG ; Ol d entry po int to sen d demograp hic data f or patient s from tas k. Obsolet e | |
| 1645 | "RTN","YSC LTST3",10, 0) | |
| 1646 | Q | |
| 1647 | "RTN","YSC LTST3",11, 0) | |
| 1648 | DMG ; Call ed by YSCL TEST | |
| 1649 | "RTN","YSC LTST3",12, 0) | |
| 1650 | S YSDEBUG =$$GET1^DI Q(603.03,1 ,3,"I") | |
| 1651 | "RTN","YSC LTST3",13, 0) | |
| 1652 | K ^TMP($J ),^TMP("YS CL",$J),^T MP("YSCLL" ,$J) S YSC LLN=0,YSCL NO=20,DFN= 0,YSCLIEN= 0 | |
| 1653 | "RTN","YSC LTST3",14, 0) | |
| 1654 | N ARRAY D LIST^DIC( 603.01,,1, "I",,,,,,, "ARRAY") | |
| 1655 | "RTN","YSC LTST3",15, 0) | |
| 1656 | F I=1:1 Q :'$D(ARRAY ("DILIST", 2,I)) K Y SCLA S YSC LIEN=ARRAY ("DILIST", 2,I) D | |
| 1657 | "RTN","YSC LTST3",16, 0) | |
| 1658 | .S DFN=AR RAY("DILIS T","ID",I, 1),$P(YSST OP,",",8)= 8 Q:$$S^%Z TLOAD!'DFN | |
| 1659 | "RTN","YSC LTST3",17, 0) | |
| 1660 | .I $L($$G ET1^DIQ(2, DFN,.01)) S YSCLC=$$ GET1^DIQ(6 03.01,YSCL IEN,.01) D GET | |
| 1661 | "RTN","YSC LTST3",18, 0) | |
| 1662 | D TRANSMI T:YSCLLN G END | |
| 1663 | "RTN","YSC LTST3",19, 0) | |
| 1664 | ; | |
| 1665 | "RTN","YSC LTST3",20, 0) | |
| 1666 | GET ; | |
| 1667 | "RTN","YSC LTST3",21, 0) | |
| 1668 | S $P(YSST OP,",",9)= 9 Q:$$S^%Z TLOAD | |
| 1669 | "RTN","YSC LTST3",22, 0) | |
| 1670 | Q:'$L($$G ET1^DIQ(55 ,DFN,53)) ;Don't tr y to trans mit if no pharmacy r ecord | |
| 1671 | "RTN","YSC LTST3",23, 0) | |
| 1672 | Q:$$GET1^ DIQ(55,DFN ,56,"I") ;Don't re transmit d emographic s. | |
| 1673 | "RTN","YSC LTST3",24, 0) | |
| 1674 | Q:$D(^TMP ("YSCLL",$ J,DFN)) | |
| 1675 | "RTN","YSC LTST3",25, 0) | |
| 1676 | S ^TMP("Y SCLL",$J,D FN)=1 | |
| 1677 | "RTN","YSC LTST3",26, 0) | |
| 1678 | S YSCLP=$ $GET1^DIQ( 55,DFN,57, "I"),YSCLD EA=$$GET1^ DIQ(200,YS CLP,53.2), YSCLP=$$GE T1^DIQ(200 ,YSCLP,.01 ) | |
| 1679 | "RTN","YSC LTST3",27, 0) | |
| 1680 | D DEM^VAD PT,ADD^VAD PT S YSCL= YSCLC_"^"_ $E($P(VADM (1),",",2) )_$E(VADM( 1))_"^"_$P (VADM(3)," ^")_"^"_$P (VADM(2)," ^")_"^"_$P (VADM(5)," ^")_"^"_VA PA(6)_"^"_ DT | |
| 1681 | "RTN","YSC LTST3",28, 0) | |
| 1682 | D | |
| 1683 | "RTN","YSC LTST3",29, 0) | |
| 1684 | .S YSRACE ="*" | |
| 1685 | "RTN","YSC LTST3",30, 0) | |
| 1686 | .S YSRC=0 F S YSRC =$O(VADM(1 1,YSRC)) Q :'YSRC S YSRACE=YSR ACE_+VADM( 11,YSRC)_" -"_+VADM(1 1,YSRC,1)_ "," | |
| 1687 | "RTN","YSC LTST3",31, 0) | |
| 1688 | .S YSRACE =YSRACE_"~ " | |
| 1689 | "RTN","YSC LTST3",32, 0) | |
| 1690 | .S YSRC=0 F S YSRC =$O(VADM(1 2,YSRC)) Q :'YSRC S YSRACE=YSR ACE_+VADM( 12,YSRC)_" -"_+VADM(1 2,YSRC,1)_ "," | |
| 1691 | "RTN","YSC LTST3",33, 0) | |
| 1692 | S YSCL=YS CL_"^"_YSR ACE_"^"_YS CLP_"^"_YS CLDEA | |
| 1693 | "RTN","YSC LTST3",34, 0) | |
| 1694 | ; YSCLJ c ontaining a ZIP code | |
| 1695 | "RTN","YSC LTST3",35, 0) | |
| 1696 | N ARRAY59 D LIST^DI C(59,,"1;. 05",,,,,,, ,"ARRAY59" ) | |
| 1697 | "RTN","YSC LTST3",36, 0) | |
| 1698 | F YSCLJ=1 :1 Q:'$D(A RRAY59("DI LIST","ID" ,YSCLJ)) I ARRAY59( "DILIST"," ID",YSCLJ, 1)'="" S Y SCLJ=ARRAY 59("DILIST ","ID",YSC LJ,.05) Q | |
| 1699 | "RTN","YSC LTST3",37, 0) | |
| 1700 | S YSCL=YS CL_"^"_YSC LJ | |
| 1701 | "RTN","YSC LTST3",38, 0) | |
| 1702 | ;registra tion numbe r^initials ^dob^ssn^s ex^zip^tod ay^race^ph ysician^de a^zip code (hosp) | |
| 1703 | "RTN","YSC LTST3",39, 0) | |
| 1704 | S YSCLLN= YSCLLN+1,^ TMP($J,YSC LLN,0)=YSC L | |
| 1705 | "RTN","YSC LTST3",40, 0) | |
| 1706 | I VADM(5) =""!(VAPA( 6)="")!('V ADM(11))!( 'VADM(12)) D ;RLM R ACETEST | |
| 1707 | "RTN","YSC LTST3",41, 0) | |
| 1708 | .S ^TMP(" YSCL",$J,Y SCLNO,0)=$ P(VADM(2), "^",1)_" "_VADM(1) | |
| 1709 | "RTN","YSC LTST3",42, 0) | |
| 1710 | .S:VADM(5 )="" ^TMP( "YSCL",$J, YSCLNO,0)= ^TMP("YSCL ",$J,YSCLN O,0)_" (SE X)" | |
| 1711 | "RTN","YSC LTST3",43, 0) | |
| 1712 | .S:VAPA(6 )="" ^TMP( "YSCL",$J, YSCLNO,0)= ^TMP("YSCL ",$J,YSCLN O,0)_" (ZI P)" | |
| 1713 | "RTN","YSC LTST3",44, 0) | |
| 1714 | .S:'VADM( 12) ^TMP(" YSCL",$J,Y SCLNO,0)=^ TMP("YSCL" ,$J,YSCLNO ,0)_" (RAC E, NEW FOR MAT)" | |
| 1715 | "RTN","YSC LTST3",45, 0) | |
| 1716 | .S:'VADM( 11) ^TMP(" YSCL",$J,Y SCLNO,0)=^ TMP("YSCL" ,$J,YSCLNO ,0)_" (ETH NICITY)" | |
| 1717 | "RTN","YSC LTST3",46, 0) | |
| 1718 | .S YSCLNO =YSCLNO+1 | |
| 1719 | "RTN","YSC LTST3",47, 0) | |
| 1720 | .S ^TMP(" YSCLL",$J, DFN)=0 ; l eave unmar ked pendin g demograp hic data | |
| 1721 | "RTN","YSC LTST3",48, 0) | |
| 1722 | .I ('VADM (11))!('VA DM(12)) D | |
| 1723 | "RTN","YSC LTST3",49, 0) | |
| 1724 | ..S ^TMP( "YSCL",$J, YSCLNO,0)= "NOTE: Rac e and Ethn icity may be entered if permis sion is ob tained in the inform ed consent ",YSCLNO=Y SCLNO+1 | |
| 1725 | "RTN","YSC LTST3",50, 0) | |
| 1726 | ..S ^TMP( "YSCL",$J, YSCLNO,0)= "document. See VHA D irective 9 9-035.",YS CLNO=YSCLN O+1 | |
| 1727 | "RTN","YSC LTST3",51, 0) | |
| 1728 | ; | |
| 1729 | "RTN","YSC LTST3",52, 0) | |
| 1730 | Q | |
| 1731 | "RTN","YSC LTST3",53, 0) | |
| 1732 | ; | |
| 1733 | "RTN","YSC LTST3",54, 0) | |
| 1734 | TRANSMIT ; remote an d local me ssages | |
| 1735 | "RTN","YSC LTST3",55, 0) | |
| 1736 | S $P(YSST OP,",",10) =10 Q:$$S^ %ZTLOAD | |
| 1737 | "RTN","YSC LTST3",56, 0) | |
| 1738 | S YSDEBUG =$$GET1^DI Q(603.03,1 ,3,"I"),YS PROD=$$GET 1^DIQ(8989 .3,1,501," I") | |
| 1739 | "RTN","YSC LTST3",57, 0) | |
| 1740 | S YSPRODS T=$$GET1^D IQ(603.03, 1,9) ;S:YS PRODST="" YSPRODST=" S.
|
|
| 1741 | "RTN","YSC LTST3",58, 0) | |
| 1742 | S YSDBGST =$$GET1^DI Q(603.03,1 ,11) ;S:YS DBGST="" Y SDBGST="G. CLOZAPINE D N S. URL " | |
| 1743 | "RTN","YSC LTST3",59, 0) | |
| 1744 | ;/RBN - B egin modif ications f or YS*5.01 *122 | |
| 1745 | "RTN","YSC LTST3",60, 0) | |
| 1746 | I YSCLLN D | |
| 1747 | "RTN","YSC LTST3",61, 0) | |
| 1748 | .I YSPROD D | |
| 1749 | "RTN","YSC LTST3",62, 0) | |
| 1750 | ..I 'YSDE BUG S XMY( YSPRODST)= "" ;XMY("G .CLOZAPINE ROLL-UP") ="" ;, | |
| 1751 | "RTN","YSC LTST3",63, 0) | |
| 1752 | ..E S XMY("G.C LOZAPINE D N S. URL ")="",XMY( "G.
|
|
| 1753 | "RTN","YSC LTST3",64, 0) | |
| 1754 | .E D | |
| 1755 | "RTN","YSC LTST3",65, 0) | |
| 1756 | ..I 'YSDE BUG S XMY( YSDBGST)=" " | |
| 1757 | "RTN","YSC LTST3",66, 0) | |
| 1758 | ..E S XM Y("G.CLOZA PINE DEBUG ")="" | |
| 1759 | "RTN","YSC LTST3",67, 0) | |
| 1760 | .S XMDUZ= "CLOZAPINE MONITOR", XMTEXT="^T MP($J,",XM SUB=$S(YSD EBUG:"DEBU G ",1:"")_ "Clozapine demograph ics" D ^XM D | |
| 1761 | "RTN","YSC LTST3",68, 0) | |
| 1762 | .N DIE,DA ,DR S DIE= "^YSCL(603 .03,",DA=1 ,DR="6///" _$$NOW^XLF DT D ^DIE | |
| 1763 | "RTN","YSC LTST3",69, 0) | |
| 1764 | K XMY | |
| 1765 | "RTN","YSC LTST3",70, 0) | |
| 1766 | I 'YSDEBU G S XMY("G .PSOCLOZ") ="" S:YSPR OD XMY("G. CLOZAPINE ROLL-UP@FO RUM.VA.GOV ")="" | |
| 1767 | "RTN","YSC LTST3",71, 0) | |
| 1768 | E S XMY("G.C LOZAPINE D EBUG")="" S:YSPROD X MY("G.CLOZ APINE D N S. URL ")="" | |
| 1769 | "RTN","YSC LTST3",72, 0) | |
| 1770 | S XMDUZ=" CLOZAPINE MONITOR",X MTEXT="^TM P($J," | |
| 1771 | "RTN","YSC LTST3",73, 0) | |
| 1772 | S XMSUB=$ S(YSDEBUG: "DEBUG ",1 :"")_"Cloz apine demo graphics", ^TMP("YSCL ",$J,2,0)= " " | |
| 1773 | "RTN","YSC LTST3",74, 0) | |
| 1774 | S ^TMP("Y SCL",$J,1, 0)="Clozap ine demogr aphic data was trans mitted, "_ YSCLLN_" r ecords wer e sent.",X MTEXT="^TM P(""YSCL"" ,$J," | |
| 1775 | "RTN","YSC LTST3",75, 0) | |
| 1776 | I $O(^TMP ("YSCL",$J ,10)) S ^T MP("YSCL", $J,3,0)="F or the fol lowing pat ients, one or more o f the requ ired data" ,^TMP("YSC L",$J,4,0) ="elements (race, se x, ZIP cod e) were mi ssing.",^T MP("YSCL", $J,5,0)=" " | |
| 1777 | "RTN","YSC LTST3",76, 0) | |
| 1778 | I S ^TMP ("YSCL",$J ,6,0)="Ple ase have t his inform ation ente red.",^TMP ("YSCL",$J ,7,0)="The available data was transmitte d.",^TMP(" YSCL",$J,8 ,0)=" " | |
| 1779 | "RTN","YSC LTST3",77, 0) | |
| 1780 | D ^XMD | |
| 1781 | "RTN","YSC LTST3",78, 0) | |
| 1782 | ; set tra nsmitted f ield in 55 from ^TMP ("YSCLL",$ J) | |
| 1783 | "RTN","YSC LTST3",79, 0) | |
| 1784 | F DFN=0:0 S DFN=$O( ^TMP("YSCL L",$J,DFN) ) Q:'DFN I ^TMP("YS CLL",$J,DF N) S DIE=" ^PS(55,",D A=DFN,DR=" 56///1" D ^DIE | |
| 1785 | "RTN","YSC LTST3",80, 0) | |
| 1786 | Q | |
| 1787 | "RTN","YSC LTST3",81, 0) | |
| 1788 | ; | |
| 1789 | "RTN","YSC LTST3",82, 0) | |
| 1790 | FLERR ; | |
| 1791 | "RTN","YSC LTST3",83, 0) | |
| 1792 | K XMY | |
| 1793 | "RTN","YSC LTST3",84, 0) | |
| 1794 | ;/RBN - B egin modif ications f or YS*5.01 *122 | |
| 1795 | "RTN","YSC LTST3",85, 0) | |
| 1796 | X ^%ZOSF( "UCI") I Y =^%ZOSF("P ROD") D | |
| 1797 | "RTN","YSC LTST3",86, 0) | |
| 1798 | .S XMY("G .CLOZAPINE ROLL-UP@F ORUM.VA.GO V")="" | |
| 1799 | "RTN","YSC LTST3",87, 0) | |
| 1800 | .I YSDEBU G K XMY S XMY("G.CLO ZAPINE D N S. URL ")="" | |
| 1801 | "RTN","YSC LTST3",88, 0) | |
| 1802 | I Y'=^%ZO SF("PROD") D | |
| 1803 | "RTN","YSC LTST3",89, 0) | |
| 1804 | .S XMY("G .CLOZAPINE ROLL-UP") ="" | |
| 1805 | "RTN","YSC LTST3",90, 0) | |
| 1806 | .I YSDEBU G K XMY S XMY("G.CLO ZAPINE DEB UG")="" | |
| 1807 | "RTN","YSC LTST3",91, 0) | |
| 1808 | ;/RBN - E nd modific ations for YS*5.01*1 22 | |
| 1809 | "RTN","YSC LTST3",92, 0) | |
| 1810 | S %DT="T" ,X="NOW" D ^%DT S YS CLNOW=$P(Y ,".",2) | |
| 1811 | "RTN","YSC LTST3",93, 0) | |
| 1812 | S YSCLSIT E=$P($$SIT E^VASITE," ^",2) | |
| 1813 | "RTN","YSC LTST3",94, 0) | |
| 1814 | S XMSUB=$ S(YSDEBUG: "DEBUG ",1 :"")_"Cloz apine lab data error at "_YSCL SITE_" on "_DT_" at "_YSCLNOW, ^TMP("YSCL ",$J,1,0)= " " | |
| 1815 | "RTN","YSC LTST3",95, 0) | |
| 1816 | S ^TMP("Y SCL",$J,2, 0)="### Cl ozapine da ta error a t "_YSCLSI TE_" on "_ DT_" +++" | |
| 1817 | "RTN","YSC LTST3",96, 0) | |
| 1818 | S ^TMP("Y SCL",$J,3, 0)=" Cloza pine Lab T est file n ot properl y defined. " | |
| 1819 | "RTN","YSC LTST3",97, 0) | |
| 1820 | S ^TMP("Y SCL",$J,4, 0)=" Data cannot be transmitte d!" | |
| 1821 | "RTN","YSC LTST3",98, 0) | |
| 1822 | S XMTEXT= "^TMP(""YS CL"",$J,", XMDUZ="Clo zapine MON ITOR" D ^X MD | |
| 1823 | "RTN","YSC LTST3",99, 0) | |
| 1824 | G END^YSC LTST2 | |
| 1825 | "RTN","YSC LTST3",100 ,0) | |
| 1826 | Q | |
| 1827 | "RTN","YSC LTST3",101 ,0) | |
| 1828 | TLIST ; | |
| 1829 | "RTN","YSC LTST3",102 ,0) | |
| 1830 | I '$D(^YS CL(603.04) ) W !,"Pat ch YS*5.01 *90 not pr operly ins talled. C ontact IRM " S DIR(0) ="E" D ^DI R Q | |
| 1831 | "RTN","YSC LTST3",103 ,0) | |
| 1832 | W !,"Curr ently link ed Tests:" I '$O(^YS CL(603.04, 1,1,0)) W !,"No test s linked", ! | |
| 1833 | "RTN","YSC LTST3",104 ,0) | |
| 1834 | S YSCLA=0 | |
| 1835 | "RTN","YSC LTST3",105 ,0) | |
| 1836 | F S YSCL A=$O(^YSCL (603.04,1, 1,YSCLA)) Q:'YSCLA S YSCLB=^Y SCL(603.04 ,1,1,YSCLA ,0) D | |
| 1837 | "RTN","YSC LTST3",106 ,0) | |
| 1838 | . W !,$P (^LAB(60,$ P(YSCLB,"^ "),0),"^") ," represe nts " S YS CLB=$P(YSC LB,"^",2) | |
| 1839 | "RTN","YSC LTST3",107 ,0) | |
| 1840 | . W $S(Y SCLB="W":" WHITE BLOO D COUNT",Y SCLB="A":" ABSOLUTE N EUTROPHIL COUNT",YSC LB="N":"NE UTROPHIL P ERCENT",YS CLB="S":"S EGS %",YSC LB="B":"BA NDS %",YSC LB="T":"BA NDS ABSOLU TE",YSCLB= "C":"SEGS ABSOLUTE", 1:"Bad Rec ord") | |
| 1841 | "RTN","YSC LTST3",108 ,0) | |
| 1842 | F K DIR S DIR(0)=" PA^60:EMZ" ,DIR("A")= "Enter the name of t he test fo r Clozapin e: " W ! D ^DIR Q:Y= "^"!($D(DT OUT))!($D( DUOUT)) S YSCLTST=+ Y D Q:Y=" ^"!($D(DTO UT))!($D(D UOUT)) | |
| 1843 | "RTN","YSC LTST3",109 ,0) | |
| 1844 | . I $D(^ YSCL(603.0 4,1,1,"B", YSCLTST)) G TEXIST | |
| 1845 | "RTN","YSC LTST3",110 ,0) | |
| 1846 | . K DIR S DIR(0)=" SA^W:WHITE BLOOD COU NT;A:ABSOL UTE NEUTRO PHIL COUNT ;N:NEUTROP HIL PERCEN T;S:SEGS % ;B:BANDS % ;T:BANDS A BSOLUTE;C: SEGS ABSOL UTE" | |
| 1847 | "RTN","YSC LTST3",111 ,0) | |
| 1848 | . S DIR( "A")="Ente r the type of the te st for Clo zapine: " D ^DIR Q: Y["^"!($D( DTOUT))!($ D(DUOUT)) S YSCLTS1 =Y | |
| 1849 | "RTN","YSC LTST3",112 ,0) | |
| 1850 | . K DIR S DIR(0)=" SA^0:uL;1: K/uL;2:Per cent" | |
| 1851 | "RTN","YSC LTST3",113 ,0) | |
| 1852 | . S DIR( "A")="Ente r the repo rting meth od of the test for C lozapine: " D ^DIR Q:Y["^"!($ D(DTOUT))! ($D(DUOUT) ) S YSCLT S2=Y | |
| 1853 | "RTN","YSC LTST3",114 ,0) | |
| 1854 | . K YSCL ERR | |
| 1855 | "RTN","YSC LTST3",115 ,0) | |
| 1856 | . D VAL^ DIE(603.41 ,"+1,1,",. 01,"F","`" _YSCLTST,. YSCLRES,"F DA","YSCLE RR") | |
| 1857 | "RTN","YSC LTST3",116 ,0) | |
| 1858 | . I $D(Y SCLERR) W !,"There w as a probl em with th e data, pl ease re-en ter it" Q | |
| 1859 | "RTN","YSC LTST3",117 ,0) | |
| 1860 | . D VAL^ DIE(603.41 ,"+1,1,",1 ,"F",YSCLT S1,.YSCLRE S,"FDA","Y SCLERR") | |
| 1861 | "RTN","YSC LTST3",118 ,0) | |
| 1862 | . I $D(Y SCLERR) W !,"There w as a probl em with th e data, pl ease re-en ter it" Q | |
| 1863 | "RTN","YSC LTST3",119 ,0) | |
| 1864 | . D VAL^ DIE(603.41 ,"+1,1,",2 ,"F",YSCLT S2,.YSCLRE S,"FDA","Y SCLERR") | |
| 1865 | "RTN","YSC LTST3",120 ,0) | |
| 1866 | . I $D(Y SCLERR) W !,"There w as a probl em with th e data, pl ease re-en ter it" Q | |
| 1867 | "RTN","YSC LTST3",121 ,0) | |
| 1868 | . D UPDA TE^DIE(,"F DA",,"ERRO R") | |
| 1869 | "RTN","YSC LTST3",122 ,0) | |
| 1870 | . I $D(Y SCLERR) W !,"There w as a probl em with th e data, pl ease re-en ter it" Q | |
| 1871 | "RTN","YSC LTST3",123 ,0) | |
| 1872 | Q | |
| 1873 | "RTN","YSC LTST3",124 ,0) | |
| 1874 | TEXIST ; | |
| 1875 | "RTN","YSC LTST3",125 ,0) | |
| 1876 | W !,"This entry alr eady exist s. Do you wish to d elete it?" K DIR S D IR(0)="Y" D ^DIR Q:' Y!($D(DTOU T))!($D(DU OUT)) | |
| 1877 | "RTN","YSC LTST3",126 ,0) | |
| 1878 | S DA(1)=1 ,DA=$O(^YS CL(603.04, 1,1,"B",YS CLTST,"")) ,DIE="^YSC L(603.04,1 ,1,",DR=". 01////@" D ^DIE W !, "Deleted" S Y="" Q | |
| 1879 | "RTN","YSC LTST3",127 ,0) | |
| 1880 | Q | |
| 1881 | "RTN","YSC LTST3",128 ,0) | |
| 1882 | END K %,C, D,DA,DFN,D ISYS,DR,I, R,VADM,VAP A,VAERR,Y, YSCL,YSCL1 ,YSCL2,YSC LC,YSCLDEA ,YSCLJ,YSC LLN,YSCLNA ME,YSCLNO, YSCLP,^TMP ($J),^TMP( "YSCL",$J) ,^TMP("YSC LL",$J) Q | |
| 1883 | "RTN","YSC LTST3",129 ,0) | |
| 1884 | Q | |
| 1885 | "RTN","YSC LTST3",130 ,0) | |
| 1886 | END1 ; | |
| 1887 | "RTN","YSC LTST3",131 ,0) | |
| 1888 | K ^TMP($J ),^TMP("YS CL",$J) | |
| 1889 | "RTN","YSC LTST3",132 ,0) | |
| 1890 | K %,%DT,% H,%T,AGE,C ,CNT,D,DA, DFN,DIE,DI K,DIR,DIRO UT,DIRUT,D ISYS,DOB,D R | |
| 1891 | "RTN","YSC LTST3",133 ,0) | |
| 1892 | K DRG,DTO UT,DUOUT,I ,IOF,J,K,L AB,LABT,PN M,POP,R,RE SULTS1,SEX ,SSN,VADM, VAERR,VAPA | |
| 1893 | "RTN","YSC LTST3",134 ,0) | |
| 1894 | K X,X1,X2 ,XMDUZ,XMS UB,XMTEXT, XMY,XMZ,Y, YSACT,YSCL ,YSCL1,YSC L2,YSCL28, YSCLA,YSCL A1,YSCLAB | |
| 1895 | "RTN","YSC LTST3",135 ,0) | |
| 1896 | K YSCLAB1 ,YSCLAB2,Y SCLAB3,YSC LAB4,YSCLC ,YSCLD,YSC LD0,YSCLD1 ,YSCLDAT1 | |
| 1897 | "RTN","YSC LTST3",136 ,0) | |
| 1898 | K YSCLDAT A,YSCLDEA, YSCLDEMO,Y SCLED,YSCL F,YSCLFF,Y SCLFRQ,YSC LGL,YSCLGR N,YSCLI | |
| 1899 | "RTN","YSC LTST3",137 ,0) | |
| 1900 | K YSCLID, YSCLIED,YS CLIEN,YSCL IF,YSCLJ,Y SCLLAB,YSC LLD,YSCLLD FN,YSCLLDN | |
| 1901 | "RTN","YSC LTST3",138 ,0) | |
| 1902 | K YSCLLDT ,YSCLLK,YS CLLLN,YSCL LN,YSCLLO, YSCLM180,Y SCLM28,YSC LM56,YSCLM 7,YSCLMTCH ,YSCLNAME | |
| 1903 | "RTN","YSC LTST3",139 ,0) | |
| 1904 | K YSCLNO, YSCLNOW,YS CLNST1,YSC LNSTE,YSCL OVR,YSCLP, YSCLPHY,YS CLR,YSCLRE S,YSCLRET, YSCLRWBC,Y SCLRX | |
| 1905 | "RTN","YSC LTST3",140 ,0) | |
| 1906 | K YSCLRX2 ,YSCLSAND, YSCLSB1,YS CLSD,YSCLS GS,YSCLSIT E,YSCLSN,Y SCLSP,YSCL T,YSCLTA,Y SCLTDT,YSC LTEST | |
| 1907 | "RTN","YSC LTST3",141 ,0) | |
| 1908 | K YSCLTL, YSCLTPT,YS CLTLS,YSCL TLS1,YSCLT S1,YSCLTST ,YSCLTYPE, YSCLWBC,YS CLWBCC | |
| 1909 | "RTN","YSC LTST3",142 ,0) | |
| 1910 | K YSCLWBC T,YSCLX,YS CLZ2,YSDEB UG,YSOFF,Y SRACE,YSRC ,YSSTOP,YS TEXT,ZTDES C | |
| 1911 | "RTN","YSC LTST3",143 ,0) | |
| 1912 | K ZTDTH,Z TIO,ZTREQ, ZTRTN,ZTSA VE,ZTSTOP | |
| 1913 | "RTN","YSC LTST3",144 ,0) | |
| 1914 | Q | |
| 1915 | "RTN","YSC LTST3",145 ,0) | |
| 1916 | ZEOR ;YSCL TST3 | |
| 1917 | "RTN","YSC LTST4") | |
| 1918 | 0^9^B19360 627 | |
| 1919 | "RTN","YSC LTST4",1,0 ) | |
| 1920 | YSCLTST4 ; DALOI/LB/R LM-TRANSMI T RX AND l AB DATA FO R CLOZAPIN E ;Jul 14, 2017@09:0 0:07 | |
| 1921 | "RTN","YSC LTST4",2,0 ) | |
| 1922 | ;;5.01;ME NTAL HEALT H;**92,122 **;Dec 30, 1994;Buil d 61 | |
| 1923 | "RTN","YSC LTST4",3,0 ) | |
| 1924 | ; Referen ce to ^LAB (60 suppor ted by IA #333 | |
| 1925 | "RTN","YSC LTST4",4,0 ) | |
| 1926 | ; Referen ce to ^LR7 OR1 suppor ted by IA #2503 | |
| 1927 | "RTN","YSC LTST4",5,0 ) | |
| 1928 | ; | |
| 1929 | "RTN","YSC LTST4",6,0 ) | |
| 1930 | CL1 ;(DFN, DAYS) ; | |
| 1931 | "RTN","YSC LTST4",7,0 ) | |
| 1932 | K ^TMP($J ,"PSO"),RE SULTS,YSCL YWBC,YSCLR ANC,YSCLXW BC | |
| 1933 | "RTN","YSC LTST4",8,0 ) | |
| 1934 | Q:'DFN | |
| 1935 | "RTN","YSC LTST4",9,0 ) | |
| 1936 | S:'$G(DAY S) DAYS=90 | |
| 1937 | "RTN","YSC LTST4",10, 0) | |
| 1938 | N ARRAY D LIST^DIC( 603.01,,1, "I",,,DFN, "C",,,"ARR AY") | |
| 1939 | "RTN","YSC LTST4",11, 0) | |
| 1940 | S YSCLIEN =$G(ARRAY( "DILIST",2 ,1)),YSCLF RQ="" I YS CLIEN S YS CLFRQ=$$GE T1^DIQ(603 .01,YSCLIE N,2,"I") | |
| 1941 | "RTN","YSC LTST4",12, 0) | |
| 1942 | I $$GET1^ DIQ(603.03 ,1,7,"I")= 1 Q "-1^0 ^0^0^0^0^" _YSCLFRQ | |
| 1943 | "RTN","YSC LTST4",13, 0) | |
| 1944 | S X1=DT,X 2="-"_DAYS D C^%DTC S YSCLSD=X | |
| 1945 | "RTN","YSC LTST4",14, 0) | |
| 1946 | K ARRAY D LIST^DIC( 603.41,",1 ,","1;2"," I",,,,,,," ARRAY") | |
| 1947 | "RTN","YSC LTST4",15, 0) | |
| 1948 | F I=1:1 Q :'$D(ARRAY ("DILIST", 2,I)) S Y SCLA=ARRAY ("DILIST", 2,I) D | |
| 1949 | "RTN","YSC LTST4",16, 0) | |
| 1950 | . N YSCLT NM,YSCLTTP ,YSCLTFR S YSCLTNM=A RRAY("DILI ST",1,I) ; $$GET1^DIQ (603.41,YS CLA_",1,", .01,"I") | |
| 1951 | "RTN","YSC LTST4",17, 0) | |
| 1952 | . S YSCLT TP=ARRAY(" DILIST","I D",I,1) | |
| 1953 | "RTN","YSC LTST4",18, 0) | |
| 1954 | . S YSCLT FR=ARRAY(" DILIST","I D",I,2) | |
| 1955 | "RTN","YSC LTST4",19, 0) | |
| 1956 | . S YSCLT LS(YSCLTTP ,YSCLTNM)= YSCLTFR | |
| 1957 | "RTN","YSC LTST4",20, 0) | |
| 1958 | F I=1:1 Q :'$D(ARRAY ("DILIST", 1,I)) S Y SCLTL=ARRA Y("DILIST" ,1,I) D | |
| 1959 | "RTN","YSC LTST4",21, 0) | |
| 1960 | . D RR^LR 7OR1(DFN,, YSCLSD,DT, ,YSCLTL,"L ") | |
| 1961 | "RTN","YSC LTST4",22, 0) | |
| 1962 | . S YSCLS B1="" F S YSCLSB1=$ O(^TMP("LR RR",$J,DFN ,YSCLSB1)) Q:YSCLSB1 ="" D | |
| 1963 | "RTN","YSC LTST4",23, 0) | |
| 1964 | . . S YSC LTDT="" F S YSCLTDT =$O(^TMP(" LRRR",$J,D FN,YSCLSB1 ,YSCLTDT)) Q:YSCLTDT ="" I $P( YSCLTDT,". ",2)]"" D | |
| 1965 | "RTN","YSC LTST4",24, 0) | |
| 1966 | . . . S Y SCLTA="" F S YSCLTA =$O(^TMP(" LRRR",$J,D FN,YSCLSB1 ,YSCLTDT,Y SCLTA)) Q: YSCLTA="" I YSCLTA D | |
| 1967 | "RTN","YSC LTST4",25, 0) | |
| 1968 | . . . . S RESULTS1= ^TMP("LRRR ",$J,DFN,Y SCLSB1,YSC LTDT,YSCLT A) | |
| 1969 | "RTN","YSC LTST4",26, 0) | |
| 1970 | . . . . S RESULTS(Y SCLTL,YSCL TDT)=$P(RE SULTS1,"^" ,2) | |
| 1971 | "RTN","YSC LTST4",27, 0) | |
| 1972 | ;Find all entries f or WBC and sort by i nverse dat e. | |
| 1973 | "RTN","YSC LTST4",28, 0) | |
| 1974 | S YSCLA=" " F S YSC LA=$O(YSCL TLS("W",YS CLA)) Q:'Y SCLA S YS CLXWBC(YSC LA)="" D | |
| 1975 | "RTN","YSC LTST4",29, 0) | |
| 1976 | . S YSCLA 1="" F S YSCLA1=$O( RESULTS(YS CLA,YSCLA1 )) Q:'YSCL A1 D | |
| 1977 | "RTN","YSC LTST4",30, 0) | |
| 1978 | . . S YSC LYWBC(YSCL A1)=RESULT S(YSCLA,YS CLA1)*$S(Y SCLTLS("W" ,YSCLA):10 00,1:1) | |
| 1979 | "RTN","YSC LTST4",31, 0) | |
| 1980 | . . S ^TM P($J,"PSO" ,YSCLA1)=Y SCLYWBC(YS CLA1) | |
| 1981 | "RTN","YSC LTST4",32, 0) | |
| 1982 | S YSCLRWB C=0 F S Y SCLRWBC=$O (YSCLYWBC( YSCLRWBC)) Q:YSCLRWB C="" S YS CLRWBC(YSC LRWBC)=YSC LYWBC(YSCL RWBC) D | |
| 1983 | "RTN","YSC LTST4",33, 0) | |
| 1984 | . ;Match all ANC's and WBC's | |
| 1985 | "RTN","YSC LTST4",34, 0) | |
| 1986 | . S YSCLM TCH=0 F YS CLA="A","N ","S","C" Q:YSCLMTCH S YSCLTP T="" F S YSCLTPT=$O (YSCLTLS(Y SCLA,YSCLT PT)) Q:'YS CLTPT D Q:YSCLMTCH | |
| 1987 | "RTN","YSC LTST4",35, 0) | |
| 1988 | . . I $G( RESULTS(YS CLTPT,YSCL RWBC)),YSC LA="A",$D( YSCLRWBC(Y SCLRWBC)) S ^TMP($J, "PSO",YSCL RWBC)=YSCL RWBC(YSCLR WBC)_"^"_( RESULTS(YS CLTPT,YSCL RWBC)*$S(Y SCLTLS(YSC LA,YSCLTPT ):1000,1:1 )) Q | |
| 1989 | "RTN","YSC LTST4",36, 0) | |
| 1990 | . . I $G( RESULTS(YS CLTPT,YSCL RWBC)),YSC LA="N",$D( YSCLRWBC(Y SCLRWBC)) S YSCLMTCH =1,^TMP($J ,"PSO",YSC LRWBC)=YSC LRWBC(YSCL RWBC)_"^"_ (YSCLRWBC( YSCLRWBC)* ((RESULTS( YSCLTPT,YS CLRWBC)*.0 1))) Q | |
| 1991 | "RTN","YSC LTST4",37, 0) | |
| 1992 | . . I $G( RESULTS(YS CLTPT,YSCL RWBC)),YSC LA="S",$D( YSCLRWBC(Y SCLRWBC)) D Q | |
| 1993 | "RTN","YSC LTST4",38, 0) | |
| 1994 | . . . S ( YSCLSG1,YS CLSGS)="" F S YSCLS GS=$O(YSCL TLS("B",YS CLSGS)) D Q:'YSCLSG S!YSCLMTCH | |
| 1995 | "RTN","YSC LTST4",39, 0) | |
| 1996 | . . . . I 'YSCLSG1, 'YSCLSGS S YSCLSGS=" Z",YSCLSG1 =1 | |
| 1997 | "RTN","YSC LTST4",40, 0) | |
| 1998 | . . . . I 'YSCLSGS, YSCLSG1 Q | |
| 1999 | "RTN","YSC LTST4",41, 0) | |
| 2000 | . . . . I '$D(RESUL TS(YSCLSGS ,YSCLRWBC) ) S RESULT S(YSCLSGS, YSCLRWBC)= 0 | |
| 2001 | "RTN","YSC LTST4",42, 0) | |
| 2002 | . . . . S YSCLMTCH= 1,^TMP($J, "PSO",YSCL RWBC)=YSCL RWBC(YSCLR WBC)_"^"_( YSCLRWBC(Y SCLRWBC)*( (RESULTS(Y SCLTPT,YSC LRWBC)*.01 )+(RESULTS (YSCLSGS,Y SCLRWBC)*. 01))) Q | |
| 2003 | "RTN","YSC LTST4",43, 0) | |
| 2004 | . . I $G( RESULTS(YS CLTPT,YSCL RWBC)),YSC LA="C" S Y SCLMTCH=1 D | |
| 2005 | "RTN","YSC LTST4",44, 0) | |
| 2006 | . . . S Y SCLSGS="" F S YSCLS GS=$O(YSCL TLS("T",YS CLSGS)) D Q:'YSCLSG S!YSCLMTCH | |
| 2007 | "RTN","YSC LTST4",45, 0) | |
| 2008 | . . . . I '$G(YSCLS G1),'YSCLS GS S YSCLS GS="Z",YSC LSG1=1 | |
| 2009 | "RTN","YSC LTST4",46, 0) | |
| 2010 | . . . . I 'YSCLSGS, $G(YSCLSG1 ) Q | |
| 2011 | "RTN","YSC LTST4",47, 0) | |
| 2012 | . . . . I '$D(RESUL TS(YSCLSGS ,YSCLRWBC) ) S RESULT S(YSCLSGS, YSCLRWBC)= 0 | |
| 2013 | "RTN","YSC LTST4",48, 0) | |
| 2014 | . . . . S YSCLMTCH= 1,^TMP($J, "PSO",YSCL RWBC)=YSCL RWBC(YSCLR WBC)_"^"_( (RESULTS(Y SCLTPT,YSC LRWBC)*$S( YSCLTLS(YS CLA,YSCLTP T):1000,1: 1))+(RESUL TS(YSCLSGS ,YSCLRWBC) )) Q | |
| 2015 | "RTN","YSC LTST4",49, 0) | |
| 2016 | S YSCLA=" A",YSCLTPT ="" F S Y SCLTPT=$O( YSCLTLS(YS CLA,YSCLTP T)) Q:'YSC LTPT D | |
| 2017 | "RTN","YSC LTST4",50, 0) | |
| 2018 | . S YSCLR ANC="" F S YSCLRNC= $O(RESULTS (YSCLTPT,Y SCLRANC)) Q:'YSCLRAN C D | |
| 2019 | "RTN","YSC LTST4",51, 0) | |
| 2020 | . . Q:$D( ^TMP($J,"P SO",YSCLRA NC)) | |
| 2021 | "RTN","YSC LTST4",52, 0) | |
| 2022 | . . S ^TM P($J,"PSO" ,YSCLRANC) ="^"_(RESU LTS(YSCLTP T,YSCLRANC )*$S(YSCLT LS("A",YSC LTPT):1000 ,1:1)) | |
| 2023 | "RTN","YSC LTST4",53, 0) | |
| 2024 | K FDA,YSC LSGS,Y15,Y SCLRWBC,YS CLANC,YSCL YWBC,YSCLF RQ,ZIENS,R ESULTS,RES ULTS1,YSCL A,YSCLA1,Y SCLMTCH,YS CLSB1,YSCL SD | |
| 2025 | "RTN","YSC LTST4",54, 0) | |
| 2026 | K YSCLTA, YSCLTDT,YS CLTL,YSCLT LS,YSCLTPT ,YSCLXWBC, YSCLMULT | |
| 2027 | "RTN","YSC LTST4",55, 0) | |
| 2028 | Q | |
| 2029 | "RTN","YSC LTST4",56, 0) | |
| 2030 | ; | |
| 2031 | "RTN","YSC LTST4",57, 0) | |
| 2032 | KILL ; | |
| 2033 | "RTN","YSC LTST4",58, 0) | |
| 2034 | K FDA,YSC LSGS,Y15,R ESULTS,RES ULTS1,YSCL A,YSCLA1,Y SCLMTCH,YS CLSB1,YSCL SD,YSCLTA, YSCLMULT | |
| 2035 | "RTN","YSC LTST4",59, 0) | |
| 2036 | K YSCLTDT ,YSCLTL,YS CLSG1,YSCL TLS,YSCLTP T,YSCLXWBC | |
| 2037 | "RTN","YSC LTST4",60, 0) | |
| 2038 | ; | |
| 2039 | "RTN","YSC LTST4",61, 0) | |
| 2040 | ZEOR ;YSCL TST4 | |
| 2041 | "RTN","YSC LTST5") | |
| 2042 | 0^5^B13565 7562 | |
| 2043 | "RTN","YSC LTST5",1,0 ) | |
| 2044 | YSCLTST5 ; HINOI/RSJ- TRANSMISSI ON FOR REA L-TIME CLO ZAPINE ORD ERS ;Jul 1 4, 2017@09 :00:07 | |
| 2045 | "RTN","YSC LTST5",2,0 ) | |
| 2046 | ;;5.01;ME NTAL HEALT H;**122**; Dec 30, 19 94;Build 6 1 | |
| 2047 | "RTN","YSC LTST5",3,0 ) | |
| 2048 | ; Referen ce to $$SI TE^VASITE supported by IA #101 12 | |
| 2049 | "RTN","YSC LTST5",4,0 ) | |
| 2050 | ; Referen ce to ^DPT supported by IA #10 035 | |
| 2051 | "RTN","YSC LTST5",5,0 ) | |
| 2052 | ; Referen ce to ^PS( 55 support ed by IA # 787 | |
| 2053 | "RTN","YSC LTST5",6,0 ) | |
| 2054 | ; Referen ce to ^PS( 59 support ed by IA # 783 | |
| 2055 | "RTN","YSC LTST5",7,0 ) | |
| 2056 | ; Referen ce to ^VA( 200 suppor ted by IA #10060 | |
| 2057 | "RTN","YSC LTST5",8,0 ) | |
| 2058 | ; Referen ce to ^LAB (60 suppor ted by IA #333 | |
| 2059 | "RTN","YSC LTST5",9,0 ) | |
| 2060 | Q | |
| 2061 | "RTN","YSC LTST5",10, 0) | |
| 2062 | INPSND ; B uild inpat ient cloza pine data for transm ision | |
| 2063 | "RTN","YSC LTST5",11, 0) | |
| 2064 | N PSJPAT, PSJIOF,YCL SCNTR,PSGT IM,X,X1,X2 S YSCLRET ="",PSJPAT =DFN,PSJIO F=IOF,YCLS CNTR=0 | |
| 2065 | "RTN","YSC LTST5",12, 0) | |
| 2066 | S X1=DT,X 2=365 D C^ %DTC S YSE ND=X | |
| 2067 | "RTN","YSC LTST5",13, 0) | |
| 2068 | S $P(^XTM P("YSCLTRN ",0),"^",1 )=YSEND,$P (^XTMP("YS CLTRN",0), "^",2)=DT | |
| 2069 | "RTN","YSC LTST5",14, 0) | |
| 2070 | S:'$G(^XT MP("YSCLTR N",DT)) ^X TMP("YSCLT RN",DT)=0 | |
| 2071 | "RTN","YSC LTST5",15, 0) | |
| 2072 | D DMG,DMG 1,GETINP,I NPCHK | |
| 2073 | "RTN","YSC LTST5",16, 0) | |
| 2074 | I YSCLT D LOAD | |
| 2075 | "RTN","YSC LTST5",17, 0) | |
| 2076 | S DFN=PSJ PAT,IOF=PS JIOF | |
| 2077 | "RTN","YSC LTST5",18, 0) | |
| 2078 | K ^TMP("Y SCL",$J),^ TMP("YSCLL ",$J),^TMP ($J) | |
| 2079 | "RTN","YSC LTST5",19, 0) | |
| 2080 | Q | |
| 2081 | "RTN","YSC LTST5",20, 0) | |
| 2082 | DMG ; Call ed by PSGO ETO | |
| 2083 | "RTN","YSC LTST5",21, 0) | |
| 2084 | Q:'DFN | |
| 2085 | "RTN","YSC LTST5",22, 0) | |
| 2086 | N PSDFN | |
| 2087 | "RTN","YSC LTST5",23, 0) | |
| 2088 | S YSDEBUG =$$GET1^DI Q(603.03,1 ,3,"I"),PS DFN=DFN ;$P(^YSCL (603.03,1, 0),"^",3) | |
| 2089 | "RTN","YSC LTST5",24, 0) | |
| 2090 | K ^TMP($J ),^TMP("YS CL",$J) S (YSCLIEN,Y SCLLN)=0,Y SCLNO=20 | |
| 2091 | "RTN","YSC LTST5",25, 0) | |
| 2092 | N ARRAY D LIST^DIC( 603.01,,1, "I",,,DFN, "C",,,"ARR AY") | |
| 2093 | "RTN","YSC LTST5",26, 0) | |
| 2094 | S YSCLIEN =$G(ARRAY( "DILIST",2 ,1)) Q:'YS CLIEN | |
| 2095 | "RTN","YSC LTST5",27, 0) | |
| 2096 | S $P(YSST OP,",",8)= 8 Q:$$S^%Z TLOAD | |
| 2097 | "RTN","YSC LTST5",28, 0) | |
| 2098 | I $L($$GE T1^DIQ(2,D FN,.01)) S YSCLC=ARR AY("DILIST ","ID",1,. 01) D GET | |
| 2099 | "RTN","YSC LTST5",29, 0) | |
| 2100 | I $D(^TMP ("YSCLL",$ J,DFN)) D | |
| 2101 | "RTN","YSC LTST5",30, 0) | |
| 2102 | . S $P(^X TMP("YSCLT RN",0),"^" ,1)=YSEND, $P(^XTMP(" YSCLTRN",0 ),"^",2)=D T | |
| 2103 | "RTN","YSC LTST5",31, 0) | |
| 2104 | . S:'$G(^ XTMP("YSCL DEM",DT)) ^XTMP("YSC LDEM",DT)= 0 | |
| 2105 | "RTN","YSC LTST5",32, 0) | |
| 2106 | . I '$G(Y SCLDIS2) S ^XTMP("YS CLDEM",DT, DFN,0)=0 ; RTW | |
| 2107 | "RTN","YSC LTST5",33, 0) | |
| 2108 | . I $G(YS CLDIS2) S ^XTMP("YSC LDIS",DT,D FN,0)=$G(Y SCLDIS2) ; RTW | |
| 2109 | "RTN","YSC LTST5",34, 0) | |
| 2110 | I $G(YSCL DIS2) S ^X TMP("YSCLD IS",DT,DFN ,0)=$G(YSC LDIS2) ;RT W | |
| 2111 | "RTN","YSC LTST5",35, 0) | |
| 2112 | S DFN=PSD FN | |
| 2113 | "RTN","YSC LTST5",36, 0) | |
| 2114 | Q | |
| 2115 | "RTN","YSC LTST5",37, 0) | |
| 2116 | DMG1 ; GAT HER FACILI TY INFORMA TION | |
| 2117 | "RTN","YSC LTST5",38, 0) | |
| 2118 | S YSCLLN= 0,YSCLLLN= 3,(X1,YSCL ED)=DT,X2= -60 D C^%D TC S YSCLM 28=X,X1=$P (YSCLED,". "),X2=-28 D C^%DTC S YSCLM7=X, YSCLED=YSC LED+.5 ;28 TO 60 and 14 to 28 6/15/05 | |
| 2119 | "RTN","YSC LTST5",39, 0) | |
| 2120 | S X1=$P(Y SCLED,".") ,X2=-180 D C^%DTC S YSCLM180=X | |
| 2121 | "RTN","YSC LTST5",40, 0) | |
| 2122 | S X1=$P(Y SCLED,".") ,X2=-56 D C^%DTC S Y SCLM56=X | |
| 2123 | "RTN","YSC LTST5",41, 0) | |
| 2124 | S YSCLIF= +$$SITE^VA SITE_"," | |
| 2125 | "RTN","YSC LTST5",42, 0) | |
| 2126 | D GETS^DI Q(4,YSCLIF ,"1.01;1.0 2;1.03;.02 ;1.04","I" ,"YSCLFF") | |
| 2127 | "RTN","YSC LTST5",43, 0) | |
| 2128 | S $P(YSCL DEMO,"^",1 )=YSCLFF(4 ,YSCLIF,1. 01,"I") | |
| 2129 | "RTN","YSC LTST5",44, 0) | |
| 2130 | S $P(YSCL DEMO,"^",2 )=YSCLFF(4 ,YSCLIF,1. 02,"I") | |
| 2131 | "RTN","YSC LTST5",45, 0) | |
| 2132 | S $P(YSCL DEMO,"^",3 )=YSCLFF(4 ,YSCLIF,1. 03,"I") | |
| 2133 | "RTN","YSC LTST5",46, 0) | |
| 2134 | S $P(YSCL DEMO,"^",4 )=$P(^DIC( 5,YSCLFF(4 ,YSCLIF,.0 2,"I"),0), "^",2) | |
| 2135 | "RTN","YSC LTST5",47, 0) | |
| 2136 | S $P(YSCL DEMO,"^",5 )=YSCLFF(4 ,YSCLIF,1. 04,"I") | |
| 2137 | "RTN","YSC LTST5",48, 0) | |
| 2138 | S $P(YSCL DEMO,"^",6 )="" | |
| 2139 | "RTN","YSC LTST5",49, 0) | |
| 2140 | K J,YSCLF ,YSCLFF,YS CLIF,X | |
| 2141 | "RTN","YSC LTST5",50, 0) | |
| 2142 | Q | |
| 2143 | "RTN","YSC LTST5",51, 0) | |
| 2144 | GET ; GATH ER PATIENT DEMOGRAPH ICS | |
| 2145 | "RTN","YSC LTST5",52, 0) | |
| 2146 | S $P(YSST OP,",",9)= 9 Q:$$S^%Z TLOAD | |
| 2147 | "RTN","YSC LTST5",53, 0) | |
| 2148 | Q:'$L($$G ET1^DIQ(55 ,DFN,53)) ;Q:'$D(^P S(55,DFN," SAND")) ; Don't try to transmi t if no ph armacy rec ord | |
| 2149 | "RTN","YSC LTST5",54, 0) | |
| 2150 | Q:$$GET1^ DIQ(55,DFN ,56,"I") ;Q:$P(^PS (55,DFN,"S AND"),"^", 4) ;Don't retransmi t demograp hics. | |
| 2151 | "RTN","YSC LTST5",55, 0) | |
| 2152 | Q:$D(^TMP ("YSCLL",$ J,DFN)) | |
| 2153 | "RTN","YSC LTST5",56, 0) | |
| 2154 | S ^TMP("Y SCLL",$J,D FN)=1 | |
| 2155 | "RTN","YSC LTST5",57, 0) | |
| 2156 | S YSCLP=$ $GET1^DIQ( 55,DFN,57, "I"),YSCLD EA=$$GET1^ DIQ(200,YS CLP,53.2), YSCLP=$$GE T1^DIQ(200 ,YSCLP,.01 ) | |
| 2157 | "RTN","YSC LTST5",58, 0) | |
| 2158 | D DEM^VAD PT,ADD^VAD PT S YSCL= YSCLC_"^"_ $E($P(VADM (1),",",2) )_$E(VADM( 1))_"^"_$P (VADM(3)," ^")_"^"_$P (VADM(2)," ^")_"^"_$P (VADM(5)," ^")_"^"_VA PA(6)_"^"_ DT | |
| 2159 | "RTN","YSC LTST5",59, 0) | |
| 2160 | D | |
| 2161 | "RTN","YSC LTST5",60, 0) | |
| 2162 | . S YSRAC E="*" | |
| 2163 | "RTN","YSC LTST5",61, 0) | |
| 2164 | . S YSRC= 0 F S YSR C=$O(VADM( 11,YSRC)) Q:'YSRC S YSRACE=YS RACE_+VADM (11,YSRC)_ "-"_+VADM( 11,YSRC,1) _"," | |
| 2165 | "RTN","YSC LTST5",62, 0) | |
| 2166 | . S YSRAC E=YSRACE_" ~" | |
| 2167 | "RTN","YSC LTST5",63, 0) | |
| 2168 | . S YSRC= 0 F S YSR C=$O(VADM( 12,YSRC)) Q:'YSRC S YSRACE=YS RACE_+VADM (12,YSRC)_ "-"_+VADM( 12,YSRC,1) _"," | |
| 2169 | "RTN","YSC LTST5",64, 0) | |
| 2170 | S YSCL=YS CL_"^"_YSR ACE_"^"_YS CLP_"^"_YS CLDEA | |
| 2171 | "RTN","YSC LTST5",65, 0) | |
| 2172 | ; YSCLJ c ontains a ZIP code | |
| 2173 | "RTN","YSC LTST5",66, 0) | |
| 2174 | N ARRAY59 D LIST^DI C(59,,"1;. 05",,,,,,, ,"ARRAY59" ) | |
| 2175 | "RTN","YSC LTST5",67, 0) | |
| 2176 | S YSCLJ=" " F S YSC LJ=$O(ARRA Y59("DILIS T","ID",YS CLJ)) Q:'Y SCLJ I AR RAY59("DIL IST","ID", YSCLJ,1)'= "" S YSCLJ =ARRAY59(" DILIST","I D",YSCLJ,. 05) Q | |
| 2177 | "RTN","YSC LTST5",68, 0) | |
| 2178 | S YSCL=YS CL_"^"_YSC LJ | |
| 2179 | "RTN","YSC LTST5",69, 0) | |
| 2180 | ;registra tion numbe r^initials ^dob^ssn^s ex^zip^tod ay^race^ph ysician^de a^zip code (hosp) | |
| 2181 | "RTN","YSC LTST5",70, 0) | |
| 2182 | S YSCLLN= YSCLLN+1,^ TMP($J,YSC LLN,0)=YSC L | |
| 2183 | "RTN","YSC LTST5",71, 0) | |
| 2184 | I VADM(5) =""!(VAPA( 6)="")!('V ADM(11))!( 'VADM(12)) D ;RLM R ACETEST | |
| 2185 | "RTN","YSC LTST5",72, 0) | |
| 2186 | . S ^TMP( "YSCL",$J, YSCLNO,0)= $P(VADM(2) ,"^",1)_" "_VADM(1 ) | |
| 2187 | "RTN","YSC LTST5",73, 0) | |
| 2188 | . S:VADM( 5)="" ^TMP ("YSCL",$J ,YSCLNO,0) =^TMP("YSC L",$J,YSCL NO,0)_" (S EX)" | |
| 2189 | "RTN","YSC LTST5",74, 0) | |
| 2190 | . S:VAPA( 6)="" ^TMP ("YSCL",$J ,YSCLNO,0) =^TMP("YSC L",$J,YSCL NO,0)_" (Z IP)" | |
| 2191 | "RTN","YSC LTST5",75, 0) | |
| 2192 | . S:'VADM (12) ^TMP( "YSCL",$J, YSCLNO,0)= ^TMP("YSCL ",$J,YSCLN O,0)_" (RA CE, NEW FO RMAT)" | |
| 2193 | "RTN","YSC LTST5",76, 0) | |
| 2194 | . S:'VADM (11) ^TMP( "YSCL",$J, YSCLNO,0)= ^TMP("YSCL ",$J,YSCLN O,0)_" (ET HNICITY)" | |
| 2195 | "RTN","YSC LTST5",77, 0) | |
| 2196 | . S YSCLN O=YSCLNO+1 | |
| 2197 | "RTN","YSC LTST5",78, 0) | |
| 2198 | . S ^TMP( "YSCLL",$J ,DFN)=0 ; leave unma rked pendi ng demogra phic data | |
| 2199 | "RTN","YSC LTST5",79, 0) | |
| 2200 | . I ('VAD M(11))!('V ADM(12)) D | |
| 2201 | "RTN","YSC LTST5",80, 0) | |
| 2202 | . . S ^TM P("YSCL",$ J,YSCLNO,0 )="NOTE: R ace and Et hnicity ma y be enter ed if perm ission is obtained i n the info rmed conse nt",YSCLNO =YSCLNO+1 | |
| 2203 | "RTN","YSC LTST5",81, 0) | |
| 2204 | . . S ^TM P("YSCL",$ J,YSCLNO,0 )="documen t. See VHA Directive 99-035.", YSCLNO=YSC LNO+1 | |
| 2205 | "RTN","YSC LTST5",82, 0) | |
| 2206 | ; | |
| 2207 | "RTN","YSC LTST5",83, 0) | |
| 2208 | Q | |
| 2209 | "RTN","YSC LTST5",84, 0) | |
| 2210 | GETINP ;In patient Me dications | |
| 2211 | "RTN","YSC LTST5",85, 0) | |
| 2212 | Q:$$S^%ZT LOAD D DE M^VADPT | |
| 2213 | "RTN","YSC LTST5",86, 0) | |
| 2214 | S YSCLX=$ E($P(VADM( 1),",",2)) _$E(VADM(1 ))_"^"_$P( VADM(2),"^ ") | |
| 2215 | "RTN","YSC LTST5",87, 0) | |
| 2216 | S YSCLPHY ="",$P(YSC LX,"^",6)= $P(YSCLDEM O,"^",5),$ P(YSCLX,"^ ",11)=YSCL C,$P(YSCLX ,"^",16)=D T | |
| 2217 | "RTN","YSC LTST5",88, 0) | |
| 2218 | ;site zip (p6),regis tration nu mber (p11) , today (p 16) | |
| 2219 | "RTN","YSC LTST5",89, 0) | |
| 2220 | S YSSTRT= $$GET1^DIQ (55.06,+PS GORD_","_D FN,10,"I") ,YSSTOP=$$ GET1^DIQ(5 5.06,+PSGO RD_","_DFN ,34,"I") | |
| 2221 | "RTN","YSC LTST5",90, 0) | |
| 2222 | ;S YSSTRT =$P($G(^PS (55,DFN,5, +PSGORD,2) ),"^",2),Y SSTOP=$P($ G(^PS(55,D FN,5,+PSGO RD,2)),"^" ,4) | |
| 2223 | "RTN","YSC LTST5",91, 0) | |
| 2224 | S PSJOR=$ $GET1^DIQ( 55.06,+PSG ORD_","_DF N,66) ;$P( $G(^PS(55, DFN,5,+PSG ORD,0)),"^ ",21) | |
| 2225 | "RTN","YSC LTST5",92, 0) | |
| 2226 | Q | |
| 2227 | "RTN","YSC LTST5",93, 0) | |
| 2228 | INPCHK ;fo r data to send | |
| 2229 | "RTN","YSC LTST5",94, 0) | |
| 2230 | S YSCLT=0 ,YSCLWBC=0 | |
| 2231 | "RTN","YSC LTST5",95, 0) | |
| 2232 | S $P(YSST OP,",",3)= 3 Q:$$S^%Z TLOAD | |
| 2233 | "RTN","YSC LTST5",96, 0) | |
| 2234 | K PNM,SEX ,DOB,AGE,S SN D DEM^V ADPT I 'VA ERR S PNM= VADM(1),SE X=$P(VADM( 5),U),DOB= $P(VADM(3) ,U),AGE=VA DM(4),SSN= $P(VADM(2) ,U) | |
| 2235 | "RTN","YSC LTST5",97, 0) | |
| 2236 | I PSGSD=0 ,$$GET1^DI Q(55,DFN,5 4,"I")="P" Q ;no tr ansmit for pretreatm ent | |
| 2237 | "RTN","YSC LTST5",98, 0) | |
| 2238 | I PSGSD,P SGSD<YSCLM 180 Q ;Do n't report if over 6 months ol d. | |
| 2239 | "RTN","YSC LTST5",99, 0) | |
| 2240 | S YSCL=$O (YSCLA("") ) I 'YSCL D LAB^YSCL TST1 S YSC LT=1 ;Q ;get lates t WBC resu lts even i f no scrip t. | |
| 2241 | "RTN","YSC LTST5",100 ,0) | |
| 2242 | S YSCLT=1 ,YSCLRXPR= $$GET1^DIQ (55.06,+PS GORD_","_D FN,1,"I") ;we've got provider | |
| 2243 | "RTN","YSC LTST5",101 ,0) | |
| 2244 | N PSJWRD, PSJDIV,PSJ INST S PSJ WRD=$$GET1 ^DIQ(55.06 ,+PSGORD_" ,"_DFN,68, "I") | |
| 2245 | "RTN","YSC LTST5",102 ,0) | |
| 2246 | S:'PSJWRD PSJWRD=$$ GET1^DIQ(5 506,+PSGOR D_","_DFN, 9,"I") | |
| 2247 | "RTN","YSC LTST5",103 ,0) | |
| 2248 | I PSJWRD S PSJINST= $$GET1^DIQ (42,PSJWRD ,44,"I") I PSJINST S PSJDIV=$$ GET1^DIQ(4 4,PSJINST, 3,"I") | |
| 2249 | "RTN","YSC LTST5",104 ,0) | |
| 2250 | S YSCLD=$ G(PSJDIV) I YSCLD S $P(YSCLX," ^",10)=$$G ET1^DIQ(4, YSCLD,52), $P(YSCLX," ^",12)=YSC LD | |
| 2251 | "RTN","YSC LTST5",105 ,0) | |
| 2252 | ;site DEA # (p10), s ite pointe r (p12) | |
| 2253 | "RTN","YSC LTST5",106 ,0) | |
| 2254 | ;here if active | |
| 2255 | "RTN","YSC LTST5",107 ,0) | |
| 2256 | I $$GET1^ DIQ(55,DFN ,54,"I")=" A" S $P(YS CLX,"^",5) ="A" ;forc e active | |
| 2257 | "RTN","YSC LTST5",108 ,0) | |
| 2258 | S $P(YSCL X,"^",13)= 1,$P(YSCLX ,"^",9)=PS GLI\1 | |
| 2259 | "RTN","YSC LTST5",109 ,0) | |
| 2260 | I '$L($$G ET1^DIQ(55 .6,+PSGORD _","_DFN,3 01)),$G(^T MP("PSJCOM ",$J,+$G(P SGORD),"SA ND")) D | |
| 2261 | "RTN","YSC LTST5",110 ,0) | |
| 2262 | .S DIE="^ PS(55,"_DF N_",",DA(1 )=DFN,DA=+ PSGORD,DR= "301////"_ ^TMP("PSJC OM",$J,+PS GORD,"SAND ") D ^DIE | |
| 2263 | "RTN","YSC LTST5",111 ,0) | |
| 2264 | S $P(YSCL X,"^",8)=+ $$GET1^DIQ (55.6,+PSG ORD_","_DF N,301) | |
| 2265 | "RTN","YSC LTST5",112 ,0) | |
| 2266 | ;status(p 5),dosage( p8),rx cou nt(p13),is sue date(p 9) | |
| 2267 | "RTN","YSC LTST5",113 ,0) | |
| 2268 | S YSCLLO= $O(^PS(53. 8,"A",+$G( PSJOR),0)) I YSCLLO D | |
| 2269 | "RTN","YSC LTST5",114 ,0) | |
| 2270 | .S $P(YSC LX,"^",14) =$$GET1^DI Q(53.8,YSC LLO,4,"I") | |
| 2271 | "RTN","YSC LTST5",115 ,0) | |
| 2272 | .S:$P(YSC LX,"^",14) =9 $P(YSCL X,"^",14)= 94 | |
| 2273 | "RTN","YSC LTST5",116 ,0) | |
| 2274 | .S $P(YSC LX,"^",15) =$$GET1^DI Q(53.8,YSC LLO,3) ;$P(^VA (200,YSCLL O,0),"^") | |
| 2275 | "RTN","YSC LTST5",117 ,0) | |
| 2276 | ;lockout reason (p1 4), approv ing offici al (p15) | |
| 2277 | "RTN","YSC LTST5",118 ,0) | |
| 2278 | S $P(YSST OP,",",4)= 4 Q:$$S^%Z TLOAD | |
| 2279 | "RTN","YSC LTST5",119 ,0) | |
| 2280 | S YSCLPHY =$$GET1^DI Q(200,+YSC LRXPR,.01) ,$P(YSCLX, "^",7)=$$G ET1^DIQ(20 0,+YSCLRXP R,53.2) ; ,YSCLPHY=$ P(YSCLPHY, "^") | |
| 2281 | "RTN","YSC LTST5",120 ,0) | |
| 2282 | ; add if prescripti on on same day for d ifferent d rug and di fferent do se | |
| 2283 | "RTN","YSC LTST5",121 ,0) | |
| 2284 | S $P(YSCL X,"^",21)= $$GET1^DIQ (50,+PSGDN ,31) ;$P( ^PSDRUG(+P SGDN,2),"^ ",4) ;Add NDC to str ing | |
| 2285 | "RTN","YSC LTST5",122 ,0) | |
| 2286 | S YCLSCNT R=YCLSCNTR +1 | |
| 2287 | "RTN","YSC LTST5",123 ,0) | |
| 2288 | I $D(^XTM P("YSCLTRN ",DT,DFN,P SGLI)) D | |
| 2289 | "RTN","YSC LTST5",124 ,0) | |
| 2290 | .S PSGTIM =PSGLI+.00 0001,PSHLI 1=PSGTIM | |
| 2291 | "RTN","YSC LTST5",125 ,0) | |
| 2292 | .I $D(^XT MP("YSCLTR N",DT,DFN, PSGTIM)) D | |
| 2293 | "RTN","YSC LTST5",126 ,0) | |
| 2294 | ..S PSHLI 2=0 F S P SHLI2=$O(^ XTMP("YSCL TRN",DT,DF N,PSHLI2)) Q:'PSHLI2 D | |
| 2295 | "RTN","YSC LTST5",127 ,0) | |
| 2296 | ...I $P(P SHLI2,".", 1)=$P(PSGT IM,".",1) D | |
| 2297 | "RTN","YSC LTST5",128 ,0) | |
| 2298 | ....I $P( PSHLI2,"." ,2)<$P(PSG TIM,".",2) !($P(PSHLI 2,".",2)=$ P(PSGTIM," .",2)) S ( PSHLI1,PSG TIM)=PSHLI 2+.000001 | |
| 2299 | "RTN","YSC LTST5",129 ,0) | |
| 2300 | I $G(PSGT IM) N PSGL I S (PSGLI ,PSGLI1)=P SGTIM | |
| 2301 | "RTN","YSC LTST5",130 ,0) | |
| 2302 | S ^XTMP(" YSCLTRN",D T,DFN,PSGL I,0)=0_"^I ^"_PSJOR | |
| 2303 | "RTN","YSC LTST5",131 ,0) | |
| 2304 | S ^XTMP(" YSCLTRN",D T,DFN,PSGL I,YCLSCNTR )=YSCLX | |
| 2305 | "RTN","YSC LTST5",132 ,0) | |
| 2306 | Q | |
| 2307 | "RTN","YSC LTST5",133 ,0) | |
| 2308 | LOAD ; | |
| 2309 | "RTN","YSC LTST5",134 ,0) | |
| 2310 | S $P(YSST OP,",",6)= 6 Q:$$S^%Z TLOAD | |
| 2311 | "RTN","YSC LTST5",135 ,0) | |
| 2312 | I YSCLWBC ="",YSCLLD <YSCLM28 Q | |
| 2313 | "RTN","YSC LTST5",136 ,0) | |
| 2314 | ; don't s end for pr etest or o lder that 28 days | |
| 2315 | "RTN","YSC LTST5",137 ,0) | |
| 2316 | S YSCLNST E=$P(YSCLX ,"^",12) | |
| 2317 | "RTN","YSC LTST5",138 ,0) | |
| 2318 | S YSCLNST 1=$P($$SIT E^VASITE," ^",2),YSCL NSTE=$P($$ SITE^VASIT E,"^",3) | |
| 2319 | "RTN","YSC LTST5",139 ,0) | |
| 2320 | S YSCLLN= YSCLLN+1,$ P(YSCLX,"^ ",18)=YSCL RET,^TMP($ J,YSCLLN,0 )=YSCLX,YS CLLN=YSCLL N+1,^TMP($ J,YSCLLN,0 )=YSCLPHY_ "^"_YSCLDE MO_"^"_YSC LNSTE_"^"_ YSCLNST1 | |
| 2321 | "RTN","YSC LTST5",140 ,0) | |
| 2322 | I $G(PSGL I1) N PSGL I S PSGLI= PSGLI1 | |
| 2323 | "RTN","YSC LTST5",141 ,0) | |
| 2324 | Z2 I $D(^T MP($J,YSCL LN,0)) D | |
| 2325 | "RTN","YSC LTST5",142 ,0) | |
| 2326 | .S YCLSCN TR=YCLSCNT R+1,^XTMP( "YSCLTRN", DT,DFN,PSG LI,YCLSCNT R)=^TMP($J ,YSCLLN,0) | |
| 2327 | "RTN","YSC LTST5",143 ,0) | |
| 2328 | ;site num ber and na me | |
| 2329 | "RTN","YSC LTST5",144 ,0) | |
| 2330 | S YSCLLLN =YSCLLLN+1 ,^TMP("YSC L",$J,YSCL LLN,0)=$P( ^DPT(DFN,0 ),"^",9)_" "_$P(^( 0),"^")_" (R) "_$S( $P(YSCLX," ^",13)="": "NO RX " ,1:$$FMTE^ XLFDT($P(Y SCLX,"^",9 ),"D"))_" (W) " | |
| 2331 | "RTN","YSC LTST5",145 ,0) | |
| 2332 | S ^TMP("Y SCL",$J,YS CLLLN,0)=^ TMP("YSCL" ,$J,YSCLLL N,0)_$S($P (YSCLX,"^" ,3)="":"NO WBC ",1 :$$FMTE^XL FDT($P(YSC LX,"^",3), "D"))_" (N ) "_$S($P( YSCLX,"^", 20)="":"NO NEUT ",1 :$$FMTE^XL FDT($P(YSC LX,"^",19) ,"D")) ;Q | |
| 2333 | "RTN","YSC LTST5",146 ,0) | |
| 2334 | I $D(^TMP ("YSCL",$J )) D | |
| 2335 | "RTN","YSC LTST5",147 ,0) | |
| 2336 | .S YCLSCN TR=YCLSCNT R+1,^XTMP( "YSCLTRN", DT,DFN,PSG LI,YCLSCNT R)=$G(^TMP ("YSCL",$J ,YSCLLLN,0 )) K PSGLI 1 | |
| 2337 | "RTN","YSC LTST5",148 ,0) | |
| 2338 | ;9the pie ce for iss ue date, 1 6th piece for WBC da te ;RLM 06 /16/05 | |
| 2339 | "RTN","YSC LTST5",149 ,0) | |
| 2340 | S ^XTMP(" YSCLTRN",D T,0)=+$G(^ XTMP("YSCL TRN",DT,0) )+1 | |
| 2341 | "RTN","YSC LTST5",150 ,0) | |
| 2342 | Q | |
| 2343 | "RTN","YSC LTST5",151 ,0) | |
| 2344 | DOSE ; GET DOSE | |
| 2345 | "RTN","YSC LTST5",152 ,0) | |
| 2346 | N YSCLPS5 5,YSCLPTR, YSCLDFN,YS CLDOSE | |
| 2347 | "RTN","YSC LTST5",153 ,0) | |
| 2348 | S YSCLPS5 5=+$$GET1^ DIQ(100,+P SJOR,33),P SJDOSE=0,Y SCLDFN=DFN ;+$G(^ OR(100,+PS JOR,4)) | |
| 2349 | "RTN","YSC LTST5",154 ,0) | |
| 2350 | S YSCLDOS E=$$GET1^D IQ(55.06,Y SCLPS55_", "_DFN,120) | |
| 2351 | "RTN","YSC LTST5",155 ,0) | |
| 2352 | N ARRAY D LIST^DIC( 55.07,","_ YSCLPS55_" ,"_DFN_"," ,.02,"I",, ,,,,,"ARRA Y") | |
| 2353 | "RTN","YSC LTST5",156 ,0) | |
| 2354 | F YSCLPTR =1:1 Q:'$D (ARRAY("DI LIST","ID" ,YSCLPTR)) D | |
| 2355 | "RTN","YSC LTST5",157 ,0) | |
| 2356 | .S PSJDOS E=PSJDOSE+ (ARRAY("DI LIST","ID" ,YSCLPTR,. 02)*YSCLDO SE) | |
| 2357 | "RTN","YSC LTST5",158 ,0) | |
| 2358 | .D FRQ S PSJDOSE=PS JDOSE*PSJF RQ | |
| 2359 | "RTN","YSC LTST5",159 ,0) | |
| 2360 | Q | |
| 2361 | "RTN","YSC LTST5",160 ,0) | |
| 2362 | FRQ ; GET ADMIN FREQ UENCY | |
| 2363 | "RTN","YSC LTST5",161 ,0) | |
| 2364 | N PSJDI | |
| 2365 | "RTN","YSC LTST5",162 ,0) | |
| 2366 | S PSJFRQ( 0)=+$$GET1 ^DIQ(55.06 ,YSCLPS55_ ","_YSCLDF N_",",42) | |
| 2367 | "RTN","YSC LTST5",163 ,0) | |
| 2368 | I 'PSJFRQ (0) D ;G et adminis tration ti mes | |
| 2369 | "RTN","YSC LTST5",164 ,0) | |
| 2370 | .S PSJFRQ =+$$GET1^D IQ(55.06,Y SCLPS55_", "_YSCLDFN_ ",",41) | |
| 2371 | "RTN","YSC LTST5",165 ,0) | |
| 2372 | .I $$GET1 ^DIQ(55.06 ,YSCLPS55_ ","_YSCLDF N_",",26)[ "@" D ; C HECK FOR @ IN DAY OF WEEK SCHE DULE | |
| 2373 | "RTN","YSC LTST5",166 ,0) | |
| 2374 | .. S PSJF RQ(0)=1440 /$L(PSJFRQ ,"-") Q ; THE N CALCULAT E CORRECT FRUENCY | |
| 2375 | "RTN","YSC LTST5",167 ,0) | |
| 2376 | . Q:+$G(P SJFRQ(0)) | |
| 2377 | "RTN","YSC LTST5",168 ,0) | |
| 2378 | . I '$L($ TR(PSJFRQ, "012345678 9-")) Q ; n o good - w e have non numeric c haracters | |
| 2379 | "RTN","YSC LTST5",169 ,0) | |
| 2380 | . F PSJDI =1:1:$L(PS JFRQ,"-") I $P(PSJFR Q,"-",PSJD I)]"" D ; If we have data in the pi ece | |
| 2381 | "RTN","YSC LTST5",170 ,0) | |
| 2382 | .. I $L($ P(PSJFRQ," -",PSJDI)) >2,$L($P(P SJFRQ,"-", PSJDI))<5 ; | |
| 2383 | "RTN","YSC LTST5",171 ,0) | |
| 2384 | .. E S P SJFRQ="" Q ; only all ow 3 or 4 digits | |
| 2385 | "RTN","YSC LTST5",172 ,0) | |
| 2386 | .. I $L($ P(PSJFRQ," -",PSJDI)) =4 D Q | |
| 2387 | "RTN","YSC LTST5",173 ,0) | |
| 2388 | ... I $E( $P(PSJFRQ, "-",PSJDI) ,3,4)<60,$ E($P(PSJFR Q,"-",PSJD I),1,2)<25 S PSJFRQ( 0)=1+PSJFR Q(0) Q | |
| 2389 | "RTN","YSC LTST5",174 ,0) | |
| 2390 | ... S PSJ FRQ="" Q ; Out of r ange | |
| 2391 | "RTN","YSC LTST5",175 ,0) | |
| 2392 | .. I $L($ P(PSJFRQ," -",PSJDI)) =3,$E($P(P SJFRQ,"-", PSJDI),2,3 )<60 S PSJ FRQ(0)=1+P SJFRQ(0) Q | |
| 2393 | "RTN","YSC LTST5",176 ,0) | |
| 2394 | .. S PSJF RQ="" Q ; Out of range | |
| 2395 | "RTN","YSC LTST5",177 ,0) | |
| 2396 | S:PSJFRQ( 0)=0 PSJFR Q(0)=1440 | |
| 2397 | "RTN","YSC LTST5",178 ,0) | |
| 2398 | S PSJFRQ= 1440/PSJFR Q(0) | |
| 2399 | "RTN","YSC LTST5",179 ,0) | |
| 2400 | Q | |
| 2401 | "RTN","YSC LTST5",180 ,0) | |
| 2402 | XMIT ; | |
| 2403 | "RTN","YSC LTST5",181 ,0) | |
| 2404 | D START^Y SCLDIS ; T HIS WILL C HECK FOR C LOZAPINE P ATIENTS TH AT NEED TO BE DISCON TINUED AND DISCONTIU NE THEM & SEND MESSA GE TO NCCC | |
| 2405 | "RTN","YSC LTST5",182 ,0) | |
| 2406 | N YSCLDT, YSCLTRDT ; D NOW^%DTC S YSCLDT= %-1 | |
| 2407 | "RTN","YSC LTST5",183 ,0) | |
| 2408 | S YSCLLST =$P($G(^XT MP("YSCLDE M",0)),"^" ,4),YSCLTR DT=$P(YSCL LST,".",1) | |
| 2409 | "RTN","YSC LTST5",184 ,0) | |
| 2410 | REXMIT ; | |
| 2411 | "RTN","YSC LTST5",185 ,0) | |
| 2412 | N YSCLDT S %DT="T", X="N-1" D ^%DT S YSC LDT=Y ;D NOW^%DTC S YSCLDT=%- 1 | |
| 2413 | "RTN","YSC LTST5",186 ,0) | |
| 2414 | I $O(^XTM P("YSCLDEM ",YSCLTRDT )) D | |
| 2415 | "RTN","YSC LTST5",187 ,0) | |
| 2416 | .;/RBN Be gin modifi cation for retransmi t | |
| 2417 | "RTN","YSC LTST5",188 ,0) | |
| 2418 | .I $G(YSC LREX) N DT S DT=YSCL EDDT | |
| 2419 | "RTN","YSC LTST5",189 ,0) | |
| 2420 | .;/RBN En d modifica tion for r etransmit | |
| 2421 | "RTN","YSC LTST5",190 ,0) | |
| 2422 | .N DFN,PS DFN,VA,VAC NTRY,VADM, VAERR,VAPA ,XMDUN,XMD UZ,XMZ,Y,Y SCL,YSCLDE A,YSCLGL,Y SCLJ,YSCLE ND | |
| 2423 | "RTN","YSC LTST5",191 ,0) | |
| 2424 | .N YSCLLN ,YSCLORD,Y SCLP,YSCLX ,YSRACE,YS RC,YSDEBUG ,YSCLIEN,Y SSTOP,YSCL C,YSCLCNTR ,YSCLNO | |
| 2425 | "RTN","YSC LTST5",192 ,0) | |
| 2426 | .F S YSC LTRDT=$O(^ XTMP("YSCL DEM",YSCLT RDT)) Q:'Y SCLTRDT!(Y SCLTRDT'<D T) D | |
| 2427 | "RTN","YSC LTST5",193 ,0) | |
| 2428 | ..S YSDEB UG=$$GET1^ DIQ(603.03 ,1,3,"I") ;$P(^YSCL (603.03,1, 0),"^",3) | |
| 2429 | "RTN","YSC LTST5",194 ,0) | |
| 2430 | ..K ^TMP( $J),^TMP(" YSCL",$J), ^TMP("YSCL L",$J) S ( YSCLIEN,YS CLLN)=0,YS CLNO=20 | |
| 2431 | "RTN","YSC LTST5",195 ,0) | |
| 2432 | ..S YSCLC NTR=0 | |
| 2433 | "RTN","YSC LTST5",196 ,0) | |
| 2434 | ..S DFN=0 F S DFN= $O(^XTMP(" YSCLDEM",Y SCLTRDT,DF N)) Q:'DFN D | |
| 2435 | "RTN","YSC LTST5",197 ,0) | |
| 2436 | ...S YSCL IEN=$O(^YS CL(603.01, "C",DFN,0) ) Q:'YSCLI EN | |
| 2437 | "RTN","YSC LTST5",198 ,0) | |
| 2438 | ...S $P(Y SSTOP,",", 8)=8 Q:$$S ^%ZTLOAD | |
| 2439 | "RTN","YSC LTST5",199 ,0) | |
| 2440 | ...I $L($ $GET1^DIQ( 2,DFN,.01) ) S YSCLC= $$GET1^DIQ (603.01,YS CLIEN,.01) D GET | |
| 2441 | "RTN","YSC LTST5",200 ,0) | |
| 2442 | ...S ^XTM P("YSCLDEM ",YSCLTRDT ,DFN,0)=1, YSCLCNTR=Y SCLCNTR+1 | |
| 2443 | "RTN","YSC LTST5",201 ,0) | |
| 2444 | ..D TRANS MIT^YSCLTS T3:YSCLLN | |
| 2445 | "RTN","YSC LTST5",202 ,0) | |
| 2446 | ..S ^XTMP ("YSCLDEM" ,YSCLTRDT) =YSCLCNTR | |
| 2447 | "RTN","YSC LTST5",203 ,0) | |
| 2448 | ..K ^TMP( "YSCLL",$J ),^TMP("YS CL",$J) | |
| 2449 | "RTN","YSC LTST5",204 ,0) | |
| 2450 | .S $P(^XT MP("YSCLDE M",0),"^", 4)=YSCLDT | |
| 2451 | "RTN","YSC LTST5",205 ,0) | |
| 2452 | ; | |
| 2453 | "RTN","YSC LTST5",206 ,0) | |
| 2454 | S YSCLCT= 4,YSCLCNTR =1 | |
| 2455 | "RTN","YSC LTST5",207 ,0) | |
| 2456 | ;RBN Modi ficaton fo r retransm it | |
| 2457 | "RTN","YSC LTST5",208 ,0) | |
| 2458 | I '$G(YSC LREX) S YS CLTRDT=$P( $P($G(^XTM P("YSCLTRN ",0)),"^", 4),"."),YS CLEND=DT | |
| 2459 | "RTN","YSC LTST5",209 ,0) | |
| 2460 | E S YSCL TRDT=YSCLS TDT,YSCLEN D=YSCLEDDT | |
| 2461 | "RTN","YSC LTST5",210 ,0) | |
| 2462 | ;RBN End modificati on for ret ransmit | |
| 2463 | "RTN","YSC LTST5",211 ,0) | |
| 2464 | I $O(^XTM P("YSCLTRN ",YSCLTRDT )) D | |
| 2465 | "RTN","YSC LTST5",212 ,0) | |
| 2466 | .F S YSC LTRDT=$O(^ XTMP("YSCL TRN",YSCLT RDT)) Q:'Y SCLTRDT!(Y SCLTRDT'<Y SCLEND) D | |
| 2467 | "RTN","YSC LTST5",213 ,0) | |
| 2468 | ..S YSCLC NTR=1 | |
| 2469 | "RTN","YSC LTST5",214 ,0) | |
| 2470 | ..D ORDBL D | |
| 2471 | "RTN","YSC LTST5",215 ,0) | |
| 2472 | ..S YSCLL N=$G(^XTMP ("YSCLTRN" ,YSCLTRDT, 0)) D TRAN SMIT^YSCLT ST2 | |
| 2473 | "RTN","YSC LTST5",216 ,0) | |
| 2474 | ..I $G(YS CLREX) S D T=YSCLEDDT | |
| 2475 | "RTN","YSC LTST5",217 ,0) | |
| 2476 | ..S ^XTMP ("YSCLTRN" ,YSCLTRDT) =1 | |
| 2477 | "RTN","YSC LTST5",218 ,0) | |
| 2478 | ..K ^TMP( "YSCLL",$J ),^TMP("YS CL",$J) | |
| 2479 | "RTN","YSC LTST5",219 ,0) | |
| 2480 | .S $P(^XT MP("YSCLTR N",0),"^", 4)=YSCLDT | |
| 2481 | "RTN","YSC LTST5",220 ,0) | |
| 2482 | Q | |
| 2483 | "RTN","YSC LTST5",221 ,0) | |
| 2484 | ; | |
| 2485 | "RTN","YSC LTST5",222 ,0) | |
| 2486 | ORDBLD ; | |
| 2487 | "RTN","YSC LTST5",223 ,0) | |
| 2488 | N YSCLDFN ,YSCLCNT ; ,YSCLCT | |
| 2489 | "RTN","YSC LTST5",224 ,0) | |
| 2490 | S YSCLDFN =0 F S YS CLDFN=$O(^ XTMP("YSCL TRN",YSCLT RDT,YSCLDF N)) Q:'YSC LDFN D | |
| 2491 | "RTN","YSC LTST5",225 ,0) | |
| 2492 | .S YSCLOR D=0 F S Y SCLORD=$O( ^XTMP("YSC LTRN",YSCL TRDT,YSCLD FN,YSCLORD )) Q:'YSCL ORD!(YSCLO RD>DT) D | |
| 2493 | "RTN","YSC LTST5",226 ,0) | |
| 2494 | ..S YSCLC NT=0 F S YSCLCNT=$O (^XTMP("YS CLTRN",YSC LTRDT,YSCL DFN,YSCLOR D,YSCLCNT) ) Q:'YSCLC NT D | |
| 2495 | "RTN","YSC LTST5",227 ,0) | |
| 2496 | ...S:YSCL CNT=1 ^TMP ($J,YSCLCN TR,0)=$G(^ XTMP("YSCL TRN",YSCLT RDT,YSCLDF N,YSCLORD, YSCLCNT)), ^TMP($J,YS CLCNTR,0)= $G(^XTMP(" YSCLTRN",Y SCLTRDT,YS CLDFN,YSCL ORD,YSCLCN T)),YSCLCN TR=YSCLCNT R+1 | |
| 2497 | "RTN","YSC LTST5",228 ,0) | |
| 2498 | ...S:YSCL CNT=2 ^TMP ($J,YSCLCN TR,0)=$G(^ XTMP("YSCL TRN",YSCLT RDT,YSCLDF N,YSCLORD, YSCLCNT)), ^TMP($J,YS CLCNTR,0)= $G(^XTMP(" YSCLTRN",Y SCLTRDT,YS CLDFN,YSCL ORD,YSCLCN T)),YSCLCN TR=YSCLCNT R+1 | |
| 2499 | "RTN","YSC LTST5",229 ,0) | |
| 2500 | ...S:YSCL CNT=3 ^TMP ("YSCL",$J ,YSCLCT,0) =$G(^XTMP( "YSCLTRN", YSCLTRDT,Y SCLDFN,YSC LORD,YSCLC NT)),YSCLC T=YSCLCT+1 | |
| 2501 | "RTN","YSC LTST5",230 ,0) | |
| 2502 | Q | |
| 2503 | "RTN","YSC LTST5",231 ,0) | |
| 2504 | ; | |
| 2505 | "RTN","YSC LTST5",232 ,0) | |
| 2506 | REX ; Alte rnate retr ansmit | |
| 2507 | "RTN","YSC LTST5",233 ,0) | |
| 2508 | ; First get the da te range t o be resen t | |
| 2509 | "RTN","YSC LTST5",234 ,0) | |
| 2510 | N DA,DAT E,DFN,DIR, DTRUT,YSCL REX,X,Y,YS CLCT,YSCLD T,YSCLLN,Y SCLTRDT,YS CLEDDT,YSC LSTDT | |
| 2511 | "RTN","YSC LTST5",235 ,0) | |
| 2512 | K ^TMP($ J),^TMP("Y SCL") | |
| 2513 | "RTN","YSC LTST5",236 ,0) | |
| 2514 | S DIR(0) ="D" | |
| 2515 | "RTN","YSC LTST5",237 ,0) | |
| 2516 | S DIR("A ")="Enter the starti ng date" | |
| 2517 | "RTN","YSC LTST5",238 ,0) | |
| 2518 | S DIR("? ",1)="Ente r the star ting date of the ord ers you wa nt" | |
| 2519 | "RTN","YSC LTST5",239 ,0) | |
| 2520 | S DIR("? ")="to ret ransmit" | |
| 2521 | "RTN","YSC LTST5",240 ,0) | |
| 2522 | D ^DIR | |
| 2523 | "RTN","YSC LTST5",241 ,0) | |
| 2524 | I $D(DIR UT) W !,"A borting re transmit", ! Q | |
| 2525 | "RTN","YSC LTST5",242 ,0) | |
| 2526 | S YSCLST DT=Y | |
| 2527 | "RTN","YSC LTST5",243 ,0) | |
| 2528 | K Y | |
| 2529 | "RTN","YSC LTST5",244 ,0) | |
| 2530 | S DIR("A ")="Enter the ending date" | |
| 2531 | "RTN","YSC LTST5",245 ,0) | |
| 2532 | S DIR("? ",1)="Ente r the endi ng date of the order s you want " | |
| 2533 | "RTN","YSC LTST5",246 ,0) | |
| 2534 | S DIR("? ")="to ret ransmit" | |
| 2535 | "RTN","YSC LTST5",247 ,0) | |
| 2536 | D ^DIR | |
| 2537 | "RTN","YSC LTST5",248 ,0) | |
| 2538 | I $D(DIR UT) W !,"A borting re transmit", ! Q | |
| 2539 | "RTN","YSC LTST5",249 ,0) | |
| 2540 | S YSCLED DT=Y | |
| 2541 | "RTN","YSC LTST5",250 ,0) | |
| 2542 | S X1=YSC LEDDT,X2=Y SCLSTDT D ^%DTC I X< 0 W !,"The ending da te cannot be before the start date!",! G REX | |
| 2543 | "RTN","YSC LTST5",251 ,0) | |
| 2544 | ; | |
| 2545 | "RTN","YSC LTST5",252 ,0) | |
| 2546 | ;D NOW^% DTC S YSCL DT=%-1 | |
| 2547 | "RTN","YSC LTST5",253 ,0) | |
| 2548 | S YSCLRE X=1 | |
| 2549 | "RTN","YSC LTST5",254 ,0) | |
| 2550 | S X1=YSC LSTDT,X2=- 1 D C^%DTC S YSCLSTD T=X | |
| 2551 | "RTN","YSC LTST5",255 ,0) | |
| 2552 | S YSCLTR DT=YSCLSTD T,X1=YSCLE DDT,X2=1 D C^%DTC S YSCLEDDT=X | |
| 2553 | "RTN","YSC LTST5",256 ,0) | |
| 2554 | D REXMIT | |
| 2555 | "RTN","YSC LTST5",257 ,0) | |
| 2556 | Q | |
| 2557 | "RTN","YSC LTST6") | |
| 2558 | 0^6^B33307 720 | |
| 2559 | "RTN","YSC LTST6",1,0 ) | |
| 2560 | YSCLTST6 ; HINOI/RBN- TRANSMISSI ON FOR REA L-TIME CLO ZAPINE ORD ERS (OUTPA TIENT ;Jul 14, 2017@ 09:00:07 | |
| 2561 | "RTN","YSC LTST6",2,0 ) | |
| 2562 | ;;5.01;ME NTAL HEALT H;**122**; Dec 30, 19 94;Build 6 1 | |
| 2563 | "RTN","YSC LTST6",3,0 ) | |
| 2564 | ; Referen ce to $$SI TE^VASITE supported by IA #101 12 | |
| 2565 | "RTN","YSC LTST6",4,0 ) | |
| 2566 | ; Referen ce to ^PSR X supporte d by IA #7 80 | |
| 2567 | "RTN","YSC LTST6",5,0 ) | |
| 2568 | ; Referen ce to ^PS( 52.52 supp orted by I A #782 | |
| 2569 | "RTN","YSC LTST6",6,0 ) | |
| 2570 | ; Referen ce to ^PS( 55 support ed by IA # 787 | |
| 2571 | "RTN","YSC LTST6",7,0 ) | |
| 2572 | ; Referen ce to ^VA( 200 suppor ted by IA #10060 | |
| 2573 | "RTN","YSC LTST6",8,0 ) | |
| 2574 | ; Referen ce to ^DPT supported by IA #10 035 | |
| 2575 | "RTN","YSC LTST6",9,0 ) | |
| 2576 | ; | |
| 2577 | "RTN","YSC LTST6",10, 0) | |
| 2578 | ; Build o utpatient clozapine data for t ransmision | |
| 2579 | "RTN","YSC LTST6",11, 0) | |
| 2580 | N PSOPAT, PSOIOF,YSC LCNTR,YSCL DFN,YSEND, X,X1,X2 | |
| 2581 | "RTN","YSC LTST6",12, 0) | |
| 2582 | S YSCLRET ="" | |
| 2583 | "RTN","YSC LTST6",13, 0) | |
| 2584 | S PSOPAT= DFN | |
| 2585 | "RTN","YSC LTST6",14, 0) | |
| 2586 | S PSODFN= DFN | |
| 2587 | "RTN","YSC LTST6",15, 0) | |
| 2588 | S PSOIOF= IOF | |
| 2589 | "RTN","YSC LTST6",16, 0) | |
| 2590 | S YSCLCNT R=0 | |
| 2591 | "RTN","YSC LTST6",17, 0) | |
| 2592 | S X1=DT,X 2=365 D C^ %DTC S YSE ND=X | |
| 2593 | "RTN","YSC LTST6",18, 0) | |
| 2594 | S $P(^XTM P("YSCLTRN ",0),"^",1 )=YSEND,$P (^XTMP("YS CLTRN",0), "^",2)=DT ;_"^CLOZAP INE DAILY ROLLUP DAT A" | |
| 2595 | "RTN","YSC LTST6",19, 0) | |
| 2596 | S:'$G(^XT MP("YSCLTR N",DT)) ^X TMP("YSCLT RN",DT)=0 | |
| 2597 | "RTN","YSC LTST6",20, 0) | |
| 2598 | ; Get pat ient and f acility de mographic data | |
| 2599 | "RTN","YSC LTST6",21, 0) | |
| 2600 | D DMG^YSC LTST5 | |
| 2601 | "RTN","YSC LTST6",22, 0) | |
| 2602 | D DMG1^YS CLTST5 | |
| 2603 | "RTN","YSC LTST6",23, 0) | |
| 2604 | D GET^YSC LTST5 | |
| 2605 | "RTN","YSC LTST6",24, 0) | |
| 2606 | S DFN=PSO DFN | |
| 2607 | "RTN","YSC LTST6",25, 0) | |
| 2608 | S YSCL1=P SONEW("IRX N") | |
| 2609 | "RTN","YSC LTST6",26, 0) | |
| 2610 | S YSCLLD= PSOX("STOP DATE") | |
| 2611 | "RTN","YSC LTST6",27, 0) | |
| 2612 | D CHECK | |
| 2613 | "RTN","YSC LTST6",28, 0) | |
| 2614 | D LOAD | |
| 2615 | "RTN","YSC LTST6",29, 0) | |
| 2616 | S IOF=PSO IOF | |
| 2617 | "RTN","YSC LTST6",30, 0) | |
| 2618 | D END | |
| 2619 | "RTN","YSC LTST6",31, 0) | |
| 2620 | Q | |
| 2621 | "RTN","YSC LTST6",32, 0) | |
| 2622 | ; | |
| 2623 | "RTN","YSC LTST6",33, 0) | |
| 2624 | CHECK ;for data to s end | |
| 2625 | "RTN","YSC LTST6",34, 0) | |
| 2626 | K ^TMP($J ),^TMP("YS CL",$J) D DEM^VADPT | |
| 2627 | "RTN","YSC LTST6",35, 0) | |
| 2628 | S YSCLX=$ E($P(VADM( 1),",",2)) _$E(VADM(1 ))_"^"_$P( VADM(2),"^ ") | |
| 2629 | "RTN","YSC LTST6",36, 0) | |
| 2630 | S YSCLPHY ="",$P(YSC LX,"^",6)= $P(YSCLDEM O,"^",5),$ P(YSCLX,"^ ",16)=DT | |
| 2631 | "RTN","YSC LTST6",37, 0) | |
| 2632 | N ARRAY D LIST^DIC( 603.01,,1, "I",,,DFN, "C",,,"ARR AY") | |
| 2633 | "RTN","YSC LTST6",38, 0) | |
| 2634 | S YSCLT=0 ,$P(YSCLX, "^",11)=AR RAY("DILIS T","ID",1, .01) | |
| 2635 | "RTN","YSC LTST6",39, 0) | |
| 2636 | S $P(YSST OP,",",3)= 3 Q:$$S^%Z TLOAD | |
| 2637 | "RTN","YSC LTST6",40, 0) | |
| 2638 | S YSCLLD= +$$GET1^DI Q(55,DFN,5 8,"I") ;$P (^PS(55,DF N,"SAND"), U,6) ;/RBN ADDED 04/ 12/2016 | |
| 2639 | "RTN","YSC LTST6",41, 0) | |
| 2640 | K PNM,SEX ,DOB,AGE,S SN I 'VAER R S PNM=VA DM(1),SEX= $P(VADM(5) ,U),DOB=$P (VADM(3),U ),AGE=VADM (4),SSN=$P (VADM(2),U ) | |
| 2641 | "RTN","YSC LTST6",42, 0) | |
| 2642 | I YSCLLD= 0,$$GET1^D IQ(55,DFN, 54,"I")="P " Q ;no t ransmit fo r pretreat ment | |
| 2643 | "RTN","YSC LTST6",43, 0) | |
| 2644 | S YSCLT=1 ,YSCLRX=$$ GET1^DIQ(5 2,YSCL1,4, "I") ;we'v e got Prov ider | |
| 2645 | "RTN","YSC LTST6",44, 0) | |
| 2646 | S YSCL=$O (YSCLA("") ) I 'YSCL D LAB S YS CLT=1 | |
| 2647 | "RTN","YSC LTST6",45, 0) | |
| 2648 | S YSCLD=+ $$GET1^DIQ (52,YSCL1, 20,"I"),$P (YSCLX,"^" ,10)=$$GET 1^DIQ(59,Y SCLD,1),$P (YSCLX,"^" ,12)=$$GET 1^DIQ(59,Y SCLD,2) | |
| 2649 | "RTN","YSC LTST6",46, 0) | |
| 2650 | ;site DEA # (p10), s ite pointe r (p12) | |
| 2651 | "RTN","YSC LTST6",47, 0) | |
| 2652 | ;here if active | |
| 2653 | "RTN","YSC LTST6",48, 0) | |
| 2654 | S $P(YSCL X,"^",5)=" A" ;,$P(^ PS(55,DFN, "SAND"),"^ ",2)="A" ; force acti ve | |
| 2655 | "RTN","YSC LTST6",49, 0) | |
| 2656 | S $P(YSCL X,"^",13)= 1,$P(YSCLX ,"^",9)=$$ GET1^DIQ(5 2,YSCL1,1, "I") | |
| 2657 | "RTN","YSC LTST6",50, 0) | |
| 2658 | K YSCLD1 D GETS^DIQ (52,YSCL1, "301;302;3 03;304","I ","YSCLD1" ) | |
| 2659 | "RTN","YSC LTST6",51, 0) | |
| 2660 | I $D(YSCL D1) N REC D K YSCLD 1 S YSCLD1 =REC | |
| 2661 | "RTN","YSC LTST6",52, 0) | |
| 2662 | .S REC="" F I=301:1 :304 S REC =REC_YSCLD 1(52,YSCL1 _",",I,"I" )_"^" | |
| 2663 | "RTN","YSC LTST6",53, 0) | |
| 2664 | ;/MZR Beg in modific ations for 'New Orde r Created by editing ' | |
| 2665 | "RTN","YSC LTST6",54, 0) | |
| 2666 | I '$D(YSC LD1),$$GET 1^DIQ(52,Y SCL1,12)[" New Order Created by editing R x # " D | |
| 2667 | "RTN","YSC LTST6",55, 0) | |
| 2668 | .N PHRX,P HRX0,ARR,Y SCLD2 S PH RX=YSCL1 | |
| 2669 | "RTN","YSC LTST6",56, 0) | |
| 2670 | .F Q:$$G ET1^DIQ(52 ,PHRX,12)' ["New Orde r Created by editing Rx # "!$L ($$GET1^DI Q(52,PHRX, 301)) D | |
| 2671 | "RTN","YSC LTST6",57, 0) | |
| 2672 | ..S PHRX0 =+$P($$GET 1^DIQ(52,P HRX,12),"R x # ",2) | |
| 2673 | "RTN","YSC LTST6",58, 0) | |
| 2674 | ..I $L($$ GET1^DIQ(5 2,PHRX0,.0 1)) S ARR( PHRX0,PHRX )="",PHRX= PHRX0 Q | |
| 2675 | "RTN","YSC LTST6",59, 0) | |
| 2676 | .I $L($$G ET1^DIQ(52 ,PHRX,301) ) N REC D K YSCLD1 S YSCLD1=R EC | |
| 2677 | "RTN","YSC LTST6",60, 0) | |
| 2678 | ..D GETS^ DIQ(52,PHR X,"301;302 ;303;304", "I","YSCLD 1") | |
| 2679 | "RTN","YSC LTST6",61, 0) | |
| 2680 | ..S REC=" " F I=301: 1:304 S RE C=REC_YSCL D1(52,PHRX _",",I,"I" )_"^" | |
| 2681 | "RTN","YSC LTST6",62, 0) | |
| 2682 | ..F S PH RX0=$O(ARR (PHRX,"")) Q:PHRX0=" " D S PH RX=PHRX0 | |
| 2683 | "RTN","YSC LTST6",63, 0) | |
| 2684 | ...S DIE= "^PSRX(",D A=PHRX0,DR ="" F I=1: 1:4 S DR=D R_(300+I)_ "////"_$P( REC,"^",I) _";" | |
| 2685 | "RTN","YSC LTST6",64, 0) | |
| 2686 | ...D ^DIE | |
| 2687 | "RTN","YSC LTST6",65, 0) | |
| 2688 | ;/MZR End modificat ions for ' New Order Created by editing' | |
| 2689 | "RTN","YSC LTST6",66, 0) | |
| 2690 | S $P(YSCL X,"^",8)=+ YSCLD1 | |
| 2691 | "RTN","YSC LTST6",67, 0) | |
| 2692 | ;status(p 5),dosage( p8),rx cou nt(p13),is sue date(p 9) | |
| 2693 | "RTN","YSC LTST6",68, 0) | |
| 2694 | K ARRAY D LIST^DIC( 52.52,,"3; 4;5","I",, ,YSCL1,"A" ,,,"ARRAY" ) | |
| 2695 | "RTN","YSC LTST6",69, 0) | |
| 2696 | I $D(ARRA Y("DILIDT" ,"ID",1)) S $P(YSCLX ,"^",14)=A RRAY("DILI ST","ID",1 ,4) D | |
| 2697 | "RTN","YSC LTST6",70, 0) | |
| 2698 | .I ARRAY( "DILIST"," ID",1,4)=9 D | |
| 2699 | "RTN","YSC LTST6",71, 0) | |
| 2700 | ..N YSCLT MP6 S YSCL TMP6=ARRAY ("DILIST", "ID",1,5) | |
| 2701 | "RTN","YSC LTST6",72, 0) | |
| 2702 | ..I YSCLT MP6["Weath er Related Condition s" S $P(YS CLX,"^",14 )=91 | |
| 2703 | "RTN","YSC LTST6",73, 0) | |
| 2704 | ..I YSCLT MP6["Mail Order Dela y" S $P(YS CLX,"^",14 )=92 | |
| 2705 | "RTN","YSC LTST6",74, 0) | |
| 2706 | ..I YSCLT MP6["Inpat ient Going On Leave" S $P(YSCL X,"^",14)= 93 | |
| 2707 | "RTN","YSC LTST6",75, 0) | |
| 2708 | .S YSCLLO =+ARRAY("D ILIST","ID ",1,3),$P( YSCLX,"^", 15)=$$GET1 ^DIQ(200,Y SCLLO,.01) | |
| 2709 | "RTN","YSC LTST6",76, 0) | |
| 2710 | ;lockout reason (p1 4), approv ing offici al (p15) | |
| 2711 | "RTN","YSC LTST6",77, 0) | |
| 2712 | S $P(YSST OP,",",4)= 4 Q:$$S^%Z TLOAD | |
| 2713 | "RTN","YSC LTST6",78, 0) | |
| 2714 | S YSCLPHY =$$GET1^DI Q(200,+YSC LRX,.01),$ P(YSCLX,"^ ",7)=$$GET 1^DIQ(200, +YSCLRX,53 .2) ;,YSC LPHY=$P(YS CLPHY,"^") | |
| 2715 | "RTN","YSC LTST6",79, 0) | |
| 2716 | S $P(YSCL X,"^",4)=$ P(YSCLD1," ^",2),$P(Y SCLX,"^",3 )=$P(YSCLD 1,"^",3) I $P(YSCLD1 ,"^",2)]"" ,$P(YSCLD1 ,"^",3)'>Y SCLED,$P(Y SCLD1,"^", 3)'<YSCLM7 S YSCLWBC =1 | |
| 2717 | "RTN","YSC LTST6",80, 0) | |
| 2718 | ;wbc(p4), date(p3) | |
| 2719 | "RTN","YSC LTST6",81, 0) | |
| 2720 | ; add if prescripti on on same day for d ifferent d rug and di fferent do se | |
| 2721 | "RTN","YSC LTST6",82, 0) | |
| 2722 | S $P(YSCL X,"^",21)= $$GET1^DIQ (52,YSCL1, 27) ;Add N DC to stri ng | |
| 2723 | "RTN","YSC LTST6",83, 0) | |
| 2724 | N PSORD S PSORD=$$G ET1^DIQ(52 ,YSCL1,39. 3,"I") S:' PSORD PSOR D=YSCL1 | |
| 2725 | "RTN","YSC LTST6",84, 0) | |
| 2726 | S PSOLOGD T=PSOX("LO GIN DATE") | |
| 2727 | "RTN","YSC LTST6",85, 0) | |
| 2728 | S ^XTMP(" YSCLTRN",D T,DFN,PSOL OGDT,YSCLC NTR)="0^O^ "_PSORD | |
| 2729 | "RTN","YSC LTST6",86, 0) | |
| 2730 | S YSCLCNT R=YSCLCNTR +1 | |
| 2731 | "RTN","YSC LTST6",87, 0) | |
| 2732 | S ^XTMP(" YSCLTRN",D T,DFN,PSOL OGDT,YSCLC NTR)=YSCLX | |
| 2733 | "RTN","YSC LTST6",88, 0) | |
| 2734 | Q | |
| 2735 | "RTN","YSC LTST6",89, 0) | |
| 2736 | ; | |
| 2737 | "RTN","YSC LTST6",90, 0) | |
| 2738 | ORDSET(PSO RD) ; Sett ing and Or der # inst ead of PSR X # | |
| 2739 | "RTN","YSC LTST6",91, 0) | |
| 2740 | S $P(^XTM P("YSCLTRN ",DT,DFN,P SOLOGDT,0) ,"^",3)=PS ORD | |
| 2741 | "RTN","YSC LTST6",92, 0) | |
| 2742 | Q | |
| 2743 | "RTN","YSC LTST6",93, 0) | |
| 2744 | ; | |
| 2745 | "RTN","YSC LTST6",94, 0) | |
| 2746 | LAB ;get m ost recent | |
| 2747 | "RTN","YSC LTST6",95, 0) | |
| 2748 | S $P(YSST OP,",",5)= 5 Q:$$S^%Z TLOAD | |
| 2749 | "RTN","YSC LTST6",96, 0) | |
| 2750 | S YSCLLDT ="",J=9999 998-YSCLED ,K=9999998 -YSCLM7 I $P(YSCLX," ^",9) S J= 9999998-$P (YSCLX,"^" ,9) | |
| 2751 | "RTN","YSC LTST6",97, 0) | |
| 2752 | S YSCLR=$ $CL^YSCLTS T2(DFN) D ;Set 3,4, 17,19,20,2 2,23 | |
| 2753 | "RTN","YSC LTST6",98, 0) | |
| 2754 | . S $P(YS CLX,"^",3) =$P(YSCLR, "^",6) ;W BC Date | |
| 2755 | "RTN","YSC LTST6",99, 0) | |
| 2756 | . S $P(YS CLX,"^",4) =$P(YSCLR, "^",2) ;W BC Results | |
| 2757 | "RTN","YSC LTST6",100 ,0) | |
| 2758 | . S $P(YS CLX,"^",19 )=$P(YSCLR ,"^",6) ;A NC Date | |
| 2759 | "RTN","YSC LTST6",101 ,0) | |
| 2760 | . S $P(YS CLX,"^",20 )=$P(YSCLR ,"^",4) ;A NC Results | |
| 2761 | "RTN","YSC LTST6",102 ,0) | |
| 2762 | . S $P(YS CLX,"^",22 )=$P(YSCLR ,"^",3) ;W BC Name | |
| 2763 | "RTN","YSC LTST6",103 ,0) | |
| 2764 | . S $P(YS CLX,"^",23 )=$P(YSCLR ,"^",5) ;A NC Name | |
| 2765 | "RTN","YSC LTST6",104 ,0) | |
| 2766 | Q | |
| 2767 | "RTN","YSC LTST6",105 ,0) | |
| 2768 | ; | |
| 2769 | "RTN","YSC LTST6",106 ,0) | |
| 2770 | LOAD ; | |
| 2771 | "RTN","YSC LTST6",107 ,0) | |
| 2772 | S $P(YSST OP,",",6)= 6 Q:$$S^%Z TLOAD | |
| 2773 | "RTN","YSC LTST6",108 ,0) | |
| 2774 | S YSCLNST 1=$P($$SIT E^VASITE," ^",2),YSCL NSTE=$P($$ SITE^VASIT E,"^",3) | |
| 2775 | "RTN","YSC LTST6",109 ,0) | |
| 2776 | S YSCLLN= YSCLLN+1,$ P(YSCLX,"^ ",18)=YSCL RET,^TMP($ J,YSCLLN,0 )=YSCLX,YS CLLN=YSCLL N+1,^TMP($ J,YSCLLN,0 )=YSCLPHY_ "^"_YSCLDE MO_"^"_YSC LNSTE_"^"_ YSCLNST1 | |
| 2777 | "RTN","YSC LTST6",110 ,0) | |
| 2778 | S YSCLCNT R=YSCLCNTR +1 | |
| 2779 | "RTN","YSC LTST6",111 ,0) | |
| 2780 | S ^XTMP(" YSCLTRN",D T,DFN,PSOX ("LOGIN DA TE"),YSCLC NTR)=^TMP( $J,YSCLLN, 0) | |
| 2781 | "RTN","YSC LTST6",112 ,0) | |
| 2782 | ;site num ber and na me | |
| 2783 | "RTN","YSC LTST6",113 ,0) | |
| 2784 | S YSCLLLN =YSCLLLN+1 ,^TMP("YSC L",$J,YSCL LLN,0)=$P( ^DPT(DFN,0 ),"^",9)_" "_$P(^( 0),"^")_" (R) "_$S( $P(YSCLX," ^",13)="": "NO RX " ,1:$$FMTE^ XLFDT($P(Y SCLX,"^",9 ),"D"))_" (W) " | |
| 2785 | "RTN","YSC LTST6",114 ,0) | |
| 2786 | S ^TMP("Y SCL",$J,YS CLLLN,0)=^ TMP("YSCL" ,$J,YSCLLL N,0)_$S($P (YSCLX,"^" ,3)="":"NO WBC ",1 :$$FMTE^XL FDT($P(YSC LX,"^",3), "D"))_" (N ) "_$S($P( YSCLX,"^", 20)="":"NO NEUT ",1 :$$FMTE^XL FDT($P(YSC LX,"^",19) ,"D")) | |
| 2787 | "RTN","YSC LTST6",115 ,0) | |
| 2788 | S YSCLCNT R=YSCLCNTR +1 | |
| 2789 | "RTN","YSC LTST6",116 ,0) | |
| 2790 | S ^XTMP(" YSCLTRN",D T,DFN,PSOX ("LOGIN DA TE"),YSCLC NTR)=^TMP( "YSCL",$J, YSCLLLN,0) | |
| 2791 | "RTN","YSC LTST6",117 ,0) | |
| 2792 | ; Increme nt the cou nter for t he date an d the give n patient | |
| 2793 | "RTN","YSC LTST6",118 ,0) | |
| 2794 | S YSCLCNT R=YSCLCNTR +1 | |
| 2795 | "RTN","YSC LTST6",119 ,0) | |
| 2796 | S ^XTMP(" YSCLTRN",D T,0)=+$G(^ XTMP("YSCL TRN",DT,0) )+1 | |
| 2797 | "RTN","YSC LTST6",120 ,0) | |
| 2798 | Q | |
| 2799 | "RTN","YSC LTST6",121 ,0) | |
| 2800 | ; | |
| 2801 | "RTN","YSC LTST6",122 ,0) | |
| 2802 | END ; Clea n up | |
| 2803 | "RTN","YSC LTST6",123 ,0) | |
| 2804 | K ^TMP("Y SCL",$J),^ TMP("YSCLL ",$J) | |
| 2805 | "RTN","YSC LTST6",124 ,0) | |
| 2806 | Q | |
| 2807 | "RTN","YSC LTST6",125 ,0) | |
| 2808 | ; | |
| 2809 | "VER") | |
| 2810 | 8.0^22.2 | |
| 2811 | "^DD",603. 03,603.03, 8,0) | |
| 2812 | RX LAB PRO D LISTENER ^FJ40^^0;7 ^K:$L(X)>4 0!($L(X)<5 ) X | |
| 2813 | "^DD",603. 03,603.03, 8,3) | |
| 2814 | Answer mus t be 5-40 characters in length . | |
| 2815 | "^DD",603. 03,603.03, 8,21,0) | |
| 2816 | ^^2^2^3170 509^ | |
| 2817 | "^DD",603. 03,603.03, 8,21,1,0) | |
| 2818 | This is th e server a ddress whe re the Clo zapine ord er informa tion and | |
| 2819 | "^DD",603. 03,603.03, 8,21,2,0) | |
| 2820 | patient bl ood test r esults get sent | |
| 2821 | "^DD",603. 03,603.03, 8,"DT") | |
| 2822 | 3170509 | |
| 2823 | "^DD",603. 03,603.03, 9,0) | |
| 2824 | DEMOGRAPHI C PROD LIS TENER^FJ40 ^^0;8^K:$L (X)>40!($L (X)<5) X | |
| 2825 | "^DD",603. 03,603.03, 9,3) | |
| 2826 | Answer mus t be 5-40 characters in length . | |
| 2827 | "^DD",603. 03,603.03, 9,21,0) | |
| 2828 | ^^2^2^3170 509^ | |
| 2829 | "^DD",603. 03,603.03, 9,21,1,0) | |
| 2830 | This is th e server a ddress whe re the Clo zapine Pat ient demog raphic | |
| 2831 | "^DD",603. 03,603.03, 9,21,2,0) | |
| 2832 | informatio n get sent | |
| 2833 | "^DD",603. 03,603.03, 9,"DT") | |
| 2834 | 3170509 | |
| 2835 | "^DD",603. 03,603.03, 10,0) | |
| 2836 | RX LAB TES T LISTENER ^FJ40^^0;9 ^K:$L(X)>4 0!($L(X)<5 ) X | |
| 2837 | "^DD",603. 03,603.03, 10,3) | |
| 2838 | Answer mus t be 5-40 characters in length . | |
| 2839 | "^DD",603. 03,603.03, 10,21,0) | |
| 2840 | ^^2^2^3170 509^ | |
| 2841 | "^DD",603. 03,603.03, 10,21,1,0) | |
| 2842 | This is th e test ser ver addres s ot MailM an group w here the C lozapine | |
| 2843 | "^DD",603. 03,603.03, 10,21,2,0) | |
| 2844 | order info rmation an d Patient blood test results g et sent | |
| 2845 | "^DD",603. 03,603.03, 10,"DT") | |
| 2846 | 3170509 | |
| 2847 | "^DD",603. 03,603.03, 11,0) | |
| 2848 | DEMOGRAPHI C TEST LIS TENER^FJ40 ^^0;10^K:$ L(X)>40!($ L(X)<5) X | |
| 2849 | "^DD",603. 03,603.03, 11,3) | |
| 2850 | Answer mus t be 5-40 characters in length . | |
| 2851 | "^DD",603. 03,603.03, 11,21,0) | |
| 2852 | ^^2^2^3170 509^ | |
| 2853 | "^DD",603. 03,603.03, 11,21,1,0) | |
| 2854 | This is th e test ser ver addres s or MailM an group w here the C lozapine | |
| 2855 | "^DD",603. 03,603.03, 11,21,2,0) | |
| 2856 | Patient de mographic informatio n get sent | |
| 2857 | "^DD",603. 03,603.03, 11,"DT") | |
| 2858 | 3170509 | |
| 2859 | **INSTALL NAME** | |
| 2860 | PSO*7.0*45 7 | |
| 2861 | "BLD",1003 4,0) | |
| 2862 | PSO*7.0*45 7^OUTPATIE NT PHARMAC Y^0^317102 6^y | |
| 2863 | "BLD",1003 4,1,0) | |
| 2864 | ^^1^1^3160 726^^ | |
| 2865 | "BLD",1003 4,1,1,0) | |
| 2866 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 2867 | "BLD",1003 4,4,0) | |
| 2868 | ^9.64PA^52 .52^2 | |
| 2869 | "BLD",1003 4,4,52.52, 0) | |
| 2870 | 52.52 | |
| 2871 | "BLD",1003 4,4,52.52, 2,0) | |
| 2872 | ^9.641^52. 52^1 | |
| 2873 | "BLD",1003 4,4,52.52, 2,52.52,0) | |
| 2874 | CLOZAPINE PRESCRIPTI ON OVERRID ES (File- top level) | |
| 2875 | "BLD",1003 4,4,52.52, 2,52.52,1, 0) | |
| 2876 | ^9.6411^5^ 3 | |
| 2877 | "BLD",1003 4,4,52.52, 2,52.52,1, 4,0) | |
| 2878 | REASON FOR OVERRIDE | |
| 2879 | "BLD",1003 4,4,52.52, 2,52.52,1, 5,0) | |
| 2880 | COMMENTS | |
| 2881 | "BLD",1003 4,4,52.52, 2,52.52,1, 6,0) | |
| 2882 | SECOND PHA RMACIST | |
| 2883 | "BLD",1003 4,4,52.52, 222) | |
| 2884 | y^y^p^^^^n ^^n | |
| 2885 | "BLD",1003 4,4,52.52, 224) | |
| 2886 | ||
| 2887 | "BLD",1003 4,4,52.54, 0) | |
| 2888 | 52.54 | |
| 2889 | "BLD",1003 4,4,52.54, 222) | |
| 2890 | y^y^f^^n^^ y^a^n | |
| 2891 | "BLD",1003 4,4,"APDD" ,52.52,52. 52) | |
| 2892 | ||
| 2893 | "BLD",1003 4,4,"APDD" ,52.52,52. 52,4) | |
| 2894 | ||
| 2895 | "BLD",1003 4,4,"APDD" ,52.52,52. 52,5) | |
| 2896 | ||
| 2897 | "BLD",1003 4,4,"APDD" ,52.52,52. 52,6) | |
| 2898 | ||
| 2899 | "BLD",1003 4,4,"B",52 .52,52.52) | |
| 2900 | ||
| 2901 | "BLD",1003 4,4,"B",52 .54,52.54) | |
| 2902 | ||
| 2903 | "BLD",1003 4,6.3) | |
| 2904 | 65 | |
| 2905 | "BLD",1003 4,"ABPKG") | |
| 2906 | n | |
| 2907 | "BLD",1003 4,"KRN",0) | |
| 2908 | ^9.67PA^77 9.2^20 | |
| 2909 | "BLD",1003 4,"KRN",.4 ,0) | |
| 2910 | .4 | |
| 2911 | "BLD",1003 4,"KRN",.4 01,0) | |
| 2912 | .401 | |
| 2913 | "BLD",1003 4,"KRN",.4 02,0) | |
| 2914 | .402 | |
| 2915 | "BLD",1003 4,"KRN",.4 03,0) | |
| 2916 | .403 | |
| 2917 | "BLD",1003 4,"KRN",.5 ,0) | |
| 2918 | .5 | |
| 2919 | "BLD",1003 4,"KRN",.8 4,0) | |
| 2920 | .84 | |
| 2921 | "BLD",1003 4,"KRN",3. 6,0) | |
| 2922 | 3.6 | |
| 2923 | "BLD",1003 4,"KRN",3. 8,0) | |
| 2924 | 3.8 | |
| 2925 | "BLD",1003 4,"KRN",9. 2,0) | |
| 2926 | 9.2 | |
| 2927 | "BLD",1003 4,"KRN",9. 8,0) | |
| 2928 | 9.8 | |
| 2929 | "BLD",1003 4,"KRN",9. 8,"NM",0) | |
| 2930 | ^9.68A^14^ 13 | |
| 2931 | "BLD",1003 4,"KRN",9. 8,"NM",1,0 ) | |
| 2932 | PSOCLO1^^0 ^B14925761 4 | |
| 2933 | "BLD",1003 4,"KRN",9. 8,"NM",2,0 ) | |
| 2934 | PSORENW0^^ 0^B9870913 9 | |
| 2935 | "BLD",1003 4,"KRN",9. 8,"NM",3,0 ) | |
| 2936 | PSON52^^0^ B109475574 | |
| 2937 | "BLD",1003 4,"KRN",9. 8,"NM",4,0 ) | |
| 2938 | PSOCLUTL^^ 0^B8792306 5 | |
| 2939 | "BLD",1003 4,"KRN",9. 8,"NM",5,0 ) | |
| 2940 | PSODRG^^0^ B92777437 | |
| 2941 | "BLD",1003 4,"KRN",9. 8,"NM",7,0 ) | |
| 2942 | PSOORED5^^ 0^B6831719 8 | |
| 2943 | "BLD",1003 4,"KRN",9. 8,"NM",8,0 ) | |
| 2944 | PSODIR2^^0 ^B32135372 | |
| 2945 | "BLD",1003 4,"KRN",9. 8,"NM",9,0 ) | |
| 2946 | PSODIR1^^0 ^B10037490 0 | |
| 2947 | "BLD",1003 4,"KRN",9. 8,"NM",10, 0) | |
| 2948 | PSOORED1^^ 0^B6823635 0 | |
| 2949 | "BLD",1003 4,"KRN",9. 8,"NM",11, 0) | |
| 2950 | PSORENW4^^ 0^B7597655 9 | |
| 2951 | "BLD",1003 4,"KRN",9. 8,"NM",12, 0) | |
| 2952 | PSONEW^^0^ B38956670 | |
| 2953 | "BLD",1003 4,"KRN",9. 8,"NM",13, 0) | |
| 2954 | PSONEW1^^0 ^B17150662 | |
| 2955 | "BLD",1003 4,"KRN",9. 8,"NM",14, 0) | |
| 2956 | PSOORNEW^^ 0^B9770797 8 | |
| 2957 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSOCLO1" ,1) | |
| 2958 | ||
| 2959 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSOCLUTL ",4) | |
| 2960 | ||
| 2961 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSODIR1" ,9) | |
| 2962 | ||
| 2963 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSODIR2" ,8) | |
| 2964 | ||
| 2965 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSODRG", 5) | |
| 2966 | ||
| 2967 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSON52", 3) | |
| 2968 | ||
| 2969 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSONEW", 12) | |
| 2970 | ||
| 2971 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSONEW1" ,13) | |
| 2972 | ||
| 2973 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSOORED1 ",10) | |
| 2974 | ||
| 2975 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSOORED5 ",7) | |
| 2976 | ||
| 2977 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSOORNEW ",14) | |
| 2978 | ||
| 2979 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSORENW0 ",2) | |
| 2980 | ||
| 2981 | "BLD",1003 4,"KRN",9. 8,"NM","B" ,"PSORENW4 ",11) | |
| 2982 | ||
| 2983 | "BLD",1003 4,"KRN",19 ,0) | |
| 2984 | 19 | |
| 2985 | "BLD",1003 4,"KRN",19 ,"NM",0) | |
| 2986 | ^9.68A^5^5 | |
| 2987 | "BLD",1003 4,"KRN",19 ,"NM",1,0) | |
| 2988 | PSOL MANAG ER^^0 | |
| 2989 | "BLD",1003 4,"KRN",19 ,"NM",2,0) | |
| 2990 | PSOL REGIS TER PATIEN T^^0 | |
| 2991 | "BLD",1003 4,"KRN",19 ,"NM",3,0) | |
| 2992 | PSOLAB LIS T^^0 | |
| 2993 | "BLD",1003 4,"KRN",19 ,"NM",4,0) | |
| 2994 | PSOLIST OV ERRIDES^^0 | |
| 2995 | "BLD",1003 4,"KRN",19 ,"NM",5,0) | |
| 2996 | PSOL EDIT^ ^0 | |
| 2997 | "BLD",1003 4,"KRN",19 ,"NM","B", "PSOL EDIT ",5) | |
| 2998 | ||
| 2999 | "BLD",1003 4,"KRN",19 ,"NM","B", "PSOL MANA GER",1) | |
| 3000 | ||
| 3001 | "BLD",1003 4,"KRN",19 ,"NM","B", "PSOL REGI STER PATIE NT",2) | |
| 3002 | ||
| 3003 | "BLD",1003 4,"KRN",19 ,"NM","B", "PSOLAB LI ST",3) | |
| 3004 | ||
| 3005 | "BLD",1003 4,"KRN",19 ,"NM","B", "PSOLIST O VERRIDES", 4) | |
| 3006 | ||
| 3007 | "BLD",1003 4,"KRN",19 .1,0) | |
| 3008 | 19.1 | |
| 3009 | "BLD",1003 4,"KRN",10 1,0) | |
| 3010 | 101 | |
| 3011 | "BLD",1003 4,"KRN",40 9.61,0) | |
| 3012 | 409.61 | |
| 3013 | "BLD",1003 4,"KRN",77 1,0) | |
| 3014 | 771 | |
| 3015 | "BLD",1003 4,"KRN",77 9.2,0) | |
| 3016 | 779.2 | |
| 3017 | "BLD",1003 4,"KRN",87 0,0) | |
| 3018 | 870 | |
| 3019 | "BLD",1003 4,"KRN",89 89.51,0) | |
| 3020 | 8989.51 | |
| 3021 | "BLD",1003 4,"KRN",89 89.52,0) | |
| 3022 | 8989.52 | |
| 3023 | "BLD",1003 4,"KRN",89 94,0) | |
| 3024 | 8994 | |
| 3025 | "BLD",1003 4,"KRN","B ",.4,.4) | |
| 3026 | ||
| 3027 | "BLD",1003 4,"KRN","B ",.401,.40 1) | |
| 3028 | ||
| 3029 | "BLD",1003 4,"KRN","B ",.402,.40 2) | |
| 3030 | ||
| 3031 | "BLD",1003 4,"KRN","B ",.403,.40 3) | |
| 3032 | ||
| 3033 | "BLD",1003 4,"KRN","B ",.5,.5) | |
| 3034 | ||
| 3035 | "BLD",1003 4,"KRN","B ",.84,.84) | |
| 3036 | ||
| 3037 | "BLD",1003 4,"KRN","B ",3.6,3.6) | |
| 3038 | ||
| 3039 | "BLD",1003 4,"KRN","B ",3.8,3.8) | |
| 3040 | ||
| 3041 | "BLD",1003 4,"KRN","B ",9.2,9.2) | |
| 3042 | ||
| 3043 | "BLD",1003 4,"KRN","B ",9.8,9.8) | |
| 3044 | ||
| 3045 | "BLD",1003 4,"KRN","B ",19,19) | |
| 3046 | ||
| 3047 | "BLD",1003 4,"KRN","B ",19.1,19. 1) | |
| 3048 | ||
| 3049 | "BLD",1003 4,"KRN","B ",101,101) | |
| 3050 | ||
| 3051 | "BLD",1003 4,"KRN","B ",409.61,4 09.61) | |
| 3052 | ||
| 3053 | "BLD",1003 4,"KRN","B ",771,771) | |
| 3054 | ||
| 3055 | "BLD",1003 4,"KRN","B ",779.2,77 9.2) | |
| 3056 | ||
| 3057 | "BLD",1003 4,"KRN","B ",870,870) | |
| 3058 | ||
| 3059 | "BLD",1003 4,"KRN","B ",8989.51, 8989.51) | |
| 3060 | ||
| 3061 | "BLD",1003 4,"KRN","B ",8989.52, 8989.52) | |
| 3062 | ||
| 3063 | "BLD",1003 4,"KRN","B ",8994,899 4) | |
| 3064 | ||
| 3065 | "BLD",1003 4,"QDEF") | |
| 3066 | ^^^^NO^^^^ YES^^NO | |
| 3067 | "BLD",1003 4,"QUES",0 ) | |
| 3068 | ^9.62^^ | |
| 3069 | "BLD",1003 4,"REQB",0 ) | |
| 3070 | ^9.611^10^ 10 | |
| 3071 | "BLD",1003 4,"REQB",1 ,0) | |
| 3072 | PSO*7.0*16 6^2 | |
| 3073 | "BLD",1003 4,"REQB",2 ,0) | |
| 3074 | PSO*7.0*22 2^2 | |
| 3075 | "BLD",1003 4,"REQB",3 ,0) | |
| 3076 | PSO*7.0*26 8^2 | |
| 3077 | "BLD",1003 4,"REQB",4 ,0) | |
| 3078 | PSO*7.0*40 8^2 | |
| 3079 | "BLD",1003 4,"REQB",5 ,0) | |
| 3080 | PSO*7.0*41 1^2 | |
| 3081 | "BLD",1003 4,"REQB",6 ,0) | |
| 3082 | PSO*7.0*44 4^2 | |
| 3083 | "BLD",1003 4,"REQB",7 ,0) | |
| 3084 | PSO*7.0*45 0^2 | |
| 3085 | "BLD",1003 4,"REQB",8 ,0) | |
| 3086 | PSO*7.0*45 8^2 | |
| 3087 | "BLD",1003 4,"REQB",9 ,0) | |
| 3088 | PSO*7.0*48 6^2 | |
| 3089 | "BLD",1003 4,"REQB",1 0,0) | |
| 3090 | PSO*7.0*47 3^2 | |
| 3091 | "BLD",1003 4,"REQB"," B","PSO*7. 0*166",1) | |
| 3092 | ||
| 3093 | "BLD",1003 4,"REQB"," B","PSO*7. 0*222",2) | |
| 3094 | ||
| 3095 | "BLD",1003 4,"REQB"," B","PSO*7. 0*268",3) | |
| 3096 | ||
| 3097 | "BLD",1003 4,"REQB"," B","PSO*7. 0*408",4) | |
| 3098 | ||
| 3099 | "BLD",1003 4,"REQB"," B","PSO*7. 0*411",5) | |
| 3100 | ||
| 3101 | "BLD",1003 4,"REQB"," B","PSO*7. 0*444",6) | |
| 3102 | ||
| 3103 | "BLD",1003 4,"REQB"," B","PSO*7. 0*450",7) | |
| 3104 | ||
| 3105 | "BLD",1003 4,"REQB"," B","PSO*7. 0*458",8) | |
| 3106 | ||
| 3107 | "BLD",1003 4,"REQB"," B","PSO*7. 0*473",10) | |
| 3108 | ||
| 3109 | "BLD",1003 4,"REQB"," B","PSO*7. 0*486",9) | |
| 3110 | ||
| 3111 | "DATA",52. 54,1,0) | |
| 3112 | NO WBC IN LAST 7 DAY S | |
| 3113 | "DATA",52. 54,2,0) | |
| 3114 | NO VERIFIE D WBC | |
| 3115 | "DATA",52. 54,3,0) | |
| 3116 | LAST WBC RESULT < 3 500 | |
| 3117 | "DATA",52. 54,4,0) | |
| 3118 | 3 SEQ. WBC DECREASE | |
| 3119 | "DATA",52. 54,5,0) | |
| 3120 | LAST ANC R ESULT < 20 00 | |
| 3121 | "DATA",52. 54,6,0) | |
| 3122 | 3 SEQ. ANC DECREASE | |
| 3123 | "DATA",52. 54,7,0) | |
| 3124 | NCCC AUTHO RIZED | |
| 3125 | "DATA",52. 54,8,0) | |
| 3126 | REGISTER N ON-DUTY HR /WEEKEND ( MAX 4DAY) | |
| 3127 | "DATA",52. 54,9,0) | |
| 3128 | PRESCRIBER APPROVED 4 DAY SUPP LY | |
| 3129 | "DATA",52. 54,10,0) | |
| 3130 | MILD NEUTR OPENIA PRE SCRIBER AP PROVED | |
| 3131 | "FIA",52.5 2) | |
| 3132 | CLOZAPINE PRESCRIPTI ON OVERRID ES | |
| 3133 | "FIA",52.5 2,0) | |
| 3134 | ^PS(52.52, | |
| 3135 | "FIA",52.5 2,0,0) | |
| 3136 | 52.52D | |
| 3137 | "FIA",52.5 2,0,1) | |
| 3138 | y^y^p^^^^n ^^n | |
| 3139 | "FIA",52.5 2,0,10) | |
| 3140 | ||
| 3141 | "FIA",52.5 2,0,11) | |
| 3142 | ||
| 3143 | "FIA",52.5 2,0,"RLRO" ) | |
| 3144 | ||
| 3145 | "FIA",52.5 2,0,"VR") | |
| 3146 | 7.0^PSO | |
| 3147 | "FIA",52.5 2,52.52) | |
| 3148 | 1 | |
| 3149 | "FIA",52.5 2,52.52,4) | |
| 3150 | ||
| 3151 | "FIA",52.5 2,52.52,5) | |
| 3152 | ||
| 3153 | "FIA",52.5 2,52.52,6) | |
| 3154 | ||
| 3155 | "FIA",52.5 4) | |
| 3156 | CLOZAPINE OVERRIDE R EASONS | |
| 3157 | "FIA",52.5 4,0) | |
| 3158 | ^PS(52.54, | |
| 3159 | "FIA",52.5 4,0,0) | |
| 3160 | 52.54 | |
| 3161 | "FIA",52.5 4,0,1) | |
| 3162 | y^y^f^^n^^ y^a^n | |
| 3163 | "FIA",52.5 4,0,10) | |
| 3164 | ||
| 3165 | "FIA",52.5 4,0,11) | |
| 3166 | ||
| 3167 | "FIA",52.5 4,0,"RLRO" ) | |
| 3168 | ||
| 3169 | "FIA",52.5 4,0,"VR") | |
| 3170 | 7.0^PSO | |
| 3171 | "FIA",52.5 4,52.54) | |
| 3172 | 0 | |
| 3173 | "KRN",19,4 740,-1) | |
| 3174 | 0^3 | |
| 3175 | "KRN",19,4 740,0) | |
| 3176 | PSOLAB LIS T^Display Lab Tests and Result s^^R^^^^^^ ^^OUTPATIE NT PHARMAC Y | |
| 3177 | "KRN",19,4 740,1,0) | |
| 3178 | ^^3^3^2920 819^^ | |
| 3179 | "KRN",19,4 740,1,1,0) | |
| 3180 | This optio n displays results o f lab test s for pati ents recei ving | |
| 3181 | "KRN",19,4 740,1,2,0) | |
| 3182 | clozapine as require d by the c ircular re garding pa tient mana gement | |
| 3183 | "KRN",19,4 740,1,3,0) | |
| 3184 | protocol f or the use of clozap ine. | |
| 3185 | "KRN",19,4 740,25) | |
| 3186 | PSORXLAB | |
| 3187 | "KRN",19,4 740,"U") | |
| 3188 | DISPLAY LA B TESTS AN D RESULTS | |
| 3189 | "KRN",19,4 741,-1) | |
| 3190 | 0^4 | |
| 3191 | "KRN",19,4 741,0) | |
| 3192 | PSOLIST OV ERRIDES^Li st of Over ride Presc riptions^^ R^^^^^^^^O UTPATIENT PHARMACY | |
| 3193 | "KRN",19,4 741,1,0) | |
| 3194 | ^^2^2^2920 819^^^ | |
| 3195 | "KRN",19,4 741,1,1,0) | |
| 3196 | This gener ates a lis t of cloza pine presc riptions w hich were entered by | |
| 3197 | "KRN",19,4 741,1,2,0) | |
| 3198 | overriding the locko ut. | |
| 3199 | "KRN",19,4 741,25) | |
| 3200 | PSOCLOLS | |
| 3201 | "KRN",19,4 741,"U") | |
| 3202 | LIST OF OV ERRIDE PRE SCRIPTIONS | |
| 3203 | "KRN",19,2 911816,-1) | |
| 3204 | 0^2 | |
| 3205 | "KRN",19,2 911816,0) | |
| 3206 | PSOL REGIS TER PATIEN T^Register Clozapine Patient^^ R^^^^^^^^O UTPATIENT PHARMACY | |
| 3207 | "KRN",19,2 911816,1,0 ) | |
| 3208 | ^^2^2^2920 819^^^ | |
| 3209 | "KRN",19,2 911816,1,1 ,0) | |
| 3210 | This optio n enters d ata requir ed by Sand oz for Clo zapine pat ients into | |
| 3211 | "KRN",19,2 911816,1,2 ,0) | |
| 3212 | the Pharma cy Patient file | |
| 3213 | "KRN",19,2 911816,25) | |
| 3214 | REG^PSOCLU TL | |
| 3215 | "KRN",19,2 911816,99) | |
| 3216 | 55587,5810 4 | |
| 3217 | "KRN",19,2 911816,"U" ) | |
| 3218 | REGISTER C LOZAPINE P ATIENT | |
| 3219 | "KRN",19,2 911820,-1) | |
| 3220 | 0^1 | |
| 3221 | "KRN",19,2 911820,0) | |
| 3222 | PSOL MANAG ER^Clozapi ne Pharmac y Manager^ ^M^^PSOLOC KCLOZ^^^^^ ^OUTPATIEN T PHARMACY | |
| 3223 | "KRN",19,2 911820,1,0 ) | |
| 3224 | ^19.06^3^3 ^3160620^^ ^^ | |
| 3225 | "KRN",19,2 911820,1,1 ,0) | |
| 3226 | This menu contains t he options used to c ontrol the dispensin g of | |
| 3227 | "KRN",19,2 911820,1,2 ,0) | |
| 3228 | Clozapine. | |
| 3229 | "KRN",19,2 911820,1,3 ,0) | |
| 3230 | ||
| 3231 | "KRN",19,2 911820,10, 0) | |
| 3232 | ^19.01IP^8 ^7 | |
| 3233 | "KRN",19,2 911820,10, 3,0) | |
| 3234 | 2911816^^1 | |
| 3235 | "KRN",19,2 911820,10, 3,"^") | |
| 3236 | PSOL REGIS TER PATIEN T | |
| 3237 | "KRN",19,2 911820,10, 5,0) | |
| 3238 | 4740^^2 | |
| 3239 | "KRN",19,2 911820,10, 5,"^") | |
| 3240 | PSOLAB LIS T | |
| 3241 | "KRN",19,2 911820,10, 6,0) | |
| 3242 | 4741^^3 | |
| 3243 | "KRN",19,2 911820,10, 6,"^") | |
| 3244 | PSOLIST OV ERRIDES | |
| 3245 | "KRN",19,2 911820,10, 8,0) | |
| 3246 | 2911821^^4 | |
| 3247 | "KRN",19,2 911820,10, 8,"^") | |
| 3248 | PSOL EDIT | |
| 3249 | "KRN",19,2 911820,99) | |
| 3250 | 64559,5829 5 | |
| 3251 | "KRN",19,2 911820,99. 1) | |
| 3252 | 58239,4969 8 | |
| 3253 | "KRN",19,2 911820,"U" ) | |
| 3254 | CLOZAPINE PHARMACY M ANAGER | |
| 3255 | "KRN",19,2 911821,-1) | |
| 3256 | 0^5 | |
| 3257 | "KRN",19,2 911821,0) | |
| 3258 | PSOL EDIT^ Edit Data for a Pati ent in the Clozapine Program^^ R^^^^^^^^O UTPATIENT PHARMACY | |
| 3259 | "KRN",19,2 911821,1,0 ) | |
| 3260 | ^^5^5^2930 107^^^^ | |
| 3261 | "KRN",19,2 911821,1,1 ,0) | |
| 3262 | This optio n allows y ou to edit data for a patient who has al ready been | |
| 3263 | "KRN",19,2 911821,1,2 ,0) | |
| 3264 | enrolled i n the Cloz apine trea tment prog ram. It w ill typica lly be use d | |
| 3265 | "KRN",19,2 911821,1,3 ,0) | |
| 3266 | to reregis ter a pati ent whose treatment has been s uspended a nd who has | |
| 3267 | "KRN",19,2 911821,1,4 ,0) | |
| 3268 | rejoined t he program . | |
| 3269 | "KRN",19,2 911821,1,5 ,0) | |
| 3270 | ||
| 3271 | "KRN",19,2 911821,25) | |
| 3272 | AGAIN^PSOC LUTL | |
| 3273 | "KRN",19,2 911821,"U" ) | |
| 3274 | EDIT DATA FOR A PATI ENT IN THE | |
| 3275 | "MBREQ") | |
| 3276 | 0 | |
| 3277 | "ORD",18,1 9) | |
| 3278 | 19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA | |
| 3279 | "ORD",18,1 9,0) | |
| 3280 | OPTION | |
| 3281 | "PKG",170, -1) | |
| 3282 | 1^1 | |
| 3283 | "PKG",170, 0) | |
| 3284 | OUTPATIENT PHARMACY^ PSO^OUTPAT IENT LABEL S, PROFILE , INVENTOR Y, PRESCRI PTIONS | |
| 3285 | "PKG",170, 22,0) | |
| 3286 | ^9.49I^1^1 | |
| 3287 | "PKG",170, 22,1,0) | |
| 3288 | 7.0^297121 6^2981113^ 1 | |
| 3289 | "PKG",170, 22,1,"PAH" ,1,0) | |
| 3290 | 457^317102 6^52073644 9 | |
| 3291 | "PKG",170, 22,1,"PAH" ,1,1,0) | |
| 3292 | ^^1^1^3171 026 | |
| 3293 | "PKG",170, 22,1,"PAH" ,1,1,1,0) | |
| 3294 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 3295 | "QUES","XP F1",0) | |
| 3296 | Y | |
| 3297 | "QUES","XP F1","??") | |
| 3298 | ^D REP^XPD H | |
| 3299 | "QUES","XP F1","A") | |
| 3300 | Shall I wr ite over y our |FLAG| File | |
| 3301 | "QUES","XP F1","B") | |
| 3302 | YES | |
| 3303 | "QUES","XP F1","M") | |
| 3304 | D XPF1^XPD IQ | |
| 3305 | "QUES","XP F2",0) | |
| 3306 | Y | |
| 3307 | "QUES","XP F2","??") | |
| 3308 | ^D DTA^XPD H | |
| 3309 | "QUES","XP F2","A") | |
| 3310 | Want my da ta |FLAG| yours | |
| 3311 | "QUES","XP F2","B") | |
| 3312 | YES | |
| 3313 | "QUES","XP F2","M") | |
| 3314 | D XPF2^XPD IQ | |
| 3315 | "QUES","XP I1",0) | |
| 3316 | YO | |
| 3317 | "QUES","XP I1","??") | |
| 3318 | ^D INHIBIT ^XPDH | |
| 3319 | "QUES","XP I1","A") | |
| 3320 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
| 3321 | "QUES","XP I1","B") | |
| 3322 | NO | |
| 3323 | "QUES","XP I1","M") | |
| 3324 | D XPI1^XPD IQ | |
| 3325 | "QUES","XP M1",0) | |
| 3326 | PO^VA(200, :EM | |
| 3327 | "QUES","XP M1","??") | |
| 3328 | ^D MG^XPDH | |
| 3329 | "QUES","XP M1","A") | |
| 3330 | Enter the Coordinato r for Mail Group '|F LAG|' | |
| 3331 | "QUES","XP M1","B") | |
| 3332 | ||
| 3333 | "QUES","XP M1","M") | |
| 3334 | D XPM1^XPD IQ | |
| 3335 | "QUES","XP O1",0) | |
| 3336 | Y | |
| 3337 | "QUES","XP O1","??") | |
| 3338 | ^D MENU^XP DH | |
| 3339 | "QUES","XP O1","A") | |
| 3340 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
| 3341 | "QUES","XP O1","B") | |
| 3342 | YES | |
| 3343 | "QUES","XP O1","M") | |
| 3344 | D XPO1^XPD IQ | |
| 3345 | "QUES","XP Z1",0) | |
| 3346 | Y | |
| 3347 | "QUES","XP Z1","??") | |
| 3348 | ^D OPT^XPD H | |
| 3349 | "QUES","XP Z1","A") | |
| 3350 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
| 3351 | "QUES","XP Z1","B") | |
| 3352 | NO | |
| 3353 | "QUES","XP Z1","M") | |
| 3354 | D XPZ1^XPD IQ | |
| 3355 | "QUES","XP Z2",0) | |
| 3356 | Y | |
| 3357 | "QUES","XP Z2","??") | |
| 3358 | ^D RTN^XPD H | |
| 3359 | "QUES","XP Z2","A") | |
| 3360 | Want to MO VE routine s to other CPUs | |
| 3361 | "QUES","XP Z2","B") | |
| 3362 | NO | |
| 3363 | "QUES","XP Z2","M") | |
| 3364 | D XPZ2^XPD IQ | |
| 3365 | "RTN") | |
| 3366 | 13 | |
| 3367 | "RTN","PSO CLO1") | |
| 3368 | 0^1^B14925 7614 | |
| 3369 | "RTN","PSO CLO1",1,0) | |
| 3370 | PSOCLO1 ;B HAM ISC/SA B - clozar il rx lock out routin e ; 20 Oct 2017 4:1 8 PM | |
| 3371 | "RTN","PSO CLO1",2,0) | |
| 3372 | ;;7.0;OUT PATIENT PH ARMACY;**1 ,23,37,222 ,457**;DEC 1997;Buil d 65 | |
| 3373 | "RTN","PSO CLO1",3,0) | |
| 3374 | ;External reference YSCLTST2 supported by DBIA 45 56 | |
| 3375 | "RTN","PSO CLO1",4,0) | |
| 3376 | ;Referenc e to ^YSCL (603.01 is supported by DBIA 2 697 | |
| 3377 | "RTN","PSO CLO1",5,0) | |
| 3378 | ;External reference ^PS(55 su pported by DBIA 2228 | |
| 3379 | "RTN","PSO CLO1",6,0) | |
| 3380 | ;Referenc e to ^XMD supported by IA #100 70 | |
| 3381 | "RTN","PSO CLO1",7,0) | |
| 3382 | ;Referenc e to ^DPT supported by IA #100 35 | |
| 3383 | "RTN","PSO CLO1",8,0) | |
| 3384 | ;MH packa ge will au thorize di spensing o f the Cloz apine drug s | |
| 3385 | "RTN","PSO CLO1",9,0) | |
| 3386 | K ANQDATA ,ANQX,ANQN O,FLG,PSON EW("SAND") ,^TMP($J," PSO"),^TMP ($J,"CLOZF LG",DFN) | |
| 3387 | "RTN","PSO CLO1",10,0 ) | |
| 3388 | N X,Y,%,% DT,J,ANQ,A NQD,ANQJ,A NQRE,DTOUT ,DUOUT,DIR ,DIRUT,LST FOUR,PSOYS ,PSTYPE,PS REG,CLOZFL G | |
| 3389 | "RTN","PSO CLO1",11,0 ) | |
| 3390 | ;; START NCC REMEDI ATION >> 4 57*RJS | |
| 3391 | "RTN","PSO CLO1",12,0 ) | |
| 3392 | W !!,"Now doing Clo zapine Ord er checks. Please w ait...",! | |
| 3393 | "RTN","PSO CLO1",13,0 ) | |
| 3394 | N PSMSGTX T,NOKEY S NOKEY='$$F IND1^DIC(2 00.051,"," _+DUZ_",", "X","PSOLO CKCLOZ") | |
| 3395 | "RTN","PSO CLO1",14,0 ) | |
| 3396 | I XQY0["P SO" S PSTY PE=0,PSMSG TXT="presc ription" K PSOSAND | |
| 3397 | "RTN","PSO CLO1",15,0 ) | |
| 3398 | I XQY0["P SJ" S PSTY PE=1,PSMSG TXT="order " | |
| 3399 | "RTN","PSO CLO1",16,0 ) | |
| 3400 | ; /RBN Be gin NCC un registered bypass fo r PSO*457 | |
| 3401 | "RTN","PSO CLO1",17,0 ) | |
| 3402 | S CLOZFLG =0 ; Used to force s tart/stop dates to f our days o nly | |
| 3403 | "RTN","PSO CLO1",18,0 ) | |
| 3404 | S PSREG=$ $GET1^DIQ( 55,DFN,53) | |
| 3405 | "RTN","PSO CLO1",19,0 ) | |
| 3406 | I PSREG=" "!($$GET1^ DIQ(55,DFN ,54,"I")=" D") D D N OREG Q:'CL OZFLG S P SREG=$$GET 1^DIQ(55,D FN,53) | |
| 3407 | "RTN","PSO CLO1",20,0 ) | |
| 3408 | .W !!,"** * This pat ient has n o clozapin e registra tion numbe r ***",! | |
| 3409 | "RTN","PSO CLO1",21,0 ) | |
| 3410 | I PSREG?1 U6N S ^TMP ($J,"CLOZF LG",DFN)=1 | |
| 3411 | "RTN","PSO CLO1",22,0 ) | |
| 3412 | ;/RBN End NCC unreg istered pa ypass for PSO*457 | |
| 3413 | "RTN","PSO CLO1",23,0 ) | |
| 3414 | ; | |
| 3415 | "RTN","PSO CLO1",24,0 ) | |
| 3416 | S PSLAST7 ="" ; ** N CC REMEDIA TION ** 45 7/RTW | |
| 3417 | "RTN","PSO CLO1",25,0 ) | |
| 3418 | S PSOYS=$ $CL^YSCLTS T2(DFN) | |
| 3419 | "RTN","PSO CLO1",26,0 ) | |
| 3420 | G:+PSOYS< 0 END | |
| 3421 | "RTN","PSO CLO1",27,0 ) | |
| 3422 | N PSGDSP | |
| 3423 | "RTN","PSO CLO1",28,0 ) | |
| 3424 | S CLOZPAT =$P(PSOYS, U,7),CLOZP AT=$S(CLOZ PAT="M":2, CLOZPAT="B ":1,1:0) | |
| 3425 | "RTN","PSO CLO1",29,0 ) | |
| 3426 | G:+PSOYS= 0 OV1 | |
| 3427 | "RTN","PSO CLO1",30,0 ) | |
| 3428 | I +PSOYS= 1 D | |
| 3429 | "RTN","PSO CLO1",31,0 ) | |
| 3430 | .I '$G(CL OZFLG),$G( ^TMP($J,"C LOZFLG",DF N)) S CLOZ FLG=1 Q | |
| 3431 | "RTN","PSO CLO1",32,0 ) | |
| 3432 | .D DSP | |
| 3433 | "RTN","PSO CLO1",33,0 ) | |
| 3434 | I +$P(PSO YS,U,2)>0, +$P(PSOYS, U,4)>1499, '$G(CLOZFL G) D:'$G(P STYPE) DOS E Q | |
| 3435 | "RTN","PSO CLO1",34,0 ) | |
| 3436 | I $G(ANQR E)'=7,$$OV ERRIDE^YSC LTST2(DFN) S ANQRE=7 ,ANQX=0 W !!,"Permis sion to di spense clo zapine has been auth orized by NCCC",! | |
| 3437 | "RTN","PSO CLO1",35,0 ) | |
| 3438 | I $G(CLOZ FLG),+PSOY S=1 S ANQR E=8 | |
| 3439 | "RTN","PSO CLO1",36,0 ) | |
| 3440 | S X=$S(CL OZPAT=2:84 ,CLOZPAT=1 :42,1:21) | |
| 3441 | "RTN","PSO CLO1",37,0 ) | |
| 3442 | D CL1^YSC LTST2(DFN, X) | |
| 3443 | "RTN","PSO CLO1",38,0 ) | |
| 3444 | ;/RBN-RJS Begin mod ification for overri de bypass | |
| 3445 | "RTN","PSO CLO1",39,0 ) | |
| 3446 | I $D(^TMP ($J,"PSO") ) D DSP,CH ECK | |
| 3447 | "RTN","PSO CLO1",40,0 ) | |
| 3448 | I $P(ANQ( 1),U,2)>14 99,+$G(PST YPE),'+$G( ANQRE) Q ;/RJS Emer gency over ride | |
| 3449 | "RTN","PSO CLO1",41,0 ) | |
| 3450 | I $P(ANQ( 1),U,2)>14 99,'$G(PST YPE),'+$G( ANQRE) D D OSE Q ;/R JS Emergen cy overrid e | |
| 3451 | "RTN","PSO CLO1",42,0 ) | |
| 3452 | E D OVRD | |
| 3453 | "RTN","PSO CLO1",43,0 ) | |
| 3454 | ;/RBN-RJS End modif ication fo r override bypass | |
| 3455 | "RTN","PSO CLO1",44,0 ) | |
| 3456 | Q | |
| 3457 | "RTN","PSO CLO1",45,0 ) | |
| 3458 | ; | |
| 3459 | "RTN","PSO CLO1",46,0 ) | |
| 3460 | OV1 I $$OV ERRIDE^YSC LTST2(DFN) S ANQRE=7 ,ANQX=0 W !!,"Permis sion to di spense clo zapine has been auth orized by NCCC",! | |
| 3461 | "RTN","PSO CLO1",47,0 ) | |
| 3462 | S X=$S(CL OZPAT=2:84 ,CLOZPAT=1 :42,1:21) | |
| 3463 | "RTN","PSO CLO1",48,0 ) | |
| 3464 | D CL1^YSC LTST2(DFN, X) | |
| 3465 | "RTN","PSO CLO1",49,0 ) | |
| 3466 | S:$P(PSOY S,U,6)="" $P(PSOYS,U ,6)=DT | |
| 3467 | "RTN","PSO CLO1",50,0 ) | |
| 3468 | I $G(ANQR E)'=7 D DS P,CHECK | |
| 3469 | "RTN","PSO CLO1",51,0 ) | |
| 3470 | I $G(ANQR E)=8!($G(A NQRE)=7) D OVRD Q | |
| 3471 | "RTN","PSO CLO1",52,0 ) | |
| 3472 | ; | |
| 3473 | "RTN","PSO CLO1",53,0 ) | |
| 3474 | I +$P(PSO YS,U,2),+$ P(PSOYS,U, 4)<1000,+$ P(PSOYS,U, 4)>0 D MSG 4^PSOCLUTL ,MSG3^PSOC LUTL,MH,QU Q | |
| 3475 | "RTN","PSO CLO1",54,0 ) | |
| 3476 | I $D(PSRE G),'+$P(PS OYS,U,2),' +$P(PSOYS, U,4) D MSG 4^PSOCLUTL ,MSG3^PSOC LUTL,MH,QU Q | |
| 3477 | "RTN","PSO CLO1",55,0 ) | |
| 3478 | I PSTYPE= 0 D | |
| 3479 | "RTN","PSO CLO1",56,0 ) | |
| 3480 | .I +$P(PS OYS,U,2),' +$P(PSOYS, U,4) D MSG 9^PSOCLUTL ,PKEYCHK,O VRD Q ; W BC & NO AN C | |
| 3481 | "RTN","PSO CLO1",57,0 ) | |
| 3482 | .I '+$P(P SOYS,U,2), '+$P(PSOYS ,U,4) D MS G9^PSOCLUT L,PKEYCHK, OVRD Q ;N O LABS | |
| 3483 | "RTN","PSO CLO1",58,0 ) | |
| 3484 | I PSTYPE= 1 D | |
| 3485 | "RTN","PSO CLO1",59,0 ) | |
| 3486 | .I +$P(PS OYS,U,2),' +$P(PSOYS, U,4) D MSG 10^PSOCLUT L,OVRD Q ; WBC & NO ANC | |
| 3487 | "RTN","PSO CLO1",60,0 ) | |
| 3488 | .I '+$P(P SOYS,U,2), '+$P(PSOYS ,U,4) D MS G10^PSOCLU TL,PKEYCHK ,OVRD Q ; NO LABS | |
| 3489 | "RTN","PSO CLO1",61,0 ) | |
| 3490 | I '+$P(PS OYS,U,2),+ $P(PSOYS,U ,4) D MSG1 ^PSOCLUTL Q ;NO WBC & WITH AN C | |
| 3491 | "RTN","PSO CLO1",62,0 ) | |
| 3492 | Q | |
| 3493 | "RTN","PSO CLO1",63,0 ) | |
| 3494 | CHECK ; | |
| 3495 | "RTN","PSO CLO1",64,0 ) | |
| 3496 | S:'NOKEY ANQX=0 ;RT W added be cause of u ndefined A NQX error from PSGOE 7.INT 3160 303 | |
| 3497 | "RTN","PSO CLO1",65,0 ) | |
| 3498 | I $G(ANQR E)'=7,$G(A NQRE)'=8 S ANQRE=$S( '+$P(PSOYS ,U,4):9,$P (PSOYS,U,4 )<1000:9,' $P(PSOYS,U ,2):9,$P(P SOYS,U,4)< 1500:10,PS LAST7["Y": 9,1:0) | |
| 3499 | "RTN","PSO CLO1",66,0 ) | |
| 3500 | I '$P(PSO YS,U,6) S $P(PSOYS,U ,6)=$$NOW^ XLFDT | |
| 3501 | "RTN","PSO CLO1",67,0 ) | |
| 3502 | S (ANQD,A NQD(1))=99 99999-$P(P SOYS,U,6) | |
| 3503 | "RTN","PSO CLO1",68,0 ) | |
| 3504 | S ANQ(1)= $P(PSOYS,U ,2)_U_$P(P SOYS,U,4) D | |
| 3505 | "RTN","PSO CLO1",69,0 ) | |
| 3506 | .Q:'$D(^T MP($J,"PSO ")) | |
| 3507 | "RTN","PSO CLO1",70,0 ) | |
| 3508 | .F ANQJ=2 :1:4 S ANQ D=$O(^TMP( $J,"PSO",A NQD)) Q:'A NQD S ANQ (ANQJ)=^(A NQD),ANQD( ANQJ)=ANQD | |
| 3509 | "RTN","PSO CLO1",71,0 ) | |
| 3510 | S ANQD=$O (ANQ(""),- 1) | |
| 3511 | "RTN","PSO CLO1",72,0 ) | |
| 3512 | I $D(PSRE G),PSREG[" Z",$P(PSOY S,U,4)'>14 99 W !,"Em ergency ov errides fo r non regi stered clo zapine pat ients requ ires",!,"A NC levels greater th an or equa l to 1500" ,! S ANQX= 1 Q ;;RTW NCC PSJ A ND PSO | |
| 3513 | "RTN","PSO CLO1",73,0 ) | |
| 3514 | I ANQD<2 W !,"*** N o previous results t o display ***",! Q | |
| 3515 | "RTN","PSO CLO1",74,0 ) | |
| 3516 | S ANQ=$S( $P(ANQ(1), U)!$P(ANQ( 1),U,2):AN QD,1:ANQD- 1) | |
| 3517 | "RTN","PSO CLO1",75,0 ) | |
| 3518 | W !,"*** Last "_$S( ANQ=4:"Fou r ",ANQ=3: "Three ",A NQ=2:"Two ",1:"")_"W BC and NEU TROPHILS A BSOLUTE (A NC) result s ***",! | |
| 3519 | "RTN","PSO CLO1",76,0 ) | |
| 3520 | W !,?39," WBC ANC ",! | |
| 3521 | "RTN","PSO CLO1",77,0 ) | |
| 3522 | F ANQJ=AN QD:-1:1 S ANQD=99999 99-ANQD(AN QJ)_"0000" D | |
| 3523 | "RTN","PSO CLO1",78,0 ) | |
| 3524 | .I $L($P( $G(ANQ(ANQ J)),U))!$L ($P($G(ANQ (ANQJ)),U, 2)) D | |
| 3525 | "RTN","PSO CLO1",79,0 ) | |
| 3526 | ..W $$FMT E^XLFDT(AN QD,"5Z") W :ANQD["." "@",$E(ANQ D,9,10),": ",$E(ANQD, 11,12) | |
| 3527 | "RTN","PSO CLO1",80,0 ) | |
| 3528 | ..W ?29," Results: " _$J($P(ANQ (ANQJ),U), 4)_" ",$ J($P(ANQ(A NQJ),U,2), 4),! | |
| 3529 | "RTN","PSO CLO1",81,0 ) | |
| 3530 | Q | |
| 3531 | "RTN","PSO CLO1",82,0 ) | |
| 3532 | OVRD ; | |
| 3533 | "RTN","PSO CLO1",83,0 ) | |
| 3534 | Q:$G(ANQX ) | |
| 3535 | "RTN","PSO CLO1",84,0 ) | |
| 3536 | N PSREASO N | |
| 3537 | "RTN","PSO CLO1",85,0 ) | |
| 3538 | I ANQRE,N OKEY D D QU G EXIT | |
| 3539 | "RTN","PSO CLO1",86,0 ) | |
| 3540 | .S ANQX=1 W !!,"You Are Not A uthorized to Overrid e! See Clo zapine Man ager with PSOLOCKCLO Z key." | |
| 3541 | "RTN","PSO CLO1",87,0 ) | |
| 3542 | ; ** STAR T NCC REME DIATION ** 457/RTW | |
| 3543 | "RTN","PSO CLO1",88,0 ) | |
| 3544 | I ANQRE W !,"Overri de reason: "_$P($T(@ ANQRE),";; ",2),! D | |
| 3545 | "RTN","PSO CLO1",89,0 ) | |
| 3546 | .I ANQRE= 7 D Q | |
| 3547 | "RTN","PSO CLO1",90,0 ) | |
| 3548 | ..S PSREA SON=$P($T( @(ANQRE_"^ PSOCLO1")) ,";;",2) | |
| 3549 | "RTN","PSO CLO1",91,0 ) | |
| 3550 | ..D OVPRM PT | |
| 3551 | "RTN","PSO CLO1",92,0 ) | |
| 3552 | ..Q:$G(AN QX) | |
| 3553 | "RTN","PSO CLO1",93,0 ) | |
| 3554 | ..D OVRD2 | |
| 3555 | "RTN","PSO CLO1",94,0 ) | |
| 3556 | ..Q:$G(AN QX) | |
| 3557 | "RTN","PSO CLO1",95,0 ) | |
| 3558 | ..D OVRRE A | |
| 3559 | "RTN","PSO CLO1",96,0 ) | |
| 3560 | .I ANQRE= 5 D Q | |
| 3561 | "RTN","PSO CLO1",97,0 ) | |
| 3562 | ..S DIR(" A")="ANC l evels are Critically low. Do y ou want to Cancel th e order",D IR(0)="Y", DIR("B")=" N" | |
| 3563 | "RTN","PSO CLO1",98,0 ) | |
| 3564 | ..D ^DIR K DIR I Y= 0 D MSG6^P SOCLUTL Q | |
| 3565 | "RTN","PSO CLO1",99,0 ) | |
| 3566 | ..I Y(0)= "YES"!($D( DTOUT))!($ D(DUOUT))! ($D(DIROUT )) S ANQX= 1 K DIR Q | |
| 3567 | "RTN","PSO CLO1",100, 0) | |
| 3568 | .I $G(ANQ RE)=8 D Q | |
| 3569 | "RTN","PSO CLO1",101, 0) | |
| 3570 | ..S ANQX= 0 | |
| 3571 | "RTN","PSO CLO1",102, 0) | |
| 3572 | ..D OVPRM PT | |
| 3573 | "RTN","PSO CLO1",103, 0) | |
| 3574 | ..Q:$G(AN QX) | |
| 3575 | "RTN","PSO CLO1",104, 0) | |
| 3576 | ..D OVRD2 | |
| 3577 | "RTN","PSO CLO1",105, 0) | |
| 3578 | ..Q:$G(AN QX) | |
| 3579 | "RTN","PSO CLO1",106, 0) | |
| 3580 | ..D OVRRE A | |
| 3581 | "RTN","PSO CLO1",107, 0) | |
| 3582 | .;/RBN Be gin modifi cations fo r new spec ial overid e conditio n for inpa tient | |
| 3583 | "RTN","PSO CLO1",108, 0) | |
| 3584 | .I ANQRE= 9,PSTYPE=0 D Q | |
| 3585 | "RTN","PSO CLO1",109, 0) | |
| 3586 | ..D OVPRM PT | |
| 3587 | "RTN","PSO CLO1",110, 0) | |
| 3588 | ..Q:$G(AN QX) | |
| 3589 | "RTN","PSO CLO1",111, 0) | |
| 3590 | ..K DIR,D IRUT S DIR (0)="S^1:W eather Rel ated Condi tions;2:Ma il Order D elay;3:Inp atient Goi ng On Leav e" | |
| 3591 | "RTN","PSO CLO1",112, 0) | |
| 3592 | ..S DIR(" A")="Presc riber's re ason for S pecial Con dition Ove rride " D ^DIR K DIR I $D(DIRU T) S ANQX= 1 Q | |
| 3593 | "RTN","PSO CLO1",113, 0) | |
| 3594 | ..S PSREA SON=Y(0)_" : ",^TMP($ J,"CLOZFLG ",DFN)=1 | |
| 3595 | "RTN","PSO CLO1",114, 0) | |
| 3596 | ..D OVRD2 | |
| 3597 | "RTN","PSO CLO1",115, 0) | |
| 3598 | ..Q:$G(AN QX) | |
| 3599 | "RTN","PSO CLO1",116, 0) | |
| 3600 | ..D OVRRE A | |
| 3601 | "RTN","PSO CLO1",117, 0) | |
| 3602 | ..Q:$G(AN QX) | |
| 3603 | "RTN","PSO CLO1",118, 0) | |
| 3604 | ..S PSREM ARK=PSREAS ON_PSREMAR K | |
| 3605 | "RTN","PSO CLO1",119, 0) | |
| 3606 | .I ANQRE= 9,PSTYPE=1 D Q | |
| 3607 | "RTN","PSO CLO1",120, 0) | |
| 3608 | ..D OVPRM PT | |
| 3609 | "RTN","PSO CLO1",121, 0) | |
| 3610 | ..Q:$G(AN QX) | |
| 3611 | "RTN","PSO CLO1",122, 0) | |
| 3612 | ..S PSREA SON="IP Or der Overri de with Ou tside Lab Results: " ,^TMP($J," CLOZFLG",D FN)=1 | |
| 3613 | "RTN","PSO CLO1",123, 0) | |
| 3614 | ..W !,$P( PSREASON," :"),! | |
| 3615 | "RTN","PSO CLO1",124, 0) | |
| 3616 | ..D OVRRE A | |
| 3617 | "RTN","PSO CLO1",125, 0) | |
| 3618 | ..Q:$G(AN QX) | |
| 3619 | "RTN","PSO CLO1",126, 0) | |
| 3620 | ..D OVRD2 | |
| 3621 | "RTN","PSO CLO1",127, 0) | |
| 3622 | ..Q:$G(AN QX) | |
| 3623 | "RTN","PSO CLO1",128, 0) | |
| 3624 | ..S PSREM ARK=PSREAS ON_PSREMAR K | |
| 3625 | "RTN","PSO CLO1",129, 0) | |
| 3626 | .I ANQRE= 10 D | |
| 3627 | "RTN","PSO CLO1",130, 0) | |
| 3628 | ..W !,"Te st ANC Res ults 3x we ekly until ANC stabi lize to gr eater than or equal to 1500",! | |
| 3629 | "RTN","PSO CLO1",131, 0) | |
| 3630 | ..D OVPRM PT | |
| 3631 | "RTN","PSO CLO1",132, 0) | |
| 3632 | ..Q:$G(AN QX) | |
| 3633 | "RTN","PSO CLO1",133, 0) | |
| 3634 | ..D OVRD2 | |
| 3635 | "RTN","PSO CLO1",134, 0) | |
| 3636 | ..Q:$G(AN QX) | |
| 3637 | "RTN","PSO CLO1",135, 0) | |
| 3638 | ..D OVRRE A | |
| 3639 | "RTN","PSO CLO1",136, 0) | |
| 3640 | I $G(ANQX ) D EXIT Q | |
| 3641 | "RTN","PSO CLO1",137, 0) | |
| 3642 | S PSPROVI D="UNKNOWN " | |
| 3643 | "RTN","PSO CLO1",138, 0) | |
| 3644 | I $D(ND0) S PSPROVI D=$P(ND0,U ,2),PSJORN =$P(ND0,U, 21),PSJORD ER("PSJORN ")=PSJORN | |
| 3645 | "RTN","PSO CLO1",139, 0) | |
| 3646 | I $D(ORO) S PSPROVI D=$P(ORO,U ,4),PSJORN =$P(ORO,U) ,PSJORDER( "PSJORN")= PSJORN | |
| 3647 | "RTN","PSO CLO1",140, 0) | |
| 3648 | I '+$G(PS PROVID),+$ G(PSTYPE), +$G(PSGOEP R) S PSPRO VID=+$G(PS GOEPR) | |
| 3649 | "RTN","PSO CLO1",141, 0) | |
| 3650 | I $D(DUPR X0) S PSPR OVID=$P(DU PRX0,U,4) | |
| 3651 | "RTN","PSO CLO1",142, 0) | |
| 3652 | ;/RBN Beg in modific ations for new speci al overide condition for inpat ient | |
| 3653 | "RTN","PSO CLO1",143, 0) | |
| 3654 | Q:$G(ANQX ) | |
| 3655 | "RTN","PSO CLO1",144, 0) | |
| 3656 | ;/RBN Beg in modific ation to p ut pieces of ANQDATA in the co rrect sequ ence. | |
| 3657 | "RTN","PSO CLO1",145, 0) | |
| 3658 | S:ANQRE S ANQX=0,PSC LPAT=DFN,A NQDATA=DUZ _U_PSPROVI D_U_ANQRE_ U_PSREMARK _U_PSSPHAR M_U_PSCLPA T_U_$G(PSJ ORN) | |
| 3659 | "RTN","PSO CLO1",146, 0) | |
| 3660 | ;/RBN End modificat ion to put pieces of ANQDATA i n correct sequence. | |
| 3661 | "RTN","PSO CLO1",147, 0) | |
| 3662 | ; ** END NCC REMEDI ATION ** 4 57/RTW | |
| 3663 | "RTN","PSO CLO1",148, 0) | |
| 3664 | GDOSE ; se t variable to ask da ily dose | |
| 3665 | "RTN","PSO CLO1",149, 0) | |
| 3666 | N PSOCD | |
| 3667 | "RTN","PSO CLO1",150, 0) | |
| 3668 | I $G(PSTY PE) Q | |
| 3669 | "RTN","PSO CLO1",151, 0) | |
| 3670 | DOSE ; | |
| 3671 | "RTN","PSO CLO1",152, 0) | |
| 3672 | S DIR(0)= "N^12.5:30 00:1",DIR( "A")="CLOZ APINE dosa ge (mg/day ) ? " D ^D IR K DIR G EXIT:$D(D IRUT) | |
| 3673 | "RTN","PSO CLO1",153, 0) | |
| 3674 | S PSOCD=X | |
| 3675 | "RTN","PSO CLO1",154, 0) | |
| 3676 | I PSOCD#2 5=0,PSOCD' <12.5,PSOC D<900 G EX IT | |
| 3677 | "RTN","PSO CLO1",155, 0) | |
| 3678 | I PSOCD#1 2.5 S DIR( 0)="Y",DIR ("B")="NO" ,DIR("A")= PSOCD_" is an unusua l dose. A re you sur e " D ^DIR K DIR G E XIT:$D(DIR UT) I 'Y G DOSE | |
| 3679 | "RTN","PSO CLO1",156, 0) | |
| 3680 | I PSOCD>9 00 S DIR(0 )="Y",DIR( "A")="Reco mmended ma ximum dail y dose is 900. Are y ou sure " D ^DIR K D IR G EXIT: $D(DIRUT) I 'Y G DOS E | |
| 3681 | "RTN","PSO CLO1",157, 0) | |
| 3682 | EXIT ; | |
| 3683 | "RTN","PSO CLO1",158, 0) | |
| 3684 | K ^TMP($J ,"PSO") | |
| 3685 | "RTN","PSO CLO1",159, 0) | |
| 3686 | S:$D(DIRU T) ANQX=1 | |
| 3687 | "RTN","PSO CLO1",160, 0) | |
| 3688 | I $G(ANQX ) W !!,"No "_PSMSGTX T_" entere d!" H 2 Q | |
| 3689 | "RTN","PSO CLO1",161, 0) | |
| 3690 | S (PSONEW ("SAND"),P SOSAND)=PS OCD_U_$P(P SOYS,U,2)_ U_($P($P(P SOYS,U,6), "."))_U_$P (PSOYS,U,4 ) | |
| 3691 | "RTN","PSO CLO1",162, 0) | |
| 3692 | N NDAYS S NDAYS=$S( $G(ANQRE)= 9!(PSREG?1 U6N):4,CLO ZPAT=2:28, CLOZPAT=1: 14,1:7) | |
| 3693 | "RTN","PSO CLO1",163, 0) | |
| 3694 | I $G(PSON EW("DAYS S UPPLY"))>N DAYS D | |
| 3695 | "RTN","PSO CLO1",164, 0) | |
| 3696 | .S PSONEW ("DAYS SUP PLY")=NDAY S,$P(PSONE W("RX0"),U ,8)=NDAYS | |
| 3697 | "RTN","PSO CLO1",165, 0) | |
| 3698 | .S PSONEW ("DURATION ",1)=NDAYS | |
| 3699 | "RTN","PSO CLO1",166, 0) | |
| 3700 | .N SCH,ND ,QTY S SCH =PSONEW("S CHEDULE",1 ) | |
| 3701 | "RTN","PSO CLO1",167, 0) | |
| 3702 | .S ND=$$Q TSCH^PSOSI G(SCH) Q:' ND ;numb er of minu tes betwee n meds | |
| 3703 | "RTN","PSO CLO1",168, 0) | |
| 3704 | .S ND=144 0/ND ;time s daily | |
| 3705 | "RTN","PSO CLO1",169, 0) | |
| 3706 | .S QTY=ND AYS*ND*PSO NEW("DOSE ORDERED",1 ) | |
| 3707 | "RTN","PSO CLO1",170, 0) | |
| 3708 | .S PSONEW ("QTY")=QT Y,$P(PSONE W("RX0"),U ,7)=QTY | |
| 3709 | "RTN","PSO CLO1",171, 0) | |
| 3710 | Q | |
| 3711 | "RTN","PSO CLO1",172, 0) | |
| 3712 | OVPRMPT S DIR("A")=" Do you wan t to overr ide and is sue this " _PSMSGTXT, DIR(0)="Y" ,DIR("B")= "N" D ^DIR I 'Y!($D( DIROUT)!($ D(DTOUT))) S ANQX=1 K DIR | |
| 3713 | "RTN","PSO CLO1",173, 0) | |
| 3714 | Q | |
| 3715 | "RTN","PSO CLO1",174, 0) | |
| 3716 | ;/RBN mes sages move to PSOCLU TL to redu ce routine length to meet SACC standards | |
| 3717 | "RTN","PSO CLO1",175, 0) | |
| 3718 | ; | |
| 3719 | "RTN","PSO CLO1",176, 0) | |
| 3720 | PKEYCHK ; CHECK TO S EE IT PHAR MACIST HAS THE PSOLO CKCLOZ KEY | |
| 3721 | "RTN","PSO CLO1",177, 0) | |
| 3722 | I '$D(PSG STAT)!($G( PSGSTAT)=" PENDING") D | |
| 3723 | "RTN","PSO CLO1",178, 0) | |
| 3724 | .I NOKEY D | |
| 3725 | "RTN","PSO CLO1",179, 0) | |
| 3726 | ..S ANQX= 1 W !,"You Are Not A uthorized to Overrid e! See Clo zapine Man ager with PSOLOCKCLO Z key." | |
| 3727 | "RTN","PSO CLO1",180, 0) | |
| 3728 | Q | |
| 3729 | "RTN","PSO CLO1",181, 0) | |
| 3730 | ; | |
| 3731 | "RTN","PSO CLO1",182, 0) | |
| 3732 | MH ; | |
| 3733 | "RTN","PSO CLO1",183, 0) | |
| 3734 | W !!,"Als o make sur e that the LAB test, ANC is se t up corre ctly in th e" | |
| 3735 | "RTN","PSO CLO1",184, 0) | |
| 3736 | W !,"Ment al Health package us ing the CL OZAPINE MU LTI TEST L INK option .",! | |
| 3737 | "RTN","PSO CLO1",185, 0) | |
| 3738 | Q | |
| 3739 | "RTN","PSO CLO1",186, 0) | |
| 3740 | DSP ;; ** START NCC REMEDIATIO N ** 457 A ND PSJ 327 /RTW | |
| 3741 | "RTN","PSO CLO1",187, 0) | |
| 3742 | I '+$P(PS OYS,U,2),' +$P(PSOYS, U,4) Q | |
| 3743 | "RTN","PSO CLO1",188, 0) | |
| 3744 | Q:+$G(PSG DSP) | |
| 3745 | "RTN","PSO CLO1",189, 0) | |
| 3746 | W !,"*** Most recen t WBC and "_$P(PSOYS ,U,5)_" (A NC) result s ***" | |
| 3747 | "RTN","PSO CLO1",190, 0) | |
| 3748 | ; ** END NCC REMEDI ATION ** 4 57 AND PSJ 327/RTW | |
| 3749 | "RTN","PSO CLO1",191, 0) | |
| 3750 | W !," performed on " | |
| 3751 | "RTN","PSO CLO1",192, 0) | |
| 3752 | S Y=$P(PS OYS,U,6) X ^DD("DD") W $P(Y,"@ ")_" are: " | |
| 3753 | "RTN","PSO CLO1",193, 0) | |
| 3754 | W !!,?5,$ P(PSOYS,U, 3)_": "_$P (PSOYS,U,2 ) | |
| 3755 | "RTN","PSO CLO1",194, 0) | |
| 3756 | W !,?5,"A NC: "_+$P( PSOYS,U,4) ,! | |
| 3757 | "RTN","PSO CLO1",195, 0) | |
| 3758 | S PSGDSP= 1 | |
| 3759 | "RTN","PSO CLO1",196, 0) | |
| 3760 | Q | |
| 3761 | "RTN","PSO CLO1",197, 0) | |
| 3762 | DIR ; | |
| 3763 | "RTN","PSO CLO1",198, 0) | |
| 3764 | W !! K DI R S DIR(0) ="E",DIR(" A")="Press Return to Continue" D ^DIR K DIR,DTOUT, DUOUT,DIRU T | |
| 3765 | "RTN","PSO CLO1",199, 0) | |
| 3766 | Q | |
| 3767 | "RTN","PSO CLO1",200, 0) | |
| 3768 | ; ** STAR T NCC REME DIATION ** 457/RTW | |
| 3769 | "RTN","PSO CLO1",201, 0) | |
| 3770 | PHGRP ; | |
| 3771 | "RTN","PSO CLO1",202, 0) | |
| 3772 | N ARRAY D LIST^DIC( 200,,.01," P",,,"PSOL OCKCLOZ"," AB",,,"ARR AY") | |
| 3773 | "RTN","PSO CLO1",203, 0) | |
| 3774 | S PSJCNT= 0 F I=1:1 Q:'$D(ARRA Y("DILIST" ,I)) D | |
| 3775 | "RTN","PSO CLO1",204, 0) | |
| 3776 | . S XDUZ= $P(ARRAY(" DILIST",I, 0),U) Q:XD UZ=DUZ | |
| 3777 | "RTN","PSO CLO1",205, 0) | |
| 3778 | . Q:$$GET 1^DIQ(200, XDUZ,2)="" | |
| 3779 | "RTN","PSO CLO1",206, 0) | |
| 3780 | . Q:$$GET 1^DIQ(200, XDUZ,7,"I" )=1 | |
| 3781 | "RTN","PSO CLO1",207, 0) | |
| 3782 | . S PSJCN T=PSJCNT+1 | |
| 3783 | "RTN","PSO CLO1",208, 0) | |
| 3784 | . S ^TMP( "XQADUZ",$ J,XDUZ)="" | |
| 3785 | "RTN","PSO CLO1",209, 0) | |
| 3786 | W:PSJCNT= 0 "NO ACTI VE APPROVI NG MEMBERS AVAILABLE " | |
| 3787 | "RTN","PSO CLO1",210, 0) | |
| 3788 | K XDUZ | |
| 3789 | "RTN","PSO CLO1",211, 0) | |
| 3790 | Q | |
| 3791 | "RTN","PSO CLO1",212, 0) | |
| 3792 | ; ** END NCC REMEDI ATION ** 4 57/RTW | |
| 3793 | "RTN","PSO CLO1",213, 0) | |
| 3794 | ; | |
| 3795 | "RTN","PSO CLO1",214, 0) | |
| 3796 | END ; | |
| 3797 | "RTN","PSO CLO1",215, 0) | |
| 3798 | D MSG5^PS OCLUTL | |
| 3799 | "RTN","PSO CLO1",216, 0) | |
| 3800 | QU S ANQX= 1 D DIR | |
| 3801 | "RTN","PSO CLO1",217, 0) | |
| 3802 | Q | |
| 3803 | "RTN","PSO CLO1",218, 0) | |
| 3804 | ; | |
| 3805 | "RTN","PSO CLO1",219, 0) | |
| 3806 | ; /RBN Be gin NCC we ekend/new patient fo r PSO*7.0* 457 | |
| 3807 | "RTN","PSO CLO1",220, 0) | |
| 3808 | NOREG ; Re gister a n ew/discont inued non- registered cloz pati ent | |
| 3809 | "RTN","PSO CLO1",221, 0) | |
| 3810 | ; | |
| 3811 | "RTN","PSO CLO1",222, 0) | |
| 3812 | N %,FIRST ,FLG,I,LAS T,LSTFOUR, MSG,MSGNUM ,NAME,NOW, PSO1,PSO2, PSO4,PSONA ME,REG,SSN ,STAT,TMP1 | |
| 3813 | "RTN","PSO CLO1",223, 0) | |
| 3814 | N TMP2,X, X1,X2XML,X MSUB,XMTEX T,YSCLFRQ | |
| 3815 | "RTN","PSO CLO1",224, 0) | |
| 3816 | ; Check f or authori zation key | |
| 3817 | "RTN","PSO CLO1",225, 0) | |
| 3818 | I NOKEY D Q | |
| 3819 | "RTN","PSO CLO1",226, 0) | |
| 3820 | .S ANQX=1 W !,"You Are Not Au thorized t o Override ! See Cloz apine Mana ger with P SOLOCKCLOZ key." W:P STYPE=1 !! ,"No order entered!" | |
| 3821 | "RTN","PSO CLO1",227, 0) | |
| 3822 | ; | |
| 3823 | "RTN","PSO CLO1",228, 0) | |
| 3824 | W !,"Do y ou want to register this patie nt with a temporary local" | |
| 3825 | "RTN","PSO CLO1",229, 0) | |
| 3826 | W !," aut horization number in the Cloza pine regis ter? Y/N " | |
| 3827 | "RTN","PSO CLO1",230, 0) | |
| 3828 | S %=2 D Y N^DICN I % '=1 S ANQX =1 W !,"Pa tient Not Registered ",! Q | |
| 3829 | "RTN","PSO CLO1",231, 0) | |
| 3830 | W ! | |
| 3831 | "RTN","PSO CLO1",232, 0) | |
| 3832 | S (PSO1,T MP1)=DFN | |
| 3833 | "RTN","PSO CLO1",233, 0) | |
| 3834 | S PSO2=$$ FINDNEXT | |
| 3835 | "RTN","PSO CLO1",234, 0) | |
| 3836 | I PSO2=-1 D S ANQX =1 Q | |
| 3837 | "RTN","PSO CLO1",235, 0) | |
| 3838 | .W !!,"Al l emergenc y registra tion numbe rs have be en used." | |
| 3839 | "RTN","PSO CLO1",236, 0) | |
| 3840 | .W !,"Eme rgency reg istration may no lon ger be don e at this site",!! | |
| 3841 | "RTN","PSO CLO1",237, 0) | |
| 3842 | .W !,"Pat ient Not R egistered" ,! | |
| 3843 | "RTN","PSO CLO1",238, 0) | |
| 3844 | CONT S TMP 2=PSO2 | |
| 3845 | "RTN","PSO CLO1",239, 0) | |
| 3846 | S (NAME,P SONAME)=$$ GET1^DIQ(2 ,PSO1,.01) | |
| 3847 | "RTN","PSO CLO1",240, 0) | |
| 3848 | S PSCLOZ= 1 | |
| 3849 | "RTN","PSO CLO1",241, 0) | |
| 3850 | S DFN=TMP 1 | |
| 3851 | "RTN","PSO CLO1",242, 0) | |
| 3852 | S (PSO2,R EG)=TMP2 | |
| 3853 | "RTN","PSO CLO1",243, 0) | |
| 3854 | ; Check i f registra tion in fi le #55 fai led or was terminate d | |
| 3855 | "RTN","PSO CLO1",244, 0) | |
| 3856 | S LAST=$P (NAME,",") ,FIRST=$P( $P(NAME,", ",2)," ") | |
| 3857 | "RTN","PSO CLO1",245, 0) | |
| 3858 | S SSN=$$G ET1^DIQ(2, PSO1,.09), LSTFOUR=$E (SSN,6,9), ANQX=1 | |
| 3859 | "RTN","PSO CLO1",246, 0) | |
| 3860 | D NUMBER1 ^PSOCLUTL | |
| 3861 | "RTN","PSO CLO1",247, 0) | |
| 3862 | Q:$G(ANQX ) | |
| 3863 | "RTN","PSO CLO1",248, 0) | |
| 3864 | D ; Cle an file 60 3.01 | |
| 3865 | "RTN","PSO CLO1",249, 0) | |
| 3866 | .N DIK,DA | |
| 3867 | "RTN","PSO CLO1",250, 0) | |
| 3868 | .S DIK="^ YSCL(603.0 1,",DA="" F S DA=$O (^YSCL(603 .01,"C",DF N,DA)) Q:D A="" D ^D IK | |
| 3869 | "RTN","PSO CLO1",251, 0) | |
| 3870 | S MSG(1)= REG_","_LA ST_","_FIR ST_","_LST FOUR | |
| 3871 | "RTN","PSO CLO1",252, 0) | |
| 3872 | S XMTEXT= "MSG(" | |
| 3873 | "RTN","PSO CLO1",253, 0) | |
| 3874 | ;/RBN Beg in modific ation for XMSUB gets killed of f in NUMBE R1^PSOCLUT L | |
| 3875 | "RTN","PSO CLO1",254, 0) | |
| 3876 | S XMSUB=" ADD" | |
| 3877 | "RTN","PSO CLO1",255, 0) | |
| 3878 | N YSPROD S YSPROD=$ $GET1^DIQ( 8989.3,1,5 01,"I") ;X ^%ZOSF("U CI") | |
| 3879 | "RTN","PSO CLO1",256, 0) | |
| 3880 | I YSPROD S XMY("G.
|
|
| 3881 | "RTN","PSO CLO1",257, 0) | |
| 3882 | E S XMY( "G.CLOZAPI NE ROLL-UP ")="" | |
| 3883 | "RTN","PSO CLO1",258, 0) | |
| 3884 | D ^XMD | |
| 3885 | "RTN","PSO CLO1",259, 0) | |
| 3886 | S DFN=TMP 1 | |
| 3887 | "RTN","PSO CLO1",260, 0) | |
| 3888 | I '$G(XMM G) S MSGNU M=$G(XMZ) | |
| 3889 | "RTN","PSO CLO1",261, 0) | |
| 3890 | E W !!," Failed to connect wi th the NCC C." S PSOF L=1 Q | |
| 3891 | "RTN","PSO CLO1",262, 0) | |
| 3892 | ; Now tri ck the ser ver into t hinking it is sendin g a messag e | |
| 3893 | "RTN","PSO CLO1",263, 0) | |
| 3894 | ; so we c an populat e 55 and 6 03.01 | |
| 3895 | "RTN","PSO CLO1",264, 0) | |
| 3896 | S PSCLOZ= 1 | |
| 3897 | "RTN","PSO CLO1",265, 0) | |
| 3898 | S ^TMP($J ,"CLOZFLG" ,DFN)=1 | |
| 3899 | "RTN","PSO CLO1",266, 0) | |
| 3900 | S XMRG=MS G(1) | |
| 3901 | "RTN","PSO CLO1",267, 0) | |
| 3902 | S XMFROM= DUZ | |
| 3903 | "RTN","PSO CLO1",268, 0) | |
| 3904 | D NOW^%DT C | |
| 3905 | "RTN","PSO CLO1",269, 0) | |
| 3906 | S XQDATE= % | |
| 3907 | "RTN","PSO CLO1",270, 0) | |
| 3908 | D ^YSCLSE RV | |
| 3909 | "RTN","PSO CLO1",271, 0) | |
| 3910 | S ^XTMP(" PSJ CLOZ", 0)=3501231 _U_DT_U_"C LOZAPINE W EEKEND REG ISTRATION" _U_REG | |
| 3911 | "RTN","PSO CLO1",272, 0) | |
| 3912 | S ^XTMP(" PSJ CLOZ", DFN)=DT_U_ REG_U_"A" | |
| 3913 | "RTN","PSO CLO1",273, 0) | |
| 3914 | S X1=% | |
| 3915 | "RTN","PSO CLO1",274, 0) | |
| 3916 | S X2=4 | |
| 3917 | "RTN","PSO CLO1",275, 0) | |
| 3918 | D C^%DTC | |
| 3919 | "RTN","PSO CLO1",276, 0) | |
| 3920 | S ^XTMP(" PSJ CLOZ", "B",REG,DF N)=X | |
| 3921 | "RTN","PSO CLO1",277, 0) | |
| 3922 | S ^XTMP(" PSJ CLOZ", "C",DFN,RE G)="" | |
| 3923 | "RTN","PSO CLO1",278, 0) | |
| 3924 | S ANQX=0 | |
| 3925 | "RTN","PSO CLO1",279, 0) | |
| 3926 | S CLOZFLG =1 | |
| 3927 | "RTN","PSO CLO1",280, 0) | |
| 3928 | QUIT Q | |
| 3929 | "RTN","PSO CLO1",281, 0) | |
| 3930 | ; | |
| 3931 | "RTN","PSO CLO1",282, 0) | |
| 3932 | FINDNEXT() ; Find th e next pse udo Clozap ine regist ration num ber | |
| 3933 | "RTN","PSO CLO1",283, 0) | |
| 3934 | N DATA,ER R,NUM,PAD, PREF,REG,S ITE | |
| 3935 | "RTN","PSO CLO1",284, 0) | |
| 3936 | I '$D(^XT MP("PSJ CL OZ",0)) D | |
| 3937 | "RTN","PSO CLO1",285, 0) | |
| 3938 | .S ^XTMP( "PSJ CLOZ" ,0)=350123 1_U_DT_U_" CLOZAPINE WEEKEND RE GISTRATION "_U_0 | |
| 3939 | "RTN","PSO CLO1",286, 0) | |
| 3940 | S PAD="00 " | |
| 3941 | "RTN","PSO CLO1",287, 0) | |
| 3942 | S SITE=$P ($$SITE^VA SITE,U,3) | |
| 3943 | "RTN","PSO CLO1",288, 0) | |
| 3944 | S REG=$P( ^XTMP("PSJ CLOZ",0), U,4) | |
| 3945 | "RTN","PSO CLO1",289, 0) | |
| 3946 | S PAD="00 " | |
| 3947 | "RTN","PSO CLO1",290, 0) | |
| 3948 | ; Get cur rent tempo rary regis tration nu mber | |
| 3949 | "RTN","PSO CLO1",291, 0) | |
| 3950 | I REG=0 D Q REG | |
| 3951 | "RTN","PSO CLO1",292, 0) | |
| 3952 | .S REG="Z "_SITE_"00 1" | |
| 3953 | "RTN","PSO CLO1",293, 0) | |
| 3954 | ; Parse i t into pre fix, site and number | |
| 3955 | "RTN","PSO CLO1",294, 0) | |
| 3956 | S PREF=$E (REG) | |
| 3957 | "RTN","PSO CLO1",295, 0) | |
| 3958 | S NUM=+$P (REG,SITE, 2)+1 | |
| 3959 | "RTN","PSO CLO1",296, 0) | |
| 3960 | ; if the number par t is >999 make the p refix the next lower (ascii) c haracter | |
| 3961 | "RTN","PSO CLO1",297, 0) | |
| 3962 | ; and the number pa rt 001 | |
| 3963 | "RTN","PSO CLO1",298, 0) | |
| 3964 | I NUM>999 D ;Q REG | |
| 3965 | "RTN","PSO CLO1",299, 0) | |
| 3966 | .S NUM="0 01" | |
| 3967 | "RTN","PSO CLO1",300, 0) | |
| 3968 | .S PREF=$ C($A(PREF) -1) | |
| 3969 | "RTN","PSO CLO1",301, 0) | |
| 3970 | S NUM=$E( PAD,1,3-$L (+NUM))_+N UM | |
| 3971 | "RTN","PSO CLO1",302, 0) | |
| 3972 | S REG=PRE F_SITE_NUM | |
| 3973 | "RTN","PSO CLO1",303, 0) | |
| 3974 | I $A(PREF )<65 S REG =-1 | |
| 3975 | "RTN","PSO CLO1",304, 0) | |
| 3976 | Q REG | |
| 3977 | "RTN","PSO CLO1",305, 0) | |
| 3978 | ; | |
| 3979 | "RTN","PSO CLO1",306, 0) | |
| 3980 | ; /RBN En d NCC week end/new pa tient for PSO*7.0*45 7 | |
| 3981 | "RTN","PSO CLO1",307, 0) | |
| 3982 | OVRD2 ; | |
| 3983 | "RTN","PSO CLO1",308, 0) | |
| 3984 | S ANQX=0 | |
| 3985 | "RTN","PSO CLO1",309, 0) | |
| 3986 | D PHGRP | |
| 3987 | "RTN","PSO CLO1",310, 0) | |
| 3988 | S DIC("S" )="I $$FIN D1^DIC(200 .051,"","" _+Y_"","", ""X"",""PS OLOCKCLOZ" "),+Y'=DUZ ,$D(^TMP(" "XQADUZ"", $J,+Y))" | |
| 3989 | "RTN","PSO CLO1",311, 0) | |
| 3990 | S DIC=200 ,DIC(0)="A EQM" | |
| 3991 | "RTN","PSO CLO1",312, 0) | |
| 3992 | S DIC("A" )="Enter t he name of an ""Appr oving memb er from th e Clozapin e team"": " | |
| 3993 | "RTN","PSO CLO1",313, 0) | |
| 3994 | D ^DIC D | |
| 3995 | "RTN","PSO CLO1",314, 0) | |
| 3996 | .I 'Y!($D (DUOUT))!( Y<0)!($D(D TOUT)) S A NQX=1 K DI C | |
| 3997 | "RTN","PSO CLO1",315, 0) | |
| 3998 | .S PSSPHA RM=+Y | |
| 3999 | "RTN","PSO CLO1",316, 0) | |
| 4000 | Q | |
| 4001 | "RTN","PSO CLO1",317, 0) | |
| 4002 | ; | |
| 4003 | "RTN","PSO CLO1",318, 0) | |
| 4004 | OVRREA ; O verride re ason when order is N CCC Approv ed | |
| 4005 | "RTN","PSO CLO1",319, 0) | |
| 4006 | S ANQX=0 N LENGTH S LENGTH=$S ($G(ANQRE) =9:200-$L( PSREASON), 1:200) | |
| 4007 | "RTN","PSO CLO1",320, 0) | |
| 4008 | I $G(ANQR E)>6 D | |
| 4009 | "RTN","PSO CLO1",321, 0) | |
| 4010 | .K DIR,DT OUT,DUOUT, DIRUT,DIRO UT | |
| 4011 | "RTN","PSO CLO1",322, 0) | |
| 4012 | .S DIR(0) ="F^5:"_LE NGTH | |
| 4013 | "RTN","PSO CLO1",323, 0) | |
| 4014 | .S DIR("A ")="Remark s" | |
| 4015 | "RTN","PSO CLO1",324, 0) | |
| 4016 | .I $G(ANQ RE)=9 S DI R("A")="Re marks: "_$ P(PSREASON ,":") | |
| 4017 | "RTN","PSO CLO1",325, 0) | |
| 4018 | .S DIR("? ")="Respon se is free text betw een 5 and 200 charac ters." | |
| 4019 | "RTN","PSO CLO1",326, 0) | |
| 4020 | .D ^DIR | |
| 4021 | "RTN","PSO CLO1",327, 0) | |
| 4022 | .I $G(DTO UT)!$G(DUO UT)!$G(DIR UT)!$G(DIR OUT) S ANQ X=1 K DIR, DTOUT,DUOU T,DIRUT,DI ROUT Q | |
| 4023 | "RTN","PSO CLO1",328, 0) | |
| 4024 | .S PSREMA RK=Y | |
| 4025 | "RTN","PSO CLO1",329, 0) | |
| 4026 | .K DIR,DT OUT,DUOUT, DIRUT,DIRO UT | |
| 4027 | "RTN","PSO CLO1",330, 0) | |
| 4028 | Q | |
| 4029 | "RTN","PSO CLO1",331, 0) | |
| 4030 | ; | |
| 4031 | "RTN","PSO CLO1",332, 0) | |
| 4032 | CHK4REG(YS CLDFN) ; S ee iF this patient a lready has a clozapi ne registr ation numb er | |
| 4033 | "RTN","PSO CLO1",333, 0) | |
| 4034 | N YSCLANS | |
| 4035 | "RTN","PSO CLO1",334, 0) | |
| 4036 | S YSCLANS ="" | |
| 4037 | "RTN","PSO CLO1",335, 0) | |
| 4038 | S YSCLANS =$O(^XTMP( "PSJ CLOZ" ,"C",YSCLD FN,YSCLANS )) | |
| 4039 | "RTN","PSO CLO1",336, 0) | |
| 4040 | Q YSCLANS | |
| 4041 | "RTN","PSO CLO1",337, 0) | |
| 4042 | ; | |
| 4043 | "RTN","PSO CLO1",338, 0) | |
| 4044 | CHK4DFN(YS CLREG) ; S ee if this Clozapine registrat ion is ass igned | |
| 4045 | "RTN","PSO CLO1",339, 0) | |
| 4046 | N YSCLANS | |
| 4047 | "RTN","PSO CLO1",340, 0) | |
| 4048 | S YSCLANS =$O(^XTMP( "PSJ CLOZ" ,"B",YSCLR EG,"")) | |
| 4049 | "RTN","PSO CLO1",341, 0) | |
| 4050 | Q YSCLANS | |
| 4051 | "RTN","PSO CLO1",342, 0) | |
| 4052 | ; | |
| 4053 | "RTN","PSO CLO1",343, 0) | |
| 4054 | CHK4EXP(YS CLREG,YSCL DFN) ; Che ck for reg istration expiration | |
| 4055 | "RTN","PSO CLO1",344, 0) | |
| 4056 | ; RETU RNS 0 IF E XPIRED | |
| 4057 | "RTN","PSO CLO1",345, 0) | |
| 4058 | ; 1 IF N OT EXPIRED | |
| 4059 | "RTN","PSO CLO1",346, 0) | |
| 4060 | N YSCLANS ,YSCLDAT | |
| 4061 | "RTN","PSO CLO1",347, 0) | |
| 4062 | S YSCLANS =1 | |
| 4063 | "RTN","PSO CLO1",348, 0) | |
| 4064 | I $D(^XTM P("PSJ CLO Z","B",YSC LREG,YSCLD FN)) D | |
| 4065 | "RTN","PSO CLO1",349, 0) | |
| 4066 | .S YSCLDA T=$G(^XTMP ("PSJ CLOZ ","B",YSCL REG,YSCLDF N)) | |
| 4067 | "RTN","PSO CLO1",350, 0) | |
| 4068 | .I YSCLDA T<DT D | |
| 4069 | "RTN","PSO CLO1",351, 0) | |
| 4070 | ..S YSCLA NS=0 | |
| 4071 | "RTN","PSO CLO1",352, 0) | |
| 4072 | ..S:YSCLD AT>0 $P(^X TMP("PSJ C LOZ",YSCLD FN),U,3)=" D" | |
| 4073 | "RTN","PSO CLO1",353, 0) | |
| 4074 | Q YSCLANS | |
| 4075 | "RTN","PSO CLO1",354, 0) | |
| 4076 | ; | |
| 4077 | "RTN","PSO CLO1",355, 0) | |
| 4078 | ; ** NCC REMEDIATIO N add new reasons 8- 11 ** 457/ RTW 11 ;; EMERGENCY OVERRIDE N O ANC LAST 7 DAYS | |
| 4079 | "RTN","PSO CLO1",356, 0) | |
| 4080 | ; | |
| 4081 | "RTN","PSO CLO1",357, 0) | |
| 4082 | 1 ;;NO WBC IN LAST 7 DAYS | |
| 4083 | "RTN","PSO CLO1",358, 0) | |
| 4084 | 2 ;;NO VER IFIED WBC | |
| 4085 | "RTN","PSO CLO1",359, 0) | |
| 4086 | 3 ;;LAST W BC RESULT < 3500 | |
| 4087 | "RTN","PSO CLO1",360, 0) | |
| 4088 | 4 ;;3 SEQ. WBC DECRE ASE | |
| 4089 | "RTN","PSO CLO1",361, 0) | |
| 4090 | 5 ;;LAST A NC RESULT < 2000 | |
| 4091 | "RTN","PSO CLO1",362, 0) | |
| 4092 | 6 ;;3 SEQ. ANC DECRE ASE | |
| 4093 | "RTN","PSO CLO1",363, 0) | |
| 4094 | 7 ;;NCCC A UTHORIZED | |
| 4095 | "RTN","PSO CLO1",364, 0) | |
| 4096 | 8 ;;REGIST ER NON-DUT Y HR/WEEKE ND (MAX 4D AY) | |
| 4097 | "RTN","PSO CLO1",365, 0) | |
| 4098 | 9 ;;PRESCR IBER APPRO VED 4 DAY SUPPLY | |
| 4099 | "RTN","PSO CLO1",366, 0) | |
| 4100 | 10 ;;MILD NEUTROPENI A PRESCRIB ER APPROVE D | |
| 4101 | "RTN","PSO CLUTL") | |
| 4102 | 0^4^B87923 065 | |
| 4103 | "RTN","PSO CLUTL",1,0 ) | |
| 4104 | PSOCLUTL ; BHAM ISC/D MA - utili ties for c lozapine r eporting s ystem ;Jul 24, 2017@ 15:24 | |
| 4105 | "RTN","PSO CLUTL",2,0 ) | |
| 4106 | ;;7.0;OUT PATIENT PH ARMACY;**2 8,56,122,2 22,268,457 **;DEC 199 7;Build 65 | |
| 4107 | "RTN","PSO CLUTL",3,0 ) | |
| 4108 | ;External reference ^YSCL(603 .01 suppor ted by DBI A 2697 | |
| 4109 | "RTN","PSO CLUTL",4,0 ) | |
| 4110 | ;External reference ^PS(55 su pported by DBIA 2228 | |
| 4111 | "RTN","PSO CLUTL",5,0 ) | |
| 4112 | ; | |
| 4113 | "RTN","PSO CLUTL",6,0 ) | |
| 4114 | REG ; regi ster patie nt | |
| 4115 | "RTN","PSO CLUTL",7,0 ) | |
| 4116 | S DIC=55, DLAYGO=55, DIC(0)="AE QL",DIC("A ")="Select patient t o register : " D ^DIC K DIC G E ND:Y<0 S P SO1=+Y,PSO NAME=$$GET 1^DIQ(2,PS O1,.01) K DLAYGO | |
| 4117 | "RTN","PSO CLUTL",8,0 ) | |
| 4118 | D:$$GET1^ DIQ(55,PSO 1,52.1,"I" )'=2 EN^PS OHLUP(PSO1 ) N ANQX | |
| 4119 | "RTN","PSO CLUTL",9,0 ) | |
| 4120 | I '$$FIND 1^DIC(603. 01,,"Q",PS O1,"C") W !!,PSONAME _" has not been auth orized for Clozapine ",!,"by th e NCCC in Dallas. C ontact the NCCC in D allas for authorizat ion." D OV ER G:'$G(% ) REG S JA DOVER="" | |
| 4121 | "RTN","PSO CLUTL",10, 0) | |
| 4122 | S PSO4=$$ GET1^DIQ(5 5,PSO1,53) I PSO4]"" W !!,PSON AME_" is a lready reg istered wi th number "_PSO4,!!, "Use the e dit option to change registrat ion data, or",!,"con tact your supervisor ",! G REG | |
| 4123 | "RTN","PSO CLUTL",11, 0) | |
| 4124 | NUMBER S D IR(0)="55, 53" D ^DIR S PSO2=Y K DIR I $D (DIRUT) W !,"Not reg istered",! D END G R EG | |
| 4125 | "RTN","PSO CLUTL",12, 0) | |
| 4126 | N PSOEX S PSOEX=$$F IND1^DIC(5 5,,"X",PSO 2,"ASAND1" ) | |
| 4127 | "RTN","PSO CLUTL",13, 0) | |
| 4128 | I PSOEX,P SOEX'=PSO1 W !,PSO2, " is alrea dy assigne d to ",$$G ET1^DIQ(2, PSOEX,.01) W !,"Plea se contact your supe rvisor" D END G REG | |
| 4129 | "RTN","PSO CLUTL",14, 0) | |
| 4130 | NUMBER1 S PSO3="A" | |
| 4131 | "RTN","PSO CLUTL",15, 0) | |
| 4132 | PHY S DIC= "^VA(200," ,DIC(0)="A EQMZ",DIC( "A")="Prov ider respo nsible: ", DIC("S")=" I $$GET1^D IQ(200,+Y, 53.1)]"""" " D ^DIC K DIC I Y<0 W !!,"Not registere d",!! K X G END1 | |
| 4133 | "RTN","PSO CLUTL",16, 0) | |
| 4134 | I $G(PSCL OZ) D PROV CHK(+Y) G: $G(ANQX) P HY | |
| 4135 | "RTN","PSO CLUTL",17, 0) | |
| 4136 | S PSO4=+Y K DIR,DIR UT,DUOUT,D TOUT | |
| 4137 | "RTN","PSO CLUTL",18, 0) | |
| 4138 | ;/RBN Beg in NCC cha nges Ask i f okay to register t he unregis tered pati ent - PSO* 7.0*457 | |
| 4139 | "RTN","PSO CLUTL",19, 0) | |
| 4140 | N DFN,VAD M S DFN=PS O1 D DEM^V ADPT | |
| 4141 | "RTN","PSO CLUTL",20, 0) | |
| 4142 | S SSN=$P( VADM(2),"^ ") | |
| 4143 | "RTN","PSO CLUTL",21, 0) | |
| 4144 | S LSTFOUR =$E(SSN,6, 9) | |
| 4145 | "RTN","PSO CLUTL",22, 0) | |
| 4146 | I '$G(PSC LOZ) D | |
| 4147 | "RTN","PSO CLUTL",23, 0) | |
| 4148 | . S DIR(" A",1)="Wou ld you lik e to overr ide the re gistration requireme nt and ass ign a temp orary" | |
| 4149 | "RTN","PSO CLUTL",24, 0) | |
| 4150 | . S DIR(" A",2)="loc al authori zation num ber for " _PSONAME_" ("_$G(LST FOUR)_")"_ " with num ber "_PSO2 ,DIR("A")= "as a"_$S( 'PSO3:" ne w",1:"n on going")_" patient in this prog ram " | |
| 4151 | "RTN","PSO CLUTL",25, 0) | |
| 4152 | I $G(PSCL OZ) D | |
| 4153 | "RTN","PSO CLUTL",26, 0) | |
| 4154 | . S DIR(" A",2)="Wou ld you lik e to overr ide the re gistration requireme nt and ass ign a temp orary" | |
| 4155 | "RTN","PSO CLUTL",27, 0) | |
| 4156 | . S DIR(" A")="local authoriza tion numbe r for "_P SONAME_" ( "_$G(LSTFO UR)_")"_" with numbe r "_PSO2 | |
| 4157 | "RTN","PSO CLUTL",28, 0) | |
| 4158 | S DIR(0)= "Y",DIR("B ")="NO" D ^DIR K DIR I Y=0!($D (DUOUT)) S ANQX=1 D END G END1 | |
| 4159 | "RTN","PSO CLUTL",29, 0) | |
| 4160 | ;/RBN End NCC chang es to remo ve Pretrea tment choi ce - PSO*7 .0*457 | |
| 4161 | "RTN","PSO CLUTL",30, 0) | |
| 4162 | SAVE S DA= PSO1,DIE=5 5,DR="53// //"_PSO2_" ;54////"_P SO3_";57// //"_PSO4_" ;56////0;5 8////"_DT | |
| 4163 | "RTN","PSO CLUTL",31, 0) | |
| 4164 | L +^PS(55 ,DA):$S(+$ G(^DD("DIL OCKTM"))>0 :+^DD("DIL OCKTM"),1: 3) I '$T W !!,$C(7), "Patient " _PSONAME_" is being edited by another us er! Try L ater." S A NQX=1 G EN D1 | |
| 4165 | "RTN","PSO CLUTL",32, 0) | |
| 4166 | D ^DIE L -^PS(55,DA ) | |
| 4167 | "RTN","PSO CLUTL",33, 0) | |
| 4168 | END K %,%Y ,C,D,D0,DA ,DI,DQ,DIC ,DIE,DR,PS O,PSO1,PSO 2,PSO3,PSO 4,PSOC,PSO LN,PSONAME ,PSONO,PSO T,R,SSNVAE RR,XMDUZ,X MSUB,XMTEX T,Y | |
| 4169 | "RTN","PSO CLUTL",34, 0) | |
| 4170 | I '$G(PSC LOZ) K ^TM P($J),^TMP ("PSO",$J) | |
| 4171 | "RTN","PSO CLUTL",35, 0) | |
| 4172 | Q | |
| 4173 | "RTN","PSO CLUTL",36, 0) | |
| 4174 | END1 ; | |
| 4175 | "RTN","PSO CLUTL",37, 0) | |
| 4176 | I $G(ANQX ) W !!,"Pa tient Not Registered " | |
| 4177 | "RTN","PSO CLUTL",38, 0) | |
| 4178 | Q | |
| 4179 | "RTN","PSO CLUTL",39, 0) | |
| 4180 | ; | |
| 4181 | "RTN","PSO CLUTL",40, 0) | |
| 4182 | FACILITY ; Enter faci lity DEA n umber to s et up cloz apine syst em | |
| 4183 | "RTN","PSO CLUTL",41, 0) | |
| 4184 | ;this ent ry point i s no longe r used. t his functi onality wa s taken ov er | |
| 4185 | "RTN","PSO CLUTL",42, 0) | |
| 4186 | ;by the m ental heal th package with the release of YS*5.01*1 8 | |
| 4187 | "RTN","PSO CLUTL",43, 0) | |
| 4188 | ;W ! S DI C=59,DIC(0 )="AEQM",D IC("A")="S elect site to partic ipate in c lozapine p rogram : " D ^DIC G END:Y<0 | |
| 4189 | "RTN","PSO CLUTL",44, 0) | |
| 4190 | ;S DIE=DI C,DA=+Y,DR ="1R;2R;" L +^PS(59, DA) D ^DIE L -^PS(59 ,DA) G FAC ILITY | |
| 4191 | "RTN","PSO CLUTL",45, 0) | |
| 4192 | Q | |
| 4193 | "RTN","PSO CLUTL",46, 0) | |
| 4194 | ; | |
| 4195 | "RTN","PSO CLUTL",47, 0) | |
| 4196 | ; | |
| 4197 | "RTN","PSO CLUTL",48, 0) | |
| 4198 | AGAIN ; re -enter pat ient - new number, s tatus and provider | |
| 4199 | "RTN","PSO CLUTL",49, 0) | |
| 4200 | S DIC=55, DIC(0)="AE QM",DIC("A ")="Select clozapine patient : " D ^DIC K DIC G EN D:Y<0 S (D A,PSO1)=+Y ,PSONAME=$ $GET1^DIQ( 2,DA,.01) | |
| 4201 | "RTN","PSO CLUTL",50, 0) | |
| 4202 | I $$GET1^ DIQ(55,DA, 53)="" W ! ,PSONAME_" is not re gistered. Use the r egister op tion." G A GAIN | |
| 4203 | "RTN","PSO CLUTL",51, 0) | |
| 4204 | I '$$FIND 1^DIC(603. 01,,"Q",PS O1,"C") W !!,PSONAME _" has not been auth orized for Clozapine ",!,"by th e NCCC in Dallas. C ontact the NCCC in D allas for authorizat ion." D OV ER G:'$G(% ) AGAIN S JADOVER="" | |
| 4205 | "RTN","PSO CLUTL",52, 0) | |
| 4206 | S DIR(0)= "55,53" D ^DIR G END :$D(DIRUT) S PSO2=Y | |
| 4207 | "RTN","PSO CLUTL",53, 0) | |
| 4208 | N PSOEX S PSOEX=$$F IND1^DIC(5 5,,"X",PSO 2,"ASAND1" ) | |
| 4209 | "RTN","PSO CLUTL",54, 0) | |
| 4210 | I PSOEX,P SOEX'=PSO1 W !,PSO2, " already assigned t o ",$$GET1 ^DIQ(2,PSO EX,.01) G END | |
| 4211 | "RTN","PSO CLUTL",55, 0) | |
| 4212 | I '$D(JAD OVER),'$$F IND1^DIC(6 03.01,,"X" ,PSO2) W ! !,"The NCC C in Dalla s has not authorized "_PSO2_" for usage" ,!,"at thi s facility . Contact the NCCC in Dallas for author ization." D OVER G:' $G(%) END | |
| 4213 | "RTN","PSO CLUTL",56, 0) | |
| 4214 | W !,"CLOZ APINE STAT US: "_$$GE T1^DIQ(55, PSO1,54) ;$S(PSO3=" A":"ACTIVE TREATMENT ",PSO3="D" :"DISCONTI NUED",PSO3 ="H":"TREA TMENT ON H OLD",1:"PR E-TREATMEN T") | |
| 4215 | "RTN","PSO CLUTL",57, 0) | |
| 4216 | S PSO3=$$ GET1^DIQ(5 5,PSO1,54, "I") | |
| 4217 | "RTN","PSO CLUTL",58, 0) | |
| 4218 | PHY1 ; | |
| 4219 | "RTN","PSO CLUTL",59, 0) | |
| 4220 | S DIR(0)= "55,57" D ^DIR G END :$D(DIRUT) I Y S PSO 4=+Y | |
| 4221 | "RTN","PSO CLUTL",60, 0) | |
| 4222 | I $$GET1^ DIQ(200,PS O4,53.2)=" " W !!,"On ly provide rs with DE A numbers entered in the New P erson",!," file can r egister pa tients in this progr am.",!! G PHY1 | |
| 4223 | "RTN","PSO CLUTL",61, 0) | |
| 4224 | G SAVE | |
| 4225 | "RTN","PSO CLUTL",62, 0) | |
| 4226 | ; | |
| 4227 | "RTN","PSO CLUTL",63, 0) | |
| 4228 | OVER ;allo w registra tion of pa tients and clozapine numbers n ot yet aut horized by the NCCC. | |
| 4229 | "RTN","PSO CLUTL",64, 0) | |
| 4230 | K DIR,% W ! S DIR(" A")="Do yo u want to over-ride this warni ng",DIR(0) ="Y",DIR(" B")="No" D ^DIR | |
| 4231 | "RTN","PSO CLUTL",65, 0) | |
| 4232 | I Y S %=1 | |
| 4233 | "RTN","PSO CLUTL",66, 0) | |
| 4234 | K DIR,DIR UT,DUOUT Q | |
| 4235 | "RTN","PSO CLUTL",67, 0) | |
| 4236 | ; | |
| 4237 | "RTN","PSO CLUTL",68, 0) | |
| 4238 | CLOZPAT ;V ERIFY PATI ENT IS A C LOZAPINE P ATIENT | |
| 4239 | "RTN","PSO CLUTL",69, 0) | |
| 4240 | K CLOZPAT ,CLOZST S CLOZST=$$G ET1^DIQ(55 ,DFN,54,"I ") | |
| 4241 | "RTN","PSO CLUTL",70, 0) | |
| 4242 | I $L(CLOZ ST),CLOZST '="D" D | |
| 4243 | "RTN","PSO CLUTL",71, 0) | |
| 4244 | .N CLOZNU M,CLOZUID S CLOZNUM= $$GET1^DIQ (55,DFN,53 ) | |
| 4245 | "RTN","PSO CLUTL",72, 0) | |
| 4246 | .I CLOZNU M?1U6N S C LOZPAT=3 Q | |
| 4247 | "RTN","PSO CLUTL",73, 0) | |
| 4248 | .S CLOZUI D=$$FIND1^ DIC(603.01 ,,"X",CLOZ NUM) Q:'CL OZUID ;Q: '$D(^YSCL( 603.01,CLO ZUID,0)) | |
| 4249 | "RTN","PSO CLUTL",74, 0) | |
| 4250 | .S CLOZPA T=$$GET1^D IQ(603.01, CLOZUID,2, "I") | |
| 4251 | "RTN","PSO CLUTL",75, 0) | |
| 4252 | .S CLOZPA T=$S($G(CL OZPAT)="M" :2,$G(CLOZ PAT)="B":1 ,$G(CLOZPA T)="W":0,1 :90) | |
| 4253 | "RTN","PSO CLUTL",76, 0) | |
| 4254 | Q | |
| 4255 | "RTN","PSO CLUTL",77, 0) | |
| 4256 | ; | |
| 4257 | "RTN","PSO CLUTL",78, 0) | |
| 4258 | PROVCHK(PR OV) ; | |
| 4259 | "RTN","PSO CLUTL",79, 0) | |
| 4260 | N PSJQUIT S (ANQX,P SJQUIT)=0 I '$G(PROV ) Q | |
| 4261 | "RTN","PSO CLUTL",80, 0) | |
| 4262 | I '$L($$D EA^XUSER(, PROV)) S ( ANQX,PSJQU IT)=1 D Q | |
| 4263 | "RTN","PSO CLUTL",81, 0) | |
| 4264 | .W !," ", !,"*** Pro vider must have a DE A# or VA# to write p rescriptio ns for thi s drug." | |
| 4265 | "RTN","PSO CLUTL",82, 0) | |
| 4266 | I '$$FIND 1^DIC(200. 051,","_PR OV_",","X" ,"YSCL AUT HORIZED") S (ANQX,PS JQUIT)=1 D | |
| 4267 | "RTN","PSO CLUTL",83, 0) | |
| 4268 | .W !," ", !,"*** Pro vider must hold YSCL AUTHORIZE D key to w rite presc riptions f or clozapi ne." | |
| 4269 | "RTN","PSO CLUTL",84, 0) | |
| 4270 | Q | |
| 4271 | "RTN","PSO CLUTL",85, 0) | |
| 4272 | ; | |
| 4273 | "RTN","PSO CLUTL",86, 0) | |
| 4274 | MSG1 ; | |
| 4275 | "RTN","PSO CLUTL",87, 0) | |
| 4276 | W !!,"Per mission to dispense clozapine has been d enied. The results o f the late st",! | |
| 4277 | "RTN","PSO CLUTL",88, 0) | |
| 4278 | W "Lab Te st drawn i n the past 7 days sh ow ANC res ults but N o Matching WBC.",! | |
| 4279 | "RTN","PSO CLUTL",89, 0) | |
| 4280 | W "If you wish to d ispense ou tside the FDA and VA protocol ANC limits ,",! | |
| 4281 | "RTN","PSO CLUTL",90, 0) | |
| 4282 | W "docume nt your re quest to R equest for Override of Pharmac y Lockout ",! | |
| 4283 | "RTN","PSO CLUTL",91, 0) | |
| 4284 | W "(from VHA Handbo ok 1160.02 ) Director of the",! | |
| 4285 | "RTN","PSO CLUTL",92, 0) | |
| 4286 | W "VA Nat ional Cloz apine Coor dinating C enter",! | |
| 4287 | "RTN","PSO CLUTL",93, 0) | |
| 4288 | W "(Phone : 214-857- 0068 Fax: 214-857-03 39) for a one-time o verride pe rmission." ,! | |
| 4289 | "RTN","PSO CLUTL",94, 0) | |
| 4290 | W !,"No o rder enter ed!" | |
| 4291 | "RTN","PSO CLUTL",95, 0) | |
| 4292 | S ANQX=1 | |
| 4293 | "RTN","PSO CLUTL",96, 0) | |
| 4294 | Q | |
| 4295 | "RTN","PSO CLUTL",97, 0) | |
| 4296 | MSG2 ; | |
| 4297 | "RTN","PSO CLUTL",98, 0) | |
| 4298 | W !!,"Per mission to dispense clozapine has been d enied. The results o f the late st",! | |
| 4299 | "RTN","PSO CLUTL",99, 0) | |
| 4300 | W "Lab Te st drawn i n the past 7 days sh ow No ANC results. I f you wish to dispen se",! | |
| 4301 | "RTN","PSO CLUTL",100 ,0) | |
| 4302 | W "outsid e the FDA and VA pro tocol ANC limits, do cument you r request to Request ",! | |
| 4303 | "RTN","PSO CLUTL",101 ,0) | |
| 4304 | W "for Ov erride of Pharmacy L ockout (fr om VHA Han dbook 1160 .02) Direc tor of the ",! | |
| 4305 | "RTN","PSO CLUTL",102 ,0) | |
| 4306 | W "VA Nat ional Cloz apine Coor dinating C enter",! | |
| 4307 | "RTN","PSO CLUTL",103 ,0) | |
| 4308 | W "(Phone : 214-857- 0068 Fax: 214-857-03 39) for a one-time o verride pe rmission." ,! | |
| 4309 | "RTN","PSO CLUTL",104 ,0) | |
| 4310 | W !,"No o rder enter ed!" | |
| 4311 | "RTN","PSO CLUTL",105 ,0) | |
| 4312 | S ANQX=1 | |
| 4313 | "RTN","PSO CLUTL",106 ,0) | |
| 4314 | Q | |
| 4315 | "RTN","PSO CLUTL",107 ,0) | |
| 4316 | MSG3 ; | |
| 4317 | "RTN","PSO CLUTL",108 ,0) | |
| 4318 | W !,"A CB C/Differen tial inclu ding ANC M ust Be Ord ered and M onitored o n a",! | |
| 4319 | "RTN","PSO CLUTL",109 ,0) | |
| 4320 | W "Daily basis unti l the ANC above 1000 /mm3 with no signs o f infectio n.",! | |
| 4321 | "RTN","PSO CLUTL",110 ,0) | |
| 4322 | W "If ANC is betwee n 1000-149 9, therapy can be co ntinued bu t physicia n must ord er",! | |
| 4323 | "RTN","PSO CLUTL",111 ,0) | |
| 4324 | W "lab te st three t imes weekl y." | |
| 4325 | "RTN","PSO CLUTL",112 ,0) | |
| 4326 | Q | |
| 4327 | "RTN","PSO CLUTL",113 ,0) | |
| 4328 | MSG4 ; | |
| 4329 | "RTN","PSO CLUTL",114 ,0) | |
| 4330 | W !,"Perm ission to dispense c lozapine h as been de nied. If t he results of the la test" | |
| 4331 | "RTN","PSO CLUTL",115 ,0) | |
| 4332 | W !,"Lab Test drawn in the pa st 7 days show ANC b elow 1000/ mm3 and yo u wish to" | |
| 4333 | "RTN","PSO CLUTL",116 ,0) | |
| 4334 | W !,"disp ense outsi de the FDA and VA pr otocol ANC limits, d ocument yo ur request to" | |
| 4335 | "RTN","PSO CLUTL",117 ,0) | |
| 4336 | W !,"Requ est for Ov erride of Pharmacy L ockout (fr om VHA Han dbook 1160 .02)" | |
| 4337 | "RTN","PSO CLUTL",118 ,0) | |
| 4338 | W !,"Dire ctor of th e VA Natio nal Clozap ine Coordi nating Cen ter" | |
| 4339 | "RTN","PSO CLUTL",119 ,0) | |
| 4340 | W !,"(Pho ne: 214-85 7-0068 Fax : 214-857- 0339) for a one-time override permission .",! | |
| 4341 | "RTN","PSO CLUTL",120 ,0) | |
| 4342 | S ANQX=1 | |
| 4343 | "RTN","PSO CLUTL",121 ,0) | |
| 4344 | Q | |
| 4345 | "RTN","PSO CLUTL",122 ,0) | |
| 4346 | MSG5 ; | |
| 4347 | "RTN","PSO CLUTL",123 ,0) | |
| 4348 | W !!,"Per mission to dispense clozapine has been d enied. Ple ase contac t the" | |
| 4349 | "RTN","PSO CLUTL",124 ,0) | |
| 4350 | W !,"Dire ctor of th e VA Natio nal Clozap ine Coordi nating Cen ter" | |
| 4351 | "RTN","PSO CLUTL",125 ,0) | |
| 4352 | W !!,"Req uest for O verride of Pharmacy Lockout (f rom VHA Ha ndbook 116 0.02)" | |
| 4353 | "RTN","PSO CLUTL",126 ,0) | |
| 4354 | W !,"(Pho ne: 214-85 7-0068 Fax : 214-857- 0339).",! | |
| 4355 | "RTN","PSO CLUTL",127 ,0) | |
| 4356 | Q | |
| 4357 | "RTN","PSO CLUTL",128 ,0) | |
| 4358 | MSG6 ; ; * * START NC C REMEDIAT ION ** 457 AND PSJ 3 27/RTW MSG 6 added f or new cri tically lo w ANC leve ls clozapi ne overrid e requirem ents | |
| 4359 | "RTN","PSO CLUTL",129 ,0) | |
| 4360 | W !!,"Thi s clozapin e drug may not be di spensed to the patie nt at this time base d on the a vailable l ab tests r elated to the clozap ine treatm ent progra m." | |
| 4361 | "RTN","PSO CLUTL",130 ,0) | |
| 4362 | W !!,"Ple ase contac t the NCCC to reques t an overr ide in ord er to proc eed with d ispensing this drug. " | |
| 4363 | "RTN","PSO CLUTL",131 ,0) | |
| 4364 | W !!,"Req uest for O verride of Pharmacy Lockout (f rom VHA Ha ndbook 116 0.02)" | |
| 4365 | "RTN","PSO CLUTL",132 ,0) | |
| 4366 | W !!,"The matching ANC count s which ca used the l ockout are of lab te st results performed on " | |
| 4367 | "RTN","PSO CLUTL",133 ,0) | |
| 4368 | S ANQX=1, Y=$P(PSOYS ,"^",6) X ^DD("DD") W $P(Y,"@" ) | |
| 4369 | "RTN","PSO CLUTL",134 ,0) | |
| 4370 | W !!,?5," ANC: "_$P( PSOYS,"^", 4),! | |
| 4371 | "RTN","PSO CLUTL",135 ,0) | |
| 4372 | Q | |
| 4373 | "RTN","PSO CLUTL",136 ,0) | |
| 4374 | MSG9 ; | |
| 4375 | "RTN","PSO CLUTL",137 ,0) | |
| 4376 | W !,"*** Permission to dispen se clozapi ne has bee n denied b ased on th e availabl e" | |
| 4377 | "RTN","PSO CLUTL",138 ,0) | |
| 4378 | W !," lab tests related to the cloza pine treat ment progr am. ***" | |
| 4379 | "RTN","PSO CLUTL",139 ,0) | |
| 4380 | W !!,"For a Nationa l Override to dispen se at the patient's normal fre quency," | |
| 4381 | "RTN","PSO CLUTL",140 ,0) | |
| 4382 | W !,"plea se contact the VA Na tional Clo zapine Coo rdinating Center to contact" | |
| 4383 | "RTN","PSO CLUTL",141 ,0) | |
| 4384 | W !,"the VA Nationa l Clozapin e Coordina ting Cente r request an Overrid e of" | |
| 4385 | "RTN","PSO CLUTL",142 ,0) | |
| 4386 | W !,"Phar macy Locko ut (from V HA Handboo k 1160.02) " | |
| 4387 | "RTN","PSO CLUTL",143 ,0) | |
| 4388 | W !,"(Pho ne: 214-85 7-0068 Fax : 214-857- 0339)." | |
| 4389 | "RTN","PSO CLUTL",144 ,0) | |
| 4390 | W !,"A Sp ecial Cond itions Loc al Overrid e can be a pproved fo r" | |
| 4391 | "RTN","PSO CLUTL",145 ,0) | |
| 4392 | W !,"(1) weather-re lated cond itions, (2 ) mail ord er delays of clozapi ne, or" | |
| 4393 | "RTN","PSO CLUTL",146 ,0) | |
| 4394 | W !,"(3) inpatient going on l eave. With Provider' s document ation of a pproval," | |
| 4395 | "RTN","PSO CLUTL",147 ,0) | |
| 4396 | W !,"you may dispen se a one-t ime supply not to ex ceed 4 day s.",! | |
| 4397 | "RTN","PSO CLUTL",148 ,0) | |
| 4398 | Q | |
| 4399 | "RTN","PSO CLUTL",149 ,0) | |
| 4400 | ; | |
| 4401 | "RTN","PSO CLUTL",150 ,0) | |
| 4402 | ;/RBN Beg in of modi fications for new me ssage for IP 4 day o verrride. | |
| 4403 | "RTN","PSO CLUTL",151 ,0) | |
| 4404 | MSG10 ; | |
| 4405 | "RTN","PSO CLUTL",152 ,0) | |
| 4406 | W !,"*** Permission to dispen se clozapi ne has bee n denied b ased on th e availabl e" | |
| 4407 | "RTN","PSO CLUTL",153 ,0) | |
| 4408 | W !," lab tests related to the cloza pine treat ment progr am. ***" | |
| 4409 | "RTN","PSO CLUTL",154 ,0) | |
| 4410 | W !!,"For a Nationa l Override to dispen se at the patient's normal fre quency," | |
| 4411 | "RTN","PSO CLUTL",155 ,0) | |
| 4412 | W !,"plea se contact the VA Na tional Clo zapine Coo rdinating Center to request an " | |
| 4413 | "RTN","PSO CLUTL",156 ,0) | |
| 4414 | W !,"Over ride of Ph armacy Loc kout (from VHA Handb ook 1160.0 2) (Phone: 214-857-0 068" | |
| 4415 | "RTN","PSO CLUTL",157 ,0) | |
| 4416 | W !,"Fax: 214-857-0 339)." | |
| 4417 | "RTN","PSO CLUTL",158 ,0) | |
| 4418 | W !,"A Sp ecial Cond itions Loc al Overrid e for Inpa tients can be approv ed for an" | |
| 4419 | "RTN","PSO CLUTL",159 ,0) | |
| 4420 | W !,"IP O verride Or der with O utside Lab Results. With Provi der's docu mentation of" | |
| 4421 | "RTN","PSO CLUTL",160 ,0) | |
| 4422 | W !,"appr oval, you may dispen se a one-t ime IP sup ply not to exceed 4 days." | |
| 4423 | "RTN","PSO CLUTL",161 ,0) | |
| 4424 | W !,"The ANC from a nother fac ility must be record ed in the Progress n ote/commen ts" | |
| 4425 | "RTN","PSO CLUTL",162 ,0) | |
| 4426 | W !,"in p harmacy" | |
| 4427 | "RTN","PSO CLUTL",163 ,0) | |
| 4428 | Q | |
| 4429 | "RTN","PSO DIR1") | |
| 4430 | 0^9^B10037 4900 | |
| 4431 | "RTN","PSO DIR1",1,0) | |
| 4432 | PSODIR1 ;I HS/DSD - A SKS DATA F OR RX ORDE R ENTRY CO NT. ;Jul 2 4, 2017@15 :24 | |
| 4433 | "RTN","PSO DIR1",2,0) | |
| 4434 | ;;7.0;OUT PATIENT PH ARMACY;**2 3,46,78,10 2,121,131, 146,166,18 4,222,268, 206,266,34 0,391,444, 457**;DEC 1997;Build 65 | |
| 4435 | "RTN","PSO DIR1",3,0) | |
| 4436 | ;External reference ^PS(55 su pported by DBIA 2228 | |
| 4437 | "RTN","PSO DIR1",4,0) | |
| 4438 | ;External reference ^PSDRUG( supported by DBIA 22 1 | |
| 4439 | "RTN","PSO DIR1",5,0) | |
| 4440 | ;External reference $$MXDAYSU P^PSSUTIL1 supported by DBIA 6 229 | |
| 4441 | "RTN","PSO DIR1",6,0) | |
| 4442 | ; | |
| 4443 | "RTN","PSO DIR1",7,0) | |
| 4444 | PTSTAT(PSO DIR) ; | |
| 4445 | "RTN","PSO DIR1",8,0) | |
| 4446 | PTSTATEN K DIC,DR,DI E S PSODIR ("FIELD")= 0 | |
| 4447 | "RTN","PSO DIR1",9,0) | |
| 4448 | I $G(PSOT PBFG),$G(P SOFROM)="N EW" K PSOR X("PATIENT STATUS"), PSODIR("PA TIENT STAT US") N PSO FNDRX,PSOF NDFL,PSOFN DPS D | |
| 4449 | "RTN","PSO DIR1",10,0 ) | |
| 4450 | .S PSOFND FL=0 F PSO FNDPS=0:0 S PSOFNDPS =$O(^PS(53 ,PSOFNDPS) ) Q:'PSOFN DPS!(PSOFN DFL) D | |
| 4451 | "RTN","PSO DIR1",11,0 ) | |
| 4452 | ..S PSOFN DRX=$P($G( ^PS(53,PSO FNDPS,0)), "^") S PSO FNDRX=$$UP ^XLFSTR(PS OFNDRX) I PSOFNDRX=" NON-VA" S PSOFNDFL=1 S (PSORX( "PATIENT S TATUS"),DI C("B"))=$P ($G(^PS(53 ,PSOFNDPS, 0)),"^") | |
| 4453 | "RTN","PSO DIR1",12,0 ) | |
| 4454 | I $G(PSOT PBFG),$G(P SOFROM)="N EW",$G(PSO RX("PATIEN T STATUS") )="" W !," Could not find a 'NO N-VA' Pati ent Status in the RX PATIENT S TATUS file (#53)!" D PSTPB D S PSODIR(" DFLG")=1 G PTSTATX | |
| 4455 | "RTN","PSO DIR1",13,0 ) | |
| 4456 | .K DIR S DIR(0)="E" ,DIR("A")= "Press Ret urn to con tinue" D ^ DIR K DIR | |
| 4457 | "RTN","PSO DIR1",14,0 ) | |
| 4458 | I $G(PSOT PBFG),$G(P SOFROM)="N EW" G TPBB | |
| 4459 | "RTN","PSO DIR1",15,0 ) | |
| 4460 | N PSOX | |
| 4461 | "RTN","PSO DIR1",16,0 ) | |
| 4462 | S PSOX=$G (^PS(55,PS ODFN,"PS") ) I PSOX]" " S PSORX( "PATIENT S TATUS")=$P ($G(^PS(53 ,PSOX,0)), "^"),DIC(" B")=PSORX( "PATIENT S TATUS") | |
| 4463 | "RTN","PSO DIR1",17,0 ) | |
| 4464 | S:$G(PSOD IR("PATIEN T STATUS") )]"" DIC(" B")=PSODIR ("PATIENT STATUS") | |
| 4465 | "RTN","PSO DIR1",18,0 ) | |
| 4466 | TPBB ; | |
| 4467 | "RTN","PSO DIR1",19,0 ) | |
| 4468 | D ELIG^VA DPT W !,"E ligibility : "_$P(VAE L(1),"^",2 )_$S(+VAEL (3):" SC%: "_$P( VAEL(3),"^ ",2),1:"") | |
| 4469 | "RTN","PSO DIR1",20,0 ) | |
| 4470 | S N=0 F S N=$O(VAE L(1,N)) Q: 'N W !,?1 0,$P(VAEL( 1,N),"^",2 ) | |
| 4471 | "RTN","PSO DIR1",21,0 ) | |
| 4472 | S DIC("A" )="RX PATI ENT STATUS : " | |
| 4473 | "RTN","PSO DIR1",22,0 ) | |
| 4474 | S DIC(0)= "QEAMZ",DI C=53 D ^DI C K DIC | |
| 4475 | "RTN","PSO DIR1",23,0 ) | |
| 4476 | I $G(PSOT PBFG),$G(P SOFROM)="N EW" N PSOP SDIR,PSOFN DZZ,PSOPSU PA S (PSOP SDIR,PSOPS UPA)=0 D I PSOPSDIR S:PSOPSUP A PSODIR(" DFLG")=1 G :PSOPSUPA PTSTATX W ! D PSTPB G PTSTATEN | |
| 4477 | "RTN","PSO DIR1",24,0 ) | |
| 4478 | .I +Y'>0! ($D(DTOUT) )!($D(DUOU T)) S (PSO PSDIR,PSOP SUPA)=1 Q | |
| 4479 | "RTN","PSO DIR1",25,0 ) | |
| 4480 | .S (PSODI R("PATIENT STATUS"), PSORX("PAT IENT STATU S"))=+Y,PS ODIR("PTST NODE")=Y( 0) | |
| 4481 | "RTN","PSO DIR1",26,0 ) | |
| 4482 | .S PSOFND ZZ=$P($G(^ PS(53,+Y,0 )),"^") S PSOFNDZZ=$ $UP^XLFSTR (PSOFNDZZ) I PSOFNDZ Z'="NON-VA " S PSOPSD IR=1 K PSO DIR("PATIE NT STATUS" ),PSORX("P ATIENT STA TUS"),PSOD IR("PTST N ODE") | |
| 4483 | "RTN","PSO DIR1",27,0 ) | |
| 4484 | I $G(PSOT PBFG),$G(P SOFROM)="N EW" G TPBS C | |
| 4485 | "RTN","PSO DIR1",28,0 ) | |
| 4486 | I X[U,$L( X)>1 D:'$G (PSOEDIT) JUMP G PTS TATX | |
| 4487 | "RTN","PSO DIR1",29,0 ) | |
| 4488 | I $D(DUOU T)!$D(DTOU T) S PSODI R("DFLG")= 1 G PTSTAT X | |
| 4489 | "RTN","PSO DIR1",30,0 ) | |
| 4490 | I Y=-1 W $C(7)," Re quired" G PTSTATEN | |
| 4491 | "RTN","PSO DIR1",31,0 ) | |
| 4492 | N PSOFNDX ,PSOFNDXY, PSOFNDXX,P SOFNDYY | |
| 4493 | "RTN","PSO DIR1",32,0 ) | |
| 4494 | S PSOFNDX Y=$G(Y),PS OFNDYY=$G( Y(0)) | |
| 4495 | "RTN","PSO DIR1",33,0 ) | |
| 4496 | I '$G(PSO TPBFG),$G( PSOFROM)=" NEW" S PSO FNDX=$P($G (^PS(53,+Y ,0)),"^") S PSOFNDXX =$$UP^XLFS TR(PSOFNDX ) I PSOFND XX="NON-VA " K PSOFND X,PSOFNDXY ,PSOFNDYY, PSOFNDXX,Y W !!,"Can not select 'NON-VA' Rx Patient Status!", ! G PTSTAT EN | |
| 4497 | "RTN","PSO DIR1",34,0 ) | |
| 4498 | S Y=$G(PS OFNDXY),Y( 0)=$G(PSOF NDYY) | |
| 4499 | "RTN","PSO DIR1",35,0 ) | |
| 4500 | K PSOFNDX Y,PSOFNDYY ,PSOFNDX,P SOFNDXX | |
| 4501 | "RTN","PSO DIR1",36,0 ) | |
| 4502 | S (PSODIR ("PATIENT STATUS"),P SORX("PATI ENT STATUS "))=+Y | |
| 4503 | "RTN","PSO DIR1",37,0 ) | |
| 4504 | S PSODIR( "PTST NODE ")=Y(0) | |
| 4505 | "RTN","PSO DIR1",38,0 ) | |
| 4506 | TPBSC ; | |
| 4507 | "RTN","PSO DIR1",39,0 ) | |
| 4508 | I $G(PSOF DR),$P($G( OR0),"^",1 7)="C" G P TSTATX | |
| 4509 | "RTN","PSO DIR1",40,0 ) | |
| 4510 | L +^PS(55 ,PSODFN):$ S(+$G(^DD( "DILOCKTM" ))>0:+^DD( "DILOCKTM" ),1:3) I ' $T G PTSTA TX | |
| 4511 | "RTN","PSO DIR1",41,0 ) | |
| 4512 | S DIE="55 ",DR="3/// /"_+Y,DA=P SODFN D ^D IE K DIE,D A,D0 | |
| 4513 | "RTN","PSO DIR1",42,0 ) | |
| 4514 | L -^PS(55 ,PSODFN) | |
| 4515 | "RTN","PSO DIR1",43,0 ) | |
| 4516 | PTSTATX K DTOUT,DUOU T,X,Y,DA | |
| 4517 | "RTN","PSO DIR1",44,0 ) | |
| 4518 | Q | |
| 4519 | "RTN","PSO DIR1",45,0 ) | |
| 4520 | SIG(PSODIR ) ; | |
| 4521 | "RTN","PSO DIR1",46,0 ) | |
| 4522 | I $G(PSOF DR),$G(PSO DIR("SIG") )']"" D SI GOK G:$G(S IGOK)!($G( PSODIR("DF LG"))) SIG X | |
| 4523 | "RTN","PSO DIR1",47,0 ) | |
| 4524 | K DIR,DIC | |
| 4525 | "RTN","PSO DIR1",48,0 ) | |
| 4526 | S DIR(0)= "52,10" | |
| 4527 | "RTN","PSO DIR1",49,0 ) | |
| 4528 | S:$G(PSOD RUG("SIG") )]"" DIR(" B")=PSODRU G("SIG") | |
| 4529 | "RTN","PSO DIR1",50,0 ) | |
| 4530 | S:$G(PSOD IR("SIG")) ]"" DIR("B ")=PSODIR( "SIG") | |
| 4531 | "RTN","PSO DIR1",51,0 ) | |
| 4532 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") SIGX | |
| 4533 | "RTN","PSO DIR1",52,0 ) | |
| 4534 | S PSODIR( "SIG")=Y,S IGOK=0 K S IG | |
| 4535 | "RTN","PSO DIR1",53,0 ) | |
| 4536 | SIGX K X,Y | |
| 4537 | "RTN","PSO DIR1",54,0 ) | |
| 4538 | Q | |
| 4539 | "RTN","PSO DIR1",55,0 ) | |
| 4540 | QTY(PSODIR ) ; | |
| 4541 | "RTN","PSO DIR1",56,0 ) | |
| 4542 | QTYA K DIR ,DIC | |
| 4543 | "RTN","PSO DIR1",57,0 ) | |
| 4544 | I $G(CLOZ PAT)=1 S D IR("A",1)= "Patient E ligible fo r 14 day s upply or 7 day suppl y with 1 r efill" | |
| 4545 | "RTN","PSO DIR1",58,0 ) | |
| 4546 | I $G(CLOZ PAT)=2 S D IR("A",1)= "Patient E ligible 28 day suppl y or 14 da y supply w ith 1 refi ll or 7 da y supply w ith 3 refi ll" | |
| 4547 | "RTN","PSO DIR1",59,0 ) | |
| 4548 | S DIR(0)= "52,7" S:$ G(PSODRUG( "IEN")) DI R("A")="QT Y ( "_$G(P SODRUG("UN IT"))_" ) "_$S($P($G (^PSDRUG(+ PSODRUG("I EN"),5))," ^")]"":$P( ^PSDRUG(+P SODRUG("IE N"),5),"^" ),1:"") | |
| 4549 | "RTN","PSO DIR1",60,0 ) | |
| 4550 | K QTYHLD I $G(PSODI R("QTY"))] "" S QTYHL D=PSODIR(" QTY") K PS ODIR("QTY" ) | |
| 4551 | "RTN","PSO DIR1",61,0 ) | |
| 4552 | D:'$G(PSO QTY) QTY^P SOSIG(.PSO DIR) | |
| 4553 | "RTN","PSO DIR1",62,0 ) | |
| 4554 | I '$G(SPE ED),$G(QTY HLD),'$G(P SODIR("QTY ")) S PSOD IR("QTY")= QTYHLD | |
| 4555 | "RTN","PSO DIR1",63,0 ) | |
| 4556 | K QTYHLD K:'$G(PSOD IR("QTY")) PSODIR("Q TY") | |
| 4557 | "RTN","PSO DIR1",64,0 ) | |
| 4558 | I $G(SPEE D),$G(PSOD IR("QTY")) ']"" S PSO DIR("QTY") =$P(^PSRX( PSORENW("O IRXN"),0), "^",7) | |
| 4559 | "RTN","PSO DIR1",65,0 ) | |
| 4560 | S:$G(PSOD IR("QTY")) ]"" DIR("B ")=PSODIR( "QTY") | |
| 4561 | "RTN","PSO DIR1",66,0 ) | |
| 4562 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") QTYX | |
| 4563 | "RTN","PSO DIR1",67,0 ) | |
| 4564 | I $G(Y),$ G(PSODRUG( "MAXDOSE") )]"",$G(PS ODIR("DAYS SUPPLY")) ,(Y/+PSODI R("DAYS SU PPLY")>PSO DRUG("MAXD OSE")) D G:$G(PSODI R("DFLG")) QTYX G Q TYA | |
| 4565 | "RTN","PSO DIR1",68,0 ) | |
| 4566 | .W !,$C(7 )," Greate r than Max imum dose of "_PSODR UG("MAXDOS E")_" per day" D DAY SEN | |
| 4567 | "RTN","PSO DIR1",69,0 ) | |
| 4568 | I $G(PSOF DR),$P($G( OR0),"^",2 4),$G(PSOD IR("QTY")) ,+Y>$G(PSO DIR("QTY") ) D G QTY X | |
| 4569 | "RTN","PSO DIR1",70,0 ) | |
| 4570 | .W !!,"Di gitally Si gned Order - QTY can not be inc reased",! | |
| 4571 | "RTN","PSO DIR1",71,0 ) | |
| 4572 | .N DIR S DIR(0)="E" ,DIR("A")= "Press Ret urn to Con tinue" D ^ DIR W ! | |
| 4573 | "RTN","PSO DIR1",72,0 ) | |
| 4574 | S PSODIR( "QTY")=Y | |
| 4575 | "RTN","PSO DIR1",73,0 ) | |
| 4576 | QTYX K X,Y | |
| 4577 | "RTN","PSO DIR1",74,0 ) | |
| 4578 | Q | |
| 4579 | "RTN","PSO DIR1",75,0 ) | |
| 4580 | COPIES(PSO DIR) ; | |
| 4581 | "RTN","PSO DIR1",76,0 ) | |
| 4582 | K DIR,DIC | |
| 4583 | "RTN","PSO DIR1",77,0 ) | |
| 4584 | S DIR(0)= "52,10.6" | |
| 4585 | "RTN","PSO DIR1",78,0 ) | |
| 4586 | S DIR("B" )=$S($G(PS ODIR("COPI ES"))]"":P SODIR("COP IES"),1:1) | |
| 4587 | "RTN","PSO DIR1",79,0 ) | |
| 4588 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") COPIESX | |
| 4589 | "RTN","PSO DIR1",80,0 ) | |
| 4590 | S PSODIR( "COPIES")= Y | |
| 4591 | "RTN","PSO DIR1",81,0 ) | |
| 4592 | COPIESX K X,Y | |
| 4593 | "RTN","PSO DIR1",82,0 ) | |
| 4594 | Q | |
| 4595 | "RTN","PSO DIR1",83,0 ) | |
| 4596 | DAYS(PSODI R) ; | |
| 4597 | "RTN","PSO DIR1",84,0 ) | |
| 4598 | DAYSEN K D IR,DIC N P SORFLS | |
| 4599 | "RTN","PSO DIR1",85,0 ) | |
| 4600 | ;PSO*7*26 6 | |
| 4601 | "RTN","PSO DIR1",86,0 ) | |
| 4602 | N S2DS,MX DAYSUP,DFD AYSUP,PSDA YSUP,CSDRU G,NEWTOTDS ,PSOREGN S S2DS=0 | |
| 4603 | "RTN","PSO DIR1",87,0 ) | |
| 4604 | S MXDAYSU P=90,CSDRU G=0 | |
| 4605 | "RTN","PSO DIR1",88,0 ) | |
| 4606 | I $D(PSOD RUG("IEN") ) D | |
| 4607 | "RTN","PSO DIR1",89,0 ) | |
| 4608 | .S MXDAYS UP=$$MXDAY SUP^PSSUTI L1(PSODRUG ("IEN")) | |
| 4609 | "RTN","PSO DIR1",90,0 ) | |
| 4610 | .S S2DS=$ $CSDS^PSOS IGDS(PSODR UG("IEN")) I S2DS,$P ($G(PSODIR ("PTST NOD E")),"^",3 )>29 S S2D S=30 | |
| 4611 | "RTN","PSO DIR1",91,0 ) | |
| 4612 | .S PSORFL S=$S($G(PS ODIR("# OF REFILLS") ):PSODIR(" # OF REFIL LS"),1:$P( $G(PSODIR( "RX0")),"^ ",9)) | |
| 4613 | "RTN","PSO DIR1",92,0 ) | |
| 4614 | .I '$D(PS ODRUG("DEA ")) S PSOD RUG("DEA") =$$GET1^DI Q(50,PSODR UG("IEN"), 3,"") | |
| 4615 | "RTN","PSO DIR1",93,0 ) | |
| 4616 | .I (PSODR UG("DEA")[ "2")!(PSOD RUG("DEA") ["3")!(PSO DRUG("DEA" )["4")!(PS ODRUG("DEA ")["5") S CSDRUG=1 | |
| 4617 | "RTN","PSO DIR1",94,0 ) | |
| 4618 | S PSOREGN =$$GET1^DI Q(55,PSODF N,53) | |
| 4619 | "RTN","PSO DIR1",95,0 ) | |
| 4620 | S PSDAYSU P=$S(PSORE GN?1U6N!$D (^TMP($J," CLOZFLG",P SODFN)):4, $G(CLOZPAT )=2:28,$G( CLOZPAT)=1 :14,$G(CLO ZPAT)=0:7, 1:MXDAYSUP ) | |
| 4621 | "RTN","PSO DIR1",96,0 ) | |
| 4622 | S DIR(0)= "N^1:"_PSD AYSUP | |
| 4623 | "RTN","PSO DIR1",97,0 ) | |
| 4624 | S DFDAYSU P=$S($D(CL OZPAT)&('$ G(PSODIR(" DAYS SUPPL Y"))):7,$G (PSODIR("D AYS SUPPLY "))]"":PSO DIR("DAYS SUPPLY"),S 2DS>1:S2DS ,$P($G(PSO DIR("PTST NODE")),"^ ",3):$P(PS ODIR("PTST NODE"),"^ ",3),1:30) | |
| 4625 | "RTN","PSO DIR1",98,0 ) | |
| 4626 | I DFDAYSU P>MXDAYSUP D S DFDA YSUP=MXDAY SUP | |
| 4627 | "RTN","PSO DIR1",99,0 ) | |
| 4628 | .W:$G(PSO DIR("DAYS SUPPLY")) !!,$C(7)," Invalid DA YS SUPPLY value (",D FDAYSUP,") , resettin g it to ", MXDAYSUP," (maximum allowed)." ,! | |
| 4629 | "RTN","PSO DIR1",100, 0) | |
| 4630 | S DIR("B" )=DFDAYSUP | |
| 4631 | "RTN","PSO DIR1",101, 0) | |
| 4632 | S DIR("A" )="DAYS SU PPLY",DIR( "?")="Ente r a whole number bet ween 1 and "_PSDAYSU P | |
| 4633 | "RTN","PSO DIR1",102, 0) | |
| 4634 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") DAYSX | |
| 4635 | "RTN","PSO DIR1",103, 0) | |
| 4636 | I $G(Y),$ G(PSODRUG( "MAXDOSE") )]"",$G(PS ODIR("QTY" ))]"",(+PS ODIR("QTY" )/Y>PSODRU G("MAXDOSE ")) D G D AYSEN | |
| 4637 | "RTN","PSO DIR1",104, 0) | |
| 4638 | .W !,$C(7 )," Greate r than Max imum dose of "_PSODR UG("MAXDOS E")_" per day" | |
| 4639 | "RTN","PSO DIR1",105, 0) | |
| 4640 | I $G(PSOF DR),$P($G( OR0),"^",2 4),$G(PSOD IR("DAYS S UPPLY")),+ Y>$G(PSODI R("DAYS SU PPLY")) D G DAYSX | |
| 4641 | "RTN","PSO DIR1",106, 0) | |
| 4642 | .W !!,"Di gitally Si gned Order - Days Su pply canno t be incre ased",! | |
| 4643 | "RTN","PSO DIR1",107, 0) | |
| 4644 | .N DIR S DIR(0)="E" ,DIR("A")= "Press Ret urn to Con tinue" D ^ DIR W ! | |
| 4645 | "RTN","PSO DIR1",108, 0) | |
| 4646 | I $G(PSON EW("FLD")) =8,PSODIR( "DAYS SUPP LY")=Y Q | |
| 4647 | "RTN","PSO DIR1",109, 0) | |
| 4648 | S PSODIR( "DAYS SUPP LY")=Y | |
| 4649 | "RTN","PSO DIR1",110, 0) | |
| 4650 | ; Checkin g the # Of Refills f ield value after the Days Supp ly field w as edited | |
| 4651 | "RTN","PSO DIR1",111, 0) | |
| 4652 | I $D(PSOD RUG("IEN") ),$G(Y),$G (Y)>$S(PSO RFLS<4:90, PSORFLS<6: 89,PSORFLS <12:60,1:0 ) D | |
| 4653 | "RTN","PSO DIR1",112, 0) | |
| 4654 | .N PTST | |
| 4655 | "RTN","PSO DIR1",113, 0) | |
| 4656 | .S PTST=+ $G(PSODIR( "PATIENT S TATUS")) S :'PTST PTS T=$P($G(PS ODIR("RX0" )),"^",3) | |
| 4657 | "RTN","PSO DIR1",114, 0) | |
| 4658 | .I 'PTST, $G(PSODFN) S PTST=+$ G(^PS(55,P SODFN,"PS" )) | |
| 4659 | "RTN","PSO DIR1",115, 0) | |
| 4660 | .I PSORFL S>$$MAXNUM RF^PSOUTIL (PSODRUG(" IEN"),Y,PT ST,.CLOZPA T) D | |
| 4661 | "RTN","PSO DIR1",116, 0) | |
| 4662 | .. W !,$C (7),"Inval id number of REFILLS for amoun t of DAYS SUPPLY.",! ,"REFILL E DIT FORCED ." D REFIL L(.PSODIR) | |
| 4663 | "RTN","PSO DIR1",117, 0) | |
| 4664 | .. S PSOD IR("FLD",9 )=PSODIR(" # OF REFIL LS") | |
| 4665 | "RTN","PSO DIR1",118, 0) | |
| 4666 | D:$G(PSOF ROM)="NEW" | |
| 4667 | "RTN","PSO DIR1",119, 0) | |
| 4668 | .K QTYHLD S:$G(PSOD IR("QTY")) QTYHLD=PS ODIR("QTY" ) D QTY^PS OSIG(.PSOD IR) | |
| 4669 | "RTN","PSO DIR1",120, 0) | |
| 4670 | .I $G(QTY HLD),'$G(P SODIR("QTY ")) S PSOD IR("QTY")= QTYHLD | |
| 4671 | "RTN","PSO DIR1",121, 0) | |
| 4672 | .K QTYHLD K:'$G(PSO DIR("QTY") ) PSODIR(" QTY") | |
| 4673 | "RTN","PSO DIR1",122, 0) | |
| 4674 | S:$G(CLOZ PAT)=0 (PS ODIR("N# R EF"),PSODI R("# OF RE FILLS"))=0 | |
| 4675 | "RTN","PSO DIR1",123, 0) | |
| 4676 | D:$G(CLOZ PAT)=2 | |
| 4677 | "RTN","PSO DIR1",124, 0) | |
| 4678 | .S:PSODIR ("DAYS SUP PLY")=28 ( PSODIR("N# REF"),PSO DIR("# OF REFILLS")) =0 | |
| 4679 | "RTN","PSO DIR1",125, 0) | |
| 4680 | .S:PSODIR ("DAYS SUP PLY")=14 ( PSODIR("N# REF"),PSO DIR("# OF REFILLS")) =1 | |
| 4681 | "RTN","PSO DIR1",126, 0) | |
| 4682 | .S:PSODIR ("DAYS SUP PLY")=7 (P SODIR("N# REF"),PSOD IR("# OF R EFILLS"))= 3 | |
| 4683 | "RTN","PSO DIR1",127, 0) | |
| 4684 | D:$G(CLOZ PAT)=1 | |
| 4685 | "RTN","PSO DIR1",128, 0) | |
| 4686 | .S:PSODIR ("DAYS SUP PLY")=14 ( PSODIR("N# REF"),PSO DIR("# OF REFILLS")) =0 | |
| 4687 | "RTN","PSO DIR1",129, 0) | |
| 4688 | .S:PSODIR ("DAYS SUP PLY")=7 (P SODIR("N# REF"),PSOD IR("# OF R EFILLS"))= 1 | |
| 4689 | "RTN","PSO DIR1",130, 0) | |
| 4690 | K QTYHLD S:$G(PSODI R("QTY")) QTYHLD=PSO DIR("QTY") D QTY^PSO SIG(.PSODI R) | |
| 4691 | "RTN","PSO DIR1",131, 0) | |
| 4692 | I $G(QTYH LD),'$G(PS ODIR("QTY" )) S PSODI R("QTY")=Q TYHLD | |
| 4693 | "RTN","PSO DIR1",132, 0) | |
| 4694 | K QTYHLD K:'$G(PSOD IR("QTY")) PSODIR("Q TY") | |
| 4695 | "RTN","PSO DIR1",133, 0) | |
| 4696 | DAYSX K X, Y | |
| 4697 | "RTN","PSO DIR1",134, 0) | |
| 4698 | Q | |
| 4699 | "RTN","PSO DIR1",135, 0) | |
| 4700 | REFILL(PSO DIR) ; | |
| 4701 | "RTN","PSO DIR1",136, 0) | |
| 4702 | N PSODAYS ,PSOX | |
| 4703 | "RTN","PSO DIR1",137, 0) | |
| 4704 | S PSODAYS =+$G(PSODI R("DAYS SU PPLY")) | |
| 4705 | "RTN","PSO DIR1",138, 0) | |
| 4706 | ;Recalcul ating RFTT if it doe sn't exist | |
| 4707 | "RTN","PSO DIR1",139, 0) | |
| 4708 | I '$G(PSO NEW) D | |
| 4709 | "RTN","PSO DIR1",140, 0) | |
| 4710 | .N I I '$ G(RFTT),$G (PSORXED(" IRXN")) F I=0:0 S I= $O(^PSRX(P SORXED("IR XN"),1,I)) Q:'I S R FTT=$G(RFT T)+1 | |
| 4711 | "RTN","PSO DIR1",141, 0) | |
| 4712 | ; | |
| 4713 | "RTN","PSO DIR1",142, 0) | |
| 4714 | I $G(PSOD IR("PTST N ODE"))="" D | |
| 4715 | "RTN","PSO DIR1",143, 0) | |
| 4716 | .N X,Y | |
| 4717 | "RTN","PSO DIR1",144, 0) | |
| 4718 | .S X=$G(P SODIR("PAT IENT STATU S")) S:'X X=$P(RX0," ^",3) | |
| 4719 | "RTN","PSO DIR1",145, 0) | |
| 4720 | .S DIC=53 ,DIC(0)="Q XZ" D ^DIC K DIC | |
| 4721 | "RTN","PSO DIR1",146, 0) | |
| 4722 | .S:+Y PSO DIR("PTST NODE")=Y(0 ) | |
| 4723 | "RTN","PSO DIR1",147, 0) | |
| 4724 | .S:'$G(PS ODIR("PATI ENT STATUS ")) PSODIR ("PATIENT STATUS")=+ Y | |
| 4725 | "RTN","PSO DIR1",148, 0) | |
| 4726 | S $P(PSOD IR("PTST N ODE"),"^", 4)=+$P($G( PSODIR("PT ST NODE")) ,"^",4) | |
| 4727 | "RTN","PSO DIR1",149, 0) | |
| 4728 | I $G(OR0) G REFOR | |
| 4729 | "RTN","PSO DIR1",150, 0) | |
| 4730 | K DIR,DIC ,PSOX | |
| 4731 | "RTN","PSO DIR1",151, 0) | |
| 4732 | ; Control led Substa nce | |
| 4733 | "RTN","PSO DIR1",152, 0) | |
| 4734 | S PSODIR( "CS")=0 | |
| 4735 | "RTN","PSO DIR1",153, 0) | |
| 4736 | I (PSODRU G("DEA")[" 2")!(PSODR UG("DEA")[ "3")!(PSOD RUG("DEA") ["4")!(PSO DRUG("DEA" )["5") D | |
| 4737 | "RTN","PSO DIR1",154, 0) | |
| 4738 | . S $P(PS ODIR("CS") ,"^")=1 S: (PSODRUG(" DEA")["2") $P(PSODIR ("CS"),"^" ,2)=1 | |
| 4739 | "RTN","PSO DIR1",155, 0) | |
| 4740 | ; Retriev ing the Ma ximum Numb er of Refi lls allowe d | |
| 4741 | "RTN","PSO DIR1",156, 0) | |
| 4742 | S PSOX=$$ MAXNUMRF^P SOUTIL(+$G (PSODRUG(" IEN")),PSO DAYS,+$G(P SODIR("PAT IENT STATU S")),.CLOZ PAT) | |
| 4743 | "RTN","PSO DIR1",157, 0) | |
| 4744 | ; | |
| 4745 | "RTN","PSO DIR1",158, 0) | |
| 4746 | I '$D(CLO ZPAT) I PS ODRUG("DEA ")["A"&(PS ODRUG("DEA ")'["B")!( PSODRUG("D EA")["F")! (PSODRUG(" DEA")[1)!( PSODRUG("D EA")[2) D G REFILLX | |
| 4747 | "RTN","PSO DIR1",159, 0) | |
| 4748 | .I PSODRU G("DEA")[" A"&(PSODRU G("DEA")'[ "B")!(PSOD RUG("DEA") [1)!(PSODR UG("DEA")[ 2)!'$O(^PS RX(+$G(PSO DIR("IRXN" )),1,0))!( '$G(PSOLOK ED)) D Q | |
| 4749 | "RTN","PSO DIR1",160, 0) | |
| 4750 | ..S VALMS G="No refi lls allowe d on "_$S( PSODRUG("D EA")["F":" this drug. ",1:"Narco tics.") W !,VALMSG,! | |
| 4751 | "RTN","PSO DIR1",161, 0) | |
| 4752 | ..S:$D(PS ODIR("FIEL D")) PSODI R("FIELD") =0 S PSODI R("# OF RE FILLS")=0 | |
| 4753 | "RTN","PSO DIR1",162, 0) | |
| 4754 | ..Q | |
| 4755 | "RTN","PSO DIR1",163, 0) | |
| 4756 | .;reset r efills to the # give n | |
| 4757 | "RTN","PSO DIR1",164, 0) | |
| 4758 | .D RFRSET ^PSODIR2 | |
| 4759 | "RTN","PSO DIR1",165, 0) | |
| 4760 | .Q | |
| 4761 | "RTN","PSO DIR1",166, 0) | |
| 4762 | I $P($G(P SODIR("CS" )),"^",2)= 1 W !,"No refills al lowed on S chedule 2 drugs...", ! S:$D(PSO DIR("FIELD ")) PSODIR ("FIELD")= 0 S PSODIR ("# OF REF ILLS")=0 G REFILLX | |
| 4763 | "RTN","PSO DIR1",167, 0) | |
| 4764 | ; | |
| 4765 | "RTN","PSO DIR1",168, 0) | |
| 4766 | ;/RBN - I ntegration of 444 st art | |
| 4767 | "RTN","PSO DIR1",169, 0) | |
| 4768 | I $D(CLOZ PAT) S PSO X=$S($G(CL OZPAT)=2&( PSODIR("DA YS SUPPLY" )=14):1,$G (CLOZPAT)= 2&(PSODIR( "DAYS SUPP LY")=7):3, $G(CLOZPAT )=1&(PSODI R("DAYS SU PPLY")=7): 1,1:0) | |
| 4769 | "RTN","PSO DIR1",170, 0) | |
| 4770 | ;/RBN - I ntegration of 444 en d | |
| 4771 | "RTN","PSO DIR1",171, 0) | |
| 4772 | ; | |
| 4773 | "RTN","PSO DIR1",172, 0) | |
| 4774 | ;PSO*7*26 6 make sur e PSOX is greater th an RFTT | |
| 4775 | "RTN","PSO DIR1",173, 0) | |
| 4776 | S DIR(0)= "N^"_$S($G (RFTT):RFT T,1:0)_":" _$S(+$G(RF TT)>PSOX:R FTT,1:PSOX ),DIR("A") ="# OF REF ILLS" | |
| 4777 | "RTN","PSO DIR1",174, 0) | |
| 4778 | ;PSO*7*34 0 Correct Default Va lue. | |
| 4779 | "RTN","PSO DIR1",175, 0) | |
| 4780 | ; | |
| 4781 | "RTN","PSO DIR1",176, 0) | |
| 4782 | S DIR("B" )=$S($G(CO PY):PSODIR ("# OF REF ILLS"),$G( PSODIR("N# REF"))]"" :PSODIR("N # REF"),$G (PSODIR("# OF REFILL S"))]"":PS ODIR("# OF REFILLS") ,$G(RFTT)> PSOX:RFTT, 1:PSOX) | |
| 4783 | "RTN","PSO DIR1",177, 0) | |
| 4784 | S DIR("?" ,1)="Enter a whole n umber. The maximum n umber of r efills is based on" | |
| 4785 | "RTN","PSO DIR1",178, 0) | |
| 4786 | S DIR("?" )="the DAY S SUPPLY a nd the PAT IENT STATU S fields." | |
| 4787 | "RTN","PSO DIR1",179, 0) | |
| 4788 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") REFILLX | |
| 4789 | "RTN","PSO DIR1",180, 0) | |
| 4790 | S (PSODIR ("N# REF") ,PSODIR("# OF REFILL S"))=Y | |
| 4791 | "RTN","PSO DIR1",181, 0) | |
| 4792 | ; | |
| 4793 | "RTN","PSO DIR1",182, 0) | |
| 4794 | REFILLX S: $G(PSODIR( "# OF REFI LLS"))']"" PSODIR("# OF REFILL S")=$S($G( PSODIR("N# REF"))]"" :PSODIR("N # REF"),1: PSOX) | |
| 4795 | "RTN","PSO DIR1",183, 0) | |
| 4796 | K X,Y,PSO X,DEA,PSOC S,RFTT ;PS O*7*340 Ki ll RFTT | |
| 4797 | "RTN","PSO DIR1",184, 0) | |
| 4798 | ; | |
| 4799 | "RTN","PSO DIR1",185, 0) | |
| 4800 | Q | |
| 4801 | "RTN","PSO DIR1",186, 0) | |
| 4802 | ;OERR CAL L | |
| 4803 | "RTN","PSO DIR1",187, 0) | |
| 4804 | REFOR ; | |
| 4805 | "RTN","PSO DIR1",188, 0) | |
| 4806 | D REFOR^P SODIR3 | |
| 4807 | "RTN","PSO DIR1",189, 0) | |
| 4808 | G REFILLX | |
| 4809 | "RTN","PSO DIR1",190, 0) | |
| 4810 | Q | |
| 4811 | "RTN","PSO DIR1",191, 0) | |
| 4812 | DIR ; | |
| 4813 | "RTN","PSO DIR1",192, 0) | |
| 4814 | S (PSODIR ("FIELD"), PSODIR("DF LG"))=0 | |
| 4815 | "RTN","PSO DIR1",193, 0) | |
| 4816 | G:$G(DIR( 0))']"" DI RX | |
| 4817 | "RTN","PSO DIR1",194, 0) | |
| 4818 | D ^DIR K DIR,DIE,DI C,DA | |
| 4819 | "RTN","PSO DIR1",195, 0) | |
| 4820 | I $D(DUOU T)!($D(DTO UT))!($D(D IROUT)),$L ($G(X))'>1 !(Y="") S PSODIR("DF LG")=1 G D IRX | |
| 4821 | "RTN","PSO DIR1",196, 0) | |
| 4822 | I $D(DIRU T)!($D(DIR OUT)),$G(S PEED) S PS ODIR("DFLG ")=1 G DIR X | |
| 4823 | "RTN","PSO DIR1",197, 0) | |
| 4824 | I X[U,$L( X)>1 D JUM P | |
| 4825 | "RTN","PSO DIR1",198, 0) | |
| 4826 | DIRX K DIR UT,DTOUT,D UOUT,DIROU T | |
| 4827 | "RTN","PSO DIR1",199, 0) | |
| 4828 | Q | |
| 4829 | "RTN","PSO DIR1",200, 0) | |
| 4830 | JUMP ; | |
| 4831 | "RTN","PSO DIR1",201, 0) | |
| 4832 | I $G(PSOE DIT)!($G(O R0)) S PSO DIR("DFLG" )=1 Q | |
| 4833 | "RTN","PSO DIR1",202, 0) | |
| 4834 | S X=$P(X, "^",2),DIC ="^DD(52," ,DIC(0)="Q M" D ^DIC K DIC | |
| 4835 | "RTN","PSO DIR1",203, 0) | |
| 4836 | I Y=-1 S PSODIR("FI ELD")=PSOD IR("FLD") G JUMPX | |
| 4837 | "RTN","PSO DIR1",204, 0) | |
| 4838 | I $G(PSON EW1)=0 D J UMP^PSONEW 1 G JUMPX | |
| 4839 | "RTN","PSO DIR1",205, 0) | |
| 4840 | I $G(PSOR EF1)=0 D J UMP^PSOREF 1 G JUMPX | |
| 4841 | "RTN","PSO DIR1",206, 0) | |
| 4842 | I $G(PSON EW3)=0 D J UMP^PSONEW 3 G JUMPX | |
| 4843 | "RTN","PSO DIR1",207, 0) | |
| 4844 | I $G(PSOR ENW3)=0 D JUMP^PSORE NW3 G JUMP X | |
| 4845 | "RTN","PSO DIR1",208, 0) | |
| 4846 | JUMPX S X= "^"_X | |
| 4847 | "RTN","PSO DIR1",209, 0) | |
| 4848 | Q | |
| 4849 | "RTN","PSO DIR1",210, 0) | |
| 4850 | SIGOK ;rev iew and de cide on oe rr sig | |
| 4851 | "RTN","PSO DIR1",211, 0) | |
| 4852 | I '$O(SIG (0)) S SIG OK=0 Q | |
| 4853 | "RTN","PSO DIR1",212, 0) | |
| 4854 | K SIGOK W !,"SIG: " | |
| 4855 | "RTN","PSO DIR1",213, 0) | |
| 4856 | F SIG=0:0 S SIG=$O( SIG(SIG)) W SIG(SIG) _" ",!?5 Q :'$O(SIG(S IG)) | |
| 4857 | "RTN","PSO DIR1",214, 0) | |
| 4858 | K DIR,DIR UT,DUOUT,D TOUT S DIR ("B")="YES ",DIR(0)=" Y",DIR("A" )="Is this SIG corre ct" D ^DIR K DIR I $ D(DIRUT) S PSODIR("D FLG")=1 K DIRUT,DUOU T,DTOUT Q | |
| 4859 | "RTN","PSO DIR1",215, 0) | |
| 4860 | S SIGOK=Y I Y K PSO DIR("SIG") | |
| 4861 | "RTN","PSO DIR1",216, 0) | |
| 4862 | Q | |
| 4863 | "RTN","PSO DIR1",217, 0) | |
| 4864 | PSTPB ; | |
| 4865 | "RTN","PSO DIR1",218, 0) | |
| 4866 | W !,"New orders ent ered throu gh this op tion must have a Pat ient Statu s of 'NON- VA'!",! | |
| 4867 | "RTN","PSO DIR1",219, 0) | |
| 4868 | Q | |
| 4869 | "RTN","PSO DIR2") | |
| 4870 | 0^8^B32135 372 | |
| 4871 | "RTN","PSO DIR2",1,0) | |
| 4872 | PSODIR2 ;I HS/DSD/JCM - rx orde r entry co ntd ;Jul 2 4, 2017@15 :24 | |
| 4873 | "RTN","PSO DIR2",2,0) | |
| 4874 | ;;7.0;OUT PATIENT PH ARMACY;**3 ,9,26,46,1 24,146,139 ,152,166,4 57**;DEC 1 997;Build 65 | |
| 4875 | "RTN","PSO DIR2",3,0) | |
| 4876 | ;External reference to ^DD(52 supported by DBIA 9 99 | |
| 4877 | "RTN","PSO DIR2",4,0) | |
| 4878 | ;External reference to ^VA(20 0 supporte d by DBIA 10060 | |
| 4879 | "RTN","PSO DIR2",5,0) | |
| 4880 | ;External reference to ^%DTC supported by DBIA 10 000 | |
| 4881 | "RTN","PSO DIR2",6,0) | |
| 4882 | ;External reference to ^DIC s upported b y DBIA 100 06 | |
| 4883 | "RTN","PSO DIR2",7,0) | |
| 4884 | ;External reference to ^DIR s upported b y DBIA 100 26 | |
| 4885 | "RTN","PSO DIR2",8,0) | |
| 4886 | ; | |
| 4887 | "RTN","PSO DIR2",9,0) | |
| 4888 | ;-------- ---------- ---------- ---------- ---------- ---------- ---------- - | |
| 4889 | "RTN","PSO DIR2",10,0 ) | |
| 4890 | ; | |
| 4891 | "RTN","PSO DIR2",11,0 ) | |
| 4892 | EXP(PSODIR ) ; | |
| 4893 | "RTN","PSO DIR2",12,0 ) | |
| 4894 | K DIR,DIC | |
| 4895 | "RTN","PSO DIR2",13,0 ) | |
| 4896 | I $G(PSOD RUG("EXPIR ATION DATE "))]"" S Y =PSODRUG(" EXPIRATION DATE") X ^DD("DD") S PSORX("E XPIRATION DATE")=Y | |
| 4897 | "RTN","PSO DIR2",14,0 ) | |
| 4898 | S DIR("A" )="EXPIRES ",DIR("B") =$S($G(PSO RX("EXPIRA TION DATE" ))]"":PSOR X("EXPIRAT ION DATE") ,1:"T+6M") | |
| 4899 | "RTN","PSO DIR2",15,0 ) | |
| 4900 | S DIR(0)= "D^NOW::EX " | |
| 4901 | "RTN","PSO DIR2",16,0 ) | |
| 4902 | S DIR("?" )="Both th e month an d date are required. " | |
| 4903 | "RTN","PSO DIR2",17,0 ) | |
| 4904 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") EXPX | |
| 4905 | "RTN","PSO DIR2",18,0 ) | |
| 4906 | S PSODIR( "EXPIRATIO N DATE")=Y | |
| 4907 | "RTN","PSO DIR2",19,0 ) | |
| 4908 | EXPX K X,Y | |
| 4909 | "RTN","PSO DIR2",20,0 ) | |
| 4910 | Q | |
| 4911 | "RTN","PSO DIR2",21,0 ) | |
| 4912 | ; | |
| 4913 | "RTN","PSO DIR2",22,0 ) | |
| 4914 | CLINIC(PSO DIR) ; | |
| 4915 | "RTN","PSO DIR2",23,0 ) | |
| 4916 | K DIR,DIC S PSODIR( "FIELD")=0 | |
| 4917 | "RTN","PSO DIR2",24,0 ) | |
| 4918 | S DIR(0)= "52,5" S:$ G(PSORX("C LINIC"))]" " DIR("B") =PSORX("CL INIC"),DIR ("A")="CLI NIC" | |
| 4919 | "RTN","PSO DIR2",25,0 ) | |
| 4920 | D ^DIR G: PSODIR("DF LG")!PSODI R("FIELD") CLINICX | |
| 4921 | "RTN","PSO DIR2",26,0 ) | |
| 4922 | I +Y>0 S PSODIR("CL INIC")=+Y, PSORX("CLI NIC")=$P(Y ,"^",2) | |
| 4923 | "RTN","PSO DIR2",27,0 ) | |
| 4924 | E S (PSO RX("CLINIC "),PSODIR( "CLINIC")) ="" | |
| 4925 | "RTN","PSO DIR2",28,0 ) | |
| 4926 | CLINICX K X,Y,PSOX,D IC | |
| 4927 | "RTN","PSO DIR2",29,0 ) | |
| 4928 | Q | |
| 4929 | "RTN","PSO DIR2",30,0 ) | |
| 4930 | ; | |
| 4931 | "RTN","PSO DIR2",31,0 ) | |
| 4932 | MW(PSODIR) ; | |
| 4933 | "RTN","PSO DIR2",32,0 ) | |
| 4934 | K DIR,DIC | |
| 4935 | "RTN","PSO DIR2",33,0 ) | |
| 4936 | S DIR(0)= "52,11" S: $G(POERR)& '$D(PSORX( "MAIL/WIND OW")) PSOR X("MAIL/WI NDOW")=$S( $P($G(OR0) ,"^",17)=" M":"MAIL", 1:"WINDOW" ) | |
| 4937 | "RTN","PSO DIR2",34,0 ) | |
| 4938 | S DIR("B" )=$S($G(PS ORX("MAIL/ WINDOW"))] "":PSORX(" MAIL/WINDO W"),$G(PSO TPBFG)&($G (PSOFROM)= "NEW"):"MA IL",1:"WIN DOW") | |
| 4939 | "RTN","PSO DIR2",35,0 ) | |
| 4940 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") MWX | |
| 4941 | "RTN","PSO DIR2",36,0 ) | |
| 4942 | I $G(Y(0) )']"" S PS ODIR("DFLG ")=1 G MWX | |
| 4943 | "RTN","PSO DIR2",37,0 ) | |
| 4944 | S PSODIR( "MAIL/WIND OW")=Y,PSO RX("MAIL/W INDOW")=Y( 0) | |
| 4945 | "RTN","PSO DIR2",38,0 ) | |
| 4946 | I $G(PSOR X("EDIT")) ]"",PSODIR ("MAIL/WIN DOW")'="W" K PSODIR( "METHOD OF PICK-UP") | |
| 4947 | "RTN","PSO DIR2",39,0 ) | |
| 4948 | MW1 G:PSOD IR("MAIL/W INDOW")'=" W"!('$P($G (PSOPAR)," ^",12)) MW X | |
| 4949 | "RTN","PSO DIR2",40,0 ) | |
| 4950 | S DIR(0)= "52,35O" | |
| 4951 | "RTN","PSO DIR2",41,0 ) | |
| 4952 | S:$G(PSOR X("METHOD OF PICK-UP "))]"" DIR ("B")=PSOR X("METHOD OF PICK-UP ") | |
| 4953 | "RTN","PSO DIR2",42,0 ) | |
| 4954 | D DIR G:P SODIR("DFL G") MWX | |
| 4955 | "RTN","PSO DIR2",43,0 ) | |
| 4956 | I X[U W ! ,"Cannot j ump to ano ther field ..",! G M W1 | |
| 4957 | "RTN","PSO DIR2",44,0 ) | |
| 4958 | S (PSODIR ("METHOD O F PICK-UP" ),PSORX("M ETHOD OF P ICK-UP"))= Y | |
| 4959 | "RTN","PSO DIR2",45,0 ) | |
| 4960 | MWX K X,Y | |
| 4961 | "RTN","PSO DIR2",46,0 ) | |
| 4962 | Q | |
| 4963 | "RTN","PSO DIR2",47,0 ) | |
| 4964 | ; | |
| 4965 | "RTN","PSO DIR2",48,0 ) | |
| 4966 | RMK(PSODIR ) ; | |
| 4967 | "RTN","PSO DIR2",49,0 ) | |
| 4968 | RMKEN K DI R,DIC | |
| 4969 | "RTN","PSO DIR2",50,0 ) | |
| 4970 | S DIR(0)= "52,12" | |
| 4971 | "RTN","PSO DIR2",51,0 ) | |
| 4972 | S:$G(PSOD IR("REMARK S"))]"" DI R("B")=PSO DIR("REMAR KS") | |
| 4973 | "RTN","PSO DIR2",52,0 ) | |
| 4974 | D DIR G:P SODIR("DFL G") RMKX | |
| 4975 | "RTN","PSO DIR2",53,0 ) | |
| 4976 | I X[U W ! ,"Cannot j ump to ano ther field ..",! G R MKEN | |
| 4977 | "RTN","PSO DIR2",54,0 ) | |
| 4978 | S:$L(X)>0 PSODIR("R EMARKS")=X | |
| 4979 | "RTN","PSO DIR2",55,0 ) | |
| 4980 | S:X="@" P SODIR("REM ARKS")="" | |
| 4981 | "RTN","PSO DIR2",56,0 ) | |
| 4982 | RMKX K X,Y | |
| 4983 | "RTN","PSO DIR2",57,0 ) | |
| 4984 | Q | |
| 4985 | "RTN","PSO DIR2",58,0 ) | |
| 4986 | ; | |
| 4987 | "RTN","PSO DIR2",59,0 ) | |
| 4988 | ISSDT(PSOD IR) ; | |
| 4989 | "RTN","PSO DIR2",60,0 ) | |
| 4990 | K DIR,DIC | |
| 4991 | "RTN","PSO DIR2",61,0 ) | |
| 4992 | S DIR("A" )="ISSUE D ATE",DIR(" B")=$S($G( POERR)&($G (PSORX("IS SUE DATE") )']"")&($G (PSODIR("I SSUE DATE" ))]""):PSO DIR("ISSUE DATE"),$G (PSORX("IS SUE DATE") )]"":PSORX ("ISSUE DA TE"),1:"TO DAY") | |
| 4993 | "RTN","PSO DIR2",62,0 ) | |
| 4994 | I DIR("B" ) S Y=DIR( "B") X ^DD ("DD") S D IR("B")=Y | |
| 4995 | "RTN","PSO DIR2",63,0 ) | |
| 4996 | S DIR(0)= "52,1" | |
| 4997 | "RTN","PSO DIR2",64,0 ) | |
| 4998 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") ISSDTX | |
| 4999 | "RTN","PSO DIR2",65,0 ) | |
| 5000 | S (PSODIR ("ISSUE DA TE"),PSOID )=Y | |
| 5001 | "RTN","PSO DIR2",66,0 ) | |
| 5002 | X ^DD("DD ") S (PSOR X("ISSUE D ATE"),PSOD IR("ISSUE DATE"))=Y | |
| 5003 | "RTN","PSO DIR2",67,0 ) | |
| 5004 | ISSDTX K X ,Y | |
| 5005 | "RTN","PSO DIR2",68,0 ) | |
| 5006 | Q | |
| 5007 | "RTN","PSO DIR2",69,0 ) | |
| 5008 | ; | |
| 5009 | "RTN","PSO DIR2",70,0 ) | |
| 5010 | FILLDT(PSO DIR) ; | |
| 5011 | "RTN","PSO DIR2",71,0 ) | |
| 5012 | K DIR,DIC | |
| 5013 | "RTN","PSO DIR2",72,0 ) | |
| 5014 | S:'$G(PSO NEW("DAYS SUPPLY")) PSONEW("DA YS SUPPLY" )=30,PSONE W("# OF RE FILLS")=1 | |
| 5015 | "RTN","PSO DIR2",73,0 ) | |
| 5016 | S DIR("A" )="FILL DA TE",DIR("B ")=$S($G(P SORX("FILL DATE"))]" ":PSORX("F ILL DATE") ,1:"TODAY" ) | |
| 5017 | "RTN","PSO DIR2",74,0 ) | |
| 5018 | S X2=PSON EW("DAYS S UPPLY")*(P SONEW("# O F REFILLS" )+1)\1 | |
| 5019 | "RTN","PSO DIR2",75,0 ) | |
| 5020 | S X1=$S($ G(PSOID):P SOID,1:DT) | |
| 5021 | "RTN","PSO DIR2",76,0 ) | |
| 5022 | S X2=$S(P SONEW("DAY S SUPPLY") =X2:X2,+$G (PSODIR("C S")):184,1 :366) | |
| 5023 | "RTN","PSO DIR2",77,0 ) | |
| 5024 | I X2<30 D | |
| 5025 | "RTN","PSO DIR2",78,0 ) | |
| 5026 | . N % S % =$P($G(PSO RX("PATIEN T STATUS") ),"^"),X2= 30 | |
| 5027 | "RTN","PSO DIR2",79,0 ) | |
| 5028 | . S:%?.N %=$P($G(^P S(53,+%,0) ),"^") I % ["AUTH ABS " S X2=5 | |
| 5029 | "RTN","PSO DIR2",80,0 ) | |
| 5030 | ;; START NCC REMEDI ATION >> 4 57*RJS | |
| 5031 | "RTN","PSO DIR2",81,0 ) | |
| 5032 | ;; ADJUST EXPIRE DA TE FOR 4 D AY SUPPLY | |
| 5033 | "RTN","PSO DIR2",82,0 ) | |
| 5034 | I $G(CLOZ FLG),PSONE W("DAYS SU PPLY"),5 S X2=PSONEW ("DAYS SUP PLY")*(PSO NEW("# OF REFILLS")+ 1)\1 | |
| 5035 | "RTN","PSO DIR2",83,0 ) | |
| 5036 | ;; END NC C REMEDIAT ION << 457 *RJS | |
| 5037 | "RTN","PSO DIR2",84,0 ) | |
| 5038 | D C^%DTC S PSOFDMX= $P(X,".") I DT>X S Y =$S($G(PSO ID):PSOID, 1:PSORX("I SSUE DATE" )) X ^DD(" DD") S DIR ("B")=Y | |
| 5039 | "RTN","PSO DIR2",85,0 ) | |
| 5040 | S DIR(0)= "D^"_$S($G (PSOID):PS OID,+$G(PS ODIR("ISSU E DATE")): PSODIR("IS SUE DATE") ,1:DT)_$S( $G(DUZ("AG "))="I":": "_DT_":EX" ,1:":"_PSO FDMX_":EX" ) | |
| 5041 | "RTN","PSO DIR2",86,0 ) | |
| 5042 | S Y=PSOFD MX X ^DD(" DD") | |
| 5043 | "RTN","PSO DIR2",87,0 ) | |
| 5044 | S DIR("?" ,1)="The e arliest fi ll date al lowed is d etermined by the ISS UE DATE," | |
| 5045 | "RTN","PSO DIR2",88,0 ) | |
| 5046 | S DIR("?" ,2)="the F ILL DATE c annot be b efore the ISSUE DATE or AFTER the Expira tion Date " | |
| 5047 | "RTN","PSO DIR2",89,0 ) | |
| 5048 | S DIR("?" )=Y_". Bo th the mon th and dat e are requ ired." | |
| 5049 | "RTN","PSO DIR2",90,0 ) | |
| 5050 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") FILLDTX | |
| 5051 | "RTN","PSO DIR2",91,0 ) | |
| 5052 | S PSODIR( "FILL DATE ")=Y | |
| 5053 | "RTN","PSO DIR2",92,0 ) | |
| 5054 | X ^DD("DD ") S PSORX ("FILL DAT E")=Y | |
| 5055 | "RTN","PSO DIR2",93,0 ) | |
| 5056 | FILLDTX K X,Y,PSOFDM X | |
| 5057 | "RTN","PSO DIR2",94,0 ) | |
| 5058 | Q | |
| 5059 | "RTN","PSO DIR2",95,0 ) | |
| 5060 | ; | |
| 5061 | "RTN","PSO DIR2",96,0 ) | |
| 5062 | CLERK(PSOD IR) ; | |
| 5063 | "RTN","PSO DIR2",97,0 ) | |
| 5064 | I $G(DUZ( "AG"))'="I " D G CLE RKX | |
| 5065 | "RTN","PSO DIR2",98,0 ) | |
| 5066 | .S PSODIR ("CLERK CO DE")=$S($G (PSOFDR):$ P(OR0,"^", 4),1:DUZ), PSORX("CLE RK CODE")= $P($G(^VA( 200,PSODIR ("CLERK CO DE"),0))," ^") | |
| 5067 | "RTN","PSO DIR2",99,0 ) | |
| 5068 | K DIR,DIC | |
| 5069 | "RTN","PSO DIR2",100, 0) | |
| 5070 | S DIR("A" )="CLERK", DIR("B")=$ S($G(PSORX ("CLERK CO DE"))]"":P SORX("CLER K CODE"),1 :$P($G(^VA (200,DUZ,0 )),"^",2)) ,DIR(0)="5 2,16" | |
| 5071 | "RTN","PSO DIR2",101, 0) | |
| 5072 | D DIR G:P SODIR("DFL G")!PSODIR ("FIELD") CLERKX | |
| 5073 | "RTN","PSO DIR2",102, 0) | |
| 5074 | S PSODIR( "CLERK COD E")=+Y,PSO RX("CLERK CODE")=$P( Y,"^") | |
| 5075 | "RTN","PSO DIR2",103, 0) | |
| 5076 | CLERKX Q | |
| 5077 | "RTN","PSO DIR2",104, 0) | |
| 5078 | ; | |
| 5079 | "RTN","PSO DIR2",105, 0) | |
| 5080 | DIR ; | |
| 5081 | "RTN","PSO DIR2",106, 0) | |
| 5082 | S PSODIR( "FIELD")=0 | |
| 5083 | "RTN","PSO DIR2",107, 0) | |
| 5084 | G:$G(DIR( 0))']"" DI RX | |
| 5085 | "RTN","PSO DIR2",108, 0) | |
| 5086 | D ^DIR K DIR,DIE,DI C,DA I X=" ^^" S (PSO DIR("QFLG" ),PSODIR(" DFLG"))=1 G DIRX | |
| 5087 | "RTN","PSO DIR2",109, 0) | |
| 5088 | I $D(DUOU T)!($D(DTO UT))!($D(D IROUT)),$L ($G(X))'>1 !(Y="") S PSODIR("DF LG")=1 S:$ G(SPEED) P SODIR("QFL G")=1 G DI RX | |
| 5089 | "RTN","PSO DIR2",110, 0) | |
| 5090 | I $D(DUOU T)!($D(DTO UT)),$G(SP EED) S PSO DIR("DFLG" )=1 G DIRX | |
| 5091 | "RTN","PSO DIR2",111, 0) | |
| 5092 | I X[U,$L( X)>1 D JUM P | |
| 5093 | "RTN","PSO DIR2",112, 0) | |
| 5094 | DIRX K DIR UT,DTOUT,D UOUT,DIROU T,PSOX | |
| 5095 | "RTN","PSO DIR2",113, 0) | |
| 5096 | Q | |
| 5097 | "RTN","PSO DIR2",114, 0) | |
| 5098 | ; | |
| 5099 | "RTN","PSO DIR2",115, 0) | |
| 5100 | JUMP ; | |
| 5101 | "RTN","PSO DIR2",116, 0) | |
| 5102 | I $G(PSOE DIT)!($G(O R0)) S PSO DIR("DFLG" )=1 Q | |
| 5103 | "RTN","PSO DIR2",117, 0) | |
| 5104 | S X=$P(X, "^",2),DIC ="^DD(52," ,DIC(0)="Q M" D ^DIC K DIC | |
| 5105 | "RTN","PSO DIR2",118, 0) | |
| 5106 | I Y=-1 S PSODIR("FI ELD")=$G(P SODIR("FLD ")) G JUMP X | |
| 5107 | "RTN","PSO DIR2",119, 0) | |
| 5108 | I $G(PSON EW1)=0 D J UMP^PSONEW 1 G JUMPX | |
| 5109 | "RTN","PSO DIR2",120, 0) | |
| 5110 | I $G(PSON EW3)=0 D J UMP^PSONEW 3 G JUMPX | |
| 5111 | "RTN","PSO DIR2",121, 0) | |
| 5112 | I $G(PSOR ENW3)=0 D JUMP^PSORE NW3 G JUMP X | |
| 5113 | "RTN","PSO DIR2",122, 0) | |
| 5114 | JUMPX S X= "^"_X | |
| 5115 | "RTN","PSO DIR2",123, 0) | |
| 5116 | Q | |
| 5117 | "RTN","PSO DIR2",124, 0) | |
| 5118 | ;Reset re fills when drug chan ged to a c ontrolled sub | |
| 5119 | "RTN","PSO DIR2",125, 0) | |
| 5120 | RFRSET ; | |
| 5121 | "RTN","PSO DIR2",126, 0) | |
| 5122 | N RFN,RFN C | |
| 5123 | "RTN","PSO DIR2",127, 0) | |
| 5124 | S (RFN,RF NC)=0 | |
| 5125 | "RTN","PSO DIR2",128, 0) | |
| 5126 | F S RFN= $O(^PSRX(+ $G(PSODIR( "IRXN")),1 ,RFN)) Q:' RFN S RFN C=RFNC+1 | |
| 5127 | "RTN","PSO DIR2",129, 0) | |
| 5128 | I $D(PSOD IR("FIELD" )) S PSODI R("FIELD") =0 | |
| 5129 | "RTN","PSO DIR2",130, 0) | |
| 5130 | S PSODIR( "# OF REFI LLS")=RFNC | |
| 5131 | "RTN","PSO DIR2",131, 0) | |
| 5132 | S VALMSG= "The drug has been c hanged and no longer allows re fills." | |
| 5133 | "RTN","PSO DIR2",132, 0) | |
| 5134 | W !,VALMS G,! | |
| 5135 | "RTN","PSO DIR2",133, 0) | |
| 5136 | Q | |
| 5137 | "RTN","PSO DRG") | |
| 5138 | 0^5^B92777 437 | |
| 5139 | "RTN","PSO DRG",1,0) | |
| 5140 | PSODRG ;IH S/DSD/JCM - ORDER EN TRY DRUG S ELECTION ; Jul 24, 20 17@15:24 | |
| 5141 | "RTN","PSO DRG",2,0) | |
| 5142 | ;;7.0;OUT PATIENT PH ARMACY;**2 0,23,36,53 ,54,46,112 ,139,207,1 48,243,268 ,324,251,3 75,387,398 ,390,427,4 11,458,457 **;DEC 199 7;Build 65 | |
| 5143 | "RTN","PSO DRG",3,0) | |
| 5144 | ;Referenc e to ^PSDR UG( suppor ted by DBI A 221 | |
| 5145 | "RTN","PSO DRG",4,0) | |
| 5146 | ;Referenc e to ^PS(5 0.7 suppor ted by DBI A 2223 | |
| 5147 | "RTN","PSO DRG",5,0) | |
| 5148 | ;Referenc e to $$PRO MPT^PSSDIN supported by DBIA 3 166 | |
| 5149 | "RTN","PSO DRG",6,0) | |
| 5150 | ;Referenc e to EN^PS SDIN suppo rted by DB IA 3166 | |
| 5151 | "RTN","PSO DRG",7,0) | |
| 5152 | ;Referenc e to $$GET NDC^PSSNDC UT support ed by DBIA 4707 | |
| 5153 | "RTN","PSO DRG",8,0) | |
| 5154 | ;Referenc e to ^OROC API contro lled subsc ription su pported by DBIA 5367 | |
| 5155 | "RTN","PSO DRG",9,0) | |
| 5156 | ;Referenc e to $$OIT M^ORX8 sup ported by DBIA 5469 | |
| 5157 | "RTN","PSO DRG",10,0) | |
| 5158 | ;Referenc e to ^VADP T supporte d by DBIA 10061 | |
| 5159 | "RTN","PSO DRG",11,0) | |
| 5160 | ;Referenc e to IN^PS SHRQ2 supp orted by D BIA 5369 | |
| 5161 | "RTN","PSO DRG",12,0) | |
| 5162 | ;Referenc e to ^XTMP ("ORRDI" s upported b y DBIA 544 0 | |
| 5163 | "RTN","PSO DRG",13,0) | |
| 5164 | ;-------- ---------- ---------- ---------- ---------- ---------- | |
| 5165 | "RTN","PSO DRG",14,0) | |
| 5166 | START ; | |
| 5167 | "RTN","PSO DRG",15,0) | |
| 5168 | S (PSONEW ("DFLG"),P SONEW("FIE LD"),PSODR G("QFLG")) =0 K PSORX ("DFLG") | |
| 5169 | "RTN","PSO DRG",16,0) | |
| 5170 | D @($S(+$ G(PSOEDIT) =1&('$D(DA )):"SELECT ^PSODRGN", 1:"SELECT" )) | |
| 5171 | "RTN","PSO DRG",17,0) | |
| 5172 | G:$G(PSOR XED("DFLG" )) END ; S elect Drug | |
| 5173 | "RTN","PSO DRG",18,0) | |
| 5174 | I $G(PSOR X("EDIT")) ,$G(PSOY), $G(PSODRUG ("IEN"))=+ PSOY D G: $G(PSORXED ("DFLG")) END | |
| 5175 | "RTN","PSO DRG",19,0) | |
| 5176 | . N NDC D NDC(+$G(P SORXED("IR XN")),0,+P SOY,.NDC) I $G(NDC)= "^" S PSOR XED("DFLG" )=1 Q | |
| 5177 | "RTN","PSO DRG",20,0) | |
| 5178 | . I $G(ND C)'="" S ( PSODRUG("N DC"),PSORX ED("FLD",2 7))=NDC | |
| 5179 | "RTN","PSO DRG",21,0) | |
| 5180 | ; | |
| 5181 | "RTN","PSO DRG",22,0) | |
| 5182 | I $G(PSOR X("EDIT")) ]"",'PSONE W("FIELD") D TRADE | |
| 5183 | "RTN","PSO DRG",23,0) | |
| 5184 | G:$G(PSON EW("DFLG") )!($G(PSOD RG("QFLG") ))!($G(PSO RXED("DFLG "))) END | |
| 5185 | "RTN","PSO DRG",24,0) | |
| 5186 | D SET ; S et various drug info rmation | |
| 5187 | "RTN","PSO DRG",25,0) | |
| 5188 | D NFI ; D isplay dis pense drug /orderable item text | |
| 5189 | "RTN","PSO DRG",26,0) | |
| 5190 | D:'$G(PSO EDIT) POST I $G(PSOR X("DFLG")) S PSONEW( "DFLG")=1 K:'$G(PSOR X("EDIT")) PSORX("DF LG") ; Do any post s election a ction | |
| 5191 | "RTN","PSO DRG",27,0) | |
| 5192 | END ;D EOJ | |
| 5193 | "RTN","PSO DRG",28,0) | |
| 5194 | Q | |
| 5195 | "RTN","PSO DRG",29,0) | |
| 5196 | ;-------- ---------- ---------- ---------- ---------- ---------- -- | |
| 5197 | "RTN","PSO DRG",30,0) | |
| 5198 | ; | |
| 5199 | "RTN","PSO DRG",31,0) | |
| 5200 | SELECT ; | |
| 5201 | "RTN","PSO DRG",32,0) | |
| 5202 | K:'$G(PSO RXED) CLOZ PAT | |
| 5203 | "RTN","PSO DRG",33,0) | |
| 5204 | K IT,DIC, X,Y,PSODRU G("TRADE N AME"),PSOD RUG("NDC") ,PSODRUG(" DAW"),PSOD RUG("BAD") S:$G(POER R)&($P($G( OR0),"^",9 )) Y=$$GET 1^DIQ(50,$ P(OR0,"^", 9),.01) | |
| 5205 | "RTN","PSO DRG",34,0) | |
| 5206 | I $G(PSOD RUG("IEN") )]"" S Y=P SODRUG("NA ME"),PSONE W("OLD VAL ")=PSODRUG ("IEN") | |
| 5207 | "RTN","PSO DRG",35,0) | |
| 5208 | W !,"DRUG : "_$S($G( Y)]"":Y_"/ / ",1:"") R X:$S($D( DTIME):DTI ME,1:300) I '$T S DT OUT=1 | |
| 5209 | "RTN","PSO DRG",36,0) | |
| 5210 | I X="",$G (Y)]"" S:Y X=Y S:'X X=$G(PSODR UG("IEN")) S:X X="`" _X | |
| 5211 | "RTN","PSO DRG",37,0) | |
| 5212 | G:X="" SE LECT | |
| 5213 | "RTN","PSO DRG",38,0) | |
| 5214 | I X?1."?" W !!,"Ans wer with D RUG NUMBER , or GENER IC NAME, o r VA PRODU CT NAME, o r",!,"NATI ONAL DRUG CLASS, or SYNONYM" G SELECT | |
| 5215 | "RTN","PSO DRG",39,0) | |
| 5216 | I $G(PSOR XED),X["^" S PSORXED ("DFLG")=1 G SELECTX | |
| 5217 | "RTN","PSO DRG",40,0) | |
| 5218 | I X="^"!( X["^^")!($ D(DTOUT)) S PSONEW(" DFLG")=1 G SELECTX | |
| 5219 | "RTN","PSO DRG",41,0) | |
| 5220 | I '$G(POE RR),X[U,$L (X)>1 S PS ODIR("FLD" )=PSONEW(" FLD") D JU MP^PSODIR1 S:$G(PSOD IR("FIELD" )) PSONEW( "FIELD")=P SODIR("FIE LD") K PSO DIR S PSOD RG("QFLG") =1 G SELEC TX | |
| 5221 | "RTN","PSO DRG",42,0) | |
| 5222 | S DIC=50, DIC(0)="EM QZVT",DIC( "T")="",D= "B^C^VAPN^ VAC" | |
| 5223 | "RTN","PSO DRG",43,0) | |
| 5224 | S DIC("S" )="I $S('$ $GET1^DIQ( 50,+Y,100, ""I""):1,D T'>$$GET1^ DIQ(50,+Y, 100,""I"") :1,1:0),$S ($$GET1^DI Q(50,+Y,63 ,""I"")'[" "O"":0,1:1 )" ;,$D( ^PSDRUG("" ASP"",+$G( ^(2)),+Y)) " | |
| 5225 | "RTN","PSO DRG",44,0) | |
| 5226 | D MIX^DIC 1 K DIC,D | |
| 5227 | "RTN","PSO DRG",45,0) | |
| 5228 | I $D(DTOU T) S PSONE W("DFLG")= 1 G SELECT X | |
| 5229 | "RTN","PSO DRG",46,0) | |
| 5230 | I $D(DUOU T) K DUOUT G SELECT | |
| 5231 | "RTN","PSO DRG",47,0) | |
| 5232 | I Y<0 G S ELECT | |
| 5233 | "RTN","PSO DRG",48,0) | |
| 5234 | S:$G(PSON EW("OLD VA L"))=+Y&(' $G(PSOEDIT )) PSODRG( "QFLG")=1 | |
| 5235 | "RTN","PSO DRG",49,0) | |
| 5236 | K PSOY S PSOY=Y,PSO Y(0)=Y(0) | |
| 5237 | "RTN","PSO DRG",50,0) | |
| 5238 | I $P(PSOY (0),"^")=" OTHER DRUG "!($P(PSOY (0),"^")=" OUTSIDE DR UG") D TRA DE | |
| 5239 | "RTN","PSO DRG",51,0) | |
| 5240 | SELECTX K X,Y,DTOUT, DUOUT,PSON EW("OLD VA L") | |
| 5241 | "RTN","PSO DRG",52,0) | |
| 5242 | Q | |
| 5243 | "RTN","PSO DRG",53,0) | |
| 5244 | ; | |
| 5245 | "RTN","PSO DRG",54,0) | |
| 5246 | NDC(RX,RFL ,DRG,NDC) ; Editing NDC for Re leased Rx' s or for U nresolved ECME Rejec ts | |
| 5247 | "RTN","PSO DRG",55,0) | |
| 5248 | S NDC=$S( $G(NDC)'=" ":$G(NDC), 1:$$GETNDC ^PSONDCUT( RX,.RFL)) | |
| 5249 | "RTN","PSO DRG",56,0) | |
| 5250 | ; Check i f we shoul d edit the NDC | |
| 5251 | "RTN","PSO DRG",57,0) | |
| 5252 | ; Needs t o be relea sed or hav e unresolv ed billabl e rejects (PSO*7*427 ) | |
| 5253 | "RTN","PSO DRG",58,0) | |
| 5254 | ; | |
| 5255 | "RTN","PSO DRG",59,0) | |
| 5256 | N PSOCONT S PSOCONT =0 ; c ontinue fl ag | |
| 5257 | "RTN","PSO DRG",60,0) | |
| 5258 | D Q:'PSO CONT ; g et out if NDC edit n ot allowed | |
| 5259 | "RTN","PSO DRG",61,0) | |
| 5260 | . I $$RXR LDT^PSOBPS UT(RX,RFL) S PSOCONT =1 Q ; R eleased - continue a nd allow e dit | |
| 5261 | "RTN","PSO DRG",62,0) | |
| 5262 | . I $$FIN D^PSOREJUT (RX,RFL),$ $STATUS^PS OBPSUT(RX, RFL)'="" S PSOCONT=1 Q ; un released w /unresolve d billable rejection s | |
| 5263 | "RTN","PSO DRG",63,0) | |
| 5264 | . Q | |
| 5265 | "RTN","PSO DRG",64,0) | |
| 5266 | ; | |
| 5267 | "RTN","PSO DRG",65,0) | |
| 5268 | S NDC=$S( $G(NDC)'=" ":$G(NDC), 1:$$GETNDC ^PSONDCUT( RX,.RFL)) | |
| 5269 | "RTN","PSO DRG",66,0) | |
| 5270 | D NDCEDT^ PSONDCUT(R X,.RFL,$G( DRG),$G(PS OSITE),.ND C) | |
| 5271 | "RTN","PSO DRG",67,0) | |
| 5272 | Q | |
| 5273 | "RTN","PSO DRG",68,0) | |
| 5274 | ; | |
| 5275 | "RTN","PSO DRG",69,0) | |
| 5276 | TRADE ; | |
| 5277 | "RTN","PSO DRG",70,0) | |
| 5278 | K DIR,DIC ,DA,X,Y | |
| 5279 | "RTN","PSO DRG",71,0) | |
| 5280 | S DIR(0)= "52,6.5" S :$G(PSOTRN )]"" DIR(" B")=$G(PSO TRN) D ^DI R K DIR,DI C | |
| 5281 | "RTN","PSO DRG",72,0) | |
| 5282 | I X="@" S Y=X K DIR UT | |
| 5283 | "RTN","PSO DRG",73,0) | |
| 5284 | I $D(DIRU T) S:$D(DU OUT)!$D(DT OUT)&('$D( PSORX("EDI T"))) PSON EW("DFLG") =1 G TRADE X | |
| 5285 | "RTN","PSO DRG",74,0) | |
| 5286 | S PSODRUG ("TRADE NA ME")=Y | |
| 5287 | "RTN","PSO DRG",75,0) | |
| 5288 | TRADEX I $ G(PSORXED( "DFLG")),$ D(DIRUT) S PSORXED(" DFLG")=1 | |
| 5289 | "RTN","PSO DRG",76,0) | |
| 5290 | K DIRUT,D TOUT,DUOUT ,X,Y,DA,DR ,DIE | |
| 5291 | "RTN","PSO DRG",77,0) | |
| 5292 | Q | |
| 5293 | "RTN","PSO DRG",78,0) | |
| 5294 | SET ; | |
| 5295 | "RTN","PSO DRG",79,0) | |
| 5296 | N STAT S PSODRUG("I EN")=+PSOY ,PSODRUG(" VA CLASS") =$P(PSOY(0 ),"^",2) | |
| 5297 | "RTN","PSO DRG",80,0) | |
| 5298 | S PSODRUG ("NAME")=$ P(PSOY(0), "^") | |
| 5299 | "RTN","PSO DRG",81,0) | |
| 5300 | S:$$GET1^ DIQ(50,+PS OY,2.1,"I" ) PSODRUG( "OI")=$$GE T1^DIQ(50, +PSOY,2.1, "I"),PSODR UG("OIN")= $$GET1^DIQ (50,+PSOY, 2.1) | |
| 5301 | "RTN","PSO DRG",82,0) | |
| 5302 | S PSODRUG ("NDF")=$S ($$GET1^DI Q(50,+PSOY ,20,"I"):$ $GET1^DIQ( 50,+PSOY,2 0,"I")_"A" _$$GET1^DI Q(50,+PSOY ,22,"I"),1 :0) | |
| 5303 | "RTN","PSO DRG",83,0) | |
| 5304 | S PSODRUG ("MAXDOSE" )=$P(PSOY( 0),"^",4), PSODRUG("D EA")=$P(PS OY(0),"^", 3) | |
| 5305 | "RTN","PSO DRG",84,0) | |
| 5306 | S PSODRUG ("CLN")=$S ($$GET1^DI Q(50,+PSOY ,20,"I"):$ $GET1^DIQ( 50,+PSOY,2 5,"I"),1:0 ) | |
| 5307 | "RTN","PSO DRG",85,0) | |
| 5308 | S PSODRUG ("SIG")=$P (PSOY(0)," ^",5) | |
| 5309 | "RTN","PSO DRG",86,0) | |
| 5310 | I $G(PSOD RUG("NDC") )="" S PSO DRUG("NDC" )=$$GETNDC ^PSSNDCUT( +PSOY,$G(P SOSITE)) | |
| 5311 | "RTN","PSO DRG",87,0) | |
| 5312 | S PSODRUG ("DAW")=+$ $GET1^DIQ( 50,+PSOY,8 1) | |
| 5313 | "RTN","PSO DRG",88,0) | |
| 5314 | S PSODRUG ("STKLVL") =$$GET1^DI Q(50,+PSOY ,50) | |
| 5315 | "RTN","PSO DRG",89,0) | |
| 5316 | G:'$$GET1 ^DIQ(50,+P SOY,11) SE TX | |
| 5317 | "RTN","PSO DRG",90,0) | |
| 5318 | S PSOX1=$ G(^PSDRUG( +PSOY,660) ) | |
| 5319 | "RTN","PSO DRG",91,0) | |
| 5320 | S PSODRUG ("COST")=$ $GET1^DIQ( 50,+PSOY,1 5) | |
| 5321 | "RTN","PSO DRG",92,0) | |
| 5322 | S PSODRUG ("UNIT")=$ $GET1^DIQ( 50,+PSOY,1 4.5) | |
| 5323 | "RTN","PSO DRG",93,0) | |
| 5324 | S PSODRUG ("EXPIRATI ON DATE")= $$GET1^DIQ (50,+PSOY, 17.1,"I") | |
| 5325 | "RTN","PSO DRG",94,0) | |
| 5326 | SETX K PSO X1,PSOY | |
| 5327 | "RTN","PSO DRG",95,0) | |
| 5328 | Q | |
| 5329 | "RTN","PSO DRG",96,0) | |
| 5330 | NFI ;displ ay restric tion/guide lines | |
| 5331 | "RTN","PSO DRG",97,0) | |
| 5332 | D EN^PSSD IN(PSODRUG ("OI"),PSO DRUG("IEN" )) S NFI=$ $PROMPT^PS SDIN | |
| 5333 | "RTN","PSO DRG",98,0) | |
| 5334 | I NFI]"", "ODY"[NFI D TD^PSONF I | |
| 5335 | "RTN","PSO DRG",99,0) | |
| 5336 | K NFI Q | |
| 5337 | "RTN","PSO DRG",100,0 ) | |
| 5338 | POST ;orde r checks | |
| 5339 | "RTN","PSO DRG",101,0 ) | |
| 5340 | N LIST S LIST="PSOP EPS" | |
| 5341 | "RTN","PSO DRG",102,0 ) | |
| 5342 | K PSODOSD ,^TMP("PSO RXDC",$J), ^TMP($J,LI ST),^TMP(" PSODAOC",$ J) | |
| 5343 | "RTN","PSO DRG",103,0 ) | |
| 5344 | K ZDGDG,Z THER,IT,PS ODLQT,PSOD OSD | |
| 5345 | "RTN","PSO DRG",104,0 ) | |
| 5346 | I $D(^XTM P("ORRDI", "OUTAGE IN FO","DOWN" )) S ^TMP( "PSODAOC", $J,"NORDI" ,1,0)="Rem ote data n ot availab le - Only local orde r checks p rocessed." | |
| 5347 | "RTN","PSO DRG",105,0 ) | |
| 5348 | S ^TMP($J ,LIST,"IN" ,"PING")=" " D IN^PSS HRQ2(LIST) | |
| 5349 | "RTN","PSO DRG",106,0 ) | |
| 5350 | K DIR I $ P(^TMP($J, LIST,"OUT" ,0),"^")=- 1 D | |
| 5351 | "RTN","PSO DRG",107,0 ) | |
| 5352 | .D DATACK ^PSODDPRE | |
| 5353 | "RTN","PSO DRG",108,0 ) | |
| 5354 | .S ^TMP(" PSODAOC",$ J,"NOSYS", 1,0)="No E nhanced Or der Checks can be pe rformed. R eason(s): "_$P($G(^T MP($J,LIST ,"OUT",0)) ,"^",2) | |
| 5355 | "RTN","PSO DRG",109,0 ) | |
| 5356 | K ^TMP($J ,LIST,"IN" ),^TMP($J, LIST,"OUT" ,"EXCEPTIO NS") | |
| 5357 | "RTN","PSO DRG",110,0 ) | |
| 5358 | G:$G(PSOR X("DFLG")) !($G(PSORX ED("DFLG") )) POSTX | |
| 5359 | "RTN","PSO DRG",111,0 ) | |
| 5360 | K PSORX(" INTERVENE" ),PSOQUIT N STAT,SIG ,PTR,NDF,V AP S PSORX ("DFLG")=0 | |
| 5361 | "RTN","PSO DRG",112,0 ) | |
| 5362 | W !! D HD ^PSODDPR2( ):(($Y+5)' >IOSL) | |
| 5363 | "RTN","PSO DRG",113,0 ) | |
| 5364 | D ^PSOBUI LD | |
| 5365 | "RTN","PSO DRG",114,0 ) | |
| 5366 | D:'$D(PSO DGCK) @$S( $G(COPY):" ^PSOCPPRE" ,1:"^PSODD PRE") ; Du plicate dr ug check | |
| 5367 | "RTN","PSO DRG",115,0 ) | |
| 5368 | G:$G(PSOR X("DFLG")) POSTX | |
| 5369 | "RTN","PSO DRG",116,0 ) | |
| 5370 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5371 | "RTN","PSO DRG",117,0 ) | |
| 5372 | I $$GET1^ DIQ(50,+$G (PSODRUG(" IEN")),17. 5)="PSOCLO 1" D CLOZ | |
| 5373 | "RTN","PSO DRG",118,0 ) | |
| 5374 | G:PSORX(" DFLG") POS TX | |
| 5375 | "RTN","PSO DRG",119,0 ) | |
| 5376 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5377 | "RTN","PSO DRG",120,0 ) | |
| 5378 | W !,"Now doing alle rgy checks . Please wait...",! H 1 | |
| 5379 | "RTN","PSO DRG",121,0 ) | |
| 5380 | S PSONOAL ="" D ALLE RGY^PSOORU T2 D:PSONO AL'="" NOA LRGY K PSO NOAL | |
| 5381 | "RTN","PSO DRG",122,0 ) | |
| 5382 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5383 | "RTN","PSO DRG",123,0 ) | |
| 5384 | I '$G(PSO DGCKX) D ^ PSODGAL1 K PSORX("IN TERVENE") | |
| 5385 | "RTN","PSO DRG",124,0 ) | |
| 5386 | G:PSORX(" DFLG")!$G( PSOQUIT) P OSTX | |
| 5387 | "RTN","PSO DRG",125,0 ) | |
| 5388 | ;This is the allerg y check fo r profile drugs CK a ction | |
| 5389 | "RTN","PSO DRG",126,0 ) | |
| 5390 | I $D(PSOD GCK),$D(PS OSD) D PRF LP^PSOUTL | |
| 5391 | "RTN","PSO DRG",127,0 ) | |
| 5392 | G:$G(PSOR X("DFLG")) POSTX ;ps o*7*412 | |
| 5393 | "RTN","PSO DRG",128,0 ) | |
| 5394 | G:$G(PSOS PRNW)&($G( PSORENW("D FLG"))) PO STX ;speed renew | |
| 5395 | "RTN","PSO DRG",129,0 ) | |
| 5396 | ;aminogly coside | |
| 5397 | "RTN","PSO DRG",130,0 ) | |
| 5398 | N AOC,CRO CPFLG S CR OCPFLG=0 | |
| 5399 | "RTN","PSO DRG",131,0 ) | |
| 5400 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5401 | "RTN","PSO DRG",132,0 ) | |
| 5402 | S AOC=$$A OC^OROCAPI (PSODFN,$P (PSODRUG(" NDF"),"A", 2)) I $P(A OC,"^",4)] "" D | |
| 5403 | "RTN","PSO DRG",133,0 ) | |
| 5404 | .S CROCPF LG=1 | |
| 5405 | "RTN","PSO DRG",134,0 ) | |
| 5406 | .W !!,"** *Aminoglyc oside Orde red***",!! | |
| 5407 | "RTN","PSO DRG",135,0 ) | |
| 5408 | .K ^UTILI TY($J,"W") S DIWL=1, DIWR=78,DI WF="" S X= $P(AOC,"^" ,4) D ^DIW P | |
| 5409 | "RTN","PSO DRG",136,0 ) | |
| 5410 | .W ! F ZX =0:0 S ZX= $O(^UTILIT Y($J,"W",1 ,ZX)) Q:'Z X W ?2,^U TILITY($J, "W",1,ZX,0 ),! D HD^P SODDPR2(): (($Y+5)'>I OSL) | |
| 5411 | "RTN","PSO DRG",137,0 ) | |
| 5412 | .K ^UTILI TY($J,"W") | |
| 5413 | "RTN","PSO DRG",138,0 ) | |
| 5414 | .S ^TMP(" PSODAOC",$ J,"CPRS",$ P(AOC,"^", 2),0)=PSOD RUG("IEN") _"^"_$P(AO C,"^",4) | |
| 5415 | "RTN","PSO DRG",139,0 ) | |
| 5416 | .W ! | |
| 5417 | "RTN","PSO DRG",140,0 ) | |
| 5418 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5419 | "RTN","PSO DRG",141,0 ) | |
| 5420 | ;dangerou s meds for pat >64 | |
| 5421 | "RTN","PSO DRG",142,0 ) | |
| 5422 | I $G(PSOD RUG("OI")) D | |
| 5423 | "RTN","PSO DRG",143,0 ) | |
| 5424 | .N OI,OIR S OI=$$OI TM^ORX8(PS ODRUG("OI" ),"99PSP") Q:'OI | |
| 5425 | "RTN","PSO DRG",144,0 ) | |
| 5426 | .S OIR=$$ DOC^OROCAP I(PSODFN,O I) I $P(OI R,"^",4)]" " D | |
| 5427 | "RTN","PSO DRG",145,0 ) | |
| 5428 | ..S CROCP FLG=1 | |
| 5429 | "RTN","PSO DRG",146,0 ) | |
| 5430 | ..D HD^PS ODDPR2():( ($Y+5)'>IO SL) W !!," ***Dangero us Meds fo r Patient >64***",!! S DFN=PSO DFN D DEM^ VADPT | |
| 5431 | "RTN","PSO DRG",147,0 ) | |
| 5432 | ..K ^UTIL ITY($J,"W" ) S DIWL=1 ,DIWR=78,D IWF="" S X =$P(OIR,"^ ",4) D ^DI WP | |
| 5433 | "RTN","PSO DRG",148,0 ) | |
| 5434 | ..F ZX=0: 0 S ZX=$O( ^UTILITY($ J,"W",1,ZX )) Q:'ZX W ?2,^UTIL ITY($J,"W" ,1,ZX,0),! D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5435 | "RTN","PSO DRG",149,0 ) | |
| 5436 | ..K ^UTIL ITY($J,"W" ) | |
| 5437 | "RTN","PSO DRG",150,0 ) | |
| 5438 | ..S ^TMP( "PSODAOC", $J,"CPRS", $P(OIR,"^" ,2),0)=PSO DRUG("IEN" )_"^"_$P(O IR,"^",4) | |
| 5439 | "RTN","PSO DRG",151,0 ) | |
| 5440 | ..W ! | |
| 5441 | "RTN","PSO DRG",152,0 ) | |
| 5442 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5443 | "RTN","PSO DRG",153,0 ) | |
| 5444 | ;metformi n lab resu lts | |
| 5445 | "RTN","PSO DRG",154,0 ) | |
| 5446 | N GOC S G OC=$$GOC^O ROCAPI(PSO DFN,PSODRU G("NAME")) I $P(GOC, "^",4)]"" D | |
| 5447 | "RTN","PSO DRG",155,0 ) | |
| 5448 | .S CROCPF LG=1 | |
| 5449 | "RTN","PSO DRG",156,0 ) | |
| 5450 | .W !!,"** *Metformin Lab Resul ts***",!! | |
| 5451 | "RTN","PSO DRG",157,0 ) | |
| 5452 | .K ^UTILI TY($J,"W") S DIWL=1, DIWR=78,DI WF="" S X= $P(GOC,"^" ,4) D ^DIW P | |
| 5453 | "RTN","PSO DRG",158,0 ) | |
| 5454 | .F ZX=0:0 S ZX=$O(^ UTILITY($J ,"W",1,ZX) ) Q:'ZX W ?2,^UTILI TY($J,"W", 1,ZX,0),! D HD^PSODD PR2():(($Y +5)'>IOSL) | |
| 5455 | "RTN","PSO DRG",159,0 ) | |
| 5456 | .K ^UTILI TY($J,"W") | |
| 5457 | "RTN","PSO DRG",160,0 ) | |
| 5458 | .S ^TMP(" PSODAOC",$ J,"CPRS",$ P(GOC,"^", 2),0)=PSOD RUG("IEN") _"^"_$P(GO C,"^",4) | |
| 5459 | "RTN","PSO DRG",161,0 ) | |
| 5460 | .W ! | |
| 5461 | "RTN","PSO DRG",162,0 ) | |
| 5462 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5463 | "RTN","PSO DRG",163,0 ) | |
| 5464 | ;clinical reminder oc | |
| 5465 | "RTN","PSO DRG",164,0 ) | |
| 5466 | D:'$G(PSO NCROC) CK^ PSOCROC K CROCPFLG I $G(PSORX( "DFLG")) Q | |
| 5467 | "RTN","PSO DRG",165,0 ) | |
| 5468 | K DIWF,DI WL,DIWR,ZX ,DFN,CROCP FLG | |
| 5469 | "RTN","PSO DRG",166,0 ) | |
| 5470 | I $G(PSOD RUG("DEA") )["S"!($E( $G(PSODRUG ("VA CLASS ")),1,2)=" XA"),'$G(P SODGCK) D G POSTX ; stops if d rug is sup ply | |
| 5471 | "RTN","PSO DRG",167,0 ) | |
| 5472 | .W !,"Now Processin g Enhanced Order Che cks! Plea se wait... ",! H 1 | |
| 5473 | "RTN","PSO DRG",168,0 ) | |
| 5474 | ;enhanced OC | |
| 5475 | "RTN","PSO DRG",169,0 ) | |
| 5476 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5477 | "RTN","PSO DRG",170,0 ) | |
| 5478 | W ! D @$S ($G(COPY): "OBX^PSOCP PRE",1:"OB X^PSODDPRE ") ; Set P SORX("DFLG ")=1 if pr ocess to s top new en hanced ord er checks | |
| 5479 | "RTN","PSO DRG",171,0 ) | |
| 5480 | POSTX ; | |
| 5481 | "RTN","PSO DRG",172,0 ) | |
| 5482 | K IT,^TMP ($J,"DI"), PSORX("INT ERVENE"),D A,^TMP($J, "PSODRDI") ,ZDGDG,ZTH ER,^TMP($J ,"DI"_PSOD FN),PSZZQU IT | |
| 5483 | "RTN","PSO DRG",173,0 ) | |
| 5484 | I '$G(PSO RXED),'$G( PSOREINS) K PSOQUIT | |
| 5485 | "RTN","PSO DRG",174,0 ) | |
| 5486 | Q | |
| 5487 | "RTN","PSO DRG",175,0 ) | |
| 5488 | ; | |
| 5489 | "RTN","PSO DRG",176,0 ) | |
| 5490 | EOJ ; | |
| 5491 | "RTN","PSO DRG",177,0 ) | |
| 5492 | K PSODRG | |
| 5493 | "RTN","PSO DRG",178,0 ) | |
| 5494 | Q | |
| 5495 | "RTN","PSO DRG",179,0 ) | |
| 5496 | WAIT ; | |
| 5497 | "RTN","PSO DRG",180,0 ) | |
| 5498 | K DIR S D IR(0)="E", DIR("?")=" Press Retu rn to cont inue",DIR( "A")="Pres s Return t o continue ..." W ! | |
| 5499 | "RTN","PSO DRG",181,0 ) | |
| 5500 | D ^DIR K DIRUT,DUOU T,DIR,X,Y | |
| 5501 | "RTN","PSO DRG",182,0 ) | |
| 5502 | Q | |
| 5503 | "RTN","PSO DRG",183,0 ) | |
| 5504 | ; | |
| 5505 | "RTN","PSO DRG",184,0 ) | |
| 5506 | CLOZ ; | |
| 5507 | "RTN","PSO DRG",185,0 ) | |
| 5508 | S ANQRTN= $$GET1^DIQ (50,+$G(PS ODRUG("IEN ")),17.5), ANQX=0 | |
| 5509 | "RTN","PSO DRG",186,0 ) | |
| 5510 | S P(5)=PS ODRUG("IEN "),DFN=PSO DFN,X=ANQR TN | |
| 5511 | "RTN","PSO DRG",187,0 ) | |
| 5512 | X ^%ZOSF( "TEST") I D ^PSOCLO 1 S:$G(ANQ X) PSORX(" DFLG")=1 | |
| 5513 | "RTN","PSO DRG",188,0 ) | |
| 5514 | K P(5),AN QRTN,ANQX, X,DFN | |
| 5515 | "RTN","PSO DRG",189,0 ) | |
| 5516 | Q | |
| 5517 | "RTN","PSO DRG",190,0 ) | |
| 5518 | ; | |
| 5519 | "RTN","PSO DRG",191,0 ) | |
| 5520 | EN(DRG) ;r eturns lab test iden tified for clozapine order che cking | |
| 5521 | "RTN","PSO DRG",192,0 ) | |
| 5522 | K LAB I $ $GET1^DIQ( 50,+$G(DRG ),17.5)'=" PSOCLO1" S LAB("NOT" )=0 Q | |
| 5523 | "RTN","PSO DRG",193,0 ) | |
| 5524 | N LABARR D LIST^DIC (50.02,"," _DRG_","," 2;3","I",, ,,,,,"LABA RR") | |
| 5525 | "RTN","PSO DRG",194,0 ) | |
| 5526 | I +LABARR ("DILIST", 0)'=2 S LA B("BAD TES T")=0 K CN T Q | |
| 5527 | "RTN","PSO DRG",195,0 ) | |
| 5528 | K CNT F I =1:1 Q:'$D (LABARR("D ILIST",2,I )) D | |
| 5529 | "RTN","PSO DRG",196,0 ) | |
| 5530 | .S LABT=$ S(LABARR(" DILIST","I D",I,3)=1: "WBC",1:"A NC") | |
| 5531 | "RTN","PSO DRG",197,0 ) | |
| 5532 | .S LAB(LA BT)=LABARR ("DILIST", 1,I)_"^"_L ABARR("DIL IST","ID", I,2)_"^"_L ABARR("DIL IST","ID", I,3) | |
| 5533 | "RTN","PSO DRG",198,0 ) | |
| 5534 | K LABT,I | |
| 5535 | "RTN","PSO DRG",199,0 ) | |
| 5536 | Q | |
| 5537 | "RTN","PSO DRG",200,0 ) | |
| 5538 | NOALRGY ; | |
| 5539 | "RTN","PSO DRG",201,0 ) | |
| 5540 | D HD^PSOD DPR2():(($ Y+5)'>IOSL ) | |
| 5541 | "RTN","PSO DRG",202,0 ) | |
| 5542 | N DIR S D IR(0)="SA^ 1:YES;0:NO " | |
| 5543 | "RTN","PSO DRG",203,0 ) | |
| 5544 | I $D(^TMP ($J,"PSOIN TERVENE",+ PSODFN)) D Q | |
| 5545 | "RTN","PSO DRG",204,0 ) | |
| 5546 | .S DIR("A ")="No All ergy Asses sment - Do you want to duplica te Interve ntion?: ", DIR("B")=" Yes" | |
| 5547 | "RTN","PSO DRG",205,0 ) | |
| 5548 | .D ^DIR | |
| 5549 | "RTN","PSO DRG",206,0 ) | |
| 5550 | .I 'Y D Q | |
| 5551 | "RTN","PSO DRG",207,0 ) | |
| 5552 | ..I Y=0 D ^PSORXI Q | |
| 5553 | "RTN","PSO DRG",208,0 ) | |
| 5554 | ..S PSORX ("DFLG")=1 | |
| 5555 | "RTN","PSO DRG",209,0 ) | |
| 5556 | .D DUPINV ^PSORXI | |
| 5557 | "RTN","PSO DRG",210,0 ) | |
| 5558 | W $C(7),! ,"There is no allerg y assessme nt on file for this patient." | |
| 5559 | "RTN","PSO DRG",211,0 ) | |
| 5560 | W !,"You will be pr ompted to intervene if you con tinue with this pres cription" | |
| 5561 | "RTN","PSO DRG",212,0 ) | |
| 5562 | I $D(PSOD GCK) W ! K DIR S DIR (0)="E",DI R("A")="Pr ess Return to Contin ue..." D ^ DIR K DIR | |
| 5563 | "RTN","PSO DRG",213,0 ) | |
| 5564 | Q:$D(PSOD GCK) | |
| 5565 | "RTN","PSO DRG",214,0 ) | |
| 5566 | N DUOUT,D TOUT,RXIEN ,RXSTA ;*398 | |
| 5567 | "RTN","PSO DRG",215,0 ) | |
| 5568 | S DIR("A" )="Do you want to Co ntinue?: " ,DIR("B")= "N" D ^DIR | |
| 5569 | "RTN","PSO DRG",216,0 ) | |
| 5570 | I 'Y!($D( DUOUT))!($ D(DTOUT)) D Q ;*398 - E xit/Timeou t | |
| 5571 | "RTN","PSO DRG",217,0 ) | |
| 5572 | .I $D(PSO NV) S PSZZ QUIT=1 Q | |
| 5573 | "RTN","PSO DRG",218,0 ) | |
| 5574 | .S PSORX( "DFLG")=1 | |
| 5575 | "RTN","PSO DRG",219,0 ) | |
| 5576 | .I '$O(PS CAN(0)) Q ;*398 - A rray has R x IEN | |
| 5577 | "RTN","PSO DRG",220,0 ) | |
| 5578 | .I $G(REA )'="R" Q ;*398 - R einstate o nly | |
| 5579 | "RTN","PSO DRG",221,0 ) | |
| 5580 | .S RXIEN= +$G(PSCAN( RX)) I 'RX IEN Q ;*398 - G et Rx IEN | |
| 5581 | "RTN","PSO DRG",222,0 ) | |
| 5582 | .S RXSTA= $$GET1^DIQ (52,RXIEN, 100,"I") ;*398 - G et status | |
| 5583 | "RTN","PSO DRG",223,0 ) | |
| 5584 | .I RXSTA= 12 Q ;*398 - C orrect sta tus | |
| 5585 | "RTN","PSO DRG",224,0 ) | |
| 5586 | .S DIE="^ PSRX(",DA= RXIEN,DR=" 100///12" ;*398 - D iscontinue d | |
| 5587 | "RTN","PSO DRG",225,0 ) | |
| 5588 | .D ^DIE ;*398 - U pdate Rx f ile | |
| 5589 | "RTN","PSO DRG",226,0 ) | |
| 5590 | I $D(PSON V) S PSORX ("INTERVEN E")=0 D EN 1^PSORXI(P SONV) Q | |
| 5591 | "RTN","PSO DRG",227,0 ) | |
| 5592 | D ^PSORXI | |
| 5593 | "RTN","PSO DRG",228,0 ) | |
| 5594 | Q | |
| 5595 | "RTN","PSO N52") | |
| 5596 | 0^3^B10947 5574 | |
| 5597 | "RTN","PSO N52",1,0) | |
| 5598 | PSON52 ;BI R/DSD - fi les new en tries in p rescriptio n file ;Ju l 24, 2017 @15:24 | |
| 5599 | "RTN","PSO N52",2,0) | |
| 5600 | ;;7.0;OUT PATIENT PH ARMACY;**1 ,16,23,27, 32,46,71,1 11,124,117 ,131,139,1 57,143,219 ,148,239,2 01,268,260 ,225,303,3 58,251,387 ,379,390,3 91,313,408 ,473,457** ;DEC 1997; Build 65 | |
| 5601 | "RTN","PSO N52",3,0) | |
| 5602 | ;External reference ^PS(55 su pported by DBIA 2228 | |
| 5603 | "RTN","PSO N52",4,0) | |
| 5604 | ;External reference to PSOUL^ PSSLOCK su pported by DBIA 2789 | |
| 5605 | "RTN","PSO N52",5,0) | |
| 5606 | ;External reference to ^XUSEC supported by DBIA 1 0076 | |
| 5607 | "RTN","PSO N52",6,0) | |
| 5608 | ;External reference SWSTAT^IB BAPI suppo rted by DB IA 4663 | |
| 5609 | "RTN","PSO N52",7,0) | |
| 5610 | ;External reference SAVNDC^PS SNDCUT sup ported by DBIA 4707 | |
| 5611 | "RTN","PSO N52",8,0) | |
| 5612 | ;External reference to $$DS^P SSDSAPI su pported by DBIA 5425 | |
| 5613 | "RTN","PSO N52",9,0) | |
| 5614 | EN(PSOX) ; Entry Poin t | |
| 5615 | "RTN","PSO N52",10,0) | |
| 5616 | START ; | |
| 5617 | "RTN","PSO N52",11,0) | |
| 5618 | D:$D(XRTL ) T0^%ZOSV ; Start R T Monitor | |
| 5619 | "RTN","PSO N52",12,0) | |
| 5620 | D INIT G: PSON52("QF LG") END D NFILE Q:$ G(PSONEW(" DFLG")) | |
| 5621 | "RTN","PSO N52",13,0) | |
| 5622 | D PS55,DI K | |
| 5623 | "RTN","PSO N52",14,0) | |
| 5624 | S:$D(XRT0 ) XRTN=$T( +0) D:$D(X RT0) T1^%Z OSV ; Stop RT Monito r | |
| 5625 | "RTN","PSO N52",15,0) | |
| 5626 | D FINISH | |
| 5627 | "RTN","PSO N52",16,0) | |
| 5628 | I $P(^PSR X(PSOX("IR XN"),0),"^ ",11)="W", $G(^("IB") ) S ^PSRX( "ACP",$P(^ PSRX(PSOX( "IRXN"),0) ,"^",2),$P (^(2),"^", 2),0,PSOX( "IRXN"))=" " | |
| 5629 | "RTN","PSO N52",17,0) | |
| 5630 | END D EOJ | |
| 5631 | "RTN","PSO N52",18,0) | |
| 5632 | Q | |
| 5633 | "RTN","PSO N52",19,0) | |
| 5634 | INIT ; | |
| 5635 | "RTN","PSO N52",20,0) | |
| 5636 | K X,%DT S :$G(PSOID) PSOX("ISS UE DATE")= PSOID | |
| 5637 | "RTN","PSO N52",21,0) | |
| 5638 | S PSOX("C S")=0 K PS OX("NOPSDR PH") | |
| 5639 | "RTN","PSO N52",22,0) | |
| 5640 | F DEA=1:1 Q:$E(PSOD RUG("DEA") ,DEA)="" I $E(+PSOD RUG("DEA") ,DEA)>1,$E (+PSODRUG( "DEA"),DEA )<6 S $P(P SOX("CS"), "^")=1 S:$ E(+PSODRUG ("DEA"),DE A)=2 $P(PS OX("CS")," ^",2)=1 | |
| 5641 | "RTN","PSO N52",23,0) | |
| 5642 | I $P($G(P SOX("CS")) ,"^"),'$D( ^XUSEC("PS DRPH",DUZ) ) S PSOX(" NOPSDRPH") =1 | |
| 5643 | "RTN","PSO N52",24,0) | |
| 5644 | S PSON52( "QFLG")=0, X1=PSOX("I SSUE DATE" ),X2=PSOX( "DAYS SUPP LY")*(PSOX ("# OF REF ILLS")+1)\ 1 | |
| 5645 | "RTN","PSO N52",25,0) | |
| 5646 | I $D(CLOZ PAT) S X2= $S(X2=14:1 4,X2=7:7,1 :X2) G DT | |
| 5647 | "RTN","PSO N52",26,0) | |
| 5648 | S X2=$S(P SOX("DAYS SUPPLY")=X 2:X2,+$G(P SOX("CS")) :184,+$G(D EA("CS")): 184,1:366) | |
| 5649 | "RTN","PSO N52",27,0) | |
| 5650 | I X2<30 D | |
| 5651 | "RTN","PSO N52",28,0) | |
| 5652 | . N % S % =$P($G(PSO RX("PATIEN T STATUS") ),"^"),X2= 30 | |
| 5653 | "RTN","PSO N52",29,0) | |
| 5654 | . S:%?.N %=$P($G(^P S(53,+%,0) ),"^") I % ["AUTH ABS " S X2=5 | |
| 5655 | "RTN","PSO N52",30,0) | |
| 5656 | DT D C^%DT C S PSOX(" STOP DATE" )=$P(X,"." ) K X | |
| 5657 | "RTN","PSO N52",31,0) | |
| 5658 | ;*473 - I f Calculat ed Exp. Da te < Fill Date with No refills , reset Ex p. | |
| 5659 | "RTN","PSO N52",32,0) | |
| 5660 | I '$D(CLO ZPAT),'PSO X("# OF RE FILLS"),PS OX("FILL D ATE")>PSOX ("STOP DAT E") D | |
| 5661 | "RTN","PSO N52",33,0) | |
| 5662 | . N EXP S EXP=$$FMA DD^XLFDT(P SOX("FILL DATE"),PSO X("DAYS SU PPLY")) | |
| 5663 | "RTN","PSO N52",34,0) | |
| 5664 | . I $$FMD IFF^XLFDT( EXP,PSOX(" ISSUE DATE "))>$S(+$G (PSOX("CS" )):184,1:3 66) D | |
| 5665 | "RTN","PSO N52",35,0) | |
| 5666 | . . S EXP =$$FMADD^X LFDT(PSOX( "ISSUE DAT E"),$S(+$G (PSOX("CS" )):184,1:3 66)) | |
| 5667 | "RTN","PSO N52",36,0) | |
| 5668 | . I EXP<P SOX("FILL DATE") S E XP=PSOX("F ILL DATE") | |
| 5669 | "RTN","PSO N52",37,0) | |
| 5670 | . S PSOX( "STOP DATE ")=EXP | |
| 5671 | "RTN","PSO N52",38,0) | |
| 5672 | ; Titrati on to Main tenance Rx Conversio n - Set Ma int. Rx Ex p. Date = Original R x Exp. Dat e | |
| 5673 | "RTN","PSO N52",39,0) | |
| 5674 | I $G(PSOT ITRX) D | |
| 5675 | "RTN","PSO N52",40,0) | |
| 5676 | . S PSOX( "STOP DATE ")=$$GET1^ DIQ(52,PSO TITRX,26," I") | |
| 5677 | "RTN","PSO N52",41,0) | |
| 5678 | I PSOX("# OF REFILL S")>0 S X1 =PSOX("FIL L DATE"),X 2=$S((PSOX ("DAYS SUP PLY")-10\1 )<1:1,1:PS OX("DAYS S UPPLY")-10 \1) D C^%D TC S PSOX( "NEXT POSS IBLE REFIL L")=$P(X," .") K X | |
| 5679 | "RTN","PSO N52",42,0) | |
| 5680 | S PSOX("T YPE OF RX" )=0,PSOX(" DISPENSED DATE")=PSO X("FILL DA TE") D NOW ^%DTC S PS OX("LOGIN DATE")=$S( $P($G(OR0) ,"^",12):$ P($G(OR0), "^",12),1: %) K %,X | |
| 5681 | "RTN","PSO N52",43,0) | |
| 5682 | S PSOX("S TATUS")=$S ($G(PSOX(" STATUS"))] "":PSOX("S TATUS"),$D (PSORX("VE RIFY")):1, $D(PSOX("N OPSDRPH")) :1,1:0) | |
| 5683 | "RTN","PSO N52",44,0) | |
| 5684 | S PSOX("C OPIES")=$S ($G(PSOX(" COPIES"))] "":PSOX("C OPIES"),1: 1) | |
| 5685 | "RTN","PSO N52",45,0) | |
| 5686 | I $G(PSOR X("PHARM") )]"" S PSO X("PHARMAC IST")=PSOR X("PHARM") K PSORX(" PHARM") | |
| 5687 | "RTN","PSO N52",46,0) | |
| 5688 | INITX Q | |
| 5689 | "RTN","PSO N52",47,0) | |
| 5690 | ; | |
| 5691 | "RTN","PSO N52",48,0) | |
| 5692 | NFILE I $G (OR0) D Q :$G(PSONEW ("DFLG")) | |
| 5693 | "RTN","PSO N52",49,0) | |
| 5694 | .D NOOR^P SONEW Q:$G (PSONEW("D FLG")) | |
| 5695 | "RTN","PSO N52",50,0) | |
| 5696 | .I $G(PSO SIGFL)!($G (PSODRUG(" OI"))'=$P( OR0,"^",8) ) S PSONEW ("CLERK CO DE")=DUZ,P SONEW("REM ARKS")=$G( PSONEW("RE MARKS"))_" CPRS Orde r #"_$P(OR 0,"^")_" E dited." | |
| 5697 | "RTN","PSO N52",51,0) | |
| 5698 | S DIC="^P SRX(",DLAY GO=52,DIC( 0)="L",X=P SOX("RX #" ) K DD,DO D FILE^DIC N S PSOX(" IRXN")=+Y K DLAYGO,X ,Y,DIC,DD, DO | |
| 5699 | "RTN","PSO N52",52,0) | |
| 5700 | I '$D(^XU SEC("PSORP H",DUZ))!( $D(PSOX("N OPSDRPH")) ),$$DS^PSS DSAPI&(+$G (^TMP("PSO DOSF",$J,0 ))) S PSON 52(PSOX("I RXN"),"STA ")=1,PSOX( "STATUS")= 1 | |
| 5701 | "RTN","PSO N52",53,0) | |
| 5702 | F PSOX1=0 :1 S PSON5 2=$P($T(DD +PSOX1),"; ;",2,4) Q: PSON52="" K PSOY S PSOY=$P(PS ON52,";;") I $G(@PSO Y)]"" S $P (PSON52(PS OX("IRXN") ,$P(PSON52 ,";;",2)), "^",$P(PSO N52,";;",3 ))=@PSOY | |
| 5703 | "RTN","PSO N52",54,0) | |
| 5704 | F I=1:1:P SOX("ENT") S ^PSRX(P SOX("IRXN" ),6,I,0)=P SOX("DOSE" ,I)_"^"_$G (PSOX("DOS E ORDERED" ,I))_"^"_$ G(PSOX("UN ITS",I))_" ^"_$G(PSOX ("NOUN",I) )_"^" D | |
| 5705 | "RTN","PSO N52",55,0) | |
| 5706 | .S ^PSRX( PSOX("IRXN "),6,I,0)= ^PSRX(PSOX ("IRXN"),6 ,I,0)_$G(P SOX("DURAT ION",I))_" ^"_$G(PSOX ("CONJUNCT ION",I))_" ^"_$G(PSOX ("ROUTE",I ))_"^"_$G( PSOX("SCHE DULE",I))_ "^"_$G(PSO X("VERB",I )) | |
| 5707 | "RTN","PSO N52",56,0) | |
| 5708 | .I $G(PSO X("ODOSE", I))]"" S ^ PSRX(PSOX( "IRXN"),6, I,1)=PSOX( "ODOSE",I) | |
| 5709 | "RTN","PSO N52",57,0) | |
| 5710 | S ^PSRX(P SOX("IRXN" ),6,0)="^5 2.0113^"_P SOX("ENT") _"^"_PSOX( "ENT") | |
| 5711 | "RTN","PSO N52",58,0) | |
| 5712 | K PSOX1,P SOY | |
| 5713 | "RTN","PSO N52",59,0) | |
| 5714 | S PSOX1=" " F S PSO X1=$O(PSON 52(PSOX("I RXN"),PSOX 1)) Q:PSOX 1="" S ^P SRX(PSOX(" IRXN"),PSO X1)=$G(PSO N52(PSOX(" IRXN"),PSO X1)) | |
| 5715 | "RTN","PSO N52",60,0) | |
| 5716 | I $O(PSOX ("SIG",0)) D | |
| 5717 | "RTN","PSO N52",61,0) | |
| 5718 | .S D=0 F S D=$O(PS OX("SIG",D )) Q:'D S ^PSRX(PSO X("IRXN"), "INS1",D,0 )=PSOX("SI G",D),TP=$ G(TP)+1 | |
| 5719 | "RTN","PSO N52",62,0) | |
| 5720 | .S ^PSRX( PSOX("IRXN "),"INS1", 0)="^52.01 15^"_TP_"^ "_TP_"^"_D T_"^^" K T P,D | |
| 5721 | "RTN","PSO N52",63,0) | |
| 5722 | I $G(PSOX ("SINS"))] "" S ^PSRX (PSOX("IRX N"),"INSS" )=PSOX("SI NS") | |
| 5723 | "RTN","PSO N52",64,0) | |
| 5724 | I $G(SIGO K) D | |
| 5725 | "RTN","PSO N52",65,0) | |
| 5726 | .S $P(^PS RX(PSOX("I RXN"),"SIG "),"^",2)= 1,^PSRX(PS OX("IRXN") ,"SIG1",0) ="^52.04A^ ^" | |
| 5727 | "RTN","PSO N52",66,0) | |
| 5728 | .S D=0 F S D=$O(SI G(D)) Q:'D S ^PSRX( PSOX("IRXN "),"SIG1", D,0)=SIG(D ),$P(^PSRX (PSOX("IRX N"),"SIG1" ,0),"^",3) =+$P(^PSRX (PSOX("IRX N"),"SIG1" ,0),"^",3) +1,$P(^(0) ,"^",4)=+$ P(^(0),"^" ,4)+1 Q:'$ O(SIG(D)) | |
| 5729 | "RTN","PSO N52",67,0) | |
| 5730 | .K SIG | |
| 5731 | "RTN","PSO N52",68,0) | |
| 5732 | I $D(PSOI NSFL) S ^P SRX(PSOX(" IRXN"),"A" ,0)="^52.3 DA^1^1",^P SRX(PSOX(" IRXN"),"A" ,1,0)=DT_" ^G^^0^Pati ent Instru ctions "_$ S(PSOINSFL =1:"",1:"N ot ")_"Sen t By Provi der." | |
| 5733 | "RTN","PSO N52",69,0) | |
| 5734 | I $G(OR0) ,$P(OR0,"^ ",24) S ^P SRX(PSOX(" IRXN"),"PK I")=$S($G( PSOSIGFL): "^1",1:1) D ACLOG | |
| 5735 | "RTN","PSO N52",70,0) | |
| 5736 | I $P($G(P SOX("CS")) ,"^"),'+$P ($G(^PSRX( PSOX("IRXN "),"PKI")) ,"^") S $P (^PSRX(PSO X("IRXN"), "PKI"),"^" ,2)=1 | |
| 5737 | "RTN","PSO N52",71,0) | |
| 5738 | K PSOX1,P SOFINFL,HL DSIG,D,PSO INSFL,D | |
| 5739 | "RTN","PSO N52",72,0) | |
| 5740 | D:$G(^TMP ("PSODAI", $J,0)) | |
| 5741 | "RTN","PSO N52",73,0) | |
| 5742 | .S $P(^PS RX(PSOX("I RXN"),3)," ^",6)=1 | |
| 5743 | "RTN","PSO N52",74,0) | |
| 5744 | .I $O(^TM P("PSODAI" ,$J,0)) S DAI=0 F S DAI=$O(^T MP("PSODAI ",$J,DAI)) Q:'DAI D | |
| 5745 | "RTN","PSO N52",75,0) | |
| 5746 | ..S:'$D(^ PSRX(PSOX( "IRXN"),"D AI",0)) ^P SRX(PSOX(" IRXN"),"DA I",0)="^52 .03^^" S ^ PSRX(PSOX( "IRXN"),"D AI",DAI,0) =^TMP("PSO DAI",$J,DA I,0) | |
| 5747 | "RTN","PSO N52",76,0) | |
| 5748 | ..S $P(^P SRX(PSOX(" IRXN"),"DA I",0),"^", 3)=+$P(^PS RX(PSOX("I RXN"),"DAI ",0),"^",3 )+1,$P(^(0 ),"^",4)=+ $P(^(0),"^ ",4)+1 | |
| 5749 | "RTN","PSO N52",77,0) | |
| 5750 | .K ^TMP(" PSODAI",$J ),DAI | |
| 5751 | "RTN","PSO N52",78,0) | |
| 5752 | I $G(PSOX ("CHCS NUM BER"))'="" S $P(^PSR X(PSOX("IR XN"),"EXT" ),"^")=$G( PSOX("CHCS NUMBER")) | |
| 5753 | "RTN","PSO N52",79,0) | |
| 5754 | I $G(PSOX ("EXTERNAL SYSTEM")) '="" S $P( ^PSRX(PSOX ("IRXN")," EXT"),"^", 2)=$G(PSOX ("EXTERNAL SYSTEM")) | |
| 5755 | "RTN","PSO N52",80,0) | |
| 5756 | I $G(PSOX ("NEWCOPAY ")) S ^PSR X(PSOX("IR XN"),"IB") =$G(PSOX(" NEWCOPAY") ) | |
| 5757 | "RTN","PSO N52",81,0) | |
| 5758 | ;Next lin e, set SC question b ased on Co pay status ? | |
| 5759 | "RTN","PSO N52",82,0) | |
| 5760 | IBQ ;I $G( PSOBILL)=2 S ^PSRX(P SOX("IRXN" ),"IBQ")=$ S($G(PSOX( "NEWCOPAY" )):0,1:1) | |
| 5761 | "RTN","PSO N52",83,0) | |
| 5762 | N PSOSCFL D S PSOSCF LD=$S(PSOS CP'="":$G( PSOANSQ("S C")),1:"") _"^"_$G(PS OANSQ("MST "))_"^"_$G (PSOANSQ(" VEH"))_"^" _$G(PSOANS Q("RAD"))_ "^"_$G(PSO ANSQ("PGW" ))_"^"_$G( PSOANSQ("H NC"))_"^"_ $G(PSOANSQ ("CV"))_"^ "_$G(PSOAN SQ("SHAD") ) | |
| 5763 | "RTN","PSO N52",84,0) | |
| 5764 | I PSOSCP< 50&($TR(PS OSCFLD,"^" )'="")&($P ($G(^PS(53 ,+$G(PSONE W("PATIENT STATUS")) ,0)),"^",7 )'=1) D | |
| 5765 | "RTN","PSO N52",85,0) | |
| 5766 | . S ^PSRX (PSOX("IRX N"),"IBQ") =PSOSCFLD K PSOSCFLD ;don't s et if SC % is null o r 0, just set it in ICD node | |
| 5767 | "RTN","PSO N52",86,0) | |
| 5768 | D ICD^PSO DIAG | |
| 5769 | "RTN","PSO N52",87,0) | |
| 5770 | D:$$SWSTA T^IBBAPI() GACT^PSOP FSU0(PSOX( "IRXN"),0) | |
| 5771 | "RTN","PSO N52",88,0) | |
| 5772 | D:$G(PSOT ITRX) SAVE TIT(PSOTIT RX,PSOX("I RXN")) | |
| 5773 | "RTN","PSO N52",89,0) | |
| 5774 | K PSOTITR X,PSOANSQ, PSOANSQD,P SOX("NEWCO PAY") | |
| 5775 | "RTN","PSO N52",90,0) | |
| 5776 | L -^PSRX( "B",PSOX(" IRXN")) | |
| 5777 | "RTN","PSO N52",91,0) | |
| 5778 | Q | |
| 5779 | "RTN","PSO N52",92,0) | |
| 5780 | ; | |
| 5781 | "RTN","PSO N52",93,0) | |
| 5782 | ACLOG ;act ivity log (digitally signed CS orders) | |
| 5783 | "RTN","PSO N52",94,0) | |
| 5784 | N DTTM,CN T,OCNT,XX | |
| 5785 | "RTN","PSO N52",95,0) | |
| 5786 | D NOW^%DT C S DTTM=% | |
| 5787 | "RTN","PSO N52",96,0) | |
| 5788 | S CNT=0 F XX=0:0 S XX=$O(^PSR X(PSOX("IR XN"),"A",X X)) Q:'XX S CNT=XX | |
| 5789 | "RTN","PSO N52",97,0) | |
| 5790 | S OCNT=CN T | |
| 5791 | "RTN","PSO N52",98,0) | |
| 5792 | I $G(PSOC SP("NAME") )'=PSODRUG ("NAME") S CNT=CNT+1 ,^PSRX(PSO X("IRXN"), "A",CNT,0) =DTTM_"^K^ "_DUZ_"^0^ NAME: "_PS OCSP("NAME ") | |
| 5793 | "RTN","PSO N52",99,0) | |
| 5794 | S XX=0 F S XX=$O(P SOCSP("DOS E",XX)) Q: 'XX I PSO CSP("DOSE" ,XX)'=$G(P SONEW("DOS E",XX)) D | |
| 5795 | "RTN","PSO N52",100,0 ) | |
| 5796 | .S CNT=CN T+1,^PSRX( PSOX("IRXN "),"A",CNT ,0)=DTTM_" ^K^"_DUZ_" ^0^DOSAGE: "_PSOCSP( "DOSE",XX) | |
| 5797 | "RTN","PSO N52",101,0 ) | |
| 5798 | S XX=0 F S XX=$O(P SOCSP("DOS E ORDERED" ,XX)) Q:'X X I PSOCS P("DOSE OR DERED",XX) '=$G(PSONE W("DOSE OR DERED",XX) ) D | |
| 5799 | "RTN","PSO N52",102,0 ) | |
| 5800 | .S CNT=CN T+1,^PSRX( PSOX("IRXN "),"A",CNT ,0)=DTTM_" ^K^"_DUZ_" ^0^DISPENS E UNITS: " _PSOCSP("D OSE ORDERE D",XX) | |
| 5801 | "RTN","PSO N52",103,0 ) | |
| 5802 | I PSOCSP( "ISSUE DAT E")'=PSONE W("ISSUE D ATE") S CN T=CNT+1,^P SRX(PSOX(" IRXN"),"A" ,CNT,0)=DT TM_"^K^"_D UZ_"^0^ISS UE DATE: " _$$FMTE^XL FDT(PSOCSP ("ISSUE DA TE")) | |
| 5803 | "RTN","PSO N52",104,0 ) | |
| 5804 | I PSOCSP( "DAYS SUPP LY")'=PSON EW("DAYS S UPPLY") S CNT=CNT+1, ^PSRX(PSOX ("IRXN")," A",CNT,0)= DTTM_"^K^" _DUZ_"^0^D AYS SUPPLY : "_PSOCSP ("DAYS SUP PLY") | |
| 5805 | "RTN","PSO N52",105,0 ) | |
| 5806 | I PSOCSP( "QTY")'=PS ONEW("QTY" ) S CNT=CN T+1,^PSRX( PSOX("IRXN "),"A",CNT ,0)=DTTM_" ^K^"_DUZ_" ^0^QTY: "_ PSOCSP("QT Y") | |
| 5807 | "RTN","PSO N52",106,0 ) | |
| 5808 | I PSOCSP( "# OF REFI LLS")'=PSO NEW("# OF REFILLS") S CNT=CNT+ 1,^PSRX(PS OX("IRXN") ,"A",CNT,0 )=DTTM_"^K ^"_DUZ_"^0 ^# OF REFI LLS: "_PSO CSP("# OF REFILLS") | |
| 5809 | "RTN","PSO N52",107,0 ) | |
| 5810 | I '$$SUBS CRIB^ORDEA ($P(OR0,"^ "),PSOX("I RXN")) S C NT=CNT+1,^ PSRX(PSOX( "IRXN"),"A ",CNT,0)=D TTM_"^K^"_ DUZ_"^0^OR DER DEA AR CHIVE INFO file entr y failure" | |
| 5811 | "RTN","PSO N52",108,0 ) | |
| 5812 | I OCNT'=C NT S ^PSRX (PSOX("IRX N"),"A",0) ="^52.3DA^ "_CNT_"^"_ CNT | |
| 5813 | "RTN","PSO N52",109,0 ) | |
| 5814 | Q | |
| 5815 | "RTN","PSO N52",110,0 ) | |
| 5816 | ; | |
| 5817 | "RTN","PSO N52",111,0 ) | |
| 5818 | PS55 ; | |
| 5819 | "RTN","PSO N52",112,0 ) | |
| 5820 | L +^PS(55 ,PSODFN,"P "):$S(+$G( ^DD("DILOC KTM"))>0:+ ^DD("DILOC KTM"),1:3) | |
| 5821 | "RTN","PSO N52",113,0 ) | |
| 5822 | S:'$D(^PS (55,PSODFN ,"P",0)) ^ (0)="^55.0 3PA^^" | |
| 5823 | "RTN","PSO N52",114,0 ) | |
| 5824 | F PSOX1=$ P(^PS(55,P SODFN,"P", 0),"^",3): 1 Q:'$D(^P S(55,PSODF N,"P",PSOX 1)) | |
| 5825 | "RTN","PSO N52",115,0 ) | |
| 5826 | S PSOX("5 5 IEN")=PS OX1 | |
| 5827 | "RTN","PSO N52",116,0 ) | |
| 5828 | S ^PS(55, PSODFN,"P" ,PSOX1,0)= PSOX("IRXN "),$P(^PS( 55,PSODFN, "P",0),"^" ,3,4)=PSOX 1_"^"_($P( ^PS(55,PSO DFN,"P",0) ,"^",4)+1) | |
| 5829 | "RTN","PSO N52",117,0 ) | |
| 5830 | S ^PS(55, PSODFN,"P" ,"A",PSONE W("STOP DA TE"),PSOX( "IRXN"))=" " | |
| 5831 | "RTN","PSO N52",118,0 ) | |
| 5832 | PS55X L -^ PS(55,PSOD FN,"P") | |
| 5833 | "RTN","PSO N52",119,0 ) | |
| 5834 | K PSOX1 | |
| 5835 | "RTN","PSO N52",120,0 ) | |
| 5836 | Q | |
| 5837 | "RTN","PSO N52",121,0 ) | |
| 5838 | DIK ; | |
| 5839 | "RTN","PSO N52",122,0 ) | |
| 5840 | I $D(^XUS EC("PSORPH ",DUZ)) S DA=PSOX("I RXN"),DIE= 52,DR="41/ ///"_PSOCO U_";S:'X Y =""@1"";42 ////"_PSOC OUU_";@1" D ^DIE K D IE,DR | |
| 5841 | "RTN","PSO N52",123,0 ) | |
| 5842 | K DIK,DA S DIK="^PS RX(",DA=PS OX("IRXN") D IX1^DIK K DIK | |
| 5843 | "RTN","PSO N52",124,0 ) | |
| 5844 | S DA=PSOX ("IRXN") D ORC^PSORN 52C | |
| 5845 | "RTN","PSO N52",125,0 ) | |
| 5846 | Q | |
| 5847 | "RTN","PSO N52",126,0 ) | |
| 5848 | FINISH ; | |
| 5849 | "RTN","PSO N52",127,0 ) | |
| 5850 | ANQ ; | |
| 5851 | "RTN","PSO N52",128,0 ) | |
| 5852 | ; ** STAR T NCC REME DIATION ** 457/RTW R JS | |
| 5853 | "RTN","PSO N52",129,0 ) | |
| 5854 | I $D(ANQD ATA) D ;A DD ADDITIO NAL LOGIC FOR ORDERI NG PROVIDE R RJS/457 | |
| 5855 | "RTN","PSO N52",130,0 ) | |
| 5856 | .I $P($G( ANQDATA)," ^",2)["UNK NOWN",$D(P SOX("PROVI DER")) S $ P(ANQDATA, "^",2)=PSO X("PROVIDE R") | |
| 5857 | "RTN","PSO N52",131,0 ) | |
| 5858 | .I $D(PSO X("PROVIDE R")),$P($G (ANQDATA), "^",2)'=PS OX("PROVID ER") S $P( ANQDATA,"^ ",2)=PSOX( "PROVIDER" ) | |
| 5859 | "RTN","PSO N52",132,0 ) | |
| 5860 | I $G(ANQD ATA)]"" N PSOUSER,PS O1PH,PSO2P H,PSOREASN ,PSOREMRK, DTM D NOW^ %DTC S DTM =% G:$$FIN D1^DIC(52. 52,,"X",DT M) ANQ D | |
| 5861 | "RTN","PSO N52",133,0 ) | |
| 5862 | .S PSOUSE R=$P(ANQDA TA,"^",2), PSO1PH=$P( ANQDATA,"^ "),PSO2PH= $P(ANQDATA ,"^",5) | |
| 5863 | "RTN","PSO N52",134,0 ) | |
| 5864 | .S PSOREA SN=$P(ANQD ATA,"^",3) ,PSOREMRK= $P(ANQDATA ,"^",4) | |
| 5865 | "RTN","PSO N52",135,0 ) | |
| 5866 | .K DD,DO S DIC="^PS (52.52,",D IC(0)="L", DLAYGO=52. 52,X=DTM | |
| 5867 | "RTN","PSO N52",136,0 ) | |
| 5868 | .D FILE^D ICN K DIC, DLAYGO,DD, DO,DA,DR | |
| 5869 | "RTN","PSO N52",137,0 ) | |
| 5870 | .N PS52 S (PS52,DA) =+Y,DIE="^ PS(52.52," ,DR="1//// ^S X=PSOX( ""IRXN"")" _";2////^S X=PSO1PH; 3////^S X= PSOUSER;4/ ///^S X=PS OREASN;5// //^S X=PSO REMRK;6/// /^S X=PSO2 PH" | |
| 5871 | "RTN","PSO N52",138,0 ) | |
| 5872 | .D ^DIE K DIE,DA,DR | |
| 5873 | "RTN","PSO N52",139,0 ) | |
| 5874 | .K X,Y,%, ANQREM | |
| 5875 | "RTN","PSO N52",140,0 ) | |
| 5876 | .D ALERT^ PSORENW0 | |
| 5877 | "RTN","PSO N52",141,0 ) | |
| 5878 | I $$GET1^ DIQ(50,+$G (PSODRUG(" IEN")),17. 5)="PSOCLO 1" D ^YSCL TST6 | |
| 5879 | "RTN","PSO N52",142,0 ) | |
| 5880 | ;/RBN END MODIFICAT IONS FOR P SO*7.0*457 | |
| 5881 | "RTN","PSO N52",143,0 ) | |
| 5882 | ; | |
| 5883 | "RTN","PSO N52",144,0 ) | |
| 5884 | N PSOTFIN | |
| 5885 | "RTN","PSO N52",145,0 ) | |
| 5886 | I $D(PSOX ("NOPSDRPH "))!('$D(^ XUSEC("PSO RPH",DUZ)) ) S PSOTFI N="",PSOTF IN=$$TECH2 ^PSODGDGP( PSOX("IRXN "),PSODFN, DUZ,.PSOX) | |
| 5887 | "RTN","PSO N52",146,0 ) | |
| 5888 | I $D(PSOX ("NOPSDRPH "))!('$D(^ XUSEC("PSO RPH",DUZ)) ) G FINISH P:$G(PSOTF IN)=1 G FI NISHX:$G(P SOTFIN)=2 | |
| 5889 | "RTN","PSO N52",147,0 ) | |
| 5890 | ; | |
| 5891 | "RTN","PSO N52",148,0 ) | |
| 5892 | I PSOX("F ILL DATE") >DT,$P(PSO PAR,"^",6) S DA=PSOX ("IRXN"),R XFL(PSOX(" IRXN"))=0 D SUS^PSOR XL K DA G FINISHX | |
| 5893 | "RTN","PSO N52",149,0 ) | |
| 5894 | ; | |
| 5895 | "RTN","PSO N52",150,0 ) | |
| 5896 | ; - Calli ng ECME fo r claims g eneration and transm ission / R EJECT hand ling | |
| 5897 | "RTN","PSO N52",151,0 ) | |
| 5898 | N ACTION, PSOERX | |
| 5899 | "RTN","PSO N52",152,0 ) | |
| 5900 | S PSOERX= PSOX("IRXN ") | |
| 5901 | "RTN","PSO N52",153,0 ) | |
| 5902 | I $$SUBMI T^PSOBPSUT (PSOERX,0) D I ACTI ON="Q"!(AC TION="^") Q | |
| 5903 | "RTN","PSO N52",154,0 ) | |
| 5904 | . S ACTIO N="" D ECM ESND^PSOBP SU1(PSOERX ,0,"","OF" ) | |
| 5905 | "RTN","PSO N52",155,0 ) | |
| 5906 | . ; Quit if there i s an unres olved Tric are/CHAMPV A non-bill able rejec t code, PS O*7*358 | |
| 5907 | "RTN","PSO N52",156,0 ) | |
| 5908 | . I $$PSO ET^PSOREJP 3(PSOERX,0 ) S ACTION ="Q" Q | |
| 5909 | "RTN","PSO N52",157,0 ) | |
| 5910 | . I $$FIN D^PSOREJUT (PSOERX,0) D | |
| 5911 | "RTN","PSO N52",158,0 ) | |
| 5912 | . . S ACT ION=$$HDLG ^PSOREJU1( PSOERX,0," 79,88","OF ","IOQ","Q ") | |
| 5913 | "RTN","PSO N52",159,0 ) | |
| 5914 | . I $$STA TUS^PSOBPS UT(PSOERX, 0)="E PAYA BLE" D | |
| 5915 | "RTN","PSO N52",160,0 ) | |
| 5916 | . . D SAV NDC^PSSNDC UT(+$$GET1 ^DIQ(52,PS OERX,6,"I" ),$G(PSOSI TE),$$GETN DC^PSONDCU T(PSOERX,0 )) | |
| 5917 | "RTN","PSO N52",161,0 ) | |
| 5918 | ; | |
| 5919 | "RTN","PSO N52",162,0 ) | |
| 5920 | FINISHP ; | |
| 5921 | "RTN","PSO N52",163,0 ) | |
| 5922 | I $G(PSOR X("PSOL",1 ))']"" S P SORX("PSOL ",1)=PSOX( "IRXN")_", ",RXFL(PSO X("IRXN")) =0 G FINIS HX | |
| 5923 | "RTN","PSO N52",164,0 ) | |
| 5924 | F PSOX1=0 :0 S PSOX1 =$O(PSORX( "PSOL",PSO X1)) Q:'PS OX1 S PSO X2=PSOX1 | |
| 5925 | "RTN","PSO N52",165,0 ) | |
| 5926 | I $L(PSOR X("PSOL",P SOX2))+$L( PSOX("IRXN "))<220 S PSORX("PSO L",PSOX2)= PSORX("PSO L",PSOX2)_ PSOX("IRXN ")_"," | |
| 5927 | "RTN","PSO N52",166,0 ) | |
| 5928 | E S PSOR X("PSOL",P SOX2+1)=PS OX("IRXN") _"," | |
| 5929 | "RTN","PSO N52",167,0 ) | |
| 5930 | S RXFL(PS OX("IRXN") )=0 | |
| 5931 | "RTN","PSO N52",168,0 ) | |
| 5932 | FINISHX ;c all to bui ld Rx arra y for bing o board | |
| 5933 | "RTN","PSO N52",169,0 ) | |
| 5934 | I $G(PSOR X("MAIL/WI NDOW"))["W " S BINGCR T=1,BINGRT E="W",BBFL G=1 D BBRX ^PSORN52C | |
| 5935 | "RTN","PSO N52",170,0 ) | |
| 5936 | K PSOX1,P SOX2 | |
| 5937 | "RTN","PSO N52",171,0 ) | |
| 5938 | K ^TMP("P SODGI",$J) ,^TMP("PSO SER",$J),^ TMP("PSOSE RS",$J),^T MP("PSODGS ",$J),^TMP ("PSOTDD", $J),^TMP(" PSODOSF",$ J) | |
| 5939 | "RTN","PSO N52",172,0 ) | |
| 5940 | Q | |
| 5941 | "RTN","PSO N52",173,0 ) | |
| 5942 | ; | |
| 5943 | "RTN","PSO N52",174,0 ) | |
| 5944 | SAVETIT(TI TRX,MNTRX) ; Save Ti tration/Ma intenance dose Rx in formation | |
| 5945 | "RTN","PSO N52",175,0 ) | |
| 5946 | I '$D(^PS RX(+$G(TIT RX),0))!'$ D(^PSRX(+$ G(MNTRX),0 )) Q | |
| 5947 | "RTN","PSO N52",176,0 ) | |
| 5948 | S $P(^PSR X(TITRX,"T IT"),"^",2 ,3)=MNTRX_ "^1" | |
| 5949 | "RTN","PSO N52",177,0 ) | |
| 5950 | D RXACT^P SOBPSU2(TI TRX,0,"Mai ntenance R x#: "_$$GE T1^DIQ(52, MNTRX,.01) ,"E") | |
| 5951 | "RTN","PSO N52",178,0 ) | |
| 5952 | S $P(^PSR X(MNTRX,"T IT"),"^",1 )=TITRX | |
| 5953 | "RTN","PSO N52",179,0 ) | |
| 5954 | D RXACT^P SOBPSU2(MN TRX,0,"Tit ration Rx# : "_$$GET1 ^DIQ(52,TI TRX,.01)," E") | |
| 5955 | "RTN","PSO N52",180,0 ) | |
| 5956 | Q | |
| 5957 | "RTN","PSO N52",181,0 ) | |
| 5958 | ; | |
| 5959 | "RTN","PSO N52",182,0 ) | |
| 5960 | EOJ ; | |
| 5961 | "RTN","PSO N52",183,0 ) | |
| 5962 | ;B xref l ocked in r outine PSO NRXN | |
| 5963 | "RTN","PSO N52",184,0 ) | |
| 5964 | L -^PSRX( "B",PSOX(" IRXN")) K OTHDOS,DA, PSON52,PSO PRC,RTE,SC H,PSOX("IN S"),PSONEW ("INS"),PS ORXED("INS "),PSONEW( "ENT"),PSO RXED("ENT" ),OLENT | |
| 5965 | "RTN","PSO N52",185,0 ) | |
| 5966 | D PSOUL^P SSLOCK(PSO X("IRXN")) | |
| 5967 | "RTN","PSO N52",186,0 ) | |
| 5968 | Q | |
| 5969 | "RTN","PSO N52",187,0 ) | |
| 5970 | ; | |
| 5971 | "RTN","PSO N52",188,0 ) | |
| 5972 | ;;PSOX("S IG");;SIG; ;1 | |
| 5973 | "RTN","PSO N52",189,0 ) | |
| 5974 | DD ;;PSOX( "RX #");;0 ;;1 | |
| 5975 | "RTN","PSO N52",190,0 ) | |
| 5976 | ;;PSOX("I SSUE DATE" );;0;;13 | |
| 5977 | "RTN","PSO N52",191,0 ) | |
| 5978 | ;;PSODFN; ;0;;2 | |
| 5979 | "RTN","PSO N52",192,0 ) | |
| 5980 | ;;PSOX("P ATIENT STA TUS");;0;; 3 | |
| 5981 | "RTN","PSO N52",193,0 ) | |
| 5982 | ;;PSOX("P ROVIDER"); ;0;;4 | |
| 5983 | "RTN","PSO N52",194,0 ) | |
| 5984 | ;;PSOX("C LINIC");;0 ;;5 | |
| 5985 | "RTN","PSO N52",195,0 ) | |
| 5986 | ;;PSODRUG ("IEN");;0 ;;6 | |
| 5987 | "RTN","PSO N52",196,0 ) | |
| 5988 | ;;PSODRUG ("TRADE NA ME");;TN;; 1 | |
| 5989 | "RTN","PSO N52",197,0 ) | |
| 5990 | ;;PSOX("Q TY");;0;;7 | |
| 5991 | "RTN","PSO N52",198,0 ) | |
| 5992 | ;;PSOX("D AYS SUPPLY ");;0;;8 | |
| 5993 | "RTN","PSO N52",199,0 ) | |
| 5994 | ;;PSOX("# OF REFILL S");;0;;9 | |
| 5995 | "RTN","PSO N52",200,0 ) | |
| 5996 | ;;PSOX("C OPIES");;0 ;;18 | |
| 5997 | "RTN","PSO N52",201,0 ) | |
| 5998 | ;;PSOX("M AIL/WINDOW ");;0;;11 | |
| 5999 | "RTN","PSO N52",202,0 ) | |
| 6000 | ;;PSOX("R EMARKS");; 3;;7 | |
| 6001 | "RTN","PSO N52",203,0 ) | |
| 6002 | ;;PSOX("A DMINCLINIC ");;0;;15 | |
| 6003 | "RTN","PSO N52",204,0 ) | |
| 6004 | ;;PSOX("C LERK CODE" );;0;;16 | |
| 6005 | "RTN","PSO N52",205,0 ) | |
| 6006 | ;;PSODRUG ("COST");; 0;;17 | |
| 6007 | "RTN","PSO N52",206,0 ) | |
| 6008 | ;;PSOSITE ;;2;;9 | |
| 6009 | "RTN","PSO N52",207,0 ) | |
| 6010 | ;;PSOX("L OGIN DATE" );;2;;1 | |
| 6011 | "RTN","PSO N52",208,0 ) | |
| 6012 | ;;PSOX("F ILL DATE") ;;2;;2 | |
| 6013 | "RTN","PSO N52",209,0 ) | |
| 6014 | ;;PSOX("P HARMACIST" );;2;;3 | |
| 6015 | "RTN","PSO N52",210,0 ) | |
| 6016 | ;;PSOX("L OT #");;2; ;4 | |
| 6017 | "RTN","PSO N52",211,0 ) | |
| 6018 | ;;PSOX("D ISPENSED D ATE");;2;; 5 | |
| 6019 | "RTN","PSO N52",212,0 ) | |
| 6020 | ;;PSOX("S TOP DATE") ;;2;;6 | |
| 6021 | "RTN","PSO N52",213,0 ) | |
| 6022 | ;;PSODRUG ("NDC");;2 ;;7 | |
| 6023 | "RTN","PSO N52",214,0 ) | |
| 6024 | ;;PSODRUG ("DAW");;E PH;;1 | |
| 6025 | "RTN","PSO N52",215,0 ) | |
| 6026 | ;;PSODRUG ("MANUFACT URER");;2; ;8 | |
| 6027 | "RTN","PSO N52",216,0 ) | |
| 6028 | ;;PSOX("E XPIRATION DATE");;2; ;11 | |
| 6029 | "RTN","PSO N52",217,0 ) | |
| 6030 | ;;PSOX("G ENERIC PRO VIDER");;2 ;;12 | |
| 6031 | "RTN","PSO N52",218,0 ) | |
| 6032 | ;;PSOX("R ELEASED DA TE/TIME"); ;2;;13 | |
| 6033 | "RTN","PSO N52",219,0 ) | |
| 6034 | ;;PSOX("M ETHOD OF P ICK-UP");; MP;;1 | |
| 6035 | "RTN","PSO N52",220,0 ) | |
| 6036 | ;;PSOX("S TATUS");;S TA;;1 | |
| 6037 | "RTN","PSO N52",221,0 ) | |
| 6038 | ;;PSOX("L AST DISPEN SED DATE") ;;3;;1 | |
| 6039 | "RTN","PSO N52",222,0 ) | |
| 6040 | ;;PSOX("N EXT POSSIB LE REFILL" );;3;;2 | |
| 6041 | "RTN","PSO N52",223,0 ) | |
| 6042 | ;;PSOX("C OSIGNING P ROVIDER"); ;3;;3 | |
| 6043 | "RTN","PSO N52",224,0 ) | |
| 6044 | ;;PSOX("T YPE OF RX" );;TYPE;;1 | |
| 6045 | "RTN","PSO N52",225,0 ) | |
| 6046 | ;;PSOX("S AND");;SAN D;;1 | |
| 6047 | "RTN","PSO N52",226,0 ) | |
| 6048 | ;;PSOX("P OE");;POE; ;1 | |
| 6049 | "RTN","PSO N52",227,0 ) | |
| 6050 | ;;PSOX("I NS");;INS; ;1 | |
| 6051 | "RTN","PSO NEW") | |
| 6052 | 0^12^B3895 6670 | |
| 6053 | "RTN","PSO NEW",1,0) | |
| 6054 | PSONEW ;BI R/SAB - ne w rx order main driv er ;Jul 24 , 2017@15: 24 | |
| 6055 | "RTN","PSO NEW",2,0) | |
| 6056 | ;;7.0;OUT PATIENT PH ARMACY;**1 1,27,32,46 ,94,130,26 8,225,251, 379,390,41 7,313,411, 457**;DEC 1997;Build 65 | |
| 6057 | "RTN","PSO NEW",3,0) | |
| 6058 | ;External reference to UL^PSS LOCK suppo rted by DB IA 2789 | |
| 6059 | "RTN","PSO NEW",4,0) | |
| 6060 | ;External reference to $$L^PS SLOCK supp orted by D BIA 2789 | |
| 6061 | "RTN","PSO NEW",5,0) | |
| 6062 | ;External reference to ^VA(20 0 supporte d by DBIA 224 | |
| 6063 | "RTN","PSO NEW",6,0) | |
| 6064 | ;External reference to ^XUSEC ( supporte d by DBIA 10076 | |
| 6065 | "RTN","PSO NEW",7,0) | |
| 6066 | ;External reference to ^ORX1 supported by DBIA 21 86 | |
| 6067 | "RTN","PSO NEW",8,0) | |
| 6068 | ;External reference to ^ORX2 supported by DBIA 86 7 | |
| 6069 | "RTN","PSO NEW",9,0) | |
| 6070 | ;External reference to ^TIUED IT support ed by DBIA 2410 | |
| 6071 | "RTN","PSO NEW",10,0) | |
| 6072 | ;External reference to ^DD("D ILOCKTM" s upported b y DBIA 999 | |
| 6073 | "RTN","PSO NEW",11,0) | |
| 6074 | ;-------- ---------- ---------- ---------- ---------- ---------- ----- | |
| 6075 | "RTN","PSO NEW",12,0) | |
| 6076 | OERR ;back door new r x for v7 | |
| 6077 | "RTN","PSO NEW",13,0) | |
| 6078 | K PSOREED T,COPY,SPE ED,PSOEDIT ,DUR,DRET, PSOTITRX,P SOMTFLG N PSOCKCON,P SODAOC | |
| 6079 | "RTN","PSO NEW",14,0) | |
| 6080 | S PSOPLCK =$$L^PSSLO CK(PSODFN, 0) I '$G(P SOPLCK) D LOCK^PSOOR CPY S VALM SG=$S($P($ G(PSOPLCK) ,"^",2)'=" ":$P($G(PS OPLCK),"^" ,2)_" is w orking on this patie nt.",1:"An other pers on is ente ring order s for this patient." ) K PSOPLC K S VALMBC K="" Q | |
| 6081 | "RTN","PSO NEW",15,0) | |
| 6082 | K PSOPLCK S X=PSODF N_";DPT(" D LK^ORX2 I 'Y S VAL MSG="Anoth er person is enterin g orders f or this pa tient.",VA LMBCK="" D UL^PSSLOC K(PSODFN) Q | |
| 6083 | "RTN","PSO NEW",16,0) | |
| 6084 | AGAIN N VA LMCNT K PS ODRUG,PSOC OU,PSOCOUU ,PSONOOR,P SORX("FN") ,PSORX("DF LG"),PSOQU IT,POERR S PSORX("DF LG")=0 | |
| 6085 | "RTN","PSO NEW",17,0) | |
| 6086 | W ! D HLD HDR^PSOLMU TL S (PSON EW("QFLG") ,PSONEW("D FLG"),PSOQ UIT)=0,PSO FROM="NEW" ,PSONOEDT= 1 | |
| 6087 | "RTN","PSO NEW",18,0) | |
| 6088 | K ORD D F ULL^VALM1, ^PSONEW1 ; Continue order entr y | |
| 6089 | "RTN","PSO NEW",19,0) | |
| 6090 | I PSONEW( "QFLG") G END | |
| 6091 | "RTN","PSO NEW",20,0) | |
| 6092 | I PSONEW( "DFLG") W !,$C(7),"R X DELETED" ,! S:$G(PO ERR) POERR ("DFLG")=1 ,VALMBCK=" Q" G END | |
| 6093 | "RTN","PSO NEW",21,0) | |
| 6094 | D:$P($G(P SOPAR),"^" ,7)=1 AUTO ^PSONRXN I $P($G(PSO PAR),"^",7 )'=1 S PSO X=PSONEW(" RX #") D C HECK^PSONR XN | |
| 6095 | "RTN","PSO NEW",22,0) | |
| 6096 | I PSONEW( "DFLG")!PS ONEW("QFLG ") D DEL S :$G(POERR) POERR("DF LG")=1,VAL MBCK="R" G END | |
| 6097 | "RTN","PSO NEW",23,0) | |
| 6098 | D NOOR I PSONEW("DF LG") D DEL G END | |
| 6099 | "RTN","PSO NEW",24,0) | |
| 6100 | D ^PSONEW 2 I PSONEW ("DFLG") D DEL S:$G( POERR) POE RR("DFLG") =1,VALMBCK ="R" G END ; Asks if correct | |
| 6101 | "RTN","PSO NEW",25,0) | |
| 6102 | G:$G(PSOR X("FN")) E ND | |
| 6103 | "RTN","PSO NEW",26,0) | |
| 6104 | D EN^PSON 52(.PSONEW ) ; Files entry in F ile 52 | |
| 6105 | "RTN","PSO NEW",27,0) | |
| 6106 | D NPSOSD^ PSOUTIL(.P SONEW) ; A dds newly added rx t o PSOSD ar ray | |
| 6107 | "RTN","PSO NEW",28,0) | |
| 6108 | S VALMBCK ="R" | |
| 6109 | "RTN","PSO NEW",29,0) | |
| 6110 | ; | |
| 6111 | "RTN","PSO NEW",30,0) | |
| 6112 | ; - Possi ble Titrat ion prescr iption | |
| 6113 | "RTN","PSO NEW",31,0) | |
| 6114 | I $G(PSON EW("IRXN") ) D MARK^P SOOTMRX(PS ONEW("IRXN "),0) | |
| 6115 | "RTN","PSO NEW",32,0) | |
| 6116 | ; | |
| 6117 | "RTN","PSO NEW",33,0) | |
| 6118 | END D EOJ ; Clean up | |
| 6119 | "RTN","PSO NEW",34,0) | |
| 6120 | I '$G(PSO RX("FN")) W ! K DIR, DIRUT,DUOU T,DTOUT S DIR(0)="Y" ,DIR("B")= "YES",DIR( "A")="Anot her New Or der for "_ PSORX("NAM E") D ^DIR K DIR,DIR UT,DUOUT,D TOUT I Y K PSONEW,PS DRUG,ORD G AGAIN | |
| 6121 | "RTN","PSO NEW",35,0) | |
| 6122 | D ^PSOBUI LD,BLD^PSO ORUT1 S X= PSODFN_";D PT(" D ULK ^ORX2 D UL ^PSSLOCK(P SODFN) | |
| 6123 | "RTN","PSO NEW",36,0) | |
| 6124 | D RV^PSOO RFL | |
| 6125 | "RTN","PSO NEW",37,0) | |
| 6126 | S VALMBCK ="R" K PSO RX("FN") Q | |
| 6127 | "RTN","PSO NEW",38,0) | |
| 6128 | ;-------- ---------- ---------- ---------- ---------- ---------- ------ | |
| 6129 | "RTN","PSO NEW",39,0) | |
| 6130 | DEL ; | |
| 6131 | "RTN","PSO NEW",40,0) | |
| 6132 | W !,$C(7) ,"RX DELET ED",! | |
| 6133 | "RTN","PSO NEW",41,0) | |
| 6134 | I $P($G(P SOPAR),"^" ,7)=1 D | |
| 6135 | "RTN","PSO NEW",42,0) | |
| 6136 | . S DIE=" ^PS(59,",D A=PSOSITE, PSOY=$O(PS ONEW("OLD LAST RX#", "")) | |
| 6137 | "RTN","PSO NEW",43,0) | |
| 6138 | . S PSOX= PSONEW("OL D LAST RX# ",PSOY) | |
| 6139 | "RTN","PSO NEW",44,0) | |
| 6140 | . L +^PS( 59,+PSOSIT E,PSOY):$S (+$G(^DD(" DILOCKTM") )>0:+^DD(" DILOCKTM") ,1:3) | |
| 6141 | "RTN","PSO NEW",45,0) | |
| 6142 | . S DR=$S (PSOY=8:"2 003////"_P SOX,PSOY=3 :"1002.1// //"_PSOX,1 :"2003//// "_PSOX) | |
| 6143 | "RTN","PSO NEW",46,0) | |
| 6144 | . D:PSOX< $$GET1^DIQ (59,+PSOSI TE,+DR,"I" ) ^DIE K D IE,X,Y | |
| 6145 | "RTN","PSO NEW",47,0) | |
| 6146 | . L -^PS( 59,+PSOSIT E,PSOY) | |
| 6147 | "RTN","PSO NEW",48,0) | |
| 6148 | . K PSOX, PSOY Q | |
| 6149 | "RTN","PSO NEW",49,0) | |
| 6150 | EOJ ; | |
| 6151 | "RTN","PSO NEW",50,0) | |
| 6152 | I $D(PSON EW("RX #") ) L -^PSRX ("B",PSONE W("RX #")) ; +Lock s et in PSON RXN | |
| 6153 | "RTN","PSO NEW",51,0) | |
| 6154 | K PSONOED T,PSONEW,P SODRUG,ANQ DATA,LSI,C ,MAX,MIN,N DF,REF,SIG ,SER,PSOFL AG,PSOHI,P SOLO,PSONO OR,PSOCOUU ,PSOCOU,PS ORX("EDIT" ),ZNEW | |
| 6155 | "RTN","PSO NEW",52,0) | |
| 6156 | D CLEAN^P SOVER1 | |
| 6157 | "RTN","PSO NEW",53,0) | |
| 6158 | K ^TMP("P SORXDC",$J ),RORD,ACO M,ACNT,CRI T,DEF,F1,G G,I1,IEN,I NDT,LAST,M SG,NIEN,ST A,DUR,DRET ,PSOPRC | |
| 6159 | "RTN","PSO NEW",54,0) | |
| 6160 | S (ZRXN,R XN)=$O(^TM P("PSORXN" ,$J,0)) I RXN D | |
| 6161 | "RTN","PSO NEW",55,0) | |
| 6162 | .S RXN1=^ TMP("PSORX N",$J,RXN) D EN^PSOH LSN1(RXN,$ P(RXN1,"^" ),$P(RXN1, "^",2),"", $P(RXN1,"^ ",3)) | |
| 6163 | "RTN","PSO NEW",56,0) | |
| 6164 | .I $$GET1 ^DIQ(52,RX N,100,"I") =5 D EN^PS OHLSN1(RXN ,"SC","ZS" ,"") | |
| 6165 | "RTN","PSO NEW",57,0) | |
| 6166 | .;; START NCC REMED IATION >> 457*MZR | |
| 6167 | "RTN","PSO NEW",58,0) | |
| 6168 | .N PSOCLO ZO S PSOCL OZO=($$GET 1^DIQ(50,+ $$GET1^DIQ (52,RXN,6, "I"),17.5) ="PSOCLO1" ) ; Cloza pine order | |
| 6169 | "RTN","PSO NEW",59,0) | |
| 6170 | .I PSOCLO ZO,$G(PSOL OGDT) N OR N S ORN=$$ GET1^DIQ(5 2,RXN,39.3 ,"I") I OR N D ;/MZR populate ^XTMP entr y with ord er # | |
| 6171 | "RTN","PSO NEW",60,0) | |
| 6172 | ..I $P($G (^XTMP("YS CLTRN",DT, DFN,PSOLOG DT,0)),"^" ,3)=RXN D ORDSET^YSC LTST6(ORN) | |
| 6173 | "RTN","PSO NEW",61,0) | |
| 6174 | .;; END N CC REMEDIA TION >> 45 7*457 | |
| 6175 | "RTN","PSO NEW",62,0) | |
| 6176 | .;saves d rug allerg y order ch ks pso*7*3 90 | |
| 6177 | "RTN","PSO NEW",63,0) | |
| 6178 | .I $D(^TM P("PSODAOC ",$J)) D | |
| 6179 | "RTN","PSO NEW",64,0) | |
| 6180 | ..S RXN=Z RXN,PSODAO C="Rx Back door "_$S( $$GET1^DIQ (52,RXN,10 0,"I")=4:" NON-VERIFI ED ",1:"") _"NEW Orde r Acceptan ce_OP",ZNE W=1 | |
| 6181 | "RTN","PSO NEW",65,0) | |
| 6182 | .D DAOC | |
| 6183 | "RTN","PSO NEW",66,0) | |
| 6184 | K ZRXN,RX N,RXN1,^TM P("PSORXN" ,$J),^TMP( "PSODAOC", $J),RET,PS ODAOC,ZNEW | |
| 6185 | "RTN","PSO NEW",67,0) | |
| 6186 | I $G(PSON OTE) D FUL L^VALM1,MA IN^TIUEDIT (3,.TIUDA, PSODFN,"", "","","",1 ) | |
| 6187 | "RTN","PSO NEW",68,0) | |
| 6188 | K PSONOTE ,PSOCKCON, ZZCOPY | |
| 6189 | "RTN","PSO NEW",69,0) | |
| 6190 | ;W !! K D IR S DIR(0 )="E",DIR( "?")="Pres s Return t o continue ",DIR("A") ="Press Re turn to Co ntinue" D ^DIR K DIR ,DTOUT,DUO UT | |
| 6191 | "RTN","PSO NEW",70,0) | |
| 6192 | Q | |
| 6193 | "RTN","PSO NEW",71,0) | |
| 6194 | NOOR ;asks nature of order | |
| 6195 | "RTN","PSO NEW",72,0) | |
| 6196 | N PSONOOD F | |
| 6197 | "RTN","PSO NEW",73,0) | |
| 6198 | S PSONOOD F=0 | |
| 6199 | "RTN","PSO NEW",74,0) | |
| 6200 | ;; START NCC REMEDI ATION >> 4 57*MZR | |
| 6201 | "RTN","PSO NEW",75,0) | |
| 6202 | ;/MZR Add ed a next line becau se otherwi se data ge ts lost | |
| 6203 | "RTN","PSO NEW",76,0) | |
| 6204 | I $$GET1^ DIQ(50,+$G (PSODRUG(" IEN")),17. 5)="PSOCLO 1",'$D(PSO NEW("SAND" )),$G(PSOS AND) S PSO NEW("SAND" )=PSOSAND K PSOSAND | |
| 6205 | "RTN","PSO NEW",77,0) | |
| 6206 | ;; EMD NC C REMEDIAT ION >> 457 *MZR | |
| 6207 | "RTN","PSO NEW",78,0) | |
| 6208 | I $G(OR0) D G NOOR X ;front d oor | |
| 6209 | "RTN","PSO NEW",79,0) | |
| 6210 | .S PSOI=$ S($G(PSOSI GFL):1,$G( PSODRUG("O I"))'=$P(O R0,"^",8): 1,1:0) | |
| 6211 | "RTN","PSO NEW",80,0) | |
| 6212 | .I 'PSOI S PSONOOR= "" D:$$FIN D1^DIC(200 .051,","_D UZ_",","X" ,"PSORPH") COUN Q ; NoO $P(OR0 ,"^",7) | |
| 6213 | "RTN","PSO NEW",81,0) | |
| 6214 | .S PSONOO DF=1 | |
| 6215 | "RTN","PSO NEW",82,0) | |
| 6216 | .D DIR I $D(DIRUT) S PSONEW(" DFLG")=1 Q | |
| 6217 | "RTN","PSO NEW",83,0) | |
| 6218 | .S PSONOO R=Y D:$$FI ND1^DIC(20 0.051,","_ DUZ_",","X ","PSORPH" ) COUN K D IR,DTOUT,D TOUT,DIRUT | |
| 6219 | "RTN","PSO NEW",84,0) | |
| 6220 | ;backdoor order | |
| 6221 | "RTN","PSO NEW",85,0) | |
| 6222 | D DIR I $ D(DIRUT) S PSONEW("D FLG")=1,VA LMBCK="Q" Q | |
| 6223 | "RTN","PSO NEW",86,0) | |
| 6224 | S PSONOOR =Y K DIK,D A,DIE,DR,P SOI,DIR,DU OUT,DTOUT, DIRUT | |
| 6225 | "RTN","PSO NEW",87,0) | |
| 6226 | G:'$D(^XU SEC("PSORP H",DUZ)) N OORX | |
| 6227 | "RTN","PSO NEW",88,0) | |
| 6228 | COUN ;pati ent counse ling | |
| 6229 | "RTN","PSO NEW",89,0) | |
| 6230 | G:$G(PSOR X("EDIT")) &('$G(PSOS IGFL)) NOO RX K DIR,D UOUT,DTOUT ,DIRUT | |
| 6231 | "RTN","PSO NEW",90,0) | |
| 6232 | S DIR("B" )="NO",DIR (0)="52,41 " D ^DIR S PSOCOU=$S (Y:Y,1:0) | |
| 6233 | "RTN","PSO NEW",91,0) | |
| 6234 | I $D(DIRU T)!('PSOCO U) S PSOCO UU=0 D:'$G (SPEED) PR ONTE Q | |
| 6235 | "RTN","PSO NEW",92,0) | |
| 6236 | K:'$G(PSO COU) PSOCO UU K DIR,D UOUT,DTOUT ,DIRUT I Y S DIR(0)= "52,42",DI R("B")="NO " D ^DIR S PSOCOUU=$ S(Y:Y,1:0) | |
| 6237 | "RTN","PSO NEW",93,0) | |
| 6238 | PRONTE K P SONOTE,DIR ,DIRUT,DUO UT | |
| 6239 | "RTN","PSO NEW",94,0) | |
| 6240 | I $T(MAIN ^TIUEDIT)] "",'$G(SPE ED) D K D IR,DIRUT,D UOUT | |
| 6241 | "RTN","PSO NEW",95,0) | |
| 6242 | .S DIR(0) ="Y",DIR(" B")="No",D IR("A")="D o you want to enter a Progress Note",DIR ("A",1)="" D ^DIR K DIR | |
| 6243 | "RTN","PSO NEW",96,0) | |
| 6244 | .S PSONOT E=+Y Q ;I 'Y!($D(DI RUT)) Q | |
| 6245 | "RTN","PSO NEW",97,0) | |
| 6246 | NOORX K X, Y,DIR,DUOU T,DTOUT,DI RUT | |
| 6247 | "RTN","PSO NEW",98,0) | |
| 6248 | Q | |
| 6249 | "RTN","PSO NEW",99,0) | |
| 6250 | DIR ;ask n ature of o rder | |
| 6251 | "RTN","PSO NEW",100,0 ) | |
| 6252 | K DIR,DTO UT,DTOUT,D IRUT I $T( NA^ORX1)]" " D Q | |
| 6253 | "RTN","PSO NEW",101,0 ) | |
| 6254 | .S PSONOO R=$$NA^ORX 1($S($G(PS ONOODF)!($ G(PSONOBCK )):"S",1:" W"),0,"B", "Nature of Order",0, "WPSDIVR"_ $S($$GET1^ DIQ(200,DU Z,53.3):"E ",1:"")) | |
| 6255 | "RTN","PSO NEW",102,0 ) | |
| 6256 | .I +PSONO OR S (Y,PS ONOOR)=$P( PSONOOR,"^ ",3) Q | |
| 6257 | "RTN","PSO NEW",103,0 ) | |
| 6258 | .S DIRUT= 1 K PSONOO R | |
| 6259 | "RTN","PSO NEW",104,0 ) | |
| 6260 | I $D(PSON OOR) S DF= PSONOOR,PS ONODF=$S(D F="E":"PRO VIDER ENTE RED",DF="V ":"VERBAL" ,DF="P":"T ELEPHONE", DF="D":"DU PLICATE",D F="S":"SER VICE CORRE CTED",DF=" I":"POLICY ",DF="R":" SERVICE RE JECTED",1: "WRITTEN") | |
| 6261 | "RTN","PSO NEW",105,0 ) | |
| 6262 | K DIR,DTO UT,DTOUT,D IRUT S DIR ("A")="Nat ure of Ord er: ",DIR( "B")=$S($D (PSONOOR): PSONODF,1: "WRITTEN") | |
| 6263 | "RTN","PSO NEW",106,0 ) | |
| 6264 | S DIR(0)= "SA^W:WRIT TEN;V:VERB AL;P:TELEP HONE;S:SER VICE CORRE CTED;D:DUP LICATE;I:P OLICY;R:SE RVICE REJE CTED"_$S($ $GET1^DIQ( 200,DUZ,53 .3):";E:PR OVIDER ENT ERED",1:"" ) | |
| 6265 | "RTN","PSO NEW",107,0 ) | |
| 6266 | D ^DIR K DF,PSONODF Q:$D(DIRU T) S PSON OOR=Y | |
| 6267 | "RTN","PSO NEW",108,0 ) | |
| 6268 | DIRX Q | |
| 6269 | "RTN","PSO NEW",109,0 ) | |
| 6270 | ; | |
| 6271 | "RTN","PSO NEW",110,0 ) | |
| 6272 | NOORE(PSON EW) ;entry point for renew | |
| 6273 | "RTN","PSO NEW",111,0 ) | |
| 6274 | D NOOR I $D(DIRUT) S PSONEW(" DFLG")=1 Q | |
| 6275 | "RTN","PSO NEW",112,0 ) | |
| 6276 | S PSONEW( "NOO")=PSO NOOR | |
| 6277 | "RTN","PSO NEW",113,0 ) | |
| 6278 | Q | |
| 6279 | "RTN","PSO NEW",114,0 ) | |
| 6280 | DAOC ;adds all backd oor order checks to file 100.0 5. | |
| 6281 | "RTN","PSO NEW",115,0 ) | |
| 6282 | D ^PSONEW OC K ^TMP( "PSODAOC", $J),PSRDI | |
| 6283 | "RTN","PSO NEW",116,0 ) | |
| 6284 | Q | |
| 6285 | "RTN","PSO NEW1") | |
| 6286 | 0^13^B1715 0662 | |
| 6287 | "RTN","PSO NEW1",1,0) | |
| 6288 | PSONEW1 ;B IR/DSD - n ew Rx orde r entry ;J ul 24, 201 7@15:24 | |
| 6289 | "RTN","PSO NEW1",2,0) | |
| 6290 | ;;7.0;OUT PATIENT PH ARMACY;**4 6,104,117, 143,457**; DEC 1997;B uild 65 | |
| 6291 | "RTN","PSO NEW1",3,0) | |
| 6292 | ;External reference ^PS(55 su pported by DBIA 2228 | |
| 6293 | "RTN","PSO NEW1",4,0) | |
| 6294 | ; | |
| 6295 | "RTN","PSO NEW1",5,0) | |
| 6296 | START ; | |
| 6297 | "RTN","PSO NEW1",6,0) | |
| 6298 | S (PSONEW ("DFLG"),P SONEW("FIE LD"),PSONE W1)=0 | |
| 6299 | "RTN","PSO NEW1",7,0) | |
| 6300 | ; | |
| 6301 | "RTN","PSO NEW1",8,0) | |
| 6302 | 1 S PSONEW ("FLD")=1 S PSONEW(" FIELD")=0 | |
| 6303 | "RTN","PSO NEW1",9,0) | |
| 6304 | I $P($G(P SOPAR),"^" ,7)'=1 D M ANUAL^PSON RXN ; Get Manual Rx number | |
| 6305 | "RTN","PSO NEW1",10,0 ) | |
| 6306 | G:PSONEW( "QFLG")!PS ONEW("DFLG ") END G:P SONEW("FIE LD") @PSON EW("FIELD" ) | |
| 6307 | "RTN","PSO NEW1",11,0 ) | |
| 6308 | ; | |
| 6309 | "RTN","PSO NEW1",12,0 ) | |
| 6310 | 2 S PSONEW ("FLD")=2 D PTSTAT^P SODIR1(.PS ONEW) ; Ge t Patient Status | |
| 6311 | "RTN","PSO NEW1",13,0 ) | |
| 6312 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6313 | "RTN","PSO NEW1",14,0 ) | |
| 6314 | ; | |
| 6315 | "RTN","PSO NEW1",15,0 ) | |
| 6316 | 3 S PSONEW ("FLD")=3 D ^PSODRG ; Get dru g and rela ted inform ation | |
| 6317 | "RTN","PSO NEW1",16,0 ) | |
| 6318 | G:PSONEW( "DFLG") EN D D EN^PSO DIAG ; ge t ICD diag nosis code s for orde r | |
| 6319 | "RTN","PSO NEW1",17,0 ) | |
| 6320 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6321 | "RTN","PSO NEW1",18,0 ) | |
| 6322 | ; | |
| 6323 | "RTN","PSO NEW1",19,0 ) | |
| 6324 | ;/RBN - B EGIN CHANG ES PSO*7.0 *457 | |
| 6325 | "RTN","PSO NEW1",20,0 ) | |
| 6326 | 31 I $D(^T MP("CLOZFL G",PSODFN) ) D | |
| 6327 | "RTN","PSO NEW1",21,0 ) | |
| 6328 | . S PSONE W("# OF RE FILLS")=0 | |
| 6329 | "RTN","PSO NEW1",22,0 ) | |
| 6330 | . S PSONE W("DAYS SU PPLY")=4 | |
| 6331 | "RTN","PSO NEW1",23,0 ) | |
| 6332 | . S PSONE W("DOSE",1 )=100 | |
| 6333 | "RTN","PSO NEW1",24,0 ) | |
| 6334 | . S PSONE W("DOSE OR DERED",1)= 1 | |
| 6335 | "RTN","PSO NEW1",25,0 ) | |
| 6336 | . S PSONE W("DURATIO N",1)=4 | |
| 6337 | "RTN","PSO NEW1",26,0 ) | |
| 6338 | . S PSONE W("QTY")=4 | |
| 6339 | "RTN","PSO NEW1",27,0 ) | |
| 6340 | . S PSONE W("ENT")=1 | |
| 6341 | "RTN","PSO NEW1",28,0 ) | |
| 6342 | . ;/MZR A dded next line to as sure check for durat ion in PSO ORED5 | |
| 6343 | "RTN","PSO NEW1",29,0 ) | |
| 6344 | . S CLOZF LG=1 | |
| 6345 | "RTN","PSO NEW1",30,0 ) | |
| 6346 | S PSONEW( "FLD")=31 D DOSE^PSO DIR(.PSONE W) ; Get D osing | |
| 6347 | "RTN","PSO NEW1",31,0 ) | |
| 6348 | ;/RBN - E ND CHANGES PSO*7.0*4 57 | |
| 6349 | "RTN","PSO NEW1",32,0 ) | |
| 6350 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6351 | "RTN","PSO NEW1",33,0 ) | |
| 6352 | ; | |
| 6353 | "RTN","PSO NEW1",34,0 ) | |
| 6354 | 32 I '$G(P SONEW("ENT ")) W !,"I ncomplete Dosaging D ata!",! K DIRUT G 31 | |
| 6355 | "RTN","PSO NEW1",35,0 ) | |
| 6356 | S PSONEW( "FLD")=32 D INS^PSOD IR(.PSONEW ) ; Get Pa tient Inst ructions | |
| 6357 | "RTN","PSO NEW1",36,0 ) | |
| 6358 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6359 | "RTN","PSO NEW1",37,0 ) | |
| 6360 | I $P($G(^ PS(55,PSOD FN,"LAN")) ,"^") D SI NS^PSODIR( .PSONEW) | |
| 6361 | "RTN","PSO NEW1",38,0 ) | |
| 6362 | ; | |
| 6363 | "RTN","PSO NEW1",39,0 ) | |
| 6364 | 4 D EN^PSO FSIG(.PSON EW) I $O(S IG(0)) S S IGOK=1 | |
| 6365 | "RTN","PSO NEW1",40,0 ) | |
| 6366 | ; | |
| 6367 | "RTN","PSO NEW1",41,0 ) | |
| 6368 | 7 S PSONEW ("FLD")=7 D DAYS^PSO DIR1(.PSON EW) ; Get days suppl y | |
| 6369 | "RTN","PSO NEW1",42,0 ) | |
| 6370 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6371 | "RTN","PSO NEW1",43,0 ) | |
| 6372 | ; | |
| 6373 | "RTN","PSO NEW1",44,0 ) | |
| 6374 | 5 S PSONEW ("FLD")=5 D QTY^PSOD IR1(.PSONE W) ; Get q uantity | |
| 6375 | "RTN","PSO NEW1",45,0 ) | |
| 6376 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6377 | "RTN","PSO NEW1",46,0 ) | |
| 6378 | ; | |
| 6379 | "RTN","PSO NEW1",47,0 ) | |
| 6380 | 6 I $P($G( PSOPAR),"^ ",15) S PS ONEW("FLD" )=6 D COPI ES^PSODIR1 (.PSONEW) ; Get labe l copies | |
| 6381 | "RTN","PSO NEW1",48,0 ) | |
| 6382 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6383 | "RTN","PSO NEW1",49,0 ) | |
| 6384 | ; | |
| 6385 | "RTN","PSO NEW1",50,0 ) | |
| 6386 | ;/RBN - B EGIN CHANG ES PSO*7.0 *457 | |
| 6387 | "RTN","PSO NEW1",51,0 ) | |
| 6388 | 8 I $G(^TM P("CLOZFLG ",PSODFN)) G 9 | |
| 6389 | "RTN","PSO NEW1",52,0 ) | |
| 6390 | S PSONEW( "FLD")=8 D REFILL^PS ODIR1(.PSO NEW) ; Get # of refi lls | |
| 6391 | "RTN","PSO NEW1",53,0 ) | |
| 6392 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6393 | "RTN","PSO NEW1",54,0 ) | |
| 6394 | ;/RBN - E ND CHANGES PSO*7.0*4 57 | |
| 6395 | "RTN","PSO NEW1",55,0 ) | |
| 6396 | ; | |
| 6397 | "RTN","PSO NEW1",56,0 ) | |
| 6398 | 9 S PSONEW ("FLD")=9 D PROV^PSO DIR(.PSONE W) ; Get P rovider | |
| 6399 | "RTN","PSO NEW1",57,0 ) | |
| 6400 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6401 | "RTN","PSO NEW1",58,0 ) | |
| 6402 | G:$G(DUZ( "AG"))'="I " 11 | |
| 6403 | "RTN","PSO NEW1",59,0 ) | |
| 6404 | ; | |
| 6405 | "RTN","PSO NEW1",60,0 ) | |
| 6406 | 10 Q:$G(DU Z("AG"))'= "I" S PSO NEW("FLD") =10 D EXP^ PSODIR2(.P SONEW) ; G et Expirat ion Date - Indian He alth Servi ce ONLY | |
| 6407 | "RTN","PSO NEW1",61,0 ) | |
| 6408 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6409 | "RTN","PSO NEW1",62,0 ) | |
| 6410 | ; | |
| 6411 | "RTN","PSO NEW1",63,0 ) | |
| 6412 | 11 S PSONE W("FLD")=1 1 D CLINIC ^PSODIR2(. PSONEW) ; Get Clinic | |
| 6413 | "RTN","PSO NEW1",64,0 ) | |
| 6414 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6415 | "RTN","PSO NEW1",65,0 ) | |
| 6416 | ; | |
| 6417 | "RTN","PSO NEW1",66,0 ) | |
| 6418 | 12 S PSONE W("FLD")=1 2 D MW^PSO DIR2(.PSON EW) ; Get Mail/Windo w Info | |
| 6419 | "RTN","PSO NEW1",67,0 ) | |
| 6420 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6421 | "RTN","PSO NEW1",68,0 ) | |
| 6422 | ; | |
| 6423 | "RTN","PSO NEW1",69,0 ) | |
| 6424 | 13 S PSONE W("FLD")=1 3 D RMK^PS ODIR2(.PSO NEW) ; Get Remarks | |
| 6425 | "RTN","PSO NEW1",70,0 ) | |
| 6426 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6427 | "RTN","PSO NEW1",71,0 ) | |
| 6428 | ; | |
| 6429 | "RTN","PSO NEW1",72,0 ) | |
| 6430 | 14 S PSONE W("FLD")=1 4 D ISSDT^ PSODIR2(.P SONEW) ; G et Issue D ate | |
| 6431 | "RTN","PSO NEW1",73,0 ) | |
| 6432 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6433 | "RTN","PSO NEW1",74,0 ) | |
| 6434 | ; | |
| 6435 | "RTN","PSO NEW1",75,0 ) | |
| 6436 | 15 S PSONE W("FLD")=1 5 D FILLDT ^PSODIR2(. PSONEW) ; Get Fill d ate | |
| 6437 | "RTN","PSO NEW1",76,0 ) | |
| 6438 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6439 | "RTN","PSO NEW1",77,0 ) | |
| 6440 | ; | |
| 6441 | "RTN","PSO NEW1",78,0 ) | |
| 6442 | 16 S PSONE W("FLD")=1 6 D CLERK^ PSODIR2(.P SONEW) ; G et Clerk C ode | |
| 6443 | "RTN","PSO NEW1",79,0 ) | |
| 6444 | G:PSONEW( "DFLG") EN D G:PSONEW ("FIELD") @PSONEW("F IELD") | |
| 6445 | "RTN","PSO NEW1",80,0 ) | |
| 6446 | ; | |
| 6447 | "RTN","PSO NEW1",81,0 ) | |
| 6448 | END ; | |
| 6449 | "RTN","PSO NEW1",82,0 ) | |
| 6450 | K PSONEW1 ,^TMP("CLO ZFLG",PSOD FN) | |
| 6451 | "RTN","PSO NEW1",83,0 ) | |
| 6452 | Q | |
| 6453 | "RTN","PSO NEW1",84,0 ) | |
| 6454 | ; | |
| 6455 | "RTN","PSO NEW1",85,0 ) | |
| 6456 | JUMP ; | |
| 6457 | "RTN","PSO NEW1",86,0 ) | |
| 6458 | S PSONEW( "FIELD")=$ S(+Y=.01:1 ,+Y=3:2,+Y =6:3,+Y=10 :4,+Y=7:5, +Y=10.6:6, +Y=8:7,+Y= 9:8,+Y=4:9 ,+Y=29:10, +Y=5:11,+Y =11:12,+Y= 12:13,+Y=1 :14,+Y=22: 15,+Y=16:1 6,+Y=113:3 1,+Y=114:3 2,1:PSONEW ("FLD")) | |
| 6459 | "RTN","PSO NEW1",87,0 ) | |
| 6460 | I PSONEW( "FIELD")>P SONEW("FLD ") W !,$C( 7),"Cannot jump ahea d ..",! S PSONEW("FI ELD")=PSON EW("FLD") | |
| 6461 | "RTN","PSO NEW1",88,0 ) | |
| 6462 | Q | |
| 6463 | "RTN","PSO ORED1") | |
| 6464 | 0^10^B6823 6350 | |
| 6465 | "RTN","PSO ORED1",1,0 ) | |
| 6466 | PSOORED1 ; ISC-BHAM/S AB - edit orders fro m backdoor ; 25 Oct 2017 9:42 AM | |
| 6467 | "RTN","PSO ORED1",2,0 ) | |
| 6468 | ;;7.0;OUT PATIENT PH ARMACY;**5 ,23,46,78, 114,117,13 1,146,223, 148,244,24 9,268,206, 313,444,45 7**;DEC 19 97;Build 6 5 | |
| 6469 | "RTN","PSO ORED1",3,0 ) | |
| 6470 | ;External reference ^PS(55 su pported by DBIA 2228 | |
| 6471 | "RTN","PSO ORED1",4,0 ) | |
| 6472 | ;External reference ^PS(50.7 supported by DBIA 22 23 | |
| 6473 | "RTN","PSO ORED1",5,0 ) | |
| 6474 | ; | |
| 6475 | "RTN","PSO ORED1",6,0 ) | |
| 6476 | ;*244 cal l to remov e DC'd Rx' s from Rx ien string s | |
| 6477 | "RTN","PSO ORED1",7,0 ) | |
| 6478 | ; | |
| 6479 | "RTN","PSO ORED1",8,0 ) | |
| 6480 | EN(PSORENW ) ; | |
| 6481 | "RTN","PSO ORED1",9,0 ) | |
| 6482 | N LST,ORD ,ORN K VAL MBCK,PSORX ("FN") S P SOAC=1,(PS ORX("QFLG" ),PSORX("D FLG"))=0 ; D DREN^PSO ORNW2,INIT | |
| 6483 | "RTN","PSO ORED1",10, 0) | |
| 6484 | D INIT | |
| 6485 | "RTN","PSO ORED1",11, 0) | |
| 6486 | D @$S($P( PSOPAR,"^" ,7):"AUTO^ PSONRXN",1 :"MANUAL^P SONRXN") | |
| 6487 | "RTN","PSO ORED1",12, 0) | |
| 6488 | I '$D(PSO NEW("RX #" )),'$P(PSO PAR,"^",7) D PAUSE^V ALM1 K VAL MSG,PSONEW ("QFLG") S VALMBCK=" Q" Q | |
| 6489 | "RTN","PSO ORED1",13, 0) | |
| 6490 | I '$D(PSO NEW("RX #" )) K VALMS G D DEL^PS ONEW,PAUSE ^VALM1 S V ALMBCK="Q" Q | |
| 6491 | "RTN","PSO ORED1",14, 0) | |
| 6492 | S PSORENW ("RX #")=P SONEW("RX #") I '$P( PSOPAR,"^" ,7) D Q:$ G(PSONEW(" DFLG"))!($ G(PSONEW(" QFLG"))) | |
| 6493 | "RTN","PSO ORED1",15, 0) | |
| 6494 | .S PSOX=P SORENW("RX #") D CHE CK^PSONRXN | |
| 6495 | "RTN","PSO ORED1",16, 0) | |
| 6496 | I $G(PSON EW("DFLG") )!$G(PSONE W("QFLG")) D DEL^PSO NEW,PAUSE^ VALM1 S VA LMBCK="Q" K PSORENW Q | |
| 6497 | "RTN","PSO ORED1",17, 0) | |
| 6498 | D EN^PSOO RNE1(.PSOR ENW) I '$G (PSORX("FN ")) D:$P($ G(PSOPAR), "^",7)=1 S VALMBCK= "Q" Q | |
| 6499 | "RTN","PSO ORED1",18, 0) | |
| 6500 | .S DIE="^ PS(59,",DA =PSOSITE,P SOY=$O(PSO NEW("OLD L AST RX#"," ")),PSOX=P SONEW("OLD LAST RX#" ,PSOY) | |
| 6501 | "RTN","PSO ORED1",19, 0) | |
| 6502 | .L +^PS(5 9,+PSOSITE ,PSOY):$S( +$G(^DD("D ILOCKTM")) >0:+^DD("D ILOCKTM"), 1:3) | |
| 6503 | "RTN","PSO ORED1",20, 0) | |
| 6504 | .S DR=$S( PSOY=8:"20 03////"_PS OX,PSOY=3: "1002.1/// /"_PSOX,1: "2003////" _PSOX) | |
| 6505 | "RTN","PSO ORED1",21, 0) | |
| 6506 | .D:PSOX<$ $GET1^DIQ( 59,+PSOSIT E,+DR,"I") ^DIE K DI E,X,Y L -^ PS(59,+PSO SITE,PSOY) | |
| 6507 | "RTN","PSO ORED1",22, 0) | |
| 6508 | .I $D(PSO NEW("RX #" )) L -^PSR X("B",PSON EW("RX #") ) | |
| 6509 | "RTN","PSO ORED1",23, 0) | |
| 6510 | .K PSOX,P SOY Q | |
| 6511 | "RTN","PSO ORED1",24, 0) | |
| 6512 | Q:$G(COPY ) | |
| 6513 | "RTN","PSO ORED1",25, 0) | |
| 6514 | TRY S $P(^ PSRX(PSORE NW("OIRXN" ),"STA")," ^")=15,DA= PSORENW("O IRXN") | |
| 6515 | "RTN","PSO ORED1",26, 0) | |
| 6516 | S $P(^PSR X(DA,3),"^ ",5)=DT,$P (^PSRX(DA, 3),"^",10) =$P(^PSRX( DA,3),"^") | |
| 6517 | "RTN","PSO ORED1",27, 0) | |
| 6518 | D REVERSE ^PSOBPSU1( DA,,"DC",7 ),CAN^PSOT PCAN(DA) | |
| 6519 | "RTN","PSO ORED1",28, 0) | |
| 6520 | D RMP^PSO CAN3 ;*244 | |
| 6521 | "RTN","PSO ORED1",29, 0) | |
| 6522 | ;cancel/d iscontinue action | |
| 6523 | "RTN","PSO ORED1",30, 0) | |
| 6524 | S PHARM=" ",STAT="RP ",COMM="Pr escription discontin ued due to editing." D EN^PSOH LSN1(DA,ST AT,PHARM,C OMM,PSONOO R) K STAT, PHARM,COMM | |
| 6525 | "RTN","PSO ORED1",31, 0) | |
| 6526 | S ACOM="D iscontinue d due to e diting. Ne w Rx creat ed "_$$GET 1^DIQ(52,P SORENW("IR XN"),.01," I")_"." | |
| 6527 | "RTN","PSO ORED1",32, 0) | |
| 6528 | I $G(^PSR X(DA,"H")) ]"" D | |
| 6529 | "RTN","PSO ORED1",33, 0) | |
| 6530 | .I $$GET1 ^DIQ(52,DA ,100,"I")= 3!($$GET1^ DIQ(52,DA, 100,"I")=1 6) D | |
| 6531 | "RTN","PSO ORED1",34, 0) | |
| 6532 | ..S DIE=5 2,DR="22// /"_$$GET1^ DIQ(52,DA, 101,"I") D ^DIE S AC OM="Discon tinued due to editin g while on hold. " K :$P(^PSRX( DA,"H"),"^ ") ^PSRX(" AH",$P(^PS RX(DA,"H") ,"^"),DA) | |
| 6533 | "RTN","PSO ORED1",35, 0) | |
| 6534 | ..S ^PSRX (DA,"H")=" " | |
| 6535 | "RTN","PSO ORED1",36, 0) | |
| 6536 | S RXDA=DA ,(DA,SUSDA )=$O(^PS(5 2.5,"B",RX DA,0)) D:D A | |
| 6537 | "RTN","PSO ORED1",37, 0) | |
| 6538 | .S SUSD=$ P($G(^PS(5 2.5,DA,0)) ,"^",2) | |
| 6539 | "RTN","PSO ORED1",38, 0) | |
| 6540 | .S:+$G(^P S(52.5,DA, "P"))'=1 A COM="Disco ntinued du e to editi ng while s uspended." | |
| 6541 | "RTN","PSO ORED1",39, 0) | |
| 6542 | .I $O(^PS RX(RXDA,1, 0)) S DA=R XDA D:'$G( ^PS(52.5,+ SUSDA,"P") ) REF^PSOC AN2 | |
| 6543 | "RTN","PSO ORED1",40, 0) | |
| 6544 | .S DA=SUS DA,DIK="^P S(52.5," D ^DIK K DI K | |
| 6545 | "RTN","PSO ORED1",41, 0) | |
| 6546 | K SUSD,SU SDA S DA=R XDA,RXREF= 0,PSODFN=+ $P(^PSRX(D A,0),"^",2 ) D | |
| 6547 | "RTN","PSO ORED1",42, 0) | |
| 6548 | .S ACNT=0 F SUB=0:0 S SUB=$O( ^PSRX(DA," A",SUB)) Q :'SUB S A CNT=SUB | |
| 6549 | "RTN","PSO ORED1",43, 0) | |
| 6550 | .S RFCNT= 0 F RF=0:0 S RF=$O(^ PSRX(DA,1, RF)) Q:'RF S RFCNT= RF S:RF>5 RFCNT=RF+1 | |
| 6551 | "RTN","PSO ORED1",44, 0) | |
| 6552 | .D NOW^%D TC S ^PSRX (DA,"A",0) ="^52.3DA^ "_(ACNT+1) _"^"_(ACNT +1),^PSRX( DA,"A",ACN T+1,0)=%_" ^C^"_DUZ_" ^"_RFCNT_" ^"_$G(ACOM ) | |
| 6553 | "RTN","PSO ORED1",45, 0) | |
| 6554 | .I $G(PSO OIFLG),'$G (PSOMRFLG) S $P(^PSR X(DA,"A",A CNT+1,1)," ^")="Pharm acy Ordera ble Item E dited." | |
| 6555 | "RTN","PSO ORED1",46, 0) | |
| 6556 | .I '$G(PS OOIFLG),$G (PSOMRFLG) S $P(^PSR X(DA,"A",A CNT+1,1)," ^")="Medic ation Rout e/Schedule Edited." | |
| 6557 | "RTN","PSO ORED1",47, 0) | |
| 6558 | .I $G(PSO OIFLG),$G( PSOMRFLG) S $P(^PSRX (DA,"A",AC NT+1,1),"^ ")="Pharma cy Orderab le Item an d Medicati on Route/S chedule Ed ited." | |
| 6559 | "RTN","PSO ORED1",48, 0) | |
| 6560 | .S REA="C " D EXP^PS OHELP1 | |
| 6561 | "RTN","PSO ORED1",49, 0) | |
| 6562 | I $G(^PS( 52.4,DA,0) )]"" S PSC DA=DA,DIK= "^PS(52.4, " D ^DIK S DA=PSCDA K DIK,PSCD A | |
| 6563 | "RTN","PSO ORED1",50, 0) | |
| 6564 | Q | |
| 6565 | "RTN","PSO ORED1",51, 0) | |
| 6566 | INS K X,QU IT,Y,DIR,D IRUT,DUOUT ,DTOUT,DIC ,INSDEL,UP MI,^TMP($J ,"INS1") | |
| 6567 | "RTN","PSO ORED1",52, 0) | |
| 6568 | I '$O(^PS RX(PSORXED ("IRXN"),6 ,0)),'$O(P SORXED("DO SE",0)) D UPMI Q:$G( QUIT) ;G INS1 | |
| 6569 | "RTN","PSO ORED1",53, 0) | |
| 6570 | I $G(^PSR X(PSORXED( "IRXN"),"I NS"))]"" S PSORXED(" FLD",114)= ^PSRX(PSOR XED("IRXN" ),"INS") K UPMI G IN S1 | |
| 6571 | "RTN","PSO ORED1",54, 0) | |
| 6572 | K DD,GG F I=0:0 S I =$O(^PSRX( PSORXED("I RXN"),"INS 1",I)) Q:' I S DD=$G (DD)+1 | |
| 6573 | "RTN","PSO ORED1",55, 0) | |
| 6574 | I $G(DD)= 1 S PSORXE D("FLD",11 4)=^PSRX(P SORXED("IR XN"),"INS1 ",$O(^PSRX (PSORXED(" IRXN"),"IN S1",0)),0) K UPMI,DD G INS1 | |
| 6575 | "RTN","PSO ORED1",56, 0) | |
| 6576 | I $O(^PSR X(PSORXED( "IRXN"),"I NS1",0)) D G INSX | |
| 6577 | "RTN","PSO ORED1",57, 0) | |
| 6578 | .F I=0:0 S I=$O(^PS RX(PSORXED ("IRXN")," INS1",I)) Q:'I S ^T MP($J,"INS 1",I,0)=^P SRX(PSORXE D("IRXN"), "INS1",I,0 ) | |
| 6579 | "RTN","PSO ORED1",58, 0) | |
| 6580 | .S ^TMP($ J,"INS1",0 )=^PSRX(PS ORXED("IRX N"),"INS1" ,0) | |
| 6581 | "RTN","PSO ORED1",59, 0) | |
| 6582 | .S DIC="^ TMP($J,""I NS1"",",DW PK=2,DWLW= 80 D EN^DI WE I $G(X) ="^" K ^TM P($J,"INS1 ") Q | |
| 6583 | "RTN","PSO ORED1",60, 0) | |
| 6584 | .I '$O(^T MP($J,"INS 1",0)) S I NSDEL=1 | |
| 6585 | "RTN","PSO ORED1",61, 0) | |
| 6586 | .S D=0 F S D=$O(^P SRX(PSORXE D("IRXN"), "INS1",D)) Q:'D S P SORXED("SI G",D)=^PSR X(PSORXED( "IRXN"),"I NS1",D,0) | |
| 6587 | "RTN","PSO ORED1",62, 0) | |
| 6588 | INS1 K Y,D IR,DIRUT,D UOUT,DTOUT ,DIC,X | |
| 6589 | "RTN","PSO ORED1",63, 0) | |
| 6590 | I $G(UPMI ) K UPMI I $G(^PS(50 .7,PSODRUG ("OI"),"IN S"))]"" S PSORXED("F LD",114)=^ PS(50.7,PS ODRUG("OI" ),"INS") | |
| 6591 | "RTN","PSO ORED1",64, 0) | |
| 6592 | S:$G(PSOR XED("FLD", 114))]"" D IR("B")=PS ORXED("FLD ",114) | |
| 6593 | "RTN","PSO ORED1",65, 0) | |
| 6594 | S DIR("?" )="Enter Q uick codes or Free T ext",DIR(0 )="52,114" D ^DIR | |
| 6595 | "RTN","PSO ORED1",66, 0) | |
| 6596 | I $D(DTOU T)!($D(DUO UT))!($G(P SORXED("FL D",114))=X ) K PSORXE D("FLD",11 4) G INSX | |
| 6597 | "RTN","PSO ORED1",67, 0) | |
| 6598 | I X'="",X '="@" D SI G^PSOHELP G INS1:'$D (X) | |
| 6599 | "RTN","PSO ORED1",68, 0) | |
| 6600 | S PSORXED ("FLD",114 )=X | |
| 6601 | "RTN","PSO ORED1",69, 0) | |
| 6602 | I $G(INS1 )]"" W " ( "_$E(INS1, 2,9999999) _")" | |
| 6603 | "RTN","PSO ORED1",70, 0) | |
| 6604 | G:(X']""! (X="@")) I NSX | |
| 6605 | "RTN","PSO ORED1",71, 0) | |
| 6606 | S (PSORXE D("INS"),P SORXED("SI G",1))=$E( INS1,2,999 9999) D EN ^PSOFSIG(. PSORXED) | |
| 6607 | "RTN","PSO ORED1",72, 0) | |
| 6608 | INSX I $P( $G(^PS(55, PSODFN,"LA N")),"^") K DIR D | |
| 6609 | "RTN","PSO ORED1",73, 0) | |
| 6610 | .I $G(^PS RX(PSORXED ("IRXN")," INSS"))]"" S PSORXED ("SINS")=^ PSRX(PSORX ED("IRXN") ,"INSS") | |
| 6611 | "RTN","PSO ORED1",74, 0) | |
| 6612 | .D SINS^P SODIR(.PSO RXED) I $G (PSORXED(" SINS"))']" " K ^PSRX( PSORXED("I RXN"),"INS S") Q | |
| 6613 | "RTN","PSO ORED1",75, 0) | |
| 6614 | .S PSORXE D("FLD",11 4.1)=PSORX ED("SINS") | |
| 6615 | "RTN","PSO ORED1",76, 0) | |
| 6616 | K DIRUT,D UOUT,DTOUT ,DIR,X,Y,D IC,DWPK | |
| 6617 | "RTN","PSO ORED1",77, 0) | |
| 6618 | Q | |
| 6619 | "RTN","PSO ORED1",78, 0) | |
| 6620 | INIT ;setu p psorenw array | |
| 6621 | "RTN","PSO ORED1",79, 0) | |
| 6622 | S PSORENW ("RX0")=^P SRX(PSOREN W("IRXN"), 0),PSORENW ("RX2")=^( 2),PSORENW ("RX3")=^( 3),PSORENW ("STA")=^( "STA"),PSO RENW("TN") =$G(^("TN" )) | |
| 6623 | "RTN","PSO ORED1",80, 0) | |
| 6624 | I $G(PSOS IGFL),$G(P SORX("SIG" ))]"" S PS ORENW("SIG ")=PSORX(" SIG"),SIGO K=0 | |
| 6625 | "RTN","PSO ORED1",81, 0) | |
| 6626 | E D | |
| 6627 | "RTN","PSO ORED1",82, 0) | |
| 6628 | .I '$P($G (^PSRX(PSO RENW("IRXN "),"SIG")) ,"^",2) S PSORENW("S IG")=$P($G (^("SIG")) ,"^") | |
| 6629 | "RTN","PSO ORED1",83, 0) | |
| 6630 | .E D | |
| 6631 | "RTN","PSO ORED1",84, 0) | |
| 6632 | ..S SIGOK =1 Q:$O(SI G(0)) | |
| 6633 | "RTN","PSO ORED1",85, 0) | |
| 6634 | ..S D=0 F I=0:0 S D =D+1,I=$O( ^PSRX(PSOR ENW("IRXN" ),"SIG1",I )) Q:'I S SIG(D)=^P SRX(PSOREN W("IRXN"), "SIG1",I,0 ) | |
| 6635 | "RTN","PSO ORED1",86, 0) | |
| 6636 | ..K PSOX1 ,D | |
| 6637 | "RTN","PSO ORED1",87, 0) | |
| 6638 | S PSORENW ("OIRXN")= PSORENW("I RXN") | |
| 6639 | "RTN","PSO ORED1",88, 0) | |
| 6640 | S PSORENW ("PROVIDER ")=$S($G(P SORENW("PR OVIDER")): PSORENW("P ROVIDER"), 1:$P(PSORE NW("RX0"), "^",4)) | |
| 6641 | "RTN","PSO ORED1",89, 0) | |
| 6642 | S (PSOREN W("PROVIDE R NAME"),P SORX("PROV IDER NAME" ))=$P($G(^ VA(200,PSO RENW("PROV IDER"),0)) ,"^") | |
| 6643 | "RTN","PSO ORED1",90, 0) | |
| 6644 | I $P($G(^ VA(200,PSO RENW("PROV IDER"),"PS ")),"^",7) ,$P($G(^(" PS")),"^", 8) S PSORE NW("COSIGN ING PROVID ER")=$P($G (^("PS")), "^",8) | |
| 6645 | "RTN","PSO ORED1",91, 0) | |
| 6646 | S PSORENW ("CLINIC") =$S($G(PSO RENW("CLIN IC")):PSOR ENW("CLINI C"),1:$P(P SORENW("RX 0"),"^",5) ) | |
| 6647 | "RTN","PSO ORED1",92, 0) | |
| 6648 | S PSORENW ("REMARKS" )="New Ord er Created by "_$S($ G(COPY)&(' $G(PSOEDIT )):"copyin g",1:"edit ing")_" Rx # "_$P(PS ORENW("RX0 "),"^")_". " | |
| 6649 | "RTN","PSO ORED1",93, 0) | |
| 6650 | ; | |
| 6651 | "RTN","PSO ORED1",94, 0) | |
| 6652 | ; - Maint enance Dos e Rx Remar ks field | |
| 6653 | "RTN","PSO ORED1",95, 0) | |
| 6654 | I $G(PSOM TFLG) S PS ORENW("REM ARKS")="Ma intenance Rx created from Titr ation Rx# "_$P(PSORE NW("RX0"), "^")_"." | |
| 6655 | "RTN","PSO ORED1",96, 0) | |
| 6656 | ; | |
| 6657 | "RTN","PSO ORED1",97, 0) | |
| 6658 | S PSORENW ("COSIGNER ")=$S($G(P SORENW("CO SIGNER")): PSORENW("C OSIGNER"), $P(PSORENW ("RX3"),"^ ",3):$P(PS ORENW("RX3 "),"^",3), 1:"") | |
| 6659 | "RTN","PSO ORED1",98, 0) | |
| 6660 | K:PSORENW ("COSIGNER ")="" PSOR ENW("COSIG NER") | |
| 6661 | "RTN","PSO ORED1",99, 0) | |
| 6662 | S PSORENW ("PSODFN") =$P(PSOREN W("RX0")," ^",2) | |
| 6663 | "RTN","PSO ORED1",100 ,0) | |
| 6664 | S PSORENW ("ORX #")= $P(PSORENW ("RX0"),"^ ") | |
| 6665 | "RTN","PSO ORED1",101 ,0) | |
| 6666 | S:$G(PSOD RUG("IEN") ) PSORENW( "DRUG IEN" )=PSODRUG( "IEN") | |
| 6667 | "RTN","PSO ORED1",102 ,0) | |
| 6668 | ; | |
| 6669 | "RTN","PSO ORED1",103 ,0) | |
| 6670 | ;; START NCC REMEDI ATION >> 4 57*RJS - A DJUST MAX DAYS SUPPL Y FOR 4 DA Y SUPPLY | |
| 6671 | "RTN","PSO ORED1",104 ,0) | |
| 6672 | I $$GET1^ DIQ(50,+$G (PSODRUG(" IEN")),17. 5)="PSOCLO 1",$P(PSOR ENW("RX0") ,"^",8)<5 S PSORENW( "DAYS SUPP LY")=$P(PS ORENW("RX0 "),"^",8) | |
| 6673 | "RTN","PSO ORED1",105 ,0) | |
| 6674 | ;; END NC C REMEDIAT ION << 457 *RJS | |
| 6675 | "RTN","PSO ORED1",106 ,0) | |
| 6676 | ; | |
| 6677 | "RTN","PSO ORED1",107 ,0) | |
| 6678 | I $G(PSOR ENW("DAYS SUPPLY")) G QTY | |
| 6679 | "RTN","PSO ORED1",108 ,0) | |
| 6680 | S PSORENW ("DAYS SUP PLY")=$S($ D(CLOZPAT) :7,1:$P(PS ORENW("RX0 "),"^",8)) | |
| 6681 | "RTN","PSO ORED1",109 ,0) | |
| 6682 | QTY S PSOR ENW("QTY") =$S($G(PSO RENW("QTY" )):PSORENW ("QTY"),1: $P(PSORENW ("RX0"),"^ ",7)) | |
| 6683 | "RTN","PSO ORED1",110 ,0) | |
| 6684 | RFN S PSOR ENW("# OF REFILLS")= $S($D(CLOZ PAT):0,$G( PSORENW("# OF REFILL S")):PSORE NW("# OF R EFILLS"),1 :$P(PSOREN W("RX0")," ^",9)) | |
| 6685 | "RTN","PSO ORED1",111 ,0) | |
| 6686 | S (PSOID, Y,PSORENW( "FILL DATE "),PSORENW ("ISSUE DA TE"))=DT | |
| 6687 | "RTN","PSO ORED1",112 ,0) | |
| 6688 | ; | |
| 6689 | "RTN","PSO ORED1",113 ,0) | |
| 6690 | ; - Maint enance Rx Fill Date is set wit h Next Pos sible Fill from Titr ation Rx | |
| 6691 | "RTN","PSO ORED1",114 ,0) | |
| 6692 | I $G(PSOM TFLG),$P($ G(PSORENW( "RX3")),"^ ",2)>DT S PSORENW("F ILL DATE") =$P(PSOREN W("RX3")," ^",2) | |
| 6693 | "RTN","PSO ORED1",115 ,0) | |
| 6694 | ; | |
| 6695 | "RTN","PSO ORED1",116 ,0) | |
| 6696 | S:PSORENW ("CLINIC") PSORX("CL INIC")=$P( ^SC(+PSORE NW("CLINIC "),0),"^") | |
| 6697 | "RTN","PSO ORED1",117 ,0) | |
| 6698 | S PSORENW ("PATIENT STATUS")=$ S($G(PSORE NW("PATIEN T STATUS") ):PSORENW( "PATIENT S TATUS"),'$ P(PSORENW( "RX0"),"^" ,3):$G(^PS (55,PSOREN W("PSODFN" ),"PS")),1 :$P(PSOREN W("RX0")," ^",3)) | |
| 6699 | "RTN","PSO ORED1",118 ,0) | |
| 6700 | S PSORENW ("PTST NOD E")=$G(^PS (53,PSOREN W("PATIENT STATUS"), 0)) | |
| 6701 | "RTN","PSO ORED1",119 ,0) | |
| 6702 | S PSDAYS= $S($G(PSOR ENW("DAYS SUPPLY")): PSORENW("D AYS SUPPLY "),'$P(PSO RENW("RX0" ),"^",8):$ P(PSORENW( "PTST NODE "),"^",3), 1:$P(PSORE NW("RX0"), "^",8)) | |
| 6703 | "RTN","PSO ORED1",120 ,0) | |
| 6704 | I $G(PSOD RUG("IEN") ) S DREN=P SODRUG("IE N"),POERR= 1 D DRG^PS OORDRG K P OERR | |
| 6705 | "RTN","PSO ORED1",121 ,0) | |
| 6706 | D:$G(PSOR ENW("# OF REFILLS")) ']"" RF | |
| 6707 | "RTN","PSO ORED1",122 ,0) | |
| 6708 | ; | |
| 6709 | "RTN","PSO ORED1",123 ,0) | |
| 6710 | ; - Maint enance Rx # of Refil ls adjustm ent | |
| 6711 | "RTN","PSO ORED1",124 ,0) | |
| 6712 | I $G(PSOM TFLG),$G(P SORENW("# OF REFILLS "))>0 S PS ORENW("# O F REFILLS" )=PSORENW( "# OF REFI LLS")-1 | |
| 6713 | "RTN","PSO ORED1",125 ,0) | |
| 6714 | ; | |
| 6715 | "RTN","PSO ORED1",126 ,0) | |
| 6716 | S PSORENW ("MAIL/WIN DOW")=$S($ G(PSORENW( "MAIL/WIND OW"))]"":P SORENW("MA IL/WINDOW" ),1:$P(PSO RENW("RX0" ),"^",11)) | |
| 6717 | "RTN","PSO ORED1",127 ,0) | |
| 6718 | S PSORX(" MAIL/WINDO W")=$S(PSO RENW("MAIL /WINDOW")= "W":"WINDO W",1:"MAIL ") | |
| 6719 | "RTN","PSO ORED1",128 ,0) | |
| 6720 | S PSORENW ("COPIES") =$S($G(PSO RENW("COPI ES")):PSOR ENW("COPIE S"),$P(PSO RENW("RX0" ),"^",18): $P(PSORENW ("RX0"),"^ ",18),1:1) | |
| 6721 | "RTN","PSO ORED1",129 ,0) | |
| 6722 | S PSORENW ("CLERK CO DE")=DUZ | |
| 6723 | "RTN","PSO ORED1",130 ,0) | |
| 6724 | S:$G(PSOR X("CLERK C ODE"))']"" PSORX("CL ERK CODE") =$P($G(^VA (200,DUZ,0 )),"^") | |
| 6725 | "RTN","PSO ORED1",131 ,0) | |
| 6726 | Q:$D(COPY ) S PSORE NW("ENT")= 0 | |
| 6727 | "RTN","PSO ORED1",132 ,0) | |
| 6728 | K PSORENW ("ENT") F I=0:0 S I= $O(PSORENW ("DOSE",I) ) Q:'I S PSORENW("E NT")=$G(PS ORENW("ENT "))+1 | |
| 6729 | "RTN","PSO ORED1",133 ,0) | |
| 6730 | I $O(^TMP ($J,"INS1" ,0)) D | |
| 6731 | "RTN","PSO ORED1",134 ,0) | |
| 6732 | .K PSORXE D("SIG"),D D | |
| 6733 | "RTN","PSO ORED1",135 ,0) | |
| 6734 | .F I=0:0 S I=$O(^TM P($J,"INS1 ",I)) Q:'I S PSOREN W("SIG",I) =^TMP($J," INS1",I,0) | |
| 6735 | "RTN","PSO ORED1",136 ,0) | |
| 6736 | .K ^TMP($ J,"INS1") | |
| 6737 | "RTN","PSO ORED1",137 ,0) | |
| 6738 | I $G(^PSR X(PSORENW( "IRXN"),"I NS"))]"" S PSORENW(" INS")=^PSR X(PSORENW( "IRXN"),"I NS") | |
| 6739 | "RTN","PSO ORED1",138 ,0) | |
| 6740 | I $G(^PSR X(PSORENW( "IRXN"),"I NSS"))]"" S PSORENW( "SINS")=^P SRX(PSOREN W("IRXN"), "INSS") | |
| 6741 | "RTN","PSO ORED1",139 ,0) | |
| 6742 | I '$G(PSO RENW("ENT" )),'$G(PSO SIGFL) D D OLST1^PSOO RED3(.PSOR ENW) S PSO RENW("ENT" )=+$G(OLEN T) | |
| 6743 | "RTN","PSO ORED1",140 ,0) | |
| 6744 | Q | |
| 6745 | "RTN","PSO ORED1",141 ,0) | |
| 6746 | RF ;# of r efills | |
| 6747 | "RTN","PSO ORED1",142 ,0) | |
| 6748 | ; Retriev ing the Ma ximum Numb er of Refi lls allowe d | |
| 6749 | "RTN","PSO ORED1",143 ,0) | |
| 6750 | S PSORENW ("# OF REF ILLS")=$$M AXNUMRF^PS OUTIL(+$G( PSODRUG("I EN")),PSDA YS,+$G(PSO RENW("PATI ENT STATUS ")),.CLOZP AT) | |
| 6751 | "RTN","PSO ORED1",144 ,0) | |
| 6752 | Q | |
| 6753 | "RTN","PSO ORED1",145 ,0) | |
| 6754 | UPMI ;add dosing dat a for pre- poe rxs | |
| 6755 | "RTN","PSO ORED1",146 ,0) | |
| 6756 | W !! K PS ONEW("DFLG "),DIR,DIR UT,DTOUT,D UOUT S DIR (0)="Y",DI R("B")="No ",DIR("A") ="Dosing I nstruction s Are Miss ing!! Do Y ou Want to Add Them" | |
| 6757 | "RTN","PSO ORED1",147 ,0) | |
| 6758 | D ^DIR I 'Y!($D(DIR UT)) S QUI T=1 K DIR, DIRUT,DUOT ,DUOUT Q | |
| 6759 | "RTN","PSO ORED1",148 ,0) | |
| 6760 | S UPMI=1, EDTHLD=$G( PSORX("EDI T")) K PSO RX("EDIT") | |
| 6761 | "RTN","PSO ORED1",149 ,0) | |
| 6762 | D DOSE1^P SOORED5(.P SORXED) S (PSORXED,P SORX("EDIT "))=EDTHLD K EDTHLD I $G(PSONE W("DFLG")) S QUIT=1 | |
| 6763 | "RTN","PSO ORED1",150 ,0) | |
| 6764 | Q | |
| 6765 | "RTN","PSO ORED5") | |
| 6766 | 0^7^B68317 198 | |
| 6767 | "RTN","PSO ORED5",1,0 ) | |
| 6768 | PSOORED5 ; BIR/SAB-Rx s without dosing inf o ;Jul 24, 2017@15:2 4 | |
| 6769 | "RTN","PSO ORED5",2,0 ) | |
| 6770 | ;;7.0;OUT PATIENT PH ARMACY;**4 6,75,78,10 0,99,117,1 33,251,378 ,372,416,3 13,450,486 ,457**;DEC 1997;Buil d 65 | |
| 6771 | "RTN","PSO ORED5",3,0 ) | |
| 6772 | ;^PS(51.2 - DBIA 22 26 | |
| 6773 | "RTN","PSO ORED5",4,0 ) | |
| 6774 | ;^PS(50.7 - DBIA 22 23 | |
| 6775 | "RTN","PSO ORED5",5,0 ) | |
| 6776 | ;^PSDRUG - DBIA 221 | |
| 6777 | "RTN","PSO ORED5",6,0 ) | |
| 6778 | ;^PS(55 - DBIA 2228 | |
| 6779 | "RTN","PSO ORED5",7,0 ) | |
| 6780 | ;called b y psoored2 and psodi r | |
| 6781 | "RTN","PSO ORED5",8,0 ) | |
| 6782 | ;pre-poe rxs and ne w backdoor rxs | |
| 6783 | "RTN","PSO ORED5",9,0 ) | |
| 6784 | DOSE1(PSOR XED) ;for new rxs | |
| 6785 | "RTN","PSO ORED5",10, 0) | |
| 6786 | DOSE ;pre- poe rx | |
| 6787 | "RTN","PSO ORED5",11, 0) | |
| 6788 | D KV K RO U,STRE,FIE LD,DOSEOR, DUPD,X,Y,U NITS S ENT =1,OLENT=E NT | |
| 6789 | "RTN","PSO ORED5",12, 0) | |
| 6790 | ASK S ROU= "PSOORED5" D ASK^PSO BKDED K RO U G:$D(DIR UT) EXE ; 486 | |
| 6791 | "RTN","PSO ORED5",13, 0) | |
| 6792 | I $G(JUMP ) K JUMP G JUMP | |
| 6793 | "RTN","PSO ORED5",14, 0) | |
| 6794 | I $G(QUIT )]"" K QUI T,ROU Q | |
| 6795 | "RTN","PSO ORED5",15, 0) | |
| 6796 | ; | |
| 6797 | "RTN","PSO ORED5",16, 0) | |
| 6798 | I $G(VERB )]"" S PSO RXED("VERB ",ENT)=VER B G DUPD | |
| 6799 | "RTN","PSO ORED5",17, 0) | |
| 6800 | I $G(PSOR X("EDIT")) ']"" W:$G( PSORXED("V ERB",ENT)) ]"" !,"VER B: "_PSORX ED("VERB", ENT) G DUP D | |
| 6801 | "RTN","PSO ORED5",18, 0) | |
| 6802 | VER D VER^ PSOOREDX | |
| 6803 | "RTN","PSO ORED5",19, 0) | |
| 6804 | I X[U,$L( X)>1 S FIE LD="VER" G JUMP | |
| 6805 | "RTN","PSO ORED5",20, 0) | |
| 6806 | G EX:$D(D TOUT),EXE: $D(DUOUT) I X="@" K PSORXED("V ERB",ENT), VERB G DUP D | |
| 6807 | "RTN","PSO ORED5",21, 0) | |
| 6808 | S:X'="" ( PSORXED("V ERB",ENT), VERB)=X | |
| 6809 | "RTN","PSO ORED5",22, 0) | |
| 6810 | DUPD ; | |
| 6811 | "RTN","PSO ORED5",23, 0) | |
| 6812 | I $G(PSOR XED("DOSE" ,ENT))'?.N &($G(PSORX ED("DOSE", ENT))'?.N1 ".".N)!'DO SE("LD") K PSORXED(" DOSE ORDER ED",ENT),D UPD G NOU1 | |
| 6813 | "RTN","PSO ORED5",24, 0) | |
| 6814 | D KV S DI R(0)="52.0 113,1",DIR ("A")="DIS PENSE UNIT S PER DOSE "_$S($G(PS ORXED("NOU N",ENT))]" ":"("_PSOR XED("NOUN" ,ENT)_")", 1:"") | |
| 6815 | "RTN","PSO ORED5",25, 0) | |
| 6816 | I '$G(PSO RXED("DOSE ",ENT)),$G (PSORXED(" DOSE",ENT- 1)) S PSOR XED("DOSE" ,ENT)=PSOR XED("DOSE" ,ENT-1) | |
| 6817 | "RTN","PSO ORED5",26, 0) | |
| 6818 | S DIR("B" )=$S($G(PS ORXED("DOS E ORDERED" ,ENT))]"": PSORXED("D OSE ORDERE D",ENT),$G (DUPD)]"": DUPD,1:"") S:$E($G(D IR("B")),1 )="." DIR( "B")="0"_$ G(DIR("B") ) K:DIR("B ")="" DIR( "B") | |
| 6819 | "RTN","PSO ORED5",27, 0) | |
| 6820 | D ^DIR I X[U,$L(X)> 1 S FIELD= "DUPD" G J UMP | |
| 6821 | "RTN","PSO ORED5",28, 0) | |
| 6822 | G EX:$D(D TOUT),EXE: $D(DUOUT) | |
| 6823 | "RTN","PSO ORED5",29, 0) | |
| 6824 | I X="@"!( X=0) W !," Dispense U nits Per D ose is Req uired!!",! G DUPD | |
| 6825 | "RTN","PSO ORED5",30, 0) | |
| 6826 | D STR^PSO OREDX | |
| 6827 | "RTN","PSO ORED5",31, 0) | |
| 6828 | ; | |
| 6829 | "RTN","PSO ORED5",32, 0) | |
| 6830 | NOU1 G:'$D (DUPD) RTE D CNON^PS OORED3 N P SONDEF | |
| 6831 | "RTN","PSO ORED5",33, 0) | |
| 6832 | I $G(NOUN )]"",$G(PS ORX("EDIT" ))']"" S P SORXED("NO UN",ENT)=N OUN W !,"N OUN: "_$G( NOUN) G RT E | |
| 6833 | "RTN","PSO ORED5",34, 0) | |
| 6834 | I $G(PSOR X("EDIT")) ']"",$G(PS ORXED("NOU N",ENT))]" " W !,"NOU N: "_PSORX ED("NOUN", ENT) G RTE | |
| 6835 | "RTN","PSO ORED5",35, 0) | |
| 6836 | NOU D NOU^ PSOOREDX I X[U,$L(X) >1 S FIELD ="NOU" G J UMP | |
| 6837 | "RTN","PSO ORED5",36, 0) | |
| 6838 | G EXE:$D( DTOUT)!$D( DUOUT) I X ="@" K PSO RXED("NOUN ",ENT),NOU N G RTE | |
| 6839 | "RTN","PSO ORED5",37, 0) | |
| 6840 | I X'="",$ G(PSONDEF) ="" S NOUN =X | |
| 6841 | "RTN","PSO ORED5",38, 0) | |
| 6842 | I X'="",$ G(PSONDEF) '=X S NOUN =X | |
| 6843 | "RTN","PSO ORED5",39, 0) | |
| 6844 | S:X'="" P SORXED("NO UN",ENT)=X | |
| 6845 | "RTN","PSO ORED5",40, 0) | |
| 6846 | ; | |
| 6847 | "RTN","PSO ORED5",41, 0) | |
| 6848 | RTE I $G(E NT)>1,$G(P SORX("EDIT "))']"",$G (PSORXED(" ROUTE",ENT -1)),$G(PS ORXED("ROU TE",ENT))' ]"" S PSOR XED("ROUTE ",ENT)=PSO RXED("ROUT E",ENT-1) G SCH | |
| 6849 | "RTN","PSO ORED5",42, 0) | |
| 6850 | I '$G(DRE T),'$G(PSO RXED("ROUT E",ENT)),$ P(^PS(50.7 ,PSODRUG(" OI"),0),"^ ",6) S PSO RXED("ROUT E",ENT)=$P (^PS(50.7, PSODRUG("O I"),0),"^" ,6) | |
| 6851 | "RTN","PSO ORED5",43, 0) | |
| 6852 | I $G(DRET ) S PSORXE D("ROUTE", ENT)="" | |
| 6853 | "RTN","PSO ORED5",44, 0) | |
| 6854 | I $G(RTE) K RTE | |
| 6855 | "RTN","PSO ORED5",45, 0) | |
| 6856 | D KV S DI R(0)="FO^2 :45",DIR(" A")="ROUTE ",DIR("?") ="^D HLP^P SOORED4" | |
| 6857 | "RTN","PSO ORED5",46, 0) | |
| 6858 | S DIR("B" )=$S($G(PS ORXED("ROU TE",ENT)): $P(^PS(51. 2,PSORXED( "ROUTE",EN T),0),"^") ,$G(RTE)]" ":RTE,$G(D RET):"",1: "PO") K:DI R("B")="" DIR("B") | |
| 6859 | "RTN","PSO ORED5",47, 0) | |
| 6860 | D ^DIR I X[U,$L(X)> 1 S FIELD= "RTE" G JU MP | |
| 6861 | "RTN","PSO ORED5",48, 0) | |
| 6862 | G EX:$D(D TOUT),EXE: $D(DUOUT) | |
| 6863 | "RTN","PSO ORED5",49, 0) | |
| 6864 | I X="@"!( X="") K RT E,ERTE S D RET=1,PSOR XED("ROUTE ",ENT)="" G SCH | |
| 6865 | "RTN","PSO ORED5",50, 0) | |
| 6866 | K DRET I X=$P($G(^P S(51.2,+$G (PSORXED(" ROUTE",ENT )),0)),"^" ) S RTE=$P (^PS(51.2, PSORXED("R OUTE",ENT) ,0),"^"),E RTE=$P(^PS (51.2,PSOR XED("ROUTE ",ENT),0), "^",2) W X _" "_$G(ER TE) G SCH | |
| 6867 | "RTN","PSO ORED5",51, 0) | |
| 6868 | S DIC=51. 2,DIC(0)=" QEZM",DIC( "S")="I $P (^(0),""^" ",4)" D ^D IC Q:X[U G:Y=-1 RTE W " "_$P (Y(0),"^", 2) | |
| 6869 | "RTN","PSO ORED5",52, 0) | |
| 6870 | S:X'="" P SORXED("RO UTE",ENT)= +Y,RTE=Y(0 ,0),ERTE=$ P(Y(0),"^" ,2) | |
| 6871 | "RTN","PSO ORED5",53, 0) | |
| 6872 | ; | |
| 6873 | "RTN","PSO ORED5",54, 0) | |
| 6874 | SCH D SCH^ PSOBKDED I X[U,$L(X) >1 S FIELD ="SCH" G J UMP | |
| 6875 | "RTN","PSO ORED5",55, 0) | |
| 6876 | G EX:$D(D TOUT),EXE: $D(DUOUT) S SCH=Y D SCH^PSOSIG I $G(SCH) ']"" G SCH | |
| 6877 | "RTN","PSO ORED5",56, 0) | |
| 6878 | S PSORXED ("SCHEDULE ",ENT)=SCH W " ("_SC HEX_")" K SCH,SCHEX, X,Y,PSOSCH | |
| 6879 | "RTN","PSO ORED5",57, 0) | |
| 6880 | S:$G(PSOR XED("ENT") )<ENT PSOR XED("ENT") =ENT | |
| 6881 | "RTN","PSO ORED5",58, 0) | |
| 6882 | ; | |
| 6883 | "RTN","PSO ORED5",59, 0) | |
| 6884 | DUR D KV K EXP S DIR (0)="52.01 13,4",DIR( "A")="LIMI TED DURATI ON (IN DAY S, HOURS O R MINUTES) " | |
| 6885 | "RTN","PSO ORED5",60, 0) | |
| 6886 | I '$G(CLO ZFLG),$G(P SORXED("SA ND")) D | |
| 6887 | "RTN","PSO ORED5",61, 0) | |
| 6888 | .N DFN S DFN=PSODFN D CLOZPAT ^PSOCLUTL | |
| 6889 | "RTN","PSO ORED5",62, 0) | |
| 6890 | K PSORXED ("DURATION ",ENT) | |
| 6891 | "RTN","PSO ORED5",63, 0) | |
| 6892 | I $D(DUR) S DIR("B" )=DUR | |
| 6893 | "RTN","PSO ORED5",64, 0) | |
| 6894 | D ^DIR I X[U,$L(X)> 1 S FIELD= "DUR" G JU MP | |
| 6895 | "RTN","PSO ORED5",65, 0) | |
| 6896 | G EX:$D(D TOUT),EXE: $D(DUOUT) | |
| 6897 | "RTN","PSO ORED5",66, 0) | |
| 6898 | ;; START NCC REMEDI ATION >> 4 57*RJS - A DJUST FOR 4 DAY SUPP LY | |
| 6899 | "RTN","PSO ORED5",67, 0) | |
| 6900 | ;/RBN Beg in modific ation for #326 ;/MZR Added a m essage and correct c hecking fo r Hours/Mi nutes | |
| 6901 | "RTN","PSO ORED5",68, 0) | |
| 6902 | I $G(DIR( "B"))!$G(P SORXED("DU RATION",EN T)) N Z,MA X D I Z>M AX G DUR | |
| 6903 | "RTN","PSO ORED5",69, 0) | |
| 6904 | .I X=+X S Z=X | |
| 6905 | "RTN","PSO ORED5",70, 0) | |
| 6906 | .E S Z=$ E(X,$L(X)) ,Z=$S(Z="L ":30*X,Z=" W":7*X,Z=" H":X/24,Z= "M":X/1440 ,1:+X) | |
| 6907 | "RTN","PSO ORED5",71, 0) | |
| 6908 | .S MAX=$S ($G(DIR("B ")):+DIR(" B"),1:$G(P SORXED("DU RATION",EN T))) | |
| 6909 | "RTN","PSO ORED5",72, 0) | |
| 6910 | .I Z>MAX D | |
| 6911 | "RTN","PSO ORED5",73, 0) | |
| 6912 | ..W " ("_ $S(X["L":" MONTHS",X[ "W":"WEEKS ",X["H":"H OURS",X["M ":"MINUTES ",1:"DAYS" )_")" | |
| 6913 | "RTN","PSO ORED5",74, 0) | |
| 6914 | ..W !,"NO T MORE THA N ",MAX," DAYS" | |
| 6915 | "RTN","PSO ORED5",75, 0) | |
| 6916 | ;; END NC C REMEDIAT ION << 457 *RJS | |
| 6917 | "RTN","PSO ORED5",76, 0) | |
| 6918 | D DUR1^PS OOREDX | |
| 6919 | "RTN","PSO ORED5",77, 0) | |
| 6920 | ; | |
| 6921 | "RTN","PSO ORED5",78, 0) | |
| 6922 | CON D CON^ PSOOREDX I X[U,$L(X) >1 S FIELD ="CON" G J UMP | |
| 6923 | "RTN","PSO ORED5",79, 0) | |
| 6924 | G EX:$D(D TOUT),EXE: $D(DUOUT) | |
| 6925 | "RTN","PSO ORED5",80, 0) | |
| 6926 | I X="@",$ G(PSORXED( "CONJUNCTI ON",ENT))= "" W !,?10 ,"Invalid Entry - no thing to d elete!!" G CON | |
| 6927 | "RTN","PSO ORED5",81, 0) | |
| 6928 | S:X'=""&( X'="@") PS ORXED("CON JUNCTION", ENT)=Y | |
| 6929 | "RTN","PSO ORED5",82, 0) | |
| 6930 | I X="@" D CON1^PSOO REDX G:$D( DIRUT) EX G:'Y CON S :'$G(COPY) PSOSIGFL= 1 D UPD^PS OOREDX G C ON | |
| 6931 | "RTN","PSO ORED5",83, 0) | |
| 6932 | ; | |
| 6933 | "RTN","PSO ORED5",84, 0) | |
| 6934 | I '$$DURO K^PSOORED3 (.PSORXED, ENT) D G DUR | |
| 6935 | "RTN","PSO ORED5",85, 0) | |
| 6936 | . W !!,"D uration is required for the do sage enter ed prior t o the THEN conjuncti on.",$C(7) ,! | |
| 6937 | "RTN","PSO ORED5",86, 0) | |
| 6938 | N PSODLBD 4 S PSOSAV X=X,PSODLB D4=1 | |
| 6939 | "RTN","PSO ORED5",87, 0) | |
| 6940 | I $G(PSOR XED("CONJU NCTION",EN T))]"" S P SOCKCON=1 D DCHK1^PS ODOSUT G:$ G(PSORXED( "DFLG"))!( $G(PSORX(" DFLG"))) E X S ENT=EN T+1 K DIR G ASK | |
| 6941 | "RTN","PSO ORED5",88, 0) | |
| 6942 | E K PSOC KCON I $$D CHK^PSODOS UT S PSORX ED("DFLG") =1,PSORX(" DFLG")=1 G EX | |
| 6943 | "RTN","PSO ORED5",89, 0) | |
| 6944 | I PSOSAVX ="",$G(PSO RXED)!($D( PSOEDDOS)) K PSOCKCO N | |
| 6945 | "RTN","PSO ORED5",90, 0) | |
| 6946 | K PSOSAVX | |
| 6947 | "RTN","PSO ORED5",91, 0) | |
| 6948 | ; | |
| 6949 | "RTN","PSO ORED5",92, 0) | |
| 6950 | EXS ;Entry point for EXE to re build SIG PSO*7.0*4 50 | |
| 6951 | "RTN","PSO ORED5",93, 0) | |
| 6952 | S X=$G(PS ORXED("INS ")) D SIG^ PSOHELP S: $G(INS1)]" " PSORXED( "SIG")=$E( INS1,2,999 9999) | |
| 6953 | "RTN","PSO ORED5",94, 0) | |
| 6954 | D EN^PSOF SIG(.PSORX ED) I $O(S IG(0)) S P SORXED("EN T")=ENT,SI GOK=1 | |
| 6955 | "RTN","PSO ORED5",95, 0) | |
| 6956 | Q:$G(PSOR EEDT)!($G( PSOORRNW)) | |
| 6957 | "RTN","PSO ORED5",96, 0) | |
| 6958 | K QTYHLD S:$G(PSORX ED("QTY")) QTYHLD=PS ORXED("QTY ") D QTY^P SOSIG(.PSO RXED) I $G (PSORXED(" QTY")) S Q TY=1 | |
| 6959 | "RTN","PSO ORED5",97, 0) | |
| 6960 | I $G(QTYH LD),'$G(PS ORXED("QTY ")) S PSOR XED("QTY") =QTYHLD | |
| 6961 | "RTN","PSO ORED5",98, 0) | |
| 6962 | K QTYHLD Q:$G(PSOFR OM)="NEW"! ($G(COPY)) !($G(PSOFR OM))!($G(P SOREEDT)) | |
| 6963 | "RTN","PSO ORED5",99, 0) | |
| 6964 | Q:$G(PSOS IGFL) D | |
| 6965 | "RTN","PSO ORED5",100 ,0) | |
| 6966 | .S D=0 F S D=$O(SI G(D)) Q:'D S ^PSRX( PSORXED("I RXN"),"SIG 1",D,0)=SI G(D),$P(^P SRX(PSORXE D("IRXN"), "SIG1",0), "^",3)=+$P ($G(^PSRX( PSORXED("I RXN"),"SIG 1",0)),"^" ,3)+1,$P(^ (0),"^",4) =+$P($G(^( 0)),"^",4) +1 Q:'$O(S IG(D)) | |
| 6967 | "RTN","PSO ORED5",101 ,0) | |
| 6968 | .S (A,I)= 0 F S I=$ O(^PSRX(PS ORXED("IRX N"),"A",I) ) Q:'I S A=A+1 | |
| 6969 | "RTN","PSO ORED5",102 ,0) | |
| 6970 | .S:'$D(^P SRX(PSORXE D("IRXN"), "A",0)) ^P SRX(PSORXE D("IRXN"), "A",0)="^5 2.3DA^" | |
| 6971 | "RTN","PSO ORED5",103 ,0) | |
| 6972 | .S $P(^PS RX(PSORXED ("IRXN")," A",0),"^", 3)=$P($G(^ PSRX(PSORX ED("IRXN") ,"A",0))," ^",3)+1,$P (^(0),"^", 4)=$P($G(^ (0)),"^",4 )+1 | |
| 6973 | "RTN","PSO ORED5",104 ,0) | |
| 6974 | .D NOW^%D TC S A=A+1 ,^PSRX(PSO RXED("IRXN "),"A",A,0 )=%_"^E^"_ DUZ_"^0^Ne w Dosing I nstruction s Added",^ PSRX(PSORX ED("IRXN") ,"A",A,1)= "ORIGINAL SIG^" D | |
| 6975 | "RTN","PSO ORED5",105 ,0) | |
| 6976 | ..I '$P(^ PSRX(PSORX ED("IRXN") ,"SIG"),"^ ",2) S $P( ^PSRX(PSOR XED("IRXN" ),"A",A,1) ,"^",2)=$P (^PSRX(PSO RXED("IRXN "),"SIG"), "^") Q | |
| 6977 | "RTN","PSO ORED5",106 ,0) | |
| 6978 | ..F I=0:0 S I=$O(^P SRX(PSORXE D("IRXN"), "SIG1",I)) Q:'I S ^ PSRX(PSORX ED("IRXN") ,"A",A,2,I ,0)=^PSRX( PSORXED("I RXN"),"SIG 1",I,0),^P SRX(PSORXE D("IRXN"), "A",A,2,0) ="^52.34A^ "_I_"^"_I | |
| 6979 | "RTN","PSO ORED5",107 ,0) | |
| 6980 | .S ^PSRX( PSORXED("I RXN"),"SIG ")="^1" K SIG,A,I | |
| 6981 | "RTN","PSO ORED5",108 ,0) | |
| 6982 | S ^PSRX(P SORXED("IR XN"),6,0)= "^52.0113^ "_ENT_"^"_ ENT | |
| 6983 | "RTN","PSO ORED5",109 ,0) | |
| 6984 | F I=1:1:E NT S ^PSRX (PSORXED(" IRXN"),6,I ,0)=PSORXE D("DOSE",I )_"^"_$G(P SORXED("DO SE ORDERED ",I))_"^"_ $G(PSORXED ("UNITS",I ))_"^"_$G( PSORXED("N OUN",I))_" ^" D | |
| 6985 | "RTN","PSO ORED5",110 ,0) | |
| 6986 | .S ^PSRX( PSORXED("I RXN"),6,I, 0)=^PSRX(P SORXED("IR XN"),6,I,0 )_$G(PSORX ED("DURATI ON",I))_"^ "_$G(PSORX ED("CONJUN CTION",I)) _"^"_$G(PS ORXED("ROU TE",I))_"^ "_$G(PSORX ED("SCHEDU LE",I))_"^ "_$G(PSORX ED("VERB", I)) | |
| 6987 | "RTN","PSO ORED5",111 ,0) | |
| 6988 | .I $G(PSO RXED("DOSE ",I))]"" S ^PSRX(PSO RXED("IRXN "),6,I,1)= PSORXED("D OSE",I) | |
| 6989 | "RTN","PSO ORED5",112 ,0) | |
| 6990 | S ^PSRX(P SORXED("IR XN"),"POE" )=1 G EX | |
| 6991 | "RTN","PSO ORED5",113 ,0) | |
| 6992 | Q | |
| 6993 | "RTN","PSO ORED5",114 ,0) | |
| 6994 | EX I $D(DU OUT)!($D(D TOUT)) S P SONEW("DFL G")=1 | |
| 6995 | "RTN","PSO ORED5",115 ,0) | |
| 6996 | ;I $D(DUO UT)!($D(DT OUT)) S:'$ G(PSORX("E DIT")) PSO NEW("DFLG" )=1 | |
| 6997 | "RTN","PSO ORED5",116 ,0) | |
| 6998 | G:$G(PSOS IGFL)!($G( PSORX("EDI T")))!($G( PSORXED))! ($G(PSOREE DT)) EX1 | |
| 6999 | "RTN","PSO ORED5",117 ,0) | |
| 7000 | K PSORXED ("DOSE"),P SORXED("NO UN"),PSORX ED("VERB") ,PSORXED(" DOSE ORDER ED"),PSORX ED("ROUTE" ),SIG,PSOR XED("SCHED ULE"),PSOR XED("DURAT ION"),PSOR XED("CONJU NCTION"),P SORXED("OD OSE") | |
| 7001 | "RTN","PSO ORED5",118 ,0) | |
| 7002 | EX1 K UNIT N,STRE,DOS E,DUPD,SCH ,VERB,NOUN ,DOSEOR,RT E,DUR,X,Y, ENTS,PSOSC H,ENT,PSOR TE,DURA,ER TE,ROU | |
| 7003 | "RTN","PSO ORED5",119 ,0) | |
| 7004 | KV K DIR,D IRUT,DTOUT ,DUOUT | |
| 7005 | "RTN","PSO ORED5",120 ,0) | |
| 7006 | Q | |
| 7007 | "RTN","PSO ORED5",121 ,0) | |
| 7008 | ;This lin e tag was added to c heck if EX it is bein g performe d while ED ITing. If it is, | |
| 7009 | "RTN","PSO ORED5",122 ,0) | |
| 7010 | ;process SIG and do not delet e order. Previous c alls to EX when due to $D(DUOU T) were | |
| 7011 | "RTN","PSO ORED5",123 ,0) | |
| 7012 | ;changed to go to t his line t ag instead . | |
| 7013 | "RTN","PSO ORED5",124 ,0) | |
| 7014 | EXE I $G(P SORX("EDIT "))]"" K D UOUT G EXS ;*PSO*7. 0*450 | |
| 7015 | "RTN","PSO ORED5",125 ,0) | |
| 7016 | G EX | |
| 7017 | "RTN","PSO ORED5",126 ,0) | |
| 7018 | ; | |
| 7019 | "RTN","PSO ORED5",127 ,0) | |
| 7020 | UPD ;updat es dosing array | |
| 7021 | "RTN","PSO ORED5",128 ,0) | |
| 7022 | D UPD^PSO ORED6 | |
| 7023 | "RTN","PSO ORED5",129 ,0) | |
| 7024 | Q | |
| 7025 | "RTN","PSO ORED5",130 ,0) | |
| 7026 | JUMP ; | |
| 7027 | "RTN","PSO ORED5",131 ,0) | |
| 7028 | I $G(PSOR XED("SCHED ULE",1))'] "" W $C(7) ,!!,"All D osing Inst ructions m ust be ent ered befor e Jumping to other F ields!",!! G @FIELD | |
| 7029 | "RTN","PSO ORED5",132 ,0) | |
| 7030 | I $L($E(X ,2,99))<3 W !,"Field Name Must Be At Lea st 3 Chara cters in L ength",! G @FIELD | |
| 7031 | "RTN","PSO ORED5",133 ,0) | |
| 7032 | D FNM^PSO OREDX | |
| 7033 | "RTN","PSO ORED5",134 ,0) | |
| 7034 | I FLDNM'] "" K X,NM, FLDNM W !, "INVALID F IELD NAME. PLEASE T RY AGAIN!" ,! G @FIEL D | |
| 7035 | "RTN","PSO ORED5",135 ,0) | |
| 7036 | F AR=1:1: PSORXED("E NT") W !,A R_". "_$P( FLDNM,"^", 2)_": "_$S (NM="ROU"& ($G(PSORXE D($P(FLDNM ,"^"),AR)) ):$P(^PS(5 1.2,PSORXE D($P(FLDNM ,"^"),AR), 0),"^"),1: $G(PSORXED ($P(FLDNM, "^"),AR))) S AR1=AR | |
| 7037 | "RTN","PSO ORED5",136 ,0) | |
| 7038 | D KV | |
| 7039 | "RTN","PSO ORED5",137 ,0) | |
| 7040 | I $G(PSOF ROM)'="NEW ",'$G(COPY ) S DIR("A ",1)="* In dicates wh ich fields will crea te a New O rder" | |
| 7041 | "RTN","PSO ORED5",138 ,0) | |
| 7042 | S DIR("A" )="Select Field by n umber",DIR (0)="NO^1: "_AR1 D ^D IR G:$D(DI RUT) @FIEL D | |
| 7043 | "RTN","PSO ORED5",139 ,0) | |
| 7044 | D JFN^PSO OREDX G:FL DNM="" @FI ELD G @FLD NM | |
| 7045 | "RTN","PSO ORED5",140 ,0) | |
| 7046 | G EX | |
| 7047 | "RTN","PSO ORED5",141 ,0) | |
| 7048 | Q | |
| 7049 | "RTN","PSO ORED5",142 ,0) | |
| 7050 | LAN ; | |
| 7051 | "RTN","PSO ORED5",143 ,0) | |
| 7052 | Q:'$G(PSO DRUG("IEN" )) | |
| 7053 | "RTN","PSO ORED5",144 ,0) | |
| 7054 | I $G(OR0) ,'$G(PSONE W("DOSE OR DERED",II) ),$P($G(^P S(55,PSODF N,"LAN")), "^") D K QI,QII Q | |
| 7055 | "RTN","PSO ORED5",145 ,0) | |
| 7056 | .Q:$G(OTH DOS(II)) | |
| 7057 | "RTN","PSO ORED5",146 ,0) | |
| 7058 | .F QI=0:0 S QI=$O(^ PSDRUG(PSO DRUG("IEN" ),"DOS2",Q I)) Q:'QI D Q:$G(Q II) | |
| 7059 | "RTN","PSO ORED5",147 ,0) | |
| 7060 | ..Q:$G(PS ONEW("DOSE ",II))']"" | |
| 7061 | "RTN","PSO ORED5",148 ,0) | |
| 7062 | ..I PSONE W("DOSE",I I)=$P(^PSD RUG(PSODRU G("IEN")," DOS2",QI,0 ),"^") S P SONEW("ODO SE",II)=$P (^PSDRUG(P SODRUG("IE N"),"DOS2" ,QI,0),"^" ,4),QII=1 | |
| 7063 | "RTN","PSO ORED5",149 ,0) | |
| 7064 | I $G(Y),$ P($G(DOSE( Y)),"^",13 )]"" S PSO RXED("ODOS E",ENT)=$P (DOSE(Y)," ^",13) Q | |
| 7065 | "RTN","PSO ORED5",150 ,0) | |
| 7066 | K QII F I =0:0 S I=$ O(^PSDRUG( PSODRUG("I EN"),"DOS2 ",I)) Q:'I I DOSE=$ P(^PSDRUG( PSODRUG("I EN"),"DOS2 ",I,0),"^" ) D Q:$G( QII) | |
| 7067 | "RTN","PSO ORED5",151 ,0) | |
| 7068 | .S PSORXE D("ODOSE", ENT)=$P(^P SDRUG(PSOD RUG("IEN") ,"DOS2",I, 0),"^",4), QII=1 | |
| 7069 | "RTN","PSO ORED5",152 ,0) | |
| 7070 | K QII,I | |
| 7071 | "RTN","PSO ORED5",153 ,0) | |
| 7072 | Q | |
| 7073 | "RTN","PSO ORED5",154 ,0) | |
| 7074 | ; | |
| 7075 | "RTN","PSO ORNEW") | |
| 7076 | 0^14^B9770 7978 | |
| 7077 | "RTN","PSO ORNEW",1,0 ) | |
| 7078 | PSOORNEW ; BIR/SAB - display or ders from oerr ;Jul 24, 2017@1 5:24 | |
| 7079 | "RTN","PSO ORNEW",2,0 ) | |
| 7080 | ;;7.0;OUT PATIENT PH ARMACY;**1 1,23,27,32 ,55,46,71, 90,94,106, 131,133,14 3,237,222, 258,206,22 5,251,386, 390,391,37 2,416,431, 313,408,43 6,411,444, 486,457**; DEC 1997;B uild 65 | |
| 7081 | "RTN","PSO ORNEW",3,0 ) | |
| 7082 | ;External reference to ^PS(50 .7 support ed by DBIA 2223 | |
| 7083 | "RTN","PSO ORNEW",4,0 ) | |
| 7084 | ;External reference to ^PSDRU G supporte d by DBIA 221 | |
| 7085 | "RTN","PSO ORNEW",5,0 ) | |
| 7086 | ;External reference to ^PS(50 .606 suppo rted by DB IA 2174 | |
| 7087 | "RTN","PSO ORNEW",6,0 ) | |
| 7088 | ;External reference to ^PS(55 supported by DBIA 2 228 | |
| 7089 | "RTN","PSO ORNEW",7,0 ) | |
| 7090 | ;External reference to EN1^OR CFLAG supp orted by D BIA 3620 | |
| 7091 | "RTN","PSO ORNEW",8,0 ) | |
| 7092 | ; | |
| 7093 | "RTN","PSO ORNEW",9,0 ) | |
| 7094 | ;PSO*237 quit Finis h if Today > Issue d ate + 365 | |
| 7095 | "RTN","PSO ORNEW",10, 0) | |
| 7096 | ; | |
| 7097 | "RTN","PSO ORNEW",11, 0) | |
| 7098 | DSPL I $G( PSODSPL) S VALMBCK=" Q" K PSODS PL,PSOANSQ D Q | |
| 7099 | "RTN","PSO ORNEW",12, 0) | |
| 7100 | Q:'$D(PSO LMC) K ^T MP("PSOPO" ,$J) S PSO LMC=PSOLMC +1 | |
| 7101 | "RTN","PSO ORNEW",13, 0) | |
| 7102 | I $D(CLOZ PAT) S PSO NEW("DAYS SUPPLY")=$ S($G(PSONE W("DAYS SU PPLY")):PS ONEW("DAYS SUPPLY"), 1:7) G OI | |
| 7103 | "RTN","PSO ORNEW",14, 0) | |
| 7104 | S PSONEW( "DAYS SUPP LY")=$S($G (PSONEW("D AYS SUPPLY ")):PSONEW ("DAYS SUP PLY"),+$G( ^PS(55,PSO DFN,"PS")) &($P(^PS(5 3,+$G(^PS( 55,PSODFN, "PS")),0), "^",3))&(' $G(PSONEW( "DAYS SUPP LY"))):$P( ^PS(53,+$G (^PS(55,PS ODFN,"PS") ),0),"^",3 ),1:30) | |
| 7105 | "RTN","PSO ORNEW",15, 0) | |
| 7106 | OI I '$G(P SODRUG("OI ")) D | |
| 7107 | "RTN","PSO ORNEW",16, 0) | |
| 7108 | .N OI,OID S (OI,PSO DRUG("OI") )=$P(OR0," ^",8),PSOD RUG("OIN") =$P(^PS(50 .7,$P(OR0, "^",8),0), "^"),OID=$ P(OR0,"^", 9) | |
| 7109 | "RTN","PSO ORNEW",17, 0) | |
| 7110 | .I $P($G( OR0),"^",9 ) S POERR= 1,DREN=$P( OR0,"^",9) D DRG^PSO ORDRG K PO ERR | |
| 7111 | "RTN","PSO ORNEW",18, 0) | |
| 7112 | I '$D(CLO ZPAT) I $G (PSODRUG(" DEA"))["A" ,$G(PSODRU G("DEA"))' ["B"!($G(P SODRUG("DE A"))["F") S PSONEW(" # OF REFIL LS")=0 | |
| 7113 | "RTN","PSO ORNEW",19, 0) | |
| 7114 | I $D(CLOZ PAT) S PSO NEW("# OF REFILLS")= $S($D(PSON EW("# OF R EFILLS")): PSONEW("# OF REFILLS "),$G(CLOZ PAT)=2&($P (OR0,"^",1 1)>2):3,$G (CLOZPAT)& ($P(OR0,"^ ",11)>1):1 ,1:0) | |
| 7115 | "RTN","PSO ORNEW",20, 0) | |
| 7116 | S IEN=0 D OBX^PSOOR FI1,DIN^PS ONFI(PSODR UG("OI"),$ S($G(PSODR UG("IEN")) :PSODRUG(" IEN"),1:"" )) | |
| 7117 | "RTN","PSO ORNEW",21, 0) | |
| 7118 | D LMDISP^ PSOORFI5(+ $G(ORD)) ; Display F lag/Unflag Informati on | |
| 7119 | "RTN","PSO ORNEW",22, 0) | |
| 7120 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)="*(1 ) Orderabl e Item: "_ $P(^PS(50. 7,PSODRUG( "OI"),0)," ^")_" "_$P (^PS(50.60 6,$P(^(0), "^",2),0), "^")_NFIO | |
| 7121 | "RTN","PSO ORNEW",23, 0) | |
| 7122 | S:NFIO["< DIN>" NFIO =IEN_","_( $L(^TMP("P SOPO",$J,I EN,0))-4) | |
| 7123 | "RTN","PSO ORNEW",24, 0) | |
| 7124 | K LST I $ G(PSODRUG( "NAME"))]" " D G PT | |
| 7125 | "RTN","PSO ORNEW",25, 0) | |
| 7126 | .S IEN=IE N+1,^TMP(" PSOPO",$J, IEN,0)=" ( 2)"_$S($D( ^PSDRUG("A Q",PSODRUG ("IEN"))): " CMO P ",1:" ") _"Drug: "_ PSODRUG("N AME")_NFID | |
| 7127 | "RTN","PSO ORNEW",26, 0) | |
| 7128 | .S:NFID[" <DIN>" NFI D=IEN_","_ ($L(^TMP(" PSOPO",$J, IEN,0))-4) | |
| 7129 | "RTN","PSO ORNEW",27, 0) | |
| 7130 | .I $P($G( ^PSDRUG(PS ODRUG("IEN "),0)),"^" ,10)]"" S IEN=IEN+1, ^TMP("PSOP O",$J,IEN, 0)=" Drug Mess age:" D DR GMSG | |
| 7131 | "RTN","PSO ORNEW",28, 0) | |
| 7132 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)=" (2 ) Drug: No Dispense Drug Selec ted" | |
| 7133 | "RTN","PSO ORNEW",29, 0) | |
| 7134 | PT D DOSE2 ^PSOORFI4 | |
| 7135 | "RTN","PSO ORNEW",30, 0) | |
| 7136 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)=" (4 ) Pat In struct:" D :$O(PSONEW ("SIG",0)) INST^PSOO RFI4 | |
| 7137 | "RTN","PSO ORNEW",31, 0) | |
| 7138 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)=" P rovider Co mments:" S TY=3 D IN ST^PSOORFI 1 | |
| 7139 | "RTN","PSO ORNEW",32, 0) | |
| 7140 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)=" Instru ctions:" S TY=2 D IN ST^PSOORFI 1 | |
| 7141 | "RTN","PSO ORNEW",33, 0) | |
| 7142 | K PSOELSE S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)=" SIG:" | |
| 7143 | "RTN","PSO ORNEW",34, 0) | |
| 7144 | F I=0:0 S I=$O(SIG( I)) Q:'I S SIG=SIG( I) D | |
| 7145 | "RTN","PSO ORNEW",35, 0) | |
| 7146 | .F SG=1:1 :$L(SIG) S :$L(^TMP(" PSOPO",$J, IEN,0)_" " _$P(SIG," ",SG))>80 IEN=IEN+1, $P(^TMP("P SOPO",$J,I EN,0)," ", 20)=" " S: $P(SIG," " ,SG)'="" ^ TMP("PSOPO ",$J,IEN,0 )=$G(^TMP( "PSOPO",$J ,IEN,0))_" "_$P(SIG, " ",SG) | |
| 7147 | "RTN","PSO ORNEW",36, 0) | |
| 7148 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)=" (5 ) Patient Status: "_ $P($G(^PS( 53,+PSONEW ("PATIENT STATUS"),0 )),"^") | |
| 7149 | "RTN","PSO ORNEW",37, 0) | |
| 7150 | K PSOELSE I $G(PSON EW("ISSUE DATE"))']" " S PSOELS E=1 S IEN= IEN+1,(PSO ID,Y)=$E($ P(OR0,"^", 6),1,7) X ^DD("DD") S PSONEW(" ISSUE DATE ")=Y,^TMP( "PSOPO",$J ,IEN,0)=" (4) Is sue Date: "_Y | |
| 7151 | "RTN","PSO ORNEW",38, 0) | |
| 7152 | I '$G(PSO ELSE) S IE N=IEN+1,^T MP("PSOPO" ,$J,IEN,0) =" (6) Issue Dat e: "_PSONE W("ISSUE D ATE") | |
| 7153 | "RTN","PSO ORNEW",39, 0) | |
| 7154 | K PSOELSE I $G(PSOR X("FILL DA TE"))']"" S PSOELSE= 1 D | |
| 7155 | "RTN","PSO ORNEW",40, 0) | |
| 7156 | .S (Y,PSO RX("FILL D ATE"))=$S( $E($P(OR0, "^",6),1,7 )<DT:DT,1: $E($P(OR0, "^",6),1,7 )) X ^DD(" DD") S PSO NEW("FILL DATE")=Y,^ TMP("PSOPO ",$J,IEN,0 )=^TMP("PS OPO",$J,IE N,0)_" (5) Fi ll Date: " _Y | |
| 7157 | "RTN","PSO ORNEW",41, 0) | |
| 7158 | I '$G(PSO ELSE) S Y= PSORX("FIL L DATE") X ^DD("DD") S PSORX(" FILL DATE" )=Y,^TMP(" PSOPO",$J, IEN,0)=^TM P("PSOPO", $J,IEN,0)_ " (7 ) Fill Dat e: "_PSORX ("FILL DAT E") | |
| 7159 | "RTN","PSO ORNEW",42, 0) | |
| 7160 | I $P(OR0, "^",18) S IEN=IEN+1, Y=$P(OR0," ^",18) X ^ DD("DD") S $P(^TMP(" PSOPO",$J, IEN,0)," " ,39)="Effe ctive Date : "_Y | |
| 7161 | "RTN","PSO ORNEW",43, 0) | |
| 7162 | I $D(CLOZ PAT) D ELI G^PSOORFI2 S:'$D(PSO NEW("QTY") ) PSONEW(" QTY")=0 | |
| 7163 | "RTN","PSO ORNEW",44, 0) | |
| 7164 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)=" (8 ) Days Supply: "_ PSONEW("DA YS SUPPLY" ) | |
| 7165 | "RTN","PSO ORNEW",45, 0) | |
| 7166 | S ^TMP("P SOPO",$J,I EN,0)=^TMP ("PSOPO",$ J,IEN,0)_" (9) QTY"_$S($ P($G(^PSDR UG(+$G(PSO DRUG("IEN" )),660))," ^",8)]"":" ("_$P($G( ^PSDRUG(+P SODRUG("IE N"),660)), "^",8)_")" ,1:" ( )" ) | |
| 7167 | "RTN","PSO ORNEW",46, 0) | |
| 7168 | S ^TMP("P SOPO",$J,I EN,0)=^TMP ("PSOPO",$ J,IEN,0)_" : "_$S($G( PSONEW("QT Y"))]"":PS ONEW("QTY" ),1:$P(OR0 ,"^",10)) | |
| 7169 | "RTN","PSO ORNEW",47, 0) | |
| 7170 | I $P($G(^ PSDRUG(+$G (PSODRUG(" IEN")),5)) ,"^")]"" D | |
| 7171 | "RTN","PSO ORNEW",48, 0) | |
| 7172 | .S $P(RN, " ",79)=" ",IEN=IEN+ 1 | |
| 7173 | "RTN","PSO ORNEW",49, 0) | |
| 7174 | .S ^TMP(" PSOPO",$J, IEN,0)=$E( RN,$L("QTY DSP MSG: "_$P(^PSDR UG(PSODRUG ("IEN"),5) ,"^"))+1,7 9)_"QTY DS P MSG: "_$ P(^PSDRUG( PSODRUG("I EN"),5),"^ ") K RN | |
| 7175 | "RTN","PSO ORNEW",50, 0) | |
| 7176 | S IEN=IEN +1 | |
| 7177 | "RTN","PSO ORNEW",51, 0) | |
| 7178 | I $P(OR0, "^",24) S ^TMP("PSOP O",$J,IEN, 0)=" Pro vider orde red: days supply "_+ $P(OR0,"^" ,22)_", qu antity "_+ $P(OR0,"^" ,10)_" & r efills "_+ $P(OR0,"^" ,11) | |
| 7179 | "RTN","PSO ORNEW",52, 0) | |
| 7180 | E S ^TMP ("PSOPO",$ J,IEN,0)=" Pro vider orde red "_+$P( OR0,"^",11 )_" refill s" | |
| 7181 | "RTN","PSO ORNEW",53, 0) | |
| 7182 | D:$D(CLOZ PAT) PQTY^ PSOORFI4 | |
| 7183 | "RTN","PSO ORNEW",54, 0) | |
| 7184 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)="(10 ) # of R efills: "_ $S($G(PSON EW("# OF R EFILLS"))] "":PSONEW( "# OF REFI LLS"),1:$P (OR0,"^",1 1))_" (11) Rou ting: "_$S ($G(PSONEW ("MAIL/WIN DOW"))="M" :"MAIL",1: "WINDOW") | |
| 7185 | "RTN","PSO ORNEW",55, 0) | |
| 7186 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)="(12 ) Clinic: "_ PSORX("CLI NIC") | |
| 7187 | "RTN","PSO ORNEW",56, 0) | |
| 7188 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)="(13 ) Pr ovider: "_ PSONEW("PR OVIDER NAM E") | |
| 7189 | "RTN","PSO ORNEW",57, 0) | |
| 7190 | D:$P(OR0, "^",24)!(( +$G(PSODRU G("DEA"))> 1)&(+$G(PS ODRUG("DEA "))<6)) PR V^PSOORFI5 ($G(PSONEW ("PROVIDER ")),$G(PSO DRUG("IEN" )),$P(OR0, "^")) | |
| 7191 | "RTN","PSO ORNEW",58, 0) | |
| 7192 | I $P($G(^ VA(200,$S( $G(PSONEW( "PROVIDER" )):PSONEW( "PROVIDER" ),1:$P(OR0 ,"^",5))," PS")),"^", 7)&($P($G( ^("PS"))," ^",8)) D | |
| 7193 | "RTN","PSO ORNEW",59, 0) | |
| 7194 | .S IEN=IE N+1,PSONEW ("COSIGNIN G PROVIDER ")=$S($G(P SONEW("COS IGNING PRO VIDER")):P SONEW("COS IGNING PRO VIDER"),1: $P(^("PS") ,"^",8)) | |
| 7195 | "RTN","PSO ORNEW",60, 0) | |
| 7196 | .S ^TMP(" PSOPO",$J, IEN,0)=" Cos-P rovider: " _$P(^VA(20 0,PSONEW(" COSIGNING PROVIDER") ,0),"^") | |
| 7197 | "RTN","PSO ORNEW",61, 0) | |
| 7198 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)="(14 ) Copies: "_ $S($G(PSON EW("COPIES ")):PSONEW ("COPIES") ,1:1) | |
| 7199 | "RTN","PSO ORNEW",62, 0) | |
| 7200 | S PSONEW( "REMARKS") =$S($G(PSO NEW("REMAR KS"))]"":P SONEW("REM ARKS"),$P( OR0,"^",17 )="C":"Adm inistered in Clinic. ",1:"") | |
| 7201 | "RTN","PSO ORNEW",63, 0) | |
| 7202 | K PSONEW( "ADMINCLIN IC") S:$P( OR0,"^",17 )="C" PSON EW("ADMINC LINIC")=1 | |
| 7203 | "RTN","PSO ORNEW",64, 0) | |
| 7204 | S IEN=IEN +1,^TMP("P SOPO",$J,I EN,0)="(15 ) R emarks:" | |
| 7205 | "RTN","PSO ORNEW",65, 0) | |
| 7206 | I $G(PSON EW("REMARK S"))]"" D | |
| 7207 | "RTN","PSO ORNEW",66, 0) | |
| 7208 | .F SG=1:1 :$L(PSONEW ("REMARKS" )) S:$L(^T MP("PSOPO" ,$J,IEN,0) _" "_$P(PS ONEW("REMA RKS")," ", SG))>80 IE N=IEN+1,$P (^TMP("PSO PO",$J,IEN ,0)," ",20 )=" " D | |
| 7209 | "RTN","PSO ORNEW",67, 0) | |
| 7210 | ..S:$P(PS ONEW("REMA RKS")," ", SG)'="" ^T MP("PSOPO" ,$J,IEN,0) =$G(^TMP(" PSOPO",$J, IEN,0))_" "_$P(PSONE W("REMARKS ")," ",SG) | |
| 7211 | "RTN","PSO ORNEW",68, 0) | |
| 7212 | I $G(PSOS IGFL)!(PSO DRUG("OI") '=$P(OR0," ^",8)) S P SONEW("CLE RK CODE")= DUZ,PSORX( "CLERK COD E")=$P(^VA (200,DUZ,0 ),"^"),VAL MSG="This change wil l create a new presc ription!" | |
| 7213 | "RTN","PSO ORNEW",69, 0) | |
| 7214 | S $P(RN," ",35)=" " ,IEN=IEN+1 ,^TMP("PSO PO",$J,IEN ,0)=" En try By: "_ $P(^VA(200 ,PSONEW("C LERK CODE" ),0),"^")_ $E(RN,$L($ P(^VA(200, PSONEW("CL ERK CODE") ,0),"^"))+ 1,35) | |
| 7215 | "RTN","PSO ORNEW",70, 0) | |
| 7216 | S Y=$P(OR 0,"^",12) X ^DD("DD" ) S ^TMP(" PSOPO",$J, IEN,0)=^TM P("PSOPO", $J,IEN,0)_ "Entry Dat e: "_$E($P (OR0,"^",1 2),4,5)_"/ "_$E($P(OR 0,"^",12), 6,7)_"/"_$ E($P(OR0," ^",12),2,3 )_" "_$P(Y ,"@",2) K RN | |
| 7217 | "RTN","PSO ORNEW",71, 0) | |
| 7218 | I PSOLMC< 2 D ^PSOLM PO1 S VALM BCK="Q",PS OLMC=0 | |
| 7219 | "RTN","PSO ORNEW",72, 0) | |
| 7220 | S:PSOLMC> 1 VALMBCK= "R" | |
| 7221 | "RTN","PSO ORNEW",73, 0) | |
| 7222 | Q | |
| 7223 | "RTN","PSO ORNEW",74, 0) | |
| 7224 | ORCHK D PR OVCOM^PSOO RFI4,ORCHK ^PSOORFI4 | |
| 7225 | "RTN","PSO ORNEW",75, 0) | |
| 7226 | Q | |
| 7227 | "RTN","PSO ORNEW",76, 0) | |
| 7228 | EDT D KV S DIR("A",1 )="* Indic ates which fields wi ll create an new Ord er",DIR("A ")="Select Field to Edit by nu mber",DIR( 0)="LO^1:1 5" D ^DIR Q:$D(DTOUT )!($D(DUOU T)) | |
| 7229 | "RTN","PSO ORNEW",77, 0) | |
| 7230 | EDTSEL N L ST,FLD,OUT D KV S OU T=0 | |
| 7231 | "RTN","PSO ORNEW",78, 0) | |
| 7232 | I +Y S LS T=Y D FULL ^VALM1 N P SODOSE M P SODOSE=PSO NEW D G D SPL | |
| 7233 | "RTN","PSO ORNEW",79, 0) | |
| 7234 | .F FLD=1: 1:$L(LST," ,") Q:$P(L ST,",",FLD )']""!(OUT ) D @(+$P (LST,",",F LD)) D:$P( LST,",",FL D)=8 REF D KV | |
| 7235 | "RTN","PSO ORNEW",80, 0) | |
| 7236 | E S VALM BCK="" Q | |
| 7237 | "RTN","PSO ORNEW",81, 0) | |
| 7238 | Q | |
| 7239 | "RTN","PSO ORNEW",82, 0) | |
| 7240 | ACP ; | |
| 7241 | "RTN","PSO ORNEW",83, 0) | |
| 7242 | N PSOORNE W,DIR,Y S Y=0,PSOORN EW=1 | |
| 7243 | "RTN","PSO ORNEW",84, 0) | |
| 7244 | I $G(ORD) ,+$P($G(^P S(52.41,+O RD,0)),"^" ,23)=1 D Q:$D(DIRUT )!'Y D EN 1^ORCFLAG( +$P($G(^PS (52.41,ORD ,0)),"^")) H 1 | |
| 7245 | "RTN","PSO ORNEW",85, 0) | |
| 7246 | . D FULL^ VALM1 | |
| 7247 | "RTN","PSO ORNEW",86, 0) | |
| 7248 | . I '$D(^ XUSEC("PSO RPH",DUZ)) D S Y=0 Q | |
| 7249 | "RTN","PSO ORNEW",87, 0) | |
| 7250 | . . S DIR ("A",1)="O rder must be unflagg ed by a ph armacist b efore it c an be fini shed." | |
| 7251 | "RTN","PSO ORNEW",88, 0) | |
| 7252 | . . S DIR ("A",2)="" | |
| 7253 | "RTN","PSO ORNEW",89, 0) | |
| 7254 | . . S DIR (0)="E",DI R("A")="En ter RETURN to contin ue" W !,$C (7) D ^DIR | |
| 7255 | "RTN","PSO ORNEW",90, 0) | |
| 7256 | . . S VAL MBCK="R" | |
| 7257 | "RTN","PSO ORNEW",91, 0) | |
| 7258 | . D KV | |
| 7259 | "RTN","PSO ORNEW",92, 0) | |
| 7260 | . S DIR(" A",1)="Thi s Order is flagged. In order t o finish i t" | |
| 7261 | "RTN","PSO ORNEW",93, 0) | |
| 7262 | . S DIR(" A",2)="you must unfl ag it firs t." | |
| 7263 | "RTN","PSO ORNEW",94, 0) | |
| 7264 | . S DIR(" A",3)="" | |
| 7265 | "RTN","PSO ORNEW",95, 0) | |
| 7266 | . S DIR(0 )="Y",DIR( "A")="Unfl ag Order", DIR("B")=" NO" | |
| 7267 | "RTN","PSO ORNEW",96, 0) | |
| 7268 | . W ! D ^ DIR I $D(D IRUT)!'Y S VALMBCK=" Q" | |
| 7269 | "RTN","PSO ORNEW",97, 0) | |
| 7270 | I $G(ORD) ,+$P($G(^P S(52.41,+O RD,0)),"^" ,23)=1 Q | |
| 7271 | "RTN","PSO ORNEW",98, 0) | |
| 7272 | ; | |
| 7273 | "RTN","PSO ORNEW",99, 0) | |
| 7274 | ;/MZR edi ted next l ine in cas e QTY not defined | |
| 7275 | "RTN","PSO ORNEW",100 ,0) | |
| 7276 | I $D(CLOZ PAT),+$G(P SONEW("QTY "))=0 S PS ONEW("QTY" )=$P(OR0," ^",10) | |
| 7277 | "RTN","PSO ORNEW",101 ,0) | |
| 7278 | S (PSODIR ("DFLG"),P SORX("DFLG "),PSODIR( "QFLD"))=0 ,ACP=1 D O RCHK | |
| 7279 | "RTN","PSO ORNEW",102 ,0) | |
| 7280 | G:$G(PSON EW("QFLG") ) DSPL | |
| 7281 | "RTN","PSO ORNEW",103 ,0) | |
| 7282 | I $G(PSOD IR("DFLG") )!$G(PSORX ("DFLG")) Q | |
| 7283 | "RTN","PSO ORNEW",104 ,0) | |
| 7284 | I $G(PSON EW("FLD")) !($G(PSODR UG("NAME") )']"")!('$ O(SIG(0))) G DSPL | |
| 7285 | "RTN","PSO ORNEW",105 ,0) | |
| 7286 | I $G(PSOD RUG("NAME" ))]"",'$G( ORCHK)!($G (ORDRG)'=P SODRUG("NA ME")) D I $G(PSORX( "DFLG")) Q ;D CLEAN ^PSOVER1 G DSPL | |
| 7287 | "RTN","PSO ORNEW",106 ,0) | |
| 7288 | . D POST^ PSODRG S:' $G(PSORX(" DFLG")) OR CHK=1,ORDR G=PSODRUG( "NAME") | |
| 7289 | "RTN","PSO ORNEW",107 ,0) | |
| 7290 | D:'$G(PSO RX("DFLG") ) DOSCK^PS ODOSUT("N" ) I $G(PSO RX("DFLG") ) G DSPL | |
| 7291 | "RTN","PSO ORNEW",108 ,0) | |
| 7292 | I '$D(PSO NEW("RX #" )) S PSOFR OM="NEW",R TN=$S($P($ G(PSOPAR), "^",7):"AU TO^PSONRXN ",1:"MANUA L^PSONRXN" ) D @RTN Q :PSONEW("Q FLG") I ' $P($G(PSOP AR),"^",7) S PSOX=PS ONEW("RX # ") D CHECK ^PSONRXN | |
| 7293 | "RTN","PSO ORNEW",109 ,0) | |
| 7294 | D RXNCHK^ PSOORNE1 I $G(PSONEW ("QFLG")) S PSONEW(" DFLG")=1 Q | |
| 7295 | "RTN","PSO ORNEW",110 ,0) | |
| 7296 | I DT>$$FM ADD^XLFDT( $P(OR0,"^" ,6),365) D EXPR^PSON EW2 G DSPL | |
| 7297 | "RTN","PSO ORNEW",111 ,0) | |
| 7298 | D STOP^PS ONEW2,DISP LAY^PSONEW 2,^PSONEWF | |
| 7299 | "RTN","PSO ORNEW",112 ,0) | |
| 7300 | I $G(PSOC PZ("DFLG") ) W !!,"No action ta ken!",! K DIR S DIR( 0)="E",DIR ("?")="Pre ss Return to continu e",DIR("A" )="Press R eturn to c ontinue" D ^DIR,KV K PSOCPZ("D FLG"),DRET ,PSOANSQD S VALMBCK= "Q" Q | |
| 7301 | "RTN","PSO ORNEW",113 ,0) | |
| 7302 | ; | |
| 7303 | "RTN","PSO ORNEW",114 ,0) | |
| 7304 | K PSOCPZ( "DFLG") D KV S DIR(0 )="Y",DIR( "A")="Are you sure y ou want to Accept th is Order", DIR("B")=" NO" D ^DIR I $D(DIRU T) D KV K DRET,PSOAN SQ,PSOANSQ D S VALMBC K="Q" Q | |
| 7305 | "RTN","PSO ORNEW",115 ,0) | |
| 7306 | D KV I 'Y K PSOANSQ G DSPL | |
| 7307 | "RTN","PSO ORNEW",116 ,0) | |
| 7308 | I $G(PSON EW("MAIL/W INDOW"))[" W" D:$P($G (PSOPAR)," ^",12) S BINGCRT="Y ",BINGRTE= "W",PSORX( "MAIL/WIND OW")="WIND OW" K RTN | |
| 7309 | "RTN","PSO ORNEW",117 ,0) | |
| 7310 | .W ! K DI R,DIRUT S DIR(0)="52 ,35O" | |
| 7311 | "RTN","PSO ORNEW",118 ,0) | |
| 7312 | .S:$G(PSO RX("METHOD OF PICK-U P"))]"" DI R("B")=PSO RX("METHOD OF PICK-U P") D ^DIR I $D(DIRU T) K DIR,D IRUT Q | |
| 7313 | "RTN","PSO ORNEW",119 ,0) | |
| 7314 | .S (PSONE W("METHOD OF PICK-UP "),PSORX(" METHOD OF PICK-UP")) =Y K X,Y | |
| 7315 | "RTN","PSO ORNEW",120 ,0) | |
| 7316 | S PSONEW( "POE")=1 K PSORX("DF LG"),PSONE W("DFLG") D EN^PSON5 2(.PSONEW) G:$G(PSON EW("DFLG") ) ABORT D DCORD^PSON EW2 D:$G(P KI)=898020 20 ALERT^P SOPKIV1 | |
| 7317 | "RTN","PSO ORNEW",121 ,0) | |
| 7318 | ; - Possi ble Titrat ion Rx? | |
| 7319 | "RTN","PSO ORNEW",122 ,0) | |
| 7320 | I $G(PSON EW("IRXN") ) D MARK^P SOOTMRX(PS ONEW("IRXN "),0) | |
| 7321 | "RTN","PSO ORNEW",123 ,0) | |
| 7322 | ;saves dr ug allergy order chk s pso*7*39 0 | |
| 7323 | "RTN","PSO ORNEW",124 ,0) | |
| 7324 | I $D(^TMP ("PSODAOC" ,$J)) D | |
| 7325 | "RTN","PSO ORNEW",125 ,0) | |
| 7326 | .I $G(PSO RX("DFLG") ) K ^TMP(" PSODAOC",$ J) Q | |
| 7327 | "RTN","PSO ORNEW",126 ,0) | |
| 7328 | .S RXN=PS ONEW("IRXN "),PSODAOC ="Finished CPRS Rx " _$S($P(^PS RX(RXN,"ST A"),"^")=4 :"NON-VERI FIED ",1:" ")_"Order Acceptance _OP" | |
| 7329 | "RTN","PSO ORNEW",127 ,0) | |
| 7330 | .D DAOC^P SONEW | |
| 7331 | "RTN","PSO ORNEW",128 ,0) | |
| 7332 | D NPSOSD^ PSOUTIL(.P SONEW),FUL L^VALM1 K PSORX("MAI L/WINDOW") | |
| 7333 | "RTN","PSO ORNEW",129 ,0) | |
| 7334 | D EOJ^PSO NEW | |
| 7335 | "RTN","PSO ORNEW",130 ,0) | |
| 7336 | ABORT S VA LMBCK="Q", DIR(0)="E" ,DIR("?")= "Press Ret urn to con tinue",DIR ("A")="Pre ss Return to Continu e" D ^DIR, CLEAN^PSOV ER1,KV | |
| 7337 | "RTN","PSO ORNEW",131 ,0) | |
| 7338 | Q | |
| 7339 | "RTN","PSO ORNEW",132 ,0) | |
| 7340 | KV K DIRUT ,DUOUT,DTO UT,DIR,PSO EDDOS | |
| 7341 | "RTN","PSO ORNEW",133 ,0) | |
| 7342 | Q | |
| 7343 | "RTN","PSO ORNEW",134 ,0) | |
| 7344 | REF ; | |
| 7345 | "RTN","PSO ORNEW",135 ,0) | |
| 7346 | ; Retriev ing the Ma ximum Numb er of Refi lls allowe d | |
| 7347 | "RTN","PSO ORNEW",136 ,0) | |
| 7348 | N MAXRF S MAXRF=$$M AXNUMRF^PS OUTIL(+$G( PSODRUG("I EN")),+$G( PSONEW("DA YS SUPPLY" )),+$G(PSO NEW("PATIE NT STATUS" )),.CLOZPA T) | |
| 7349 | "RTN","PSO ORNEW",137 ,0) | |
| 7350 | I ($G(PSO NEW("# OF REFILLS")) '="")&($G( PSONEW("# OF REFILLS "))'>MAXRF ) D | |
| 7351 | "RTN","PSO ORNEW",138 ,0) | |
| 7352 | . S PSONE W("N# REF" )=PSONEW(" # OF REFIL LS") | |
| 7353 | "RTN","PSO ORNEW",139 ,0) | |
| 7354 | E D | |
| 7355 | "RTN","PSO ORNEW",140 ,0) | |
| 7356 | . S (PSON EW("N# REF "),PSONEW( "# OF REFI LLS"))=MAX RF | |
| 7357 | "RTN","PSO ORNEW",141 ,0) | |
| 7358 | Q | |
| 7359 | "RTN","PSO ORNEW",142 ,0) | |
| 7360 | 1 I $P($G( OR0),"^",2 4) D Q | |
| 7361 | "RTN","PSO ORNEW",143 ,0) | |
| 7362 | . W !!,"D igitally S igned Orde r - Ordera ble Item c annot be c hanged",! D PZ | |
| 7363 | "RTN","PSO ORNEW",144 ,0) | |
| 7364 | N PSOBDR, PSOBDRG S PSOBDRG=1 D 1^PSOORN W2 Q ;oi | |
| 7365 | "RTN","PSO ORNEW",145 ,0) | |
| 7366 | ; | |
| 7367 | "RTN","PSO ORNEW",146 ,0) | |
| 7368 | 4 D INS^PS OORNW2 Q | |
| 7369 | "RTN","PSO ORNEW",147 ,0) | |
| 7370 | ; | |
| 7371 | "RTN","PSO ORNEW",148 ,0) | |
| 7372 | 3 I $G(LST )["3,",$P( OR0,"^",24 ) D Q | |
| 7373 | "RTN","PSO ORNEW",149 ,0) | |
| 7374 | . W !!,"D igitally S igned Orde r - Dose c annot be c hanged",! D PZ | |
| 7375 | "RTN","PSO ORNEW",150 ,0) | |
| 7376 | N PSOEDDO S S PSOEDD OS=1 D DOS E^PSOORED4 (.PSONEW) Q | |
| 7377 | "RTN","PSO ORNEW",151 ,0) | |
| 7378 | ; | |
| 7379 | "RTN","PSO ORNEW",152 ,0) | |
| 7380 | 6 D 4^PSOO RNW2 Q ;i dt | |
| 7381 | "RTN","PSO ORNEW",153 ,0) | |
| 7382 | ; | |
| 7383 | "RTN","PSO ORNEW",154 ,0) | |
| 7384 | 7 D 5^PSOO RNW2 Q ;f dt | |
| 7385 | "RTN","PSO ORNEW",155 ,0) | |
| 7386 | ; | |
| 7387 | "RTN","PSO ORNEW",156 ,0) | |
| 7388 | 5 D 3^PSOO RNW2 Q ;p stat | |
| 7389 | "RTN","PSO ORNEW",157 ,0) | |
| 7390 | ; | |
| 7391 | "RTN","PSO ORNEW",158 ,0) | |
| 7392 | 13 I $P($G (OR0),"^", 24) D Q | |
| 7393 | "RTN","PSO ORNEW",159 ,0) | |
| 7394 | . W !!,"D igitally S igned Orde r - Provid er cannot be changed ",! D PZ | |
| 7395 | "RTN","PSO ORNEW",160 ,0) | |
| 7396 | D 12^PSOO RNW2 Q ;d oc | |
| 7397 | "RTN","PSO ORNEW",161 ,0) | |
| 7398 | ; | |
| 7399 | "RTN","PSO ORNEW",162 ,0) | |
| 7400 | 12 D 11^PS OORNW2 Q ;cli | |
| 7401 | "RTN","PSO ORNEW",163 ,0) | |
| 7402 | ; | |
| 7403 | "RTN","PSO ORNEW",164 ,0) | |
| 7404 | 2 N PSOCSI G I '$G(PS OBDRG) N P SOBDR,PSOB DRG S PSOB DRG=1,PSOQ FLG=0 | |
| 7405 | "RTN","PSO ORNEW",165 ,0) | |
| 7406 | N CPRN S CPRN=+$P($ G(OR0),"^" ,24) D 2^P SOORNW1 Q: $G(PSOQFLG ) D EN^PS ODIAG ;dr g/ICD | |
| 7407 | "RTN","PSO ORNEW",166 ,0) | |
| 7408 | I $G(PSOC SIG) K PSO CSIG G 3 | |
| 7409 | "RTN","PSO ORNEW",167 ,0) | |
| 7410 | Q | |
| 7411 | "RTN","PSO ORNEW",168 ,0) | |
| 7412 | ; | |
| 7413 | "RTN","PSO ORNEW",169 ,0) | |
| 7414 | 9 D 8^PSOO RNW2 Q ;q ty | |
| 7415 | "RTN","PSO ORNEW",170 ,0) | |
| 7416 | ; | |
| 7417 | "RTN","PSO ORNEW",171 ,0) | |
| 7418 | 8 N CPRN S CPRN=+$P( $G(OR0),"^ ",24) D 7^ PSOORNW2 Q ;ds | |
| 7419 | "RTN","PSO ORNEW",172 ,0) | |
| 7420 | ; | |
| 7421 | "RTN","PSO ORNEW",173 ,0) | |
| 7422 | 10 I $P($G (OR0),"^", 24) D Q | |
| 7423 | "RTN","PSO ORNEW",174 ,0) | |
| 7424 | . W !!,"D igitally S igned Orde r - Refill s cannot b e changed" ,! D PZ | |
| 7425 | "RTN","PSO ORNEW",175 ,0) | |
| 7426 | D 9^PSOOR NW2 Q ;#r fs | |
| 7427 | "RTN","PSO ORNEW",176 ,0) | |
| 7428 | ; | |
| 7429 | "RTN","PSO ORNEW",177 ,0) | |
| 7430 | 14 D 13^PS OORNW2 Q ;cop | |
| 7431 | "RTN","PSO ORNEW",178 ,0) | |
| 7432 | ; | |
| 7433 | "RTN","PSO ORNEW",179 ,0) | |
| 7434 | 11 D 10^PS OORNW2 Q ;m/w | |
| 7435 | "RTN","PSO ORNEW",180 ,0) | |
| 7436 | ; | |
| 7437 | "RTN","PSO ORNEW",181 ,0) | |
| 7438 | 15 D 14^PS OORNW2 Q ;rem | |
| 7439 | "RTN","PSO ORNEW",182 ,0) | |
| 7440 | ; | |
| 7441 | "RTN","PSO ORNEW",183 ,0) | |
| 7442 | DRGMSG ; | |
| 7443 | "RTN","PSO ORNEW",184 ,0) | |
| 7444 | F SG=1:1: $L($P(^PSD RUG(PSODRU G("IEN"),0 ),"^",10)) S:$L(^TMP ("PSOPO",$ J,IEN,0)_" "_$P($P(^ PSDRUG(PSO DRUG("IEN" ),0),"^",1 0)," ",SG) )>80 IEN=I EN+1,$P(^T MP("PSOPO" ,$J,IEN,0) ," ",20)=" " D | |
| 7445 | "RTN","PSO ORNEW",185 ,0) | |
| 7446 | .S:$P($P( ^PSDRUG(PS ODRUG("IEN "),0),"^", 10)," ",SG )'="" ^TMP ("PSOPO",$ J,IEN,0)=$ G(^TMP("PS OPO",$J,IE N,0))_" "_ $P($P(^PSD RUG(PSODRU G("IEN"),0 ),"^",10), " ",SG) | |
| 7447 | "RTN","PSO ORNEW",186 ,0) | |
| 7448 | K SG | |
| 7449 | "RTN","PSO ORNEW",187 ,0) | |
| 7450 | Q | |
| 7451 | "RTN","PSO ORNEW",188 ,0) | |
| 7452 | ; | |
| 7453 | "RTN","PSO ORNEW",189 ,0) | |
| 7454 | PZ ; | |
| 7455 | "RTN","PSO ORNEW",190 ,0) | |
| 7456 | N DIR S D IR(0)="E", DIR("A")=" Press Retu rn to Cont inue" D ^D IR W ! | |
| 7457 | "RTN","PSO ORNEW",191 ,0) | |
| 7458 | Q | |
| 7459 | "RTN","PSO RENW0") | |
| 7460 | 0^2^B98709 139 | |
| 7461 | "RTN","PSO RENW0",1,0 ) | |
| 7462 | PSORENW0 ; IHS/DSD/JC M-renew ma in driver continuati on ;Jul 24 , 2017@15: 24 | |
| 7463 | "RTN","PSO RENW0",2,0 ) | |
| 7464 | ;;7.0;OUT PATIENT PH ARMACY;**1 1,27,32,59 ,64,46,71, 96,100,130 ,237,206,2 51,375,379 ,372,411,4 57**;DEC 1 997;Build 65 | |
| 7465 | "RTN","PSO RENW0",3,0 ) | |
| 7466 | ;External reference to ^PS(50 .7 support ed by DBIA 2223 | |
| 7467 | "RTN","PSO RENW0",4,0 ) | |
| 7468 | ;External reference to ^PSDRU G supporte d by DBIA 221 | |
| 7469 | "RTN","PSO RENW0",5,0 ) | |
| 7470 | ;External reference to PSOL^P SSLOCK sup ported by DBIA 2789 | |
| 7471 | "RTN","PSO RENW0",6,0 ) | |
| 7472 | ;External reference to PSOUL^ PSSLOCK su pported by DBIA 2789 | |
| 7473 | "RTN","PSO RENW0",7,0 ) | |
| 7474 | ; | |
| 7475 | "RTN","PSO RENW0",8,0 ) | |
| 7476 | ;PSO*237 was not ad ding to Cl ozapine Ov erride fil e, fix | |
| 7477 | "RTN","PSO RENW0",9,0 ) | |
| 7478 | PROCESS ; | |
| 7479 | "RTN","PSO RENW0",10, 0) | |
| 7480 | D ^PSOREN W1 | |
| 7481 | "RTN","PSO RENW0",11, 0) | |
| 7482 | D INST2^P SORENW | |
| 7483 | "RTN","PSO RENW0",12, 0) | |
| 7484 | I $D(PSOR X("BAR COD E")),PSODF N'=PSORENW ("PSODFN") D NEWPT | |
| 7485 | "RTN","PSO RENW0",13, 0) | |
| 7486 | S PSORENW ("DFLG")=0 ,PSORENW(" FILL DATE" )=PSORNW(" FILL DATE" ) | |
| 7487 | "RTN","PSO RENW0",14, 0) | |
| 7488 | I $G(PSOR NW("MAIL/W INDOW"))]" " S PSOREN W("MAIL/WI NDOW")=PSO RNW("MAIL/ WINDOW") | |
| 7489 | "RTN","PSO RENW0",15, 0) | |
| 7490 | W !!,"Now Renewing Rx # "_PSO RENW("ORX #")_" Dr ug: "_$$GE T1^DIQ(50, +$G(PSOREN W("DRUG IE N")),.01), ! | |
| 7491 | "RTN","PSO RENW0",16, 0) | |
| 7492 | D CHECK G :PSORENW(" DFLG") PRO CESSX | |
| 7493 | "RTN","PSO RENW0",17, 0) | |
| 7494 | D FILDATE | |
| 7495 | "RTN","PSO RENW0",18, 0) | |
| 7496 | D DRUG G: PSORENW("D FLG")!PSOR X("DFLG") PROCESSX | |
| 7497 | "RTN","PSO RENW0",19, 0) | |
| 7498 | D RXN G:P SORENW("DF LG") PROCE SSX | |
| 7499 | "RTN","PSO RENW0",20, 0) | |
| 7500 | D STOP^PS ORENW1,OER R^PSORENW1 :$G(PSOFDR ) | |
| 7501 | "RTN","PSO RENW0",21, 0) | |
| 7502 | DSPL K PSO EDT,PSOLM D DSPLY^PS ORENW3 G:P SORENW("DF LG") PROCE SSX | |
| 7503 | "RTN","PSO RENW0",22, 0) | |
| 7504 | S PSORENW ("QFLG")=0 D:'$G(PSO FDR) EDIT | |
| 7505 | "RTN","PSO RENW0",23, 0) | |
| 7506 | G:PSORENW ("DFLG")!$ G(PSORX("F N")) PROCE SSX | |
| 7507 | "RTN","PSO RENW0",24, 0) | |
| 7508 | G:'$G(PSO RX("FN"))& ('$G(PSORE NW("QFLG") )) DSPL | |
| 7509 | "RTN","PSO RENW0",25, 0) | |
| 7510 | D:$$FIND1 ^DIC(200.0 51,","_DUZ _",","X"," PSORPH")!( '$P(PSOPAR ,"^",2)) V ER1^PSOORN E4(.PSOREN W) I PSORE NW("DFLG") =1 G PROCE SSX | |
| 7511 | "RTN","PSO RENW0",26, 0) | |
| 7512 | I $G(NEWD OSE),PSORE NW("ENT")> 0 K NEWDOS E G DSPL | |
| 7513 | "RTN","PSO RENW0",27, 0) | |
| 7514 | D EN^PSOR N52(.PSORE NW) | |
| 7515 | "RTN","PSO RENW0",28, 0) | |
| 7516 | D RNPSOSD ^PSOUTIL | |
| 7517 | "RTN","PSO RENW0",29, 0) | |
| 7518 | D CAN,DCO RD^PSONEW2 | |
| 7519 | "RTN","PSO RENW0",30, 0) | |
| 7520 | S BBRN1=$ $FIND1^DIC (52,,"X",P SORENW("NR X #")) I $ $GET1^DIQ( 52,BBRN1,1 1,"I")["W" S BINGCRT ="Y",BINGR TE="W" | |
| 7521 | "RTN","PSO RENW0",31, 0) | |
| 7522 | ;PSO*237 add to Clo zapine Ove rride file | |
| 7523 | "RTN","PSO RENW0",32, 0) | |
| 7524 | ANQ I $G(A NQDATA)]"" N PSOUSER ,PSO1PH,PS O2PH,PSORE ASN,PSOREM RK S PSOUS ER=$P(ANQD ATA,"^",5) ,PSO1PH=$P (ANQDATA," ^"),PSO2PH =$P(ANQDAT A,"^",5),P SOREASN=$P (ANQDATA," ^",3),PSOR EMRK=$P(AN QDATA,"^", 4) D NOW^% DTC G:$$FI ND1^DIC(52 .52,,"X",% ) ANQ D | |
| 7525 | "RTN","PSO RENW0",33, 0) | |
| 7526 | .;; ** ST ART NCC RE MEDIATION ** 457/RTW | |
| 7527 | "RTN","PSO RENW0",34, 0) | |
| 7528 | .N PSOUSE R,PSO1PH,P SO2PH,PSOR EASN,PSORE MRK,PSOPRO V | |
| 7529 | "RTN","PSO RENW0",35, 0) | |
| 7530 | .S PSOPRO V=$P(ANQDA TA,"^",2), PSO1PH=$P( ANQDATA,"^ "),PSO2PH= $P(ANQDATA ,"^",5),PS OREASN=$P( ANQDATA,"^ ",3),PSORE MRK=$P(ANQ DATA,"^",4 ) | |
| 7531 | "RTN","PSO RENW0",36, 0) | |
| 7532 | .S XQA(PS O2PH)="",X QA(PSOPROV )="" | |
| 7533 | "RTN","PSO RENW0",37, 0) | |
| 7534 | .I $D(ORO ) S PSOPRO V=$P(ORO," ^",4) | |
| 7535 | "RTN","PSO RENW0",38, 0) | |
| 7536 | .K DD,DO S DIC="^PS (52.52,",D IC(0)="L", DLAYGO=52. 52,X=% | |
| 7537 | "RTN","PSO RENW0",39, 0) | |
| 7538 | .D FILE^D ICN K DIC, DLAYGO,DD, DO,DA,DR | |
| 7539 | "RTN","PSO RENW0",40, 0) | |
| 7540 | .N PS52 S (PS52,DA) =+Y,DIE="^ PS(52.52," ,DR="1//// "_PSORENW( "IRXN")_"; 2////"_PSO 1PH_";3/// /"_PSOPROV _";4////"_ PSOREASN_" ;5////"_PS OREMRK_";6 ////"_PSO2 PH | |
| 7541 | "RTN","PSO RENW0",41, 0) | |
| 7542 | .D ^DIE K DIE,DA,DR | |
| 7543 | "RTN","PSO RENW0",42, 0) | |
| 7544 | .K ANQDAT A,X,Y,%,AN QREM | |
| 7545 | "RTN","PSO RENW0",43, 0) | |
| 7546 | .D ALERT | |
| 7547 | "RTN","PSO RENW0",44, 0) | |
| 7548 | ; ** END NCC REMEDI ATION ** 4 57/RTW | |
| 7549 | "RTN","PSO RENW0",45, 0) | |
| 7550 | ; | |
| 7551 | "RTN","PSO RENW0",46, 0) | |
| 7552 | PROCESSX N PSORWRIT I PSORENW( "DFLG")!$G (PSORX("DF LG")) S PS OBBCLK=1 W :'$G(POERR ) !,$C(7), "RENEWED R X DELETED" ,! S PSOWR IT=1,PSORE RR=1 D | |
| 7553 | "RTN","PSO RENW0",47, 0) | |
| 7554 | .D:$P($G( PSOLST(+$G (ORN))),"^ ",2) PSOUL ^PSSLOCK($ P(PSOLST(O RN),"^",2) ) S POERR( "DFLG")=1 D CLEAN^PS OVER1 D | |
| 7555 | "RTN","PSO RENW0",48, 0) | |
| 7556 | ..W !! K DIR S DIR( 0)="E",DIR ("?")="Pre ss Return to continu e",DIR("A" )="Press R eturn to C ontinue" D ^DIR K DI R,DTOUT,DU OUT S VALM BCK="Q" | |
| 7557 | "RTN","PSO RENW0",49, 0) | |
| 7558 | D:$G(PSOR ENW("OLD F ILL DATE") )]"" SUSDA TEK^PSOUTI L(.PSORENW ) | |
| 7559 | "RTN","PSO RENW0",50, 0) | |
| 7560 | K PRC,PHI ,PSOQUIT,B BRN,BBRN1, PSORENW,PS ODRUG,PSOR X("PROVIDE R NAME"),P SORX("CLIN IC"),PSORX ("FN") | |
| 7561 | "RTN","PSO RENW0",51, 0) | |
| 7562 | K PSOEDT, PSOLM S:$G (PSORENW(" FROM"))="" (PSORENW( "DFLG"),PS ORENW("QFL G"))=0 | |
| 7563 | "RTN","PSO RENW0",52, 0) | |
| 7564 | D CLEAN^P SOVER1 | |
| 7565 | "RTN","PSO RENW0",53, 0) | |
| 7566 | Q | |
| 7567 | "RTN","PSO RENW0",54, 0) | |
| 7568 | ; | |
| 7569 | "RTN","PSO RENW0",55, 0) | |
| 7570 | CHECK ; | |
| 7571 | "RTN","PSO RENW0",56, 0) | |
| 7572 | I '$D(PSO RX("BAR CO DE")),PSOR ENW("PSODF N")'=PSODF N D G CHE CKX | |
| 7573 | "RTN","PSO RENW0",57, 0) | |
| 7574 | .W !!,?5, $C(7),"Can 't renew R x # "_$P(P SORENW("RX 0"),"^")_" , it is no t for this patient." S PSORENW ("DFLG")=1 | |
| 7575 | "RTN","PSO RENW0",58, 0) | |
| 7576 | .S:$G(POE RR) VALMSG ="Can't re new Rx # " _$P(PSOREN W("RX0")," ^")_", not for this patient.", VALMBCK="R " | |
| 7577 | "RTN","PSO RENW0",59, 0) | |
| 7578 | ;Invalid dosage che ck | |
| 7579 | "RTN","PSO RENW0",60, 0) | |
| 7580 | N PSOOCPR X,PSOOLPF, PSOOLPD,PS ONOSIG S P SOOCPRX=PS ORENW("OIR XN") D CDO SE | |
| 7581 | "RTN","PSO RENW0",61, 0) | |
| 7582 | I PSOOLPF !(PSONOSIG ) D G CHE CKX | |
| 7583 | "RTN","PSO RENW0",62, 0) | |
| 7584 | .S PSOREN W("DFLG")= 1 | |
| 7585 | "RTN","PSO RENW0",63, 0) | |
| 7586 | .W !!,$C( 7),"Cannot renew Rx # "_$P(PSO RENW("RX0" ),"^")_$S( PSOOLPF:", invalid d osage of " _$G(PSOOLP D),1:", Mi ssing Sig" ) | |
| 7587 | "RTN","PSO RENW0",64, 0) | |
| 7588 | .S:$G(POE RR) VALMSG ="Cannot r enew Rx # "_$P(PSORE NW("RX0"), "^")_$S(PS OOLPF:", i nvalid Dos age of "_$ G(PSOOLPD) ,1:", Miss ing Sig") S VALMBCK= "R" | |
| 7589 | "RTN","PSO RENW0",65, 0) | |
| 7590 | .I '$G(PS ORNSPD) W ! K DIR S DIR(0)="E" ,DIR("?")= "Press Ret urn to con tinue",DIR ("A")="Pre ss Return to Continu e" D ^DIR K DIR | |
| 7591 | "RTN","PSO RENW0",66, 0) | |
| 7592 | .I $G(PSO RNSPD) W ! | |
| 7593 | "RTN","PSO RENW0",67, 0) | |
| 7594 | ; | |
| 7595 | "RTN","PSO RENW0",68, 0) | |
| 7596 | N PSOS S (PSOS,PSOX ,PSOY)="" K ACOM,DIR ,DIRUT,DIR UT,DUOUT N DRG | |
| 7597 | "RTN","PSO RENW0",69, 0) | |
| 7598 | I $G(PSOS D) F S PS OS=$O(PSOS D(PSOS)) Q :PSOS="" F S PSOX= $O(PSOSD(P SOS,PSOX)) Q:PSOX']" "!(PSORENW ("DFLG")) I PSORENW ("OIRXN")= +PSOSD(PSO S,PSOX) S PSOY=PSOSD (PSOS,PSOX ) I $TR($P (PSOY,"^", 3),"B")]"" D K ACOM ,DIR,DIRUT ,DIRUT,DUO UT | |
| 7599 | "RTN","PSO RENW0",70, 0) | |
| 7600 | . S PSORE NW("DFLG") =1 | |
| 7601 | "RTN","PSO RENW0",71, 0) | |
| 7602 | . W !,$C( 7),"Cannot renew Rx # ",$P(PSO RENW("RX0" ),"^") | |
| 7603 | "RTN","PSO RENW0",72, 0) | |
| 7604 | . S PSORE A=$P(PSOY, "^",3),PSO STAT=+PSOR ENW("STA") | |
| 7605 | "RTN","PSO RENW0",73, 0) | |
| 7606 | . D STATU S^PSOUTIL( PSOREA,PSO STAT) K PS OREA,PSOST AT | |
| 7607 | "RTN","PSO RENW0",74, 0) | |
| 7608 | .I $G(ACO M)]"" D | |
| 7609 | "RTN","PSO RENW0",75, 0) | |
| 7610 | ..S DRG=$ $GET1^DIQ( 52,PSORENW ("OIRXN"), 6) | |
| 7611 | "RTN","PSO RENW0",76, 0) | |
| 7612 | ..W ! S D IR(0)="Y", DIR("A",1) ="Do you w ant to Dis continue t his Pendin g Order",D IR("A")="f or "_DRG,D IR("B")="N o" | |
| 7613 | "RTN","PSO RENW0",77, 0) | |
| 7614 | ..D ^DIR I 'Y!($D(D IRUT)) Q | |
| 7615 | "RTN","PSO RENW0",78, 0) | |
| 7616 | ..D NOOR^ PSOCAN4 Q: $D(DIRUT) D DE^PSOO RFI2 | |
| 7617 | "RTN","PSO RENW0",79, 0) | |
| 7618 | .Q | |
| 7619 | "RTN","PSO RENW0",80, 0) | |
| 7620 | I PSOY="" ,'$G(PSOOR RNW) D | |
| 7621 | "RTN","PSO RENW0",81, 0) | |
| 7622 | .W !,$C(7 ),"Cannot renew Rx # ",$P(PSOR ENW("RX0") ,"^")," la ter Rx exi sts." S PS ORENW("DFL G")=1 | |
| 7623 | "RTN","PSO RENW0",82, 0) | |
| 7624 | .S:$G(POE RR) VALMSG ="Cannot r enew Rx # "_$P(PSORE NW("RX0"), "^")_" lat er Rx exis ts.",VALMB CK="R" | |
| 7625 | "RTN","PSO RENW0",83, 0) | |
| 7626 | K PSOX,PS OY G:PSORE NW("DFLG") CHECKX | |
| 7627 | "RTN","PSO RENW0",84, 0) | |
| 7628 | ; | |
| 7629 | "RTN","PSO RENW0",85, 0) | |
| 7630 | I $A($E(P SORENW("OR X #"),$L(P SORENW("OR X #"))))'< 90 D Q | |
| 7631 | "RTN","PSO RENW0",86, 0) | |
| 7632 | . W !,$C( 7),"Cannot renew Rx # "_PSOREN W("ORX #") _", Max nu mber of re newals rea ched." | |
| 7633 | "RTN","PSO RENW0",87, 0) | |
| 7634 | .S:$G(POE RR)!('$G(S PEED)) (AC OM,VALMSG) ="Cannot r enew Rx # "_PSORENW( "ORX #")_" , Max numb er reached .",VALMBCK ="R" | |
| 7635 | "RTN","PSO RENW0",88, 0) | |
| 7636 | . S PSORE NW("DFLG") =1 | |
| 7637 | "RTN","PSO RENW0",89, 0) | |
| 7638 | .I $G(OR0 )]"" D | |
| 7639 | "RTN","PSO RENW0",90, 0) | |
| 7640 | ..S DRG=$ $GET1^DIQ( 52,PSORENW ("OIRXN"), 6) | |
| 7641 | "RTN","PSO RENW0",91, 0) | |
| 7642 | ..W ! S D IR(0)="Y", DIR("A",1) ="Do you w ant to Dis continue t his Pendin g Order",D IR("A")="f or "_DRG,D IR("B")="N o" | |
| 7643 | "RTN","PSO RENW0",92, 0) | |
| 7644 | ..D ^DIR I 'Y!($D(D IRUT)) Q | |
| 7645 | "RTN","PSO RENW0",93, 0) | |
| 7646 | ..D NOOR^ PSOCAN4 Q: $D(DIRUT) D DE^PSOO RFI2 | |
| 7647 | "RTN","PSO RENW0",94, 0) | |
| 7648 | .K ACOM Q | |
| 7649 | "RTN","PSO RENW0",95, 0) | |
| 7650 | D CHKDIV G:PSORENW( "DFLG") CH ECKX | |
| 7651 | "RTN","PSO RENW0",96, 0) | |
| 7652 | ; | |
| 7653 | "RTN","PSO RENW0",97, 0) | |
| 7654 | D CHKPRV^ PSOUTIL | |
| 7655 | "RTN","PSO RENW0",98, 0) | |
| 7656 | CHECKX Q | |
| 7657 | "RTN","PSO RENW0",99, 0) | |
| 7658 | ; | |
| 7659 | "RTN","PSO RENW0",100 ,0) | |
| 7660 | CHKDIV ; | |
| 7661 | "RTN","PSO RENW0",101 ,0) | |
| 7662 | G:$P(PSOR ENW("RX2") ,"^",9)=+P SOSITE CHK DIVX | |
| 7663 | "RTN","PSO RENW0",102 ,0) | |
| 7664 | W !?5,$C( 7),"RX # " ,$P(PSOREN W("RX0")," ^")," is f or (",$$GE T1^DIQ(59, $P(PSORENW ("RX2"),"^ ",9),.01), ") divisio n." | |
| 7665 | "RTN","PSO RENW0",103 ,0) | |
| 7666 | I '$P($G( PSOSYS),"^ ",2) S PSO RENW("DFLG ")=1 G CHK DIVX | |
| 7667 | "RTN","PSO RENW0",104 ,0) | |
| 7668 | D:$P($G(P SOSYS),"^" ,3) DIR | |
| 7669 | "RTN","PSO RENW0",105 ,0) | |
| 7670 | CHKDIVX Q | |
| 7671 | "RTN","PSO RENW0",106 ,0) | |
| 7672 | ; | |
| 7673 | "RTN","PSO RENW0",107 ,0) | |
| 7674 | DRUG ; | |
| 7675 | "RTN","PSO RENW0",108 ,0) | |
| 7676 | K PSOY | |
| 7677 | "RTN","PSO RENW0",109 ,0) | |
| 7678 | S PSOY=PS ORENW("DRU G IEN"),PS OY(0)=^PSD RUG(PSOY,0 ),PSORENWD =1 | |
| 7679 | "RTN","PSO RENW0",110 ,0) | |
| 7680 | I '$P($G( ^PSDRUG(PS OY,2)),"^" ) D Q:$G( PSORX("DFL G")) | |
| 7681 | "RTN","PSO RENW0",111 ,0) | |
| 7682 | .I $$GET1 ^DIQ(52,PS ORENW("OIR XN"),39.2, "I") S PSO DRUG("OI") =$$GET1^DI Q(52,PSORE NW("OIRXN" ),39.2,"I" ),PSODRUG( "OIN")=$$G ET1^DIQ(52 ,PSORENW(" OIRXN"),39 .2) Q | |
| 7683 | "RTN","PSO RENW0",112 ,0) | |
| 7684 | .W !!,"Ca nnot Renew !! No Pha rmacy Orde rable Item !" S VALMS G="Cannot Renew!! N o Pharmacy Orderable Item!",PS ORX("DFLG" )=1 | |
| 7685 | "RTN","PSO RENW0",113 ,0) | |
| 7686 | D SET^PSO DRG | |
| 7687 | "RTN","PSO RENW0",114 ,0) | |
| 7688 | D POST^PS ODRG D:'PS ORX("DFLG" ) DOSCK^PS ODOSUT("R" ) S:$G(PSO RX("DFLG") ) PSORENW( "DFLG")=1 ;remove or der checks for v7. d o allergy checks onl y | |
| 7689 | "RTN","PSO RENW0",115 ,0) | |
| 7690 | S PSONOOR =PSORENW(" NOO") | |
| 7691 | "RTN","PSO RENW0",116 ,0) | |
| 7692 | K PSORX(" INTERVENE" ) | |
| 7693 | "RTN","PSO RENW0",117 ,0) | |
| 7694 | S:$D(PSON EW("STATUS ")) PSOREN W("STATUS" )=PSONEW(" STATUS") | |
| 7695 | "RTN","PSO RENW0",118 ,0) | |
| 7696 | K PSOY,PS ONEW("STAT US"),PSORE NWD | |
| 7697 | "RTN","PSO RENW0",119 ,0) | |
| 7698 | Q | |
| 7699 | "RTN","PSO RENW0",120 ,0) | |
| 7700 | ; | |
| 7701 | "RTN","PSO RENW0",121 ,0) | |
| 7702 | RXN ; | |
| 7703 | "RTN","PSO RENW0",122 ,0) | |
| 7704 | K PSOX | |
| 7705 | "RTN","PSO RENW0",123 ,0) | |
| 7706 | S PSOX=$E (PSORENW(" ORX #"),$L (PSORENW(" ORX #"))) | |
| 7707 | "RTN","PSO RENW0",124 ,0) | |
| 7708 | S PSORENW ("NRX #")= $S(PSOX?1N :PSORENW(" ORX #")_"A ",1:$E(PSO RENW("ORX #"),1,$L(P SORENW("OR X #"))-1)_ $C($A(PSOX )+1)) | |
| 7709 | "RTN","PSO RENW0",125 ,0) | |
| 7710 | RETRY I $O (^PSRX("B" ,PSORENW(" NRX #"),0) ) D G:'$G (PSORENW(" DFLG")) RE TRY | |
| 7711 | "RTN","PSO RENW0",126 ,0) | |
| 7712 | .W:$A($E( PSORENW("N RX #"),$L( PSORENW("O RX #"))))' =90 !,"Rx # "_PSOREN W("NRX #") _" is alre ady on fil e." | |
| 7713 | "RTN","PSO RENW0",127 ,0) | |
| 7714 | .S:$G(PSO FDR) VALMS G="Rx # "_ PSORENW("N RX #")_" i s already on file." | |
| 7715 | "RTN","PSO RENW0",128 ,0) | |
| 7716 | .I $A($E( PSORENW("N RX #"),$L( PSORENW("O RX #"))))= 90 D | |
| 7717 | "RTN","PSO RENW0",129 ,0) | |
| 7718 | ..W !,"Rx # "_PSORE NW("NRX #" )_" is alr eady on fi le. Cannot renew Rx #"_PSORENW ("ORX #")_ ".",!,"A n ew Rx must be entere d.",! | |
| 7719 | "RTN","PSO RENW0",130 ,0) | |
| 7720 | ..S:$G(PS OFDR) VALM SG="Rx # " _PSORENW(" NRX #")_" is already on file. Cannot ren ew Rx #"_P SORENW("OR X #")_". A new Rx mu st be ente red." | |
| 7721 | "RTN","PSO RENW0",131 ,0) | |
| 7722 | ..K DIR S DIR(0)="E ",DIR("?") ="Press Re turn to co ntinue",DI R("A")="Pr ess Return to Contin ue" D ^DIR K DIR | |
| 7723 | "RTN","PSO RENW0",132 ,0) | |
| 7724 | ..S:$G(PO ERR)!($G(P SOFDR)) VA LMSG="Cann ot renew R x # "_PSOR ENW("ORX # ")_", Max number rea ched.",VAL MBCK="R" S PSORENW(" DFLG")=1 | |
| 7725 | "RTN","PSO RENW0",133 ,0) | |
| 7726 | .S PSOX=$ E(PSORENW( "NRX #"),$ L(PSORENW( "NRX #"))) | |
| 7727 | "RTN","PSO RENW0",134 ,0) | |
| 7728 | .S PSOREN W("NRX #") =$S(PSOX?1 N:PSORENW( "NRX #")_" A",1:$E(PS ORENW("NRX #"),1,$L( PSORENW("N RX #"))-1) _$C($A(PSO X)+1)) | |
| 7729 | "RTN","PSO RENW0",135 ,0) | |
| 7730 | RXNX K PSO X | |
| 7731 | "RTN","PSO RENW0",136 ,0) | |
| 7732 | Q | |
| 7733 | "RTN","PSO RENW0",137 ,0) | |
| 7734 | ; | |
| 7735 | "RTN","PSO RENW0",138 ,0) | |
| 7736 | FILDATE ; | |
| 7737 | "RTN","PSO RENW0",139 ,0) | |
| 7738 | S PSORENW ("IRXN")=P SORENW("OI RXN") | |
| 7739 | "RTN","PSO RENW0",140 ,0) | |
| 7740 | D NEXT^PS OUTIL(.PSO RENW) | |
| 7741 | "RTN","PSO RENW0",141 ,0) | |
| 7742 | I PSORENW ("FILL DAT E")<$P(PSO RENW("RX3" ),"^",2) D | |
| 7743 | "RTN","PSO RENW0",142 ,0) | |
| 7744 | .D RENFDT ^PSOUTIL(. PSORENW) | |
| 7745 | "RTN","PSO RENW0",143 ,0) | |
| 7746 | .I PSOREN W("FILL DA TE")<DT,PS ORENW("FIL L DATE")<P SORNW("FIL L DATE") S (Y,PSOREN W("FILL DA TE"))=DT X ^DD("DD") S PSORX(" FILL DATE" )=Y K Y | |
| 7747 | "RTN","PSO RENW0",144 ,0) | |
| 7748 | K PSORENW ("IRXN") | |
| 7749 | "RTN","PSO RENW0",145 ,0) | |
| 7750 | Q | |
| 7751 | "RTN","PSO RENW0",146 ,0) | |
| 7752 | ; | |
| 7753 | "RTN","PSO RENW0",147 ,0) | |
| 7754 | EDIT ; | |
| 7755 | "RTN","PSO RENW0",148 ,0) | |
| 7756 | K DIR,X,Y | |
| 7757 | "RTN","PSO RENW0",149 ,0) | |
| 7758 | S DIR(0)= "Y",DIR("B ")=$S($G(D UZ("AG"))' ="I":"Y",$ G(PSEXDT): "Y",1:"N") | |
| 7759 | "RTN","PSO RENW0",150 ,0) | |
| 7760 | S DIR("A" )="Edit re newed Rx " ,DIR("?")= "Answer YE S to edit the renewe d Rx, NO n ot to." | |
| 7761 | "RTN","PSO RENW0",151 ,0) | |
| 7762 | D ^DIR K DIR S:$D(D IRUT) PSOR ENW("DFLG" )=1 | |
| 7763 | "RTN","PSO RENW0",152 ,0) | |
| 7764 | G:PSORENW ("DFLG") E DITX | |
| 7765 | "RTN","PSO RENW0",153 ,0) | |
| 7766 | K PSOQUIT ,PSORX("FN ") I Y S P SORNALL=1 D INIT^PSO RENW3,EN^P SOORNE4(.P SORENW) K PSORNALL S :$G(PSOQUI T) PSORENW ("DFLG")=1 I '$G(PSO RX("FN")) D FULL^VAL M1 Q | |
| 7767 | "RTN","PSO RENW0",154 ,0) | |
| 7768 | Q:$G(PSOR X("FN")) | |
| 7769 | "RTN","PSO RENW0",155 ,0) | |
| 7770 | EDITX S PS OEDT=1,VAL MBCK="Q" K X,Y,DIRUT ,DTOUT,DUO UT S PSORE NW("QFLG") =1 | |
| 7771 | "RTN","PSO RENW0",156 ,0) | |
| 7772 | Q | |
| 7773 | "RTN","PSO RENW0",157 ,0) | |
| 7774 | ; | |
| 7775 | "RTN","PSO RENW0",158 ,0) | |
| 7776 | DELETE ; | |
| 7777 | "RTN","PSO RENW0",159 ,0) | |
| 7778 | K DA,DIK | |
| 7779 | "RTN","PSO RENW0",160 ,0) | |
| 7780 | S DA=$O(^ PS(52.5,"B ",PSORENW( "OIRXN"),0 )),DIK="^P S(52.5," | |
| 7781 | "RTN","PSO RENW0",161 ,0) | |
| 7782 | D ^DIK K DIK,DIC | |
| 7783 | "RTN","PSO RENW0",162 ,0) | |
| 7784 | Q | |
| 7785 | "RTN","PSO RENW0",163 ,0) | |
| 7786 | ; | |
| 7787 | "RTN","PSO RENW0",164 ,0) | |
| 7788 | CAN ; | |
| 7789 | "RTN","PSO RENW0",165 ,0) | |
| 7790 | K REA,DA, MSG | |
| 7791 | "RTN","PSO RENW0",166 ,0) | |
| 7792 | S REA="C" ,DA=PSOREN W("OIRXN") | |
| 7793 | "RTN","PSO RENW0",167 ,0) | |
| 7794 | S MSG="Re newed"_$S( $G(PSOFDR) :" from CP RS",1:"") | |
| 7795 | "RTN","PSO RENW0",168 ,0) | |
| 7796 | S PSCAN(P SORENW("OR X #"))=DA_ "^C" | |
| 7797 | "RTN","PSO RENW0",169 ,0) | |
| 7798 | D CAN^PSO CAN | |
| 7799 | "RTN","PSO RENW0",170 ,0) | |
| 7800 | K REA,DA, MSG,PSCAN | |
| 7801 | "RTN","PSO RENW0",171 ,0) | |
| 7802 | Q | |
| 7803 | "RTN","PSO RENW0",172 ,0) | |
| 7804 | ; | |
| 7805 | "RTN","PSO RENW0",173 ,0) | |
| 7806 | DIR ; | |
| 7807 | "RTN","PSO RENW0",174 ,0) | |
| 7808 | S DIR(0)= "Y",DIR("A ")="CONTIN UE ",DIR(" B")="N" | |
| 7809 | "RTN","PSO RENW0",175 ,0) | |
| 7810 | S DIR("?" )="Answer YES to Con tinue, NO to bypass" | |
| 7811 | "RTN","PSO RENW0",176 ,0) | |
| 7812 | D ^DIR K DIR | |
| 7813 | "RTN","PSO RENW0",177 ,0) | |
| 7814 | S:$D(DIRU T)!('Y) PS ORENW("DFL G")=1 | |
| 7815 | "RTN","PSO RENW0",178 ,0) | |
| 7816 | DIRX K DIR UT,DTOUT,D UOUT,X,Y | |
| 7817 | "RTN","PSO RENW0",179 ,0) | |
| 7818 | Q | |
| 7819 | "RTN","PSO RENW0",180 ,0) | |
| 7820 | NEWPT ; | |
| 7821 | "RTN","PSO RENW0",181 ,0) | |
| 7822 | S PSOQFLG =0 N PSODF N | |
| 7823 | "RTN","PSO RENW0",182 ,0) | |
| 7824 | S PSODFN= PSORENW("P SODFN") | |
| 7825 | "RTN","PSO RENW0",183 ,0) | |
| 7826 | D ^PSOPTP ST I PSOQF LG S PSORE NW("DFLG") =1,PSOQFLG =0 G NEWPT X | |
| 7827 | "RTN","PSO RENW0",184 ,0) | |
| 7828 | D PROFILE ^PSOREF1 | |
| 7829 | "RTN","PSO RENW0",185 ,0) | |
| 7830 | NEWPTX Q | |
| 7831 | "RTN","PSO RENW0",186 ,0) | |
| 7832 | ; | |
| 7833 | "RTN","PSO RENW0",187 ,0) | |
| 7834 | EN(PSORENW ) ; Entry Poi nt for Bat ch Barcode Option | |
| 7835 | "RTN","PSO RENW0",188 ,0) | |
| 7836 | S PSORENR X=$G(PSOBB C("OIRXN") ) | |
| 7837 | "RTN","PSO RENW0",189 ,0) | |
| 7838 | I $G(PSOR ENRX) D PS OL^PSSLOCK (PSORENRX) I '$G(PSO MSG) D K DIR,PSOMSG W ! S DIR ("A")="Pre ss Return to continu e",DIR(0)= "E",DIR("? ")="Press Return to continue" D ^DIR K D IR W ! Q | |
| 7839 | "RTN","PSO RENW0",190 ,0) | |
| 7840 | .I $P($G( PSOMSG),"^ ",2)'="" W $C(7),!!, $P(PSOMSG, "^",2) Q | |
| 7841 | "RTN","PSO RENW0",191 ,0) | |
| 7842 | .W $C(7), !!,"Anothe r person i s editing Rx "_$$GET 1^DIQ(52,P SORENRX,.0 1,"I") | |
| 7843 | "RTN","PSO RENW0",192 ,0) | |
| 7844 | K PSOMSG, PSOBBCLK S PSOBARCD= 1 D PROCES S K PSOBAR CD | |
| 7845 | "RTN","PSO RENW0",193 ,0) | |
| 7846 | D KLIB^PS ORENW1 | |
| 7847 | "RTN","PSO RENW0",194 ,0) | |
| 7848 | I $G(PSOR ENRX),$G(P SOBBCLK) D PSOUL^PSS LOCK(PSORE NRX) | |
| 7849 | "RTN","PSO RENW0",195 ,0) | |
| 7850 | K PSORENR X,PSOBBCLK | |
| 7851 | "RTN","PSO RENW0",196 ,0) | |
| 7852 | Q | |
| 7853 | "RTN","PSO RENW0",197 ,0) | |
| 7854 | CDOSE ;Val idate Dosa ge field o n Renewal, Copy, Edi t | |
| 7855 | "RTN","PSO RENW0",198 ,0) | |
| 7856 | ;PSOOCPRX must be s et to inte rnal Rx nu mber | |
| 7857 | "RTN","PSO RENW0",199 ,0) | |
| 7858 | Q:'$G(PSO OCPRX) | |
| 7859 | "RTN","PSO RENW0",200 ,0) | |
| 7860 | N PSOOLP, PSOOKZ | |
| 7861 | "RTN","PSO RENW0",201 ,0) | |
| 7862 | S PSOOLP= "",(PSOOLP F,PSONOSIG )=0 F S P SOOLP=$O(^ PSRX(PSOOC PRX,6,PSOO LP)) Q:PSO OLP=""!(PS OOLPF) I $P($G(^PSR X(PSOOCPRX ,6,PSOOLP, 0)),"^")[" 0.." S PSO OLPD=$P($G (^(0)),"^" ),PSOOLPF= 1 | |
| 7863 | "RTN","PSO RENW0",202 ,0) | |
| 7864 | Q:PSOOLPF | |
| 7865 | "RTN","PSO RENW0",203 ,0) | |
| 7866 | S PSOOKZ= 0 | |
| 7867 | "RTN","PSO RENW0",204 ,0) | |
| 7868 | I $P($G(^ PSRX(PSOOC PRX,"SIG") ),"^",2) S PSOOLP="" F S PSOO LP=$O(^PSR X(PSOOCPRX ,"SIG1",PS OOLP)) Q:P SOOLP=""!( PSOOKZ) I $G(^PSRX( PSOOCPRX," SIG1",PSOO LP,0))'="" S PSOOKZ= 1 | |
| 7869 | "RTN","PSO RENW0",205 ,0) | |
| 7870 | I '$P($G( ^PSRX(PSOO CPRX,"SIG" )),"^",2), $P($G(^("S IG")),"^") '="" S PSO OKZ=1 | |
| 7871 | "RTN","PSO RENW0",206 ,0) | |
| 7872 | I 'PSOOKZ S PSONOSI G=1 | |
| 7873 | "RTN","PSO RENW0",207 ,0) | |
| 7874 | Q | |
| 7875 | "RTN","PSO RENW0",208 ,0) | |
| 7876 | ; | |
| 7877 | "RTN","PSO RENW0",209 ,0) | |
| 7878 | ;; ** STA RT NCC REM EDIATION * * 457/RTW | |
| 7879 | "RTN","PSO RENW0",210 ,0) | |
| 7880 | ALERT ; se nd an aler t to the t hree appro ving team members | |
| 7881 | "RTN","PSO RENW0",211 ,0) | |
| 7882 | S XQADATA =PSCLPAT | |
| 7883 | "RTN","PSO RENW0",212 ,0) | |
| 7884 | S PSOLAST 4=$E($P($G (^DPT(PSCL PAT,0)),"^ ",9),6,9) | |
| 7885 | "RTN","PSO RENW0",213 ,0) | |
| 7886 | S XQAARCH =1 | |
| 7887 | "RTN","PSO RENW0",214 ,0) | |
| 7888 | S XQAFLG= "D" | |
| 7889 | "RTN","PSO RENW0",215 ,0) | |
| 7890 | S XQA(PSO 2PH)="",XQ A(PSOUSER) ="" | |
| 7891 | "RTN","PSO RENW0",216 ,0) | |
| 7892 | D NOW^%DT C S Y=% D DD^%DT S P SCDATE=Y | |
| 7893 | "RTN","PSO RENW0",217 ,0) | |
| 7894 | S XQAMSG= $$GET1^DIQ (2,PSCLPAT ,.01)_" (" _PSOLAST4_ ")"_": CLO ZAPINE OVE RRIDE RX P ROCESSED :"_PSCDATE | |
| 7895 | "RTN","PSO RENW0",218 ,0) | |
| 7896 | S XQAID=" PSI"_","_P SCLPAT | |
| 7897 | "RTN","PSO RENW0",219 ,0) | |
| 7898 | D SETUP^X QALERT | |
| 7899 | "RTN","PSO RENW0",220 ,0) | |
| 7900 | W !!,"OVE RRIDE ALER TS HAVE BE EN SENT TO THE APPRO VING TEAM MEMBERS",! ! | |
| 7901 | "RTN","PSO RENW0",221 ,0) | |
| 7902 | Q | |
| 7903 | "RTN","PSO RENW4") | |
| 7904 | 0^11^B7597 6559 | |
| 7905 | "RTN","PSO RENW4",1,0 ) | |
| 7906 | PSORENW4 ; BIR/SAB - rx speed r enew ;Jul 24, 2017@1 5:24 | |
| 7907 | "RTN","PSO RENW4",2,0 ) | |
| 7908 | ;;7.0;OUT PATIENT PH ARMACY;**1 1,23,27,32 ,37,64,46, 75,71,100, 130,117,15 2,148,264, 225,301,39 0,313,411, 444,457**; DEC 1997;B uild 65 | |
| 7909 | "RTN","PSO RENW4",3,0 ) | |
| 7910 | ;External reference to ^PSDRU G( support ed by DBIA 221 | |
| 7911 | "RTN","PSO RENW4",4,0 ) | |
| 7912 | ;External reference to ^PS(50 .7 support ed by DBIA 2223 | |
| 7913 | "RTN","PSO RENW4",5,0 ) | |
| 7914 | ;External reference to $$L^PS SLOCK supp orted by D BIA 2789 | |
| 7915 | "RTN","PSO RENW4",6,0 ) | |
| 7916 | ;External reference to UL^PSS LOCK suppo rted by DB IA 2789 | |
| 7917 | "RTN","PSO RENW4",7,0 ) | |
| 7918 | ;External reference to PSOL^P SSLOCK sup ported by DBIA 2789 | |
| 7919 | "RTN","PSO RENW4",8,0 ) | |
| 7920 | ;External reference to PSOUL^ PSSLOCK su pported by DBIA 2789 | |
| 7921 | "RTN","PSO RENW4",9,0 ) | |
| 7922 | ;External reference to LK^ORX 2 supporte d by DBIA 867 | |
| 7923 | "RTN","PSO RENW4",10, 0) | |
| 7924 | ;External reference to ULK^OR X2 support ed by DBIA 867 | |
| 7925 | "RTN","PSO RENW4",11, 0) | |
| 7926 | ;External reference to ^PSRX supported by DBIA 35 00 | |
| 7927 | "RTN","PSO RENW4",12, 0) | |
| 7928 | ;External reference to ^VA(20 0 supporte d by DBIA 10060 | |
| 7929 | "RTN","PSO RENW4",13, 0) | |
| 7930 | SEL K PSOD RUG ;PSO*7 *301 | |
| 7931 | "RTN","PSO RENW4",14, 0) | |
| 7932 | N PSOSPRN W,PSOIBOLD S PSOSPRN W=1 | |
| 7933 | "RTN","PSO RENW4",15, 0) | |
| 7934 | I $P(PSOP AR,"^",4)= 0 S VALMSG ="Renewing is NOT Al lowed. Che ck Site Pa rameters!" ,VALMBCK=" " Q | |
| 7935 | "RTN","PSO RENW4",16, 0) | |
| 7936 | N VALMCNT I '$G(PSO CNT) S VAL MSG="This patient ha s no Presc riptions!" ,VALMBCK=" " Q | |
| 7937 | "RTN","PSO RENW4",17, 0) | |
| 7938 | S PSOPLCK =$$L^PSSLO CK(PSODFN, 0) I '$G(P SOPLCK) D LOCK^PSOOR CPY S VALM SG=$S($P($ G(PSOPLCK) ,"^",2)'=" ":$P($G(PS OPLCK),"^" ,2)_" is w orking on this patie nt.",1:"An other pers on is ente ring order s for this patient." ) K PSOPLC K S VALMBC K="" Q | |
| 7939 | "RTN","PSO RENW4",18, 0) | |
| 7940 | K PSOPLCK S X=PSODF N_";DPT(" D LK^ORX2 I 'Y S VAL MSG="Anoth er person is enterin g orders f or this pa tient.",VA LMBCK="" D UL^PSSLOC K(PSODFN) Q | |
| 7941 | "RTN","PSO RENW4",19, 0) | |
| 7942 | K PRC,PHI ,PSORX("ED IT"),PSOFD R,DIR,DUOU T,DIRUT,PS ORNSPD S D IR("A")="S elect Orde rs by numb er",DIR(0) ="LO^1:"_P SOCNT D ^D IR I $D(DT OUT)!($D(D UOUT)) K D IR,DIRUT,D TOUT,DUOUT S VALMBCK ="" G SELQ | |
| 7943 | "RTN","PSO RENW4",20, 0) | |
| 7944 | ; | |
| 7945 | "RTN","PSO RENW4",21, 0) | |
| 7946 | ;>> Begin NCC remed iation *45 7/RJS | |
| 7947 | "RTN","PSO RENW4",22, 0) | |
| 7948 | D I $G(P SOERR)=2 S PSOERR=0 G SELQ | |
| 7949 | "RTN","PSO RENW4",23, 0) | |
| 7950 | .N PSDRGI EN,ORDLN S ORDLN=$G( PSOLST(+Y) ) Q:+ORDLN '=52 | |
| 7951 | "RTN","PSO RENW4",24, 0) | |
| 7952 | .S PSDRGI EN=$$GET1^ DIQ(52,+$P (ORDLN,"^" ,2),6) Q:' PSDRGIEN | |
| 7953 | "RTN","PSO RENW4",25, 0) | |
| 7954 | .I $$GET1 ^DIQ(50,PS DRGIEN,17. 5)="PSOCLO 1" D S PS OERR=2 | |
| 7955 | "RTN","PSO RENW4",26, 0) | |
| 7956 | ..N Y,ORU B S Y("1") ="^^Renew^ RN",ORUB=1 D NS^XQOR M4 | |
| 7957 | "RTN","PSO RENW4",27, 0) | |
| 7958 | ..K DIR S DIR(0)="E ",DIR("A") ="Press Re turn to Co ntinue" D ^DIR K DIR ,DTOUT,DUO UT,DIRUT | |
| 7959 | "RTN","PSO RENW4",28, 0) | |
| 7960 | ;<< END N CC remedia tion *457/ RJS | |
| 7961 | "RTN","PSO RENW4",29, 0) | |
| 7962 | ; | |
| 7963 | "RTN","PSO RENW4",30, 0) | |
| 7964 | K DIR,DIR UT,DTOUT,P SOOELSE,DT OUT I +Y S (SPEED,PS OOELSE,PSO RNSPD)=1 D FULL^VALM 1 S LST=Y D | |
| 7965 | "RTN","PSO RENW4",31, 0) | |
| 7966 | .S (PSODI R("DFLG"), PSODIR("FI ELD"))=0,P SOOPT=3,(P SORENW("DF LG"),PSORE NW("QFLG") ,PSORX("DF LG"))=0 D INIT Q:PSO RENW("DFLG ") | |
| 7967 | "RTN","PSO RENW4",32, 0) | |
| 7968 | .F ORD=1: 1:$L(LST," ,") Q:$P(L ST,",",ORD )']"" S O RN=$P(LST, ",",ORD) D :+PSOLST(O RN)=52 PRO CESS S (PS OQUIT,PSOR ENW("DFLG" ),POERR,PO ERR("DFLG" ),PSORX("D FLG"))=0 | |
| 7969 | "RTN","PSO RENW4",33, 0) | |
| 7970 | I '$G(PSO OELSE) S V ALMBCK="" G SELQ | |
| 7971 | "RTN","PSO RENW4",34, 0) | |
| 7972 | S VALMBCK ="R" | |
| 7973 | "RTN","PSO RENW4",35, 0) | |
| 7974 | D ^PSOBUI LD,BLD^PSO ORUT1 K DI R,DIRUT,DT OUT,DUOUT, LST,ORD,IE N,ORN,RPH, ST,REFL,RE F,PSOACT,O RSV,PSORNW ,PSORENW,P SONO,PSOCO ,PSOCU,PSO DIR,DSMSG, SPEED,PSOR ENW,PSOOEL SE,PSOOPT, PSORX("FIL L DATE"),P SORX("ISSU E DATE"),P SOID,PSOMS G,PSORX("D FLG"),PSOQ TY | |
| 7975 | "RTN","PSO RENW4",36, 0) | |
| 7976 | SELQ K PSO RNSPD,RTE, DRET,PRC,P HI,PSOSPRN W,X S X=PS ODFN_";DPT (" D ULK^O RX2,UL^PSS LOCK(PSODF N),CLEAN^P SOVER1 | |
| 7977 | "RTN","PSO RENW4",37, 0) | |
| 7978 | Q | |
| 7979 | "RTN","PSO RENW4",38, 0) | |
| 7980 | ; | |
| 7981 | "RTN","PSO RENW4",39, 0) | |
| 7982 | PROCESS ; Process on e order at a time | |
| 7983 | "RTN","PSO RENW4",40, 0) | |
| 7984 | I $$LMREJ ^PSOREJU1( $P(PSOLST( ORN),"^",2 )) D K DI R,PSOMSG D PAUSE^VAL M1 Q | |
| 7985 | "RTN","PSO RENW4",41, 0) | |
| 7986 | .W $C(7), !,"Rx "_$$ GET1^DIQ(5 2,$P(PSOLS T(ORN),"^" ,2),.01)_" has OPEN/ UNRESOLVED 3rd Party Payer Rej ects!" | |
| 7987 | "RTN","PSO RENW4",42, 0) | |
| 7988 | I $$TITRX ^PSOUTL($P (PSOLST(OR N),"^",2)) ="t" D K DIR,PSOMSG D PAUSE^V ALM1 Q | |
| 7989 | "RTN","PSO RENW4",43, 0) | |
| 7990 | .W $C(7), !,"Rx# "_$ $GET1^DIQ( 52,$P(PSOL ST(ORN),"^ ",2),.01)_ " is marke d as 'Titr ation Rx' and cannot be renewe d." | |
| 7991 | "RTN","PSO RENW4",44, 0) | |
| 7992 | D PSOL^PS SLOCK($P(P SOLST(ORN) ,"^",2)) I '$G(PSOMS G) W $C(7) ,!!,$S($P( $G(PSOMSG) ,"^",2)'=" ":$P($G(PS OMSG),"^", 2),1:"Anot her person is editin g Rx "_$$G ET1^DIQ(52 ,$P(PSOLST (ORN),"^", 2),.01,"I" )),! K DIR ,PSOMSG D PAUSE^VALM 1 Q | |
| 7993 | "RTN","PSO RENW4",45, 0) | |
| 7994 | K RET,DRE T,PRC,PHI N PSORXN S (PSORENW( "OIRXN"),P SORXN)=$P( PSOLST(ORN ),"^",2),P SOFROM="NE W" | |
| 7995 | "RTN","PSO RENW4",46, 0) | |
| 7996 | N ARR,RXN KEY D GETS ^DIQ(52,PS ORXN,"**", "I","ARR") S RXNKEY= PSORXN_"," | |
| 7997 | "RTN","PSO RENW4",47, 0) | |
| 7998 | ;S PSOREN W("RX0")=^ PSRX(PSORX N,0),PSORE NW("RX2")= ^(2),PSORE NW("RX3")= ^(3) | |
| 7999 | "RTN","PSO RENW4",48, 0) | |
| 8000 | D | |
| 8001 | "RTN","PSO RENW4",49, 0) | |
| 8002 | .N J S (P SORENW("RX 0"),PSOREN W("RX2"),P SORENW("RX 3"))="" | |
| 8003 | "RTN","PSO RENW4",50, 0) | |
| 8004 | .F J=.01, 2,3,4,5,6, 7,8,9,11,1 ,13,14,16, 17,10.6,10 .3 S PSORE NW("RX0")= PSORENW("R X0")_$G(AR R(52,RXNKE Y,J,"I"))_ U | |
| 8005 | "RTN","PSO RENW4",51, 0) | |
| 8006 | .F J=21,2 2,23,24,25 ,26,27,28, 20,104,29, 30,31,32.2 ,32.1,32.3 S PSORENW ("RX2")=PS ORENW("RX2 ")_$G(ARR( 52,RXNKEY, J,"I"))_U | |
| 8007 | "RTN","PSO RENW4",52, 0) | |
| 8008 | .F J=101, 102,109,10 2.1,26.1,3 4.1,12,102 .2,112,127 S PSORENW ("RX3")=PS ORENW("RX3 ")_$G(ARR( 52,RXNKEY, J,"I"))_U | |
| 8009 | "RTN","PSO RENW4",53, 0) | |
| 8010 | S PSORENW ("STA")=AR R(52,RXNKE Y,100,"I") ;^("STA" ) | |
| 8011 | "RTN","PSO RENW4",54, 0) | |
| 8012 | S PSORENW ("TN")=ARR (52,RXNKEY ,6.5,"I") ;$G(^("T N")) | |
| 8013 | "RTN","PSO RENW4",55, 0) | |
| 8014 | S SIGOK=A RR(52,RXNK EY,10.1,"I ") I SIGOK D | |
| 8015 | "RTN","PSO RENW4",56, 0) | |
| 8016 | .N I F I= 1:1:SIGOK S SIG(I)=$ G(ARR(52.0 4,I_","_RX NKEY,.01," I")) | |
| 8017 | "RTN","PSO RENW4",57, 0) | |
| 8018 | S PSOIBOL D=$G(PSORE NW("OIRXN" )) D SETIB ^PSORENW1 | |
| 8019 | "RTN","PSO RENW4",58, 0) | |
| 8020 | I '$G(PSO RENW("PROV IDER")) D | |
| 8021 | "RTN","PSO RENW4",59, 0) | |
| 8022 | .S PSOREN W("PROVIDE R")=ARR(52 ,RXNKEY,4, "I") ;$P( PSORENW("R X0"),"^",4 ) | |
| 8023 | "RTN","PSO RENW4",60, 0) | |
| 8024 | .S:ARR(52 ,RXNKEY,10 9,"I") PSO RENW("COSI GNING PROV IDER")=ARR (52,RXNKEY ,109,"I") | |
| 8025 | "RTN","PSO RENW4",61, 0) | |
| 8026 | S PSORX(" PROVIDER N AME")=$$GE T1^DIQ(200 ,ARR(52,RX NKEY,4,"I" ),.01) | |
| 8027 | "RTN","PSO RENW4",62, 0) | |
| 8028 | I '$G(PSO RENW("CLIN IC")) S PS ORENW("CLI NIC")=ARR( 52,RXNKEY, 5,"I") | |
| 8029 | "RTN","PSO RENW4",63, 0) | |
| 8030 | S PSORENW ("REMARKS" )="RENEWED FROM RX # "_ARR(52, RXNKEY,.01 ,"I") | |
| 8031 | "RTN","PSO RENW4",64, 0) | |
| 8032 | S PSORENW ("SIG")=AR R(52,RXNKE Y,10,"I") | |
| 8033 | "RTN","PSO RENW4",65, 0) | |
| 8034 | S PSORENW ("PSODFN") =ARR(52,RX NKEY,2,"I" ) | |
| 8035 | "RTN","PSO RENW4",66, 0) | |
| 8036 | S PSORENW ("ORX #")= ARR(52,RXN KEY,.01,"I ") | |
| 8037 | "RTN","PSO RENW4",67, 0) | |
| 8038 | S PSORENW ("DRUG IEN ")=ARR(52, RXNKEY,6," I") | |
| 8039 | "RTN","PSO RENW4",68, 0) | |
| 8040 | S PSORENW ("QTY")=AR R(52,RXNKE Y,7,"I") | |
| 8041 | "RTN","PSO RENW4",69, 0) | |
| 8042 | S PSORENW ("INS")=$S ($G(PSOREN W("ENT"))] "":PSORENW ("ENT"),1: ARR(52,RXN KEY,114,"I ")) | |
| 8043 | "RTN","PSO RENW4",70, 0) | |
| 8044 | S:'$G(PSO RENW("ENT" )) PSORENW ("ENT")=0 | |
| 8045 | "RTN","PSO RENW4",71, 0) | |
| 8046 | N I S I=" " F S I=$ O(ARR(52.0 113,I)) Q: 'I D | |
| 8047 | "RTN","PSO RENW4",72, 0) | |
| 8048 | .S PSOREN W("ENT")=P SORENW("EN T")+1,PSOR ENW("DOSE" ,PSORENW(" ENT"))=ARR (52.0113,I ,.01,"I") | |
| 8049 | "RTN","PSO RENW4",73, 0) | |
| 8050 | .S PSOREN W("UNITS", PSORENW("E NT"))=ARR( 52.0113,I, 2,"I") | |
| 8051 | "RTN","PSO RENW4",74, 0) | |
| 8052 | .S PSOREN W("DOSE OR DERED",PSO RENW("ENT" ))=ARR(52. 0113,I,1," I") | |
| 8053 | "RTN","PSO RENW4",75, 0) | |
| 8054 | .S PSOREN W("ROUTE", PSORENW("E NT"))=ARR( 52.0113,I, 6,"I") | |
| 8055 | "RTN","PSO RENW4",76, 0) | |
| 8056 | .S PSOREN W("SCHEDUL E",PSORENW ("ENT"))=A RR(52.0113 ,I,7,"I") | |
| 8057 | "RTN","PSO RENW4",77, 0) | |
| 8058 | .S PSOREN W("DURATIO N",PSORENW ("ENT"))=A RR(52.0113 ,I,4,"I") | |
| 8059 | "RTN","PSO RENW4",78, 0) | |
| 8060 | .S PSOREN W("CONJUNC TION",PSOR ENW("ENT") )=ARR(52.0 113,I,5,"I ") | |
| 8061 | "RTN","PSO RENW4",79, 0) | |
| 8062 | .S PSOREN W("NOUN",P SORENW("EN T"))=ARR(5 2.0113,I,3 ,"I") | |
| 8063 | "RTN","PSO RENW4",80, 0) | |
| 8064 | .S PSOREN W("VERB",P SORENW("EN T"))=ARR(5 2.0113,I,8 ,"I") | |
| 8065 | "RTN","PSO RENW4",81, 0) | |
| 8066 | .I ARR(52 .0113,I,9, "I")]"" S PSORENW("O DOSE",PSOR ENW("ENT") )=ARR(52.0 113,I,9,"I ") | |
| 8067 | "RTN","PSO RENW4",82, 0) | |
| 8068 | I $$GET1^ DIQ(50,+$G (PSORENW(" DRUG IEN") ),17.5)="P SOCLO1" N PSON S PSO N=0 D I P SON K PSON D POZ,KLI B^PSORENW1 D PSOUL^P SSLOCK($P( PSOLST(ORN ),"^",2)) Q | |
| 8069 | "RTN","PSO RENW4",83, 0) | |
| 8070 | .I '$L($$ GET1^DIQ(2 00,PSORENW ("PROVIDER "),53.2)), '$L($$GET1 ^DIQ(200,P SORENW("PR OVIDER"),5 3.3)) D Q | |
| 8071 | "RTN","PSO RENW4",84, 0) | |
| 8072 | ..S PSON= 1 W $C(7), !!,"Only p roviders w ith DEA# o r a VA# ca n write pr escription s for cloz apine.",! | |
| 8073 | "RTN","PSO RENW4",85, 0) | |
| 8074 | .I '$$FIN D1^DIC(200 .051,","_P SORENW("PR OVIDER")_" ,","X","YS CL AUTHORI ZED") D | |
| 8075 | "RTN","PSO RENW4",86, 0) | |
| 8076 | ..S PSON= 1 W $C(7), !!,"Provid er must ho ld YSCL AU THORIZED k ey to writ e prescrip tions for clozapine. ",! | |
| 8077 | "RTN","PSO RENW4",87, 0) | |
| 8078 | I $G(PSOR NW("MAIL/W INDOW"))]" " S PSOREN W("MAIL/WI NDOW")=PSO RNW("MAIL/ WINDOW") | |
| 8079 | "RTN","PSO RENW4",88, 0) | |
| 8080 | I $D(ARR( 52.02)) D K T | |
| 8081 | "RTN","PSO RENW4",89, 0) | |
| 8082 | .S T="" F S T=$O(A RR(52.02,T )) Q:'T S PHI(+T)=A RR(52.02,T ,.01,"I") | |
| 8083 | "RTN","PSO RENW4",90, 0) | |
| 8084 | W !!,"Now Renewing Rx # "_PSO RENW("ORX #")_" Dr ug: "_$$GE T1^DIQ(50, +$G(PSOREN W("DRUG IE N")),.01), ! | |
| 8085 | "RTN","PSO RENW4",91, 0) | |
| 8086 | I '$$GET1 ^DIQ(50,+$ G(PSORENW( "DRUG IEN" )),2.1,"I" ) D G:$G( PSORENW("D FLG")) PRO CESSX | |
| 8087 | "RTN","PSO RENW4",92, 0) | |
| 8088 | .I ARR(52 ,RXNKEY,39 .2,"I") S PSODRUG("O I")=ARR(52 ,RXNKEY,39 .2,"I"),PS ODRUG("OIN ")=$$GET1^ DIQ(50.7,A RR(52,RXNK EY,39.2,"I "),.01) Q | |
| 8089 | "RTN","PSO RENW4",93, 0) | |
| 8090 | .W !!,"Ca nnot Renew !! No Pha rmacy Orde rable Item !" S VALMS G="Cannot Renew!! N o Pharmacy Orderable Item!",PS ORX("DFLG" )=1 | |
| 8091 | "RTN","PSO RENW4",94, 0) | |
| 8092 | D POZ | |
| 8093 | "RTN","PSO RENW4",95, 0) | |
| 8094 | D CHECK^P SORENW0 G: PSORENW("D FLG") PROC ESSX | |
| 8095 | "RTN","PSO RENW4",96, 0) | |
| 8096 | D FILDATE ^PSORENW0 | |
| 8097 | "RTN","PSO RENW4",97, 0) | |
| 8098 | D DRUG^PS ORENW0 G:P SORENW("DF LG") PROCE SSX | |
| 8099 | "RTN","PSO RENW4",98, 0) | |
| 8100 | D RXN^PSO RENW0 G:PS ORENW("DFL G") PROCES SX | |
| 8101 | "RTN","PSO RENW4",99, 0) | |
| 8102 | D STOP^PS ORENW1 | |
| 8103 | "RTN","PSO RENW4",100 ,0) | |
| 8104 | DSPL K PSO EDT,PSOLM, BBFLG,BBRX ,BINGCRT,B INGRTE S P SDY=PSOREN W("DAYS SU PPLY"),PSR F=PSORENW( "# OF REFI LLS") | |
| 8105 | "RTN","PSO RENW4",101 ,0) | |
| 8106 | F DEA=1:1 Q:$E(PSOD RUG("DEA") ,DEA)="" I $E(+PSOD RUG("DEA") ,DEA)>1,$E (+PSODRUG( "DEA"),DEA )<6 S PSOD IR("CS")=1 | |
| 8107 | "RTN","PSO RENW4",102 ,0) | |
| 8108 | N MXRFLS | |
| 8109 | "RTN","PSO RENW4",103 ,0) | |
| 8110 | S MXRFLS= $$MAXNUMRF ^PSOUTIL(+ $G(PSODRUG ("IEN")),+ $G(PSORENW ("DAYS SUP PLY")),+AR R(52,RXNKE Y,3,"I"),. CLOZPAT) | |
| 8111 | "RTN","PSO RENW4",104 ,0) | |
| 8112 | I MXRFLS< PSORENW("# OF REFILL S") S PSOR ENW("# OF REFILLS")= MXRFLS | |
| 8113 | "RTN","PSO RENW4",105 ,0) | |
| 8114 | D DSPLY^P SORENW3 G: PSORENW("D FLG") PROC ESSX | |
| 8115 | "RTN","PSO RENW4",106 ,0) | |
| 8116 | D:$$FIND1 ^DIC(200.0 51,","_DUZ _",","X"," PSORPH")!( '$P(PSOPAR ,"^",2)) V ER1^PSOORN E4(.PSOREN W) G:PSORE NW("DFLG") =1 PROCESS X | |
| 8117 | "RTN","PSO RENW4",107 ,0) | |
| 8118 | I $G(PSOQ TY) D QTY^ PSODIR1(.P SORENW) G: PSORENW("D FLG")=1 PR OCESSX | |
| 8119 | "RTN","PSO RENW4",108 ,0) | |
| 8120 | D EN^PSOR N52(.PSORE NW) | |
| 8121 | "RTN","PSO RENW4",109 ,0) | |
| 8122 | D RNPSOSD ^PSOUTIL | |
| 8123 | "RTN","PSO RENW4",110 ,0) | |
| 8124 | D CAN^PSO RENW0,DCOR D^PSONEW2 | |
| 8125 | "RTN","PSO RENW4",111 ,0) | |
| 8126 | S PSORENW ("# OF REF ILLS")=PSR F K PSDY,P SRF,PSODIR ("CS"),DEA ,PSORENW(" ENT") | |
| 8127 | "RTN","PSO RENW4",112 ,0) | |
| 8128 | S BBRN1=$ $FIND1^DIC (52,,"X",P SORENW("NR X #")) I $ $GET1^DIQ( 52,BBRN1,1 1,"I")["W" S BINGCRT ="Y",BINGR TE="W",BBF LG=1,BBRX( 1)=$G(BBRX (1))_BBRN1 _"," | |
| 8129 | "RTN","PSO RENW4",113 ,0) | |
| 8130 | PROCESSX I PSORENW(" DFLG") D | |
| 8131 | "RTN","PSO RENW4",114 ,0) | |
| 8132 | .K PHI,PR C,PSODRUG, SIG,PSORXE D,SIGOK | |
| 8133 | "RTN","PSO RENW4",115 ,0) | |
| 8134 | .K PSOREN W("DOSE"), PSORENW("D URATION"), PSORENW("D RUG IEN"), PSORENW("E NT"),PSORE NW("INS"), PSORENW("N OUN"),PSOR ENW("ROUTE "),PSORENW ("SCHEDULE "),PSORENW ("SIG"),PS ORENW("VER B"),PSOREN W("UNITS") | |
| 8135 | "RTN","PSO RENW4",116 ,0) | |
| 8136 | .I '$G(PO ERR) W !,$ C(7),"Rx N OT RENEWED . RENEWED RX DELETED ",! S POER R("DFLG")= 1 D CLEAN^ PSOVER1,PO Z | |
| 8137 | "RTN","PSO RENW4",117 ,0) | |
| 8138 | K PSORDLO K I PSOREN W("DFLG") S PSORDLOK =1 | |
| 8139 | "RTN","PSO RENW4",118 ,0) | |
| 8140 | D:$G(PSOR ENW("OLD F ILL DATE") )]"" SUSDA TEK^PSOUTI L(.PSORENW ) | |
| 8141 | "RTN","PSO RENW4",119 ,0) | |
| 8142 | K BBRN,BB RN1,PSODRU G,PSORX("P ROVIDER NA ME"),PSORX ("CLINIC") | |
| 8143 | "RTN","PSO RENW4",120 ,0) | |
| 8144 | K PSOEDT, PSOLM S:$G (PSORENW(" FROM"))="" (PSORENW( "DFLG"),PS ORENW("QFL G"))=0 | |
| 8145 | "RTN","PSO RENW4",121 ,0) | |
| 8146 | I $G(PSOR DLOK) D PS OUL^PSSLOC K($P(PSOLS T(ORN),"^" ,2)) | |
| 8147 | "RTN","PSO RENW4",122 ,0) | |
| 8148 | D KLIB^PS ORENW1 | |
| 8149 | "RTN","PSO RENW4",123 ,0) | |
| 8150 | K PSORDLO K | |
| 8151 | "RTN","PSO RENW4",124 ,0) | |
| 8152 | S RXN=$O( ^TMP("PSOR XN",$J,0)) I RXN N Z RXN S ZRXN =RXN D | |
| 8153 | "RTN","PSO RENW4",125 ,0) | |
| 8154 | .S RXN1=^ TMP("PSORX N",$J,RXN) D EN^PSOH LSN1(RXN,$ P(RXN1,"^" ),$P(RXN1, "^",2),"", $P(RXN1,"^ ",3)) | |
| 8155 | "RTN","PSO RENW4",126 ,0) | |
| 8156 | .I $P(^PS RX(RXN,"ST A"),"^")=5 D EN^PSOH LSN1(RXN," SC","ZS",$ P(RXN1,"^" ,4)) | |
| 8157 | "RTN","PSO RENW4",127 ,0) | |
| 8158 | .;saves d rug allerg y order ch ks pso*7*3 90 | |
| 8159 | "RTN","PSO RENW4",128 ,0) | |
| 8160 | .I $D(^TM P("PSODAOC ",$J,"ALLE RGY")) D | |
| 8161 | "RTN","PSO RENW4",129 ,0) | |
| 8162 | ..I $G(PS ORX("DFLG" ))!$G(PSOR ENW("DFLG" )) K ^TMP( "PSODAOC", $J) Q | |
| 8163 | "RTN","PSO RENW4",130 ,0) | |
| 8164 | ..S RXN=Z RXN,PSODAO C="Rx Back door "_$S( $$GET1^DIQ (52,RXN,10 0,"I")=4:" NON-VERIFI ED ",1:"") _"SPEED RE NEW Order Acceptance _OP" | |
| 8165 | "RTN","PSO RENW4",131 ,0) | |
| 8166 | ..S PSOAR ENW=1 D DA OC^PSONEW K PSOARENW | |
| 8167 | "RTN","PSO RENW4",132 ,0) | |
| 8168 | K ZRXN,RX N,RXN1,^TM P("PSORXN" ,$J),^TMP( "PSODAOC", $J) | |
| 8169 | "RTN","PSO RENW4",133 ,0) | |
| 8170 | Q | |
| 8171 | "RTN","PSO RENW4",134 ,0) | |
| 8172 | INIT ; | |
| 8173 | "RTN","PSO RENW4",135 ,0) | |
| 8174 | D ASK Q:P SORENW("DF LG") | |
| 8175 | "RTN","PSO RENW4",136 ,0) | |
| 8176 | D NOORE^P SONEW(.PSO RENW) Q:PS ORENW("DFL G") | |
| 8177 | "RTN","PSO RENW4",137 ,0) | |
| 8178 | Q | |
| 8179 | "RTN","PSO RENW4",138 ,0) | |
| 8180 | ASK ;upfro nt questio ns | |
| 8181 | "RTN","PSO RENW4",139 ,0) | |
| 8182 | W !! D IS SDT^PSODIR 2(.PSORENW ) Q:PSOREN W("DFLG") S PSORENW ("ISSUE DA TE")=PSOID | |
| 8183 | "RTN","PSO RENW4",140 ,0) | |
| 8184 | D FILLDT^ PSODIR2(.P SORENW) K PSONEW("DA YS SUPPLY" ),PSONEW(" # OF REFIL LS") Q:PSO RENW("DFLG ") | |
| 8185 | "RTN","PSO RENW4",141 ,0) | |
| 8186 | S PSORNW( "FILL DATE ")=PSORENW ("FILL DAT E") | |
| 8187 | "RTN","PSO RENW4",142 ,0) | |
| 8188 | D MW^PSOD IR2(.PSORE NW) Q:PSOR ENW("DFLG" ) | |
| 8189 | "RTN","PSO RENW4",143 ,0) | |
| 8190 | D PTSTAT^ PSODIR1(.P SORENW) Q: PSORENW("D FLG") | |
| 8191 | "RTN","PSO RENW4",144 ,0) | |
| 8192 | D DAYS^PS ODIR1(.PSO RENW) Q:PS ORENW("DFL G") | |
| 8193 | "RTN","PSO RENW4",145 ,0) | |
| 8194 | S PSODRUG ("DEA")=0 D REFILL^P SODIR1(.PS ORENW) K P SODRUG("DE A") Q:PSOR ENW("DFLG" ) | |
| 8195 | "RTN","PSO RENW4",146 ,0) | |
| 8196 | K DIR,DIR UT S DIR(0 )="Y",DIR( "B")="No", DIR("A")=" Do you wan t to edit Renewed Rx (s) QTY " D ^DIR I $ D(DIRUT) S PSORENW(" DFLG")=1 K DIR,DIRUT Q | |
| 8197 | "RTN","PSO RENW4",147 ,0) | |
| 8198 | S PSOQTY= Y K DIR,DI RUT,Y | |
| 8199 | "RTN","PSO RENW4",148 ,0) | |
| 8200 | D CLINIC^ PSODIR2(.P SORENW) Q: PSORENW("D FLG") | |
| 8201 | "RTN","PSO RENW4",149 ,0) | |
| 8202 | D PROV^PS ODIR(.PSOR ENW) S:PSO RENW("DFLG ") PSORENW ("DFLG")=0 | |
| 8203 | "RTN","PSO RENW4",150 ,0) | |
| 8204 | Q | |
| 8205 | "RTN","PSO RENW4",151 ,0) | |
| 8206 | ; | |
| 8207 | "RTN","PSO RENW4",152 ,0) | |
| 8208 | POZ ; | |
| 8209 | "RTN","PSO RENW4",153 ,0) | |
| 8210 | K DIR S D IR(0)="E", DIR("A")=" Press Retu rn to Cont inue" D ^D IR K DIR,D IRUT,DTOUT | |
| 8211 | "RTN","PSO RENW4",154 ,0) | |
| 8212 | Q | |
| 8213 | "VER") | |
| 8214 | 8.0^22.2 | |
| 8215 | "^DD",52.5 2,52.52,4, 0) | |
| 8216 | REASON FOR OVERRIDE^ RP52.54'^P S(52.54,^0 ;5^Q | |
| 8217 | "^DD",52.5 2,52.52,4, 3) | |
| 8218 | Enter the reason for the overr ide of thi s prescrip tion. | |
| 8219 | "^DD",52.5 2,52.52,4, 8.5) | |
| 8220 | ^ | |
| 8221 | "^DD",52.5 2,52.52,4, 9) | |
| 8222 | ^ | |
| 8223 | "^DD",52.5 2,52.52,4, 21,0) | |
| 8224 | ^.001^1^1^ 3160701^^^ ^ | |
| 8225 | "^DD",52.5 2,52.52,4, 21,1,0) | |
| 8226 | This field records t he reason as a point er to file #52.54. | |
| 8227 | "^DD",52.5 2,52.52,4, "DT") | |
| 8228 | 3160218 | |
| 8229 | "^DD",52.5 2,52.52,5, 0) | |
| 8230 | COMMENTS^R FIX^^0;6^K :$L(X)>200 !($L(X)<5) !(X?." ") X | |
| 8231 | "^DD",52.5 2,52.52,5, 3) | |
| 8232 | Enter comm ents descr ibing the reason ove rride the lockout. Input must be betwee n 5 and 20 0 characte rs in leng th. | |
| 8233 | "^DD",52.5 2,52.52,5, 9) | |
| 8234 | ^ | |
| 8235 | "^DD",52.5 2,52.52,5, 21,0) | |
| 8236 | ^.001^1^1^ 3160315^^^ ^ | |
| 8237 | "^DD",52.5 2,52.52,5, 21,1,0) | |
| 8238 | This is an y informat ion about why the pr escription was fille d. | |
| 8239 | "^DD",52.5 2,52.52,5, "DT") | |
| 8240 | 2900302 | |
| 8241 | "^DD",52.5 2,52.52,6, 0) | |
| 8242 | SECOND APP ROVING TEA M MEMBER^R P200'^VA(2 00,^1;1^Q | |
| 8243 | "^DD",52.5 2,52.52,6, 3) | |
| 8244 | Enter the name of th e second a pproving t eam member . | |
| 8245 | "^DD",52.5 2,52.52,6, 21,0) | |
| 8246 | ^.001^1^1^ 3160310^^^ | |
| 8247 | "^DD",52.5 2,52.52,6, 21,1,0) | |
| 8248 | This field records t he name as a pointer to file 2 00). | |
| 8249 | "^DD",52.5 2,52.52,6, "DT") | |
| 8250 | 3160516 | |
| 8251 | "^DD",52.5 4,52.54,0) | |
| 8252 | FIELD^^.01 ^1 | |
| 8253 | "^DD",52.5 4,52.54,0, "DT") | |
| 8254 | 3151223 | |
| 8255 | "^DD",52.5 4,52.54,0, "IX","B",5 2.54,.01) | |
| 8256 | ||
| 8257 | "^DD",52.5 4,52.54,0, "NM","CLOZ APINE OVER RIDE REASO NS") | |
| 8258 | ||
| 8259 | "^DD",52.5 4,52.54,0, "PT",52.52 ,4) | |
| 8260 | ||
| 8261 | "^DD",52.5 4,52.54,0, "PT",53.8, 4) | |
| 8262 | ||
| 8263 | "^DD",52.5 4,52.54,0, "VRPK") | |
| 8264 | PSO | |
| 8265 | "^DD",52.5 4,52.54,.0 1,0) | |
| 8266 | OVERRIDE R EASON^RF^^ 0;1^K:$L(X )>100!($L( X)<3)!'(X' ?1P.E) X | |
| 8267 | "^DD",52.5 4,52.54,.0 1,1,0) | |
| 8268 | ^.1 | |
| 8269 | "^DD",52.5 4,52.54,.0 1,1,1,0) | |
| 8270 | 52.54^B | |
| 8271 | "^DD",52.5 4,52.54,.0 1,1,1,1) | |
| 8272 | S ^PS(52.5 4,"B",$E(X ,1,30),DA) ="" | |
| 8273 | "^DD",52.5 4,52.54,.0 1,1,1,2) | |
| 8274 | K ^PS(52.5 4,"B",$E(X ,1,30),DA) | |
| 8275 | "^DD",52.5 4,52.54,.0 1,3) | |
| 8276 | Enter the reason for the overr ide (input should be 3 to 100 characters in length ). | |
| 8277 | "^DD",52.5 4,52.54,.0 1,21,0) | |
| 8278 | ^^1^1^3160 310^ | |
| 8279 | "^DD",52.5 4,52.54,.0 1,21,1,0) | |
| 8280 | This field contains the reason for the C lozapine l ockout ove rride. | |
| 8281 | "^DD",52.5 4,52.54,.0 1,"DT") | |
| 8282 | 3160310 | |
| 8283 | "^DIC",52. 54,52.54,0 ) | |
| 8284 | CLOZAPINE OVERRIDE R EASONS^52. 54 | |
| 8285 | "^DIC",52. 54,52.54,0 ,"GL") | |
| 8286 | ^PS(52.54, | |
| 8287 | "^DIC",52. 54,52.54," %D",0) | |
| 8288 | ^^2^2^3160 310^ | |
| 8289 | "^DIC",52. 54,52.54," %D",1,0) | |
| 8290 | This file contains t he possibl e reasons for overri ding a Clo zapine | |
| 8291 | "^DIC",52. 54,52.54," %D",2,0) | |
| 8292 | prescripti on or orde r lockout. | |
| 8293 | "^DIC",52. 54,"B","CL OZAPINE OV ERRIDE REA SONS",52.5 4) | |
| 8294 | ||
| 8295 | **INSTALL NAME** | |
| 8296 | PSJ*5.0*32 7 | |
| 8297 | "BLD",1003 5,0) | |
| 8298 | PSJ*5.0*32 7^INPATIEN T MEDICATI ONS^0^3171 026^y | |
| 8299 | "BLD",1003 5,1,0) | |
| 8300 | ^^1^1^3161 228^^ | |
| 8301 | "BLD",1003 5,1,1,0) | |
| 8302 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 8303 | "BLD",1003 5,4,0) | |
| 8304 | ^9.64PA^55 ^2 | |
| 8305 | "BLD",1003 5,4,53.8,0 ) | |
| 8306 | 53.8 | |
| 8307 | "BLD",1003 5,4,53.8,2 22) | |
| 8308 | y^y^f^^^^n | |
| 8309 | "BLD",1003 5,4,55,0) | |
| 8310 | 55 | |
| 8311 | "BLD",1003 5,4,55,2,0 ) | |
| 8312 | ^9.641^55. 06^1 | |
| 8313 | "BLD",1003 5,4,55,2,5 5.06,0) | |
| 8314 | UNIT DOSE (sub-file ) | |
| 8315 | "BLD",1003 5,4,55,2,5 5.06,1,0) | |
| 8316 | ^9.6411^30 1^1 | |
| 8317 | "BLD",1003 5,4,55,2,5 5.06,1,301 ,0) | |
| 8318 | CLOZAPINE DOSAGE (MG /DAY) | |
| 8319 | "BLD",1003 5,4,55,222 ) | |
| 8320 | y^y^p^^^^n ^^n | |
| 8321 | "BLD",1003 5,4,55,224 ) | |
| 8322 | ||
| 8323 | "BLD",1003 5,4,"APDD" ,55,55.06) | |
| 8324 | ||
| 8325 | "BLD",1003 5,4,"APDD" ,55,55.06, 301) | |
| 8326 | ||
| 8327 | "BLD",1003 5,4,"B",53 .8,53.8) | |
| 8328 | ||
| 8329 | "BLD",1003 5,4,"B",55 ,55) | |
| 8330 | ||
| 8331 | "BLD",1003 5,6.3) | |
| 8332 | 64 | |
| 8333 | "BLD",1003 5,"ABPKG") | |
| 8334 | n | |
| 8335 | "BLD",1003 5,"INID") | |
| 8336 | ^n | |
| 8337 | "BLD",1003 5,"INIT") | |
| 8338 | ADDMENUS^P SJ327P | |
| 8339 | "BLD",1003 5,"KRN",0) | |
| 8340 | ^9.67PA^77 9.2^20 | |
| 8341 | "BLD",1003 5,"KRN",.4 ,0) | |
| 8342 | .4 | |
| 8343 | "BLD",1003 5,"KRN",.4 01,0) | |
| 8344 | .401 | |
| 8345 | "BLD",1003 5,"KRN",.4 02,0) | |
| 8346 | .402 | |
| 8347 | "BLD",1003 5,"KRN",.4 03,0) | |
| 8348 | .403 | |
| 8349 | "BLD",1003 5,"KRN",.5 ,0) | |
| 8350 | .5 | |
| 8351 | "BLD",1003 5,"KRN",.8 4,0) | |
| 8352 | .84 | |
| 8353 | "BLD",1003 5,"KRN",3. 6,0) | |
| 8354 | 3.6 | |
| 8355 | "BLD",1003 5,"KRN",3. 8,0) | |
| 8356 | 3.8 | |
| 8357 | "BLD",1003 5,"KRN",9. 2,0) | |
| 8358 | 9.2 | |
| 8359 | "BLD",1003 5,"KRN",9. 8,0) | |
| 8360 | 9.8 | |
| 8361 | "BLD",1003 5,"KRN",9. 8,"NM",0) | |
| 8362 | ^9.68A^38^ 31 | |
| 8363 | "BLD",1003 5,"KRN",9. 8,"NM",1,0 ) | |
| 8364 | PSJOE^^0^B 119581461 | |
| 8365 | "BLD",1003 5,"KRN",9. 8,"NM",2,0 ) | |
| 8366 | PSGOE42^^0 ^B14392718 | |
| 8367 | "BLD",1003 5,"KRN",9. 8,"NM",3,0 ) | |
| 8368 | PSJCLOZ^^0 ^B17451297 5 | |
| 8369 | "BLD",1003 5,"KRN",9. 8,"NM",4,0 ) | |
| 8370 | PSGOE7^^0^ B46313440 | |
| 8371 | "BLD",1003 5,"KRN",9. 8,"NM",6,0 ) | |
| 8372 | PSGOE41^^0 ^B11632292 5 | |
| 8373 | "BLD",1003 5,"KRN",9. 8,"NM",7,0 ) | |
| 8374 | PSJRXLAB^^ 0^B3774089 8 | |
| 8375 | "BLD",1003 5,"KRN",9. 8,"NM",8,0 ) | |
| 8376 | PSJCLOLS^^ 0^B1014058 5 | |
| 8377 | "BLD",1003 5,"KRN",9. 8,"NM",9,0 ) | |
| 8378 | PSGOEV^^0^ B96139745 | |
| 8379 | "BLD",1003 5,"KRN",9. 8,"NM",12, 0) | |
| 8380 | PSGOE92^^0 ^B47389177 | |
| 8381 | "BLD",1003 5,"KRN",9. 8,"NM",13, 0) | |
| 8382 | PSGOER^^0^ B90418784 | |
| 8383 | "BLD",1003 5,"KRN",9. 8,"NM",14, 0) | |
| 8384 | PSGOER0^^0 ^B25398399 | |
| 8385 | "BLD",1003 5,"KRN",9. 8,"NM",15, 0) | |
| 8386 | PSGOE8^^0^ B58943110 | |
| 8387 | "BLD",1003 5,"KRN",9. 8,"NM",16, 0) | |
| 8388 | PSGOE81^^0 ^B15265657 7 | |
| 8389 | "BLD",1003 5,"KRN",9. 8,"NM",17, 0) | |
| 8390 | PSGOE82^^0 ^B40327002 | |
| 8391 | "BLD",1003 5,"KRN",9. 8,"NM",18, 0) | |
| 8392 | PSJCOM^^0^ B47680485 | |
| 8393 | "BLD",1003 5,"KRN",9. 8,"NM",19, 0) | |
| 8394 | PSGOT^^0^B 27687479 | |
| 8395 | "BLD",1003 5,"KRN",9. 8,"NM",20, 0) | |
| 8396 | PSJOE1^^0^ B40247164 | |
| 8397 | "BLD",1003 5,"KRN",9. 8,"NM",21, 0) | |
| 8398 | PSGOD^^0^B 37725457 | |
| 8399 | "BLD",1003 5,"KRN",9. 8,"NM",23, 0) | |
| 8400 | PSGPEN^^0^ B58973143 | |
| 8401 | "BLD",1003 5,"KRN",9. 8,"NM",24, 0) | |
| 8402 | PSGNE3^^0^ B96747624 | |
| 8403 | "BLD",1003 5,"KRN",9. 8,"NM",25, 0) | |
| 8404 | PSGOEF^^0^ B149403477 | |
| 8405 | "BLD",1003 5,"KRN",9. 8,"NM",26, 0) | |
| 8406 | PSGON^^0^B 41441741 | |
| 8407 | "BLD",1003 5,"KRN",9. 8,"NM",27, 0) | |
| 8408 | PSGOEE^^0^ B132209675 | |
| 8409 | "BLD",1003 5,"KRN",9. 8,"NM",29, 0) | |
| 8410 | PSGOETO^^0 ^B45746599 | |
| 8411 | "BLD",1003 5,"KRN",9. 8,"NM",30, 0) | |
| 8412 | PSGOE91^^0 ^B16128430 3 | |
| 8413 | "BLD",1003 5,"KRN",9. 8,"NM",31, 0) | |
| 8414 | PSJCOM1^^0 ^B54587887 | |
| 8415 | "BLD",1003 5,"KRN",9. 8,"NM",33, 0) | |
| 8416 | PSJLMUDE^^ 0^B8770453 3 | |
| 8417 | "BLD",1003 5,"KRN",9. 8,"NM",35, 0) | |
| 8418 | PSJLMPRU^^ 0^B2002438 3 | |
| 8419 | "BLD",1003 5,"KRN",9. 8,"NM",36, 0) | |
| 8420 | PSJOEA^^0^ B32154460 | |
| 8421 | "BLD",1003 5,"KRN",9. 8,"NM",37, 0) | |
| 8422 | PSJOEA1^^0 ^B29905654 | |
| 8423 | "BLD",1003 5,"KRN",9. 8,"NM",38, 0) | |
| 8424 | PSJ327P^^0 ^B688619 | |
| 8425 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGNE3", 24) | |
| 8426 | ||
| 8427 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOD",2 1) | |
| 8428 | ||
| 8429 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE41" ,6) | |
| 8430 | ||
| 8431 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE42" ,2) | |
| 8432 | ||
| 8433 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE7", 4) | |
| 8434 | ||
| 8435 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE8", 15) | |
| 8436 | ||
| 8437 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE81" ,16) | |
| 8438 | ||
| 8439 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE82" ,17) | |
| 8440 | ||
| 8441 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE91" ,30) | |
| 8442 | ||
| 8443 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOE92" ,12) | |
| 8444 | ||
| 8445 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOEE", 27) | |
| 8446 | ||
| 8447 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOEF", 25) | |
| 8448 | ||
| 8449 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOER", 13) | |
| 8450 | ||
| 8451 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOER0" ,14) | |
| 8452 | ||
| 8453 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOETO" ,29) | |
| 8454 | ||
| 8455 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOEV", 9) | |
| 8456 | ||
| 8457 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGON",2 6) | |
| 8458 | ||
| 8459 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGOT",1 9) | |
| 8460 | ||
| 8461 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSGPEN", 23) | |
| 8462 | ||
| 8463 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJ327P" ,38) | |
| 8464 | ||
| 8465 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJCLOLS ",8) | |
| 8466 | ||
| 8467 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJCLOZ" ,3) | |
| 8468 | ||
| 8469 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJCOM", 18) | |
| 8470 | ||
| 8471 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJCOM1" ,31) | |
| 8472 | ||
| 8473 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJLMPRU ",35) | |
| 8474 | ||
| 8475 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJLMUDE ",33) | |
| 8476 | ||
| 8477 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJOE",1 ) | |
| 8478 | ||
| 8479 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJOE1", 20) | |
| 8480 | ||
| 8481 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJOEA", 36) | |
| 8482 | ||
| 8483 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJOEA1" ,37) | |
| 8484 | ||
| 8485 | "BLD",1003 5,"KRN",9. 8,"NM","B" ,"PSJRXLAB ",7) | |
| 8486 | ||
| 8487 | "BLD",1003 5,"KRN",19 ,0) | |
| 8488 | 19 | |
| 8489 | "BLD",1003 5,"KRN",19 ,"NM",0) | |
| 8490 | ^9.68A^3^3 | |
| 8491 | "BLD",1003 5,"KRN",19 ,"NM",1,0) | |
| 8492 | PSJL MANAG ER^^0 | |
| 8493 | "BLD",1003 5,"KRN",19 ,"NM",2,0) | |
| 8494 | PSJLAB LIS T^^0 | |
| 8495 | "BLD",1003 5,"KRN",19 ,"NM",3,0) | |
| 8496 | PSJLIST OV ERRIDES^^0 | |
| 8497 | "BLD",1003 5,"KRN",19 ,"NM","B", "PSJL MANA GER",1) | |
| 8498 | ||
| 8499 | "BLD",1003 5,"KRN",19 ,"NM","B", "PSJLAB LI ST",2) | |
| 8500 | ||
| 8501 | "BLD",1003 5,"KRN",19 ,"NM","B", "PSJLIST O VERRIDES", 3) | |
| 8502 | ||
| 8503 | "BLD",1003 5,"KRN",19 .1,0) | |
| 8504 | 19.1 | |
| 8505 | "BLD",1003 5,"KRN",19 .1,"NM",0) | |
| 8506 | ^9.68A^^ | |
| 8507 | "BLD",1003 5,"KRN",10 1,0) | |
| 8508 | 101 | |
| 8509 | "BLD",1003 5,"KRN",40 9.61,0) | |
| 8510 | 409.61 | |
| 8511 | "BLD",1003 5,"KRN",77 1,0) | |
| 8512 | 771 | |
| 8513 | "BLD",1003 5,"KRN",77 9.2,0) | |
| 8514 | 779.2 | |
| 8515 | "BLD",1003 5,"KRN",87 0,0) | |
| 8516 | 870 | |
| 8517 | "BLD",1003 5,"KRN",89 89.51,0) | |
| 8518 | 8989.51 | |
| 8519 | "BLD",1003 5,"KRN",89 89.52,0) | |
| 8520 | 8989.52 | |
| 8521 | "BLD",1003 5,"KRN",89 94,0) | |
| 8522 | 8994 | |
| 8523 | "BLD",1003 5,"KRN","B ",.4,.4) | |
| 8524 | ||
| 8525 | "BLD",1003 5,"KRN","B ",.401,.40 1) | |
| 8526 | ||
| 8527 | "BLD",1003 5,"KRN","B ",.402,.40 2) | |
| 8528 | ||
| 8529 | "BLD",1003 5,"KRN","B ",.403,.40 3) | |
| 8530 | ||
| 8531 | "BLD",1003 5,"KRN","B ",.5,.5) | |
| 8532 | ||
| 8533 | "BLD",1003 5,"KRN","B ",.84,.84) | |
| 8534 | ||
| 8535 | "BLD",1003 5,"KRN","B ",3.6,3.6) | |
| 8536 | ||
| 8537 | "BLD",1003 5,"KRN","B ",3.8,3.8) | |
| 8538 | ||
| 8539 | "BLD",1003 5,"KRN","B ",9.2,9.2) | |
| 8540 | ||
| 8541 | "BLD",1003 5,"KRN","B ",9.8,9.8) | |
| 8542 | ||
| 8543 | "BLD",1003 5,"KRN","B ",19,19) | |
| 8544 | ||
| 8545 | "BLD",1003 5,"KRN","B ",19.1,19. 1) | |
| 8546 | ||
| 8547 | "BLD",1003 5,"KRN","B ",101,101) | |
| 8548 | ||
| 8549 | "BLD",1003 5,"KRN","B ",409.61,4 09.61) | |
| 8550 | ||
| 8551 | "BLD",1003 5,"KRN","B ",771,771) | |
| 8552 | ||
| 8553 | "BLD",1003 5,"KRN","B ",779.2,77 9.2) | |
| 8554 | ||
| 8555 | "BLD",1003 5,"KRN","B ",870,870) | |
| 8556 | ||
| 8557 | "BLD",1003 5,"KRN","B ",8989.51, 8989.51) | |
| 8558 | ||
| 8559 | "BLD",1003 5,"KRN","B ",8989.52, 8989.52) | |
| 8560 | ||
| 8561 | "BLD",1003 5,"KRN","B ",8994,899 4) | |
| 8562 | ||
| 8563 | "BLD",1003 5,"QDEF") | |
| 8564 | ^^^^NO^^^^ YES^^NO | |
| 8565 | "BLD",1003 5,"QUES",0 ) | |
| 8566 | ^9.62^^ | |
| 8567 | "BLD",1003 5,"REQB",0 ) | |
| 8568 | ^9.611^7^7 | |
| 8569 | "BLD",1003 5,"REQB",1 ,0) | |
| 8570 | PSJ*5.0*25 4^2 | |
| 8571 | "BLD",1003 5,"REQB",2 ,0) | |
| 8572 | PSJ*5.0*54 ^2 | |
| 8573 | "BLD",1003 5,"REQB",3 ,0) | |
| 8574 | PSJ*5.0*27 5^2 | |
| 8575 | "BLD",1003 5,"REQB",4 ,0) | |
| 8576 | PSJ*5.0*28 1^2 | |
| 8577 | "BLD",1003 5,"REQB",5 ,0) | |
| 8578 | PSJ*5.0*31 5^2 | |
| 8579 | "BLD",1003 5,"REQB",6 ,0) | |
| 8580 | PSJ*5.0*31 7^2 | |
| 8581 | "BLD",1003 5,"REQB",7 ,0) | |
| 8582 | PSJ*5.0*33 4^2 | |
| 8583 | "BLD",1003 5,"REQB"," B","PSJ*5. 0*254",1) | |
| 8584 | ||
| 8585 | "BLD",1003 5,"REQB"," B","PSJ*5. 0*275",3) | |
| 8586 | ||
| 8587 | "BLD",1003 5,"REQB"," B","PSJ*5. 0*281",4) | |
| 8588 | ||
| 8589 | "BLD",1003 5,"REQB"," B","PSJ*5. 0*315",5) | |
| 8590 | ||
| 8591 | "BLD",1003 5,"REQB"," B","PSJ*5. 0*317",6) | |
| 8592 | ||
| 8593 | "BLD",1003 5,"REQB"," B","PSJ*5. 0*334",7) | |
| 8594 | ||
| 8595 | "BLD",1003 5,"REQB"," B","PSJ*5. 0*54",2) | |
| 8596 | ||
| 8597 | "FIA",53.8 ) | |
| 8598 | CLOZAPINE MEDICATION OVERRIDES | |
| 8599 | "FIA",53.8 ,0) | |
| 8600 | ^PS(53.8, | |
| 8601 | "FIA",53.8 ,0,0) | |
| 8602 | 53.8D | |
| 8603 | "FIA",53.8 ,0,1) | |
| 8604 | y^y^f^^^^n | |
| 8605 | "FIA",53.8 ,0,10) | |
| 8606 | ||
| 8607 | "FIA",53.8 ,0,11) | |
| 8608 | ||
| 8609 | "FIA",53.8 ,0,"RLRO") | |
| 8610 | ||
| 8611 | "FIA",53.8 ,0,"VR") | |
| 8612 | 5.0^PSJ | |
| 8613 | "FIA",53.8 ,53.8) | |
| 8614 | 0 | |
| 8615 | "FIA",55) | |
| 8616 | PHARMACY P ATIENT | |
| 8617 | "FIA",55,0 ) | |
| 8618 | ^PS(55, | |
| 8619 | "FIA",55,0 ,0) | |
| 8620 | 55P | |
| 8621 | "FIA",55,0 ,1) | |
| 8622 | y^y^p^^^^n ^^n | |
| 8623 | "FIA",55,0 ,10) | |
| 8624 | ||
| 8625 | "FIA",55,0 ,11) | |
| 8626 | ||
| 8627 | "FIA",55,0 ,"RLRO") | |
| 8628 | ||
| 8629 | "FIA",55,0 ,"VR") | |
| 8630 | 5.0^PSJ | |
| 8631 | "FIA",55,5 5) | |
| 8632 | 1 | |
| 8633 | "FIA",55,5 5.06) | |
| 8634 | 1 | |
| 8635 | "FIA",55,5 5.06,301) | |
| 8636 | ||
| 8637 | "INIT") | |
| 8638 | ADDMENUS^P SJ327P | |
| 8639 | "KRN",19,2 921817,-1) | |
| 8640 | 0^2 | |
| 8641 | "KRN",19,2 921817,0) | |
| 8642 | PSJLAB LIS T^Display Inpatient Lab Tests and Result s^^R^^^^^^ ^^INPATIEN T MEDICATI ONS | |
| 8643 | "KRN",19,2 921817,1,0 ) | |
| 8644 | ^19.06^3^3 ^3160329^^ | |
| 8645 | "KRN",19,2 921817,1,1 ,0) | |
| 8646 | This optio n displays results o f lab test s for pati ents recei ving cloza pine | |
| 8647 | "KRN",19,2 921817,1,2 ,0) | |
| 8648 | as require d by the c ircular re garding pa tient mana gement pro tocol for the | |
| 8649 | "KRN",19,2 921817,1,3 ,0) | |
| 8650 | use of clo zapine. Th is is for inpatient pharmacy. | |
| 8651 | "KRN",19,2 921817,25) | |
| 8652 | PSJRXLAB | |
| 8653 | "KRN",19,2 921817,"U" ) | |
| 8654 | DISPLAY IN PATIENT LA B TESTS AN | |
| 8655 | "KRN",19,2 921818,-1) | |
| 8656 | 0^3 | |
| 8657 | "KRN",19,2 921818,0) | |
| 8658 | PSJLIST OV ERRIDES^Li st Inpatie nt Clozapi ne Overrid es^^R^^^^^ ^^^INPATIE NT MEDICAT IONS | |
| 8659 | "KRN",19,2 921818,1,0 ) | |
| 8660 | ^^2^2^3160 407^ | |
| 8661 | "KRN",19,2 921818,1,1 ,0) | |
| 8662 | This gener ates a lis t of inpat ient order ed clozapi ne prescri ptions ent ered | |
| 8663 | "KRN",19,2 921818,1,2 ,0) | |
| 8664 | by overrid ing the lo ckout. | |
| 8665 | "KRN",19,2 921818,25) | |
| 8666 | PSJCLOLS | |
| 8667 | "KRN",19,2 921818,"U" ) | |
| 8668 | LIST INPAT IENT CLOZA PINE OVERR | |
| 8669 | "KRN",19,2 921819,-1) | |
| 8670 | 0^1 | |
| 8671 | "KRN",19,2 921819,0) | |
| 8672 | PSJL MANAG ER^Clozapi ne Inpatie nt Medicat ions Manag er^^M^^PSO LOCKCLOZ^^ ^^^^INPATI ENT MEDICA TIONS | |
| 8673 | "KRN",19,2 921819,1,0 ) | |
| 8674 | ^19.06^1^1 ^3160620^^ ^^ | |
| 8675 | "KRN",19,2 921819,1,1 ,0) | |
| 8676 | This menu contains o ptions use d to contr ol inpatie nt Clozapi ne dispens ing. | |
| 8677 | "KRN",19,2 921819,10, 0) | |
| 8678 | ^19.01IP^7 ^6 | |
| 8679 | "KRN",19,2 921819,10, 3,0) | |
| 8680 | 2921818^^3 | |
| 8681 | "KRN",19,2 921819,10, 3,"^") | |
| 8682 | PSJLIST OV ERRIDES | |
| 8683 | "KRN",19,2 921819,10, 5,0) | |
| 8684 | 2921817^^2 | |
| 8685 | "KRN",19,2 921819,10, 5,"^") | |
| 8686 | PSJLAB LIS T | |
| 8687 | "KRN",19,2 921819,99) | |
| 8688 | 64559,5829 6 | |
| 8689 | "KRN",19,2 921819,"U" ) | |
| 8690 | CLOZAPINE INPATIENT MEDICATION | |
| 8691 | "MBREQ") | |
| 8692 | 0 | |
| 8693 | "ORD",18,1 9) | |
| 8694 | 19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA | |
| 8695 | "ORD",18,1 9,0) | |
| 8696 | OPTION | |
| 8697 | "PKG",221, -1) | |
| 8698 | 1^1 | |
| 8699 | "PKG",221, 0) | |
| 8700 | INPATIENT MEDICATION S^PSJ^UNIT DOSE AND IVS | |
| 8701 | "PKG",221, 22,0) | |
| 8702 | ^9.49I^1^1 | |
| 8703 | "PKG",221, 22,1,0) | |
| 8704 | 5.0^297121 5^2981113^ 1 | |
| 8705 | "PKG",221, 22,1,"PAH" ,1,0) | |
| 8706 | 327^317102 6^52073644 9 | |
| 8707 | "PKG",221, 22,1,"PAH" ,1,1,0) | |
| 8708 | ^^1^1^3171 026 | |
| 8709 | "PKG",221, 22,1,"PAH" ,1,1,1,0) | |
| 8710 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 8711 | "QUES","XP F1",0) | |
| 8712 | Y | |
| 8713 | "QUES","XP F1","??") | |
| 8714 | ^D REP^XPD H | |
| 8715 | "QUES","XP F1","A") | |
| 8716 | Shall I wr ite over y our |FLAG| File | |
| 8717 | "QUES","XP F1","B") | |
| 8718 | YES | |
| 8719 | "QUES","XP F1","M") | |
| 8720 | D XPF1^XPD IQ | |
| 8721 | "QUES","XP F2",0) | |
| 8722 | Y | |
| 8723 | "QUES","XP F2","??") | |
| 8724 | ^D DTA^XPD H | |
| 8725 | "QUES","XP F2","A") | |
| 8726 | Want my da ta |FLAG| yours | |
| 8727 | "QUES","XP F2","B") | |
| 8728 | YES | |
| 8729 | "QUES","XP F2","M") | |
| 8730 | D XPF2^XPD IQ | |
| 8731 | "QUES","XP I1",0) | |
| 8732 | YO | |
| 8733 | "QUES","XP I1","??") | |
| 8734 | ^D INHIBIT ^XPDH | |
| 8735 | "QUES","XP I1","A") | |
| 8736 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
| 8737 | "QUES","XP I1","B") | |
| 8738 | NO | |
| 8739 | "QUES","XP I1","M") | |
| 8740 | D XPI1^XPD IQ | |
| 8741 | "QUES","XP M1",0) | |
| 8742 | PO^VA(200, :EM | |
| 8743 | "QUES","XP M1","??") | |
| 8744 | ^D MG^XPDH | |
| 8745 | "QUES","XP M1","A") | |
| 8746 | Enter the Coordinato r for Mail Group '|F LAG|' | |
| 8747 | "QUES","XP M1","B") | |
| 8748 | ||
| 8749 | "QUES","XP M1","M") | |
| 8750 | D XPM1^XPD IQ | |
| 8751 | "QUES","XP O1",0) | |
| 8752 | Y | |
| 8753 | "QUES","XP O1","??") | |
| 8754 | ^D MENU^XP DH | |
| 8755 | "QUES","XP O1","A") | |
| 8756 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
| 8757 | "QUES","XP O1","B") | |
| 8758 | YES | |
| 8759 | "QUES","XP O1","M") | |
| 8760 | D XPO1^XPD IQ | |
| 8761 | "QUES","XP Z1",0) | |
| 8762 | Y | |
| 8763 | "QUES","XP Z1","??") | |
| 8764 | ^D OPT^XPD H | |
| 8765 | "QUES","XP Z1","A") | |
| 8766 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
| 8767 | "QUES","XP Z1","B") | |
| 8768 | NO | |
| 8769 | "QUES","XP Z1","M") | |
| 8770 | D XPZ1^XPD IQ | |
| 8771 | "QUES","XP Z2",0) | |
| 8772 | Y | |
| 8773 | "QUES","XP Z2","??") | |
| 8774 | ^D RTN^XPD H | |
| 8775 | "QUES","XP Z2","A") | |
| 8776 | Want to MO VE routine s to other CPUs | |
| 8777 | "QUES","XP Z2","B") | |
| 8778 | NO | |
| 8779 | "QUES","XP Z2","M") | |
| 8780 | D XPZ2^XPD IQ | |
| 8781 | "RTN") | |
| 8782 | 31 | |
| 8783 | "RTN","PSG NE3") | |
| 8784 | 0^24^B9674 7624 | |
| 8785 | "RTN","PSG NE3",1,0) | |
| 8786 | PSGNE3 ;BI R/CML3,MLM -DETERMINE DEFAULT F OR START & STOP TIME S ;Jul 26, 2017@18:0 4:02 | |
| 8787 | "RTN","PSG NE3",2,0) | |
| 8788 | ;;5.0;INP ATIENT MED ICATIONS ; **4,26,47, 50,63,69,1 05,80,111, 183,193,17 9,275,327* *;16 DEC 9 7;Build 64 | |
| 8789 | "RTN","PSG NE3",3,0) | |
| 8790 | ; | |
| 8791 | "RTN","PSG NE3",4,0) | |
| 8792 | ; Referen ce to ^PS( 51.1 is su pported by DBIA 2177 | |
| 8793 | "RTN","PSG NE3",5,0) | |
| 8794 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191 | |
| 8795 | "RTN","PSG NE3",6,0) | |
| 8796 | ; Referen ce to PSBA PIPM is su pported by DBIA 3564 | |
| 8797 | "RTN","PSG NE3",7,0) | |
| 8798 | ; | |
| 8799 | "RTN","PSG NE3",8,0) | |
| 8800 | N X1,X2,Y | |
| 8801 | "RTN","PSG NE3",9,0) | |
| 8802 | NOW ; | |
| 8803 | "RTN","PSG NE3",10,0) | |
| 8804 | S:'$D(PSG ST) PSGST= "" | |
| 8805 | "RTN","PSG NE3",11,0) | |
| 8806 | S PSGDT=$ $DATE^PSJU TL2(),PSGN ESD=$$ENSD ($S(PSGST[ "P":"PRN", 1:PSGSCH), PSGS0Y,PSG DT,PSGDT) | |
| 8807 | "RTN","PSG NE3",12,0) | |
| 8808 | ; | |
| 8809 | "RTN","PSG NE3",13,0) | |
| 8810 | STOP ; exi t when sta rt date fo und | |
| 8811 | "RTN","PSG NE3",14,0) | |
| 8812 | K ET,F,FT ,LT,NT,PSG NE3,TT G:$ D(PSGOES)! $D(PSGODF) SF S PSGN ESDO=$$END D^PSGMI(PS GNESD) | |
| 8813 | "RTN","PSG NE3",15,0) | |
| 8814 | Q | |
| 8815 | "RTN","PSG NE3",16,0) | |
| 8816 | ; | |
| 8817 | "RTN","PSG NE3",17,0) | |
| 8818 | ENFD(PSGDT ) ; find d efault sto p date | |
| 8819 | "RTN","PSG NE3",18,0) | |
| 8820 | N X1,X2,X 3DMIN,Y | |
| 8821 | "RTN","PSG NE3",19,0) | |
| 8822 | SF I '$O(^ PS(55,PSGP ,5,"AUS",P SGDT)),'$D (^PS(53.1, "AC",PSGP) ),+$G(^PS( 55,PSGP,5. 1)) S $P(^ PS(55,PSGP ,5.1),U)=" " | |
| 8823 | "RTN","PSG NE3",20,0) | |
| 8824 | S PSJSYSW 0=$G(PSJSY SW0) ; Ini tialize/re store PSJS YSW0 ward parameters ; clinic o rders may not have t hem. Kille d at exit in ENKV^PS GSETU | |
| 8825 | "RTN","PSG NE3",21,0) | |
| 8826 | I $G(PSGO EA)="R",$P (PSJSYSW0, "^",4) D E NWALL(%,0, PSGP) | |
| 8827 | "RTN","PSG NE3",22,0) | |
| 8828 | S PSGNEFD ="",PSGNEW =$S('$P(PS JSYSW0,U,4 ):0,+$G(^P S(55,PSGP, 5.1))'>PSG DT:0,1:+$G (^PS(55,PS GP,5.1))) S:PSGNEW<P SGNESD PSG NEW=0 | |
| 8829 | "RTN","PSG NE3",23,0) | |
| 8830 | I PSGNEW, ($G(PSGOEA )="R") S X 1=$P(%,"." ),X2=3 D C ^%DTC S PS GNEW=$S($P (X,".")_(P SGNESD#1)' >PSGNEW:PS GNEW,1:0) | |
| 8831 | "RTN","PSG NE3",24,0) | |
| 8832 | I PSGST=" O" S PSGNE FD=$$ENOSD ^PSJDCU(PS JSYSW0,PSG NESD,PSGP) I PSGNEFD ]"" G OUT | |
| 8833 | "RTN","PSG NE3",25,0) | |
| 8834 | ;PSJ*179; x-ref to " APPSJ" | |
| 8835 | "RTN","PSG NE3",26,0) | |
| 8836 | I PSGST'= "O",PSGSCH ]"",$S(PSG SCH="ONCE" :1,PSGSCH= "STAT":1,P SGSCH="ONE TIME":1,1 :0)!($P($G (^PS(51.1, +$O(^PS(51 .1,"AC","P SJ",PSGSCH ,0)),0))," ^",5)="O") S PSGNEFD =$$ENOSD^P SJDCU(PSJS YSW0,PSGNE SD,PSGP) I PSGNEFD]" " G OUT | |
| 8837 | "RTN","PSG NE3",27,0) | |
| 8838 | S X1=$P(P SGNESD,"." ),X2=$S($P (PSJSYSW0, "^",3):+$P (PSJSYSW0, "^",3),1:1 4) | |
| 8839 | "RTN","PSG NE3",28,0) | |
| 8840 | D | |
| 8841 | "RTN","PSG NE3",29,0) | |
| 8842 | . ; *** p si 06 082 - RDC 08/2 006;ADDED VAR AA TO CHK FOR AP PT and CLI NIC *** | |
| 8843 | "RTN","PSG NE3",30,0) | |
| 8844 | . N A,AA, B | |
| 8845 | "RTN","PSG NE3",31,0) | |
| 8846 | . Q:'$D(P SGORD) S A="" | |
| 8847 | "RTN","PSG NE3",32,0) | |
| 8848 | . I PSGOR D["P" S A= $G(^PS(53. 1,+PSGORD, "DSS")) | |
| 8849 | "RTN","PSG NE3",33,0) | |
| 8850 | . I PSGOR D["U" S A= $G(^PS(55, PSGP,5,+PS GORD,8)) | |
| 8851 | "RTN","PSG NE3",34,0) | |
| 8852 | . I PSGOR D["I" S A= $G(^PS(55, PSGP,"IV", +PSGORD,"D SS")) | |
| 8853 | "RTN","PSG NE3",35,0) | |
| 8854 | . ;PSJ*5* 179;Clin D ef Stop | |
| 8855 | "RTN","PSG NE3",36,0) | |
| 8856 | . S AA=$P (A,"^",2), A=$P(A,"^" ) I A,AA S X2=14 I $ D(^PS(53.4 6,"B",A)) S B=$O(^PS (53.46,"B" ,A,"")),X2 =$P(^PS(53 .46,B,0)," ^",2) I X2 ="" S X2=1 4 | |
| 8857 | "RTN","PSG NE3",37,0) | |
| 8858 | D | |
| 8859 | "RTN","PSG NE3",38,0) | |
| 8860 | .N PSGDRG ,X1 I '$D( PSJXX1) S PSGDRG=$O( PSJXDOX("D D","")) I PSGDRG | |
| 8861 | "RTN","PSG NE3",39,0) | |
| 8862 | .E N ORI FN S ORIFN =+$P($G(PS JXX1),U,21 ) D:ORIFN Q:'$G(PSG DRG) | |
| 8863 | "RTN","PSG NE3",40,0) | |
| 8864 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) I PSGPTR D | |
| 8865 | "RTN","PSG NE3",41,0) | |
| 8866 | ...S PSGD RG=$$GET1^ DIQ(100.04 5,PSGPTR_" ,"_ORIFN,1 ,"I") | |
| 8867 | "RTN","PSG NE3",42,0) | |
| 8868 | .Q:$$GET1 ^DIQ(50,+$ G(PSGDRG), 17.5)'="PS OCLO1" | |
| 8869 | "RTN","PSG NE3",43,0) | |
| 8870 | .N DFN S DFN=PSGP | |
| 8871 | "RTN","PSG NE3",44,0) | |
| 8872 | .I '$D(CL OZPAT) D C LOZPAT^PSJ CLOZ | |
| 8873 | "RTN","PSG NE3",45,0) | |
| 8874 | .N PSGANC ,PSGCFLG,P SGOVRD | |
| 8875 | "RTN","PSG NE3",46,0) | |
| 8876 | .S PSGANC =$$CL^YSCL TST2(DFN), PSGCFLG=1 | |
| 8877 | "RTN","PSG NE3",47,0) | |
| 8878 | .S PSGOVR D=$$OVERRI DE^YSCLTST 2(DFN) | |
| 8879 | "RTN","PSG NE3",48,0) | |
| 8880 | .S X2=$S( $G(CLOZPAT )=2:28,$G( CLOZPAT)=1 :14,$G(CLO ZPAT)=0:7, 1:90) | |
| 8881 | "RTN","PSG NE3",49,0) | |
| 8882 | .I $$GET1 ^DIQ(55,DF N,53)?1U6N S X2=4 | |
| 8883 | "RTN","PSG NE3",50,0) | |
| 8884 | .I 'PSGOV RD,'+$P(PS GANC,"^",4 ) S X2=4 | |
| 8885 | "RTN","PSG NE3",51,0) | |
| 8886 | D C^%DTC | |
| 8887 | "RTN","PSG NE3",52,0) | |
| 8888 | I $G(PSGN EDFD) I $S ($P(PSGNED FD,"^")["L ":PSGS0XT! PSGS0Y,1:1 ) D DFD | |
| 8889 | "RTN","PSG NE3",53,0) | |
| 8890 | I $G(PSGO RD),$G(PSG FD) S X3DM IN=$$GETDU R^PSJLIVMD (PSGP,+$G( PSGORD),$S ($G(PSGORD )["P":"P", $G(PSGORD) ["V":"IV", 1:5),1) I X3DMIN]"" D I PSGNE FD]"" G OU T | |
| 8891 | "RTN","PSG NE3",54,0) | |
| 8892 | . S X3DMI N=$$DURMIN ^PSJLIVMD( X3DMIN) I $G(X3DMIN) S PSGNEFD =$$FMADD^X LFDT(PSGNE SD,,,X3DMI N) | |
| 8893 | "RTN","PSG NE3",55,0) | |
| 8894 | S X=+(X_$ S($P(PSJSY SW0,"^",7) :"."_$P(PS JSYSW0,"^" ,7),1:(PSG NESD#1))) | |
| 8895 | "RTN","PSG NE3",56,0) | |
| 8896 | S PSGNEFD =$S('PSGNE FD:X,X<PSG NEFD:X,1:P SGNEFD) | |
| 8897 | "RTN","PSG NE3",57,0) | |
| 8898 | I PSGNEW, (PSGNEW<PS GNEFD),$P( PSJSYSW0,U ,4) D | |
| 8899 | "RTN","PSG NE3",58,0) | |
| 8900 | . I $G(PS GORD),$G(P SGRDTX) I PSGORD=$P( PSGRDTX,U, 4),PSGNEW< PSGRDTX Q ; Reques ted Start is after S top | |
| 8901 | "RTN","PSG NE3",59,0) | |
| 8902 | . S PSGNE FD=PSGNEW | |
| 8903 | "RTN","PSG NE3",60,0) | |
| 8904 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 8905 | "RTN","PSG NE3",61,0) | |
| 8906 | ; | |
| 8907 | "RTN","PSG NE3",62,0) | |
| 8908 | OUT ; | |
| 8909 | "RTN","PSG NE3",63,0) | |
| 8910 | ;*179 Acc ount for d rug changi ng | |
| 8911 | "RTN","PSG NE3",64,0) | |
| 8912 | I $G(PSGP DNX)&('$G( PSBSTR)) S :$G(PSGSDX ) PSGNESD= PSGSDX S:$ G(PSGFDX) PSGNEFD=PS GFDX | |
| 8913 | "RTN","PSG NE3",65,0) | |
| 8914 | I '$D(PSG ODF),'$D(P SGOES) S P SGNEFDO=$$ ENDD^PSGMI (PSGNEFD) | |
| 8915 | "RTN","PSG NE3",66,0) | |
| 8916 | K PSGDL,P SGNEW Q | |
| 8917 | "RTN","PSG NE3",67,0) | |
| 8918 | ; | |
| 8919 | "RTN","PSG NE3",68,0) | |
| 8920 | DFD ; | |
| 8921 | "RTN","PSG NE3",69,0) | |
| 8922 | I $P(PSGN EDFD,"^")[ "D" S X1=$ P(PSGNESD, "."),X2=+P SGNEDFD D C^%DTC S X =+(X_"."_$ S($P(PSJSY SW0,"^",7) :$P(PSJSYS W0,"^",7), 1:$P(PSGNE SD,".",2)) ) | |
| 8923 | "RTN","PSG NE3",70,0) | |
| 8924 | I $P(PSGN EDFD,"^")[ "L" S PSGD L=+PSGNEDF D D EN1^PS GDL | |
| 8925 | "RTN","PSG NE3",71,0) | |
| 8926 | S PSGNEFD =$S(PSGNEW <X&PSGNEW: PSGNEW,1:X ) Q:$P(PSG NEDFD,"^") '["D"!'$P( PSJSYSW0," ^",4)!PSGN EW | |
| 8927 | "RTN","PSG NE3",72,0) | |
| 8928 | Q | |
| 8929 | "RTN","PSG NE3",73,0) | |
| 8930 | ; | |
| 8931 | "RTN","PSG NE3",74,0) | |
| 8932 | ENOR ; | |
| 8933 | "RTN","PSG NE3",75,0) | |
| 8934 | K PSGOES, PSGODF S X =$P($G(^PS (53.1,DA,2 )),"^") | |
| 8935 | "RTN","PSG NE3",76,0) | |
| 8936 | S $P(^PS( 53.1,DA,0) ,"^",7)=$S (X="PRN":" P",X="ONCE ":"O",X="S TAT":"O",X ="ONE TIME ":"O",X="O N CALL":"O C",$P(PSGN EDFD,"^",3 )]"":$P(PS GNEDFD,"^" ,3),1:"C") D PSGNE3 S X=PSGNES D | |
| 8937 | "RTN","PSG NE3",77,0) | |
| 8938 | Q | |
| 8939 | "RTN","PSG NE3",78,0) | |
| 8940 | ; | |
| 8941 | "RTN","PSG NE3",79,0) | |
| 8942 | ENSET0(DFN ) ; Set "0 " node and build xre fs for ent ries found without o ne. | |
| 8943 | "RTN","PSG NE3",80,0) | |
| 8944 | N DA,DIK S ^PS(55,D FN,0)=DFN, DIK="^PS(5 5,",DIK(1) =.01,DA=DF N D EN^DIK | |
| 8945 | "RTN","PSG NE3",81,0) | |
| 8946 | S $P(^PS( 55,DFN,5.1 ),"^",11)= 2 ; Mark a s converte d for POE | |
| 8947 | "RTN","PSG NE3",82,0) | |
| 8948 | Q | |
| 8949 | "RTN","PSG NE3",83,0) | |
| 8950 | ; | |
| 8951 | "RTN","PSG NE3",84,0) | |
| 8952 | ENWALL(SD, FD,DFN) ; Update def ault stop date if ap propriate. | |
| 8953 | "RTN","PSG NE3",85,0) | |
| 8954 | N WALL,NW ALL,X1,X2, X3 | |
| 8955 | "RTN","PSG NE3",86,0) | |
| 8956 | D NOW^%DT C S X3=% | |
| 8957 | "RTN","PSG NE3",87,0) | |
| 8958 | S WALL=+$ G(^PS(55,D FN,5.1)),X 1=$P(SD,". "),X2=3 D C^%DTC I + (X_"."_$P( SD,".",2)) '>+WALL Q | |
| 8959 | "RTN","PSG NE3",88,0) | |
| 8960 | S X1=$P(X 3,"."),X2= $S($P(PSJS YSW0,U,3): +$P(PSJSYS W0,U,3),1: 14) D C^%D TC | |
| 8961 | "RTN","PSG NE3",89,0) | |
| 8962 | S NWALL=X _$S($P(PSJ SYSW0,U,7) :"."_$P(PS JSYSW0,U,7 ),1:SD#1) | |
| 8963 | "RTN","PSG NE3",90,0) | |
| 8964 | S $P(^PS( 55,DFN,5.1 ),U)=+$S(F D>NWALL:FD ,1:NWALL) | |
| 8965 | "RTN","PSG NE3",91,0) | |
| 8966 | Q | |
| 8967 | "RTN","PSG NE3",92,0) | |
| 8968 | ; | |
| 8969 | "RTN","PSG NE3",93,0) | |
| 8970 | ENSD(SCH,A T,LI,OSD) ;Find star t dt/tm | |
| 8971 | "RTN","PSG NE3",94,0) | |
| 8972 | ;SCH=sche dule,AT=ad min times, LI=login d ate/time,O SD=Renewed orders st art | |
| 8973 | "RTN","PSG NE3",95,0) | |
| 8974 | I $G(APPT ),$G(PSGOR D)["P" S X D=$$DATE2^ PSJUTL2($S (($$FMDIFF ^XLFDT(APP T,PSGDT,2) <0):PSGDT, 1:APPT)) Q XD | |
| 8975 | "RTN","PSG NE3",96,0) | |
| 8976 | N X,OSDLI D | |
| 8977 | "RTN","PSG NE3",97,0) | |
| 8978 | .I $L(LI) <13 S X=LI Q | |
| 8979 | "RTN","PSG NE3",98,0) | |
| 8980 | .I $L(LI) =14 S X=$E (LI,13,14) S:X>29 X= $E(LI,1,12 )_5 S:X'>2 9 X=$E(LI, 1,12)_1 Q | |
| 8981 | "RTN","PSG NE3",99,0) | |
| 8982 | .I $L(LI) =13 S X=$E (LI,13)_0 S:X>29 X=$ E(LI,1,12) _5 S:X'>29 X=$E(LI,1 ,12)_1 Q | |
| 8983 | "RTN","PSG NE3",100,0 ) | |
| 8984 | I $G(LI) S:(LI=$G(O SD)) OSDLI =1 | |
| 8985 | "RTN","PSG NE3",101,0 ) | |
| 8986 | S LI=+$FN (X,"",4) I '$P(LI,". ",2) S LI= $$FMADD^XL FDT(LI,-1, 0,0,0)_.24 | |
| 8987 | "RTN","PSG NE3",102,0 ) | |
| 8988 | I $G(OSDL I) S OSD=L I K OSDLI | |
| 8989 | "RTN","PSG NE3",103,0 ) | |
| 8990 | ;BHW;PSJ* 5*179;Re-c alc Start date | |
| 8991 | "RTN","PSG NE3",104,0 ) | |
| 8992 | N PSGBCAD M,PSGBCLDT ,PSGBCLA,P SGBCFR,PSG BTT,PSGBST ,PSGBCSHH, PSGBCLHH,P SGBSAT,PSG BSATN,PSGB NAT,PSGBCL IT,PSGBCTD Y | |
| 8993 | "RTN","PSG NE3",105,0 ) | |
| 8994 | N PSGBCTD D,PSGBCTDA ,PSGDAYC,P SGBDNXT,PS GBCSCD,PSG BCLID | |
| 8995 | "RTN","PSG NE3",106,0 ) | |
| 8996 | S (PSGBST ,PSGBCFR,P SGBCADM)=" " | |
| 8997 | "RTN","PSG NE3",107,0 ) | |
| 8998 | S PSGBCOR D=$S($G(PS GORD):PSGO RD,$G(PSJO RD):PSJORD ,1:$G(PSGO RD)) | |
| 8999 | "RTN","PSG NE3",108,0 ) | |
| 9000 | I PSGBCOR D S:'$P($G (^PS(55,DF N,$S($G(PS GBCORD)["V ":"IV",1:5 ),+PSGBCOR D,0)),"^", 2) PSGBCOR D="" | |
| 9001 | "RTN","PSG NE3",109,0 ) | |
| 9002 | I PSGBCOR D["U" S PS GBCOT=5,PS GBCND=0,PS GBCPO=25 | |
| 9003 | "RTN","PSG NE3",110,0 ) | |
| 9004 | I PSGBCOR D["V" S PS GBCOT="IV" ,PSGBCND=2 ,PSGBCPO=5 | |
| 9005 | "RTN","PSG NE3",111,0 ) | |
| 9006 | I (PSGBCO RD'["U")&( PSGBCORD'[ "V") S PSG BCORD="" | |
| 9007 | "RTN","PSG NE3",112,0 ) | |
| 9008 | I +$G(DFN )&(+PSGBCO RD) S PSGB CPRV=PSGBC ORD D | |
| 9009 | "RTN","PSG NE3",113,0 ) | |
| 9010 | .F S PSG BCADM=$$EN ^PSBAPIPM( DFN,PSGBCP RV) Q:PSGB CADM'="" S PSGBCPRV =$P(^PS(55 ,DFN,PSGBC OT,+PSGBCP RV,PSGBCND ),U,PSGBCP O) Q:(PSGB CPRV="")!( PSGBCPRV[" P") | |
| 9011 | "RTN","PSG NE3",114,0 ) | |
| 9012 | .Q | |
| 9013 | "RTN","PSG NE3",115,0 ) | |
| 9014 | I $L(PSGB CADM) D I PSGBST Q +PSGBST | |
| 9015 | "RTN","PSG NE3",116,0 ) | |
| 9016 | .S PSGBCL ID=$P(LI," .",1),PSGB CLIT=$E($P (LI,".",2) ,1,2) I $L (PSGBCLIT) =1 S PSGBC LIT=PSGBCL IT*10 | |
| 9017 | "RTN","PSG NE3",117,0 ) | |
| 9018 | .S PSGBCS CH=$P(PSGB CADM,U,1), PSGBCSCD=$ P(PSGBCSCH ,".",1),PS GBCLDT=$P( PSGBCADM,U ,2),PSGBCL A=$P(PSGBC ADM,U,3) | |
| 9019 | "RTN","PSG NE3",118,0 ) | |
| 9020 | .I "GR"'[ PSGBCLA Q | |
| 9021 | "RTN","PSG NE3",119,0 ) | |
| 9022 | .S PSGBCF R="" | |
| 9023 | "RTN","PSG NE3",120,0 ) | |
| 9024 | .I PSGBCO RD["U" S P SGBCFR=$P( ^PS(55,DFN ,5,+PSGBCO RD,2),U,6) | |
| 9025 | "RTN","PSG NE3",121,0 ) | |
| 9026 | .I PSGBCO RD["V" S P SGBCFR=$P( ^PS(55,DFN ,"IV",+PSG BCORD,0),U ,15) | |
| 9027 | "RTN","PSG NE3",122,0 ) | |
| 9028 | .;Convert | |
| 9029 | "RTN","PSG NE3",123,0 ) | |
| 9030 | .S PSGBCF R=$S(PSGBC FR="D":144 0,PSGBCFR= "O":0,1:PS GBCFR)*60 | |
| 9031 | "RTN","PSG NE3",124,0 ) | |
| 9032 | .I 'PSGBC FR,'AT Q | |
| 9033 | "RTN","PSG NE3",125,0 ) | |
| 9034 | .S X=PSGB CSCH D H^% DTC S PSGB CSCH=%H*86 400+%T,PSG BCSHH=%H_" ,"_%T | |
| 9035 | "RTN","PSG NE3",126,0 ) | |
| 9036 | .S X=PSGB CLDT D H^% DTC S PSGB CLDT=%H*86 400+%T,PSG BCLHH=%H_" ,"_%T | |
| 9037 | "RTN","PSG NE3",127,0 ) | |
| 9038 | .;Sched A dmin Time | |
| 9039 | "RTN","PSG NE3",128,0 ) | |
| 9040 | .I PSGBCS CH D | |
| 9041 | "RTN","PSG NE3",129,0 ) | |
| 9042 | ..;Check admin time s/freq | |
| 9043 | "RTN","PSG NE3",130,0 ) | |
| 9044 | ..I AT D Q:PSGBST | |
| 9045 | "RTN","PSG NE3",131,0 ) | |
| 9046 | ...S PSGB SAT=$P($P( PSGBCADM," ^",1),".", 2) Q:'PSGB SAT | |
| 9047 | "RTN","PSG NE3",132,0 ) | |
| 9048 | ...I $L(P SGBSAT)=1 S PSGBSAT= PSGBSAT*10 | |
| 9049 | "RTN","PSG NE3",133,0 ) | |
| 9050 | ...I ((PS GBSAT<PSGB CLIT)!(PSG BCSCD<PSGB CLID))&(PS GBCSCD'>PS GBCLID) S PSGBSAT=PS GBCLIT ;& (PSGBCFR<8 6400) | |
| 9051 | "RTN","PSG NE3",134,0 ) | |
| 9052 | ...S PSGB NAT="" | |
| 9053 | "RTN","PSG NE3",135,0 ) | |
| 9054 | ...I ($L( $P(AT,"-", 1))=4)&($L (PSGBSAT)' =4) S PSGB SAT=PSGBSA T_$E("00", 1,4-$L(PSG BSAT)) | |
| 9055 | "RTN","PSG NE3",136,0 ) | |
| 9056 | ...F PSGB SATN=1:1 S PSGBNAT=$ P(AT,"-",P SGBSATN) Q :PSGBNAT=" " I PSGBN AT>PSGBSAT Q | |
| 9057 | "RTN","PSG NE3",137,0 ) | |
| 9058 | ...;If DO W | |
| 9059 | "RTN","PSG NE3",138,0 ) | |
| 9060 | ...I ("SU -MO-TU-WE- TH-FR-SA"[ $P(SCH,"-" ,1)) D Q: PSGBST | |
| 9061 | "RTN","PSG NE3",139,0 ) | |
| 9062 | ....;Get TODAY | |
| 9063 | "RTN","PSG NE3",140,0 ) | |
| 9064 | ....D NOW ^%DTC I '$ L(PSGBNAT) ,PSGBCSCD' <X S X1=X, X2=1 D C^% DTC | |
| 9065 | "RTN","PSG NE3",141,0 ) | |
| 9066 | ....S PSG BCTDD=X D DW^%DTC S PSGBCTDY=$ E(X,1,2) | |
| 9067 | "RTN","PSG NE3",142,0 ) | |
| 9068 | ....K PSG BCTMP F PS GBCTMP="SU :1","MO:2" ,"TU:3","W E:4","TH:5 ","FR:6"," SA:7" S PS GBCTMP($P( PSGBCTMP," :",1))=$P( PSGBCTMP," :",2),PSGB CTMP($P(PS GBCTMP,":" ,2))=$P(PS GBCTMP,":" ,1) | |
| 9069 | "RTN","PSG NE3",143,0 ) | |
| 9070 | ....;DAY of Last Ad min | |
| 9071 | "RTN","PSG NE3",144,0 ) | |
| 9072 | ....S X=P SGBCSCD D DW^%DTC S PSGBCTDA=$ E(X,1,2) I PSGBCSCD< PSGBCTDD S PSGBCTDA= PSGBCTDY | |
| 9073 | "RTN","PSG NE3",145,0 ) | |
| 9074 | ....;Get Next Day i n Sched | |
| 9075 | "RTN","PSG NE3",146,0 ) | |
| 9076 | ....S PSG DAYC=PSGBC TMP(PSGBCT DA),(PSGBD NXT,X)="" | |
| 9077 | "RTN","PSG NE3",147,0 ) | |
| 9078 | ....F X=P SGDAYC:1:7 I SCH[$G( PSGBCTMP(X )) S PSGBD NXT=PSGBCT MP(X) Q | |
| 9079 | "RTN","PSG NE3",148,0 ) | |
| 9080 | ....I '$L (PSGBDNXT) S PSGBDNX T=$P(SCH," -",1) | |
| 9081 | "RTN","PSG NE3",149,0 ) | |
| 9082 | ....;Set new Start Day | |
| 9083 | "RTN","PSG NE3",150,0 ) | |
| 9084 | ....S PSG BCTDY=PSGB CTMP(PSGBC TDY) | |
| 9085 | "RTN","PSG NE3",151,0 ) | |
| 9086 | ....S PSG BDNXT=PSGB CTMP(PSGBD NXT) | |
| 9087 | "RTN","PSG NE3",152,0 ) | |
| 9088 | ....S X2= PSGBDNXT-P SGBCTDY I X2<0 S X2= (7-PSGBCTD Y)+PSGBDNX T | |
| 9089 | "RTN","PSG NE3",153,0 ) | |
| 9090 | ....S X1= PSGBCTDD D C^%DTC ; Add # of d ays | |
| 9091 | "RTN","PSG NE3",154,0 ) | |
| 9092 | ....I +X S PSGBST=X _"."_($S(' $L(PSGBNAT )!(PSGBCLI D'=X):$P(A T,"-",1),1 :PSGBNAT)) | |
| 9093 | "RTN","PSG NE3",155,0 ) | |
| 9094 | ....Q | |
| 9095 | "RTN","PSG NE3",156,0 ) | |
| 9096 | ...;IF no Next Admi n | |
| 9097 | "RTN","PSG NE3",157,0 ) | |
| 9098 | ...I (('P SGBNAT)&(P SGBCFR))!( (PSGBCFR>8 6399)&(PSG BCSCD<PSGB CLID)) S X 1=$S(PSGBC FR<86400:P SGBCLID,1: PSGBCSCD), X2=$S(PSGB CFR<86400: 1,1:PSGBCF R/60/60/24 ) D C^%DTC S PSGBST= +X_"."_($S (PSGBNAT:P SGBNAT,1:$ P(AT,"-",1 ))) Q | |
| 9099 | "RTN","PSG NE3",158,0 ) | |
| 9100 | ...S PSGB ST=PSGBCSC D_"."_PSGB NAT | |
| 9101 | "RTN","PSG NE3",159,0 ) | |
| 9102 | ...Q | |
| 9103 | "RTN","PSG NE3",160,0 ) | |
| 9104 | ..I 'PSGB CFR Q | |
| 9105 | "RTN","PSG NE3",161,0 ) | |
| 9106 | ..;Add Fr eq | |
| 9107 | "RTN","PSG NE3",162,0 ) | |
| 9108 | ..S PSGBS T=PSGBCSCH +PSGBCFR,P SGBST=(PSG BST\86400) _","_(PSGB ST#86400) | |
| 9109 | "RTN","PSG NE3",163,0 ) | |
| 9110 | ..I $P(PS GBST,",",2 )<3600 S $ P(PSGBST," ,",2)=3600 | |
| 9111 | "RTN","PSG NE3",164,0 ) | |
| 9112 | ..;If nex t day | |
| 9113 | "RTN","PSG NE3",165,0 ) | |
| 9114 | ..I $P(PS GBST,",",2 )<3600 S % H=$S(+PSGB ST=+PSGBCS HH:+PSGBST ,1:PSGBST- 1)_",86400 " | |
| 9115 | "RTN","PSG NE3",166,0 ) | |
| 9116 | ..S %H=PS GBST D YMD ^%DTC S PS GBST=X_(+$ E(%,1,5)) | |
| 9117 | "RTN","PSG NE3",167,0 ) | |
| 9118 | ..I PSGBS T<LI S PSG BST="" Q | |
| 9119 | "RTN","PSG NE3",168,0 ) | |
| 9120 | ..;If the date/time is > than the First admin | |
| 9121 | "RTN","PSG NE3",169,0 ) | |
| 9122 | ..I AT,($ P(PSGBST," .",1)>PSGB CLID) D | |
| 9123 | "RTN","PSG NE3",170,0 ) | |
| 9124 | ...S PSGB SAT=$P(PSG BST,".",2) I $L(PSGB SAT)=1 S P SGBSAT=PSG BSAT*10 | |
| 9125 | "RTN","PSG NE3",171,0 ) | |
| 9126 | ...S PSGB SATN=$P(AT ,"-",1) ; First admi n TIME | |
| 9127 | "RTN","PSG NE3",172,0 ) | |
| 9128 | ...I PSGB SAT>PSGBSA TN S PSGBS T=$P(PSGBS T,".",1)_" ."_PSGBSAT N | |
| 9129 | "RTN","PSG NE3",173,0 ) | |
| 9130 | ...Q | |
| 9131 | "RTN","PSG NE3",174,0 ) | |
| 9132 | ..Q | |
| 9133 | "RTN","PSG NE3",175,0 ) | |
| 9134 | .;Future Date? | |
| 9135 | "RTN","PSG NE3",176,0 ) | |
| 9136 | .I (PSGBS T)&((PSGBS T<LI)!(($P (PSGBCADM, "^",1)+.00 01)>PSGBST )) D | |
| 9137 | "RTN","PSG NE3",177,0 ) | |
| 9138 | ..S INFO= ($S(($P(PS GBCADM,"^" ,1)+.0001> PSGBST):$P (PSGBCADM, "^",1)+.00 01,1:$G(LI )))_U_($G( PSGFD))_U_ ($G(PSGSCH ))_U_($G(P SGST))_U_( $G(PSGPDRG ))_U_($G(P SGS0Y)) | |
| 9139 | "RTN","PSG NE3",178,0 ) | |
| 9140 | ..S PSGBS T=$$ENQ^PS JORP2(PSGP ,INFO) | |
| 9141 | "RTN","PSG NE3",179,0 ) | |
| 9142 | ..I PSGBS T<LI S PSG BST="" Q | |
| 9143 | "RTN","PSG NE3",180,0 ) | |
| 9144 | ..Q | |
| 9145 | "RTN","PSG NE3",181,0 ) | |
| 9146 | .;No Sche d time | |
| 9147 | "RTN","PSG NE3",182,0 ) | |
| 9148 | .I PSGBCL DT,PSGBCFR ,'PSGBCSCH D Q | |
| 9149 | "RTN","PSG NE3",183,0 ) | |
| 9150 | ..;Add Fr eq | |
| 9151 | "RTN","PSG NE3",184,0 ) | |
| 9152 | ..S PSGBS T=PSGBCLDT +PSGBCFR,P SGBST=(PSG BST\86400) _","_(PSGB ST#86400) | |
| 9153 | "RTN","PSG NE3",185,0 ) | |
| 9154 | ..I $P(PS GBST,",",2 )<3600 S $ P(PSGBST," ,",2)=3600 | |
| 9155 | "RTN","PSG NE3",186,0 ) | |
| 9156 | ..I $P(PS GBST,",",2 )#3600 S P SGBTT=$P(( $P(PSGBST, ",",2)/360 0)+1,".",1 )*3600,$P( PSGBST,"," ,2)=PSGBTT | |
| 9157 | "RTN","PSG NE3",187,0 ) | |
| 9158 | ..;If nex t day | |
| 9159 | "RTN","PSG NE3",188,0 ) | |
| 9160 | ..I $P(PS GBST,",",2 )<3600 S % H=$S(+PSGB ST=+PSGBCL HH:+PSGBST ,1:PSGBST- 1)_",86400 " | |
| 9161 | "RTN","PSG NE3",189,0 ) | |
| 9162 | ..S %H=PS GBST D YMD ^%DTC S PS GBST=X_(+$ E(%,1,3)) | |
| 9163 | "RTN","PSG NE3",190,0 ) | |
| 9164 | ..I PSGBS T<LI S PSG BST="" Q | |
| 9165 | "RTN","PSG NE3",191,0 ) | |
| 9166 | ..Q | |
| 9167 | "RTN","PSG NE3",192,0 ) | |
| 9168 | ;BHW;PSJ* 5*179;END | |
| 9169 | "RTN","PSG NE3",193,0 ) | |
| 9170 | I $G(PSJS YSW0)=""!( $P(PSJSYSW 0,U,5)=2) Q LI | |
| 9171 | "RTN","PSG NE3",194,0 ) | |
| 9172 | S:SCH["PR N" AT="" | |
| 9173 | "RTN","PSG NE3",195,0 ) | |
| 9174 | N INT,PSG S:(SCH'[" PRN"&(SCH' ?1"Q".N1"H ")&(LI'=OS D)&('AT)&( $G(PSGST)' ="O")) AT= $E(OSD,9,1 0) S OSD=$ E(OSD,1,10 ) | |
| 9175 | "RTN","PSG NE3",196,0 ) | |
| 9176 | S INT=$S( SCH="QD":2 4,SCH="QOD ":48,SCH=" QH":1,SCH? 1"Q".N1"D" :(+$P(SCH, "Q",2)*24) ,SCH?1"Q". N1"H":+$P( SCH,"Q",2) ,LI=OSD:24 ,1:24) | |
| 9177 | "RTN","PSG NE3",197,0 ) | |
| 9178 | S:INT=24 OSD=$$FMAD D^XLFDT(LI ,0,-INT,0, 0) | |
| 9179 | "RTN","PSG NE3",198,0 ) | |
| 9180 | I 'AT,INT >23 S:$P(P SJSYSW0,U, 5)!($E(LI, 11,12)>30) AT=$E($$F MADD^XLFDT (LI,0,1,0, 0),9,10) S :AT="00" A T=24 S:'AT AT=$E(LI, 9,10) | |
| 9181 | "RTN","PSG NE3",199,0 ) | |
| 9182 | I SCH?1"Q ".N1"H",'A T S ND=OSD ,PSG(+ND)= "" S:(INT> 24)&('$G(P SJREN)) IN T=24 S DAY S=INT\24,H RS=(-INT\2 4*24+INT) F S ND=$$ FMADD^XLFD T(ND,DAYS, HRS),PSG(+ ND)="" Q:N D>LI | |
| 9183 | "RTN","PSG NE3",200,0 ) | |
| 9184 | Q:INT=24& '$L(AT,"-" ) $E(LI,1, 8)_AT | |
| 9185 | "RTN","PSG NE3",201,0 ) | |
| 9186 | I '$O(PSG (LI)) S X= $S(OSD>1:O SD,LI>1:LI ,1:$$DATE^ PSJUTL2) D | |
| 9187 | "RTN","PSG NE3",202,0 ) | |
| 9188 | .F S ND= X D Q:ND> LI S:(INT >24)&('$G( PSJREN)) I NT=24 S DA YS=INT\24, HRS=(-INT\ 24*24+INT) S X=$$FMA DD^XLFDT($ S($P(ND,". ",2)=24:$P (ND,".")_" .23",1:ND) ,DAYS,HRS) S:$P(X,". ")'>$P(ND, ".") X=$$F MADD^XLFDT (X,1,0,0,0 ) | |
| 9189 | "RTN","PSG NE3",203,0 ) | |
| 9190 | ..F Y=1:1 S AT1=$P( AT,"-",Y) Q:'AT1 S ND=ND\1_". "_AT1,PSG( +ND)="" | |
| 9191 | "RTN","PSG NE3",204,0 ) | |
| 9192 | Q:$P(PSJS YSW0,U,5) $O(PSG(LI) ) | |
| 9193 | "RTN","PSG NE3",205,0 ) | |
| 9194 | S INT="" F ND=0:0 S ND=$O(PSG (ND)) S X= $$FMDIFF^X LFDT(LI,ND ,2) S:X<0 X=-X Q:INT &(X'<INT) S INT=+X, OND=ND Q:I NT=0 | |
| 9195 | "RTN","PSG NE3",206,0 ) | |
| 9196 | Q $S($G(O ND):OND,1: LI) ;Use login time if OND is null PSJ* 5*193 | |
| 9197 | "RTN","PSG OD") | |
| 9198 | 0^21^B3772 5457 | |
| 9199 | "RTN","PSG OD",1,0) | |
| 9200 | PSGOD ;BIR /CML3-CREA TES NEW OR DER FROM O LD ONE ;Ju l 26, 2017 @18:04:02 | |
| 9201 | "RTN","PSG OD",2,0) | |
| 9202 | ;;5.0;INP ATIENT MED ICATIONS;* *67,58,111 ,133,181,2 86,281,315 ,327**;16 DEC 97;Bui ld 64 | |
| 9203 | "RTN","PSG OD",3,0) | |
| 9204 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 9205 | "RTN","PSG OD",4,0) | |
| 9206 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
| 9207 | "RTN","PSG OD",5,0) | |
| 9208 | ; | |
| 9209 | "RTN","PSG OD",6,0) | |
| 9210 | ;*286 - D o not allo w copied U nit Dose o rders for outpatient s | |
| 9211 | "RTN","PSG OD",7,0) | |
| 9212 | D INP^VAD PT I 'VAIN (4) W !,"Y ou cannot copy Unit Dose order s for this patient!" H 2 Q | |
| 9213 | "RTN","PSG OD",8,0) | |
| 9214 | I $$GET1^ DIQ(55.06, +PSJORD_", "_PSGP,69, "I") D Q | |
| 9215 | "RTN","PSG OD",9,0) | |
| 9216 | .W !,"Thi s order is marked 'N ot To Be G iven' and can't be c opied!" H 2 | |
| 9217 | "RTN","PSG OD",10,0) | |
| 9218 | N PSGDRG D G:$G(AN QX) DONE | |
| 9219 | "RTN","PSG OD",11,0) | |
| 9220 | .N ORIFN S ORIFN=+$ $GET1^DIQ( 55.06,+PSJ ORD_","_PS GP,66) D:O RIFN Q:'$ G(PSGDRG) | |
| 9221 | "RTN","PSG OD",12,0) | |
| 9222 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) I PSGPTR D | |
| 9223 | "RTN","PSG OD",13,0) | |
| 9224 | ...S PSGD RG=$$GET1^ DIQ(100.04 5,PSGPTR_" ,"_ORIFN,1 ,"I") | |
| 9225 | "RTN","PSG OD",14,0) | |
| 9226 | .Q:$$GET1 ^DIQ(50,PS GDRG,17.5) '="PSOCLO1 " ; conti nue just w ith Clozap ine drug | |
| 9227 | "RTN","PSG OD",15,0) | |
| 9228 | .N CLOZNU M,CLOZUID | |
| 9229 | "RTN","PSG OD",16,0) | |
| 9230 | .S CLOZNU M=$$GET1^D IQ(55,DFN, 53) | |
| 9231 | "RTN","PSG OD",17,0) | |
| 9232 | .I CLOZNU M'="" S CL OZUID=$$FI ND1^DIC(60 3.01,,"X", CLOZNUM) | |
| 9233 | "RTN","PSG OD",18,0) | |
| 9234 | .I '$G(CL OZUID) D Q | |
| 9235 | "RTN","PSG OD",19,0) | |
| 9236 | ..W !!,"* ** This pa tient has no clozapi ne registr ation numb er ***" | |
| 9237 | "RTN","PSG OD",20,0) | |
| 9238 | ..W !,"** * and must be reregi stered *** " | |
| 9239 | "RTN","PSG OD",21,0) | |
| 9240 | ..D PAUSE ^VALM1 S A NQX=1 Q | |
| 9241 | "RTN","PSG OD",22,0) | |
| 9242 | .S CLOZPA T=$$GET1^D IQ(603.01, CLOZUID,2, "I"),CLOZP AT=$S(CLOZ PAT="M":2, CLOZPAT="B ":1,CLOZPA T="W":0,1: 90) | |
| 9243 | "RTN","PSG OD",23,0) | |
| 9244 | ; | |
| 9245 | "RTN","PSG OD",24,0) | |
| 9246 | F W !!," Do you wan t to copy this order " S %=2 D YN^DICN Q: % D CH | |
| 9247 | "RTN","PSG OD",25,0) | |
| 9248 | G:%'=1 DO NE | |
| 9249 | "RTN","PSG OD",26,0) | |
| 9250 | ; | |
| 9251 | "RTN","PSG OD",27,0) | |
| 9252 | W !!,"... copying... " N OLDON | |
| 9253 | "RTN","PSG OD",28,0) | |
| 9254 | K PSGORQF | |
| 9255 | "RTN","PSG OD",29,0) | |
| 9256 | N PSGPDRG ,Q | |
| 9257 | "RTN","PSG OD",30,0) | |
| 9258 | S PSGOEPR =$$GET1^DI Q(55,PSGP, 62.02,"I") ,OLDON=PSG ORD,Q="" | |
| 9259 | "RTN","PSG OD",31,0) | |
| 9260 | K PSGODN S F=$S(PSG ORD["P":"^ PS(53.1,"_ +PSGORD_", ",1:"^PS(5 5,"_PSGP_" ,5,"_+PSGO RD_",") F N=0,.2,2,2 .1,6 S PSG ODN(N)=$G( @(F_N_")") ) | |
| 9261 | "RTN","PSG OD",32,0) | |
| 9262 | S PSGPR=$ P(PSGODN(0 ),"^",2),P SGMR=$P(PS GODN(0),"^ ",3),PSGSM =$P(PSGODN (0),"^",5) ,PSGHSM=$P (PSGODN(0) ,"^",6),PS GST=$P(PSG ODN(0),"^" ,7) | |
| 9263 | "RTN","PSG OD",33,0) | |
| 9264 | S PSGPDRG =+PSGODN(. 2),PSGDO=$ P(PSGODN(. 2),"^",2) | |
| 9265 | "RTN","PSG OD",34,0) | |
| 9266 | ;*315 | |
| 9267 | "RTN","PSG OD",35,0) | |
| 9268 | S:$G(PSGO DN(2.1))]" " PSGDUR=+ PSGODN(2.1 ),PSGRMVT= $P(PSGODN( 2.1),U,2), PSGRMV=$P( PSGODN(2.1 ),U,3),PSG RF=$P(PSGO DN(2.1),U, 4) | |
| 9269 | "RTN","PSG OD",36,0) | |
| 9270 | S PSGSI=P SGODN(6) | |
| 9271 | "RTN","PSG OD",37,0) | |
| 9272 | ; The nak ed referen ce below r efers to t he full re ference in side indir ection to ^PS(55,PSG P,5,+PSGOR D, or ^PS( 55,PSGP,"I V",+PSGORD , or ^PS(5 3.1,+PSGOR D | |
| 9273 | "RTN","PSG OD",38,0) | |
| 9274 | S PSGODN( 3)=0 F Q=0 :0 S Q=$O( @(F_"3,"_Q _")")) Q:' Q I $D(^( Q,0)) S PS GODN(3,Q)= ^(0),PSGOD N(3)=PSGOD N(3)+1 S ^ PS(53.45,P SJSYSP,1,Q ,0)=^(0) | |
| 9275 | "RTN","PSG OD",39,0) | |
| 9276 | ;S:PSGODN (12)>0 ^PS (53.45,PSJ SYSP,4,0)= "^53.4504" S:PSGODN( 3)>0 ^PS(5 3.45,PSJSY SP,1,0)="^ 53.4501" | |
| 9277 | "RTN","PSG OD",40,0) | |
| 9278 | S:PSGODN( 3)>0 ^PS(5 3.45,PSJSY SP,1,0)="^ 53.4501" | |
| 9279 | "RTN","PSG OD",41,0) | |
| 9280 | ; The nak ed referen ce below r efers to t he full re ference in side indir ection to ^PS(55,PSG P,5,+PSGOR D, or ^PS( 55,PSGP,"I V",+PSGORD , or ^PS(5 3.1,+PSGOR D | |
| 9281 | "RTN","PSG OD",42,0) | |
| 9282 | S (PSGODN (1),Q)=0 F S Q=$O(@ (F_"1,"_Q_ ")")) Q:'Q S ND=$G( ^(Q,0)) I ND,'$P(ND, "^",3) S P SGODN(1)=P SGODN(1)+1 ,PSGODN(1, PSGODN(1)) =$P(ND,"^" ,1,2) S ^P S(53.45,PS JSYSP,2,PS GODN(1),0) =^(0) | |
| 9283 | "RTN","PSG OD",43,0) | |
| 9284 | S PSGS0Y= $P(PSGODN( 2),"^",5), PSGS0XT=$P (PSGODN(2) ,"^",6),PS GNESD="",P SGSCH=$P(P SGODN(2),U ) | |
| 9285 | "RTN","PSG OD",44,0) | |
| 9286 | S PSGODF= 1,PSGNEDFD =$P($$GTNE DFD^PSGOE7 ("U",+PSGP DRG),U)_"^ ^"_PSGST_" ^"_PSGSCH | |
| 9287 | "RTN","PSG OD",45,0) | |
| 9288 | W "." D ^ PSGNE3 | |
| 9289 | "RTN","PSG OD",46,0) | |
| 9290 | K PSGEFN, PSGOEEF,PS GOEE,PSGOE OS S PSGEF N="1:13" F X=1:1:13 S PSGEFN(X )="" | |
| 9291 | "RTN","PSG OD",47,0) | |
| 9292 | S PSGPDN= $$OINAME^P SJLMUTL(PS GPDRG),PSG OINST="",P SGSDN=$$EN DD^PSGMI(P SGNESD)_U_ $$ENDTC^PS GMI(PSGNES D),PSGFDN= $$ENDD^PSG MI(PSGNEFD )_U_$$ENDT C^PSGMI(PS GNEFD) | |
| 9293 | "RTN","PSG OD",48,0) | |
| 9294 | S PSGAT=P SGS0Y,PSGE BN=DUZ,PSG LIN=$$ENDD ^PSGMI(PSG DT)_U_$$EN DTC^PSGMI( PSGDT),PSG EBN=$$ENNP N^PSGMI(DU Z),PSGSTAT =$S(PSGOEA V:"ACTIVE" ,1:"NON-VE RIFIED") | |
| 9295 | "RTN","PSG OD",49,0) | |
| 9296 | I '$G(PSG NEFD) S PS GNEFD=$P(P SGODN(2),U ,4) | |
| 9297 | "RTN","PSG OD",50,0) | |
| 9298 | W "." D C HK^PSGOEV( "^^"_PSGMR _"^^^^"_PS GST,PSGPDR G_U_PSGDO, PSGSCH_U_P SGNESD_"^^ "_PSGNEFD) | |
| 9299 | "RTN","PSG OD",51,0) | |
| 9300 | I $G(PSGS CH)]"" D | |
| 9301 | "RTN","PSG OD",52,0) | |
| 9302 | .N X S X= PSGSCH N S WD,SDW,XAB B,QX D ENO S^PSGS0 I $G(X)=""!$ G(PSJNSS) S CHK=1 K PSJNSS Q | |
| 9303 | "RTN","PSG OD",53,0) | |
| 9304 | .I $G(PSG AT)="",$G( PSGS0Y) S PSGAT=PSGS 0Y | |
| 9305 | "RTN","PSG OD",54,0) | |
| 9306 | .I $G(PSG AT),($G(PS GS0Y)="") S PSGS0Y=P SGAT | |
| 9307 | "RTN","PSG OD",55,0) | |
| 9308 | .I $G(PSG S0XT)="D", $G(PSGS0Y) ="" S CHK= 1 D K PSJ NSS | |
| 9309 | "RTN","PSG OD",56,0) | |
| 9310 | ..W ! K D IR S DIR(0 )="FOA",DI R("A")=" WARNING - Admin tim es are req uired for DAY OF WEE K schedule s " D ^ DIR K DIR | |
| 9311 | "RTN","PSG OD",57,0) | |
| 9312 | S PSGSD=P SGNESD,PSG FD=PSGNEFD | |
| 9313 | "RTN","PSG OD",58,0) | |
| 9314 | K PSJACEP T S VALMBC K="Q" D:$D (Y) EN^VAL M("PSJU LM ACCEPT") | |
| 9315 | "RTN","PSG OD",59,0) | |
| 9316 | I $G(PSJA CEPT)=1 D OC S:$G(PS GORQF) PSJ ACEPT=0 S: $G(PSJACEP T)=1 VALMB CK="",PSJN OO=$$ENNOO ^PSJUTL5(" N") | |
| 9317 | "RTN","PSG OD",60,0) | |
| 9318 | I '$G(PSJ ACEPT)!($G (PSJNOO)<0 ) W:'$G(PS JCOFLG) !! ,"Order no t copied." D PAUSE^V ALM1:'$G(P SJCOFLG) G ORIG ; PSJCOFLG s et in PSOD GAL1 for a llergies | |
| 9319 | "RTN","PSG OD",61,0) | |
| 9320 | S PSGNESD =PSGSD,PSG NEFD=PSGFD | |
| 9321 | "RTN","PSG OD",62,0) | |
| 9322 | K PSGOEE D ^PSGOETO S PSJORD= PSGORD I P SGOEAV D | |
| 9323 | "RTN","PSG OD",63,0) | |
| 9324 | .I '$D(PS GOEE),+PSJ SYSU=3 D E N^PSGPEN(P SGORD) | |
| 9325 | "RTN","PSG OD",64,0) | |
| 9326 | .;; START NCC REMED IATION >> 327*RJS | |
| 9327 | "RTN","PSG OD",65,0) | |
| 9328 | .I +$G(PS GCOPY)!(+$ G(PSGEDT)) D | |
| 9329 | "RTN","PSG OD",66,0) | |
| 9330 | ..I $G(PS GDRG),$$GE T1^DIQ(50, PSGDRG,17. 5)="PSOCLO 1" D | |
| 9331 | "RTN","PSG OD",67,0) | |
| 9332 | ...I $D(^ TMP($J,"PS GCLOZ",DFN ,+$G(PSJOR D),"SAND") ) D K ^T MP($J,"PSG CLOZ",DFN, PSJORD,"SA ND") | |
| 9333 | "RTN","PSG OD",68,0) | |
| 9334 | ....S DIE ="^PS(55," _DFN_",5," ,DA=PSJORD ,DA(1)=DFN ,DR="301// //"_^TMP($ J,"PSGCLOZ ",DFN,PSJO RD,"SAND") D ^DIE | |
| 9335 | "RTN","PSG OD",69,0) | |
| 9336 | ...I $D(P SJXDOX("DD ")) N PSGD N S PSGDN= $O(PSJXDOX ("DD",0)) | |
| 9337 | "RTN","PSG OD",70,0) | |
| 9338 | ...D PSJF ILE^PSJCLO Z(DFN),INP SND^YSCLTS T5 K:$D(^T MP($J,"CLO ZFLG",DFN) ) ^TMP($J, "CLOZFLG", DFN) | |
| 9339 | "RTN","PSG OD",71,0) | |
| 9340 | .;; END N CC REMEDIA TION >> 32 7*RJS | |
| 9341 | "RTN","PSG OD",72,0) | |
| 9342 | .D SETOC^ PSJNEWOC(P SGORD) ;RT C 178789 S tore aller gy if auto vf is on | |
| 9343 | "RTN","PSG OD",73,0) | |
| 9344 | D GETUD^P SJLMGUD(PS GP,PSGORD) ,ENSFE^PSG OEE0(PSGP, PSGORD),^P SGOE1,EN^V ALM("PSJ L M UD ACTIO N") | |
| 9345 | "RTN","PSG OD",74,0) | |
| 9346 | ;RTC 1787 89 - store allery if not verif ied the ne wly copied order | |
| 9347 | "RTN","PSG OD",75,0) | |
| 9348 | I ($G(PSG ORD)["P"), ($$GET1^DI Q(53.1,+PS GORD,28,"I ")="N"),($ G(PSJOCFG) ="COPY UD" ) D SETOC^ PSJNEWOC(P SGORD) | |
| 9349 | "RTN","PSG OD",76,0) | |
| 9350 | ; | |
| 9351 | "RTN","PSG OD",77,0) | |
| 9352 | S PSGCANF L=0,(PSGOR D,PSJORD)= OLDON W !! ,"You are finished w ith the ne w order.", !,"The fol lowing ACT ION prompt is for th e original order." | |
| 9353 | "RTN","PSG OD",78,0) | |
| 9354 | K DIR S D IR(0)="E" D ^DIR K D IR | |
| 9355 | "RTN","PSG OD",79,0) | |
| 9356 | ORIG ;Redi splay orig inal order | |
| 9357 | "RTN","PSG OD",80,0) | |
| 9358 | D GETUD^P SJLMGUD(PS GP,OLDON), INIT^PSJLM UDE(PSGP,O LDON) | |
| 9359 | "RTN","PSG OD",81,0) | |
| 9360 | DONE ; | |
| 9361 | "RTN","PSG OD",82,0) | |
| 9362 | K %,%H,%I ,DA,F,N,PS GODN,PSGOD F,PSGS0XT, PSGS0Y,PSG NESD,PSGTO L,PSGTOO,P SGUOW,X,Y, ^PS(53.45, PSJSYSP,1) ,^PS(53.45 ,PSJSYSP,2 ) | |
| 9363 | "RTN","PSG OD",83,0) | |
| 9364 | K PSGPR,P SGMR,PSGSM ,PSGHSM,PS GST,PSGPDR G,PSGDO,PS GNEDFD,PSG SCH,PSGNEF D | |
| 9365 | "RTN","PSG OD",84,0) | |
| 9366 | Q | |
| 9367 | "RTN","PSG OD",85,0) | |
| 9368 | ; | |
| 9369 | "RTN","PSG OD",86,0) | |
| 9370 | CH ; | |
| 9371 | "RTN","PSG OD",87,0) | |
| 9372 | W !!?2,"A nswer 'YES ' to have a new, non -verified order crea ted for th is patient ,",!,"usin g the info rmation fr om this or der. (The START and STOP date s will be" ,!,"recalc ulated.) Enter 'NO' (or '^') to stop no w." Q | |
| 9373 | "RTN","PSG OD",88,0) | |
| 9374 | ; | |
| 9375 | "RTN","PSG OD",89,0) | |
| 9376 | WH ; | |
| 9377 | "RTN","PSG OD",90,0) | |
| 9378 | W !!?2,"A nswer 'YES ' to take action on this new o rder. Ent er 'NO' (o r '^') to return",!, "to the or iginal ord er now." Q | |
| 9379 | "RTN","PSG OD",91,0) | |
| 9380 | ; | |
| 9381 | "RTN","PSG OD",92,0) | |
| 9382 | OC ;Perfor m order ch ecks | |
| 9383 | "RTN","PSG OD",93,0) | |
| 9384 | NEW PSJDD ,X,PSJALLG Y | |
| 9385 | "RTN","PSG OD",94,0) | |
| 9386 | ;*286 - O rder check s on curre nt dispens e drugs | |
| 9387 | "RTN","PSG OD",95,0) | |
| 9388 | F X=0:0 S X=$O(^PS( 53.45,PSJS YSP,2,X)) Q:'X D | |
| 9389 | "RTN","PSG OD",96,0) | |
| 9390 | . S PSJDD =$G(^PS(53 .45,PSJSYS P,2,X,0)) | |
| 9391 | "RTN","PSG OD",97,0) | |
| 9392 | . I +PSJD D S PSJALL GY(+PSJDD) ="" | |
| 9393 | "RTN","PSG OD",98,0) | |
| 9394 | S PSJDD=+ $O(PSJALLG Y(0)) Q:'P SJDD | |
| 9395 | "RTN","PSG OD",99,0) | |
| 9396 | D FULL^VA LM1 | |
| 9397 | "RTN","PSG OD",100,0) | |
| 9398 | ;; START NCC REMEDI ATION >> 3 27*RJS FOR TOTAL DAI LY DOSE | |
| 9399 | "RTN","PSG OD",101,0) | |
| 9400 | I $$GET1^ DIQ(50,PSJ DD,17.5)=" PSOCLO1" S ANQX=0 D TDD^PSJCLO Z | |
| 9401 | "RTN","PSG OD",102,0) | |
| 9402 | Q:$G(PSGO RQF) | |
| 9403 | "RTN","PSG OD",103,0) | |
| 9404 | ;/RJS Beg in PSJ*5.0 *327 modif ication FO R ORDER CH ECKS | |
| 9405 | "RTN","PSG OD",104,0) | |
| 9406 | S PSJDD=+ $O(PSJALLG Y(0)) Q:'P SJDD | |
| 9407 | "RTN","PSG OD",105,0) | |
| 9408 | D FULL^VA LM1 | |
| 9409 | "RTN","PSG OD",106,0) | |
| 9410 | D ENDDC^P SGSICHK($G (PSGP),PSJ DD) Q:$G(P SGORQF) | |
| 9411 | "RTN","PSG OD",107,0) | |
| 9412 | D IN^PSJO CDS($G(PSG ORD),"UD", PSJDD) Q:$ G(PSGORQF) | |
| 9413 | "RTN","PSG OD",108,0) | |
| 9414 | D ORD^PSJ CLOZ | |
| 9415 | "RTN","PSG OD",109,0) | |
| 9416 | Q | |
| 9417 | "RTN","PSG OE41") | |
| 9418 | 0^6^B11632 2925 | |
| 9419 | "RTN","PSG OE41",1,0) | |
| 9420 | PSGOE41 ;B IR/CML3-RE GULAR ORDE R ENTRY (C ONT.) ;Jul 26, 2017@ 18:04:02 | |
| 9421 | "RTN","PSG OE41",2,0) | |
| 9422 | ;;5.0;INP ATIENT MED ICATIONS;* *50,63,64, 69,58,111, 136,113,26 7,315,334, 327**;16 D EC 97;Buil d 64 | |
| 9423 | "RTN","PSG OE41",3,0) | |
| 9424 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 9425 | "RTN","PSG OE41",4,0) | |
| 9426 | ; Referen ce to ^DIC N is suppo rted by DB IA 10009. | |
| 9427 | "RTN","PSG OE41",5,0) | |
| 9428 | ; Referen ce to %DT is support ed by DBIA 10003. | |
| 9429 | "RTN","PSG OE41",6,0) | |
| 9430 | ; Referen ce to %DTC is suppor ted by DBI A 10000. | |
| 9431 | "RTN","PSG OE41",7,0) | |
| 9432 | ; Referen ce to ^PS( 51.1 is su pported by DBIA 2177 . | |
| 9433 | "RTN","PSG OE41",8,0) | |
| 9434 | ; Referen ce to ^PS( 50.7 is su pported by DBIA# 218 0 | |
| 9435 | "RTN","PSG OE41",9,0) | |
| 9436 | ; | |
| 9437 | "RTN","PSG OE41",10,0 ) | |
| 9438 | 39 ; admin times | |
| 9439 | "RTN","PSG OE41",11,0 ) | |
| 9440 | G:$P(PSGN EDFD,"^",3 )="P"!($P( PSGNEDFD," ^",3)="OC" ) 8 | |
| 9441 | "RTN","PSG OE41",12,0 ) | |
| 9442 | I $$ODD^P SGS0(PSGS0 XT) D PSGD UR G 8 | |
| 9443 | "RTN","PSG OE41",13,0 ) | |
| 9444 | W !,"ADMI N TIMES: " _$S(PSGS0Y :PSGS0Y_"/ / ",1:"") R X:DTIME I X="^"!'$ T W:'$T $C (7) S PSGO ROE1=1,PSG DUR="" G D ONE | |
| 9445 | "RTN","PSG OE41",14,0 ) | |
| 9446 | I X="",PS GS0Y]"" S PSGNOHI=1, X=PSGS0Y ; *315 If ad min time d efault was taken the n don't hi ghlight ad min time. | |
| 9447 | "RTN","PSG OE41",15,0 ) | |
| 9448 | I X="",$G (PSGS0XT)= "D" I $L(P SGSCH,"@") =2,$P(PSGS CH,"@",2) S (PSGAT,P SGS0Y)=$P( PSGSCH,"@" ,2) G 8 | |
| 9449 | "RTN","PSG OE41",16,0 ) | |
| 9450 | I X?1."?" D ENHLP^P SGOEM(53.1 ,39) G 39 | |
| 9451 | "RTN","PSG OE41",17,0 ) | |
| 9452 | I X="@" D DEL G:%'= 1 39 S (PS GFOK(39),P SGS0Y)="" G 39 | |
| 9453 | "RTN","PSG OE41",18,0 ) | |
| 9454 | S PSGF2=3 9 I $E(X)= "^" D FF G :Y>0 @Y G 39 | |
| 9455 | "RTN","PSG OE41",19,0 ) | |
| 9456 | I (PSGS0X T="D")&('$ G(X)!(X["@ "&($P($G(X ),"@",2))) ) I ((",P, R,")'[("," _$G(PSGST) _",")) D G 39 | |
| 9457 | "RTN","PSG OE41",20,0 ) | |
| 9458 | .W $C(7), " ??" S X ="?" W !," This is a 'DAY OF TH E WEEK' sc hedule and MUST have admin tim es." D ENH LP^PSGOEM( 53.1,39) | |
| 9459 | "RTN","PSG OE41",21,0 ) | |
| 9460 | I $G(PSGS 0XT)'="D", $G(PSGS0XT )'="P",$G( PSGS0XT)'= "OC" D TIM ES G:'$D(X ) 39 D PSG DUR G:'$D( X) 39 G:$G (X)="^" DO NE ;*315 | |
| 9461 | "RTN","PSG OE41",22,0 ) | |
| 9462 | I $G(PSGS 0XT)="O",X ="" S (PSG AT,PSGS0Y) =X,PSGFOK( 39)="" G 8 | |
| 9463 | "RTN","PSG OE41",23,0 ) | |
| 9464 | D ENCHK^P SGS0 I '$D (X) W $C(7 )," ??" G 39 | |
| 9465 | "RTN","PSG OE41",24,0 ) | |
| 9466 | S (PSGAT, PSGS0Y)=X, PSGFOK(39) ="" | |
| 9467 | "RTN","PSG OE41",25,0 ) | |
| 9468 | ; | |
| 9469 | "RTN","PSG OE41",26,0 ) | |
| 9470 | 8 ; specia l instruct ions | |
| 9471 | "RTN","PSG OE41",27,0 ) | |
| 9472 | S PSGSI=$ $EDITSI^PS JBCMA5($G( PSGP),$G(P SGORD)) | |
| 9473 | "RTN","PSG OE41",28,0 ) | |
| 9474 | S PSGF2=8 I $E(X)=" ^" D FF G: Y>0 @Y G 8 | |
| 9475 | "RTN","PSG OE41",29,0 ) | |
| 9476 | I X="@",P SGSI="" W $C(7)," ? ?" S X="?" D ENHLP^P SGOEM(53.1 ,8) G 8 | |
| 9477 | "RTN","PSG OE41",30,0 ) | |
| 9478 | I X="@" D DEL G:%'= 1 8 S (PSG FOK(8),PSG SI)="" G:' $G(PSGOE3) 10 | |
| 9479 | "RTN","PSG OE41",31,0 ) | |
| 9480 | I X?1."?" D ENHLP^P SGOEM(53.1 ,8) G 8 | |
| 9481 | "RTN","PSG OE41",32,0 ) | |
| 9482 | S PSGSI=$ S((PSGSI>0 &(PSGSI<3) ):$G(^PS(5 3.45,+PSJS YSP,5,1,0) )_" "_$G(^ PS(53.45,+ PSJSYSP,5, 2,0)),PSGS I>2:"Instr uctions to o long. Se e Order Vi ew or BCMA for full text",1:"" ) | |
| 9483 | "RTN","PSG OE41",33,0 ) | |
| 9484 | S:PSGSI=" " PSGSI=" " I PSGSI] "" S PSGSI =$$ENBCMA^ PSJUTL("U" ),PSGFOK(8 )="" | |
| 9485 | "RTN","PSG OE41",34,0 ) | |
| 9486 | Q:$G(PSGO E3) | |
| 9487 | "RTN","PSG OE41",35,0 ) | |
| 9488 | 10 ; start date/time | |
| 9489 | "RTN","PSG OE41",36,0 ) | |
| 9490 | D ^PSGNE3 | |
| 9491 | "RTN","PSG OE41",37,0 ) | |
| 9492 | S:'$D(PSG NESDO) PSG NESDO=$$EN DD^PSGMI(P SGNESD) S PSGSD=PSGN ESDO | |
| 9493 | "RTN","PSG OE41",38,0 ) | |
| 9494 | A10 W !,"S TART DATE/ TIME: "_PS GSD_"// " R X:DTIME I X="^"!'$ T W:'$T $C (7) S PSGO ROE1=1 G D ONE | |
| 9495 | "RTN","PSG OE41",39,0 ) | |
| 9496 | I X="",PS GNESD W " "_PSGSD G O25 | |
| 9497 | "RTN","PSG OE41",40,0 ) | |
| 9498 | I X="P" D ENPREV^PS GDL W:'$D( X) $C(7) G :'$D(X) A1 0 S PSGNES D=+X,PSGSD =$$ENDD^PS GMI(+X) W " ",PSGSD G O25 | |
| 9499 | "RTN","PSG OE41",41,0 ) | |
| 9500 | S PSGF2=1 0 I X="@"! (X?1."?") W:X="@" $C (7)," (Re quired)" S :X="@" X=" ?" D ENHLP ^PSGOEM(53 .1,10) | |
| 9501 | "RTN","PSG OE41",42,0 ) | |
| 9502 | I $E(X)=" ^" D FF G: Y>0 @Y G A 10 | |
| 9503 | "RTN","PSG OE41",43,0 ) | |
| 9504 | NEW TMPX S TMPX=X,X 1=PSGDT,X2 =-7 D C^%D TC K %DT S %DT="ERTX ",%DT(0)=X ,X=TMPX D ^%DT K %DT I Y'>0 D ENHLP^PSGO EM(53.1,10 ) G A10 | |
| 9505 | "RTN","PSG OE41",44,0 ) | |
| 9506 | S PSGNESD =+Y,PSGSD= $$ENDD^PSG MI(+Y),(PS GNEFD,PSGF D)="" | |
| 9507 | "RTN","PSG OE41",45,0 ) | |
| 9508 | ; | |
| 9509 | "RTN","PSG OE41",46,0 ) | |
| 9510 | O25 ; | |
| 9511 | "RTN","PSG OE41",47,0 ) | |
| 9512 | S PSGFOK( 10)="" I $ P(PSGNEDFD ,"^",3)="O " S PSGNEF D=$$ENOSD^ PSJDCU(PSJ SYSW0,PSGN ESD,PSGP) I PSGNEFD] "" S PSGFD =$$ENDD^PS GMI(PSGNEF D) | |
| 9513 | "RTN","PSG OE41",48,0 ) | |
| 9514 | ; | |
| 9515 | "RTN","PSG OE41",49,0 ) | |
| 9516 | 25 ; stop date | |
| 9517 | "RTN","PSG OE41",50,0 ) | |
| 9518 | Q:$G(PSGO E3) | |
| 9519 | "RTN","PSG OE41",51,0 ) | |
| 9520 | I 'PSGNEF D D ENFD^P SGNE3(PSGD T) S PSGFD =PSGNEFDO | |
| 9521 | "RTN","PSG OE41",52,0 ) | |
| 9522 | ;/RBN-RJS Begin cha nges for e mergency r egistratio n of cloza pine patie nt Set end date to s tart date + 4 days a t midnight . | |
| 9523 | "RTN","PSG OE41",53,0 ) | |
| 9524 | N PSGDRG, PSGCFLG,PS GEMRG,PSGT DTD S PSGD RG=$O(PSJX DOX("DD"," ")) S:'$G( DFN) DFN=$ G(PSGP) | |
| 9525 | "RTN","PSG OE41",54,0 ) | |
| 9526 | I PSGDRG, $$GET1^DIQ (50,PSGDRG ,17.5)="PS OCLO1" D | |
| 9527 | "RTN","PSG OE41",55,0 ) | |
| 9528 | .S PSGCFL G=1,PSGOVR D=$$OVERRI DE^YSCLTST 2(DFN) | |
| 9529 | "RTN","PSG OE41",56,0 ) | |
| 9530 | .S PSGCFL G=0 | |
| 9531 | "RTN","PSG OE41",57,0 ) | |
| 9532 | .I $D(ANQ DATA),$P(A NQDATA,"^" ,3)=9 D | |
| 9533 | "RTN","PSG OE41",58,0 ) | |
| 9534 | ..N X,X1, X2,X3 S X3 =$G(PSGNES D),X1=X3,X 2=4 D C^%D TC S PSGNE FD=X,PSGFD =$$ENDD^PS GMI(PSGNEF D) | |
| 9535 | "RTN","PSG OE41",59,0 ) | |
| 9536 | ..S PSGOL DED=PSGFD, PSGNEFDOLD =PSGNEFD,P SGTDTD=1 | |
| 9537 | "RTN","PSG OE41",60,0 ) | |
| 9538 | .I $$GET1 ^DIQ(55,DF N,53)?1U6N D | |
| 9539 | "RTN","PSG OE41",61,0 ) | |
| 9540 | ..N X,X1, X2,X3 S X3 =$P(PSGNES D,".",1)_" .2359",X1= X3,X2=4 D C^%DTC S P SGNEFD=X,P SGFD=$$END D^PSGMI(PS GNEFD) | |
| 9541 | "RTN","PSG OE41",62,0 ) | |
| 9542 | ..S PSGOL DED=PSGFD, PSGNEFDOLD =PSGNEFD,P SGEMRG=1 | |
| 9543 | "RTN","PSG OE41",63,0 ) | |
| 9544 | .I '$D(CL OZPAT) D C LOZPAT^PSJ CLOZ | |
| 9545 | "RTN","PSG OE41",64,0 ) | |
| 9546 | .I $D(CLO ZPAT),'$G( PSGEMRG),' $G(PSGTDTD ) D | |
| 9547 | "RTN","PSG OE41",65,0 ) | |
| 9548 | ..N X,X1, X2 | |
| 9549 | "RTN","PSG OE41",66,0 ) | |
| 9550 | ..S X1=PS GNESD,X2=$ S($G(CLOZP AT)=2:28,$ G(CLOZPAT) =1:14,$G(C LOZPAT)=0: 7,1:90) D C^%DTC S P SGNEFD=X,P SGFD=$$END D^PSGMI(PS GNEFD) | |
| 9551 | "RTN","PSG OE41",67,0 ) | |
| 9552 | ..S PSGCF LG=0,PSGOL DED=PSGFD, PSGNEFDOLD =PSGNEFD | |
| 9553 | "RTN","PSG OE41",68,0 ) | |
| 9554 | ;/RBN-RJS End chang es for eme rgency reg istration of clozapi ne patient | |
| 9555 | "RTN","PSG OE41",69,0 ) | |
| 9556 | N MSG,PSG TMPST S PS GTMPST=$G( PSGST) S:' +$G(PSGRF) PSGRF=+$$ GET1^DIQ(5 0.7,$G(PSG PDRG),12," I") ;*315 One time o rders for MRR's requ ire messag e to instr uct pharma cists | |
| 9557 | "RTN","PSG OE41",70,0 ) | |
| 9558 | I +$G(PSG RF),$$FIND 1^DIC(51.1 ,,"X",$G(P SGSCH)) D | |
| 9559 | "RTN","PSG OE41",71,0 ) | |
| 9560 | .S:PSGTMP ST=($G(PSG ST)="R") P SGST=$$GET 1^DIQ(51.1 ,$$FIND1^D IC(51.1,," X",$G(PSGS CH)),5,"I" ) ;Handle "Fill on R equest" | |
| 9561 | "RTN","PSG OE41",72,0 ) | |
| 9562 | I $G(PSGT MPST)="O", +$G(PSGRF) S (PSGNEF D,PSGFD)=" " D | |
| 9563 | "RTN","PSG OE41",73,0 ) | |
| 9564 | .I +$G(PS GRF)=1 S M SG(1)="Thi s NOW orde r has an O rderable I tem for wh ich a remo val is req uired" D | |
| 9565 | "RTN","PSG OE41",74,0 ) | |
| 9566 | ..S MSG(2 )=" at the next admi nistration ." | |
| 9567 | "RTN","PSG OE41",75,0 ) | |
| 9568 | ..S MSG(3 )="The Sto p DATE/TIM E entered should be the next a nticipated administr ation for the medica tion.",MSG (3,"F")="! " | |
| 9569 | "RTN","PSG OE41",76,0 ) | |
| 9570 | .I +$G(PS GRF)=2 S M SG(1)="Thi s NOW orde r has an O rderable I tem for wh ich a remo val period is option al",MSG(1, "F")="!!" D | |
| 9571 | "RTN","PSG OE41",77,0 ) | |
| 9572 | ..S MSG(2 )="prior t o the next administr ation.",MS G(2,"F")=" !" | |
| 9573 | "RTN","PSG OE41",78,0 ) | |
| 9574 | ..S MSG(3 )="If Earl y Removal is needed, enter Rem oval Time in Stop DA TE/TIME fi eld.",MSG( 3,"F")="!" | |
| 9575 | "RTN","PSG OE41",79,0 ) | |
| 9576 | ..S MSG(4 )="If an E arly Remov al is not required, the Stop D ATE/TIME e ntered" | |
| 9577 | "RTN","PSG OE41",80,0 ) | |
| 9578 | ..S MSG(5 )="should be the nex t anticipa ted admini stration f or the med ication.", MSG(5,"F") ="!" | |
| 9579 | "RTN","PSG OE41",81,0 ) | |
| 9580 | .I +$G(PS GRF)=3 S M SG(1)="Thi s NOW orde r has an O rderable I tem that r equires a removal pe riod prior ",MSG(1,"F ")="!!" D | |
| 9581 | "RTN","PSG OE41",82,0 ) | |
| 9582 | ..S MSG(2 )=" to the next admi nistration .",MSG(2," F")="!" | |
| 9583 | "RTN","PSG OE41",83,0 ) | |
| 9584 | ..S MSG(3 )="Please Enter the Stop DATE/ TIME to re flect the Removal Ti me for thi s medicati on.",MSG(3 ,"F")="!" | |
| 9585 | "RTN","PSG OE41",84,0 ) | |
| 9586 | .D EN^DDI OL(.MSG) | |
| 9587 | "RTN","PSG OE41",85,0 ) | |
| 9588 | A25 W !,"S TOP DATE/T IME: "_$S( PSGFD]"":P SGFD_"// " ,1:"") R X :DTIME I X ="^"!'$T W :'$T $C(7) S PSGOROE 1=1 G DONE | |
| 9589 | "RTN","PSG OE41",86,0 ) | |
| 9590 | I X="",PS GNEFD W " "_PSGFD S PSGFOK(2 5)="" G W 25 | |
| 9591 | "RTN","PSG OE41",87,0 ) | |
| 9592 | S PSGF2=2 5 I $E(X)= "^" D FF G :Y>0 @Y G A25 | |
| 9593 | "RTN","PSG OE41",88,0 ) | |
| 9594 | I X="@"!( X?1."?") W :X="@" $C( 7)," (Req uired)" S: X="@" X="? " D ENHLP^ PSGOEM(53. 1,25) | |
| 9595 | "RTN","PSG OE41",89,0 ) | |
| 9596 | I X=+X,(X >0),(X'>20 00000) G A 25:'$$ENDL ^PSGDL(PSG SCH,X) K P SGDLS S PS GDL=X W " ...dose li mit..." D EN1^PSGDL | |
| 9597 | "RTN","PSG OE41",90,0 ) | |
| 9598 | K %DT S % DT="ERTX", %DT(0)=PSG NESD D ^%D T K %DT I Y'>0 W $C( 7),!!?13," *** WARNIN G! INVALID STOP DATE OR PRIOR TO START D ATE! ***", ! G A25 | |
| 9599 | "RTN","PSG OE41",91,0 ) | |
| 9600 | ;/RJS Beg in changes for emerg ency regis tration of clozapine patient S et end dat e to start date + 4 days at mi dnight. | |
| 9601 | "RTN","PSG OE41",92,0 ) | |
| 9602 | I $D(PSGC FLG) D I $G(PSGCFLG ) S PSGCFL G=0 G A25 | |
| 9603 | "RTN","PSG OE41",93,0 ) | |
| 9604 | .N X2 S X 2=$S($G(CL OZPAT)=2:2 8,$G(CLOZP AT)=1:14,$ G(CLOZPAT) =0:7,1:90) | |
| 9605 | "RTN","PSG OE41",94,0 ) | |
| 9606 | .I $G(PSG EMRG)!$G(P SGTDTD) S X2=4 | |
| 9607 | "RTN","PSG OE41",95,0 ) | |
| 9608 | .I $P(Y," .")>$P(PSG NEFD,".") D S PSGCF LG=1 Q | |
| 9609 | "RTN","PSG OE41",96,0 ) | |
| 9610 | ..I X2=4 W !!?13,"* ** EMERGEN CY SUPPLY NOT TO EXC EED 4 DAYS ! ***",! Q | |
| 9611 | "RTN","PSG OE41",97,0 ) | |
| 9612 | ..W !!,"* ** STOP DA TE/TIME NO T TO EXCEE D "_X2_" D AYS! ***", ! Q | |
| 9613 | "RTN","PSG OE41",98,0 ) | |
| 9614 | .S (PSGFD X,PSGFD,PS GNEFD)=+Y, PSGFDN=$$E NDD^PSGMI( PSGFD)_"^" _$$ENDTC^P SGMI(PSGFD ) | |
| 9615 | "RTN","PSG OE41",99,0 ) | |
| 9616 | ;/RJS End changes f or emergen cy registr ation of c lozapine p atient | |
| 9617 | "RTN","PSG OE41",100, 0) | |
| 9618 | A255 ; | |
| 9619 | "RTN","PSG OE41",101, 0) | |
| 9620 | I $G(PSGC FLG) S PSG CFLG=0 G A 25 | |
| 9621 | "RTN","PSG OE41",102, 0) | |
| 9622 | S PSGNEFD =+Y,PSGFD= $$ENDD^PSG MI(+Y),PSG FOK(25)="" | |
| 9623 | "RTN","PSG OE41",103, 0) | |
| 9624 | K PSGEMRG ,PSGTDTD | |
| 9625 | "RTN","PSG OE41",104, 0) | |
| 9626 | ;; END NC C REMEDIAT ION RJS*32 7 | |
| 9627 | "RTN","PSG OE41",105, 0) | |
| 9628 | W25 ; | |
| 9629 | "RTN","PSG OE41",106, 0) | |
| 9630 | N Z | |
| 9631 | "RTN","PSG OE41",107, 0) | |
| 9632 | D DOSE I $G(Z)]"",Z >PSGNEFD D G A25 | |
| 9633 | "RTN","PSG OE41",108, 0) | |
| 9634 | .W !,"The re must be an admin time that falls betw een the St art Date/T ime" | |
| 9635 | "RTN","PSG OE41",109, 0) | |
| 9636 | .W !,"and the Stop Date/Time. " | |
| 9637 | "RTN","PSG OE41",110, 0) | |
| 9638 | I PSGNEFD <PSGDT W $ C(7),!!?13 ,"*** WARN ING! THE S TOP DATE E NTERED IS IN THE PAS T! ***",! | |
| 9639 | "RTN","PSG OE41",111, 0) | |
| 9640 | D EFDNEW^ PSJUTL ;D isplay Exp ected Firs t Dose;BHW ;PSJ*5*136 | |
| 9641 | "RTN","PSG OE41",112, 0) | |
| 9642 | I $G(PSGD UR),'$G(PS GOROE1) D VERTIMES ; *315 | |
| 9643 | "RTN","PSG OE41",113, 0) | |
| 9644 | NEXT ; | |
| 9645 | "RTN","PSG OE41",114, 0) | |
| 9646 | S:'+$G(PS GRF) PSGRF =+$$GET1^D IQ(50.7,$G (PSGPDRG), 12,"I") | |
| 9647 | "RTN","PSG OE41",115, 0) | |
| 9648 | G:'$D(PSG AARR) 1^PS GOE42 | |
| 9649 | "RTN","PSG OE41",116, 0) | |
| 9650 | ; | |
| 9651 | "RTN","PSG OE41",117, 0) | |
| 9652 | DONE ; | |
| 9653 | "RTN","PSG OE41",118, 0) | |
| 9654 | I PSGOROE 1 K Y W $C (7)," ... order not entered... " | |
| 9655 | "RTN","PSG OE41",119, 0) | |
| 9656 | K F,F0,F1 ,PSGF2,F3, PSG,SDT,PS GEMRG,PSGC LOZ Q | |
| 9657 | "RTN","PSG OE41",120, 0) | |
| 9658 | ; | |
| 9659 | "RTN","PSG OE41",121, 0) | |
| 9660 | FF ; up-ar row to ano ther field | |
| 9661 | "RTN","PSG OE41",122, 0) | |
| 9662 | D ENFF^PS GOEM I Y>0 ,Y'=39,Y'= 8,Y'=10,Y' =25 S Y=Y_ "^PSGOE4"_ $S("^109^1 3^3^7^26^" [("^"_Y_"^ "):"",1:2) S:$P(Y,U) =2 FB=PSGF 2_"^PSGOE4 1" | |
| 9663 | "RTN","PSG OE41",123, 0) | |
| 9664 | Q | |
| 9665 | "RTN","PSG OE41",124, 0) | |
| 9666 | ; | |
| 9667 | "RTN","PSG OE41",125, 0) | |
| 9668 | DEL ; dele te entry | |
| 9669 | "RTN","PSG OE41",126, 0) | |
| 9670 | W !?3,"SU RE YOU WAN T TO DELET E" S %=0 D YN^DICN I %'=1 W $C (7)," <NO THING DELE TED>" | |
| 9671 | "RTN","PSG OE41",127, 0) | |
| 9672 | Q | |
| 9673 | "RTN","PSG OE41",128, 0) | |
| 9674 | TIMES ; At least o ne admin t ime, not m ore than i nterval al lows. | |
| 9675 | "RTN","PSG OE41",129, 0) | |
| 9676 | I $G(PSGS 0XT)'="O", X="" W !," This order requires at least o ne adminis tration ti me." K X Q ;No time s | |
| 9677 | "RTN","PSG OE41",130, 0) | |
| 9678 | N H,I,MAX | |
| 9679 | "RTN","PSG OE41",131, 0) | |
| 9680 | I PSGSCH] "" I $D(^P S(51.1,"AC ","PSJ",PS GSCH)) S H =+$O(^PS(5 1.1,"AC"," PSJ",PSGSC H,0)) S I= $P($G(^PS( 51.1,H,0)) ,"^",3) | |
| 9681 | "RTN","PSG OE41",132, 0) | |
| 9682 | I $G(PSGS T)="O",$L( X,"-")>1 W !,"This i s a One Ti me Order - only one admin time is permit ted." K X Q | |
| 9683 | "RTN","PSG OE41",133, 0) | |
| 9684 | I $G(PSGS T)="O" Q ;Done vali dating One Time | |
| 9685 | "RTN","PSG OE41",134, 0) | |
| 9686 | I +$G(I)= 0 Q ;No f requency - can not c heck frequ ency relat ed items | |
| 9687 | "RTN","PSG OE41",135, 0) | |
| 9688 | S MAX=144 0/I | |
| 9689 | "RTN","PSG OE41",136, 0) | |
| 9690 | I MAX<1 D Q | |
| 9691 | "RTN","PSG OE41",137, 0) | |
| 9692 | . I $L(X, "-")'=1 W !,"This or der requir es one adm in time." K X Q | |
| 9693 | "RTN","PSG OE41",138, 0) | |
| 9694 | I MAX'<1, $L(X,"-")> MAX W !,"T he number of admin t imes enter ed is grea ter than i ndicated b y the sche dule." K X Q ;Too m any times | |
| 9695 | "RTN","PSG OE41",139, 0) | |
| 9696 | I MAX'<1, $L(X,"-")< MAX W !,"T he number of admin t imes enter ed is fewe r than ind icated by the schedu le." ;Too few times | |
| 9697 | "RTN","PSG OE41",140, 0) | |
| 9698 | Q | |
| 9699 | "RTN","PSG OE41",141, 0) | |
| 9700 | DOSE ;Make certain a t least on e dose is given. | |
| 9701 | "RTN","PSG OE41",142, 0) | |
| 9702 | Q:$G(PSGS T)="OC"!($ G(PSGST)=" P") | |
| 9703 | "RTN","PSG OE41",143, 0) | |
| 9704 | N INFO,X | |
| 9705 | "RTN","PSG OE41",144, 0) | |
| 9706 | S Z="",IN FO=($G(PSG NESD))_U_( $G(PSGNEFD ))_U_($G(P SGSCH))_U_ ($G(PSGST) )_U_($G(PS GDRG))_U_( $G(PSGS0Y) ) | |
| 9707 | "RTN","PSG OE41",145, 0) | |
| 9708 | I '$L($G( PSGP)) N P SGP S PSGP ="" | |
| 9709 | "RTN","PSG OE41",146, 0) | |
| 9710 | S Z=$$ENQ ^PSJORP2(P SGP,INFO) ;Expected first dos e. | |
| 9711 | "RTN","PSG OE41",147, 0) | |
| 9712 | Q | |
| 9713 | "RTN","PSG OE41",148, 0) | |
| 9714 | ; | |
| 9715 | "RTN","PSG OE41",149, 0) | |
| 9716 | ;*315 new tags | |
| 9717 | "RTN","PSG OE41",150, 0) | |
| 9718 | PSGDUR ; P rompt for Removal ti mes if adm in times a re on 24hr rotations and Site Params are enabled. | |
| 9719 | "RTN","PSG OE41",151, 0) | |
| 9720 | ; check p arameter f iles for r emoval cri teria quit if remova l rotation not enabl ed (<2) | |
| 9721 | "RTN","PSG OE41",152, 0) | |
| 9722 | ; if enab led determ ine type ( hard vers soft stop) | |
| 9723 | "RTN","PSG OE41",153, 0) | |
| 9724 | ;0 = no r emoval (cu rrent cap/ tab functi onality) | |
| 9725 | "RTN","PSG OE41",154, 0) | |
| 9726 | ;1 = remo val at nex t admin (c urrent pat ch functio nality) | |
| 9727 | "RTN","PSG OE41",155, 0) | |
| 9728 | ;2 = remo val prior to next ad min; soft stop (phar macist opt ional prom pt to desi gnate dura tion of ad ministrati on | |
| 9729 | "RTN","PSG OE41",156, 0) | |
| 9730 | ;3 = remo val prior to next ad min; hard stop (phar macist req uired prom pt to desi gnate dura tion of ad ministrati on) | |
| 9731 | "RTN","PSG OE41",157, 0) | |
| 9732 | ; prompt for remova l if = 2 t hen allow skip, if = 3 then fo rce entry | |
| 9733 | "RTN","PSG OE41",158, 0) | |
| 9734 | ; | |
| 9735 | "RTN","PSG OE41",159, 0) | |
| 9736 | S PSGRF=+ $$GET1^DIQ (50.7,$G(P SGPDRG),12 ,"I") Q:(( PSGRF<2)!( $G(PSGST)= "O")!($G(P SGST)="P") !($G(PSGST )="OC")) ; no remov al flag or no remova l rotation | |
| 9737 | "RTN","PSG OE41",160, 0) | |
| 9738 | Q:$G(PSGS 0XT)>1440 ; Duratio n of Admin istration valid only for 24 ho urs - subj ect to cha nge in fut ure. | |
| 9739 | "RTN","PSG OE41",161, 0) | |
| 9740 | N RP,PSGI DF,WMSG,PS GDERR S (P SGIDF,PSGD ERR)=0 S:$ G(PSGDUR)> 0 RP=PSGDU R/60 S:"BI D,TID,QID" [$G(PSGSCH ) PSGIDF=1 ; Use sep arate vali dation for Times Per Day type orders | |
| 9741 | "RTN","PSG OE41",162, 0) | |
| 9742 | S PSGF2=3 9 | |
| 9743 | "RTN","PSG OE41",163, 0) | |
| 9744 | W !,"DURA TION OF AD MINISTRATI ON (HRS): "_$S($G(RP ):RP_"// " ,1:"") R R P:DTIME I RP="^"!'$T W:'$T $C( 7) S PSGOR OE1=1,X="^ " K PSGFOK (39) Q | |
| 9745 | "RTN","PSG OE41",164, 0) | |
| 9746 | I RP="",$ G(PSGS0XT) ="D" I $L( PSGSCH,"@" )=2,$P(PSG SCH,"@",2) S (PSGAT, PSGRMV)=$P (PSGSCH,"@ ",2) G 8 | |
| 9747 | "RTN","PSG OE41",165, 0) | |
| 9748 | I RP="@", PSGRF'=3 D DEL G:%'= 1 PSGDUR S (PSGFOK(3 9),PSGS0Y, PSGDUR,PSG RMVT)="",P SGRMV=-1 S :$$GET1^DI Q(53.1,+$G (PSGORD),1 37) (PSGDU R,PSGRMVT) ="@" Q | |
| 9749 | "RTN","PSG OE41",166, 0) | |
| 9750 | I (RP'="" ),(RP'="@" ),($E(RP)' ="^"),($E( RP)'="?") S:(RP'?1N. 2N)!(+(RP) <1) RP="?" | |
| 9751 | "RTN","PSG OE41",167, 0) | |
| 9752 | I RP?1."? " D DURHLP ^PSGOEM(RP ,PSGRF) G PSGDUR | |
| 9753 | "RTN","PSG OE41",168, 0) | |
| 9754 | I $E(RP)= "^" D FF G :Y>0 @Y G PSGDUR | |
| 9755 | "RTN","PSG OE41",169, 0) | |
| 9756 | I (+RP>0) ,'PSGIDF D I PSGRMV <1 G PSGDU R ; exclud e TPD sche dules | |
| 9757 | "RTN","PSG OE41",170, 0) | |
| 9758 | .S PSGDUR =(RP*60),P SGRMV=$G(P SGS0XT)-PS GDUR | |
| 9759 | "RTN","PSG OE41",171, 0) | |
| 9760 | .I PSGRMV <1 W !,"DU RATION OF ADMINISTRA TION MATCH ES OR EXCE EDS ORDER FREQUENCY" S RP="",P SGDERR=1 K PSGDUR,PS GRMV Q ;G PSGDUR | |
| 9761 | "RTN","PSG OE41",172, 0) | |
| 9762 | Q:$G(PSGD ERR)=1 | |
| 9763 | "RTN","PSG OE41",173, 0) | |
| 9764 | I PSGRF=3 ,(+RP<1) W !,"ENTRY IS REQUIRE D" S RP="" G PSGDUR | |
| 9765 | "RTN","PSG OE41",174, 0) | |
| 9766 | I PSGRF=2 ,(+RP<1) D | |
| 9767 | "RTN","PSG OE41",175, 0) | |
| 9768 | .W !,"You have not entered Du ration of Administra tion for t his medica tion order , " | |
| 9769 | "RTN","PSG OE41",176, 0) | |
| 9770 | .W !,"the refore the BCMA user will not be prompte d to remov e the medi cation pri or " | |
| 9771 | "RTN","PSG OE41",177, 0) | |
| 9772 | .W !,"to the next A dmin Time. " | |
| 9773 | "RTN","PSG OE41",178, 0) | |
| 9774 | .S PSGRMV =-1,RP=0 | |
| 9775 | "RTN","PSG OE41",179, 0) | |
| 9776 | I PSGIDF, (+RP>0) D ;Only for TPD sched ules | |
| 9777 | "RTN","PSG OE41",180, 0) | |
| 9778 | .N F,P,PS GARR | |
| 9779 | "RTN","PSG OE41",181, 0) | |
| 9780 | .S PSGADT =$S($G(PSG DUR)=-1:X, $G(PSGS0Y) :PSGS0Y,$G (PSGAT):PS GAT,1:""), PSGAT=PSGA DT | |
| 9781 | "RTN","PSG OE41",182, 0) | |
| 9782 | .S PSGARR =$L($G(PSG ADT),"-") | |
| 9783 | "RTN","PSG OE41",183, 0) | |
| 9784 | .F P=1:1: PSGARR D | |
| 9785 | "RTN","PSG OE41",184, 0) | |
| 9786 | ..S PSGAR R(P)=($P(P SGADT,"-", P)/100) S: (P>1) F(P) =PSGARR(P) -PSGARR(P- 1) | |
| 9787 | "RTN","PSG OE41",185, 0) | |
| 9788 | ..I $G(F( P)),($G(F( P))'=RP) S WMSG=1_U_ "Duration of Adminis tration do es not cor respond to one or mo re",WMSG(1 )="of this order's s cheduled A dministrat ion Times! " | |
| 9789 | "RTN","PSG OE41",186, 0) | |
| 9790 | S:(+RP>0) PSGDUR=(R P*60) | |
| 9791 | "RTN","PSG OE41",187, 0) | |
| 9792 | W:(+RP>0) ?60,RP," HOURS" | |
| 9793 | "RTN","PSG OE41",188, 0) | |
| 9794 | D:$G(WMSG ) EN^DDIOL ($P(WMSG,U ,2)),EN^DD IOL(WMSG(1 )) | |
| 9795 | "RTN","PSG OE41",189, 0) | |
| 9796 | Q:'$G(PSG OE3)!'+$G( PSGDUR) | |
| 9797 | "RTN","PSG OE41",190, 0) | |
| 9798 | ; | |
| 9799 | "RTN","PSG OE41",191, 0) | |
| 9800 | VERTIMES ; Redisplay Admin and Removal t imes | |
| 9801 | "RTN","PSG OE41",192, 0) | |
| 9802 | S PSGRF=+ $$GET1^DIQ (50.7,$G(P SGPDRG),12 ,"I") Q:(P SGRF<2)!($ G(PSGST)=" O") | |
| 9803 | "RTN","PSG OE41",193, 0) | |
| 9804 | N PSGADT, PSGRARR,PS GAARR | |
| 9805 | "RTN","PSG OE41",194, 0) | |
| 9806 | ;If we ha ve a frequ ency and t his is odd type orde r then we need to st art calcul ations wit h order st art time. | |
| 9807 | "RTN","PSG OE41",195, 0) | |
| 9808 | I $G(PSGS 0XT),$G(PS GNESD),+$G (PSGDUR),$ G(PSGAT)=" ",$G(PSGS0 Y)="" D Q | |
| 9809 | "RTN","PSG OE41",196, 0) | |
| 9810 | .N L | |
| 9811 | "RTN","PSG OE41",197, 0) | |
| 9812 | .S (PSGAA RR,PSGRARR )=1,PSGADT =$P($P(PSG NESD,U,1), ".",2),L=$ L(PSGADT) | |
| 9813 | "RTN","PSG OE41",198, 0) | |
| 9814 | .S PSGRAR R(1)=((((( PSGADT*60) +PSGDUR)/6 0)#24)*100 ) S:PSGRAR R(1)=0 PSG RARR(1)=24 00 S:$L(PS GRARR(1))= 3 PSGRARR( 1)="0"_PSG RARR(1) | |
| 9815 | "RTN","PSG OE41",199, 0) | |
| 9816 | .S PSGRAR R(1)=$E(PS GRARR(1),1 ,L)_"(R)" | |
| 9817 | "RTN","PSG OE41",200, 0) | |
| 9818 | .S PSGAAR R(1)=PSGAD T,PSGAARR( 1)=$E(PSGA ARR(1),1,L )_"(A)" | |
| 9819 | "RTN","PSG OE41",201, 0) | |
| 9820 | .D WRITE | |
| 9821 | "RTN","PSG OE41",202, 0) | |
| 9822 | ; | |
| 9823 | "RTN","PSG OE41",203, 0) | |
| 9824 | S (PSGRAR R,PSGAARR) =$S($G(PSG AT):$L(PSG AT,"-"),1: $L(PSGS0Y, "-")) | |
| 9825 | "RTN","PSG OE41",204, 0) | |
| 9826 | N P,L | |
| 9827 | "RTN","PSG OE41",205, 0) | |
| 9828 | F P=1:1:P SGRARR D | |
| 9829 | "RTN","PSG OE41",206, 0) | |
| 9830 | .S PSGADT =$S($G(PSG AT):$P(PSG AT,"-",P), 1:$P(PSGS0 Y,"-",P)), L=$L(PSGAD T) | |
| 9831 | "RTN","PSG OE41",207, 0) | |
| 9832 | .S PSGADT =$S($L(PSG ADT)=4:PSG ADT/100,1: PSGADT*1) | |
| 9833 | "RTN","PSG OE41",208, 0) | |
| 9834 | .S PSGRAR R(P)=((((( PSGADT*60) +PSGDUR)/6 0)#24)*100 ) S:PSGRAR R(P)=0 PSG RARR(P)=24 00 S:$L(PS GRARR(P))= 3 PSGRARR( P)="0"_PSG RARR(P) | |
| 9835 | "RTN","PSG OE41",209, 0) | |
| 9836 | .S PSGRAR R(P)=$E(PS GRARR(P),1 ,L)_"(R)" | |
| 9837 | "RTN","PSG OE41",210, 0) | |
| 9838 | .S PSGAAR R(P)=(PSGA DT*100) S: $L(PSGAARR (P))=3 PSG AARR(P)="0 "_PSGAARR( P) | |
| 9839 | "RTN","PSG OE41",211, 0) | |
| 9840 | .S PSGAAR R(P)=$E(PS GAARR(P),1 ,L)_"(A)" | |
| 9841 | "RTN","PSG OE41",212, 0) | |
| 9842 | D WRITE | |
| 9843 | "RTN","PSG OE41",213, 0) | |
| 9844 | Q | |
| 9845 | "RTN","PSG OE41",214, 0) | |
| 9846 | ; | |
| 9847 | "RTN","PSG OE41",215, 0) | |
| 9848 | WRITE ; | |
| 9849 | "RTN","PSG OE41",216, 0) | |
| 9850 | W !!,"Ver ify Admin and remova l times",! | |
| 9851 | "RTN","PSG OE41",217, 0) | |
| 9852 | W !,"(A)D MINISTRATI ON -(R)EMO VAL TIMES" | |
| 9853 | "RTN","PSG OE41",218, 0) | |
| 9854 | W !,"____ __________ __________ __________ __________ __________ __________ __________ _",! | |
| 9855 | "RTN","PSG OE41",219, 0) | |
| 9856 | F P=1:1:P SGAARR W P SGAARR(P)_ "-"_PSGRAR R(P) W:P' =PSGAARR " , " | |
| 9857 | "RTN","PSG OE41",220, 0) | |
| 9858 | D ASK | |
| 9859 | "RTN","PSG OE41",221, 0) | |
| 9860 | Q | |
| 9861 | "RTN","PSG OE41",222, 0) | |
| 9862 | ; | |
| 9863 | "RTN","PSG OE41",223, 0) | |
| 9864 | ASK ; | |
| 9865 | "RTN","PSG OE41",224, 0) | |
| 9866 | N Y | |
| 9867 | "RTN","PSG OE41",225, 0) | |
| 9868 | S DIR("A" )="Is this correct", DIR(0)="Y" D ^DIR I $D(DUOUT)! $D(DTOUT) W:'$T $C(7 ) S PSGOEE =0 K PSGDU R G DONE | |
| 9869 | "RTN","PSG OE41",226, 0) | |
| 9870 | I 'Y K X S PSGDUR=- 1 G 39 | |
| 9871 | "RTN","PSG OE41",227, 0) | |
| 9872 | N P S P=1 ,PSGRMVT=$ P(PSGRARR( P),"(",1) | |
| 9873 | "RTN","PSG OE41",228, 0) | |
| 9874 | F S P=$O (PSGRARR(P )) Q:P="" D | |
| 9875 | "RTN","PSG OE41",229, 0) | |
| 9876 | .S PSGRMV T=PSGRMVT_ "-"_$P(PSG RARR(P),"( ",1) | |
| 9877 | "RTN","PSG OE41",230, 0) | |
| 9878 | Q | |
| 9879 | "RTN","PSG OE41",231, 0) | |
| 9880 | ; | |
| 9881 | "RTN","PSG OE42") | |
| 9882 | 0^2^B14392 718 | |
| 9883 | "RTN","PSG OE42",1,0) | |
| 9884 | PSGOE42 ;B IR/CML3-RE GULAR ORDE R ENTRY (C ONT.) ;Jul 26, 2017@ 18:04:02 | |
| 9885 | "RTN","PSG OE42",2,0) | |
| 9886 | ;;5.0;INP ATIENT MED ICATIONS ; **327**;16 DEC 97;Bu ild 64 | |
| 9887 | "RTN","PSG OE42",3,0) | |
| 9888 | ; | |
| 9889 | "RTN","PSG OE42",4,0) | |
| 9890 | ; | |
| 9891 | "RTN","PSG OE42",5,0) | |
| 9892 | 1 I +$G(PS GCLOZ) K P SGCLOZ Q ;NCC REDEM TION *327/ RJS QUIT I F STOP DAT E HAS BEEN MODIFIED AND PROCES S | |
| 9893 | "RTN","PSG OE42",6,0) | |
| 9894 | ; provide r | |
| 9895 | "RTN","PSG OE42",7,0) | |
| 9896 | I '+$G(PS JSYSU) S P STMPI=PSGP R,PSTMPN=P SGPRN G A1 | |
| 9897 | "RTN","PSG OE42",8,0) | |
| 9898 | I $S(+PSJ SYSU=3:0,1 :$P(PSJSYS U,";",2)) G:$P(PSJSY SW0,"^",24 ) 5 G DONE | |
| 9899 | "RTN","PSG OE42",9,0) | |
| 9900 | S PSTMPI= PSGPR,PSTM PN=PSGPRN | |
| 9901 | "RTN","PSG OE42",10,0 ) | |
| 9902 | ;;A1 W !, "PROVIDER: ",$S(PSGP R:PSGPRN_" // ",1:"") R X:DTIME I X="^"!' $T W:'$T $ C(7) S PSG OROE1=1 G DONE | |
| 9903 | "RTN","PSG OE42",11,0 ) | |
| 9904 | A1 W !,"PR OVIDER: ", $S(PSGPR:P SGPRN_"// ",1:"") R X:DTIME I X="^" W $C (7) S PSGO ROE1=1 G D ONE | |
| 9905 | "RTN","PSG OE42",12,0 ) | |
| 9906 | I $S(X="" :'PSGPR,1: X="@") W $ C(7)," (R equired)" S X="?",PS GF2=1 D EN HLP^PSGOEM (53.1,1) G 1 | |
| 9907 | "RTN","PSG OE42",13,0 ) | |
| 9908 | I X="",PS GPR S X=PS GPRN I PSG PR'=PSGPRN ,$$GET1^DI Q(200,PSGP R,53.1,"I" ) W " " _$$GET1^DI Q(200,PSGP R,53.2)_" "_$$GET 1^DIQ(200, PSGPR,53.3 ) S PSGFOK (1)="" G A 2 | |
| 9909 | "RTN","PSG OE42",14,0 ) | |
| 9910 | S PSGF2=1 I X?1."?" D ENHLP^P SGOEM(53.1 ,1) | |
| 9911 | "RTN","PSG OE42",15,0 ) | |
| 9912 | I $E(X)=" ^" D FF G: Y>0 @Y G 1 | |
| 9913 | "RTN","PSG OE42",16,0 ) | |
| 9914 | K DIC S D IC="^VA(20 0,",DIC(0) ="EMQZ",DI C("S")="I $D(^(""PS" ")),^(""PS ""),$S('$P (^(""PS"") ,""^"",4): 1,1:$P(^(" "PS""),""^ "",4)>DT)" D ^DIC K DIC I Y'>0 G 1 | |
| 9915 | "RTN","PSG OE42",17,0 ) | |
| 9916 | S PSGPR=+ Y,PSGPRN=$ P(Y(0,0)," ^"),PSGFOK (1)="" | |
| 9917 | "RTN","PSG OE42",18,0 ) | |
| 9918 | A2 ;; STAR T NCC T4 M ODS >> 327 *RJS | |
| 9919 | "RTN","PSG OE42",19,0 ) | |
| 9920 | I '$G(PSG DRG) D LIS T^DIC(50,, .01,"I",,, PSGPDRG,"A SP",,,"ARR AY") I ARR AY("DILIST ",0) N I F I=1:1 Q:' $D(ARRAY(" DILIST",2, I)) S PSG DRG=ARRAY( "DILIST",2 ,I) Q:$L($ $GET1^DIQ( 50,PSGDRG, .01)) | |
| 9921 | "RTN","PSG OE42",20,0 ) | |
| 9922 | I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" D | |
| 9923 | "RTN","PSG OE42",21,0 ) | |
| 9924 | .S ANQX=0 D PROVCHK ^PSJCLOZ(P SGPR) ;(PS GP,PSGDRG) | |
| 9925 | "RTN","PSG OE42",22,0 ) | |
| 9926 | .I ANQX=0 K PSTMPN, PSTMPI | |
| 9927 | "RTN","PSG OE42",23,0 ) | |
| 9928 | I $G(ANQX ) S PSGPR= PSTMPI,PSG PRN=PSTMPN W ! K AN QX G A1 | |
| 9929 | "RTN","PSG OE42",24,0 ) | |
| 9930 | ;; END NC C T4 MODS << 327*RJS | |
| 9931 | "RTN","PSG OE42",25,0 ) | |
| 9932 | 5 ; self m ed | |
| 9933 | "RTN","PSG OE42",26,0 ) | |
| 9934 | I '$P(PSJ SYSW0,"^", 24) G DONE | |
| 9935 | "RTN","PSG OE42",27,0 ) | |
| 9936 | A5 W !,"SE LF MED: " W:PSGSM]"" $P("NO^YE S","^",PSG SM+1),"// " R X:DTIM E I X="^"! '$T W:'$T $C(7) S PS GOROE1=1 G DONE | |
| 9937 | "RTN","PSG OE42",28,0 ) | |
| 9938 | I "01"[X, $L(X)<2 S: PSGSM=""&( X]"") PSGS M=X W:PSGS M]"" " (" ,$P("NO^YE S","^",PSG SM+1),")" G DONE | |
| 9939 | "RTN","PSG OE42",29,0 ) | |
| 9940 | I X="@" W :PSGSM="" $C(7)," ? ?" G:PSGSM ="" A5 D D EL G:%'=1 A5 S (PSGS M,PSGHSM)= "" G DONE | |
| 9941 | "RTN","PSG OE42",30,0 ) | |
| 9942 | S PSGF2=5 I X?1"^". E D FF G:Y >0 @Y G A5 | |
| 9943 | "RTN","PSG OE42",31,0 ) | |
| 9944 | I X?1."?" S PSGF2=5 D ENHLP^P SGOEM(53.1 ,5) G A5 | |
| 9945 | "RTN","PSG OE42",32,0 ) | |
| 9946 | D YN I S PSGSM=$E( X)="Y",PSG FOK(5)="" G 6:PSGSM, DONE | |
| 9947 | "RTN","PSG OE42",33,0 ) | |
| 9948 | W $C(7) D ENHLP^PSG OEM(53.1,5 ) G A5 | |
| 9949 | "RTN","PSG OE42",34,0 ) | |
| 9950 | ; | |
| 9951 | "RTN","PSG OE42",35,0 ) | |
| 9952 | 6 ; hospit al supplie d self med | |
| 9953 | "RTN","PSG OE42",36,0 ) | |
| 9954 | W !,"HOSP ITAL SUPPL IED SELF M ED: " W:PS GHSM]"" $P ("NO^YES", "^",PSGHSM +1),"// " R X:DTIME I X="^"!'$ T W:'$T $C (7) S PSGO ROE1=1 G D ONE | |
| 9955 | "RTN","PSG OE42",37,0 ) | |
| 9956 | I "01"[X, $L(X)<2 S: PSGHSM=""& (X]"") PSG HSM=X W:PS GHSM]"" " (",$P("NO ^YES","^", PSGHSM+1), ")" G DONE | |
| 9957 | "RTN","PSG OE42",38,0 ) | |
| 9958 | I X="@" W :PSGHSM="" $C(7)," ??" G:PSGH SM="" 6 D DEL G:%'=1 6 S PSGHS M="" G DON E | |
| 9959 | "RTN","PSG OE42",39,0 ) | |
| 9960 | S PSGF2=6 I X?1"^". E D FF G:Y >0 @Y G 6 | |
| 9961 | "RTN","PSG OE42",40,0 ) | |
| 9962 | I X?1."?" D ENHLP^P SGOEM(53.1 ,6) G 6 | |
| 9963 | "RTN","PSG OE42",41,0 ) | |
| 9964 | D YN I S PSGHSM=$E (X)="Y" G DONE | |
| 9965 | "RTN","PSG OE42",42,0 ) | |
| 9966 | W $C(7) S PSGF2=6 D ENHLP^PSG OEM(53.1,6 ) G 6 | |
| 9967 | "RTN","PSG OE42",43,0 ) | |
| 9968 | Q | |
| 9969 | "RTN","PSG OE42",44,0 ) | |
| 9970 | ; | |
| 9971 | "RTN","PSG OE42",45,0 ) | |
| 9972 | DONE ; | |
| 9973 | "RTN","PSG OE42",46,0 ) | |
| 9974 | K F,F0,F1 ,PSGF2,F3, PSG,SDT Q | |
| 9975 | "RTN","PSG OE42",47,0 ) | |
| 9976 | ; | |
| 9977 | "RTN","PSG OE42",48,0 ) | |
| 9978 | FF ; up-ar row to ano ther field | |
| 9979 | "RTN","PSG OE42",49,0 ) | |
| 9980 | D ENFF^PS GOEM I Y>0 ,Y'=1,Y'=5 S Y=Y_"^P SGOE4"_$S( "^109^13^3 ^7^26^"[(" ^"_Y_"^"): "",1:1) | |
| 9981 | "RTN","PSG OE42",50,0 ) | |
| 9982 | Q | |
| 9983 | "RTN","PSG OE42",51,0 ) | |
| 9984 | ; | |
| 9985 | "RTN","PSG OE42",52,0 ) | |
| 9986 | DEL ; dele te entry | |
| 9987 | "RTN","PSG OE42",53,0 ) | |
| 9988 | W !?3,"SU RE YOU WAN T TO DELET E" S %=0 D YN^DICN I %'=1 W $C (7)," <NO THING DELE TED>" | |
| 9989 | "RTN","PSG OE42",54,0 ) | |
| 9990 | Q | |
| 9991 | "RTN","PSG OE42",55,0 ) | |
| 9992 | ; | |
| 9993 | "RTN","PSG OE42",56,0 ) | |
| 9994 | YN ; yes/n o as a set of codes | |
| 9995 | "RTN","PSG OE42",57,0 ) | |
| 9996 | I X'?.U F Y=1:1:$L( X) I $E(X, Y)?1L S X= $E(X,1,Y-1 )_$C($A(X, Y)-32)_$E( X,Y+1,$L(X )) | |
| 9997 | "RTN","PSG OE42",58,0 ) | |
| 9998 | F Y="NO", "YES" I $P (Y,X)="" W $P(Y,X,2) Q | |
| 9999 | "RTN","PSG OE42",59,0 ) | |
| 10000 | Q | |
| 10001 | "RTN","PSG OE42",60,0 ) | |
| 10002 | ; | |
| 10003 | "RTN","PSG OE42",61,0 ) | |
| 10004 | 2 ; dispen se drug mu ltiple | |
| 10005 | "RTN","PSG OE42",62,0 ) | |
| 10006 | I PSGDRG, '$D(^PS(53 .45,PSJSYS P,2)) S ^( 2,0)="^53. 4502P^1^1" ,^(1,0)=PS GDRG_"^"_P SGUD | |
| 10007 | "RTN","PSG OE42",63,0 ) | |
| 10008 | K DA,DR S DIE="^PS( 53.45,",DA =PSJSYSP,D R=2,DR(2,5 3.4502)=$S ($G(PSGFOK (13)):.02, 1:".01;.02 ") D ^DIE | |
| 10009 | "RTN","PSG OE42",64,0 ) | |
| 10010 | I '$O(^PS (53.45,PSJ SYSP,2,0)) W $C(7),! !,"WARNING : This ord er must ha ve at leas t one disp ense drug before pha rmacy can" ,!?9,"veri fy it!" | |
| 10011 | "RTN","PSG OE42",65,0 ) | |
| 10012 | I $G(PSGF OK(13)) Q | |
| 10013 | "RTN","PSG OE42",66,0 ) | |
| 10014 | G @FB | |
| 10015 | "RTN","PSG OE7") | |
| 10016 | 0^4^B46313 440 | |
| 10017 | "RTN","PSG OE7",1,0) | |
| 10018 | PSGOE7 ;BI R/CML3-SEL ECT DRUG ; Jul 26, 20 17@18:04:0 2 | |
| 10019 | "RTN","PSG OE7",2,0) | |
| 10020 | ;;5.0;INP ATIENT MED ICATIONS;* *9,26,34,5 2,55,50,87 ,111,181,2 54,267,260 ,288,281,3 17,327**;1 6 DEC 97;B uild 64 | |
| 10021 | "RTN","PSG OE7",3,0) | |
| 10022 | ; | |
| 10023 | "RTN","PSG OE7",4,0) | |
| 10024 | ; Referen ce to ^PS( 50.7 is su pported by DBIA 2180 | |
| 10025 | "RTN","PSG OE7",5,0) | |
| 10026 | ; Referen ce to ^PS( 59.7 is su pported by DBIA 2181 | |
| 10027 | "RTN","PSG OE7",6,0) | |
| 10028 | ; Referen ce to ^PSD RUG( is su pported by DBIA 2192 | |
| 10029 | "RTN","PSG OE7",7,0) | |
| 10030 | ; Referen ce to ^PSN APIS is su pported by DBIA 2531 | |
| 10031 | "RTN","PSG OE7",8,0) | |
| 10032 | ; Referen ce to $$GE T^XPAR is supported by DBIA 22 63 | |
| 10033 | "RTN","PSG OE7",9,0) | |
| 10034 | ; Referen ce to ^VAD PT is supp orted by D BIA 10061 | |
| 10035 | "RTN","PSG OE7",10,0) | |
| 10036 | ; Referen ce to ^TMP ("PSODAOC" ,$J suppor ted by DBI A 6071 | |
| 10037 | "RTN","PSG OE7",11,0) | |
| 10038 | ; NFI-UD chgs for F R#: 1 | |
| 10039 | "RTN","PSG OE7",12,0) | |
| 10040 | ; | |
| 10041 | "RTN","PSG OE7",13,0) | |
| 10042 | ;S PSGDIC S="U"_$S($ D(PSJOERR) :",I",1:"" ) | |
| 10043 | "RTN","PSG OE7",14,0) | |
| 10044 | S PSGDICS ="U" | |
| 10045 | "RTN","PSG OE7",15,0) | |
| 10046 | ; | |
| 10047 | "RTN","PSG OE7",16,0) | |
| 10048 | AD ; Ask D rug | |
| 10049 | "RTN","PSG OE7",17,0) | |
| 10050 | K PSJDOSE ,PSJDOX ;v ar array u se in ^PSJ DOSE | |
| 10051 | "RTN","PSG OE7",18,0) | |
| 10052 | K PSGODO, ^TMP("PSJI NTER",$J) D KILL^PSJ BCMA5(+$G( PSJSYSP)) | |
| 10053 | "RTN","PSG OE7",19,0) | |
| 10054 | K DIC S D IC="^PS(50 .7,",DIC(0 )="EMQZVT" ,D="B^C" I '$P(PSJSY SU,";",4) S DIC("S") ="I $$ENOI SC^PSJUTL( Y,""U"")" | |
| 10055 | "RTN","PSG OE7",20,0) | |
| 10056 | N PSJTABS ,PSJPLTYP, PSJPDLOC | |
| 10057 | "RTN","PSG OE7",21,0) | |
| 10058 | E D | |
| 10059 | "RTN","PSG OE7",22,0) | |
| 10060 | .I '$D(PS JDGCK) S D IC("T")="" ,DIC="^PSD RUG(",DIC( "S")="I $$ GET1^DIQ(5 0,+Y,2.1," "I""),$$GE T1^DIQ(50, +Y,63)[""U "" S X(1)= +$$GET1^DI Q(50,+Y,10 0,""I"") I $S('X(1): 1,1:X(1)>D T)",D="B^C ^VAPN^VAC^ NDC^XATC" | |
| 10061 | "RTN","PSG OE7",23,0) | |
| 10062 | .I $D(PSJ DGCK) S DI C("T")="", DIC="^PSDR UG(",DIC(" S")="I $$G ET1^DIQ(50 ,+Y,2.1,"" I""),$$GCN ^PSGOE7(+Y ),$$PKGFLG ^PSGOE7($$ GET1^DIQ(5 0,+Y,63)) S X(1)=+$$ GET1^DIQ(5 0,+Y,100," "I"") I $S ('X(1):1,1 :X(1)>DT)" ,D="B^C^VA PN^VAC^NDC ^XATC" | |
| 10063 | "RTN","PSG OE7",24,0) | |
| 10064 | ; | |
| 10065 | "RTN","PSG OE7",25,0) | |
| 10066 | AD1 ; | |
| 10067 | "RTN","PSG OE7",26,0) | |
| 10068 | K PSGORD, PSJORD,PSJ ALLGY,PSGU SRX,^TMP(" PSJINTER", $J),^PS(53 .45,+$G(PS JSYSP),5), ^PS(53.45, +$G(PSJSYS P),6),PSJP LTYP,PSJPD LOC | |
| 10069 | "RTN","PSG OE7",27,0) | |
| 10070 | K ^TMP("P SODAOC",$J ) | |
| 10071 | "RTN","PSG OE7",28,0) | |
| 10072 | S PSGORQF =0 R !!,"S elect DRUG : ",X:DTIM E I '$T W $C(7) S X= "^" | |
| 10073 | "RTN","PSG OE7",29,0) | |
| 10074 | ; -- save off value of X in P SGUSRX so variable c an be reli able check ed at DO t ag | |
| 10075 | "RTN","PSG OE7",30,0) | |
| 10076 | S PSGUSRX =X | |
| 10077 | "RTN","PSG OE7",31,0) | |
| 10078 | I $D(PSJD GCK) I ($G (PSJOCNT)= 1&(X="")) D Q | |
| 10079 | "RTN","PSG OE7",32,0) | |
| 10080 | .W !!,"No t enough a ctive prof ile drugs to perform drug chec k",! | |
| 10081 | "RTN","PSG OE7",33,0) | |
| 10082 | .K DIR S DIR(0)="E" ,DIR("A")= "Press Ret urn to Con tinue..." D ^DIR K D IR W @IOF | |
| 10083 | "RTN","PSG OE7",34,0) | |
| 10084 | I $D(PSJD GCK),X="" N PSGDGCKF S PSGDGCK F=1 G DGCK X | |
| 10085 | "RTN","PSG OE7",35,0) | |
| 10086 | I ("^"[X) !(X="") S PSGORQF=1 G DONE | |
| 10087 | "RTN","PSG OE7",36,0) | |
| 10088 | G:X?1"S." 1.E DONE | |
| 10089 | "RTN","PSG OE7",37,0) | |
| 10090 | I X?1."?" W !!?2,"S elect the medication you wish the patien t to recei ve." W:PSJ SYSU<3 " You should consult", !,"with yo ur pharmac y before o rdering an y non-form ulary medi cation." W ! | |
| 10091 | "RTN","PSG OE7",38,0) | |
| 10092 | ; PSJ*5*3 17 - PADE - Define P ADE identi fier for l ookups if kernel par ameter tur ned on | |
| 10093 | "RTN","PSG OE7",39,0) | |
| 10094 | I $$GET^X PAR("SYS", "PSJ PADE OE BALANCE S") N PSJT ABS N:'$G( VAIN(4))&$ G(PSGP) VA IN,DFN,PSJ TABS D | |
| 10095 | "RTN","PSG OE7",40,0) | |
| 10096 | .N PSJORC L,PSJCLNK K DIC("W") | |
| 10097 | "RTN","PSG OE7",41,0) | |
| 10098 | .I '$G(VA IN(4)),$G( PSGP) S DF N=PSGP D I NP^VADPT | |
| 10099 | "RTN","PSG OE7",42,0) | |
| 10100 | .; If cli nic order, quit if c linic loca tion is no t linked t o PADE | |
| 10101 | "RTN","PSG OE7",43,0) | |
| 10102 | .S PSJORC L="" I $G( PSGORD)["P " S PSJORC L=$$GET1^D IQ(53.1,+$ G(PSGORD), 113,"I")_" ^"_$$GET1^ DIQ(53.1,+ $G(PSGORD) ,126,"I") I 1 | |
| 10103 | "RTN","PSG OE7",44,0) | |
| 10104 | .E I $G( PSGORD)["U " S PSJORC L=$$GET1^D IQ(55.06,+ $G(PSGORD) _","_+$G(P SGP),130," I")_"^"_$$ GET1^DIQ(5 5.06,+$G(P SGORD)_"," _+$G(PSGP) ,131,"I") I 1 | |
| 10105 | "RTN","PSG OE7",45,0) | |
| 10106 | .E I $G( PSGORD)["V " S PSJORC L=$$GET1^D IQ(55.01,+ $G(PSGORD) _","_+$G(P SGP),136," I")_"^"_$$ GET1^DIQ(5 5.01,+$G(P SGORD)_"," _+$G(PSGP) ,139,"I") | |
| 10107 | "RTN","PSG OE7",46,0) | |
| 10108 | .I PSJORC L,$P(PSJOR CL,"^",2) S PSJCLNK= $$PADECL^P SJPAD50(+$ G(PSJORCL) ) Q:'PSJCL NK | |
| 10109 | "RTN","PSG OE7",47,0) | |
| 10110 | .I '$G(PS JCLNK) Q:' $$PADEWD^P SJPAD50(+$ G(VAIN(4)) ) | |
| 10111 | "RTN","PSG OE7",48,0) | |
| 10112 | .S $P(PSJ TABS," ",4 0)="" | |
| 10113 | "RTN","PSG OE7",49,0) | |
| 10114 | .S PSJPLT YP=$S($G(P SJCLNK):"" "CL""",1:" ""WD"""),P SJPDLOC=$S (PSJPLTYP= "CL":+PSJO RCL,1:+$G( VAIN(4))) | |
| 10115 | "RTN","PSG OE7",50,0) | |
| 10116 | .S DIC("W ")="W $E(P SJTABS,1,( 40-$L($S($ G(DIY)]""" ":$G(DIY), 1:$$GET1^D IQ(50,+$G( Y),.01)))) )_"" PADE : ""_$$DRG QTY^PSJPAD SI(+Y,"_PS JPLTYP_"," _$G(PSJPDL OC)_")_"" ""_$$GET 1^DIQ(50,+ Y,101)" | |
| 10117 | "RTN","PSG OE7",51,0) | |
| 10118 | ; | |
| 10119 | "RTN","PSG OE7",52,0) | |
| 10120 | D MIX^DIC 1 G:X?1."? " AD1 G:"^ "[X!(Y'>0) AD1 S (PS GDO,PSGDRG ,PSGDRGN,P SGNEDFD,PS GPDRG,PSGP DRGN)="" | |
| 10121 | "RTN","PSG OE7",53,0) | |
| 10122 | I $D(PSJD GCK) I $$P SJSUPCK^PS JDGCK(+Y) G AD1 | |
| 10123 | "RTN","PSG OE7",54,0) | |
| 10124 | ; | |
| 10125 | "RTN","PSG OE7",55,0) | |
| 10126 | DGCKX I $P (PSJSYSU," ;",4) D G DO | |
| 10127 | "RTN","PSG OE7",56,0) | |
| 10128 | .S:'$D(PS JDGCK) PSG DRG=+Y,PSG DRGN=Y(0,0 ) | |
| 10129 | "RTN","PSG OE7",57,0) | |
| 10130 | .S:$D(PSJ DGCK)&'$D( PSGDGCKF) PSGDRG=+Y, PSGDRGN=Y( 0,0) | |
| 10131 | "RTN","PSG OE7",58,0) | |
| 10132 | .S:$D(PSJ DGCK)&$D(P SGDGCKF) P SGDRG=$P($ $DGCKIEN^P SJDGCK()," ;",2),PSGD RGN=$$GET1 ^DIQ(50,PS GDRG,.01) | |
| 10133 | "RTN","PSG OE7",59,0) | |
| 10134 | .D DIN^PS JDIN(+$$GE T1^DIQ(50, PSGDRG,2.1 ,"I"),PSGD RG) | |
| 10135 | "RTN","PSG OE7",60,0) | |
| 10136 | .I '$D(PS JDGCK) I $ P(Y(0),"^" ,9) D NF S :Y>0 PSGDR G=+Y(0),PS GDRGN=Y(0, 0) D SNFM | |
| 10137 | "RTN","PSG OE7",61,0) | |
| 10138 | .I $D(PSJ DGCK)&'$D( PSGDGCKF) I $P(Y(0), "^",9) D N F S:Y>0 PS GDRG=+Y(0) ,PSGDRGN=Y (0,0) D SN FM | |
| 10139 | "RTN","PSG OE7",62,0) | |
| 10140 | .S PSGPDR G=+$$GET1^ DIQ(50,PSG DRG,2.1,"I "),PSGPDRG N=$$OINAME ^PSJLMUTL( PSGPDRG) | |
| 10141 | "RTN","PSG OE7",63,0) | |
| 10142 | I '$D(PSJ DGCK) S PS GPDRG=+Y,P SGPDRGN=$$ OINAME^PSJ LMUTL(PSGP DRG) | |
| 10143 | "RTN","PSG OE7",64,0) | |
| 10144 | I $D(PSJD GCK)&'$D(P SGDGCKF) S PSGPDRG=+ Y,PSGPDRGN =$$OINAME^ PSJLMUTL(P SGPDRG) | |
| 10145 | "RTN","PSG OE7",65,0) | |
| 10146 | D LIST^DI C(50,,.01, "I",,,PSGP DRG,"ASP", ,,"ARRAY") I +ARRAY( "DILIST",0 )=1 S (X,P SGDRG)=ARR AY("DILIST ",2,1),PSG DRGN=$$END DN^PSGMI(X ) | |
| 10147 | "RTN","PSG OE7",66,0) | |
| 10148 | ; | |
| 10149 | "RTN","PSG OE7",67,0) | |
| 10150 | DO ; dosag e ordered | |
| 10151 | "RTN","PSG OE7",68,0) | |
| 10152 | NEW PSJAL LGY,PSGFLG ,ANQX ;; NCC Remedi ation 317/ 327 interg ation. RJ S-327 | |
| 10153 | "RTN","PSG OE7",69,0) | |
| 10154 | S PSGNEDF D=$$GTNEDF D("U",PSGP DRG) | |
| 10155 | "RTN","PSG OE7",70,0) | |
| 10156 | ; -- if P SGDGCKF is set, CK a ction is b eing used and no DRU G was ente red, do no t set PSJA LLGY array | |
| 10157 | "RTN","PSG OE7",71,0) | |
| 10158 | I $G(PSGD RG),$P(PSJ SYSU,";",4 ) D G:$G( PSGORQF) A D | |
| 10159 | "RTN","PSG OE7",72,0) | |
| 10160 | .S:'$G(PS GDGCKF) PS JALLGY(PSG DRG)=$S($G (PSGUSRX)= ""&($G(PSG DRG)):"",1 :"P") | |
| 10161 | "RTN","PSG OE7",73,0) | |
| 10162 | .D ENDDC^ PSGSICHK(P SGP,PSGDRG ) | |
| 10163 | "RTN","PSG OE7",74,0) | |
| 10164 | ;;START N CC T4 MODS >> 327*RJ S | |
| 10165 | "RTN","PSG OE7",75,0) | |
| 10166 | I $P(PSJS YSU,";",4) ,$$GET1^DI Q(50,+$G(P SGDRG),17. 5)="PSOCLO 1" D G:$G (ANQX) AD | |
| 10167 | "RTN","PSG OE7",76,0) | |
| 10168 | .D ^PSOCL O1 | |
| 10169 | "RTN","PSG OE7",77,0) | |
| 10170 | I '$P(PSJ SYSU,";",4 ) D G:$G( ANQX) AD S PSGX=PSGP DRG D END^ PSGSICHK G :Y<0 AD | |
| 10171 | "RTN","PSG OE7",78,0) | |
| 10172 | .N ARRAY D LIST^DIC (50,,.01," I",,,PSGPD RG,"ASP",, ,"ARRAY") | |
| 10173 | "RTN","PSG OE7",79,0) | |
| 10174 | .N I F I= 1:1 Q:'$D( ARRAY("DIL IST",2,I)) S PSGDRG =ARRAY("DI LIST",2,I) D:PSGDRG Q:$G(PSGF LG) | |
| 10175 | "RTN","PSG OE7",80,0) | |
| 10176 | ..I $$GET 1^DIQ(50,P SGDRG,17.5 )="PSOCLO1 " D ^PSOCL O1 S PSGFL G=1 | |
| 10177 | "RTN","PSG OE7",81,0) | |
| 10178 | ;; END NC C T4 MODS << 327*RJS | |
| 10179 | "RTN","PSG OE7",82,0) | |
| 10180 | S PSGDO=" " | |
| 10181 | "RTN","PSG OE7",83,0) | |
| 10182 | ; | |
| 10183 | "RTN","PSG OE7",84,0) | |
| 10184 | DONE ; | |
| 10185 | "RTN","PSG OE7",85,0) | |
| 10186 | K DIC,%,% Y,PSGDICS, PSJLUAPP,Q 1,Q2,Q3,Z, PSJALLGY,P SGUSRX Q | |
| 10187 | "RTN","PSG OE7",86,0) | |
| 10188 | ; | |
| 10189 | "RTN","PSG OE7",87,0) | |
| 10190 | NF ; | |
| 10191 | "RTN","PSG OE7",88,0) | |
| 10192 | S Y=0 W $ C(7),!!,"P LEASE NOTE : The sele cted item is not cur rently on your medic al center' s",!?13,"f ormulary." Q:'$P(PSJ SYSU,";",2 ) | |
| 10193 | "RTN","PSG OE7",89,0) | |
| 10194 | N CNT S C NT=0 F Q1= 0:0 S Q1=$ O(^PSDRUG( PSGDRG,65, Q1)) Q:'Q1 I $$CHKD RG(+$G(^(Q 1,0))) S C NT=CNT+1 | |
| 10195 | "RTN","PSG OE7",90,0) | |
| 10196 | I CNT=0 W !!,"There are no fo rmulary al ternatives entered f or this it em." W:PSJ SYSU>2 " You should consult", !,"with yo ur pharmac y before o rdering th is item." S Y=0 Q | |
| 10197 | "RTN","PSG OE7",91,0) | |
| 10198 | I CNT=1 S Q1=$O(^PS DRUG(PSGDR G,65,0)),Q 1=+$G(^(Q1 ,0)),Q3=$P (^PSDRUG(Q 1,0),"^") W !!,Q3," has been e ntered as a formular y " W:$X>6 7 ! W "alt ernative." | |
| 10199 | "RTN","PSG OE7",92,0) | |
| 10200 | I F Q=1: 1 S %=2 W !!,"Is ",$ S(Q=1:"thi s",1:Q3)," acceptabl e" D YN^DI CN Q:% D NFOH | |
| 10201 | "RTN","PSG OE7",93,0) | |
| 10202 | I CNT=1 S :%=1 (Y(0) ,Y)=Q1,Y(0 ,0)=Q3 S:% <0 Y=-1 Q | |
| 10203 | "RTN","PSG OE7",94,0) | |
| 10204 | K DA,DIC S DA(1)=PS GDRG,DIC=" ^PSDRUG("_ PSGDRG_",6 5,",DIC(0) ="AEMQZ",D IC("A")="S elect FORM ULARY ALTE RNATIVE: " W ! D ^DI C K DIC Q | |
| 10205 | "RTN","PSG OE7",95,0) | |
| 10206 | ; | |
| 10207 | "RTN","PSG OE7",96,0) | |
| 10208 | NFOH ; | |
| 10209 | "RTN","PSG OE7",97,0) | |
| 10210 | S X="Answ er 'YES' t o order th is formula ry alterna tive ("_Q3 _") for th e patient instead of the non-f ormulary i tem origin ally selec ted. Answ er 'NO' to use the d rug origin ally selec ted." | |
| 10211 | "RTN","PSG OE7",98,0) | |
| 10212 | W !!?2 F Y=1:1:$L(X ," ") S Z= $P(X," ",Y ) W:$L(Z)+ $X+2>IOM ! W Z," " | |
| 10213 | "RTN","PSG OE7",99,0) | |
| 10214 | Q | |
| 10215 | "RTN","PSG OE7",100,0 ) | |
| 10216 | CHKDRG(DRG ) ; Determ ine if dis pense drug is valid for Unit D ose. | |
| 10217 | "RTN","PSG OE7",101,0 ) | |
| 10218 | I $D(^PSD RUG(DRG,0) ),$P($G(^( 2)),U,3)[" U" S X=+$G (^("I")) I 'X!(X>DT) Q DRG | |
| 10219 | "RTN","PSG OE7",102,0 ) | |
| 10220 | Q 0 | |
| 10221 | "RTN","PSG OE7",103,0 ) | |
| 10222 | ; | |
| 10223 | "RTN","PSG OE7",104,0 ) | |
| 10224 | SNFM ; sho w non-form ulary mess age | |
| 10225 | "RTN","PSG OE7",105,0 ) | |
| 10226 | S Y=1 Q:P SJSYSU=3!' $O(^PS(59. 7,1,21,0)) W $C(7), ! S Q=0 F S Q=$O(^P S(59.7,1,2 1,Q)) Q:'Q W !,$G(^ (Q,0)) | |
| 10227 | "RTN","PSG OE7",106,0 ) | |
| 10228 | W ! D REA D^PSJUTL S Y=1 Q | |
| 10229 | "RTN","PSG OE7",107,0 ) | |
| 10230 | ; | |
| 10231 | "RTN","PSG OE7",108,0 ) | |
| 10232 | GTNEDFD(AP P,PDRG) ; Find defau lts from O rderable I tem. | |
| 10233 | "RTN","PSG OE7",109,0 ) | |
| 10234 | Q $P($G(^ PS(50.7,+P DRG,0)),"^ ",5,8) | |
| 10235 | "RTN","PSG OE7",110,0 ) | |
| 10236 | N Q,X S X ="" | |
| 10237 | "RTN","PSG OE7",111,0 ) | |
| 10238 | F Q=1:1:$ L(APP) S X =$E(APP,Q) Q:X="" S X=$O(^PS( 50.3,+PDRG ,1,"B",X,0 )) I X S X =$P($G(^PS (50.3,+PDR G,1,X,0)), "^",5,8) Q | |
| 10239 | "RTN","PSG OE7",112,0 ) | |
| 10240 | Q X | |
| 10241 | "RTN","PSG OE7",113,0 ) | |
| 10242 | ; | |
| 10243 | "RTN","PSG OE7",114,0 ) | |
| 10244 | PKGFLG(PKF ) ;Return 0 for not in range o f acceptab le package flags, 1 for within range | |
| 10245 | "RTN","PSG OE7",115,0 ) | |
| 10246 | I $S(PKF[ "U":1,1:0) Q 1 | |
| 10247 | "RTN","PSG OE7",116,0 ) | |
| 10248 | I $S(PKF[ "I":1,1:0) Q 1 | |
| 10249 | "RTN","PSG OE7",117,0 ) | |
| 10250 | Q 0 | |
| 10251 | "RTN","PSG OE7",118,0 ) | |
| 10252 | ; | |
| 10253 | "RTN","PSG OE7",119,0 ) | |
| 10254 | GCN(PSGIEN ID) ;Retur n 0 for no t matched, 1 for mat ched with no GCNSEQN O, 1^1 for matched w ith a GCNS EQNO | |
| 10255 | "RTN","PSG OE7",120,0 ) | |
| 10256 | N PSGNDFI D,PSGGCNPT ,PSGGCNID | |
| 10257 | "RTN","PSG OE7",121,0 ) | |
| 10258 | S PSGNDFI D=$P($G(^P SDRUG(PSGI ENID,"ND") ),"^"),PSG GCNPT=$P($ G(^PSDRUG( PSGIENID," ND")),"^", 3) | |
| 10259 | "RTN","PSG OE7",122,0 ) | |
| 10260 | I 'PSGNDF ID!('PSGGC NPT) Q 0 | |
| 10261 | "RTN","PSG OE7",123,0 ) | |
| 10262 | S PSGGCNI D=$$PROD0^ PSNAPIS(PS GNDFID,PSG GCNPT) | |
| 10263 | "RTN","PSG OE7",124,0 ) | |
| 10264 | I $P(PSGG CNID,"^",7 ) Q PSGIEN ID_";"_PSG NDFID_";"_ $P(PSGGCNI D,"^",7) | |
| 10265 | "RTN","PSG OE7",125,0 ) | |
| 10266 | Q PSGIENI D_";"_PSGN DFID | |
| 10267 | "RTN","PSG OE8") | |
| 10268 | 0^15^B5894 3110 | |
| 10269 | "RTN","PSG OE8",1,0) | |
| 10270 | PSGOE8 ;BI R/CML3-EDI T ORDERS I N 53.1 ;Ju l 26, 2017 @18:04:02 | |
| 10271 | "RTN","PSG OE8",2,0) | |
| 10272 | ;;5.0;INP ATIENT MED ICATIONS ; **47,50,65 ,72,110,11 1,188,192, 113,223,26 9,287,315, 327**;16 D EC 97;Buil d 64 | |
| 10273 | "RTN","PSG OE8",3,0) | |
| 10274 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 10275 | "RTN","PSG OE8",4,0) | |
| 10276 | ; Referen ce to ^PS( 50.7 is su pported by DBIA# 218 0 | |
| 10277 | "RTN","PSG OE8",5,0) | |
| 10278 | ; Referen ce to ^PS( 51.1 is su pported by DBIA 2177 | |
| 10279 | "RTN","PSG OE8",6,0) | |
| 10280 | ; Referen ce to ^PS( 51.2 is su pported by DBIA# 217 8 | |
| 10281 | "RTN","PSG OE8",7,0) | |
| 10282 | ; Referen ce to ^PSD RUG is sup ported by DBIA# 2192 | |
| 10283 | "RTN","PSG OE8",8,0) | |
| 10284 | ; | |
| 10285 | "RTN","PSG OE8",9,0) | |
| 10286 | 101 ;Order able Item | |
| 10287 | "RTN","PSG OE8",10,0) | |
| 10288 | S MSG=0,F 2=101,PSGO OPD=PSGPD, PSGOOPDN=P SGPDN S:PS GOEEF(F2) BACK="101^ PSGOE8" | |
| 10289 | "RTN","PSG OE8",11,0) | |
| 10290 | S %=1 I $ P(PSJSYSU, ";",3)>1 W !!,$C(7), "WARNING! If you ch ange the d rug of an order, the Dosage Or dered and Dispense", !,"Drug(s) are delet ed." F W !,"Do you wish to co ntinue" S %=2 D YN^D ICN Q:% | |
| 10291 | "RTN","PSG OE8",12,0) | |
| 10292 | I %'=1 G DONE | |
| 10293 | "RTN","PSG OE8",13,0) | |
| 10294 | A101 ; | |
| 10295 | "RTN","PSG OE8",14,0) | |
| 10296 | I $$PNDRE N($G(PSGOR D)) D Q | |
| 10297 | "RTN","PSG OE8",15,0) | |
| 10298 | . W !!?5, "Orderable Item may not be edi ted at thi s point." D PAUSE^VA LM1 | |
| 10299 | "RTN","PSG OE8",16,0) | |
| 10300 | W !,"ORDE RABLE ITEM : ",$S(PSG PD:PSGPDN_ "// ",1:"" ) R X:DTIM E I X="^"! '$T W:'$T $C(7) S PS GOEE=0 G D ONE | |
| 10301 | "RTN","PSG OE8",17,0) | |
| 10302 | ;; START NCC T4 MOD S >> 327*R JS | |
| 10303 | "RTN","PSG OE8",18,0) | |
| 10304 | A201 I X=" ",PSGPD S X=PSGPDN I PSGPD'=PS GPDN,$L($$ GET1^DIQ(5 0.7,PSGPD, .01)) G:'$ G(ANQX) DO NE | |
| 10305 | "RTN","PSG OE8",19,0) | |
| 10306 | S PSGPDOL D=PSGPD,PS GPDNOLD=PS GPDN,PSGPD RGOLD=PSGP DRG | |
| 10307 | "RTN","PSG OE8",20,0) | |
| 10308 | ;; END NC C T4 MODS >> 327*RJS | |
| 10309 | "RTN","PSG OE8",21,0) | |
| 10310 | I X="",PS GPD S X=PS GPDN I PSG PD'=PSGPDN ,$L($$GET1 ^DIQ(50.7, PSGPD,.01) ) G DONE | |
| 10311 | "RTN","PSG OE8",22,0) | |
| 10312 | I $S(X="@ ":1,X]"":0 ,1:'PSGPD) W $C(7)," (Require d)" S X="? " D ENHLP^ PSGOEM(53. 1,101) G A 101 | |
| 10313 | "RTN","PSG OE8",23,0) | |
| 10314 | I X?1."?" D ENHLP^P SGOEM(53.1 ,101) | |
| 10315 | "RTN","PSG OE8",24,0) | |
| 10316 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 101 | |
| 10317 | "RTN","PSG OE8",25,0) | |
| 10318 | ;BHW;PSJ* 5.0*192;Mo dify ^DIC call to us e MIX^DIC and only B /C cross-r eferences | |
| 10319 | "RTN","PSG OE8",26,0) | |
| 10320 | K DIC,D S DIC="^PS( 50.7,",DIC (0)="EMQZ" ,DIC("S")= "I $$ENOIS C^PSJUTL(Y ,""U"")",D ="B^C" D M IX^DIC1 K DIC,D I Y' >0 G A101 | |
| 10321 | "RTN","PSG OE8",27,0) | |
| 10322 | F S %=2 D DH,YN^DI CN Q:% | |
| 10323 | "RTN","PSG OE8",28,0) | |
| 10324 | I %'=1 G A101 | |
| 10325 | "RTN","PSG OE8",29,0) | |
| 10326 | S (PSGPDR G,PSGPD)=+ Y,(PSGPDN, PSGPDRGN)= $$OINAME^P SJLMUTL(PS GPDRG) | |
| 10327 | "RTN","PSG OE8",30,0) | |
| 10328 | S PSGNEDF D=$$GTNEDF D^PSGOE7(" U",PSGPDRG ) | |
| 10329 | "RTN","PSG OE8",31,0) | |
| 10330 | S PSGPDNX =1,PSGDO=" ",(PSGPDRG ,PSGPD)=+Y ,(PSGPDN,P SGPDRGN)=$ $OINAME^PS JLMUTL(PSG PDRG) K ^P S(53.45,PS JSYSP,2) S X=$O(^PSD RUG("ASP", PSGPD,0)) I X,'$O(^( X)) D | |
| 10331 | "RTN","PSG OE8",32,0) | |
| 10332 | .S ^PS(53 .45,PSJSYS P,2,0)="^5 3.4502P^1^ 1",^(1,0)= X,^PS(53.4 5,PSJSYSP, 2,"B",X,1) ="" | |
| 10333 | "RTN","PSG OE8",33,0) | |
| 10334 | S PSGDRGT MP=X | |
| 10335 | "RTN","PSG OE8",34,0) | |
| 10336 | D ENDRG^P SGOEF1(PSG PD,0) | |
| 10337 | "RTN","PSG OE8",35,0) | |
| 10338 | ;; START NCC T4 MOD S >> 327*R JS | |
| 10339 | "RTN","PSG OE8",36,0) | |
| 10340 | I $$GET1^ DIQ(50,+$G (PSGDRGTMP ),17.5)="P SOCLO1" D I $G(ANQX ) K ANQX G A201 | |
| 10341 | "RTN","PSG OE8",37,0) | |
| 10342 | .S ANQX=0 D CLOZ^PS JCLOZ(DFN, PSGDRGTMP) | |
| 10343 | "RTN","PSG OE8",38,0) | |
| 10344 | .I $G(ANQ X) W ! S X =$E(PSGPDN OLD,0,4),P SGPDN=PSGP DNOLD,PSGP D=PSGPDOLD ,PSGPDRG=P SGPDRGOLD K PSGDRGTM P,PSGPDOLD ,PSGPDNOLD ,PSGPDRGOL D | |
| 10345 | "RTN","PSG OE8",39,0) | |
| 10346 | ;; END NC C T4 MODS >> 327*RJS | |
| 10347 | "RTN","PSG OE8",40,0) | |
| 10348 | G DONE | |
| 10349 | "RTN","PSG OE8",41,0) | |
| 10350 | ; | |
| 10351 | "RTN","PSG OE8",42,0) | |
| 10352 | 109 ; dosa ge ordered | |
| 10353 | "RTN","PSG OE8",43,0) | |
| 10354 | S MSG=0,F 2=109 S:PS GOEEF(F2) BACK="109^ PSGOE8" | |
| 10355 | "RTN","PSG OE8",44,0) | |
| 10356 | A109 ; | |
| 10357 | "RTN","PSG OE8",45,0) | |
| 10358 | I $$PNDRE N($G(PSGOR D)) D Q | |
| 10359 | "RTN","PSG OE8",46,0) | |
| 10360 | . W !!?5, "Dosage ma y not be e dited at t his point. " D PAUSE^ VALM1 | |
| 10361 | "RTN","PSG OE8",47,0) | |
| 10362 | S PSGOEEF (F2)=PSGOE E | |
| 10363 | "RTN","PSG OE8",48,0) | |
| 10364 | D EDITDOS E^PSJDOSE S X=PSGDO G DONE | |
| 10365 | "RTN","PSG OE8",49,0) | |
| 10366 | W !,"DOSA GE ORDERED : ",$S(PSG DO]"":PSGD O_"// ",1: "") R X:DT IME I X="^ "!'$T W:'$ T $C(7) S PSGOEE=0 G DONE | |
| 10367 | "RTN","PSG OE8",50,0) | |
| 10368 | I X=""&(P SGDO]"") S X=PSGDO | |
| 10369 | "RTN","PSG OE8",51,0) | |
| 10370 | I $$CHECK (PSJSYSP)& (X="")&(PS GDO']"") W $C(7)," (Require d) " G A10 9 | |
| 10371 | "RTN","PSG OE8",52,0) | |
| 10372 | I $$CHECK (PSJSYSP)& (X="@") W $C(7)," (Requir ed) " G A1 09 | |
| 10373 | "RTN","PSG OE8",53,0) | |
| 10374 | I '$$CHEC K(PSJSYSP) &(X="@") S PSGDO="" G DONE | |
| 10375 | "RTN","PSG OE8",54,0) | |
| 10376 | I X?1."?" D ENHLP^P SGOEM(53.1 ,109) G A1 09 | |
| 10377 | "RTN","PSG OE8",55,0) | |
| 10378 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 109 | |
| 10379 | "RTN","PSG OE8",56,0) | |
| 10380 | I $E(X,$L (X))=" " F S X=$E(X ,1,$L(X)-1 ) Q:$E(X,$ L(X))'=" " | |
| 10381 | "RTN","PSG OE8",57,0) | |
| 10382 | I $S(X?.E 1C.E:1,$L( X)>20:1,X= "":0,X["^" :1,X?1.P:1 ,1:X=+X) W $C(7)," ",$S(X?1.P !(X=""):"( Required)" ,1:"??") D ENHLP^PSG OEM(53.1,1 09) G A109 | |
| 10383 | "RTN","PSG OE8",58,0) | |
| 10384 | S PSGDO=X G DONE | |
| 10385 | "RTN","PSG OE8",59,0) | |
| 10386 | ; | |
| 10387 | "RTN","PSG OE8",60,0) | |
| 10388 | 3 ; med ro ute | |
| 10389 | "RTN","PSG OE8",61,0) | |
| 10390 | S MSG=0,F 2=3 S:PSGO EEF(F2) BA CK="3^PSGO E8" | |
| 10391 | "RTN","PSG OE8",62,0) | |
| 10392 | A3 I $$PND REN($G(PSG ORD)) D Q | |
| 10393 | "RTN","PSG OE8",63,0) | |
| 10394 | . W !!?5, "Med Route may not b e edited a t this poi nt." D PAU SE^VALM1 | |
| 10395 | "RTN","PSG OE8",64,0) | |
| 10396 | W !,"MED ROUTE: ",$ S(PSGMR:PS GMRN_"// " ,1:"") R X :DTIME I X ="^"!'$T W :'$T $C(7) S PSGOEE= 0 G DONE | |
| 10397 | "RTN","PSG OE8",65,0) | |
| 10398 | I X="",PS GMR S X=PS GMRN I PSG MR'=PSGMRN ,$L($$GET1 ^DIQ(51.2, PSGMR,.01) ) W " "_$ $GET1^DIQ( 51.2,PSGMR ,1) G DONE | |
| 10399 | "RTN","PSG OE8",66,0) | |
| 10400 | I $S(X="@ ":1,X]"":0 ,1:'PSGMR) W $C(7)," (Require d)" S X="? " D ENHLP^ PSGOEM(53. 1,3) G A3 | |
| 10401 | "RTN","PSG OE8",67,0) | |
| 10402 | I X?1."?" D ENHLP^P SGOEM(53.1 ,3) | |
| 10403 | "RTN","PSG OE8",68,0) | |
| 10404 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 3 | |
| 10405 | "RTN","PSG OE8",69,0) | |
| 10406 | K DIC S D IC="^PS(51 .2,",DIC(0 )="EMQZ",D IC("S")="I $P(^(0)," "^"",4)" D ^DIC K DI C I Y'>0 G A3 | |
| 10407 | "RTN","PSG OE8",70,0) | |
| 10408 | S PSGMR=+ Y,PSGMRN=Y (0,0) G DO NE | |
| 10409 | "RTN","PSG OE8",71,0) | |
| 10410 | ; | |
| 10411 | "RTN","PSG OE8",72,0) | |
| 10412 | 26 ; sched ule | |
| 10413 | "RTN","PSG OE8",73,0) | |
| 10414 | S MSG=0,F 2=26 S:PSG OEEF(F2) B ACK="26^PS GOE8" | |
| 10415 | "RTN","PSG OE8",74,0) | |
| 10416 | A26 I $$PN DREN($G(PS GORD)) D Q | |
| 10417 | "RTN","PSG OE8",75,0) | |
| 10418 | . W !!?5, "Schedule may not be edited at this poin t." D PAUS E^VALM1 | |
| 10419 | "RTN","PSG OE8",76,0) | |
| 10420 | W !,"SCHE DULE: ",$S (PSGSCH]"" :PSGSCH_"/ / ",1:"") R X:DTIME I X="^"!'$ T W:'$T $C (7) S PSGO EE=0 G DON E | |
| 10421 | "RTN","PSG OE8",77,0) | |
| 10422 | S:X="" X= PSGSCH,PSG SCH="" I " @"[X W $C( 7)," (Req uired)" S X="?" D EN HLP^PSGOEM (53.1,26) G A26 | |
| 10423 | "RTN","PSG OE8",78,0) | |
| 10424 | S DOW=0 I $$DOW^PSI VUTL($$ENL U^PSGMI(X) ) S DOW=1 | |
| 10425 | "RTN","PSG OE8",79,0) | |
| 10426 | I X?1."?" D ENHLP^P SGOEM(53.1 ,26) G A26 | |
| 10427 | "RTN","PSG OE8",80,0) | |
| 10428 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 26 | |
| 10429 | "RTN","PSG OE8",81,0) | |
| 10430 | ;BHW;PSJ* 5*188;Add flag and I EN return variable f or PSGS0 ( PSJ*5*134) , Highligh t Admin Ti mes if the y changed. | |
| 10431 | "RTN","PSG OE8",82,0) | |
| 10432 | N PSGOES, PSJSLUP,PS GSFLG S PS JSLUP=1,PS GSFLG=1 D EN^PSGS0 I '$D(X) W $C(7)," ? ?" S X="?" D ENHLP^P SGOEM(53.1 ,26) G A26 | |
| 10433 | "RTN","PSG OE8",83,0) | |
| 10434 | I X'=PSGS CH D | |
| 10435 | "RTN","PSG OE8",84,0) | |
| 10436 | . K PSGDU R,PSGRMVT, PSGRMV,ND2 P1 ;*315 R emoval tim es are tie d to ADMIN times. | |
| 10437 | "RTN","PSG OE8",85,0) | |
| 10438 | . N XX | |
| 10439 | "RTN","PSG OE8",86,0) | |
| 10440 | . S PSGSC H=X | |
| 10441 | "RTN","PSG OE8",87,0) | |
| 10442 | . I PSGS0 Y'=PSGAT S PSGAT=PSG S0Y ;Chan ge so that any sched ule change will adju st the typ e and defa ult the ad min times - DRF | |
| 10443 | "RTN","PSG OE8",88,0) | |
| 10444 | . D ;Cha nge schedu le type to agree wit h schedule | |
| 10445 | "RTN","PSG OE8",89,0) | |
| 10446 | .. I $G(D OW) S PSGS T="C",PSGS TN=$$ENSTN ^PSGMI(PSG ST) Q | |
| 10447 | "RTN","PSG OE8",90,0) | |
| 10448 | .. I (PSG SCH[" PRN" )!(PSGSCH= "PRN") I $ $PRNOK^PSG S0(PSGSCH) S PSGOST= PSGST,PSGS T="P",PSGS TN=$$ENSTN ^PSGMI(PSG ST) Q | |
| 10449 | "RTN","PSG OE8",91,0) | |
| 10450 | .. I '$G( PSGSCIEN), PSGSCH]"" S XX=$$FIN D1^DIC(51. 1,,"X",PSG SCH),PSGSC IEN=XX | |
| 10451 | "RTN","PSG OE8",92,0) | |
| 10452 | .. S PSGO ST=$G(PSGS T),PSGST=$ $GET1^DIQ( 51.1,PSGSC IEN,5,"I") I PSGST=" D" S PSGST ="C" ;DOW schedules are conve rted to Co ntinuous | |
| 10453 | "RTN","PSG OE8",93,0) | |
| 10454 | .. S PSGS TN=$$ENSTN ^PSGMI(PSG ST) | |
| 10455 | "RTN","PSG OE8",94,0) | |
| 10456 | . I $G(PS JSYSW0),($ P(PSJSYSW0 ,U,5)'=2), '$G(PSGEFN (8)) W !!, "NOTE: Thi s may caus e the Admi n Times an d the Star t Time to be out of sync." | |
| 10457 | "RTN","PSG OE8",95,0) | |
| 10458 | . W !!,"N OTE: This change in schedule a lso change s the ADMI N TIMES an d SCHEDULE TYPE.",! | |
| 10459 | "RTN","PSG OE8",96,0) | |
| 10460 | . S MSG=1 S:'$G(PSG OEEF(39)) PSGOEEF(39 )=1 ;*287 - Prevent infinite l oop editin g admin ti mes | |
| 10461 | "RTN","PSG OE8",97,0) | |
| 10462 | . I ($G(P SGRF)>1),P SGST="C" D | |
| 10463 | "RTN","PSG OE8",98,0) | |
| 10464 | ..S PSGF2 =39,BACK=" 39^PSGOE81 " D 39^PSG OE81 S BAC K="26^PSGO E8",PSGF2= 26,PSGOAT= PSGAT ;*31 5 Prompt f or Admin t o get DOA | |
| 10465 | "RTN","PSG OE8",99,0) | |
| 10466 | ..Q | |
| 10467 | "RTN","PSG OE8",100,0 ) | |
| 10468 | . I $G(PS JNEWOE) D PAUSE^VALM 1 | |
| 10469 | "RTN","PSG OE8",101,0 ) | |
| 10470 | I PSGST=" O" S PSGOE EF(7)=1 I +$G(PSGRF) S PSGOEEF (25)=1 D 2 5^PSGOE81 S PSGF2=26 | |
| 10471 | "RTN","PSG OE8",102,0 ) | |
| 10472 | G DONE | |
| 10473 | "RTN","PSG OE8",103,0 ) | |
| 10474 | ; | |
| 10475 | "RTN","PSG OE8",104,0 ) | |
| 10476 | 7 ; schedu le type | |
| 10477 | "RTN","PSG OE8",105,0 ) | |
| 10478 | S MSG=0,F 2=7 S:PSGO EEF(F2) BA CK="7^PSGO E8" | |
| 10479 | "RTN","PSG OE8",106,0 ) | |
| 10480 | A7 W !,"SC HEDULE TYP E: "_$S(PS GSTN]"":PS GSTN_"// " ,1:"") R X :DTIME S X =$TR(X,"co procf","CO PROCF") I X="^"!'$T S PSGOEE=0 W $C(7) G DONE | |
| 10481 | "RTN","PSG OE8",107,0 ) | |
| 10482 | I X="" S X=PSGST,PS GSTN=$$ENS TN^PSGMI(X ) W:PSGSTN ]"" " ",P SGSTN G DO NE | |
| 10483 | "RTN","PSG OE8",108,0 ) | |
| 10484 | S:X="F" X ="R" | |
| 10485 | "RTN","PSG OE8",109,0 ) | |
| 10486 | I ",?,??, C,O,OC,P,R ,"'[(","_X _",") W " ??" G A7 | |
| 10487 | "RTN","PSG OE8",110,0 ) | |
| 10488 | I $$PRNOK ^PSGS0($G( PSGSCH)),X ="C" W " ??" G A7 | |
| 10489 | "RTN","PSG OE8",111,0 ) | |
| 10490 | I X="@"!( X?1."?") W :X="@" $C( 7)," (Req uired)" S: X="@" X="? " D ENHLP^ PSGOEM(53. 1,7) G A7 | |
| 10491 | "RTN","PSG OE8",112,0 ) | |
| 10492 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 7 | |
| 10493 | "RTN","PSG OE8",113,0 ) | |
| 10494 | ;*223 Don 't allow O sched typ e on C ord ers | |
| 10495 | "RTN","PSG OE8",114,0 ) | |
| 10496 | I X="O",$ $SCHTP(PSG SCH)'="O" W !," SCH EDULE ("_P SGSCH_") i s not a ON E TIME Sch edule." G A7 | |
| 10497 | "RTN","PSG OE8",115,0 ) | |
| 10498 | ;*269 Don 't allow C sched typ e on O ord ers | |
| 10499 | "RTN","PSG OE8",116,0 ) | |
| 10500 | I X="C",$ $SCHTP(PSG SCH)="O" W !," SCHE DULE ("_PS GSCH_") is not a CON TINUOUS Sc hedule." G A7 | |
| 10501 | "RTN","PSG OE8",117,0 ) | |
| 10502 | S PSGOST= PSGST | |
| 10503 | "RTN","PSG OE8",118,0 ) | |
| 10504 | S PSGST=X ,PSGSTN=$$ ENSTN^PSGM I(X) W:PSG STN]"" " ",PSGSTN | |
| 10505 | "RTN","PSG OE8",119,0 ) | |
| 10506 | I X="P",$ G(PSGAT)]" " S PSGOAT =PSGAT S P SGAT="" D | |
| 10507 | "RTN","PSG OE8",120,0 ) | |
| 10508 | .W !!,"NO TE: This c hange in s chedule ty pe also ch anges the ADMIN TIME S.",! | |
| 10509 | "RTN","PSG OE8",121,0 ) | |
| 10510 | .S MSG=1, PSGOEEF(39 )=1 | |
| 10511 | "RTN","PSG OE8",122,0 ) | |
| 10512 | .I $G(PSJ NEWOE) D P AUSE^VALM1 | |
| 10513 | "RTN","PSG OE8",123,0 ) | |
| 10514 | ; | |
| 10515 | "RTN","PSG OE8",124,0 ) | |
| 10516 | DONE ; | |
| 10517 | "RTN","PSG OE8",125,0 ) | |
| 10518 | I PSGOEE G:'PSGOEEF (F2) @BACK S PSGOEE= PSGOEEF(F2 ) | |
| 10519 | "RTN","PSG OE8",126,0 ) | |
| 10520 | K F,F0,F2 Q | |
| 10521 | "RTN","PSG OE8",127,0 ) | |
| 10522 | ; | |
| 10523 | "RTN","PSG OE8",128,0 ) | |
| 10524 | DEL ; dele te entry | |
| 10525 | "RTN","PSG OE8",129,0 ) | |
| 10526 | W !?3,"SU RE YOU WAN T TO DELET E" S %=0 D YN^DICN I %'=1 W $C (7)," <NO THING DELE TED>" | |
| 10527 | "RTN","PSG OE8",130,0 ) | |
| 10528 | Q | |
| 10529 | "RTN","PSG OE8",131,0 ) | |
| 10530 | ; | |
| 10531 | "RTN","PSG OE8",132,0 ) | |
| 10532 | DH ; | |
| 10533 | "RTN","PSG OE8",133,0 ) | |
| 10534 | W !!?2,"W hen the dr ug of an o rder is ch anged, the Dosage Or dered and Dispense D rug(s)",!, "for the o rder are n o longer v alid, and therefore deleted fr om the ord er.",!,"If possible, a new cor responding dispense drug will be added t o the orde r." | |
| 10535 | "RTN","PSG OE8",134,0 ) | |
| 10536 | W !!?2,"A nswer 'YES ' to conti nue with t his change . Answer 'NO' to se lect anoth er",!,"dru g or to ac cept the d rug as it was. Ente r an '^' t he exit th is edit." Q | |
| 10537 | "RTN","PSG OE8",135,0 ) | |
| 10538 | ; | |
| 10539 | "RTN","PSG OE8",136,0 ) | |
| 10540 | CHECK(PSJS YSP) ; Che ck to see if multipl e dispense drugs | |
| 10541 | "RTN","PSG OE8",137,0 ) | |
| 10542 | ; Input - PSJS YSP | |
| 10543 | "RTN","PSG OE8",138,0 ) | |
| 10544 | ; Returns 0 = only one. | |
| 10545 | "RTN","PSG OE8",139,0 ) | |
| 10546 | ; 1 = more than one | |
| 10547 | "RTN","PSG OE8",140,0 ) | |
| 10548 | ; Checks Inactive D ate and do esn't coun t if < or = today. | |
| 10549 | "RTN","PSG OE8",141,0 ) | |
| 10550 | N PSJRSB, PSJINACT,P SJRBCNT S PSJRBCNT=0 | |
| 10551 | "RTN","PSG OE8",142,0 ) | |
| 10552 | F PSJRSB= 0:0 S PSJR SB=$O(^PS( 53.45,PSJS YSP,2,PSJR SB)) Q:'PS JRSB D | |
| 10553 | "RTN","PSG OE8",143,0 ) | |
| 10554 | .S PSJINA CT=$P(^PS( 53.45,PSJS YSP,2,PSJR SB,0),"^", 3) | |
| 10555 | "RTN","PSG OE8",144,0 ) | |
| 10556 | .I (PSJIN ACT="")!(( PSJINACT>0 )&(PSJINAC T>DT)) D | |
| 10557 | "RTN","PSG OE8",145,0 ) | |
| 10558 | ..S PSJRB CNT=$S('$D (PSJRBCNT) :1,1:PSJRB CNT+1) | |
| 10559 | "RTN","PSG OE8",146,0 ) | |
| 10560 | Q $S(PSJR BCNT>1:1,1 :0) | |
| 10561 | "RTN","PSG OE8",147,0 ) | |
| 10562 | ; | |
| 10563 | "RTN","PSG OE8",148,0 ) | |
| 10564 | PNDREN(PND ON) ; | |
| 10565 | "RTN","PSG OE8",149,0 ) | |
| 10566 | I PNDON'[ "P" Q 0 | |
| 10567 | "RTN","PSG OE8",150,0 ) | |
| 10568 | S RNWL="^ PS(53.1,"_ +PNDON_",0 )" S RNWL= $G(@(RNWL) ) S RNWL=$ S($P(RNWL, "^",24)="R ":1,1:0) | |
| 10569 | "RTN","PSG OE8",151,0 ) | |
| 10570 | Q RNWL | |
| 10571 | "RTN","PSG OE8",152,0 ) | |
| 10572 | ; | |
| 10573 | "RTN","PSG OE8",153,0 ) | |
| 10574 | SCHTP(SCH) ; *223 Re turn SCHed ule type | |
| 10575 | "RTN","PSG OE8",154,0 ) | |
| 10576 | N X I SCH ="" Q "" | |
| 10577 | "RTN","PSG OE8",155,0 ) | |
| 10578 | S X=$O(^P S(51.1,"AP PSJ",SCH,0 )) | |
| 10579 | "RTN","PSG OE8",156,0 ) | |
| 10580 | Q:'$G(X) "" | |
| 10581 | "RTN","PSG OE8",157,0 ) | |
| 10582 | Q $P(^PS( 51.1,X,0), "^",5) | |
| 10583 | "RTN","PSG OE8",158,0 ) | |
| 10584 | ; | |
| 10585 | "RTN","PSG OE81") | |
| 10586 | 0^16^B1526 56577 | |
| 10587 | "RTN","PSG OE81",1,0) | |
| 10588 | PSGOE81 ;B IR/CML3-NO N-VERIFIED ORDER EDI T (CONT.) ;Jul 26, 2 017@18:04: 02 | |
| 10589 | "RTN","PSG OE81",2,0) | |
| 10590 | ;;5.0;INP ATIENT MED ICATIONS;* *26,50,64, 58,82,110, 111,136,11 3,267,315, 334,327**; 16 DEC 97; Build 64 | |
| 10591 | "RTN","PSG OE81",3,0) | |
| 10592 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 10593 | "RTN","PSG OE81",4,0) | |
| 10594 | ; Referen ce to ^PS( 50.7 is su pported by DBIA# 218 0 | |
| 10595 | "RTN","PSG OE81",5,0) | |
| 10596 | ; Referen ce to ^PS( 51.1 is su pported by DBIA 2177 . | |
| 10597 | "RTN","PSG OE81",6,0) | |
| 10598 | ; | |
| 10599 | "RTN","PSG OE81",7,0) | |
| 10600 | 39 ; admin times | |
| 10601 | "RTN","PSG OE81",8,0) | |
| 10602 | N PSGDOA | |
| 10603 | "RTN","PSG OE81",9,0) | |
| 10604 | S MSG=0,P SGF2=39 S: PSGOEEF(PS GF2) BACK= "39^PSGOE8 1",ORIG=$G (PSGAT),PS GDOA=$G(PS GDUR) | |
| 10605 | "RTN","PSG OE81",10,0 ) | |
| 10606 | A39 ;*315 next 2 lin es | |
| 10607 | "RTN","PSG OE81",11,0 ) | |
| 10608 | I (PSGST= "P")!$$PRN OK^PSGS0($ G(PSGSCH)) G DONE | |
| 10609 | "RTN","PSG OE81",12,0 ) | |
| 10610 | I $$ODD^P SGS0(PSGS0 XT) D PSGD UR G DONE | |
| 10611 | "RTN","PSG OE81",13,0 ) | |
| 10612 | W !,"ADMI N TIMES: " _$S(PSGAT: PSGAT_"// ",1:"") R X:DTIME I X="^"!('$T ) W:'$T $C (7) S PSGO EE=0 S:X=" ^" (X,PSGA T)=$G(ORIG ),PSGDUR=" " G DONE ; *315 | |
| 10613 | "RTN","PSG OE81",14,0 ) | |
| 10614 | I X="" S: (($G(PSGS0 XT)="D")&' $G(PSGS0Y) ) PSGOEE=0 S:$G(PSGA T) X=PSGAT ,PSGNOHI=1 ;*315 If admin time default w as taken t hen don't highlight admin time . | |
| 10615 | "RTN","PSG OE81",15,0 ) | |
| 10616 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 39 | |
| 10617 | "RTN","PSG OE81",16,0 ) | |
| 10618 | I X=" "!( X?1."?") D ENHLP^PSG OEM(53.1,3 9) G A39 | |
| 10619 | "RTN","PSG OE81",17,0 ) | |
| 10620 | I PSGS0XT ="D"&'$G(X ) I ((",P, R,")'[("," _$G(PSGST) _",")) D G A39 | |
| 10621 | "RTN","PSG OE81",18,0 ) | |
| 10622 | .W $C(7), " ??" S X ="?" W !," This is a 'DAY OF TH E WEEK' sc hedule and MUST have admin tim es." D ENH LP^PSGOEM( 53.1,39) | |
| 10623 | "RTN","PSG OE81",19,0 ) | |
| 10624 | I X="@" D DEL G:%'= 1 A39 S PS GAT="",X=" " | |
| 10625 | "RTN","PSG OE81",20,0 ) | |
| 10626 | I $G(PSGS 0XT),'$$OD D^PSGS0(PS GS0XT),$G( PSGS0XT)'= "P",$G(PSG S0XT)'="OC ",'$$PRNOK ^PSGS0(PSG SCH),($G(P SGST)'="O" ) D TIMES G:'$D(X) A 39 D PSGDU R G:'$D(X) A39 G:$G( X)="^" DON E ;*315 | |
| 10627 | "RTN","PSG OE81",21,0 ) | |
| 10628 | I (($G(PS GST)="O")! ($G(PSGST) ="OC")),X= "" D G DO NE | |
| 10629 | "RTN","PSG OE81",22,0 ) | |
| 10630 | .S (PSGS0 Y,PSGAT)=X | |
| 10631 | "RTN","PSG OE81",23,0 ) | |
| 10632 | .I (($G(P SGRF))&($G (PSGST)="O ")) N PSGR O S (PSGRO ,PSGOEEF(2 5))=1,PSGO EEF(39)=1 D 25 | |
| 10633 | "RTN","PSG OE81",24,0 ) | |
| 10634 | D ENCHK^P SGS0 I '$D (X) W $C(7 ) G A39 | |
| 10635 | "RTN","PSG OE81",25,0 ) | |
| 10636 | S PSGOAT= PSGAT | |
| 10637 | "RTN","PSG OE81",26,0 ) | |
| 10638 | S (PSGS0Y ,PSGAT)=X G DONE | |
| 10639 | "RTN","PSG OE81",27,0 ) | |
| 10640 | ; | |
| 10641 | "RTN","PSG OE81",28,0 ) | |
| 10642 | 8 ; specia l instruct ions | |
| 10643 | "RTN","PSG OE81",29,0 ) | |
| 10644 | S MSG=0,P SGF2=8 S:P SGOEEF(PSG F2) BACK=" 8^PSGOE81" | |
| 10645 | "RTN","PSG OE81",30,0 ) | |
| 10646 | A8 ; speci al instruc tions | |
| 10647 | "RTN","PSG OE81",31,0 ) | |
| 10648 | S PSGSI=$ $EDITSI^PS JBCMA5($G( PSGP),$G(P SGORD)) I $G(PSGP),$ G(PSGORD) I '$$DIFFS I^PSJBCMA5 (PSGP,PSGO RD) S PSGO EE=0 G DON E | |
| 10649 | "RTN","PSG OE81",32,0 ) | |
| 10650 | S PSGSI=$ S((PSGSI>0 &(PSGSI<4) ):$G(^PS(5 3.45,+PSJS YSP,5,1,0) )_" "_$G(^ PS(53.45,+ PSJSYSP,5, 2,0)),PSGS I>3:"Instr uctions to o long. Se e Order Vi ew or BCMA for full text",1:"" ) | |
| 10651 | "RTN","PSG OE81",33,0 ) | |
| 10652 | S:PSGSI=" " PSGSI=" " I PSGSI] "" S PSGSI =$$ENBCMA^ PSJUTL("U" ) G DONE | |
| 10653 | "RTN","PSG OE81",34,0 ) | |
| 10654 | Q | |
| 10655 | "RTN","PSG OE81",35,0 ) | |
| 10656 | ; | |
| 10657 | "RTN","PSG OE81",36,0 ) | |
| 10658 | 10 ; start date/time | |
| 10659 | "RTN","PSG OE81",37,0 ) | |
| 10660 | S MSG=0,P SGF2=10 S: PSGOEEF(PS GF2) BACK= "10^PSGOE8 1" | |
| 10661 | "RTN","PSG OE81",38,0 ) | |
| 10662 | A10 ; star t date/tim e | |
| 10663 | "RTN","PSG OE81",39,0 ) | |
| 10664 | K PSGSDX N DUR,DURM IN,TMPFD | |
| 10665 | "RTN","PSG OE81",40,0 ) | |
| 10666 | I $G(PSGO RD)["P",$G (PSGP) I $ $LASTREN^P SJLMPRI(PS GP,PSGORD) D Q | |
| 10667 | "RTN","PSG OE81",41,0 ) | |
| 10668 | .W !?5,"S tart Date may not be edited at this poin t. " D PAU SE^VALM1 | |
| 10669 | "RTN","PSG OE81",42,0 ) | |
| 10670 | W !,"STAR T DATE/TIM E: "_$S($P (PSGSDN,"^ ")]"":$P(P SGSDN,"^") _"// ",1:" ") R X:DTI ME | |
| 10671 | "RTN","PSG OE81",43,0 ) | |
| 10672 | I X="^"!' $T W:'$T $ C(7) S PSG OEE=0 G DO NE | |
| 10673 | "RTN","PSG OE81",44,0 ) | |
| 10674 | I X="",PS GSD W " " _$P(PSGSDN ,"^") G DO NE | |
| 10675 | "RTN","PSG OE81",45,0 ) | |
| 10676 | I X="P" D ENPREV^PS GDL W:'$D( X) $C(7) G :'$D(X) A1 0 D G DON E | |
| 10677 | "RTN","PSG OE81",46,0 ) | |
| 10678 | .S PSGSD= +X,PSGSDN= $$ENDD^PSG MI(PSGSD)_ "^"_$$ENDT C^PSGMI(PS GSD) | |
| 10679 | "RTN","PSG OE81",47,0 ) | |
| 10680 | .W " ",$ P(PSGSDN," ^") | |
| 10681 | "RTN","PSG OE81",48,0 ) | |
| 10682 | I X="@"!( X?1."?") W :X="@" $C( 7)," (Req uired)" S: X="@" X="? " D ENHLP^ PSGOEM(53. 1,10) | |
| 10683 | "RTN","PSG OE81",49,0 ) | |
| 10684 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 10 | |
| 10685 | "RTN","PSG OE81",50,0 ) | |
| 10686 | NEW TMPX S TMPX=X,X 1=+$G(PSGL I),X2=-7 D C^%DTC K %DT S %DT= "ERTX",%DT (0)=X,X=TM PX | |
| 10687 | "RTN","PSG OE81",51,0 ) | |
| 10688 | D ^%DT K %DT I Y'>0 D ENHLP^P SGOEM(53.1 ,10) G A10 | |
| 10689 | "RTN","PSG OE81",52,0 ) | |
| 10690 | I PSGFD<Y D G A10 | |
| 10691 | "RTN","PSG OE81",53,0 ) | |
| 10692 | .W $C(7), !?5,"*** T HE START D ATE CANNOT BE AFTER THE STOP D ATE! ***", ! S MSG=1 | |
| 10693 | "RTN","PSG OE81",54,0 ) | |
| 10694 | N X1,X2,D IFF,PSGEMR G,PSGBACK, CLOZFLG S X1=PSGFD,X 2=Y D ^%DT C S DIFF=X | |
| 10695 | "RTN","PSG OE81",55,0 ) | |
| 10696 | N PSGDRG D | |
| 10697 | "RTN","PSG OE81",56,0 ) | |
| 10698 | .N ORIFN S ORIFN=+$ P($G(PSJXX 1),U,21) I ORIFN D I $G(PSGDR G) | |
| 10699 | "RTN","PSG OE81",57,0 ) | |
| 10700 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) I PSGPTR D | |
| 10701 | "RTN","PSG OE81",58,0 ) | |
| 10702 | ...S PSGD RG=$$GET1^ DIQ(100.04 5,PSGPTR_" ,"_ORIFN,1 ,"I") | |
| 10703 | "RTN","PSG OE81",59,0 ) | |
| 10704 | .E I $D( PSJXDOX("D D")) S PSG DRG=$O(PSJ XDOX("DD", "")) | |
| 10705 | "RTN","PSG OE81",60,0 ) | |
| 10706 | I $G(PSGD RG),$$GET1 ^DIQ(50,PS GDRG,17.5) ="PSOCLO1" S CLOZFLG =1 | |
| 10707 | "RTN","PSG OE81",61,0 ) | |
| 10708 | S PSGEMRG =$S($$GET1 ^DIQ(55,DF N,53)?1U6N :1,1:0),PS GBACK=0 | |
| 10709 | "RTN","PSG OE81",62,0 ) | |
| 10710 | I PSGEMRG ,$G(CLOZFL G),DIFF>4 D G A10 ; Emergen cy Registr ation peri od not to exceed 4 d ays | |
| 10711 | "RTN","PSG OE81",63,0 ) | |
| 10712 | .W !!?13, "*** EMERG ENCY SUPPL Y NOT TO E XCEED 4 DA YS! ***",! | |
| 10713 | "RTN","PSG OE81",64,0 ) | |
| 10714 | I 'PSGEMR G,$G(CLOZF LG) D G:P SGBACK A10 | |
| 10715 | "RTN","PSG OE81",65,0 ) | |
| 10716 | .N CLOZNU M,CLOZUID, X2 S CLOZN UM=$$GET1^ DIQ(55,DFN ,53) | |
| 10717 | "RTN","PSG OE81",66,0 ) | |
| 10718 | .I CLOZNU M'="" S CL OZUID=$$FI ND1^DIC(60 3.01,,"X", CLOZNUM) | |
| 10719 | "RTN","PSG OE81",67,0 ) | |
| 10720 | .I $G(CLO ZUID) S CL OZPAT=$$GE T1^DIQ(603 .01,CLOZUI D,2,"I") D | |
| 10721 | "RTN","PSG OE81",68,0 ) | |
| 10722 | ..S CLOZP AT=$S($G(C LOZPAT)="M ":2,$G(CLO ZPAT)="B": 1,$G(CLOZP AT)="W":0, 1:"") | |
| 10723 | "RTN","PSG OE81",69,0 ) | |
| 10724 | .S X2=$S( $P($G(ANQD ATA),"^",3 )=9:4,$G(C LOZPAT)=2: 28,$G(CLOZ PAT)=1:14, $G(CLOZPAT )=0:7,1:90 ) | |
| 10725 | "RTN","PSG OE81",70,0 ) | |
| 10726 | .I DIFF>X 2 W !!,"** * SUPPLY P ERIOD NOT TO EXCEED "_X2_" DAY S! ***",! S PSGBACK= 1 | |
| 10727 | "RTN","PSG OE81",71,0 ) | |
| 10728 | S (PSGSDX ,PSGSD,PSG NESD)=+Y,P SGSDN=$$EN DD^PSGMI(P SGSD)_"^"_ $$ENDTC^PS GMI(PSGSD) | |
| 10729 | "RTN","PSG OE81",72,0 ) | |
| 10730 | I $G(PSGO RD)["P",$G (PSGP) S D UR=$$GETDU R^PSJLIVMD (PSGP,+PSG ORD,"P",1) I DUR]"" S DURMIN=$ $DURMIN^PS JLIVMD(DUR ) I DURMIN D | |
| 10731 | "RTN","PSG OE81",73,0 ) | |
| 10732 | . S TMPFD =$$FMADD^X LFDT(PSGSD ,,,DURMIN) K:(TMPFD< PSGSD) TMP FD I $G(TM PFD) S PSG FD=TMPFD,P SGFDN=$$EN DD^PSGMI(P SGFD)_"^"_ $$ENDTC^PS GMI(PSGFD) | |
| 10733 | "RTN","PSG OE81",74,0 ) | |
| 10734 | G DONE | |
| 10735 | "RTN","PSG OE81",75,0 ) | |
| 10736 | ; | |
| 10737 | "RTN","PSG OE81",76,0 ) | |
| 10738 | 25 ; stop date | |
| 10739 | "RTN","PSG OE81",77,0 ) | |
| 10740 | S MSG=0,P SGF2=25 S: PSGOEEF(PS GF2) BACK= "25^PSGOE8 1" | |
| 10741 | "RTN","PSG OE81",78,0 ) | |
| 10742 | A25 ; | |
| 10743 | "RTN","PSG OE81",79,0 ) | |
| 10744 | ;; START NCC REMEDI ATION RJS* 327 | |
| 10745 | "RTN","PSG OE81",80,0 ) | |
| 10746 | N PSGDRG D | |
| 10747 | "RTN","PSG OE81",81,0 ) | |
| 10748 | .N ORIFN S ORIFN=+$ P($G(PSJXX 1),U,21) I ORIFN D I $G(PSGDR G) | |
| 10749 | "RTN","PSG OE81",82,0 ) | |
| 10750 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) I PSGPTR D | |
| 10751 | "RTN","PSG OE81",83,0 ) | |
| 10752 | ...S PSGD RG=$$GET1^ DIQ(100.04 5,PSGPTR_" ,"_ORIFN,1 ,"I") | |
| 10753 | "RTN","PSG OE81",84,0 ) | |
| 10754 | .E I $D( PSJXDOX("D D")) S PSG DRG=$O(PSJ XDOX("DD", "")) | |
| 10755 | "RTN","PSG OE81",85,0 ) | |
| 10756 | N CLOZFLG I $G(PSGD RG),$$GET1 ^DIQ(50,PS GDRG,17.5) ="PSOCLO1" S CLOZFLG =1 | |
| 10757 | "RTN","PSG OE81",86,0 ) | |
| 10758 | I '$D(CLO ZPAT),$G(C LOZFLG) N CLOZPAT S: $$FIND1^DI C(603.01,, "Q",DFN,"C ") CLOZPAT =1 | |
| 10759 | "RTN","PSG OE81",87,0 ) | |
| 10760 | I $G(CLOZ FLG) N PSG OLDED,PSGF DNOLD S PS GOLDED=PSG FD,PSGFDNO LD=PSGFDN | |
| 10761 | "RTN","PSG OE81",88,0 ) | |
| 10762 | ;; END NC C REMEDIAT ION RJS*32 7 | |
| 10763 | "RTN","PSG OE81",89,0 ) | |
| 10764 | N MSG,PSG TMPST S PS GTMPST=$G( PSGST) S:' +$G(PSGRF) PSGRF=+$$ GET1^DIQ(5 0.7,$G(PSG PDRG),12," I") ;*315 One time o rders for MRR's requ ire messag e to instr uct pharma cists | |
| 10765 | "RTN","PSG OE81",90,0 ) | |
| 10766 | I $$FIND1 ^DIC(51.1, ,"X",$G(PS GSCH)) D | |
| 10767 | "RTN","PSG OE81",91,0 ) | |
| 10768 | . S:PSGTM PST=($G(PS GST)="R") PSGST=$$GE T1^DIQ(51. 1,$$FIND1^ DIC(51.1,, "X",$G(PSG SCH)),5,"I ") ;Handle "Fill on Request" | |
| 10769 | "RTN","PSG OE81",92,0 ) | |
| 10770 | .Q | |
| 10771 | "RTN","PSG OE81",93,0 ) | |
| 10772 | I $G(PSGT MPST)="O", +$G(PSGRF) S (PSGFDN ,PSGFD)="" D | |
| 10773 | "RTN","PSG OE81",94,0 ) | |
| 10774 | . I +$G(P SGRF)=1 S MSG(1)="Th is NOW ord er has an Orderable Item for w hich a rem oval is re quired" D | |
| 10775 | "RTN","PSG OE81",95,0 ) | |
| 10776 | .. S MSG( 2)=" at th e next adm inistratio n." | |
| 10777 | "RTN","PSG OE81",96,0 ) | |
| 10778 | .. S MSG( 3)="The St op DATE/TI ME entered should be the next anticipate d administ ration for the medic ation.",MS G(3,"F")=" !" | |
| 10779 | "RTN","PSG OE81",97,0 ) | |
| 10780 | ..Q | |
| 10781 | "RTN","PSG OE81",98,0 ) | |
| 10782 | . I +$G(P SGRF)=2 S MSG(1)="Th is NOW ord er has an Orderable Item for w hich a rem oval perio d is optio nal",MSG(1 ,"F")="!!" D | |
| 10783 | "RTN","PSG OE81",99,0 ) | |
| 10784 | .. S MSG( 2)="prior to the nex t administ ration.",M SG(2,"F")= "!" | |
| 10785 | "RTN","PSG OE81",100, 0) | |
| 10786 | .. S MSG( 3)="If Ear ly Removal is needed , enter Re moval Time in Stop D ATE/TIME f ield.",MSG (3,"F")="! " | |
| 10787 | "RTN","PSG OE81",101, 0) | |
| 10788 | .. S MSG( 4)="If an Early Remo val is not required, the Stop DATE/TIME entered" | |
| 10789 | "RTN","PSG OE81",102, 0) | |
| 10790 | .. S MSG( 5)="should be the ne xt anticip ated admin istration for the me dication." ,MSG(5,"F" )="!" | |
| 10791 | "RTN","PSG OE81",103, 0) | |
| 10792 | ..Q | |
| 10793 | "RTN","PSG OE81",104, 0) | |
| 10794 | . I +$G(P SGRF)=3 S MSG(1)="Th is NOW ord er has an Orderable Item that requires a removal p eriod prio r",MSG(1," F")="!!" D | |
| 10795 | "RTN","PSG OE81",105, 0) | |
| 10796 | .. S MSG( 2)=" to th e next adm inistratio n.",MSG(2, "F")="!" | |
| 10797 | "RTN","PSG OE81",106, 0) | |
| 10798 | .. S MSG( 3)="Please Enter the Stop DATE /TIME to r eflect the Removal T ime for th is medicat ion.",MSG( 3,"F")="!" | |
| 10799 | "RTN","PSG OE81",107, 0) | |
| 10800 | ..Q | |
| 10801 | "RTN","PSG OE81",108, 0) | |
| 10802 | . D EN^DD IOL(.MSG) | |
| 10803 | "RTN","PSG OE81",109, 0) | |
| 10804 | .Q | |
| 10805 | "RTN","PSG OE81",110, 0) | |
| 10806 | K PSGFDX N PSGEMRG | |
| 10807 | "RTN","PSG OE81",111, 0) | |
| 10808 | W !,"STOP DATE/TIME : "_$S($P( PSGFDN,"^" )]"":$P(PS GFDN,"^")_ "// ",1:"" ) R X:DTIM E I X="^"! '$T W:'$T $C(7) S PS GOEE=0 G D ONE | |
| 10809 | "RTN","PSG OE81",112, 0) | |
| 10810 | I X="",PS GFD S X=$P (PSGFDN,"^ ") | |
| 10811 | "RTN","PSG OE81",113, 0) | |
| 10812 | I $E(X)=" ^" D ENFF^ PSGOE82 G: Y>0 @Y G A 25 | |
| 10813 | "RTN","PSG OE81",114, 0) | |
| 10814 | I X="@"!( X?1."?") W :X="@" $C( 7)," (Req uired)" S: X="@" X="? " D ENHLP^ PSGOEM(53. 1,25) | |
| 10815 | "RTN","PSG OE81",115, 0) | |
| 10816 | I X=+X,(X >0),(X'>20 00000) G A 25:'$$ENDL ^PSGDL(PSG SCH,X) K P SGDLS S PS GDL=X W " ...dose li mit..." D ENE^PSGDL | |
| 10817 | "RTN","PSG OE81",116, 0) | |
| 10818 | K %DT S % DT="ERTX", %DT(0)=PSG SD D ^%DT K %DT I Y' >0 W $C(7) ,!!?13,"** * WARNING! INVALID S TOP DATE O R PRIOR TO START DAT E! ***",! G A25 | |
| 10819 | "RTN","PSG OE81",117, 0) | |
| 10820 | ;/RJS Beg in changes for emerg ency regis tration of clozapine patient S et end dat e to start date + 4 days at mi dnight. | |
| 10821 | "RTN","PSG OE81",118, 0) | |
| 10822 | I $$GET1^ DIQ(55,DFN ,53)?1U6N, $G(CLOZFLG ) D G:X>4 A25 ;def 418867 RJ S*327 | |
| 10823 | "RTN","PSG OE81",119, 0) | |
| 10824 | .N X1,X2 S X1=+Y,X2 =PSGSD D ^ %DTC | |
| 10825 | "RTN","PSG OE81",120, 0) | |
| 10826 | .S PSGEMR G=1 Q:X'>4 | |
| 10827 | "RTN","PSG OE81",121, 0) | |
| 10828 | .I X>4 D | |
| 10829 | "RTN","PSG OE81",122, 0) | |
| 10830 | ..W !!?13 ,"*** EMER GENCY SUPP LY NOT TO EXCEED 4 D AYS! ***", ! | |
| 10831 | "RTN","PSG OE81",123, 0) | |
| 10832 | ..S $P(PS GFD,".",2) =2359,X1=P SGSD,X2=4 D C^%DTC S PSGFD=X | |
| 10833 | "RTN","PSG OE81",124, 0) | |
| 10834 | ..S $P(PS GFDN,"^",1 )=$$ENDD^P SGMI(PSGFD ),$P(PSGFD N,"^",2)=P SGFD | |
| 10835 | "RTN","PSG OE81",125, 0) | |
| 10836 | ;/RJS End changes f or emergen cy registr ation of c lozapine p atient Set end date to start d ate + 4 da ys at midn ight. | |
| 10837 | "RTN","PSG OE81",126, 0) | |
| 10838 | ;/RJS Beg in verify that stop date does not exceed maximum d ays supply based on lab freque ncy | |
| 10839 | "RTN","PSG OE81",127, 0) | |
| 10840 | A255 I '$G (PSGEMRG), $G(CLOZFLG ) N PSGBAC K D G:$G( PSGBACK) A 25 | |
| 10841 | "RTN","PSG OE81",128, 0) | |
| 10842 | .N CLOZNU M,CLOZUID, PSGCFLG S PSGCFLG=1 | |
| 10843 | "RTN","PSG OE81",129, 0) | |
| 10844 | .S PSGOVR D=$$OVERRI DE^YSCLTST 2(DFN) | |
| 10845 | "RTN","PSG OE81",130, 0) | |
| 10846 | .S CLOZNU M=$$GET1^D IQ(55,DFN, 53) | |
| 10847 | "RTN","PSG OE81",131, 0) | |
| 10848 | .I $G(CLO ZNUM)'="" S CLOZUID= $$FIND1^DI C(603.01,, "X",CLOZNU M) | |
| 10849 | "RTN","PSG OE81",132, 0) | |
| 10850 | .I $G(CLO ZUID) S CL OZPAT=$$GE T1^DIQ(603 .01,CLOZUI D,2,"I") D | |
| 10851 | "RTN","PSG OE81",133, 0) | |
| 10852 | ..S CLOZP AT=$S($G(C LOZPAT)="M ":2,$G(CLO ZPAT)="B": 1,$G(CLOZP AT)="W":0, 1:"") | |
| 10853 | "RTN","PSG OE81",134, 0) | |
| 10854 | .N X,X1,X 2 ;I $P($G (ANQDATA), "^",3)=9 S X2=4 | |
| 10855 | "RTN","PSG OE81",135, 0) | |
| 10856 | .S X2=$S( $P($G(ANQD ATA),"^",3 )=9:4,$G(C LOZPAT)=2: 28,$G(CLOZ PAT)=1:14, $G(CLOZPAT )=0:7,1:90 ) | |
| 10857 | "RTN","PSG OE81",136, 0) | |
| 10858 | .S X1=+Y D | |
| 10859 | "RTN","PSG OE81",137, 0) | |
| 10860 | ..N X2 S X2=PSGSD D ^%DTC S X 1=PSGSD | |
| 10861 | "RTN","PSG OE81",138, 0) | |
| 10862 | .I X>X2 W !!,"*** S TOP DATE/T IME NOT TO EXCEED "_ X2_" DAYS! ***",! S PSGBACK=1 Q | |
| 10863 | "RTN","PSG OE81",139, 0) | |
| 10864 | K:($G(PSG EMRG)) PSG EMRG | |
| 10865 | "RTN","PSG OE81",140, 0) | |
| 10866 | ;/RJS End verify th at stop da te does no t exceed m aximum day s supply b ased on la b frequenc y. | |
| 10867 | "RTN","PSG OE81",141, 0) | |
| 10868 | ;; END NC C REMEDIAT ION RJS*32 7 | |
| 10869 | "RTN","PSG OE81",142, 0) | |
| 10870 | S (PSGFDX ,PSGFD,PSG NEFD)=+Y,P SGFDN=$$EN DD^PSGMI(P SGFD)_"^"_ $$ENDTC^PS GMI(PSGFD) | |
| 10871 | "RTN","PSG OE81",143, 0) | |
| 10872 | W25 ; | |
| 10873 | "RTN","PSG OE81",144, 0) | |
| 10874 | N Z,MSG | |
| 10875 | "RTN","PSG OE81",145, 0) | |
| 10876 | D DOSE I $G(Z)]"",Z >PSGNEFD D G A25 | |
| 10877 | "RTN","PSG OE81",146, 0) | |
| 10878 | . S MSG(1 )="There i s no admin istration time that falls betw een the St art Date/T ime" | |
| 10879 | "RTN","PSG OE81",147, 0) | |
| 10880 | . S MSG(2 )="and the Stop Date /Time." | |
| 10881 | "RTN","PSG OE81",148, 0) | |
| 10882 | . D EN^DD IOL(.MSG) | |
| 10883 | "RTN","PSG OE81",149, 0) | |
| 10884 | I PSGFD<P SGDT W $C( 7),!!?13," *** WARNIN G! THE STO P DATE ENT ERED IS IN THE PAST! ***",! S MSG=1 | |
| 10885 | "RTN","PSG OE81",150, 0) | |
| 10886 | Q:+$G(PSG RO) | |
| 10887 | "RTN","PSG OE81",151, 0) | |
| 10888 | ; | |
| 10889 | "RTN","PSG OE81",152, 0) | |
| 10890 | DONE ; | |
| 10891 | "RTN","PSG OE81",153, 0) | |
| 10892 | ;Display Expected F irst Dose; BHW;PSJ*5* 136 | |
| 10893 | "RTN","PSG OE81",154, 0) | |
| 10894 | D EFDNV^P SJUTL | |
| 10895 | "RTN","PSG OE81",155, 0) | |
| 10896 | I PSGOEE G:'PSGOEEF (PSGF2) @B ACK S PSGO EE=PSGOEEF (PSGF2) | |
| 10897 | "RTN","PSG OE81",156, 0) | |
| 10898 | D:+$G(PSG DUR) VERTI MES ;*315 | |
| 10899 | "RTN","PSG OE81",157, 0) | |
| 10900 | K ORIG,PS GOLDED,PSG NEFDOLD,PS GFDNOLD | |
| 10901 | "RTN","PSG OE81",158, 0) | |
| 10902 | S:'+$G(PS GRF) PSGRF =+$$GET1^D IQ(50.7,$G (PSGPDRG), 12,"I") | |
| 10903 | "RTN","PSG OE81",159, 0) | |
| 10904 | Q | |
| 10905 | "RTN","PSG OE81",160, 0) | |
| 10906 | ; | |
| 10907 | "RTN","PSG OE81",161, 0) | |
| 10908 | FF ; up-ar row to ano ther field | |
| 10909 | "RTN","PSG OE81",162, 0) | |
| 10910 | D ENFF^PS GOEM I Y>0 ,Y'=39,Y'= 8,Y'=10,Y' =25 S Y=Y_ "^PSGOE8"_ $S("^109^1 3^3^7^26^" [("^"_Y_"^ "):"",1:2) S:Y=2 FB= PSGF2_"^PS GOE81" | |
| 10911 | "RTN","PSG OE81",163, 0) | |
| 10912 | Q | |
| 10913 | "RTN","PSG OE81",164, 0) | |
| 10914 | ; | |
| 10915 | "RTN","PSG OE81",165, 0) | |
| 10916 | DEL ; dele te entry | |
| 10917 | "RTN","PSG OE81",166, 0) | |
| 10918 | W !?3,"SU RE YOU WAN T TO DELET E" S %=0 D YN^DICN I %'=1 W $C (7)," <NO THING DELE TED>" | |
| 10919 | "RTN","PSG OE81",167, 0) | |
| 10920 | Q | |
| 10921 | "RTN","PSG OE81",168, 0) | |
| 10922 | ; | |
| 10923 | "RTN","PSG OE81",169, 0) | |
| 10924 | TIMES ;At least one admin time , not more than inte rval allow s. | |
| 10925 | "RTN","PSG OE81",170, 0) | |
| 10926 | I ($G(PSG S0XT)'="O" ),($G(PSGS T)'="OC"), '$$PRNOK^P SGS0(PSGSC H) I X="" D EN^DDIOL ("This ord er require s at least one admin istration time.") K X Q ;No t imes | |
| 10927 | "RTN","PSG OE81",171, 0) | |
| 10928 | N H,I,MAX | |
| 10929 | "RTN","PSG OE81",172, 0) | |
| 10930 | I PSGSCH] "" I $D(^P S(51.1,"AC ","PSJ",PS GSCH)) S H =+$O(^PS(5 1.1,"AC"," PSJ",PSGSC H,0)) S I= $P($G(^PS( 51.1,H,0)) ,"^",3) | |
| 10931 | "RTN","PSG OE81",173, 0) | |
| 10932 | I $G(PSGS T)="O",$L( X,"-")>1 D EN^DDIOL( "This is a One Time Order. Onl y one admi nistration time is p ermitted." ) K X Q | |
| 10933 | "RTN","PSG OE81",174, 0) | |
| 10934 | I $G(PSGS T)="O" Q ;Done vali dating One Time | |
| 10935 | "RTN","PSG OE81",175, 0) | |
| 10936 | I +$G(I)= 0 Q ;No f requency - can not c heck frequ ency relat ed items | |
| 10937 | "RTN","PSG OE81",176, 0) | |
| 10938 | S MAX=144 0/I | |
| 10939 | "RTN","PSG OE81",177, 0) | |
| 10940 | I MAX<1,$ L(X,"-")>1 D EN^DDIO L("This or der requir es one adm inistratio n time.") K X Q | |
| 10941 | "RTN","PSG OE81",178, 0) | |
| 10942 | I MAX'<1, $L(X,"-")> MAX D EN^D DIOL("The number of admin time s entered is greater than indi cated by t he schedul e.") K X Q ;Too man y times | |
| 10943 | "RTN","PSG OE81",179, 0) | |
| 10944 | I MAX'<1, $L(X,"-")< MAX D EN^D DIOL("The number of admin time s entered is fewer t han indica ted by the schedule. ") ;Too f ew times | |
| 10945 | "RTN","PSG OE81",180, 0) | |
| 10946 | Q | |
| 10947 | "RTN","PSG OE81",181, 0) | |
| 10948 | ; | |
| 10949 | "RTN","PSG OE81",182, 0) | |
| 10950 | DOSE ;Make certain a t least on e dose is given. | |
| 10951 | "RTN","PSG OE81",183, 0) | |
| 10952 | N INFO,X | |
| 10953 | "RTN","PSG OE81",184, 0) | |
| 10954 | S Z="",IN FO=$S($G(P SGNESD):PS GNESD,1:$G (PSGSD))_U _($G(PSGNE FD))_U_($G (PSGSCH))_ U_($G(PSGS T))_U_($G( PSGDRG))_U _($G(PSGS0 Y)) | |
| 10955 | "RTN","PSG OE81",185, 0) | |
| 10956 | Q:$G(PSGS T)="OC"!($ G(PSGST)=" P") | |
| 10957 | "RTN","PSG OE81",186, 0) | |
| 10958 | I '$L($G( PSGP)) N P SGP S PSGP ="" | |
| 10959 | "RTN","PSG OE81",187, 0) | |
| 10960 | S Z=$$ENQ ^PSJORP2(P SGP,INFO) ;Expected first dos e. | |
| 10961 | "RTN","PSG OE81",188, 0) | |
| 10962 | Q | |
| 10963 | "RTN","PSG OE81",189, 0) | |
| 10964 | ; | |
| 10965 | "RTN","PSG OE81",190, 0) | |
| 10966 | ;*315 new tags | |
| 10967 | "RTN","PSG OE81",191, 0) | |
| 10968 | PSGDUR ; P rompt for Removal ti mes if adm in times a re on 24hr rotations and Site Params are enabled. | |
| 10969 | "RTN","PSG OE81",192, 0) | |
| 10970 | ; check p arameter f iles for r emoval cri teria quit if remova l rotation not enabl ed (<2) | |
| 10971 | "RTN","PSG OE81",193, 0) | |
| 10972 | ; if enab led determ ine type ( hard vers soft stop) | |
| 10973 | "RTN","PSG OE81",194, 0) | |
| 10974 | ;0 = no r emoval (cu rrent cap/ tab functi onality) | |
| 10975 | "RTN","PSG OE81",195, 0) | |
| 10976 | ;1 = remo val at nex t admin (c urrent pat ch functio nality) | |
| 10977 | "RTN","PSG OE81",196, 0) | |
| 10978 | ;2 = remo val prior to next ad min; soft stop (phar macist opt ional prom pt to desi gnate dura tion of ad ministrati on | |
| 10979 | "RTN","PSG OE81",197, 0) | |
| 10980 | ;3 = remo val prior to next ad min; hard stop (phar macist req uired prom pt to desi gnate dura tion of ad ministrati on) | |
| 10981 | "RTN","PSG OE81",198, 0) | |
| 10982 | ; prompt for remova l if = 2 t hen allow skip, if = 3 then fo rce entry | |
| 10983 | "RTN","PSG OE81",199, 0) | |
| 10984 | ; | |
| 10985 | "RTN","PSG OE81",200, 0) | |
| 10986 | S PSGRF=+ $$GET1^DIQ (50.7,$G(P SGPDRG),12 ,"I") Q:(( PSGRF<2)!( $G(PSGST)= "O")!($G(P SGST)="P") !($G(PSGST )="OC")) ; no remov al flag or no remova l rotation | |
| 10987 | "RTN","PSG OE81",201, 0) | |
| 10988 | Q:$G(PSGS 0XT)>1440 ; Duratio n of Admin istration valid only for 24 ho urs - subj ect to cha nge in fut ure. | |
| 10989 | "RTN","PSG OE81",202, 0) | |
| 10990 | N RP,PSGI DF,WMSG,PS GDERR S (P SGIDF,PSGD ERR)=0 S:$ G(PSGDUR)> 0 RP=(PSGD UR/60) S:" BID,TID,QI D"[$G(PSGS CH) PSGIDF =1 ; Use separate v alidation for Times per day ty pe orders | |
| 10991 | "RTN","PSG OE81",203, 0) | |
| 10992 | S PSGF2=3 9 | |
| 10993 | "RTN","PSG OE81",204, 0) | |
| 10994 | W !,"DURA TION OF AD MINISTRATI ON (HRS): "_$S($G(RP ):RP_"// " ,1:"") R R P:DTIME I RP="^"!'$T W:'$T $C( 7) S PSGDU R=$G(PSGDO A),X="^",P SGOEE=0 Q | |
| 10995 | "RTN","PSG OE81",205, 0) | |
| 10996 | I RP="" S :$G(PSGDUR )>0 RP=($G (PSGDUR)/6 0) | |
| 10997 | "RTN","PSG OE81",206, 0) | |
| 10998 | I RP="",$ G(PSGS0XT) ="D",$L(PS GSCH,"@")= 2,$P(PSGSC H,"@",2) S (PSGAT,PS GRMVT)=$P( PSGSCH,"@" ,2) G 8 | |
| 10999 | "RTN","PSG OE81",207, 0) | |
| 11000 | I RP="@", PSGRF'=3 D DEL G:%'= 1 PSGDUR S (PSGS0Y,P SGDUR,PSGR MVT)="",PS GRMV=-1 S: +$$GET1^DI Q(53.1,+$G (PSGORD),1 37) (PSGDU R,PSGRMV,P SGRMVT)="@ " Q | |
| 11001 | "RTN","PSG OE81",208, 0) | |
| 11002 | I (RP'="" ),(RP'="@" ),($E(RP)' ="^"),($E( RP)'="?") S:(RP'?1N. 2N)!(+(RP) <1) RP="?" | |
| 11003 | "RTN","PSG OE81",209, 0) | |
| 11004 | I RP?1."? " D DURHLP ^PSGOEM(RP ,PSGRF) G PSGDUR | |
| 11005 | "RTN","PSG OE81",210, 0) | |
| 11006 | I $E(RP)= "^" D FF G :Y>0 @Y G PSGDUR | |
| 11007 | "RTN","PSG OE81",211, 0) | |
| 11008 | I (+RP>0) ,'PSGIDF D I PSGRMV <1 G PSGDU R ; exclud e BID,TID or QID sch edules | |
| 11009 | "RTN","PSG OE81",212, 0) | |
| 11010 | .S PSGDUR =(RP*60),P SGRMV=$G(P SGS0XT)-PS GDUR | |
| 11011 | "RTN","PSG OE81",213, 0) | |
| 11012 | .I PSGRMV <1 W !,"DU RATION OF ADMINISTRA TION MATCH ES OR EXCE EDS ORDER FREQUENCY" S RP="",P SGDERR=1 K PSGDUR,PS GRMV ; G P SGDUR | |
| 11013 | "RTN","PSG OE81",214, 0) | |
| 11014 | Q:$G(PSGD ERR)=1 | |
| 11015 | "RTN","PSG OE81",215, 0) | |
| 11016 | I PSGRF=3 ,(+RP<1) W $C(7),!," ENTRY IS R EQUIRED" S RP="" G P SGDUR | |
| 11017 | "RTN","PSG OE81",216, 0) | |
| 11018 | I PSGRF=2 ,(+RP<1) D | |
| 11019 | "RTN","PSG OE81",217, 0) | |
| 11020 | .W !,"You have not entered Du ration of Administra tion for t his medica tion order , " | |
| 11021 | "RTN","PSG OE81",218, 0) | |
| 11022 | .W !,"the refore the BCMA user will not be prompte d to remov e the medi cation pri or " | |
| 11023 | "RTN","PSG OE81",219, 0) | |
| 11024 | .W !,"to the next A dmin Time. " | |
| 11025 | "RTN","PSG OE81",220, 0) | |
| 11026 | .S PSGRMV =-1,RP=0 | |
| 11027 | "RTN","PSG OE81",221, 0) | |
| 11028 | I PSGIDF, (+RP>0) D ;Only for TPD sched ules | |
| 11029 | "RTN","PSG OE81",222, 0) | |
| 11030 | .N F,P,PS GARR | |
| 11031 | "RTN","PSG OE81",223, 0) | |
| 11032 | .S PSGADT =$S($G(PSG DUR)=-1:X, $G(PSGAT): PSGAT,$G(P SGS0Y):PSG S0Y,1:""), PSGS0Y=PSG ADT | |
| 11033 | "RTN","PSG OE81",224, 0) | |
| 11034 | .S PSGARR =$L($G(PSG ADT),"-") | |
| 11035 | "RTN","PSG OE81",225, 0) | |
| 11036 | .F P=1:1: PSGARR D | |
| 11037 | "RTN","PSG OE81",226, 0) | |
| 11038 | ..S PSGAR R(P)=($P(P SGADT,"-", P)/100) S: (P>1) F(P) =PSGARR(P) -PSGARR(P- 1) | |
| 11039 | "RTN","PSG OE81",227, 0) | |
| 11040 | ..I $G(F( P)),($G(F( P))'=RP) S WMSG=1_U_ "Duration of Adminis tration do es not cor respond to one or mo re",WMSG(1 )="of this order's s cheduled A dministrat ion Times! " | |
| 11041 | "RTN","PSG OE81",228, 0) | |
| 11042 | S:(+RP>0) PSGDUR=(R P*60) | |
| 11043 | "RTN","PSG OE81",229, 0) | |
| 11044 | W:(+RP>0) ?60,RP," HOURS" | |
| 11045 | "RTN","PSG OE81",230, 0) | |
| 11046 | D:$G(WMSG ) EN^DDIOL ($P(WMSG,U ,2)),EN^DD IOL(WMSG(1 )) | |
| 11047 | "RTN","PSG OE81",231, 0) | |
| 11048 | Q | |
| 11049 | "RTN","PSG OE81",232, 0) | |
| 11050 | ; | |
| 11051 | "RTN","PSG OE81",233, 0) | |
| 11052 | VERTIMES ; Redisplay Admin and Removal t imes | |
| 11053 | "RTN","PSG OE81",234, 0) | |
| 11054 | S PSGRF=+ $$GET1^DIQ (50.7,$G(P SGPDRG),12 ,"I") Q:(P SGRF<2)!($ G(PSGST)=" O") | |
| 11055 | "RTN","PSG OE81",235, 0) | |
| 11056 | N PSGADT, PSGRARR,PS GAARR | |
| 11057 | "RTN","PSG OE81",236, 0) | |
| 11058 | ;If we ha ve a frequ ency and t his is odd type orde r then we need to st art calcul ations wit h order st art time. | |
| 11059 | "RTN","PSG OE81",237, 0) | |
| 11060 | I $G(PSGS 0XT),$G(PS GNESD),+$G (PSGDUR),$ G(PSGAT)=" " D Q | |
| 11061 | "RTN","PSG OE81",238, 0) | |
| 11062 | .N L | |
| 11063 | "RTN","PSG OE81",239, 0) | |
| 11064 | .S (PSGAA RR,PSGRARR )=1,PSGADT =$P($P(PSG NESD,U,1), ".",2),L=$ L(PSGADT) | |
| 11065 | "RTN","PSG OE81",240, 0) | |
| 11066 | .S PSGRAR R(1)=((((( PSGADT*60) +PSGDUR)/6 0)#24)*100 ) S:PSGRAR R(1)=0 PSG RARR(1)=24 00 S:$L(PS GRARR(1))= 3 PSGRARR( 1)="0"_PSG RARR(1) | |
| 11067 | "RTN","PSG OE81",241, 0) | |
| 11068 | .S PSGRAR R(1)=$E(PS GRARR(1),1 ,L)_"(R)" | |
| 11069 | "RTN","PSG OE81",242, 0) | |
| 11070 | .S PSGAAR R(1)=PSGAD T,PSGAARR( 1)=$E(PSGA ARR(1),1,L )_"(A)" | |
| 11071 | "RTN","PSG OE81",243, 0) | |
| 11072 | .D WRITE | |
| 11073 | "RTN","PSG OE81",244, 0) | |
| 11074 | ; | |
| 11075 | "RTN","PSG OE81",245, 0) | |
| 11076 | S (PSGRAR R,PSGAARR) =$S($G(PSG AT):$L(PSG AT,"-"),1: $L(PSGS0Y, "-")) | |
| 11077 | "RTN","PSG OE81",246, 0) | |
| 11078 | N P,L | |
| 11079 | "RTN","PSG OE81",247, 0) | |
| 11080 | F P=1:1:P SGRARR D | |
| 11081 | "RTN","PSG OE81",248, 0) | |
| 11082 | .S PSGADT =$S($G(PSG AT):$P(PSG AT,"-",P), 1:$P(PSGS0 Y,"-",P)), L=$L(PSGAD T) | |
| 11083 | "RTN","PSG OE81",249, 0) | |
| 11084 | .S PSGADT =$S($L(PSG ADT)=4:PSG ADT/100,1: PSGADT*1) | |
| 11085 | "RTN","PSG OE81",250, 0) | |
| 11086 | .S PSGRAR R(P)=((((( PSGADT*60) +PSGDUR)/6 0)#24)*100 ) S:PSGRAR R(P)=0 PSG RARR(P)=24 00 S:$L(PS GRARR(P))= 3 PSGRARR( P)="0"_PSG RARR(P) | |
| 11087 | "RTN","PSG OE81",251, 0) | |
| 11088 | .S PSGRAR R(P)=$E(PS GRARR(P),1 ,L)_"(R)" | |
| 11089 | "RTN","PSG OE81",252, 0) | |
| 11090 | .S PSGAAR R(P)=(PSGA DT*100) S: $L(PSGAARR (P))=3 PSG AARR(P)="0 "_PSGAARR( P) | |
| 11091 | "RTN","PSG OE81",253, 0) | |
| 11092 | .S PSGAAR R(P)=$E(PS GAARR(P),1 ,L)_"(A)" | |
| 11093 | "RTN","PSG OE81",254, 0) | |
| 11094 | D WRITE | |
| 11095 | "RTN","PSG OE81",255, 0) | |
| 11096 | Q | |
| 11097 | "RTN","PSG OE81",256, 0) | |
| 11098 | ; | |
| 11099 | "RTN","PSG OE81",257, 0) | |
| 11100 | WRITE ; | |
| 11101 | "RTN","PSG OE81",258, 0) | |
| 11102 | W !!,"Ver ify Admin and remova l times",! | |
| 11103 | "RTN","PSG OE81",259, 0) | |
| 11104 | W !,"(A)D MINISTRATI ON -(R)EMO VAL TIMES" | |
| 11105 | "RTN","PSG OE81",260, 0) | |
| 11106 | W !,"____ __________ __________ __________ __________ __________ __________ __________ _",! | |
| 11107 | "RTN","PSG OE81",261, 0) | |
| 11108 | F P=1:1:P SGAARR W P SGAARR(P)_ "-"_PSGRAR R(P) W:P' =PSGAARR " , " | |
| 11109 | "RTN","PSG OE81",262, 0) | |
| 11110 | D ASK | |
| 11111 | "RTN","PSG OE81",263, 0) | |
| 11112 | Q | |
| 11113 | "RTN","PSG OE81",264, 0) | |
| 11114 | ; | |
| 11115 | "RTN","PSG OE81",265, 0) | |
| 11116 | ASK ; | |
| 11117 | "RTN","PSG OE81",266, 0) | |
| 11118 | N Y | |
| 11119 | "RTN","PSG OE81",267, 0) | |
| 11120 | S DIR("A" )="Is this correct", DIR(0)="Y" D ^DIR I $D(DUOUT)! $D(DTOUT) W:'$T $C(7 ) S PSGOEE =0 K PSGDU R G DONE | |
| 11121 | "RTN","PSG OE81",268, 0) | |
| 11122 | I 'Y K X S PSGDUR=- 1 G A39 | |
| 11123 | "RTN","PSG OE81",269, 0) | |
| 11124 | N P S P=1 ,PSGRMVT=$ P(PSGRARR( P),"(",1) | |
| 11125 | "RTN","PSG OE81",270, 0) | |
| 11126 | F S P=$O (PSGRARR(P )) Q:P="" D | |
| 11127 | "RTN","PSG OE81",271, 0) | |
| 11128 | .S PSGRMV T=PSGRMVT_ "-"_$P(PSG RARR(P),"( ",1) | |
| 11129 | "RTN","PSG OE81",272, 0) | |
| 11130 | Q | |
| 11131 | "RTN","PSG OE81",273, 0) | |
| 11132 | ; | |
| 11133 | "RTN","PSG OE82") | |
| 11134 | 0^17^B4032 7002 | |
| 11135 | "RTN","PSG OE82",1,0) | |
| 11136 | PSGOE82 ;B IR/CML3-NO N-VERIFIED ORDER EDI T (CONT.) ;Jul 26, 2 017@18:04: 02 | |
| 11137 | "RTN","PSG OE82",2,0) | |
| 11138 | ;;5.0;INP ATIENT MED ICATIONS ; **2,35,50, 67,58,81,1 27,168,181 ,276,317,3 27**;16 DE C 97;Build 64 | |
| 11139 | "RTN","PSG OE82",3,0) | |
| 11140 | ; | |
| 11141 | "RTN","PSG OE82",4,0) | |
| 11142 | ; Referen ce to ^DD( 53.1 is su pported by DBIA #225 6. | |
| 11143 | "RTN","PSG OE82",5,0) | |
| 11144 | ; Referen ce to ^VA( 200 is sup ported by DBIA #1006 0. | |
| 11145 | "RTN","PSG OE82",6,0) | |
| 11146 | ; Referen ce to ^DIE is suppor ted by DBI A #10018. | |
| 11147 | "RTN","PSG OE82",7,0) | |
| 11148 | ; Referen ce to ^DIC is suppor ted by DBI A #10006. | |
| 11149 | "RTN","PSG OE82",8,0) | |
| 11150 | ; Referen ce to ^DIC N is suppo rted by DB IA #10009. | |
| 11151 | "RTN","PSG OE82",9,0) | |
| 11152 | ; Referen ce to $$GE T^XPAR is supported by DBIA #2 263 | |
| 11153 | "RTN","PSG OE82",10,0 ) | |
| 11154 | ; | |
| 11155 | "RTN","PSG OE82",11,0 ) | |
| 11156 | 1 ; provid er | |
| 11157 | "RTN","PSG OE82",12,0 ) | |
| 11158 | S MSG=0,P SGF2=1 S:P SGOEEF(PSG F2) BACK=" 1^PSGOE82" | |
| 11159 | "RTN","PSG OE82",13,0 ) | |
| 11160 | A1 I $G(PS GORD)["P", $G(PSGP) I $$LASTREN ^PSJLMPRI( PSGP,PSGOR D) D Q | |
| 11161 | "RTN","PSG OE82",14,0 ) | |
| 11162 | . W !?5," This order has been renewed. P rovider ma y not be e dited at t his point. " D PAUSE ^VALM1 | |
| 11163 | "RTN","PSG OE82",15,0 ) | |
| 11164 | ;; START NCC T4 MOD S >> 327*R JS | |
| 11165 | "RTN","PSG OE82",16,0 ) | |
| 11166 | S PSTMPI= PSGPR,PSTM PN=PSGPRN | |
| 11167 | "RTN","PSG OE82",17,0 ) | |
| 11168 | W !,"PROV IDER: ",$S (PSGPR:PSG PRN_"// ", 1:"") R X: DTIME I X= "^"!'$T W: '$T $C(7) S PSGOEE=0 G DONE | |
| 11169 | "RTN","PSG OE82",18,0 ) | |
| 11170 | I $S(X="" :'PSGPR,1: X="@") W $ C(7)," (R equired)" S X="?" D ENHLP^PSGO EM(53.1,1) G A1 | |
| 11171 | "RTN","PSG OE82",19,0 ) | |
| 11172 | I X="",PS GPR S X=PS GPRN I PSG PR'=PSGPRN ,$$GET1^DI Q(200,PSGP R,53.1,"I" ) G:'$G(AN QX) DONE | |
| 11173 | "RTN","PSG OE82",20,0 ) | |
| 11174 | I +$G(ANQ X) G A2 | |
| 11175 | "RTN","PSG OE82",21,0 ) | |
| 11176 | I X?1."?" D ENHLP^P SGOEM(53.1 ,1) | |
| 11177 | "RTN","PSG OE82",22,0 ) | |
| 11178 | I $E(X)=" ^" D ENFF G:Y>0 @Y G A1 | |
| 11179 | "RTN","PSG OE82",23,0 ) | |
| 11180 | K DIC S D IC="^VA(20 0,",DIC(0) ="EMQZ",DI C("S")="I $$GET1^DIQ (200,PSGPR ,53.1,""I" "),$S('$$G ET1^DIQ(20 0,PSGPR,53 .4,""I""): 1,1:$$GET1 ^DIQ(200,P SGPR,53.4, ""I"")>DT) " D ^DIC K DIC I Y'> 0 G A1 | |
| 11181 | "RTN","PSG OE82",24,0 ) | |
| 11182 | A2 S ANQX= 0 D CLOZPR V | |
| 11183 | "RTN","PSG OE82",25,0 ) | |
| 11184 | I $G(ANQX ) S PSGPR= PSTMPI,PSG PRN=PSTMPN K PSTMPN ,PSTMPI,AN QX G A1 | |
| 11185 | "RTN","PSG OE82",26,0 ) | |
| 11186 | ;; END NC C T4 MODS << 327*RJS | |
| 11187 | "RTN","PSG OE82",27,0 ) | |
| 11188 | S PSGPR=+ Y,PSGPRN=Y (0,0) G DO NE | |
| 11189 | "RTN","PSG OE82",28,0 ) | |
| 11190 | ; | |
| 11191 | "RTN","PSG OE82",29,0 ) | |
| 11192 | 5 ; self m ed | |
| 11193 | "RTN","PSG OE82",30,0 ) | |
| 11194 | S MSG=0,P SGF2=5 S:P SGOEEF(PSG F2) BACK=" 5^PSGOE82" K PSGOEEF (6) S:PSGS M PSGOEEF( 6)=1 | |
| 11195 | "RTN","PSG OE82",31,0 ) | |
| 11196 | A5 W !,"SE LF MED: " W $P("NO^Y ES","^",PS GSM+1),"// " R X:DTI ME I X="^" !'$T W:'$T $C(7) S P SGOEE=0 G DONE | |
| 11197 | "RTN","PSG OE82",32,0 ) | |
| 11198 | ;I "01"[X ,$L(X)<2 S :PSGSM=""& (X]"") PSG SM=X W:PSG SM]"" " ( ",$P("NO^Y ES","^",PS GSM+1),")" G:'PSGSM DONE S PSG OEEF(6)=1 G 6 | |
| 11199 | "RTN","PSG OE82",33,0 ) | |
| 11200 | I "01"[X, $L(X)<2 S: X]"" PSGSM =+X W:PSGS M]"" " (" ,$P("NO^YE S","^",PSG SM+1),")" G:'PSGSM D ONE S PSGO EEF(6)=1 G 6 | |
| 11201 | "RTN","PSG OE82",34,0 ) | |
| 11202 | I X="@" W $C(7)," (Required) " G A5 | |
| 11203 | "RTN","PSG OE82",35,0 ) | |
| 11204 | I X?1"^". E D ENFF G :Y>0 @Y G A5 | |
| 11205 | "RTN","PSG OE82",36,0 ) | |
| 11206 | I X?1."?" D ENHLP^P SGOEM(53.1 ,5) G A5 | |
| 11207 | "RTN","PSG OE82",37,0 ) | |
| 11208 | D YN I S PSGSM=$E( X)="Y" K P SGOEEF(6) G:'PSGSM D ONE S PSGO EEF(6)=1 G 6 | |
| 11209 | "RTN","PSG OE82",38,0 ) | |
| 11210 | W $C(7) D ENHLP^PSG OEM(53.1,5 ) G A5 | |
| 11211 | "RTN","PSG OE82",39,0 ) | |
| 11212 | ; | |
| 11213 | "RTN","PSG OE82",40,0 ) | |
| 11214 | 6 ; hospit al supplie d self med | |
| 11215 | "RTN","PSG OE82",41,0 ) | |
| 11216 | S MSG=0,P SGF2=6 S:P SGOEEF(PSG F2) BACK=" 6^PSGOE82" | |
| 11217 | "RTN","PSG OE82",42,0 ) | |
| 11218 | A6 W !,"HO SPITAL SUP PLIED SELF MED: " W: PSGHSM]"" $P("NO^YES ","^",PSGH SM+1),"// " R X:DTIM E I X="^"! '$T W:'$T $C(7) S PS GOEE=0 G D ONE | |
| 11219 | "RTN","PSG OE82",43,0 ) | |
| 11220 | I "01"[X, $L(X)=1 S: X]"" PSGHS M=+X W " (",$P("NO^ YES","^",P SGHSM+1)," )" S MSG=0 ,PSGF2=5 G DONE | |
| 11221 | "RTN","PSG OE82",44,0 ) | |
| 11222 | I X="@" W $C(7)," (Required) " G A6 | |
| 11223 | "RTN","PSG OE82",45,0 ) | |
| 11224 | I X?1"^". E D ENFF G :Y>0 @Y G A6 | |
| 11225 | "RTN","PSG OE82",46,0 ) | |
| 11226 | I X?1."?" D ENHLP^P SGOEM(53.1 ,6) G A6 | |
| 11227 | "RTN","PSG OE82",47,0 ) | |
| 11228 | D YN I S PSGHSM=$E (X)="Y" S MSG=0,PSGF 2=5 G DONE | |
| 11229 | "RTN","PSG OE82",48,0 ) | |
| 11230 | W $C(7) D ENHLP^PSG OEM(53.1,6 ) G A6 | |
| 11231 | "RTN","PSG OE82",49,0 ) | |
| 11232 | ; | |
| 11233 | "RTN","PSG OE82",50,0 ) | |
| 11234 | 2 ; dispen se drug mu ltiple | |
| 11235 | "RTN","PSG OE82",51,0 ) | |
| 11236 | ;*276 - D isallow un authorized nurses fr om editing Dispense Drug | |
| 11237 | "RTN","PSG OE82",52,0 ) | |
| 11238 | I '$P($G( PSJSYSU)," ;",4) W !, "You are n ot authori zed to edi t Dispense Drugs." D PAUSE^VAL M1 Q | |
| 11239 | "RTN","PSG OE82",53,0 ) | |
| 11240 | S MSG=0,P SGF2=2,BAC K="2^PSGOE 82" K PSGO EEND | |
| 11241 | "RTN","PSG OE82",54,0 ) | |
| 11242 | N PSGX,AR RAY D LIST ^DIC(53.45 02,","_PSJ SYSP_",",, "I",,,,,,, "ARRAY") S PSGX=+ARR AY("DILIST ",0) | |
| 11243 | "RTN","PSG OE82",55,0 ) | |
| 11244 | N PSJPNDR N I $G(PSG ORD) I $E( PSGORD,$L( PSGORD))=" P",$$GET1^ DIQ(53.1,+ PSGORD,103 ,"I")="R" S PSJPNDRN =1 D | |
| 11245 | "RTN","PSG OE82",56,0 ) | |
| 11246 | .S $P(PSJ PNDRN,"^", 2)="Dispen se drugs f or renewal orders ca nnot be de leted, but can be gi ven an INA CTIVE DATE . " | |
| 11247 | "RTN","PSG OE82",57,0 ) | |
| 11248 | ; PSJ*5*3 17 - If PS J PADE OE BALANCES p arameter i s YES, PAD E balances should di splay as i dentifier. | |
| 11249 | "RTN","PSG OE82",58,0 ) | |
| 11250 | N PSJPADL K S PSJPAD LK=0 ; Fl ag indicat ing PADE d rug lookup was done, don't do drug looku p twice - PSJ*5*317 | |
| 11251 | "RTN","PSG OE82",59,0 ) | |
| 11252 | I $$GET^X PAR("SYS", "PSJ PADE OE BALANCE S") D | |
| 11253 | "RTN","PSG OE82",60,0 ) | |
| 11254 | .N DA,DIC ,DIE,DR,DI R,PSJLOC,P SJDRG,PSJD DC,DFN,PSJ ORD,PSJPOI ,PSJORCL,P SJCLNK,PSJ CLND | |
| 11255 | "RTN","PSG OE82",61,0 ) | |
| 11256 | .; If cli nic order, quit if c linic loca tion is no t linked t o PADE | |
| 11257 | "RTN","PSG OE82",62,0 ) | |
| 11258 | .S PSJORC L=$S($G(PS GORD)["P": $$GET1^DIQ (53.1,+$G( PSGORD),11 3,"I")_"^" _$$GET1^DI Q(53.1,+$G (PSGORD),1 26,"I"),1: "") | |
| 11259 | "RTN","PSG OE82",63,0 ) | |
| 11260 | .I PSJORC L,$P(PSJOR CL,"^",2) S PSJCLNK= $$PADECL^P SJPAD50(+$ G(PSJORCL) ) Q:'PSJCL NK | |
| 11261 | "RTN","PSG OE82",64,0 ) | |
| 11262 | .I '$G(PS JCLNK) Q:' $$PADEWD^P SJPAD50(+$ G(VAIN(4)) ) | |
| 11263 | "RTN","PSG OE82",65,0 ) | |
| 11264 | .I $G(PSG ORD) S PSJ POI=$$GET1 ^DIQ(53.1, PSGORD,108 ,"I") | |
| 11265 | "RTN","PSG OE82",66,0 ) | |
| 11266 | .S DFN=$G (PSGP),PSJ ORD=$G(PSG ORD) | |
| 11267 | "RTN","PSG OE82",67,0 ) | |
| 11268 | .N ARRAY D LIST^DIC (53.4502," ,"_+$G(PSJ SYSP)_",", ,"I",,,,,, ,"ARRAY") | |
| 11269 | "RTN","PSG OE82",68,0 ) | |
| 11270 | .F I=1:1 Q:'$D(ARRA Y("DILIST" ,2,I)) S PSJDDC=ARR AY("DILIST ",2,I),PSJ DRG(PSJDDC )=$$GET1^D IQ(53.4502 ,PSJDDC_", "_PSJSYSP, .01,"I") I '$G(PSJPO I) D | |
| 11271 | "RTN","PSG OE82",69,0 ) | |
| 11272 | ..S PSJPO I=+$$GET1^ DIQ(50,+$G (PSJDRG(PS JDDC)),2.1 ,"I") | |
| 11273 | "RTN","PSG OE82",70,0 ) | |
| 11274 | ..I '$G(P SJPOI),$G( PSGPD),($$ GET1^DIQ(5 0.7,+$G(PS GPD),.01)] "") S PSJP OI=+PSGPD | |
| 11275 | "RTN","PSG OE82",71,0 ) | |
| 11276 | .S PSJCLN D=$S($G(PS JORD)["U": $$GET1^DIQ (55.06,+PS JORD_","_D FN,28,"I") ,$G(PSJORD )["P":$$GE T1^DIQ(53. 1,+PSGORD, 113,"I")_" ^"_$$GET1^ DIQ(53.1,+ PSGORD,126 ,"I"),1:"" ) | |
| 11277 | "RTN","PSG OE82",72,0 ) | |
| 11278 | .S PSJLOC =$S(PSJCLN D&$P(PSJCL ND,"^",2): +PSJCLND_" C",1:"") | |
| 11279 | "RTN","PSG OE82",73,0 ) | |
| 11280 | .S:'PSJLO C PSJLOC=+ $G(VAIN(4) ) I '$G(PS JLOC) D | |
| 11281 | "RTN","PSG OE82",74,0 ) | |
| 11282 | ..N VAIN D INP^VADP T S PSJLOC =$G(VAIN(4 )) | |
| 11283 | "RTN","PSG OE82",75,0 ) | |
| 11284 | .S PSJPAD LK=1 | |
| 11285 | "RTN","PSG OE82",76,0 ) | |
| 11286 | .D READDD ^PSJPAD50( .PSJDRG,$S ($G(PSGPD) :+$G(PSGPD ),1:+$G(PS JPOI)),PSJ LOC,PSJORD ,$G(PSGORD )) | |
| 11287 | "RTN","PSG OE82",77,0 ) | |
| 11288 | ; PSJ*5*3 17 - If PS J PADE OE BALANCES p arameter i s NO, PADE balances should NOT display a s identife r. | |
| 11289 | "RTN","PSG OE82",78,0 ) | |
| 11290 | I '$G(PSJ PADLK) N D A,DIC,DIE, DR,DIR S D IE="^PS(53 .45,",DA=P SJSYSP,DR= 2,DR(2,53. 4502)=".01 ;.02"_$S($ G(PSJPNDRN ):";.03",1 :"") D ^DI E | |
| 11291 | "RTN","PSG OE82",79,0 ) | |
| 11292 | I '$O(^PS (53.45,PSJ SYSP,2,0)) W $C(7),! !,"WARNING : This ord er must ha ve at leas t one disp ense drug before pha rmacy can" ,!?9,"veri fy it!",! S MSG=1 | |
| 11293 | "RTN","PSG OE82",80,0 ) | |
| 11294 | D DDOC(PS GX) | |
| 11295 | "RTN","PSG OE82",81,0 ) | |
| 11296 | NEW PSJDO SE | |
| 11297 | "RTN","PSG OE82",82,0 ) | |
| 11298 | D DOSECHK ^PSJDOSE | |
| 11299 | "RTN","PSG OE82",83,0 ) | |
| 11300 | I +$G(PSJ DSFLG) D D SPWARN^PSJ DOSE S PSG OEEF(109)= 1 | |
| 11301 | "RTN","PSG OE82",84,0 ) | |
| 11302 | G DONE | |
| 11303 | "RTN","PSG OE82",85,0 ) | |
| 11304 | ; | |
| 11305 | "RTN","PSG OE82",86,0 ) | |
| 11306 | 40 ; comme nts | |
| 11307 | "RTN","PSG OE82",87,0 ) | |
| 11308 | S MSG=0,P SGF2=40,BA CK="40^PSG OE82",DA=P SJSYSP,DR= 1,DIE="^PS (53.45," D ^DIE W ! G DONE | |
| 11309 | "RTN","PSG OE82",88,0 ) | |
| 11310 | ; | |
| 11311 | "RTN","PSG OE82",89,0 ) | |
| 11312 | 66 ; provi der commen ts | |
| 11313 | "RTN","PSG OE82",90,0 ) | |
| 11314 | ;S MSG=0, PSGF2=66,B ACK="66^PS GOE82",DA= PSJSYSP,DR =4,DIE="^P S(53.45," D ^DIE W ! G DONE | |
| 11315 | "RTN","PSG OE82",91,0 ) | |
| 11316 | ; | |
| 11317 | "RTN","PSG OE82",92,0 ) | |
| 11318 | DONE ; | |
| 11319 | "RTN","PSG OE82",93,0 ) | |
| 11320 | I PSGOEE G:'PSGOEEF (PSGF2) @B ACK S PSGO EE=PSGOEEF (PSGF2) | |
| 11321 | "RTN","PSG OE82",94,0 ) | |
| 11322 | K F,F0,PS GF2,F3,PSG ,SDT Q | |
| 11323 | "RTN","PSG OE82",95,0 ) | |
| 11324 | ; | |
| 11325 | "RTN","PSG OE82",96,0 ) | |
| 11326 | ENFF ; up- arrow to a nother fie ld | |
| 11327 | "RTN","PSG OE82",97,0 ) | |
| 11328 | S Y=-1 I '$D(PSGOEE F)!(X?1"^" 1.9N) W $C (7)," ??" Q | |
| 11329 | "RTN","PSG OE82",98,0 ) | |
| 11330 | S X=$E(X, 2,99) I X= +X S Y=$S( $D(PSGOEEF (X)):X,1:- 1) W " " W:Y>0 $$CO DES2^PSIVU TL(53.1,X) W:Y'>0 $C (7),"??" Q | |
| 11331 | "RTN","PSG OE82",99,0 ) | |
| 11332 | K DIC S D IC="^DD(53 .1,",DIC(0 )="QEM",DI C("S")="I $D(PSGOEEF (+Y))" D ^ DIC K DIC S Y=+Y S:Y >0 Y=$P($T (@("F"_Y)) ,";",3) Q | |
| 11333 | "RTN","PSG OE82",100, 0) | |
| 11334 | ; | |
| 11335 | "RTN","PSG OE82",101, 0) | |
| 11336 | DEL ; dele te entry | |
| 11337 | "RTN","PSG OE82",102, 0) | |
| 11338 | W !?3,"SU RE YOU WAN T TO DELET E" S %=0 D YN^DICN I %'=1 W $C (7)," <NO THING DELE TED>" | |
| 11339 | "RTN","PSG OE82",103, 0) | |
| 11340 | Q | |
| 11341 | "RTN","PSG OE82",104, 0) | |
| 11342 | ; | |
| 11343 | "RTN","PSG OE82",105, 0) | |
| 11344 | CLOZPRV ;; START NCC T4 MODS > > 327*RJS | |
| 11345 | "RTN","PSG OE82",106, 0) | |
| 11346 | I '$G(PSG DRG) D LIS T^DIC(50,, .01,"I",,, PSGPDRG,"A SP",,,"ARR AY") Q:'AR RAY("DILIS T",0) S P SGDRG=ARRA Y("DILIST" ,2,1) Q:'$ L($$GET1^D IQ(50,PSGD RG,.01)) | |
| 11347 | "RTN","PSG OE82",107, 0) | |
| 11348 | I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" D | |
| 11349 | "RTN","PSG OE82",108, 0) | |
| 11350 | .I PSGPR' =+Y S PSGP R=+Y,PSGPR N=Y(0,0) | |
| 11351 | "RTN","PSG OE82",109, 0) | |
| 11352 | .S ANQX=0 D PROVCHK ^PSJCLOZ(P SGPR) | |
| 11353 | "RTN","PSG OE82",110, 0) | |
| 11354 | .I ANQX=0 K PSTMPN, PSTMPI | |
| 11355 | "RTN","PSG OE82",111, 0) | |
| 11356 | ;; END NC C T4 MODS << 327*RJS | |
| 11357 | "RTN","PSG OE82",112, 0) | |
| 11358 | Q | |
| 11359 | "RTN","PSG OE82",113, 0) | |
| 11360 | ; | |
| 11361 | "RTN","PSG OE82",114, 0) | |
| 11362 | YN ; yes/n o as a set of codes | |
| 11363 | "RTN","PSG OE82",115, 0) | |
| 11364 | I X'?.U F Y=1:1:$L( X) I $E(X, Y)?1L S X= $E(X,1,Y-1 )_$C($A(X, Y)-32)_$E( X,Y+1,$L(X )) | |
| 11365 | "RTN","PSG OE82",116, 0) | |
| 11366 | F Y="NO", "YES" I $P (Y,X)="" W $P(Y,X,2) Q | |
| 11367 | "RTN","PSG OE82",117, 0) | |
| 11368 | Q | |
| 11369 | "RTN","PSG OE82",118, 0) | |
| 11370 | DDOC(PSGX) ; Order c heck on ad ditional d ispense dr ug for all ergy and a dv. reacti ons. | |
| 11371 | "RTN","PSG OE82",119, 0) | |
| 11372 | N PSGY,PS GND1,PSGND 3,PSJALLGY | |
| 11373 | "RTN","PSG OE82",120, 0) | |
| 11374 | S PSGY=0 F S PSGX= $O(^PS(53. 45,PSJSYSP ,2,PSGX)) Q:'PSGX S PSGY=$P($ G(^PS(53.4 5,PSJSYSP, 2,PSGX,0)) ,"^") Q:PS GY="" D | |
| 11375 | "RTN","PSG OE82",121, 0) | |
| 11376 | . N INTER VEN,PSJDDI ,PSJIREQ,P SJRXREQ,PS JDD,PSGORQ F,PSJPDRG S PSJDD=PS GY | |
| 11377 | "RTN","PSG OE82",122, 0) | |
| 11378 | . S Y=1,( PSJIREQ,PS JRXREQ,INT ERVEN,X)=" " | |
| 11379 | "RTN","PSG OE82",123, 0) | |
| 11380 | . I '$G(P SJALGY1) S PSJALLGY( PSJDD)="" D ALLERGY^ PSJOC | |
| 11381 | "RTN","PSG OE82",124, 0) | |
| 11382 | . ;D IVSO L^PSGSICHK | |
| 11383 | "RTN","PSG OE82",125, 0) | |
| 11384 | . I ($D(P SGORQF)) D | |
| 11385 | "RTN","PSG OE82",126, 0) | |
| 11386 | .. K ^PS( 53.45,PSJS YSP,2,PSGX ),^PS(53.4 5,PSJSYSP, 2,"B",PSGY ) | |
| 11387 | "RTN","PSG OE82",127, 0) | |
| 11388 | Q | |
| 11389 | "RTN","PSG OE82",128, 0) | |
| 11390 | ; | |
| 11391 | "RTN","PSG OE82",129, 0) | |
| 11392 | F101 ;;101 ^PSGOE8 | |
| 11393 | "RTN","PSG OE82",130, 0) | |
| 11394 | F109 ;;109 ^PSGOE8 | |
| 11395 | "RTN","PSG OE82",131, 0) | |
| 11396 | F3 ;;3^PSG OE8 | |
| 11397 | "RTN","PSG OE82",132, 0) | |
| 11398 | F7 ;;7^PSG OE8 | |
| 11399 | "RTN","PSG OE82",133, 0) | |
| 11400 | PSGF26 ;;2 6^PSGOE8 | |
| 11401 | "RTN","PSG OE82",134, 0) | |
| 11402 | F39 ;;39^P SGOE81 | |
| 11403 | "RTN","PSG OE82",135, 0) | |
| 11404 | F8 ;;8^PSG OE81 | |
| 11405 | "RTN","PSG OE82",136, 0) | |
| 11406 | F10 ;;10^P SGOE81 | |
| 11407 | "RTN","PSG OE82",137, 0) | |
| 11408 | PSGF25 ;;2 5^PSGOE81 | |
| 11409 | "RTN","PSG OE82",138, 0) | |
| 11410 | F1 ;;1^PSG OE82 | |
| 11411 | "RTN","PSG OE82",139, 0) | |
| 11412 | F5 ;;5^PSG OE82 | |
| 11413 | "RTN","PSG OE82",140, 0) | |
| 11414 | PSGF2 ;;2^ PSGOE82 | |
| 11415 | "RTN","PSG OE91") | |
| 11416 | 0^30^B1612 84303 | |
| 11417 | "RTN","PSG OE91",1,0) | |
| 11418 | PSGOE91 ;B IR/CML3-AC TIVE ORDER EDIT (CON T.) ;Jul 2 6, 2017@18 :04:02 | |
| 11419 | "RTN","PSG OE91",2,0) | |
| 11420 | ;;5.0;INP ATIENT MED ICATIONS;* *50,64,58, 110,111,13 6,113,179, 265,267,28 5,315,334, 327**;16 D EC 97;Buil d 64 | |
| 11421 | "RTN","PSG OE91",3,0) | |
| 11422 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 11423 | "RTN","PSG OE91",4,0) | |
| 11424 | ; Referen ce to ^PS( 55 is supp orted by D BIA #2191. | |
| 11425 | "RTN","PSG OE91",5,0) | |
| 11426 | ; Referen ce to ^PS( 50.7 is su pported by DBIA# 218 0 | |
| 11427 | "RTN","PSG OE91",6,0) | |
| 11428 | ; Referen ce to ^PS( 51.1 is su pported by DBIA 2177 . | |
| 11429 | "RTN","PSG OE91",7,0) | |
| 11430 | ;External reference YSCLTST2 supported by DBIA 45 56 | |
| 11431 | "RTN","PSG OE91",8,0) | |
| 11432 | ; | |
| 11433 | "RTN","PSG OE91",9,0) | |
| 11434 | 41 ; admin times | |
| 11435 | "RTN","PSG OE91",10,0 ) | |
| 11436 | ;S MSG=0, PSGF2=41,O RIG=$G(PSG AT) S:PSGO EEF(PSGF2) BACK="41^ PSGOE91" | |
| 11437 | "RTN","PSG OE91",11,0 ) | |
| 11438 | ;*315 nex t 5 lines | |
| 11439 | "RTN","PSG OE91",12,0 ) | |
| 11440 | N PSGDOA | |
| 11441 | "RTN","PSG OE91",13,0 ) | |
| 11442 | S MSG=0,P SGF2=41,OR IG=$G(PSGA T),PSGDOA= $G(PSGDUR) S:PSGOEEF (PSGF2) BA CK="41^PSG OE91" | |
| 11443 | "RTN","PSG OE91",14,0 ) | |
| 11444 | I (PSGST= "P")!$$PRN OK^PSGS0($ G(PSGSCH)) G DONE | |
| 11445 | "RTN","PSG OE91",15,0 ) | |
| 11446 | I $$ODD^P SGS0(PSGS0 XT) D PSGD UR G DONE | |
| 11447 | "RTN","PSG OE91",16,0 ) | |
| 11448 | A41 I $G(P SJORD),$G( PSGP) I $$ COMPLEX^PS JOE(PSGP,P SJORD) S P SGOEE=0 D G DONE | |
| 11449 | "RTN","PSG OE91",17,0 ) | |
| 11450 | .W !!?5," ADMIN TIME S may not be edited for active complex o rders." D PAUSE^VALM 1 | |
| 11451 | "RTN","PSG OE91",18,0 ) | |
| 11452 | W !,"ADMI N TIMES: " _$S(PSGAT: PSGAT_"// ",1:"") R X:DTIME I X="^"!('$T ) W:'$T $C (7) S PSGO EE=0 S:X=" ^" (X,PSGA T)=$G(ORIG ),PSGDUR=" " G DONE | |
| 11453 | "RTN","PSG OE91",19,0 ) | |
| 11454 | I X="" S: $G(PSGAT) X=PSGAT,PS GNOHI=1 ;* 315 If adm in time de fault was taken then don't hig hlight adm in time. | |
| 11455 | "RTN","PSG OE91",20,0 ) | |
| 11456 | I $E(X)=" ^" D ENFF^ PSGOE92 G: Y>0 @Y G A 41 | |
| 11457 | "RTN","PSG OE91",21,0 ) | |
| 11458 | I X="@" I (PSGS0XT= "D")!(PSGS CH["@") I ((",P,R,OC ,O,")'[(", "_$G(PSGST )_",")) D G A41 | |
| 11459 | "RTN","PSG OE91",22,0 ) | |
| 11460 | .W $C(7), " ??" S X ="?" W:PSG S0XT="D"!( PSGSCH["@" ) !,"This is a 'DAY OF THE WEE K' schedul e and MUST have admi n times." D ENHLP^PS GOEM(55.06 ,41) | |
| 11461 | "RTN","PSG OE91",23,0 ) | |
| 11462 | I X="@" D DEL G:%'= 1 A41 S PS GAT="",X=" " | |
| 11463 | "RTN","PSG OE91",24,0 ) | |
| 11464 | I ((PSGST ="O")!($G( PSGST)="OC ")!($G(PSG ST)="P")!$ $ODD^PSGS0 ($P($G(ZZN D),"^",3)) !($P($G(ZZ ND),"^",5) ="O")),X=" " D G DON E | |
| 11465 | "RTN","PSG OE91",25,0 ) | |
| 11466 | .S (PSGS0 Y,PSGAT)=X | |
| 11467 | "RTN","PSG OE91",26,0 ) | |
| 11468 | .I (($G(P SGRF))&($G (PSGST)="O ")) N PSGR O S PSGOEE F(34)=1,PS GOEEF(41)= 1,PSGRO=1 D 34 | |
| 11469 | "RTN","PSG OE91",27,0 ) | |
| 11470 | I $G(PSGS 0XT) I '$$ ODD^PSGS0( PSGS0XT),$ G(PSGST)'= "P",$G(PSG ST)'="OC", '$$PRNOK^P SGS0(PSGSC H) I ($G(P SGST)'="O" ) D TIMES G:'$D(X) A 41 D PSGDU R G:'$D(X) A41 G:$G( X)="^" DON E ;*315 | |
| 11471 | "RTN","PSG OE91",28,0 ) | |
| 11472 | I X?1."?" D ENHLP^P SGOEM(55.0 6,41) G A4 1 | |
| 11473 | "RTN","PSG OE91",29,0 ) | |
| 11474 | D ENCHK^P SGS0 I '$D (X) W $C(7 )," ??" S X="?" D E NHLP^PSGOE M(55.06,41 ) G A41 | |
| 11475 | "RTN","PSG OE91",30,0 ) | |
| 11476 | S PSGOAT= PSGAT | |
| 11477 | "RTN","PSG OE91",31,0 ) | |
| 11478 | S (PSGS0Y ,PSGAT)=X G DONE | |
| 11479 | "RTN","PSG OE91",32,0 ) | |
| 11480 | ; | |
| 11481 | "RTN","PSG OE91",33,0 ) | |
| 11482 | 8 ; specia l instruct ions | |
| 11483 | "RTN","PSG OE91",34,0 ) | |
| 11484 | S MSG=0,P SGF2=8 S:P SGOEEF(PSG F2) BACK=" 8^PSGOE91" | |
| 11485 | "RTN","PSG OE91",35,0 ) | |
| 11486 | A8 I $G(PS GP),$G(PSG ORD) I $$C OMPLEX^PSJ OE(PSGP,PS GORD) D | |
| 11487 | "RTN","PSG OE91",36,0 ) | |
| 11488 | .N X,Y,PA RENT S PAR ENT=$S(PSG ORD["U":$$ GET1^DIQ(5 5.06,+PSGO RD_","_PSG P,125,"I") ,1:$$GET1^ DIQ(53.1,+ PSGORD,125 ,"I")) | |
| 11489 | "RTN","PSG OE91",37,0 ) | |
| 11490 | .I PARENT D FULL^VA LM1 W !!?5 ,"This ord er is part of a comp lex order. Please re view the f ollowing " ,!?5,"asso ciated ord ers before changing this order ." D CMPLX ^PSJCOM1(P SGP,PARENT ,PSGORD) | |
| 11491 | "RTN","PSG OE91",38,0 ) | |
| 11492 | I $E(X)=U D ENFF^PS GOE92 G:Y> 0 @Y G A8 | |
| 11493 | "RTN","PSG OE91",39,0 ) | |
| 11494 | S PSGSI=$ $EDITSI^PS JBCMA5($G( PSGP),$G(P SGORD)) I $G(PSGP),$ G(PSGORD) I '$$DIFFS I^PSJBCMA5 (PSGP,PSGO RD) S PSGO EE=0 G DON E | |
| 11495 | "RTN","PSG OE91",40,0 ) | |
| 11496 | S PSGSI=$ S((PSGSI>0 &(PSGSI<4) ):$$GET1^D IQ(53.455, "1,"_+PSJS YSP,.01)_" "_$$GET1^ DIQ(53.455 ,"2,"_+PSJ SYSP,.01), PSGSI>3:"I nstruction s too long . See Orde r View or BCMA for f ull text." ,1:"") | |
| 11497 | "RTN","PSG OE91",41,0 ) | |
| 11498 | S:PSGSI=" " PSGSI=" " I PSGSI] "" S PSGSI =$$ENBCMA^ PSJUTL("U" ) G DONE | |
| 11499 | "RTN","PSG OE91",42,0 ) | |
| 11500 | Q | |
| 11501 | "RTN","PSG OE91",43,0 ) | |
| 11502 | ; | |
| 11503 | "RTN","PSG OE91",44,0 ) | |
| 11504 | 10 ; start date/time | |
| 11505 | "RTN","PSG OE91",45,0 ) | |
| 11506 | S MSG=0,P SGF2=10 S: PSGOEEF(PS GF2) BACK= "10^PSGOE9 1" | |
| 11507 | "RTN","PSG OE91",46,0 ) | |
| 11508 | A10 ; | |
| 11509 | "RTN","PSG OE91",47,0 ) | |
| 11510 | I $G(PSJO RD),$G(PSG P) I $$COM PLEX^PSJOE (PSGP,PSJO RD) S PSGO EE=0 D G DONE | |
| 11511 | "RTN","PSG OE91",48,0 ) | |
| 11512 | .W !!?5," Start Date /Time may not be edi ted for ac tive compl ex orders. " D PAUSE^ VALM1 | |
| 11513 | "RTN","PSG OE91",49,0 ) | |
| 11514 | K PSGSDX | |
| 11515 | "RTN","PSG OE91",50,0 ) | |
| 11516 | W !,"STAR T DATE/TIM E: "_$S($P (PSGSDN,"^ ")]"":$P(P SGSDN,"^") _"// ",1:" ") R X:DTI ME I X="^" !'$T W:'$T $C(7) S P SGOEE=0 G DONE | |
| 11517 | "RTN","PSG OE91",51,0 ) | |
| 11518 | I X="",PS GSD W " " _PSGSDN G DONE | |
| 11519 | "RTN","PSG OE91",52,0 ) | |
| 11520 | I X="P" D ENPREV^PS GDL W:'$D( X) $C(7) G :'$D(X) A1 0 S PSGSD= +X,PSGSDN= $$ENDD^PSG MI(PSGSD)_ "^"_$$ENDT C^PSGMI(PS GSD) W " ",$P(PSGSD N,"^") G D ONE | |
| 11521 | "RTN","PSG OE91",53,0 ) | |
| 11522 | I X="@"!( X?1."?") W :X="@" $C( 7)," (Req uired)" S: X="@" X="? " D ENHLP^ PSGOEM(55. 06,10) | |
| 11523 | "RTN","PSG OE91",54,0 ) | |
| 11524 | I $E(X)=" ^" D ENFF^ PSGOE92 G: Y>0 @Y G A 10 | |
| 11525 | "RTN","PSG OE91",55,0 ) | |
| 11526 | NEW TMPX S TMPX=X,X 1=PSGDT,X2 =-7 D C^%D TC K %DT S %DT="ERTX ",%DT(0)=X ,X=TMPX D ^%DT K %DT I Y'>0 D ENHLP^PSGO EM(55.06,1 0) G A10 | |
| 11527 | "RTN","PSG OE91",56,0 ) | |
| 11528 | I PSGFD<Y W $C(7),! ?5,"*** TH E START DA TE CANNOT BE AFTER T HE STOP DA TE! ***",! S MSG=1 G A10 | |
| 11529 | "RTN","PSG OE91",57,0 ) | |
| 11530 | N X1,X2,D IFF,PSGEMR G,PSGBACK S X1=PSGFD ,X2=Y D ^% DTC S DIFF =X | |
| 11531 | "RTN","PSG OE91",58,0 ) | |
| 11532 | I '$G(PSG DRG) N PSG DRG D | |
| 11533 | "RTN","PSG OE91",59,0 ) | |
| 11534 | .N ORIFN, CLOZFLG S ORIFN=+$P( $G(PSJXX1) ,U,21) I O RIFN D I $G(PSGDRG) | |
| 11535 | "RTN","PSG OE91",60,0 ) | |
| 11536 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) I PSGPTR D | |
| 11537 | "RTN","PSG OE91",61,0 ) | |
| 11538 | ...S PSGD RG=$$GET1^ DIQ(100.04 5,PSGPTR_" ,"_ORIFN,1 ,"I") | |
| 11539 | "RTN","PSG OE91",62,0 ) | |
| 11540 | .E I $D( PSJXDOX("D D")) S PSG DRG=$O(PSJ XDOX("DD", "")) | |
| 11541 | "RTN","PSG OE91",63,0 ) | |
| 11542 | I $G(PSGD RG),$$GET1 ^DIQ(50,PS GDRG,17.5) ="PSOCLO1" S CLOZFLG =1 | |
| 11543 | "RTN","PSG OE91",64,0 ) | |
| 11544 | S PSGEMRG =$S($$GET1 ^DIQ(55,DF N,53)?1U6N :1,1:0),PS GBACK=0 | |
| 11545 | "RTN","PSG OE91",65,0 ) | |
| 11546 | I PSGEMRG ,$G(CLOZFL G),DIFF>4 D G A10 ; Emergen cy Registr ation peri od not to exceed 4 d ays | |
| 11547 | "RTN","PSG OE91",66,0 ) | |
| 11548 | .W !!?13, "*** EMERG ENCY SUPPL Y NOT TO E XCEED 4 DA YS! ***",! | |
| 11549 | "RTN","PSG OE91",67,0 ) | |
| 11550 | I 'PSGEMR G,$G(CLOZF LG) D G:P SGBACK A10 | |
| 11551 | "RTN","PSG OE91",68,0 ) | |
| 11552 | .N CLOZNU M,CLOZUID, X2,PSGCFLG ,PSGANC S CLOZNUM=$$ GET1^DIQ(5 5,DFN,53) | |
| 11553 | "RTN","PSG OE91",69,0 ) | |
| 11554 | .I CLOZNU M'="" S CL OZUID=$$FI ND1^DIC(60 3.01,,"X", CLOZNUM) | |
| 11555 | "RTN","PSG OE91",70,0 ) | |
| 11556 | .I $G(CLO ZUID) S CL OZPAT=$$GE T1^DIQ(603 .01,CLOZUI D,2,"I") D | |
| 11557 | "RTN","PSG OE91",71,0 ) | |
| 11558 | ..S CLOZP AT=$S(CLOZ PAT="M":2, CLOZPAT="B ":1,CLOZPA T="W":0,1: "") | |
| 11559 | "RTN","PSG OE91",72,0 ) | |
| 11560 | .S PSGCFL G=1,PSGANC =$$CL^YSCL TST2(DFN) | |
| 11561 | "RTN","PSG OE91",73,0 ) | |
| 11562 | .I '$$OVE RRIDE^YSCL TST2(DFN), '+$P(PSGAN C,"^",4) S X2=4 | |
| 11563 | "RTN","PSG OE91",74,0 ) | |
| 11564 | .E S X2= $S($G(CLOZ PAT)=2:28, $G(CLOZPAT )=1:14,$G( CLOZPAT)=0 :7,1:90) | |
| 11565 | "RTN","PSG OE91",75,0 ) | |
| 11566 | .I DIFF>X 2 W !!,"** * SUPPLY P ERIOD NOT TO EXCEED "_X2_" DAY S! ***",! S PSGBACK= 1 | |
| 11567 | "RTN","PSG OE91",76,0 ) | |
| 11568 | S (PSGSDX ,PSGSD)=+Y ,PSGSDN=$$ ENDD^PSGMI (PSGSD)_"^ "_$$ENDTC^ PSGMI(PSGS D) | |
| 11569 | "RTN","PSG OE91",77,0 ) | |
| 11570 | G DONE | |
| 11571 | "RTN","PSG OE91",78,0 ) | |
| 11572 | ; | |
| 11573 | "RTN","PSG OE91",79,0 ) | |
| 11574 | 34 ; stop date | |
| 11575 | "RTN","PSG OE91",80,0 ) | |
| 11576 | S MSG=0,P SGF2=34 S: PSGOEEF(PS GF2) BACK= "34^PSGOE9 1" | |
| 11577 | "RTN","PSG OE91",81,0 ) | |
| 11578 | A34 ; | |
| 11579 | "RTN","PSG OE91",82,0 ) | |
| 11580 | K PSGFDX N PSGEMRG | |
| 11581 | "RTN","PSG OE91",83,0 ) | |
| 11582 | I $G(PSJO RD),$G(PSG P) I $$COM PLEX^PSJOE (PSGP,PSJO RD),'$$LAS TCHLD^PSJC LOZ(PSGP,P SJORD) S P SGOEE=0 D G DONE | |
| 11583 | "RTN","PSG OE91",84,0 ) | |
| 11584 | .W !!?5," Stop Date/ Time may n ot be edit ed for act ive comple x orders." D PAUSE^V ALM1 | |
| 11585 | "RTN","PSG OE91",85,0 ) | |
| 11586 | ;; START NCC REMEDI ATION RJS* 327 | |
| 11587 | "RTN","PSG OE91",86,0 ) | |
| 11588 | I '$G(PSG DRG) N PSG DRG D | |
| 11589 | "RTN","PSG OE91",87,0 ) | |
| 11590 | .N ORIFN, CLOZFLG S ORIFN=+$P( $G(PSJXX1) ,U,21) I O RIFN D I $G(PSGDRG) | |
| 11591 | "RTN","PSG OE91",88,0 ) | |
| 11592 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) I PSGPTR D | |
| 11593 | "RTN","PSG OE91",89,0 ) | |
| 11594 | ...S PSGD RG=$$GET1^ DIQ(100.04 5,PSGPTR_" ,"_ORIFN,1 ,"I") | |
| 11595 | "RTN","PSG OE91",90,0 ) | |
| 11596 | .E I $D( PSJXDOX("D D")) S PSG DRG=$O(PSJ XDOX("DD", "")) | |
| 11597 | "RTN","PSG OE91",91,0 ) | |
| 11598 | I $G(PSGD RG),$$GET1 ^DIQ(50,PS GDRG,17.5) ="PSOCLO1" S CLOZFLG =1 | |
| 11599 | "RTN","PSG OE91",92,0 ) | |
| 11600 | I '$D(CLO ZPAT),$G(C LOZFLG) N CLOZPAT S: $$FIND1^DI C(603.01,, "Q",DFN,"C ") CLOZPAT =1 | |
| 11601 | "RTN","PSG OE91",93,0 ) | |
| 11602 | I $D(CLOZ PAT) N PSG OLDED,PSGF DNOLD S PS GOLDED=PSG FD,PSGFDNO LD=PSGFDN | |
| 11603 | "RTN","PSG OE91",94,0 ) | |
| 11604 | ;; END NC C REMEDIAT ION RJS*32 7 | |
| 11605 | "RTN","PSG OE91",95,0 ) | |
| 11606 | N MSG,PSG TMPST S PS GTMPST=$G( PSGST) S:' +$G(PSGRF) PSGRF=+$$ GET1^DIQ(5 0.7,$G(PSG PDRG),12," I") ;*315 One time o rders for MRR's requ ire messag e to instr uct pharma cists | |
| 11607 | "RTN","PSG OE91",96,0 ) | |
| 11608 | I +$G(PSG RF),$$FIND 1^DIC(51.1 ,,"X",$G(P SGSCH)) D | |
| 11609 | "RTN","PSG OE91",97,0 ) | |
| 11610 | .S:PSGTMP ST=($G(PSG ST)="R") P SGST=$$GET 1^DIQ(51.1 ,$$FIND1^D IC(51.1,," X",$G(PSGS CH)),5,"I" ) ;Handle "Fill on R equest" | |
| 11611 | "RTN","PSG OE91",98,0 ) | |
| 11612 | I $G(PSGT MPST)="O", +$G(PSGRF) S (PSGFDN ,PSGFD)="" D | |
| 11613 | "RTN","PSG OE91",99,0 ) | |
| 11614 | .I +$G(PS GRF)=1 S M SG(1)="Thi s NOW orde r has an O rderable I tem for wh ich a remo val is req uired" D | |
| 11615 | "RTN","PSG OE91",100, 0) | |
| 11616 | ..S MSG(2 )=" at the next admi nistration ." | |
| 11617 | "RTN","PSG OE91",101, 0) | |
| 11618 | ..S MSG(3 )="The Sto p DATE/TIM E entered should be the next a nticipated administr ation for the medica tion.",MSG (3,"F")="! " | |
| 11619 | "RTN","PSG OE91",102, 0) | |
| 11620 | .I +$G(PS GRF)=2 S M SG(1)="Thi s NOW orde r has an O rderable I tem for wh ich a remo val period is option al",MSG(1, "F")="!!" D | |
| 11621 | "RTN","PSG OE91",103, 0) | |
| 11622 | ..S MSG(2 )="prior t o the next administr ation.",MS G(2,"F")=" !" | |
| 11623 | "RTN","PSG OE91",104, 0) | |
| 11624 | ..S MSG(3 )="If Earl y Removal is needed, enter Rem oval Time in Stop DA TE/TIME fi eld.",MSG( 3,"F")="!" | |
| 11625 | "RTN","PSG OE91",105, 0) | |
| 11626 | ..S MSG(4 )="If an E arly Remov al is not required, the Stop D ATE/TIME e ntered" | |
| 11627 | "RTN","PSG OE91",106, 0) | |
| 11628 | ..S MSG(5 )="should be the nex t anticipa ted admini stration f or the med ication.", MSG(5,"F") ="!" | |
| 11629 | "RTN","PSG OE91",107, 0) | |
| 11630 | .I +$G(PS GRF)=3 S M SG(1)="Thi s NOW orde r has an O rderable I tem that r equires a removal pe riod prior ",MSG(1,"F ")="!!" D | |
| 11631 | "RTN","PSG OE91",108, 0) | |
| 11632 | ..S MSG(2 )=" to the next admi nistration .",MSG(2," F")="!" | |
| 11633 | "RTN","PSG OE91",109, 0) | |
| 11634 | ..S MSG(3 )="Please Enter the Stop DATE/ TIME to re flect the Removal Ti me for thi s medicati on.",MSG(3 ,"F")="!" | |
| 11635 | "RTN","PSG OE91",110, 0) | |
| 11636 | .D EN^DDI OL(.MSG) | |
| 11637 | "RTN","PSG OE91",111, 0) | |
| 11638 | W !,"STOP DATE/TIME : "_$S($P( PSGFDN,"^" )]"":$P(PS GFDN,"^")_ "// ",1:"" ) R X:DTIM E I X="^"! '$T W:'$T $C(7) S PS GOEE=0 G D ONE | |
| 11639 | "RTN","PSG OE91",112, 0) | |
| 11640 | I X="",PS GFD W " "_$P(PSGFD N,"^") G W 34 | |
| 11641 | "RTN","PSG OE91",113, 0) | |
| 11642 | I $E(X)=" ^" D ENFF^ PSGOE92 G: Y>0 @Y G A 34 | |
| 11643 | "RTN","PSG OE91",114, 0) | |
| 11644 | I X="@"!( X?1."?") W :X="@" $C( 7)," (Req uired)" S: X="@" X="? " D ENHLP^ PSGOEM(55. 06,34) | |
| 11645 | "RTN","PSG OE91",115, 0) | |
| 11646 | I X=+X,(X >0),(X'>20 00000) G A 34:'$$ENDL ^PSGDL(PSG SCH,X) K P SGDLS S PS GDL=X W " ...dose li mit..." D ENE^PSGDL | |
| 11647 | "RTN","PSG OE91",116, 0) | |
| 11648 | K %DT S % DT="ERTX", %DT(0)=PSG SD D ^%DT K %DT I Y' >0 W $C(7) ,!!?13,"** * WARNING! INVALID S TOP DATE O R PRIOR TO START DAT E! ***",! G A34 | |
| 11649 | "RTN","PSG OE91",117, 0) | |
| 11650 | S (PSGFDX ,PSGFD)=+Y ,PSGFDN=$$ ENDD^PSGMI (PSGFD)_"^ "_$$ENDTC^ PSGMI(PSGF D) | |
| 11651 | "RTN","PSG OE91",118, 0) | |
| 11652 | ;/RJS Beg in changes for emerg ency regis tration of clozapine patient S et end dat e to start date + 4 days at mi dnight. | |
| 11653 | "RTN","PSG OE91",119, 0) | |
| 11654 | I '$D(CLO ZPAT),$G(C LOZFLG) N CLOZPAT S: $$FIND1^DI C(603.01,, "Q",DFN,"C ") CLOZPAT =1 | |
| 11655 | "RTN","PSG OE91",120, 0) | |
| 11656 | I $$GET1^ DIQ(55,DFN ,53)?1U6N, $G(CLOZFLG ) D G:X>4 A34 ;def 418867 RJ S*327 | |
| 11657 | "RTN","PSG OE91",121, 0) | |
| 11658 | .S X1=+Y, X2=PSGSD D ^%DTC | |
| 11659 | "RTN","PSG OE91",122, 0) | |
| 11660 | .S PSGEMR G=1 Q:X'>4 | |
| 11661 | "RTN","PSG OE91",123, 0) | |
| 11662 | .I X>4 D | |
| 11663 | "RTN","PSG OE91",124, 0) | |
| 11664 | ..W !!?13 ,"*** EMER GENCY SUPP LY NOT TO EXCEED 4 D AYS! ***", ! | |
| 11665 | "RTN","PSG OE91",125, 0) | |
| 11666 | ..S $P(PS GFD,".",2) =2359,X1=P SGSD,X2=4 D C^%DTC S PSGFD=X | |
| 11667 | "RTN","PSG OE91",126, 0) | |
| 11668 | ..S $P(PS GFDN,"^",1 )=$$ENDD^P SGMI(PSGFD ),$P(PSGFD N,"^",2)=P SGFD | |
| 11669 | "RTN","PSG OE91",127, 0) | |
| 11670 | ;/RJS End changes f or emergen cy registr ation of c lozapine p atient Set end date to start d ate + 4 da ys at midn ight. | |
| 11671 | "RTN","PSG OE91",128, 0) | |
| 11672 | C34 I $D(C LOZPAT),'$ G(PSGEMRG) ,$G(CLOZFL G) N PSGBA CK D G:$G (PSGBACK) A34 | |
| 11673 | "RTN","PSG OE91",129, 0) | |
| 11674 | .N CLOZNU M,CLOZUID, PSGANC,PSG OVRD,PSGCF LG S PSGCF LG=1 | |
| 11675 | "RTN","PSG OE91",130, 0) | |
| 11676 | .S:$$OVER RIDE^YSCLT ST2(DFN) P SGOVRD=1 | |
| 11677 | "RTN","PSG OE91",131, 0) | |
| 11678 | .S PSGANC =$$CL^YSCL TST2(DFN) | |
| 11679 | "RTN","PSG OE91",132, 0) | |
| 11680 | .S CLOZNU M=$$GET1^D IQ(55,DFN, 53) | |
| 11681 | "RTN","PSG OE91",133, 0) | |
| 11682 | .I $L(CLO ZNUM) S CL OZUID=$$FI ND1^DIC(60 3.01,,"X", CLOZNUM) | |
| 11683 | "RTN","PSG OE91",134, 0) | |
| 11684 | .I $G(CLO ZUID) S CL OZPAT=$$GE T1^DIQ(603 .01,CLOZUI D,2,"I"),C LOZPAT=$S( CLOZPAT="M ":2,CLOZPA T="B":1,CL OZPAT="W": 0,1:"") | |
| 11685 | "RTN","PSG OE91",135, 0) | |
| 11686 | .N X,X1,X 2 | |
| 11687 | "RTN","PSG OE91",136, 0) | |
| 11688 | .I '$G(PS GOVRD),'+$ P(PSGANC," ^",4) S X2 =4 | |
| 11689 | "RTN","PSG OE91",137, 0) | |
| 11690 | .E S X2= $S($G(CLOZ PAT)=2:28, $G(CLOZPAT )=1:14,$G( CLOZPAT)=0 :7,1:90) | |
| 11691 | "RTN","PSG OE91",138, 0) | |
| 11692 | .S X1=+Y D | |
| 11693 | "RTN","PSG OE91",139, 0) | |
| 11694 | ..N X2 S X2=PSGSD D ^%DTC S X 1=PSGFD | |
| 11695 | "RTN","PSG OE91",140, 0) | |
| 11696 | .I X>X2 S PSGFD=PSG OLDED,PSGF DN=PSGFDNO LD D | |
| 11697 | "RTN","PSG OE91",141, 0) | |
| 11698 | ..W !!,"* ** STOP DA TE/TIME NO T TO EXCEE D "_X2_" D AYS! ***", ! S PSGBAC K=1 | |
| 11699 | "RTN","PSG OE91",142, 0) | |
| 11700 | K:$G(PSGE MRG) PSGEM RG | |
| 11701 | "RTN","PSG OE91",143, 0) | |
| 11702 | ;/RJS End verify th at stop da te does no t exceed m aximum day s supply b ased on la b frequenc y. | |
| 11703 | "RTN","PSG OE91",144, 0) | |
| 11704 | S (PSGFDX ,PSGFD)=+Y ,PSGFDN=$$ ENDD^PSGMI (PSGFD)_"^ "_$$ENDTC^ PSGMI(PSGF D) | |
| 11705 | "RTN","PSG OE91",145, 0) | |
| 11706 | ;; END NC C REMEDIAT ION RJS*32 7 | |
| 11707 | "RTN","PSG OE91",146, 0) | |
| 11708 | W34 ;Compa re to Star t Date | |
| 11709 | "RTN","PSG OE91",147, 0) | |
| 11710 | N Z,MSG | |
| 11711 | "RTN","PSG OE91",148, 0) | |
| 11712 | D DOSE I $G(Z)]"",Z >$S($G(PSG FD):PSGFD, 1:$G(PSGNE FD)) D G A34 | |
| 11713 | "RTN","PSG OE91",149, 0) | |
| 11714 | .S MSG(1) ="There is no admini stration t ime that f alls betwe en the Sta rt Date/Ti me" | |
| 11715 | "RTN","PSG OE91",150, 0) | |
| 11716 | .S MSG(2) ="and the Stop Date/ Time." | |
| 11717 | "RTN","PSG OE91",151, 0) | |
| 11718 | .D EN^DDI OL(.MSG) | |
| 11719 | "RTN","PSG OE91",152, 0) | |
| 11720 | I PSGFD<P SGDT W $C( 7),!!?13," *** WARNIN G! THE STO P DATE ENT ERED IS IN THE PAST! ***",! S MSG=1 | |
| 11721 | "RTN","PSG OE91",153, 0) | |
| 11722 | Q:+$G(PSG RO) | |
| 11723 | "RTN","PSG OE91",154, 0) | |
| 11724 | ; | |
| 11725 | "RTN","PSG OE91",155, 0) | |
| 11726 | DONE ; | |
| 11727 | "RTN","PSG OE91",156, 0) | |
| 11728 | ;Display Expected F irst Dose; BHW;PSJ*5* 136 | |
| 11729 | "RTN","PSG OE91",157, 0) | |
| 11730 | ;BHW;PSJ* 5*179; - R emove EFD call. Add ed to PSGO EE. | |
| 11731 | "RTN","PSG OE91",158, 0) | |
| 11732 | I PSGOEE G:'PSGOEEF (PSGF2) @B ACK S PSGO EE=PSGOEEF (PSGF2) | |
| 11733 | "RTN","PSG OE91",159, 0) | |
| 11734 | D:+$G(PSG DUR) VERTI MES ;*315 | |
| 11735 | "RTN","PSG OE91",160, 0) | |
| 11736 | S:'+$G(PS GRF) PSGRF =+$$GET1^D IQ(50.7,$G (PSGPDRG), 12,"I") | |
| 11737 | "RTN","PSG OE91",161, 0) | |
| 11738 | K F,F0,F1 ,PSGF2,F3, PSG,SDT,OR IG Q | |
| 11739 | "RTN","PSG OE91",162, 0) | |
| 11740 | ; | |
| 11741 | "RTN","PSG OE91",163, 0) | |
| 11742 | FF ; up-ar row to ano ther field | |
| 11743 | "RTN","PSG OE91",164, 0) | |
| 11744 | D ENFF^PS GOEM I Y>0 ,Y'=41,Y'= 8,Y'=10,Y' =34 S Y=Y_ "^PSGOE9"_ $S("^109^1 3^3^7^26^" [("^"_Y_"^ "):"",1:2) S:Y=2 FB= PSGF2_"^PS GOE91" | |
| 11745 | "RTN","PSG OE91",165, 0) | |
| 11746 | Q | |
| 11747 | "RTN","PSG OE91",166, 0) | |
| 11748 | ; | |
| 11749 | "RTN","PSG OE91",167, 0) | |
| 11750 | DEL ; dele te entry | |
| 11751 | "RTN","PSG OE91",168, 0) | |
| 11752 | W !?3,"SU RE YOU WAN T TO DELET E" S %=0 D YN^DICN I %'=1 W $C (7)," <NO THING DELE TED>" | |
| 11753 | "RTN","PSG OE91",169, 0) | |
| 11754 | Q | |
| 11755 | "RTN","PSG OE91",170, 0) | |
| 11756 | ; | |
| 11757 | "RTN","PSG OE91",171, 0) | |
| 11758 | TIMES ;At least one admin time , not more than inte rval allow s. | |
| 11759 | "RTN","PSG OE91",172, 0) | |
| 11760 | I $G(PSGS T)'="O",($ G(PSGST)'= "OC"),($G( PSGST)'="R ") I X="" D EN^DDIOL ("This ord er require s at least one admin istration time.") K X Q ;No t imes | |
| 11761 | "RTN","PSG OE91",173, 0) | |
| 11762 | N H,I,MAX | |
| 11763 | "RTN","PSG OE91",174, 0) | |
| 11764 | I PSGSCH] "" S H=$$F IND1^DIC(5 1.1,,"X",P SGSCH) I H S I=$$GET 1^DIQ(51.1 ,H,2,"I") | |
| 11765 | "RTN","PSG OE91",175, 0) | |
| 11766 | I $G(PSGS T)="O",$L( X,"-")>1 D EN^DDIOL( "This is a One Time Order. Onl y one admi nistration time is p ermitted." ) K X Q | |
| 11767 | "RTN","PSG OE91",176, 0) | |
| 11768 | I $G(PSGS T)="O" Q ;Done vali dating One Time | |
| 11769 | "RTN","PSG OE91",177, 0) | |
| 11770 | I +$G(I)= 0 Q ;No f requency - can not c heck frequ ency relat ed items | |
| 11771 | "RTN","PSG OE91",178, 0) | |
| 11772 | S MAX=144 0/I | |
| 11773 | "RTN","PSG OE91",179, 0) | |
| 11774 | I MAX<1,$ L(X,"-")>1 D EN^DDIO L("This or der requir es one adm inistratio n time.") K X Q | |
| 11775 | "RTN","PSG OE91",180, 0) | |
| 11776 | I MAX'<1, $L(X,"-")> MAX D EN^D DIOL("The number of admin time s entered is greater than indi cated by t he schedul e.") K X Q ;Too man y times | |
| 11777 | "RTN","PSG OE91",181, 0) | |
| 11778 | I MAX'<1, $L(X,"-")< MAX D EN^D DIOL("The number of admin time s entered is fewer t han indica ted by the schedule. ") ;Too f ew times | |
| 11779 | "RTN","PSG OE91",182, 0) | |
| 11780 | Q | |
| 11781 | "RTN","PSG OE91",183, 0) | |
| 11782 | ; | |
| 11783 | "RTN","PSG OE91",184, 0) | |
| 11784 | DOSE ;Make certain a t least on e dose is given. | |
| 11785 | "RTN","PSG OE91",185, 0) | |
| 11786 | N INFO,X | |
| 11787 | "RTN","PSG OE91",186, 0) | |
| 11788 | S Z="",IN FO=($S($G( PSGSD):PSG SD,1:$G(PS GNESD)))_U _($S($G(PS GFD):PSGFD ,1:$G(PSGN EFD)))_U_( $G(PSGSCH) )_U_($G(PS GST))_U_($ G(PSGDRG)) _U_($G(PSG S0Y)) | |
| 11789 | "RTN","PSG OE91",187, 0) | |
| 11790 | Q:$G(PSGS T)="OC"!($ G(PSGST)=" P") | |
| 11791 | "RTN","PSG OE91",188, 0) | |
| 11792 | I '$L($G( PSGP)) N P SGP S PSGP ="" | |
| 11793 | "RTN","PSG OE91",189, 0) | |
| 11794 | S Z=$$ENQ ^PSJORP2(P SGP,INFO) ;Expected first dos e. | |
| 11795 | "RTN","PSG OE91",190, 0) | |
| 11796 | Q | |
| 11797 | "RTN","PSG OE91",191, 0) | |
| 11798 | ;*315 New tags | |
| 11799 | "RTN","PSG OE91",192, 0) | |
| 11800 | PSGDUR ; P rompt for Removal ti mes if adm in times a re on 24hr rotations and Site Params are enabled. | |
| 11801 | "RTN","PSG OE91",193, 0) | |
| 11802 | ; check p arameter f iles for r emoval cri teria quit if remova l rotation not enabl ed (<2) | |
| 11803 | "RTN","PSG OE91",194, 0) | |
| 11804 | ; if enab led determ ine type ( hard vers soft stop) | |
| 11805 | "RTN","PSG OE91",195, 0) | |
| 11806 | ;0 = no r emoval | |
| 11807 | "RTN","PSG OE91",196, 0) | |
| 11808 | ;1 = remo val at nex t admin | |
| 11809 | "RTN","PSG OE91",197, 0) | |
| 11810 | ;2 = remo val prior to next ad min; soft stop | |
| 11811 | "RTN","PSG OE91",198, 0) | |
| 11812 | ;3 = remo val prior to next ad min; hard stop | |
| 11813 | "RTN","PSG OE91",199, 0) | |
| 11814 | ; prompt for remova l if = 2 t hen allow skip, if = 3 then fo rce entry | |
| 11815 | "RTN","PSG OE91",200, 0) | |
| 11816 | ; | |
| 11817 | "RTN","PSG OE91",201, 0) | |
| 11818 | S PSGRF=+ $$GET1^DIQ (50.7,$G(P SGPDRG),12 ,"I") Q:(( PSGRF<2)!( $G(PSGST)= "O")!($G(P SGST)="P") !($G(PSGST )="OC")) ; no remov al flag or no remova l rotation | |
| 11819 | "RTN","PSG OE91",202, 0) | |
| 11820 | Q:$G(PSGS 0XT)>1440 ; Duratio n of Admin istration valid only for 24 ho urs - subj ect to cha nge in fut ure. | |
| 11821 | "RTN","PSG OE91",203, 0) | |
| 11822 | N RP,PSGI DF,WMSG,PS GDERR S (P SGIDF,PSGD ERR)=0 S:$ G(PSGDUR)> 0 RP=(PSGD UR/60) S:" BID,TID,QI D"[$G(PSGS CH) PSGIDF =1 ; Use separate v alidation for Times per day ty pe orders | |
| 11823 | "RTN","PSG OE91",204, 0) | |
| 11824 | S PSGF2=4 1 | |
| 11825 | "RTN","PSG OE91",205, 0) | |
| 11826 | W !,"DURA TION OF AD MINISTRATI ON (HRS): "_$S($G(RP ):RP_"// " ,1:"") R R P:DTIME I RP="^"!'$T W:'$T $C( 7) S PSGDU R=$G(PSGDO A),X="^",P SGOEE=0 Q | |
| 11827 | "RTN","PSG OE91",206, 0) | |
| 11828 | I RP="" S :$G(PSGDUR )>0 RP=($G (PSGDUR)/6 0) | |
| 11829 | "RTN","PSG OE91",207, 0) | |
| 11830 | I RP="",$ G(PSGS0XT) ="D",$L(PS GSCH,"@")= 2,$P(PSGSC H,"@",2) S (PSGAT,PS GRMVT)=$P( PSGSCH,"@" ,2) G 8 | |
| 11831 | "RTN","PSG OE91",208, 0) | |
| 11832 | I RP="@", PSGRF'=3 D DEL G:%'= 1 PSGDUR S PSGS0Y="" ,(PSGDUR,P SGRMVT)="@ ",PSGRMV=- 1 Q | |
| 11833 | "RTN","PSG OE91",209, 0) | |
| 11834 | I (RP'="" ),(RP'="@" ),($E(RP)' ="^"),($E( RP)'="?") S:(RP'?1N. 2N)!(+(RP) <1) RP="?" | |
| 11835 | "RTN","PSG OE91",210, 0) | |
| 11836 | I RP?1."? " D DURHLP ^PSGOEM(RP ,PSGRF) G PSGDUR | |
| 11837 | "RTN","PSG OE91",211, 0) | |
| 11838 | I $E(RP)= "^" D FF G :Y>0 @Y G PSGDUR | |
| 11839 | "RTN","PSG OE91",212, 0) | |
| 11840 | I (+RP>0) ,'PSGIDF D I PSGRMV <1 G PSGDU R ; exclud e BID,TID or QID sch edules | |
| 11841 | "RTN","PSG OE91",213, 0) | |
| 11842 | . S PSGDU R=(RP*60), PSGRMV=$G( PSGS0XT)-P SGDUR | |
| 11843 | "RTN","PSG OE91",214, 0) | |
| 11844 | . I PSGRM V<1 W !,"D URATION OF ADMINISTR ATION MATC HES OR EXC EEDS ORDER FREQUENCY " S RP="", PSGDERR=1 K PSGDUR,P SGRMV ; G PSGDUR Q | |
| 11845 | "RTN","PSG OE91",215, 0) | |
| 11846 | .Q | |
| 11847 | "RTN","PSG OE91",216, 0) | |
| 11848 | Q:$G(PSGD ERR)=1 | |
| 11849 | "RTN","PSG OE91",217, 0) | |
| 11850 | I PSGRF=3 ,(+RP<1) W $C(7),!," ENTRY IS R EQUIRED" S RP="" G P SGDUR | |
| 11851 | "RTN","PSG OE91",218, 0) | |
| 11852 | I PSGRF=2 ,(+RP<1) D | |
| 11853 | "RTN","PSG OE91",219, 0) | |
| 11854 | .W !,"You have not entered Du ration of Administra tion for t his medica tion order , " | |
| 11855 | "RTN","PSG OE91",220, 0) | |
| 11856 | .W !,"the refore the BCMA user will not be prompte d to remov e the medi cation pri or " | |
| 11857 | "RTN","PSG OE91",221, 0) | |
| 11858 | .W !,"to the next A dmin Time. " | |
| 11859 | "RTN","PSG OE91",222, 0) | |
| 11860 | .S PSGRMV =-1,RP=0 | |
| 11861 | "RTN","PSG OE91",223, 0) | |
| 11862 | I PSGIDF, (+RP>0) D ;Only for TPD sched ules | |
| 11863 | "RTN","PSG OE91",224, 0) | |
| 11864 | .N F,P,PS GARR | |
| 11865 | "RTN","PSG OE91",225, 0) | |
| 11866 | .S PSGADT =$S($G(PSG DUR)=-1:X, $G(PSGS0Y) :PSGS0Y,$G (PSGAT):PS GAT,1:""), PSGS0Y=PSG ADT | |
| 11867 | "RTN","PSG OE91",226, 0) | |
| 11868 | .S PSGARR =$L($G(PSG ADT),"-") | |
| 11869 | "RTN","PSG OE91",227, 0) | |
| 11870 | .F P=1:1: PSGARR D | |
| 11871 | "RTN","PSG OE91",228, 0) | |
| 11872 | ..S PSGAR R(P)=($P(P SGADT,"-", P)/100) S: (P>1) F(P) =PSGARR(P) -PSGARR(P- 1) | |
| 11873 | "RTN","PSG OE91",229, 0) | |
| 11874 | ..I $G(F( P)),($G(F( P))'=RP) S WMSG=1_U_ "Duration of Adminis tration do es not cor respond to one or mo re",WMSG(1 )="of this order's s cheduled A dministrat ion Times! " | |
| 11875 | "RTN","PSG OE91",230, 0) | |
| 11876 | S:(+RP>0) PSGDUR=(R P*60) | |
| 11877 | "RTN","PSG OE91",231, 0) | |
| 11878 | W:(+RP>0) ?60,RP," HOURS" | |
| 11879 | "RTN","PSG OE91",232, 0) | |
| 11880 | D:$G(WMSG ) EN^DDIOL ($P(WMSG,U ,2)),EN^DD IOL(WMSG(1 )) | |
| 11881 | "RTN","PSG OE91",233, 0) | |
| 11882 | Q | |
| 11883 | "RTN","PSG OE91",234, 0) | |
| 11884 | ; | |
| 11885 | "RTN","PSG OE91",235, 0) | |
| 11886 | VERTIMES ; Redisplay Admin and Removal t imes *315 | |
| 11887 | "RTN","PSG OE91",236, 0) | |
| 11888 | S PSGRF=+ $$GET1^DIQ (50.7,$G(P SGPDRG),12 ,"I") Q:(P SGRF<2)!($ G(PSGST)=" O") | |
| 11889 | "RTN","PSG OE91",237, 0) | |
| 11890 | N PSGADT, PSGRARR,PS GAARR | |
| 11891 | "RTN","PSG OE91",238, 0) | |
| 11892 | ;If we ha ve a frequ ency and t his is odd type orde r then we need to st art calcul ations wit h order st art time. | |
| 11893 | "RTN","PSG OE91",239, 0) | |
| 11894 | I $G(PSGS 0XT),$G(PS GNESD),+$G (PSGDUR),$ G(PSGAT)=" " D Q | |
| 11895 | "RTN","PSG OE91",240, 0) | |
| 11896 | .N L | |
| 11897 | "RTN","PSG OE91",241, 0) | |
| 11898 | .S (PSGAA RR,PSGRARR )=1,PSGADT =$P($P(PSG NESD,U,1), ".",2),L=$ L(PSGADT) | |
| 11899 | "RTN","PSG OE91",242, 0) | |
| 11900 | .S PSGRAR R(1)=((((( PSGADT*60) +PSGDUR)/6 0)#24)*100 ) S:PSGRAR R(1)=0 PSG RARR(1)=24 00 S:$L(PS GRARR(1))= 3 PSGRARR( 1)="0"_PSG RARR(1) | |
| 11901 | "RTN","PSG OE91",243, 0) | |
| 11902 | .S PSGRAR R(1)=$E(PS GRARR(1),1 ,L)_"(R)" | |
| 11903 | "RTN","PSG OE91",244, 0) | |
| 11904 | .S PSGAAR R(1)=PSGAD T,PSGAARR( 1)=$E(PSGA ARR(1),1,L )_"(A)" | |
| 11905 | "RTN","PSG OE91",245, 0) | |
| 11906 | .D WRITE | |
| 11907 | "RTN","PSG OE91",246, 0) | |
| 11908 | ; | |
| 11909 | "RTN","PSG OE91",247, 0) | |
| 11910 | S (PSGRAR R,PSGAARR) =$S($G(PSG AT):$L(PSG AT,"-"),1: $L(PSGS0Y, "-")) | |
| 11911 | "RTN","PSG OE91",248, 0) | |
| 11912 | N P,L | |
| 11913 | "RTN","PSG OE91",249, 0) | |
| 11914 | F P=1:1:P SGRARR D | |
| 11915 | "RTN","PSG OE91",250, 0) | |
| 11916 | .S PSGADT =$S($G(PSG AT):$P(PSG AT,"-",P), 1:$P(PSGS0 Y,"-",P)), L=$L(PSGAD T) | |
| 11917 | "RTN","PSG OE91",251, 0) | |
| 11918 | .S PSGADT =$S($L(PSG ADT)=4:PSG ADT/100,1: PSGADT*1) | |
| 11919 | "RTN","PSG OE91",252, 0) | |
| 11920 | .S PSGRAR R(P)=((((( PSGADT*60) +PSGDUR)/6 0)#24)*100 ) S:PSGRAR R(P)=0 PSG RARR(P)=24 00 S:$L(PS GRARR(P))= 3 PSGRARR( P)="0"_PSG RARR(P) | |
| 11921 | "RTN","PSG OE91",253, 0) | |
| 11922 | .S PSGRAR R(P)=$E(PS GRARR(P),1 ,L)_"(R)" | |
| 11923 | "RTN","PSG OE91",254, 0) | |
| 11924 | .S PSGAAR R(P)=(PSGA DT*100) S: $L(PSGAARR (P))=3 PSG AARR(P)="0 "_PSGAARR( P) | |
| 11925 | "RTN","PSG OE91",255, 0) | |
| 11926 | .S PSGAAR R(P)=$E(PS GAARR(P),1 ,L)_"(A)" | |
| 11927 | "RTN","PSG OE91",256, 0) | |
| 11928 | D WRITE | |
| 11929 | "RTN","PSG OE91",257, 0) | |
| 11930 | Q | |
| 11931 | "RTN","PSG OE91",258, 0) | |
| 11932 | ; | |
| 11933 | "RTN","PSG OE91",259, 0) | |
| 11934 | WRITE ; | |
| 11935 | "RTN","PSG OE91",260, 0) | |
| 11936 | W !!,"Ver ify Admin and remova l times",! | |
| 11937 | "RTN","PSG OE91",261, 0) | |
| 11938 | W !,"(A)D MINISTRATI ON -(R)EMO VAL TIMES" | |
| 11939 | "RTN","PSG OE91",262, 0) | |
| 11940 | W !,"____ __________ __________ __________ __________ __________ __________ __________ _",! | |
| 11941 | "RTN","PSG OE91",263, 0) | |
| 11942 | F P=1:1:P SGAARR W P SGAARR(P)_ "-"_PSGRAR R(P) W:P' =PSGAARR " , " | |
| 11943 | "RTN","PSG OE91",264, 0) | |
| 11944 | D ASK | |
| 11945 | "RTN","PSG OE91",265, 0) | |
| 11946 | Q | |
| 11947 | "RTN","PSG OE91",266, 0) | |
| 11948 | ; | |
| 11949 | "RTN","PSG OE91",267, 0) | |
| 11950 | ASK ; | |
| 11951 | "RTN","PSG OE91",268, 0) | |
| 11952 | N Y | |
| 11953 | "RTN","PSG OE91",269, 0) | |
| 11954 | S DIR("A" )="Is this correct", DIR(0)="Y" D ^DIR I $D(DUOUT)! $D(DTOUT) W:'$T $C(7 ) S PSGOEE =0 K PSGDU R G DONE | |
| 11955 | "RTN","PSG OE91",270, 0) | |
| 11956 | I 'Y K X S PSGDUR=- 1,PSGFOK(8 )="" G A41 | |
| 11957 | "RTN","PSG OE91",271, 0) | |
| 11958 | N P S P=1 ,PSGRMVT=$ P(PSGRARR( P),"(",1) | |
| 11959 | "RTN","PSG OE91",272, 0) | |
| 11960 | F S P=$O (PSGRARR(P )) Q:P="" D | |
| 11961 | "RTN","PSG OE91",273, 0) | |
| 11962 | .S PSGRMV T=PSGRMVT_ "-"_$P(PSG RARR(P),"( ",1) | |
| 11963 | "RTN","PSG OE91",274, 0) | |
| 11964 | Q | |
| 11965 | "RTN","PSG OE92") | |
| 11966 | 0^12^B4738 9177 | |
| 11967 | "RTN","PSG OE92",1,0) | |
| 11968 | PSGOE92 ;B IR/CML3 - ACTIVE ORD ER EDIT (C ONT.) ;Jul 26, 2017@ 18:04:02 | |
| 11969 | "RTN","PSG OE92",2,0) | |
| 11970 | ;;5.0;INP ATIENT MED ICATIONS ; **2,35,50, 58,81,110, 215,237,27 6,316,317, 327**;16 D EC 97;Buil d 64 | |
| 11971 | "RTN","PSG OE92",3,0) | |
| 11972 | ; | |
| 11973 | "RTN","PSG OE92",4,0) | |
| 11974 | ;Referenc e to ^DD(5 3.1 is sup ported by DBIA #2256 . | |
| 11975 | "RTN","PSG OE92",5,0) | |
| 11976 | ;Referenc e to ^PS(5 5 is suppo rted by DB IA #2191. | |
| 11977 | "RTN","PSG OE92",6,0) | |
| 11978 | ;Referenc e to ^PSDR UG is supp orted by D BIA #2192. | |
| 11979 | "RTN","PSG OE92",7,0) | |
| 11980 | ;Referenc e to $$GET ^XPAR is s upported b y DBIA #22 63 | |
| 11981 | "RTN","PSG OE92",8,0) | |
| 11982 | ; | |
| 11983 | "RTN","PSG OE92",9,0) | |
| 11984 | 1 ; provid er | |
| 11985 | "RTN","PSG OE92",10,0 ) | |
| 11986 | S MSG=0,P SGF2=1 S:P SGOEEF(PSG F2) BACK=" 1^PSGOE92" | |
| 11987 | "RTN","PSG OE92",11,0 ) | |
| 11988 | A1 I $G(PS JORD),$G(P SGP) I $$C OMPLEX^PSJ OE(PSGP,PS JORD) S PS GOEE=0 D G DONE | |
| 11989 | "RTN","PSG OE92",12,0 ) | |
| 11990 | .W !!?5," Provider m ay not be edited for active co mplex orde rs." D PAU SE^VALM1 | |
| 11991 | "RTN","PSG OE92",13,0 ) | |
| 11992 | W !,"PROV IDER: ",$S (PSGPR:PSG PRN_"// ", 1:"") R X: DTIME I X= "^"!'$T W: '$T $C(7) S PSGOEE=0 G DONE | |
| 11993 | "RTN","PSG OE92",14,0 ) | |
| 11994 | ;; START NCC T4 MOD S >> 327*R JS | |
| 11995 | "RTN","PSG OE92",15,0 ) | |
| 11996 | S PSTMPI= PSGPR,PSTM PN=PSGPRN | |
| 11997 | "RTN","PSG OE92",16,0 ) | |
| 11998 | I $S(X="" :'PSGPR,1: X="@") W $ C(7)," (R equired)" S X="?" D ENHLP^PSGO EM(55.06,1 ) G A1 | |
| 11999 | "RTN","PSG OE92",17,0 ) | |
| 12000 | I +$G(ANQ X) G A2 | |
| 12001 | "RTN","PSG OE92",18,0 ) | |
| 12002 | I X="",PS GPR S X=PS GPRN I PSG PR'=PSGPRN ,$L($$GET1 ^DIQ(200,P SGPR,53.1) ) G DONE | |
| 12003 | "RTN","PSG OE92",19,0 ) | |
| 12004 | I X?1."?" D ENHLP^P SGOEM(55.0 6,1) | |
| 12005 | "RTN","PSG OE92",20,0 ) | |
| 12006 | I $E(X)=" ^" D ENFF G:Y>0 @Y G A1 | |
| 12007 | "RTN","PSG OE92",21,0 ) | |
| 12008 | K DIC S D IC="^VA(20 0,",DIC(0) ="EMQZ",DI C("S")="I $D(^(""PS" ")),^(""PS ""),$S('$P (^(""PS"") ,""^"",4): 1,1:$P(^(" "PS""),""^ "",4)>DT)" D ^DIC K DIC I Y'>0 G A1 | |
| 12009 | "RTN","PSG OE92",22,0 ) | |
| 12010 | A2 D CLOZP RV^PSGOE82 | |
| 12011 | "RTN","PSG OE92",23,0 ) | |
| 12012 | I $G(ANQX ) W ! S PS GPR=PSTMPI ,PSGPRN=PS TMPN K PS TMPN,PSTMP I,ANQX G A 1 | |
| 12013 | "RTN","PSG OE92",24,0 ) | |
| 12014 | ;; END NC C T4 MODS << 327*RJS | |
| 12015 | "RTN","PSG OE92",25,0 ) | |
| 12016 | S PSGPR=+ Y,PSGPRN=Y (0,0) G DO NE | |
| 12017 | "RTN","PSG OE92",26,0 ) | |
| 12018 | ; | |
| 12019 | "RTN","PSG OE92",27,0 ) | |
| 12020 | 5 ; self m ed | |
| 12021 | "RTN","PSG OE92",28,0 ) | |
| 12022 | I $G(PSJO RD),$G(PSG P) I $$COM PLEX^PSJOE (PSGP,PSJO RD) S PSGO EE=0 D G DONE | |
| 12023 | "RTN","PSG OE92",29,0 ) | |
| 12024 | .W !!?5," Self Med m ay not be edited for active co mplex orde rs." D PAU SE^VALM1 | |
| 12025 | "RTN","PSG OE92",30,0 ) | |
| 12026 | S MSG=0,P SGF2=5 S:P SGOEEF(PSG F2) BACK=" 5^PSGOE92" K PSGOEEF (6) S:PSGS M PSGOEEF( 6)="" | |
| 12027 | "RTN","PSG OE92",31,0 ) | |
| 12028 | A5 W !,"SE LF MED: " W:PSGSM]"" $P("NO^YE S","^",PSG SM+1),"// " R X:DTIM E I X="^"! '$T W:'$T $C(7) S PS GOEE=0 G D ONE | |
| 12029 | "RTN","PSG OE92",32,0 ) | |
| 12030 | I "01"[X, $L(X)<2 S: X]"" PSGSM =+X W:PSGS M]"" " (" ,$P("NO^YE S","^",PSG SM+1),")" G:'PSGSM D ONE S PSGO EEF(6)="" G 6 | |
| 12031 | "RTN","PSG OE92",33,0 ) | |
| 12032 | I X="@" W $C(7)," (Required) " G A5 | |
| 12033 | "RTN","PSG OE92",34,0 ) | |
| 12034 | I X?1"^". E D ENFF G :Y>0 @Y G A5 | |
| 12035 | "RTN","PSG OE92",35,0 ) | |
| 12036 | I X?1."?" D ENHLP^P SGOEM(55.0 6,5) G A5 | |
| 12037 | "RTN","PSG OE92",36,0 ) | |
| 12038 | D YN I S PSGSM=$E( X)="Y" K P SGOEEF(6) G:'PSGSM D ONE S PSGO EEF(6)="" G 6 | |
| 12039 | "RTN","PSG OE92",37,0 ) | |
| 12040 | W $C(7) D ENHLP^PSG OEM(55.06, 5) G A5 | |
| 12041 | "RTN","PSG OE92",38,0 ) | |
| 12042 | ; | |
| 12043 | "RTN","PSG OE92",39,0 ) | |
| 12044 | 6 ; hospit al supplie d self med | |
| 12045 | "RTN","PSG OE92",40,0 ) | |
| 12046 | S MSG=0,P SGF2=6 S:P SGOEEF(PSG F2) BACK=" 6^PSGOE92" | |
| 12047 | "RTN","PSG OE92",41,0 ) | |
| 12048 | A6 I $G(PS JORD),$G(P SGP) I $$C OMPLEX^PSJ OE(PSGP,PS JORD) S PS GOEE=0 D G DONE | |
| 12049 | "RTN","PSG OE92",42,0 ) | |
| 12050 | .W !!?5," Hospital S upplied Se lf Med may not be ed ited for a ctive comp lex orders ." D PAUSE ^VALM1 | |
| 12051 | "RTN","PSG OE92",43,0 ) | |
| 12052 | W !,"HOSP ITAL SUPPL IED SELF M ED: " W:PS GHSM]"" $P ("NO^YES", "^",PSGHSM +1),"// " R X:DTIME I X="^"!'$ T W:'$T $C (7) S PSGO EE=0 G DON E | |
| 12053 | "RTN","PSG OE92",44,0 ) | |
| 12054 | I "01"[X, $L(X)=1 S: X]"" PSGHS M=+X W " (",$P("NO^ YES","^",P SGHSM+1)," )" S MSG=0 ,PSGF2=5 G DONE | |
| 12055 | "RTN","PSG OE92",45,0 ) | |
| 12056 | I X="@" W $C(7)," (Required) " G A6 | |
| 12057 | "RTN","PSG OE92",46,0 ) | |
| 12058 | I X?1"^". E D ENFF G :Y>0 @Y G A6 | |
| 12059 | "RTN","PSG OE92",47,0 ) | |
| 12060 | I X?1."?" D ENHLP^P SGOEM(55.0 6,6) G A6 | |
| 12061 | "RTN","PSG OE92",48,0 ) | |
| 12062 | D YN I S PSGHSM=$E (X)="Y" S MSG=0,PSGF 2=5 G DONE | |
| 12063 | "RTN","PSG OE92",49,0 ) | |
| 12064 | W $C(7) D ENHLP^PSG OEM(55.06, 6) G A6 | |
| 12065 | "RTN","PSG OE92",50,0 ) | |
| 12066 | ; | |
| 12067 | "RTN","PSG OE92",51,0 ) | |
| 12068 | 2 ; dispen se drug mu ltiple | |
| 12069 | "RTN","PSG OE92",52,0 ) | |
| 12070 | ;*276 - D isallow un authorized nurses fr om editing Dispense Drug | |
| 12071 | "RTN","PSG OE92",53,0 ) | |
| 12072 | I '$P($G( PSJSYSU)," ;",4) W !, "You are n ot authori zed to edi t Dispense Drugs." D PAUSE^VAL M1 Q | |
| 12073 | "RTN","PSG OE92",54,0 ) | |
| 12074 | I $G(PSGP ),$G(PSGOR D) I $$COM PLEX^PSJOE (PSGP,PSGO RD) D | |
| 12075 | "RTN","PSG OE92",55,0 ) | |
| 12076 | .N X,Y,PA RENT S PAR ENT=$S(PSG ORD["U":$$ GET1^DIQ(5 5.06,+PSGO RD_","_PSG P,125,"I") ,1:$$GET1^ DIQ(53.1,+ PSGORD,125 ,"I")) | |
| 12077 | "RTN","PSG OE92",56,0 ) | |
| 12078 | .I PARENT D FULL^VA LM1 W !!?5 ,"This ord er is part of a comp lex order. Please re view the f ollowing " ,!?5,"asso ciated ord ers before changing this order ." D CMPLX ^PSJCOM1(P SGP,PARENT ,PSGORD) | |
| 12079 | "RTN","PSG OE92",57,0 ) | |
| 12080 | S MSG=0,P SGF2=2,BAC K="2^PSGOE 92",PSGOEE ND=1 | |
| 12081 | "RTN","PSG OE92",58,0 ) | |
| 12082 | N PSGX,AR RAY D LIST ^DIC(53.45 02,","_PSJ SYSP_",",, "I",,,,,,, "ARRAY") S PSGX=+ARR AY("DILIST ",0) | |
| 12083 | "RTN","PSG OE92",59,0 ) | |
| 12084 | ; PSJ*5*3 17 - If PS J PADE OE BALANCES p arameter i s YES, PAD E balances should di splay as i dentifier. | |
| 12085 | "RTN","PSG OE92",60,0 ) | |
| 12086 | N PSJPADL K S PSJPAD LK=0 ; Fl ag indicat ing PADE d rug lookup was done, don't do drug looku p twice - PSJ*5*317 | |
| 12087 | "RTN","PSG OE92",61,0 ) | |
| 12088 | I $$GET^X PAR("SYS", "PSJ PADE OE BALANCE S") D | |
| 12089 | "RTN","PSG OE92",62,0 ) | |
| 12090 | .N DA,DIC ,DIE,DR,DI R,PSJLOC,P SJDRG,PSJD DC,PSJORD, DFN,PSJORC L,PSJCLNK, PSJCLND S PSJCLND="" | |
| 12091 | "RTN","PSG OE92",63,0 ) | |
| 12092 | .; If cli nic order, quit if c linic loca tion is no t linked t o PADE | |
| 12093 | "RTN","PSG OE92",64,0 ) | |
| 12094 | .I $G(PSG ORD)["P" S PSJCLND=$ $GET1^DIQ( 53.1,+$G(P SGORD),113 ,"I")_"^"_ $$GET1^DIQ (53.1,+$G( PSGORD),12 6,"I") I 1 | |
| 12095 | "RTN","PSG OE92",65,0 ) | |
| 12096 | .E I $G( PSGORD)["U " S PSJCLN D=$$GET1^D IQ(55.06,+ $G(PSGORD) _","_+$G(P SGP),130," I")_"^"_$$ GET1^DIQ(5 5.06,+$G(P SGORD)_"," _+$G(PSGP) ,131,"I") I 1 | |
| 12097 | "RTN","PSG OE92",66,0 ) | |
| 12098 | .E I $G( PSGORD)["V " S PSJCLN D=$$GET1^D IQ(55.01,+ $G(PSGORD) _","_+$G(P SGP),136," I")_"^"_$$ GET1^DIQ(5 5.01,+$G(P SGORD)_"," _+$G(PSGP) ,139,"I") | |
| 12099 | "RTN","PSG OE92",67,0 ) | |
| 12100 | .S PSJORC L=$S(PSJCL ND&$P(PSJC LND,"^",2) :+PSJCLND_ "C",1:"") | |
| 12101 | "RTN","PSG OE92",68,0 ) | |
| 12102 | .I PSJORC L S PSJCLN K=$$PADECL ^PSJPAD50( +$G(PSJORC L)) Q:'PSJ CLNK | |
| 12103 | "RTN","PSG OE92",69,0 ) | |
| 12104 | .I '$G(PS JCLNK) Q:' $$PADEWD^P SJPAD50(+$ G(VAIN(4)) ) | |
| 12105 | "RTN","PSG OE92",70,0 ) | |
| 12106 | .S DFN=$G (PSGP),PSJ ORD=$G(PSG ORD) | |
| 12107 | "RTN","PSG OE92",71,0 ) | |
| 12108 | .N ARRAY D LIST^DIC (53.4502," ,"_PSJSYSP _",",,"I", ,,,,,,"ARR AY") | |
| 12109 | "RTN","PSG OE92",72,0 ) | |
| 12110 | .F I=1:1 Q:'$D(ARRA Y("DILIST" ,2,I)) S PSJDDC=ARR AY("DILIST ",2,I),PSJ DRG(PSJDDC )=$$GET1^D IQ(53.4502 ,PSJDDC_", "_PSJSYSP, .01,"I") | |
| 12111 | "RTN","PSG OE92",73,0 ) | |
| 12112 | .S PSJLOC =$S($G(PSJ ORD)["U":+ $$GET1^DIQ (55.06,+PS JORD_","_D FN,130,"I" )_"C",$G(P SJORD)["P" :+$$GET1^D IQ(53.1,+$ G(PSGORD), 113,"I")_" C",1:"") | |
| 12113 | "RTN","PSG OE92",74,0 ) | |
| 12114 | .S:'PSJLO C PSJLOC=+ $G(VAIN(4) ) I '$G(PS JLOC) D | |
| 12115 | "RTN","PSG OE92",75,0 ) | |
| 12116 | ..N VAIN D INP^VADP T S PSJLOC =$G(VAIN(4 )) | |
| 12117 | "RTN","PSG OE92",76,0 ) | |
| 12118 | .S PSJPAD LK=1 | |
| 12119 | "RTN","PSG OE92",77,0 ) | |
| 12120 | .D READDD ^PSJPAD50( .PSJDRG,$G (PSGPDRG), PSJLOC,PSJ ORD,$G(PSG ORD)) | |
| 12121 | "RTN","PSG OE92",78,0 ) | |
| 12122 | ; PSJ*5*3 17 - If PS J PADE OE BALANCES p arameter i s NO, PADE balances should NOT display a s identife r. | |
| 12123 | "RTN","PSG OE92",79,0 ) | |
| 12124 | I '$G(PSJ PADLK) N D A,DIE,DR S DIE="^PS( 53.45,",DA =PSJSYSP,D R=2,DR(2,5 3.4502)=". 02//1;.03" D ^DIE | |
| 12125 | "RTN","PSG OE92",80,0 ) | |
| 12126 | I '$G(ARR AY("DILIST ",0)) W $C (7),!!,"WA RNING: Thi s order mu st have at least one dispense drug befor e pharmacy can",!?9, "verify it !",! S MSG =1 | |
| 12127 | "RTN","PSG OE92",81,0 ) | |
| 12128 | D DDOC^PS GOE82(PSGX ) ;* Perfo rm allergy /adv. reac tion order checks | |
| 12129 | "RTN","PSG OE92",82,0 ) | |
| 12130 | N PSJDOSE | |
| 12131 | "RTN","PSG OE92",83,0 ) | |
| 12132 | D DOSECHK ^PSJDOSE | |
| 12133 | "RTN","PSG OE92",84,0 ) | |
| 12134 | I +$G(PSJ DSFLG) D D SPWARN^PSJ DOSE S:$G( PSGOEEF(10 9))="" PSG OEEF(109)= 1 ; PSJ*5* 237 - Chec k PSGOEEF( 109) to pr event infi nite loop | |
| 12135 | "RTN","PSG OE92",85,0 ) | |
| 12136 | ; PSJ*5*2 15 - If Di spense Dru g(s) chang ed, make e ntry in Ac tivity Log . | |
| 12137 | "RTN","PSG OE92",86,0 ) | |
| 12138 | ; Compare the edite d dispense drug info rmation in ^PS(53.45 to the ac tive | |
| 12139 | "RTN","PSG OE92",87,0 ) | |
| 12140 | ; order d ispense dr ug informa tion in ^P S(55. | |
| 12141 | "RTN","PSG OE92",88,0 ) | |
| 12142 | S (PSJDDT MP,PSJDD55 ,PSJDTMP1, PSJDD551)= "" | |
| 12143 | "RTN","PSG OE92",89,0 ) | |
| 12144 | N ARRAY D LIST^DIC( 53.4502,", "_PSJSYSP_ ",",.02,"I ",,,,,,,"A RRAY") | |
| 12145 | "RTN","PSG OE92",90,0 ) | |
| 12146 | F I=1:1 Q :'$D(ARRAY ("DILIST", 2,I)) S P SJDDTMP=AR RAY("DILIS T",2,I) D | |
| 12147 | "RTN","PSG OE92",91,0 ) | |
| 12148 | .S PSJDDT MP(PSJDDTM P)=ARRAY(" DILIST",1, I)_"^"_ARR AY("DILIST ","ID",I,. 02) | |
| 12149 | "RTN","PSG OE92",92,0 ) | |
| 12150 | .S PSJDTM P1="Disp D rug: "_"(" _$P($G(PSJ DDTMP(PSJD DTMP)),"^" ,1)_") "_$ $GET1^DIQ( 50,$P($G(P SJDDTMP(PS JDDTMP))," ^",1),.01) _" Units: "_$P($G(PS JDDTMP(PSJ DDTMP)),"^ ",2)_" " | |
| 12151 | "RTN","PSG OE92",93,0 ) | |
| 12152 | N ARR1 D LIST^DIC(5 5.07,","_+ ON_","_DFN _",",.02," I",,,,,,," ARR1") | |
| 12153 | "RTN","PSG OE92",94,0 ) | |
| 12154 | F I=1:1 Q :'$D(ARR1( "DILIST",2 ,I)) S PS JDD55=ARR1 ("DILIST", 2,I) D | |
| 12155 | "RTN","PSG OE92",95,0 ) | |
| 12156 | .S PSJDD5 5(PSJDD55) =ARR1("DIL IST",1,I)_ "^"_ARR1(" DILIST","I D",I,.02) | |
| 12157 | "RTN","PSG OE92",96,0 ) | |
| 12158 | .S PSJDD5 51="Disp D rug: "_"(" _$P($G(PSJ DD55(PSJDD 55)),"^",1 )_") "_$$G ET1^DIQ(50 ,$P($G(PSJ DD55(PSJDD 55)),"^",1 ),.01)_" U nits: "_$P ($G(PSJDD5 5(PSJDD55) ),"^",2)_" " | |
| 12159 | "RTN","PSG OE92",97,0 ) | |
| 12160 | ; If the two tempor ary string s PSJDTMP1 and PSJDD 551 do not match eac h other ex actly | |
| 12161 | "RTN","PSG OE92",98,0 ) | |
| 12162 | ; then an edit has been made to the Dis pense Drug Field. M ake a new entry in | |
| 12163 | "RTN","PSG OE92",99,0 ) | |
| 12164 | ; the Act ivity Log for this o rder. | |
| 12165 | "RTN","PSG OE92",100, 0) | |
| 12166 | I PSJDTMP 1'=PSJDD55 1 D NEWUDA L^PSGAL5(D FN,+ON,600 0,"Dispens e Drug",PS JDD551) | |
| 12167 | "RTN","PSG OE92",101, 0) | |
| 12168 | K PSGOEEN D,PSJDDTMP ,PSJDTMP1, PSJDD55,PS JDD551 G D ONE | |
| 12169 | "RTN","PSG OE92",102, 0) | |
| 12170 | ; | |
| 12171 | "RTN","PSG OE92",103, 0) | |
| 12172 | 15 ; comme nts | |
| 12173 | "RTN","PSG OE92",104, 0) | |
| 12174 | I $G(PSJO RD),$G(PSG P) I $$COM PLEX^PSJOE (PSGP,PSJO RD) S PSGO EE=0 D G DONE | |
| 12175 | "RTN","PSG OE92",105, 0) | |
| 12176 | . W !!?5, "Comments may not be edited fo r active c omplex ord ers." D PA USE^VALM1 | |
| 12177 | "RTN","PSG OE92",106, 0) | |
| 12178 | S MSG=0,P SGF2=15,BA CK="15^PSG OE92",DA=P SJSYSP,DR= 1,DIE="^PS (53.45," D ^DIE W ! G DONE | |
| 12179 | "RTN","PSG OE92",107, 0) | |
| 12180 | ; | |
| 12181 | "RTN","PSG OE92",108, 0) | |
| 12182 | 72 ; provi der commen ts | |
| 12183 | "RTN","PSG OE92",109, 0) | |
| 12184 | ; | |
| 12185 | "RTN","PSG OE92",110, 0) | |
| 12186 | DONE ; | |
| 12187 | "RTN","PSG OE92",111, 0) | |
| 12188 | I PSGOEE G:'PSGOEEF (PSGF2) @B ACK S PSGO EE=PSGOEEF (PSGF2) | |
| 12189 | "RTN","PSG OE92",112, 0) | |
| 12190 | K F,F0,PS GF2,F3,PSG ,SDT Q | |
| 12191 | "RTN","PSG OE92",113, 0) | |
| 12192 | ; | |
| 12193 | "RTN","PSG OE92",114, 0) | |
| 12194 | ENFF ; up- arrow to a nother fie ld | |
| 12195 | "RTN","PSG OE92",115, 0) | |
| 12196 | S Y=-1 I '$D(PSGOEE F) W $C(7) ," ??" Q | |
| 12197 | "RTN","PSG OE92",116, 0) | |
| 12198 | S X=$E(X, 2,99) I X= +X S Y=$S( $D(PSGOEEF (X)):X,1:- 1) W " " W:Y>0 $$CO DES2^PSIVU TL(53.1,X) W:Y'>0 $C (7),"??" Q | |
| 12199 | "RTN","PSG OE92",117, 0) | |
| 12200 | K DIC S D IC="^DD(53 .1,",DIC(0 )="QEM",DI C("S")="I $D(PSGOEEF (+Y))" D ^ DIC K DIC S Y=+Y S:Y >0 Y=$P($T (@("F"_Y)) ,";",3) Q | |
| 12201 | "RTN","PSG OE92",118, 0) | |
| 12202 | ; | |
| 12203 | "RTN","PSG OE92",119, 0) | |
| 12204 | DEL ; dele te entry | |
| 12205 | "RTN","PSG OE92",120, 0) | |
| 12206 | W !?3,"SU RE YOU WAN T TO DELET E" S %=0 D YN^DICN I %'=1 W $C (7)," <NO THING DELE TED>" | |
| 12207 | "RTN","PSG OE92",121, 0) | |
| 12208 | Q | |
| 12209 | "RTN","PSG OE92",122, 0) | |
| 12210 | ; | |
| 12211 | "RTN","PSG OE92",123, 0) | |
| 12212 | YN ; yes/n o as a set of codes | |
| 12213 | "RTN","PSG OE92",124, 0) | |
| 12214 | I X'?.U F Y=1:1:$L( X) I $E(X, Y)?1L S X= $E(X,1,Y-1 )_$C($A(X, Y)-32)_$E( X,Y+1,$L(X )) | |
| 12215 | "RTN","PSG OE92",125, 0) | |
| 12216 | F Y="NO", "YES" I $P (Y,X)="" W $P(Y,X,2) Q | |
| 12217 | "RTN","PSG OE92",126, 0) | |
| 12218 | Q | |
| 12219 | "RTN","PSG OE92",127, 0) | |
| 12220 | ; | |
| 12221 | "RTN","PSG OE92",128, 0) | |
| 12222 | F101 ;;101 ^PSGOE9 | |
| 12223 | "RTN","PSG OE92",129, 0) | |
| 12224 | F109 ;;109 ^PSGOE9 | |
| 12225 | "RTN","PSG OE92",130, 0) | |
| 12226 | F3 ;;3^PSG OE9 | |
| 12227 | "RTN","PSG OE92",131, 0) | |
| 12228 | F7 ;;7^PSG OE9 | |
| 12229 | "RTN","PSG OE92",132, 0) | |
| 12230 | PSGF26 ;;2 6^PSGOE9 | |
| 12231 | "RTN","PSG OE92",133, 0) | |
| 12232 | F41 ;;41^P SGOE91 | |
| 12233 | "RTN","PSG OE92",134, 0) | |
| 12234 | F8 ;;8^PSG OE91 | |
| 12235 | "RTN","PSG OE92",135, 0) | |
| 12236 | F10 ;;10^P SGOE91 | |
| 12237 | "RTN","PSG OE92",136, 0) | |
| 12238 | F34 ;;34^P SGOE91 | |
| 12239 | "RTN","PSG OE92",137, 0) | |
| 12240 | F1 ;;1^PSG OE92 | |
| 12241 | "RTN","PSG OE92",138, 0) | |
| 12242 | F5 ;;5^PSG OE92 | |
| 12243 | "RTN","PSG OE92",139, 0) | |
| 12244 | PSGF2 ;;2^ PSGOE92 | |
| 12245 | "RTN","PSG OEE") | |
| 12246 | 0^27^B1322 09675 | |
| 12247 | "RTN","PSG OEE",1,0) | |
| 12248 | PSGOEE ;BI R/CML3 - E DIT ACTIVE OR NON-VE RIFIED ORD ERS ;Jul 2 6, 2017@18 :04:02 | |
| 12249 | "RTN","PSG OEE",2,0) | |
| 12250 | ;;5.0;INP ATIENT MED ICATIONS;* *4,7,29,47 ,64,58,82, 91,110,111 ,112,142,1 79,181,254 ,267,268,2 81,315,327 **;16 DEC 97;Build 6 4 | |
| 12251 | "RTN","PSG OEE",3,0) | |
| 12252 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 12253 | "RTN","PSG OEE",4,0) | |
| 12254 | ; | |
| 12255 | "RTN","PSG OEE",5,0) | |
| 12256 | ; Referen ce to ^PS( 55 is supp orted by D BIA# 2191. | |
| 12257 | "RTN","PSG OEE",6,0) | |
| 12258 | ; Referen ce to ^PSS LOCK is su pported by DBIA# 278 9. | |
| 12259 | "RTN","PSG OEE",7,0) | |
| 12260 | ; Referen ce to ^TMP ("PSODAOC" ,$J is sup ported by DBIA# 6071 . | |
| 12261 | "RTN","PSG OEE",8,0) | |
| 12262 | ; | |
| 12263 | "RTN","PSG OEE",9,0) | |
| 12264 | D NOW^%DT C S PSGDT= % K PSGEFN ,PSGOEEF S PSGOEEF=0 I PSGORD[ "A"!(PSGOR D["O") G A CT | |
| 12265 | "RTN","PSG OEE",10,0) | |
| 12266 | 531 ; edit orders in 53.1 | |
| 12267 | "RTN","PSG OEE",11,0) | |
| 12268 | ENF ; Entr y point | |
| 12269 | "RTN","PSG OEE",12,0) | |
| 12270 | D EN2^PSG OEEW | |
| 12271 | "RTN","PSG OEE",13,0) | |
| 12272 | K PSJACEP T D EDLOOP G:'$G(PSJ ACEPT) OUT | |
| 12273 | "RTN","PSG OEE",14,0) | |
| 12274 | I $G(PSGO EENO) D | |
| 12275 | "RTN","PSG OEE",15,0) | |
| 12276 | .N PSGOEE NO S PSGOE ENO=1 D NE W | |
| 12277 | "RTN","PSG OEE",16,0) | |
| 12278 | E D | |
| 12279 | "RTN","PSG OEE",17,0) | |
| 12280 | .N PSGOEE NO S PSGOE ENO=0 D UP D | |
| 12281 | "RTN","PSG OEE",18,0) | |
| 12282 | I $G(PSGO EAV) D ACT 1 Q | |
| 12283 | "RTN","PSG OEE",19,0) | |
| 12284 | D DONE1 | |
| 12285 | "RTN","PSG OEE",20,0) | |
| 12286 | S PSGOEEF =0,PSJORD= PSGORD D G ETUD^PSJLM GUD(PSGP,P SGORD),ENS FE^PSGOEE0 (PSGP,PSGO RD) | |
| 12287 | "RTN","PSG OEE",21,0) | |
| 12288 | Q | |
| 12289 | "RTN","PSG OEE",22,0) | |
| 12290 | ACT ; Perf orm Edit | |
| 12291 | "RTN","PSG OEE",23,0) | |
| 12292 | NEW ANQX, PSJALGY1 | |
| 12293 | "RTN","PSG OEE",24,0) | |
| 12294 | K PSGOEER | |
| 12295 | "RTN","PSG OEE",25,0) | |
| 12296 | S ANQX=0 | |
| 12297 | "RTN","PSG OEE",26,0) | |
| 12298 | N CLOZFLG I '$G(PSG DRG),$O(PS JXDOX("DD" ,0)) N PSG DRG S PSGD RG=$O(PSJX DOX("DD",0 )) | |
| 12299 | "RTN","PSG OEE",27,0) | |
| 12300 | I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" S CLO ZFLG=1 | |
| 12301 | "RTN","PSG OEE",28,0) | |
| 12302 | I $G(CLOZ FLG),PSJOP D | |
| 12303 | "RTN","PSG OEE",29,0) | |
| 12304 | .D PROVCH K^PSJCLOZ( PSGOPR) | |
| 12305 | "RTN","PSG OEE",30,0) | |
| 12306 | I +$G(ANQ X) D PAUSE ^VALM1 Q | |
| 12307 | "RTN","PSG OEE",31,0) | |
| 12308 | D EN2^PSG OEEW,EDLOO P G:'$G(PS JACEPT) OU T | |
| 12309 | "RTN","PSG OEE",32,0) | |
| 12310 | I $G(PSGO EENO) D | |
| 12311 | "RTN","PSG OEE",33,0) | |
| 12312 | .N PSGOEE NO S PSGOE ENO=1 D NE W | |
| 12313 | "RTN","PSG OEE",34,0) | |
| 12314 | E D | |
| 12315 | "RTN","PSG OEE",35,0) | |
| 12316 | .N PSGOEE NO S PSGOE ENO=0 D UP D | |
| 12317 | "RTN","PSG OEE",36,0) | |
| 12318 | S:$D(PSGO EF)!$G(PSG OEENO) PSG CANFL=-1 | |
| 12319 | "RTN","PSG OEE",37,0) | |
| 12320 | ACT1 ; Con tinue edit ing | |
| 12321 | "RTN","PSG OEE",38,0) | |
| 12322 | D DONE1 | |
| 12323 | "RTN","PSG OEE",39,0) | |
| 12324 | S PSGOEEF =0 D GETUD ^PSJLMGUD( PSGP,PSGOR D),ENSFE^P SGOEE0(PSG P,PSGORD) D:PSGOEAV UNL^PSSLOC K(PSGP,PSG ORD) | |
| 12325 | "RTN","PSG OEE",40,0) | |
| 12326 | Q | |
| 12327 | "RTN","PSG OEE",41,0) | |
| 12328 | EDIT ; Edi t | |
| 12329 | "RTN","PSG OEE",42,0) | |
| 12330 | I $G(Y) D ASKOVR(Y, $G(PSGORD) ,.PSJSTARI ) | |
| 12331 | "RTN","PSG OEE",43,0) | |
| 12332 | D FULL^VA LM1 | |
| 12333 | "RTN","PSG OEE",44,0) | |
| 12334 | W ! S PSG OEER="" F Q=1:1 S Q1 =$P(Y,",", Q) Q:'Q1 S X=$P($T( @(PSGOEEG_ Q1)),";",3 ),PSGOEER= PSGOEER_X_ ";",PSGOEE F(+X)=Q S: Q1=1 PSJAL GY1=1 | |
| 12335 | "RTN","PSG OEE",45,0) | |
| 12336 | S LIMIT=$ L(PSGOEER, ";")-1,(PS GDEF,PSGOE E)=0 F S PSGOEE=PSG OEE+1 Q:PS GOEE>LIMIT I +$P(PS GOEER,";", PSGOEE)=10 1 S PSGDEF =1 | |
| 12337 | "RTN","PSG OEE",46,0) | |
| 12338 | S PSGOEER =$E(PSGOEE R,1,$L(PSG OEER)-1),( MSG,PSGOEE )=0 F S P SGOEE=PSGO EE+1 Q:PSG OEE>$L(PSG OEER,";") S F1=$S(P SGOEEG=3:5 3.1,1:55.0 6) I 'PSGD EF!((PSGDE F)&(+$P(PS GOEER,";", PSGOEE)'=2 )) D @$P(P SGOEER,";" ,PSGOEE) Q :'PSGOEE | |
| 12339 | "RTN","PSG OEE",47,0) | |
| 12340 | Q | |
| 12341 | "RTN","PSG OEE",48,0) | |
| 12342 | EDLOOP ; C ontinue pr ompting fo r fields t o edit. | |
| 12343 | "RTN","PSG OEE",49,0) | |
| 12344 | K PSJNOO | |
| 12345 | "RTN","PSG OEE",50,0) | |
| 12346 | I $G(Y) D EDIT Q:'$ G(PSGOEE) | |
| 12347 | "RTN","PSG OEE",51,0) | |
| 12348 | D ENNOU^P SGOEE0 I ' $G(PSGOEEN O),DR="" S VALMBCK=" R" Q | |
| 12349 | "RTN","PSG OEE",52,0) | |
| 12350 | K VALMSG | |
| 12351 | "RTN","PSG OEE",53,0) | |
| 12352 | I '$G(PSG OEENO),$G( PSGPDNX) D CKDT | |
| 12353 | "RTN","PSG OEE",54,0) | |
| 12354 | I $G(PSGO EENO) D | |
| 12355 | "RTN","PSG OEE",55,0) | |
| 12356 | .S VALMSG ="This cha nge will c ause a new order to be created ." D GTSTA TUS,CHKDD, CKDT | |
| 12357 | "RTN","PSG OEE",56,0) | |
| 12358 | .S PSGEBN =$$ENNPN^P SGMI(DUZ), PSGLIN=$$E NDD^PSGMI( PSGDT)_U_$ $ENDTC^PSG MI(PSGDT) | |
| 12359 | "RTN","PSG OEE",57,0) | |
| 12360 | D CHK^PSG OEV("^^"_P SGMR_"^^^^ "_PSGST,PS GPDRG_U_PS GDO,PSGSCH _U_PSGSD_" ^^"_PSGFD) | |
| 12361 | "RTN","PSG OEE",58,0) | |
| 12362 | K VALMBCK ,PSJACEPT, PSGPDNX D EN^VALM("P SJU LM ACC EPT") Q:'$ G(PSJACEPT ) | |
| 12363 | "RTN","PSG OEE",59,0) | |
| 12364 | I $G(PSGS 0XT)="D",' $G(PSGS0Y) I ((",P,R ,")'[(","_ $G(PSGST)_ ",")) D Q | |
| 12365 | "RTN","PSG OEE",60,0) | |
| 12366 | .S PSJACE PT=0 W !!, "This is a 'DAY OF T HE WEEK' s chedule an d MUST hav e admin ti mes." D PA USE^VALM1 | |
| 12367 | "RTN","PSG OEE",61,0) | |
| 12368 | I ($G(PSG OEER)["26^ PSGOE9")!( $G(PSGOEER )["26^PSGO E8")!($G(P SGOEER)["1 09^PSGOE9" )!($G(PSGO EER)["109^ PSGOE8")!( $G(PSGOEER )["3^PSGOE 9")!($G(PS GOEER)["3^ PSGOE8")!( $G(PSGOEER )["101^PSG OE9")!($G( PSGOEER)[" 101^PSGOE8 ") S PSGOE ENO=1 | |
| 12369 | "RTN","PSG OEE",62,0) | |
| 12370 | I $G(PSGO EENO)!($G( PSGOEER)[" 2^PSGOE92" )!($G(PSGO EER)["2^PS GOE82") D OC S:($G(P SGOEER)["2 ^PSGOE82") PSJDSVFY= 1 | |
| 12371 | "RTN","PSG OEE",63,0) | |
| 12372 | I $G(PSGO RQF) S PSJ NOO=-1 | |
| 12373 | "RTN","PSG OEE",64,0) | |
| 12374 | I '$G(PSJ NOO),$G(PS GOEENO) S PSJNOO=$$E NNOO^PSJUT L5("E") | |
| 12375 | "RTN","PSG OEE",65,0) | |
| 12376 | D K1 S PS JACEPT=$S( $G(PSJNOO) <0:0,1:1) | |
| 12377 | "RTN","PSG OEE",66,0) | |
| 12378 | S VALMBCK =$S('PSJAC EPT:"R",'P SGOEAV:"R" ,1:"Q") | |
| 12379 | "RTN","PSG OEE",67,0) | |
| 12380 | Q | |
| 12381 | "RTN","PSG OEE",68,0) | |
| 12382 | OC ;Perfor m OC (only when OI o r Dosage w as edited) & dosing check | |
| 12383 | "RTN","PSG OEE",69,0) | |
| 12384 | ;; START NCC REMEDI ATION RJS* 327 | |
| 12385 | "RTN","PSG OEE",70,0) | |
| 12386 | ;; END NC C REMEDIAT ION RJS*32 7 | |
| 12387 | "RTN","PSG OEE",71,0) | |
| 12388 | NEW PSJDD ,PSJALLGY | |
| 12389 | "RTN","PSG OEE",72,0) | |
| 12390 | K PSGORQF | |
| 12391 | "RTN","PSG OEE",73,0) | |
| 12392 | D FULL^VA LM1 | |
| 12393 | "RTN","PSG OEE",74,0) | |
| 12394 | N CLOZFLG ,ANQX I '$ G(PSGDRG), $O(PSJXDOX ("DD",0)) N PSGDRG S PSGDRG=$O (PSJXDOX(" DD",0)) | |
| 12395 | "RTN","PSG OEE",75,0) | |
| 12396 | I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" S CLO ZFLG=1 | |
| 12397 | "RTN","PSG OEE",76,0) | |
| 12398 | I $G(CLOZ FLG) S (AN QX,PSGORQF )=0 D TDD^ PSJCLOZ I $G(PSGORQF ) Q | |
| 12399 | "RTN","PSG OEE",77,0) | |
| 12400 | I +$G(PSG ETDD) S AN QX=0 D CLO Z^PSJCLOZ( PSGP,PSGDR G) I $G(AN QX) S PSGO RQF=1 Q | |
| 12401 | "RTN","PSG OEE",78,0) | |
| 12402 | S PSJDD=+ $$DD53P45^ PSJMISC() I 'PSJDD S PSGORQF=1 Q | |
| 12403 | "RTN","PSG OEE",79,0) | |
| 12404 | I $G(PSJA LGY1)!$G(P SGOEENO) D | |
| 12405 | "RTN","PSG OEE",80,0) | |
| 12406 | . D ENDDC ^PSGSICHK( PSGP,PSJDD ) | |
| 12407 | "RTN","PSG OEE",81,0) | |
| 12408 | D:'$G(PSG ORQF) IN^P SJOCDS($G( PSGORD),"U D",PSJDD) | |
| 12409 | "RTN","PSG OEE",82,0) | |
| 12410 | Q | |
| 12411 | "RTN","PSG OEE",83,0) | |
| 12412 | CHKDD ;*** Check ina ctive Disp ense drug within the order. | |
| 12413 | "RTN","PSG OEE",84,0) | |
| 12414 | D CHKDRG^ PSGOE2 | |
| 12415 | "RTN","PSG OEE",85,0) | |
| 12416 | Q | |
| 12417 | "RTN","PSG OEE",86,0) | |
| 12418 | CKDT ; Che ck if new start/stop dates sho uld be cal culated. | |
| 12419 | "RTN","PSG OEE",87,0) | |
| 12420 | S PSGS0Y= $S($D(PSGS 0Y):PSGS0Y ,1:$G(PSGA T)) | |
| 12421 | "RTN","PSG OEE",88,0) | |
| 12422 | ;PSJ*5*17 9 Recalc s tart date if Before last given | |
| 12423 | "RTN","PSG OEE",89,0) | |
| 12424 | I ($P($G( PSBSTR),"^ ")>PSGSD)! ('$G(PSGNE WDT)&(PSGS D=$G(PSGOS D))&(PSGFD =$G(PSGOFD )))!($G(PS GOST)'=PSG ST)!(PSGSC H'=$G(PSGO SCH))!($G( PSGPDNX)) D | |
| 12425 | "RTN","PSG OEE",90,0) | |
| 12426 | .N PSGOES S PSGOES= 1,PSGOFD=P SGFD D ^PS GNE3 I $G( PSGOFD) S PSGNEFD=PS GFD | |
| 12427 | "RTN","PSG OEE",91,0) | |
| 12428 | .S PSGSD= PSGNESD,PS GSDN=$$END D^PSGMI(PS GNESD)_U_$ $ENDTC^PSG MI(PSGNESD ),PSGFD=PS GNEFD,PSGF DN=$$ENDD^ PSGMI(PSGN EFD)_U_$$E NDTC^PSGMI (PSGNEFD), PSGNEWDT=1 | |
| 12429 | "RTN","PSG OEE",92,0) | |
| 12430 | .I $D(PSG OFD),PSGOF D]"",PSGFD '=PSGOFD S PSGOEEF(2 5)=1 | |
| 12431 | "RTN","PSG OEE",93,0) | |
| 12432 | .I $D(PSG OSD),PSGOS D]"",PSGSD '=PSGOSD S PSGOEEF(1 0)=1 | |
| 12433 | "RTN","PSG OEE",94,0) | |
| 12434 | ;BHW;PSJ* 5*179;Add EFD call h ere, remov ed from PS GOE91 | |
| 12435 | "RTN","PSG OEE",95,0) | |
| 12436 | D EFDACT^ PSJUTL | |
| 12437 | "RTN","PSG OEE",96,0) | |
| 12438 | Q | |
| 12439 | "RTN","PSG OEE",97,0) | |
| 12440 | NEW3 ; | |
| 12441 | "RTN","PSG OEE",98,0) | |
| 12442 | ;S:PSGOEA V PSGOEAV= "0^1" | |
| 12443 | "RTN","PSG OEE",99,0) | |
| 12444 | NEW ; | |
| 12445 | "RTN","PSG OEE",100,0 ) | |
| 12446 | I $D(^PS( 53.45,+$G( PSJSYSP),5 )) N PSJFS I S PSJFSI =1 D FILES I^PSJBCMA5 (DFN,PSGOR D) N SIARR AY S SIARR AY="" D | |
| 12447 | "RTN","PSG OEE",101,0 ) | |
| 12448 | .I PSGORD ["P" M SIA RRAY=^PS(5 3.1,+PSGOR D,15) D NE WNVAL^PSGA L5(PSGORD, 6000,"SPEC IAL INSTRU CTIONS",,. SIARRAY) | |
| 12449 | "RTN","PSG OEE",102,0 ) | |
| 12450 | .I PSGORD ["U" M SIA RRAY=^PS(5 5,DFN,5,+P SGORD,15) D NEWUDAL^ PSGAL5(PSG ORD,6000," SPECIAL IN STRUCTIONS ",,.SIARRA Y) | |
| 12451 | "RTN","PSG OEE",103,0 ) | |
| 12452 | W !,"...d iscontinui ng origina l order... " | |
| 12453 | "RTN","PSG OEE",104,0 ) | |
| 12454 | I PSGORD[ "P" S PSJC OM=+$P($G( ^PS(53.1,+ PSGORD,.2) ),"^",8) I PSJCOM D NEW^PSJCOM 1 Q | |
| 12455 | "RTN","PSG OEE",105,0 ) | |
| 12456 | ;DC and U nlock orde r. | |
| 12457 | "RTN","PSG OEE",106,0 ) | |
| 12458 | S PSGEDIT ="DE" D EN OR^PSGOECS ,UNL^PSSLO CK(PSGP,PS GORD) K PS GEDIT | |
| 12459 | "RTN","PSG OEE",107,0 ) | |
| 12460 | W !!," .. .creating new order. .." W:'PSG OEAV "(you will now work on th is new ord er)" | |
| 12461 | "RTN","PSG OEE",108,0 ) | |
| 12462 | S PSGS0Y= PSGAT,PSGN ESD=PSGSD, PSGNEFD=PS GFD,PSGOEP R=PSGPR,PS GPDRG=PSGP D,PSGPDRGN =PSGPDN,PS GOEE="E" | |
| 12463 | "RTN","PSG OEE",109,0 ) | |
| 12464 | S PSGOORD =PSGORD D ^PSGOETO K PSGOEOS | |
| 12465 | "RTN","PSG OEE",110,0 ) | |
| 12466 | I PSGOORD ["U" S $P( ^PS(55,PSG P,5,+PSGOO RD,0),"^", 26,27)=PSG ORD_"^E" | |
| 12467 | "RTN","PSG OEE",111,0 ) | |
| 12468 | E S $P(^ PS(53.1,+P SGOORD,0), "^",26,27) =PSGORD_"^ E" | |
| 12469 | "RTN","PSG OEE",112,0 ) | |
| 12470 | I $G(PSJF SI) I $$GE TSI^PSJBCM A5(DFN,PSG OORD) D FI LESI^PSJBC MA5(DFN,PS GORD) | |
| 12471 | "RTN","PSG OEE",113,0 ) | |
| 12472 | I 'PSGOEA V,($G(PSGO RD)["P"),' $G(^PS(53. 1,+PSGORD, 2.5)),$G(^ PS(53.1,+P SGORD,0)) D | |
| 12473 | "RTN","PSG OEE",114,0 ) | |
| 12474 | .N DUR S DUR=$$GETD UR^PSJLIVM D(PSGP,PSG ORD,$S(PSG ORD["P":"P ",1:5),1) I DUR]"" K DA,DR,DIE S DIE="^P S(53.1,",D A=+PSGORD, DR="116/// /"_DUR D ^ DIE | |
| 12475 | "RTN","PSG OEE",115,0 ) | |
| 12476 | I PSGOEAV D | |
| 12477 | "RTN","PSG OEE",116,0 ) | |
| 12478 | .S ^TMP(" PSODAOC",$ J,"IP IEN" )=PSGORD | |
| 12479 | "RTN","PSG OEE",117,0 ) | |
| 12480 | .D SETOC^ PSJNEWOC(P SGORD) ;PS J*5*281 st ores order checks | |
| 12481 | "RTN","PSG OEE",118,0 ) | |
| 12482 | I PSGOEAV ,+PSJSYSU= 3,'$D(PSGO ES) D EN^P SGPEN(PSGO RD),UNL^PS SLOCK(PSGP ,PSGORD) Q | |
| 12483 | "RTN","PSG OEE",119,0 ) | |
| 12484 | S PSJORD= PSGORD,PSG ACT=$$ENAC TION^PSGOE 1(PSGP,PSG ORD) | |
| 12485 | "RTN","PSG OEE",120,0 ) | |
| 12486 | Q | |
| 12487 | "RTN","PSG OEE",121,0 ) | |
| 12488 | UPD ; | |
| 12489 | "RTN","PSG OEE",122,0 ) | |
| 12490 | ;/MZR add ed next li ne to prev ent updati ng if noth ing change d | |
| 12491 | "RTN","PSG OEE",123,0 ) | |
| 12492 | Q:$G(PSGO EE)=0 | |
| 12493 | "RTN","PSG OEE",124,0 ) | |
| 12494 | K DA W !! ,"...updat ing order. .." | |
| 12495 | "RTN","PSG OEE",125,0 ) | |
| 12496 | I PSGORD[ "P" S PSJC OM=+$P($G( ^PS(53.1,+ PSGORD,.2) ),"^",8) I PSJCOM D UPD^PSJCOM Q | |
| 12497 | "RTN","PSG OEE",126,0 ) | |
| 12498 | I $$DIFFS I^PSJBCMA5 (DFN,PSGOR D) D | |
| 12499 | "RTN","PSG OEE",127,0 ) | |
| 12500 | .N SIARRA Y M:PSGORD ["P" SIARR AY=^PS(53. 1,+PSGORD, 15) M:PSGO RD["U" SIA RRAY=^PS(5 5,DFN,5,+P SGORD,15) | |
| 12501 | "RTN","PSG OEE",128,0 ) | |
| 12502 | .Q:'$D(SI ARRAY) | |
| 12503 | "RTN","PSG OEE",129,0 ) | |
| 12504 | .I PSGORD ["P" D NEW NVAL^PSGAL 5(PSGORD,6 000,"SPECI AL INSTRUC TIONS",,.S IARRAY) | |
| 12505 | "RTN","PSG OEE",130,0 ) | |
| 12506 | .I PSGORD ["U" D NEW UDAL^PSGAL 5(DFN,PSGO RD,6000,"S PECIAL INS TRUCTIONS" ,,.SIARRAY ) | |
| 12507 | "RTN","PSG OEE",131,0 ) | |
| 12508 | ; Set tri gger for F IELD (12) Dispense D rug to pri nt a updat ed pick li st. | |
| 12509 | "RTN","PSG OEE",132,0 ) | |
| 12510 | I PSGORD[ "U",$D(^PS (53.45,PSJ SYSP,2,1,0 )),$D(^PS( 55,PSGP,5, +PSGORD,1, 1,0)) D | |
| 12511 | "RTN","PSG OEE",133,0 ) | |
| 12512 | .N PSJX12 ,PSJF12 S PSJF12=0 | |
| 12513 | "RTN","PSG OEE",134,0 ) | |
| 12514 | .F PSJX12 =0:1 S PSJ X12=$O(^PS (53.45,PSJ SYSP,2,PSJ X12)) Q:+P SJX12=0 S :$G(^PS(53 .45,PSJSYS P,2,PSJX12 ,0))'=$G(^ PS(55,PSGP ,5,+PSGORD ,1,PSJX12, 0)) PSJF12 =1 | |
| 12515 | "RTN","PSG OEE",135,0 ) | |
| 12516 | .S:PSJF12 ^PS(55,"A UE",PSGP,+ PSGORD)="" | |
| 12517 | "RTN","PSG OEE",136,0 ) | |
| 12518 | N TMP,PSG SIF S TMP= PSGOEENO N PSGOEENO S PSGOEENO =TMP | |
| 12519 | "RTN","PSG OEE",137,0 ) | |
| 12520 | N II F II =1:1:$L($G (DR),";") I $E($P($G (DR),";",I I),1,7)="1 22////" S PSGSIF=$P( PSGSI,"^", 2),PSGSI=$ P(PSGSI,"^ ") Q | |
| 12521 | "RTN","PSG OEE",138,0 ) | |
| 12522 | I $G(PSJC OM),$G(PSJ COMSI) K P SJCOMSI,^T MP("PSGSI" ,$J) M ^TM P("PSGSI", $J,5)=^PS( 53.45,PSJS YSP,5) D | |
| 12523 | "RTN","PSG OEE",139,0 ) | |
| 12524 | .D FILESI ^PSJBCMA5( DFN,PSGORD ) | |
| 12525 | "RTN","PSG OEE",140,0 ) | |
| 12526 | .N PSJCHI LD,PSJOEOR D S PSJOEO RD=0 F S PSJOEORD=$ O(^PS(55," ACX",PSJCO M,PSJOEORD )) Q:'PSJO EORD D | |
| 12527 | "RTN","PSG OEE",141,0 ) | |
| 12528 | ..S PSJCH ILD=0 F S PSJCHILD= $O(^PS(55, "ACX",PSJC OM,PSJOEOR D,PSJCHILD )) Q:'PSJC HILD D | |
| 12529 | "RTN","PSG OEE",142,0 ) | |
| 12530 | ...Q:PSJC HILD=PSGOR D N DR,DA ,DIE,ORD S DR=$S(PSJ CHILD["V": "31////"_$ G(P("OPI") ),1:"8//// "_$G(PSGSI )) S DR=DR _";"_$S(PS JCHILD["V" :146,1:122 )_"////"_+ $G(PSGSIF) | |
| 12531 | "RTN","PSG OEE",143,0 ) | |
| 12532 | ...I '$D( ^PS(53.45, +$G(PSJSYS P),5)) M ^ PS(53.45,+ $G(PSJSYSP ),5)=^TMP( "PSGSI",$J ,5) | |
| 12533 | "RTN","PSG OEE",144,0 ) | |
| 12534 | ...D FILE SI^PSJBCMA 5(DFN,PSJC HILD) | |
| 12535 | "RTN","PSG OEE",145,0 ) | |
| 12536 | ...;PSJ*5 *179 Comme nt edits | |
| 12537 | "RTN","PSG OEE",146,0 ) | |
| 12538 | ...S DR=$ TR(DR,"*") I DR'="" S DA=+PSJC HILD,DIE=$ S(PSJCHILD ["U":"^PS( 55,"_PSGP_ ",5,",1:"^ PS(53.1,") S:DIE["^P S(55," DA( 1)=PSGP D ^DIE W "." D EN1^PSJ HL2(PSGP," XX",+PSJCH ILD_"U") | |
| 12539 | "RTN","PSG OEE",147,0 ) | |
| 12540 | .K ^TMP(" PSGSI",$J) | |
| 12541 | "RTN","PSG OEE",148,0 ) | |
| 12542 | S DR=$TR( DR,"*") I DR'="" S D A=+PSGORD, DIE=$S(PSG ORD["U":"^ PS(55,"_PS GP_",5,",1 :"^PS(53.1 ,") S:DIE[ "^PS(55," DA(1)=PSGP D ^DIE W "." | |
| 12543 | "RTN","PSG OEE",149,0 ) | |
| 12544 | F Q=1,3 K @(PSGOEEW F_Q_")") S %X="^PS(5 3.45,"_PSJ SYSP_","_$ S(Q=1:2,1: 1)_",",%Y= PSGOEEWF_Q _"," K @(P SGOEEWF_Q_ ")") D %XY ^%RCR W ". " | |
| 12545 | "RTN","PSG OEE",150,0 ) | |
| 12546 | S $P(@(PS GOEEWF_"1, 0)"),"^",2 )=$S(PSGOR D["U":55.0 7,1:53.11) _"P" | |
| 12547 | "RTN","PSG OEE",151,0 ) | |
| 12548 | I $D(^PS( 53.45,+$G( PSJSYSP),5 )) D FILES I^PSJBCMA5 (DFN,PSJOR D) | |
| 12549 | "RTN","PSG OEE",152,0 ) | |
| 12550 | ; Naked r eference o n the line below ref ers to ful l referenc e using in direction to either ^PS(55 or ^PS(53.1, | |
| 12551 | "RTN","PSG OEE",153,0 ) | |
| 12552 | S ND=$G(@ ($S(PSGORD ["U":"^PS( 55,"_PSGP_ ",5,",1:"^ PS(53.1,") _+PSGORD_" ,0)")) I $ P(ND,"^",2 1) S ORIFN =$P(ND,"^" ,21),ND1=$ G(^(.2)),N D2=$G(^(2) ),ND2P1=$G (^(2.1)) W !,"...upd ating OE/R R..." D EN 1^PSJHL2(P SGP,"XX",P SGORD) ;*3 15 | |
| 12553 | "RTN","PSG OEE",154,0 ) | |
| 12554 | I $$ENACT ION^PSGOE1 (PSGP,PSGO RD)["V" S VALMBCK="R " | |
| 12555 | "RTN","PSG OEE",155,0 ) | |
| 12556 | I PSJSYSL ,PSJSYSL<3 S $P(@($S (PSGORD["U ":"^PS(55, "_PSGP_",5 ,",1:"^PS( 53.1,")_+P SGORD_",7) "),"^",1,2 )=PSGDT_"^ "_$E("D",P SGOEENO)_" E",PSGTOL= 2,PSGUOW=D UZ,PSGTOO= PSGORD'["U "+1,DA=+PS GORD D ENL ^PSGVDS | |
| 12557 | "RTN","PSG OEE",156,0 ) | |
| 12558 | ; **This is where t he Automat ed Dispens ing Machin e hook is called. Do NOT DELET E or chang e this loc ation ** | |
| 12559 | "RTN","PSG OEE",157,0 ) | |
| 12560 | D EDIT^PS JADM | |
| 12561 | "RTN","PSG OEE",158,0 ) | |
| 12562 | ; **END o f Interfac e Hook ** | |
| 12563 | "RTN","PSG OEE",159,0 ) | |
| 12564 | Q | |
| 12565 | "RTN","PSG OEE",160,0 ) | |
| 12566 | OUT ; | |
| 12567 | "RTN","PSG OEE",161,0 ) | |
| 12568 | D ABORT K PSGNEWDT S PSGCANFL =1 D GETUD ^PSJLMGUD( PSGP,PSGOR D),ENSFE^P SGOEE0(PSG P,PSGORD), INIT^PSJLM UDE(PSGP,P SGORD) | |
| 12569 | "RTN","PSG OEE",162,0 ) | |
| 12570 | Q | |
| 12571 | "RTN","PSG OEE",163,0 ) | |
| 12572 | DONE ; | |
| 12573 | "RTN","PSG OEE",164,0 ) | |
| 12574 | I PSGORD[ "P",'$D(PS GOEF),PSGS CH]"",$$GE T1^DIQ(53. 11,"1,"_+P SGORD,.01, "I") D ENF ^PSGOEE0 | |
| 12575 | "RTN","PSG OEE",165,0 ) | |
| 12576 | DONE1 ; | |
| 12577 | "RTN","PSG OEE",166,0 ) | |
| 12578 | ;; START NCC REMEDI ATION >> 3 27*RJS ;/R BN & MZR c hanged con ditions on the next line | |
| 12579 | "RTN","PSG OEE",167,0 ) | |
| 12580 | I $G(PSGE DT),$$GET1 ^DIQ(55.06 ,+$G(PSGOR D)_","_DFN ,.01,"I") D | |
| 12581 | "RTN","PSG OEE",168,0 ) | |
| 12582 | .N ORIFN, PSGDRG,CLO ZFLG S ORI FN=+$$GET1 ^DIQ(55.06 ,+$G(PSGOR D)_","_DFN ,66) I ORI FN D | |
| 12583 | "RTN","PSG OEE",169,0 ) | |
| 12584 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) Q:'PSGPT R | |
| 12585 | "RTN","PSG OEE",170,0 ) | |
| 12586 | ..S PSGDR G=$$GET1^D IQ(100.045 ,PSGPTR_", "_ORIFN,1, "I") | |
| 12587 | "RTN","PSG OEE",171,0 ) | |
| 12588 | .I '$G(PS GDRG),$D(P SJXDOX("DD ")) S PSGD RG=$O(PSJX DOX("DD"," ")) | |
| 12589 | "RTN","PSG OEE",172,0 ) | |
| 12590 | .I $G(PSG DRG),$$GET 1^DIQ(50,P SGDRG,17.5 )="PSOCLO1 " S CLOZFL G=1 | |
| 12591 | "RTN","PSG OEE",173,0 ) | |
| 12592 | .I $G(CLO ZFLG) D | |
| 12593 | "RTN","PSG OEE",174,0 ) | |
| 12594 | ..N DIE,D A,DR S DIE ="^PS(55," _DFN_",5," ,DA=+PSGOR D,DA(1)=DF N,DR="301/ ///" | |
| 12595 | "RTN","PSG OEE",175,0 ) | |
| 12596 | ..I $D(^T MP("PSJCOM ",$J,+$G(P SGORD))) D K ^TMP($ J,"PSGCLOZ ",DFN,+$G( PSJORD),"S AND") I 1 | |
| 12597 | "RTN","PSG OEE",176,0 ) | |
| 12598 | ...S DR=D R_$G(^TMP( "PSJCOM",$ J,+$G(PSGO RD),"SAND" )) | |
| 12599 | "RTN","PSG OEE",177,0 ) | |
| 12600 | ..E I $G (^TMP($J," PSGCLOZ",D FN,+$G(PSJ ORD),"SAND ")) D K ^ TMP($J,"PS GCLOZ",DFN ,+$G(PSJOR D),"SAND") I 1 | |
| 12601 | "RTN","PSG OEE",178,0 ) | |
| 12602 | ...S DR=D R_$G(^TMP( $J,"PSGCLO Z",DFN,+$G (PSJORD)," SAND")) | |
| 12603 | "RTN","PSG OEE",179,0 ) | |
| 12604 | ..E I $G (^TMP($J," PSGCLOZ",D FN,+$G(PSG ORD),"SAND ")) D K ^ TMP($J,"PS GCLOZ",DFN ,+$G(PSGOR D),"SAND") | |
| 12605 | "RTN","PSG OEE",180,0 ) | |
| 12606 | ...S DR=D R_$G(^TMP( $J,"PSGCLO Z",DFN,+$G (PSGORD)," SAND")) | |
| 12607 | "RTN","PSG OEE",181,0 ) | |
| 12608 | ..D ^DIE | |
| 12609 | "RTN","PSG OEE",182,0 ) | |
| 12610 | ..I $G(PS GDRG) N PS GDN S PSGD N=PSGDRG ; $O(PSJXDOX ("DD",0)) | |
| 12611 | "RTN","PSG OEE",183,0 ) | |
| 12612 | ..D PSJFI LE^PSJCLOZ (DFN),INPS ND^YSCLTST 5 | |
| 12613 | "RTN","PSG OEE",184,0 ) | |
| 12614 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 12615 | "RTN","PSG OEE",185,0 ) | |
| 12616 | I PSGORD[ "U" S X=+P SGORD L -^ PS(55,PSGP ,5,X) | |
| 12617 | "RTN","PSG OEE",186,0 ) | |
| 12618 | E L -^PS (53.1,+PSG ORD) | |
| 12619 | "RTN","PSG OEE",187,0 ) | |
| 12620 | K ^PS(53. 45,+PSJSYS P,1),^(2), ^(5),^(6) | |
| 12621 | "RTN","PSG OEE",188,0 ) | |
| 12622 | I '$D(PSG OEF) K PSG SD,PSGSCH, PSGST,PSGF D | |
| 12623 | "RTN","PSG OEE",189,0 ) | |
| 12624 | K DA,DIE, DIR,DP,DR, DRG,ND,ND0 ,ND1,ND2,N D2P1,ORIFN ,PSGAL,PSG ALEF,PSGAT ,PSGOEE,PS GOEEF,PSGO EEG,PSGOEE WF,PSGEFN, PSGTOL,PSG TOO,PSGUOW ,XREF,PSGE FN,PSGMR,P SGMRN,PSGO ROE1,PSGPD ,PSGPDN,PS GSI,PSGPR, PSGSM,PSGH SM,PSGSTN, PSGSDN,PSG FDN,PSGPRN | |
| 12625 | "RTN","PSG OEE",190,0 ) | |
| 12626 | K PSGDO,P SGOEENO Q | |
| 12627 | "RTN","PSG OEE",191,0 ) | |
| 12628 | K1 ; | |
| 12629 | "RTN","PSG OEE",192,0 ) | |
| 12630 | K BACK,F1 ,F2,PSGF2, MSG,PSGEFN ,PSGNEWDT, PSGOEEND,P SGOPD,PSGO PDN,PSGOMR ,PSGOMRN,P SGOSCH,PSG OSI,PSGOPR ,PSGOSM,PS GOHSM,PSGO SD,PSGOFD, PSGOST,PSG OPRN,PSGOS TN,PSGOSDN ,PSGOFDN,P SGODO,PSGP DRG,PSGPDR GN,PSGOEER | |
| 12631 | "RTN","PSG OEE",193,0 ) | |
| 12632 | Q | |
| 12633 | "RTN","PSG OEE",194,0 ) | |
| 12634 | ; | |
| 12635 | "RTN","PSG OEE",195,0 ) | |
| 12636 | ABORT ; Di splay no c hange mess age and pa use. | |
| 12637 | "RTN","PSG OEE",196,0 ) | |
| 12638 | D FULL^VA LM1 | |
| 12639 | "RTN","PSG OEE",197,0 ) | |
| 12640 | S (PSGDI, PSGDFLG)=' $$DDOK^PSG OE2(PSGOEE WF_"1,",+$ G(@(PSGOEE WF_".2)")) ) | |
| 12641 | "RTN","PSG OEE",198,0 ) | |
| 12642 | S PSGPFLG ='$$OIOK^P SGOE2(+$G( @(PSGOEEWF _".2)"))) | |
| 12643 | "RTN","PSG OEE",199,0 ) | |
| 12644 | I '$G(PSJ RNFLG) W ! !,$C(7),"N o changes made to th is order." D PAUSE^V ALM1 ;if flag set i n PSODGAL1 , no repea t message | |
| 12645 | "RTN","PSG OEE",200,0 ) | |
| 12646 | K PSGOEEF S PSGOEEF =0 | |
| 12647 | "RTN","PSG OEE",201,0 ) | |
| 12648 | Q | |
| 12649 | "RTN","PSG OEE",202,0 ) | |
| 12650 | ; | |
| 12651 | "RTN","PSG OEE",203,0 ) | |
| 12652 | GTSTATUS ; Determine status of new order and set L M title. | |
| 12653 | "RTN","PSG OEE",204,0 ) | |
| 12654 | S PSGSTAT =$S($P($G( PSJSYSP0), U,9):"ACTI VE",1:"NON -VERIFIED" ) | |
| 12655 | "RTN","PSG OEE",205,0 ) | |
| 12656 | S VALM("T ITLE")=PSG STAT_" UNI T DOSE "_$ S(PSGSTAT= "PENDING": "("_PSGPRI O_")",1:"" ) | |
| 12657 | "RTN","PSG OEE",206,0 ) | |
| 12658 | Q | |
| 12659 | "RTN","PSG OEE",207,0 ) | |
| 12660 | ; | |
| 12661 | "RTN","PSG OEE",208,0 ) | |
| 12662 | ASKOVR(Y,P SJOVRON,PS JSTARI) ; Check to see if any starred f ields are being edit ed. If so, ask if th ey wish to view over rides/inte rventions if they ex ist | |
| 12663 | "RTN","PSG OEE",209,0 ) | |
| 12664 | Q:'$D(Y)! $D(PSJSTAR I) N II,I 3,YY S YY= $S(Y:Y,1:$ TR($P(Y,"^ ",4),"=")) | |
| 12665 | "RTN","PSG OEE",210,0 ) | |
| 12666 | Q:'YY S PSJOVRON=$ S($G(PSJOV RON):PSJOV RON,1:$G(P SJORD)) Q: '$G(PSJOVR ON) | |
| 12667 | "RTN","PSG OEE",211,0 ) | |
| 12668 | N PSJORD S PSJORD=P SJOVRON | |
| 12669 | "RTN","PSG OEE",212,0 ) | |
| 12670 | I '$G(PSJ STARI) F I I=1:1:$L(Y Y,",") Q:$ G(PSJSTARI ) S I3=$P (YY,",",II ) I I3 S:$ G(PSGEFN(I 3))!($G(PS JSTAR)[("( "_I3_")")) PSJSTARI= 1 | |
| 12671 | "RTN","PSG OEE",213,0 ) | |
| 12672 | I $G(PSJS TARI) I ($ G(PSJORD)& $G(PSGP)) I $$ASKDIS P^PSGSICH1 D FULL^VA LM1 D OVRD ISP^PSGSIC H2(PSGP,PS JORD,3) | |
| 12673 | "RTN","PSG OEE",214,0 ) | |
| 12674 | Q | |
| 12675 | "RTN","PSG OEE",215,0 ) | |
| 12676 | ; | |
| 12677 | "RTN","PSG OEE",216,0 ) | |
| 12678 | FIELDS ; | |
| 12679 | "RTN","PSG OEE",217,0 ) | |
| 12680 | 31 ;;101^P SGOE8;PSGO PD;PSGPD;1 01;1 | |
| 12681 | "RTN","PSG OEE",218,0 ) | |
| 12682 | 32 ;;109^P SGOE8;PSGO DO;PSGDO;1 09;PSGODO] "" | |
| 12683 | "RTN","PSG OEE",219,0 ) | |
| 12684 | 33 ;;10^PS GOE81;PSGO SD;PSGSD;1 0;0 | |
| 12685 | "RTN","PSG OEE",220,0 ) | |
| 12686 | 34 ;;3^PSG OE8;PSGOMR ;PSGMR;3;1 | |
| 12687 | "RTN","PSG OEE",221,0 ) | |
| 12688 | 35 ;;25^PS GOE81;PSGO FD;PSGFD;2 5;0 | |
| 12689 | "RTN","PSG OEE",222,0 ) | |
| 12690 | 36 ;;7^PSG OE8;PSGOST ;PSGST;7;0 | |
| 12691 | "RTN","PSG OEE",223,0 ) | |
| 12692 | 37 ;;5^PSG OE82;PSGOS M;PSGSM;5; 0 | |
| 12693 | "RTN","PSG OEE",224,0 ) | |
| 12694 | 38 ;;26^PS GOE8;PSGOS CH;PSGSCH; 26;1 | |
| 12695 | "RTN","PSG OEE",225,0 ) | |
| 12696 | 39 ;;39^PS GOE81;PSGO AT;PSGAT;3 9;0 | |
| 12697 | "RTN","PSG OEE",226,0 ) | |
| 12698 | 310 ;;1^PS GOE82;PSGO PR;PSGPR;1 ;1 | |
| 12699 | "RTN","PSG OEE",227,0 ) | |
| 12700 | 311 ;;8^PS GOE81;PSGO SI;PSGSI;8 ;0 | |
| 12701 | "RTN","PSG OEE",228,0 ) | |
| 12702 | 312 ;;2^PS GOE82;;;2; 0 | |
| 12703 | "RTN","PSG OEE",229,0 ) | |
| 12704 | 313 ;;40^P SGOE82;;;4 0;0 | |
| 12705 | "RTN","PSG OEE",230,0 ) | |
| 12706 | 51 ;;101^P SGOE9;PSGO PD;PSGPD;1 01;1 | |
| 12707 | "RTN","PSG OEE",231,0 ) | |
| 12708 | 52 ;;109^P SGOE9;PSGO DO;PSGDO;1 09;PSGODO] "" | |
| 12709 | "RTN","PSG OEE",232,0 ) | |
| 12710 | 53 ;;10^PS GOE91;PSGO SD;PSGSD;1 0;1 | |
| 12711 | "RTN","PSG OEE",233,0 ) | |
| 12712 | 54 ;;3^PSG OE9;PSGOMR ;PSGMR;3;1 | |
| 12713 | "RTN","PSG OEE",234,0 ) | |
| 12714 | 55 ;;34^PS GOE91;PSGO FD;PSGFD;3 4;1 | |
| 12715 | "RTN","PSG OEE",235,0 ) | |
| 12716 | 56 ;;7^PSG OE9;PSGOST ;PSGST;7;0 | |
| 12717 | "RTN","PSG OEE",236,0 ) | |
| 12718 | 57 ;;5^PSG OE92;PSGOS M;PSGSM;5; 0 | |
| 12719 | "RTN","PSG OEE",237,0 ) | |
| 12720 | 58 ;;26^PS GOE9;PSGOS CH;PSGSCH; 26;1 | |
| 12721 | "RTN","PSG OEE",238,0 ) | |
| 12722 | 59 ;;41^PS GOE91;PSGO AT;PSGAT;4 1;0 | |
| 12723 | "RTN","PSG OEE",239,0 ) | |
| 12724 | 510 ;;1^PS GOE92;PSGO PR;PSGPR;1 ;1 | |
| 12725 | "RTN","PSG OEE",240,0 ) | |
| 12726 | 511 ;;8^PS GOE91;PSGO SI;PSGSI;8 ;0 | |
| 12727 | "RTN","PSG OEE",241,0 ) | |
| 12728 | 512 ;;2^PS GOE92;;;2; 0 | |
| 12729 | "RTN","PSG OEE",242,0 ) | |
| 12730 | 513 ;;15^P SGOE92;;;1 5;0 | |
| 12731 | "RTN","PSG OEF") | |
| 12732 | 0^25^B1494 03477 | |
| 12733 | "RTN","PSG OEF",1,0) | |
| 12734 | PSGOEF ;BI R/CML3 - F INISH ORDE RS ENTERED THROUGH O E/RR ; 25 Oct 2017 4:10 PM | |
| 12735 | "RTN","PSG OEF",2,0) | |
| 12736 | ;;5.0;INP ATIENT MED ICATIONS;* *7,30,29,3 5,39,47,50 ,56,80,116 ,110,111,1 33,153,134 ,222,113,1 81,260,199 ,281,315,3 27**;16 DE C 97;Build 64 | |
| 12737 | "RTN","PSG OEF",3,0) | |
| 12738 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 12739 | "RTN","PSG OEF",4,0) | |
| 12740 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191 | |
| 12741 | "RTN","PSG OEF",5,0) | |
| 12742 | ; Referen ce to ^PSD RUG( is su pported by DBIA 2192 | |
| 12743 | "RTN","PSG OEF",6,0) | |
| 12744 | ; Referen ce to DOSE ^PSSORPH i s supporte d by DBIA 3234. | |
| 12745 | "RTN","PSG OEF",7,0) | |
| 12746 | ; Referen ce to ^TMP ("PSODAOC" ,$J is sup ported by DBIA 6071. | |
| 12747 | "RTN","PSG OEF",8,0) | |
| 12748 | ; Referen ce to FULL ^VALM1 is supported by DBIA 10 116. | |
| 12749 | "RTN","PSG OEF",9,0) | |
| 12750 | ; Referen ce to ^PS( 50.7 is su pported by DBIA# 218 0 | |
| 12751 | "RTN","PSG OEF",10,0) | |
| 12752 | ; | |
| 12753 | "RTN","PSG OEF",11,0) | |
| 12754 | START ; | |
| 12755 | "RTN","PSG OEF",12,0) | |
| 12756 | I '$D(^PS (53.1,+PSG ORD)) W $C (7),!?3,"C annot find this pend ing order (#",+PSGOR D,")." Q | |
| 12757 | "RTN","PSG OEF",13,0) | |
| 12758 | D NOW^%DT C S PSGDT= +$E(%,1,12 ) K PSGFDX ,PSGEFN,PS GOEEF,PSGO ES,PSGONF, PSGRDTX S PSGOES=1,( PSGOEF,PSG OEEF)=0,PS GOEEG=3 | |
| 12759 | "RTN","PSG OEF",14,0) | |
| 12760 | I '$G(PSG DRG) N PSG DRG S PSGD RG=$$GET1^ DIQ(53.11, "1,"_+PSGO RD,.01,"I" ) | |
| 12761 | "RTN","PSG OEF",15,0) | |
| 12762 | N CLOZFLG S CLOZFLG =$$CLOZDRG ;I $$GET 1^DIQ(50,+ $G(PSGDRG) ,17.5)="PS OCLO1" S C LOZFLG=1 | |
| 12763 | "RTN","PSG OEF",16,0) | |
| 12764 | I $G(CLOZ FLG),'$D(C LOZPAT) D CLOZPAT^PS JCLOZ | |
| 12765 | "RTN","PSG OEF",17,0) | |
| 12766 | I $D(PSJT UD) S PSGD O=$P($G(^P S(53.1,+PS GORD,.3)), U),(PSGPDR G,PSGPD)=P SJCOI,(PSG PDRGN,PSGP DN)=$$OINA ME^PSJLMUT L(PSGPD) | |
| 12767 | "RTN","PSG OEF",18,0) | |
| 12768 | I $P($G(^ PS(53.1,+P SGORD,0)), U,24)'="R" S X=PSGSC H D EN^PSG ORS0 D | |
| 12769 | "RTN","PSG OEF",19,0) | |
| 12770 | .S:($D(X) &($P($G(^P S(53.1,+PS GORD,2))," ^",5)="")& ($P($G(^PS (53.1,+PSG ORD,0)),"^ ",24)="N") ) PSGAT=PS GS0Y | |
| 12771 | "RTN","PSG OEF",20,0) | |
| 12772 | .N PSJDOX ,PSJDOSE,P SJPIECE,PS JUNIT,PSJX ,X | |
| 12773 | "RTN","PSG OEF",21,0) | |
| 12774 | .S X=$G(^ PS(53.1,+P SGORD,1,1, 0)) Q:'+X | |
| 12775 | "RTN","PSG OEF",22,0) | |
| 12776 | .D DOSE^P SSORPH(.PS JDOX,+X,"U ") | |
| 12777 | "RTN","PSG OEF",23,0) | |
| 12778 | .I $S('$D (PSJDOX):1 ,1:+PSJDOX (1)=-1) Q | |
| 12779 | "RTN","PSG OEF",24,0) | |
| 12780 | .S PSJPIE CE=$S($P(P SJDOX(1),U )="":3,1:1 ) | |
| 12781 | "RTN","PSG OEF",25,0) | |
| 12782 | .S X=^PS( 53.1,+PSGO RD,.2) | |
| 12783 | "RTN","PSG OEF",26,0) | |
| 12784 | .S:PSJPIE CE=3 PSJDO SE=$P(X,U, 2) | |
| 12785 | "RTN","PSG OEF",27,0) | |
| 12786 | .S:PSJPIE CE=1 PSJDO SE=$P(X,U, 5),PSJUNIT =$P(X,U,6) | |
| 12787 | "RTN","PSG OEF",28,0) | |
| 12788 | .F X=0:0 S X=$O(PSJ DOX(X)) Q: +$G(PSJX)! 'X D | |
| 12789 | "RTN","PSG OEF",29,0) | |
| 12790 | ..I PSJPI ECE=3,($P( PSJDOX(X), U,3)'=PSJD OSE) Q | |
| 12791 | "RTN","PSG OEF",30,0) | |
| 12792 | ..I PSJPI ECE=1,($P( PSJDOX(X), U,1)_$P(PS JDOX(X),U, 2)'=(PSJDO SE_PSJUNIT )) Q | |
| 12793 | "RTN","PSG OEF",31,0) | |
| 12794 | ..S:+$P(P SJDOX(X),U ,12) $P(^P S(53.45,PS JSYSP,2,1, 0),U,2)=+$ P(PSJDOX(X ),U,12),PS JX=1 | |
| 12795 | "RTN","PSG OEF",32,0) | |
| 12796 | I PSGEB'= PSGOPR F X =7,11 S Y= $T(@(3_X)) ,@("PSGEFN ("_X_")="_ $P(Y,";",7 )),PSGOEEF (+$P(Y,";" ,3))="",PS GOEEF=PSGO EEF+1 | |
| 12797 | "RTN","PSG OEF",33,0) | |
| 12798 | D GTST^PS GOE6(+PSGO RD) | |
| 12799 | "RTN","PSG OEF",34,0) | |
| 12800 | I $P($G(^ PS(53.1,+P SGORD,0)), U,24)'="R" S PSGSD=" " D:PSGS0Y ]"" | |
| 12801 | "RTN","PSG OEF",35,0) | |
| 12802 | .N PSJX S PSJX=$P($ G(^PS(53.1 ,+PSGORD,0 )),U,25) I PSJX="" Q | |
| 12803 | "RTN","PSG OEF",36,0) | |
| 12804 | .I PSJX[" U" S PSGSD =$P($G(^PS (55,DFN,5, +PSJX,2)), U,2) Q | |
| 12805 | "RTN","PSG OEF",37,0) | |
| 12806 | .I PSJX[" V" S PSGSD =$P($G(^PS (55,DFN,"I V",+PSJX,0 )),U,2) Q | |
| 12807 | "RTN","PSG OEF",38,0) | |
| 12808 | .I PSJX[" P" S PSGSD =$P($G(^PS (53.1,+PSJ X,2)),U,2) | |
| 12809 | "RTN","PSG OEF",39,0) | |
| 12810 | S:PSGSD=" " PSGSD=PS GLI | |
| 12811 | "RTN","PSG OEF",40,0) | |
| 12812 | S PSGNEDF D=$$GTNEDF D^PSGOE7(" U",+PSGPD) | |
| 12813 | "RTN","PSG OEF",41,0) | |
| 12814 | S:$P($G(P SGNEDFD),U ,3)="" $P( PSGNEDFD,U ,3)=PSGST ; N PSGOE A S PSGOEA ="R" | |
| 12815 | "RTN","PSG OEF",42,0) | |
| 12816 | ZZ S (PSGN ESD,PSGSD) =$$ENSD^PS GNE3(PSGSC H,PSGS0Y,P SGLI,PSGSD ) | |
| 12817 | "RTN","PSG OEF",43,0) | |
| 12818 | ;; START NCC REMEDI ATION >> 3 27*RJS - n ext line h as been ad ded | |
| 12819 | "RTN","PSG OEF",44,0) | |
| 12820 | I $G(CLOZ FLG),$$CLO ZDRG D COM PLEX1^PSJC LOZ | |
| 12821 | "RTN","PSG OEF",45,0) | |
| 12822 | ;if this is a renew al order, ignore any 'requeste d start da te' receiv ed. Use t he system calculated start dat e. | |
| 12823 | "RTN","PSG OEF",46,0) | |
| 12824 | I $P($G(^ PS(53.1,+P SGORD,0)), U,24)'="R" D | |
| 12825 | "RTN","PSG OEF",47,0) | |
| 12826 | . D REQDT ^PSJLIVMD( PSGORD) | |
| 12827 | "RTN","PSG OEF",48,0) | |
| 12828 | E D | |
| 12829 | "RTN","PSG OEF",49,0) | |
| 12830 | . S X=$$D START^PSJD CU(DFN,$P( ^PS(53.1,+ PSGORD,0), U,25)) I X ]"" S (PSG NESD,PSGSD )=X K PSGR SD | |
| 12831 | "RTN","PSG OEF",50,0) | |
| 12832 | D ; Ext end the De fault Stop Date if n eeded for the first renewed or der. | |
| 12833 | "RTN","PSG OEF",51,0) | |
| 12834 | .N PSGOEA O,PSGWALLO | |
| 12835 | "RTN","PSG OEF",52,0) | |
| 12836 | .I $P($G( ^PS(53.1,+ PSGORD,0)) ,U,24)="R" S PSGOEAO =PSGOEA,PS GOEA="R",P SGWALLO=$P (^PS(55,DF N,5.1),U) | |
| 12837 | "RTN","PSG OEF",53,0) | |
| 12838 | .D ENFD^P SGNE3(PSGL I) S PSGFD =$S($G(PSG RDTX(+PSGO RD,"PSGFD" )):PSGRDTX (+PSGORD," PSGFD"),1: PSGNEFD) | |
| 12839 | "RTN","PSG OEF",54,0) | |
| 12840 | .I $P($G( ^PS(53.1,+ PSGORD,0)) ,U,24)="R" S PSGOEA= PSGOEAO,$P (^PS(55,DF N,5.1),U)= PSGWALLO | |
| 12841 | "RTN","PSG OEF",55,0) | |
| 12842 | N DUR,PSG RNSD S PSG RNSD=+$$LA STREN^PSJL MPRI(DFN,P SGORD) I P SGRNSD S D UR=$$GETDU R^PSJLIVMD (DFN,PSGOR D,"P",1) I DUR]"" D | |
| 12843 | "RTN","PSG OEF",56,0) | |
| 12844 | . N DURMI N S DURMIN =$$DURMIN^ PSJLIVMD(D UR) I DURM IN S PSGFD =$$FMADD^X LFDT(PSGRN SD,,,DURMI N) | |
| 12845 | "RTN","PSG OEF",57,0) | |
| 12846 | S PSGOFD= "",PSGSDN= $$ENDD^PSG MI(PSGSD)_ U_$$ENDTC^ PSGMI(PSGS D),PSGFDN= $$ENDD^PSG MI(PSGFD)_ U_$$ENDTC^ PSGMI(PSGF D) | |
| 12847 | "RTN","PSG OEF",58,0) | |
| 12848 | S PSGLIN= $$ENDD^PSG MI(PSGLI)_ U_$$ENDTC^ PSGMI(PSGL I) | |
| 12849 | "RTN","PSG OEF",59,0) | |
| 12850 | I '$$GET1 ^DIQ(53.45 02,"1,"_PS JSYSP,.01, "I") N DRG ,DRGCNT S DRGCNT=0 D | |
| 12851 | "RTN","PSG OEF",60,0) | |
| 12852 | .F X=0:0 S X=$O(^PS DRUG("ASP" ,+PSGPD,X) ) Q:'X!(DR GCNT>1) S :$P($G(^PS DRUG(+X,2) ),U,3)["U" DRGCNT=DR GCNT+1,DRG =+X | |
| 12853 | "RTN","PSG OEF",61,0) | |
| 12854 | .I DRGCNT =1 K ^PS(5 3.45,PSJSY SP,2) S ^P S(53.45,PS JSYSP,2,1, 0)=DRG_U_1 ,^PS(53.45 ,PSJSYSP,2 ,0)="^53.4 502^1^1",P S(53.45,PS JSYSP,2,"B ",+DRG,1)= "" | |
| 12855 | "RTN","PSG OEF",62,0) | |
| 12856 | Q | |
| 12857 | "RTN","PSG OEF",63,0) | |
| 12858 | FINISH ; | |
| 12859 | "RTN","PSG OEF",64,0) | |
| 12860 | ; force d isplay of second scr een if CPR S order ch ecks exist | |
| 12861 | "RTN","PSG OEF",65,0) | |
| 12862 | N NSFF,PS GOEF39,PSG EDTOI S NS FF=1 K PSJ NSS,PSGEDT OI,PSGOEER ,ZZND | |
| 12863 | "RTN","PSG OEF",66,0) | |
| 12864 | N PSJRMAB T | |
| 12865 | "RTN","PSG OEF",67,0) | |
| 12866 | I $G(PSGO RD),$D(PSG RDTX(+PSGO RD)) D K PSGRDTX | |
| 12867 | "RTN","PSG OEF",68,0) | |
| 12868 | .;PSJOCDS C stores t he default start & s top date ^ cal start & stop da te (use in dosing ca lculation for durati on) | |
| 12869 | "RTN","PSG OEF",69,0) | |
| 12870 | .;for som e reasons PSGSD & PS GFD are re set to the cal dates if order has durati on defined | |
| 12871 | "RTN","PSG OEF",70,0) | |
| 12872 | .S PSJOCD SC("CX","P SGSD",+PSG ORD)=$G(PS GSD)_U_$G( PSGRDTX(+P SGORD,"PSG RSD")) | |
| 12873 | "RTN","PSG OEF",71,0) | |
| 12874 | .S PSJOCD SC("CX","P SGFD",+PSG ORD)=$G(PS GFD)_U_$G( PSGRDTX(+P SGORD,"PSG RFD")) | |
| 12875 | "RTN","PSG OEF",72,0) | |
| 12876 | .S:$G(PSG RDTX(+PSGO RD,"PSGRSD ")) PSGSD= PSGRDTX(+P SGORD,"PSG RSD") | |
| 12877 | "RTN","PSG OEF",73,0) | |
| 12878 | .S:$G(PSG RDTX(+PSGO RD,"PSGRFD ")) PSGFD= $S($G(PSGR DTX(+PSGOR D,"PSGRFD" )):PSGRDTX (+PSGORD," PSGRFD"),1 :$G(PSGNEF D)) | |
| 12879 | "RTN","PSG OEF",74,0) | |
| 12880 | N PSJCOM S PSJCOM=+ $P($G(^PS( 53.1,+PSGO RD,.2)),"^ ",8) | |
| 12881 | "RTN","PSG OEF",75,0) | |
| 12882 | ; | |
| 12883 | "RTN","PSG OEF",76,0) | |
| 12884 | ; PSJ*5*2 22 | |
| 12885 | "RTN","PSG OEF",77,0) | |
| 12886 | ; PSJCT1 is a count er variabl e. Every piece of a complex o rder calls PSGOEF. | |
| 12887 | "RTN","PSG OEF",78,0) | |
| 12888 | ; The onl y time thi s code is to look fo r overlapp ing admin times is w hen the | |
| 12889 | "RTN","PSG OEF",79,0) | |
| 12890 | ; first p art of a c omplex ord er is bein g finished . This va riable wil l keep tra ck | |
| 12891 | "RTN","PSG OEF",80,0) | |
| 12892 | ; of how many "part s" of the complex or der have b een checke d. | |
| 12893 | "RTN","PSG OEF",81,0) | |
| 12894 | ; | |
| 12895 | "RTN","PSG OEF",82,0) | |
| 12896 | ; Also, s ince the u ser can se lect multi ple comple x orders t o finish, like selec ting | |
| 12897 | "RTN","PSG OEF",83,0) | |
| 12898 | ; orders 1-2 or 1-3 from the profile, P SJCT1A wil l keep tra ck of whet her the pa rent | |
| 12899 | "RTN","PSG OEF",84,0) | |
| 12900 | ; order n umber is t he same as the first parent or der number selected for finish ing. | |
| 12901 | "RTN","PSG OEF",85,0) | |
| 12902 | ; Since t he PSJCT1 counter va riable wil l still be set if mu ltiple com plex order s | |
| 12903 | "RTN","PSG OEF",86,0) | |
| 12904 | ; are sel ected, PSJ CT1 will b e re-set t o 1 if the parent co mplex orde r number ( PSJCT1A) i s | |
| 12905 | "RTN","PSG OEF",87,0) | |
| 12906 | ; not equ al to the original p arent orde r number ( PSJCOM). | |
| 12907 | "RTN","PSG OEF",88,0) | |
| 12908 | ; | |
| 12909 | "RTN","PSG OEF",89,0) | |
| 12910 | S PSJCT1= $G(PSJCT1) +1 | |
| 12911 | "RTN","PSG OEF",90,0) | |
| 12912 | I PSJCT1= 1 S PSJCT1 A=PSJCOM | |
| 12913 | "RTN","PSG OEF",91,0) | |
| 12914 | I $G(PSJC T1A)'=PSJC OM S PSJCT 1=1,PSJCT1 A=PSJCOM | |
| 12915 | "RTN","PSG OEF",92,0) | |
| 12916 | ; End of flag setti ng for PSJ *5*222 | |
| 12917 | "RTN","PSG OEF",93,0) | |
| 12918 | D FULL^VA LM1 | |
| 12919 | "RTN","PSG OEF",94,0) | |
| 12920 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 12921 | "RTN","PSG OEF",95,0) | |
| 12922 | ;I '$G(PS GDRG) D ; WRONG PSGD RG | |
| 12923 | "RTN","PSG OEF",96,0) | |
| 12924 | I $D(PSJX DOX("DD")) S PSGDRG= $O(PSJXDOX ("DD","")) I 1 | |
| 12925 | "RTN","PSG OEF",97,0) | |
| 12926 | E N ORIF N S ORIFN= +$P($G(PSJ XX1),U,21) I ORIFN D I $G(PSG DRG) | |
| 12927 | "RTN","PSG OEF",98,0) | |
| 12928 | .N PSGPTR S PSGPTR= $$FIND1^DI C(100.045, ","_ORIFN_ ",","X","D RUG","ID") I PSGPTR D | |
| 12929 | "RTN","PSG OEF",99,0) | |
| 12930 | ..S PSGDR G=$$GET1^D IQ(100.045 ,PSGPTR_", "_ORIFN,1, "I") | |
| 12931 | "RTN","PSG OEF",100,0 ) | |
| 12932 | Q:$G(PSGD RG)="" | |
| 12933 | "RTN","PSG OEF",101,0 ) | |
| 12934 | ; | |
| 12935 | "RTN","PSG OEF",102,0 ) | |
| 12936 | N CLOZFLG I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" S CLO ZFLG=1 | |
| 12937 | "RTN","PSG OEF",103,0 ) | |
| 12938 | I PSGSTAT '="ACTIVE" ,PSGSTAT'= "NON-VERIF IED",PSGST AT'="DISCO NTINUED",$ G(CLOZFLG) D I $G(A NQX) Q | |
| 12939 | "RTN","PSG OEF",104,0 ) | |
| 12940 | .S ANQX=0 D CLOZ^PS JCLOZ(PSGP ,PSGDRG) | |
| 12941 | "RTN","PSG OEF",105,0 ) | |
| 12942 | .I $G(ANQ X) K DIR S DIR(0)="E " D ^DIR K DIR | |
| 12943 | "RTN","PSG OEF",106,0 ) | |
| 12944 | ;; END NC C REMEDIAT ION << 327 *RJS | |
| 12945 | "RTN","PSG OEF",107,0 ) | |
| 12946 | I '$D(IOI NORM)!('$D (IOINHI)) S X="IORVO FF;IORVON; IOINHI;IOI NORM" D EN DR^%ZISS | |
| 12947 | "RTN","PSG OEF",108,0 ) | |
| 12948 | I $G(PSJC OM)'="",$G (PSJCT1)=1 D | |
| 12949 | "RTN","PSG OEF",109,0 ) | |
| 12950 | . D OVERL AP^PSGOEF2 I $G(PSJO VRLP)=1 D | |
| 12951 | "RTN","PSG OEF",110,0 ) | |
| 12952 | . . N X,X 1,DIR | |
| 12953 | "RTN","PSG OEF",111,0 ) | |
| 12954 | . . W !!, "**WARNING **" | |
| 12955 | "RTN","PSG OEF",112,0 ) | |
| 12956 | . . W !," The highli ghted admi n times fo r these po rtions of this compl ex order o verlap.",! ! | |
| 12957 | "RTN","PSG OEF",113,0 ) | |
| 12958 | . . S (X, X1)="" F S X=$O(^TM P("PSJATOV R",$J,X)) Q:X="" D | |
| 12959 | "RTN","PSG OEF",114,0 ) | |
| 12960 | . . . S X 1=$G(^TMP( "PSJATOVR" ,$J,X)) | |
| 12961 | "RTN","PSG OEF",115,0 ) | |
| 12962 | . . . W $ S($P(X1,"^ ",4)=1:IOR VON,1:""), "Part "_X, IORVOFF," has a sche dule of "_ $P(X1,"^", 2)_" and a dmin time( s) of " | |
| 12963 | "RTN","PSG OEF",116,0 ) | |
| 12964 | . . . W $ S($P(X1,"^ ",4)=1:IOR VON,1:""), $P(X1,"^", 3),IORVOFF | |
| 12965 | "RTN","PSG OEF",117,0 ) | |
| 12966 | . . . W ! | |
| 12967 | "RTN","PSG OEF",118,0 ) | |
| 12968 | . . . W $ S($G(PSJOV R("CONJ",X ))="A":"AN D",$G(PSJO VR("CONJ", X))="T":"T HEN",1:"") ,! | |
| 12969 | "RTN","PSG OEF",119,0 ) | |
| 12970 | . . W !," Please ens ure the sc hedules an d administ ration tim es are app ropriate." ,! | |
| 12971 | "RTN","PSG OEF",120,0 ) | |
| 12972 | . . S DIR (0)="EA",D IR("A")="P ress Retur n to conti nue..." D ^DIR W ! | |
| 12973 | "RTN","PSG OEF",121,0 ) | |
| 12974 | K ^TMP("P SJATOVR",$ J) | |
| 12975 | "RTN","PSG OEF",122,0 ) | |
| 12976 | I $G(PSJP ROT)=3,'$D (PSJTUD),' $$ENIVUD^P SGOEF1(PSG ORD) Q | |
| 12977 | "RTN","PSG OEF",123,0 ) | |
| 12978 | I $G(PSGO SCH)]"" D S:$G(PSGS 0XT)'="" $ P(^PS(53.1 ,+PSGORD,2 ),"^",6)=P SGS0XT | |
| 12979 | "RTN","PSG OEF",124,0 ) | |
| 12980 | .N PSGOES ,PSGS0Y,PS GSCH S X=P SGOSCH K:$ G(PSJTUD) NSFF D ENO S^PSGS0 | |
| 12981 | "RTN","PSG OEF",125,0 ) | |
| 12982 | .I '($G(P SGORD)["P" &($P($G(^P S(53.1,+PS GORD,0))," ^",24)="R" )) I $G(X) ]""&$G(PSG S0Y) S:$G( PSGAT)="" PSGAT=PSGS 0Y | |
| 12983 | "RTN","PSG OEF",126,0 ) | |
| 12984 | .I $G(PSJ NSS) S PSG OSCH="" K PSJNSS | |
| 12985 | "RTN","PSG OEF",127,0 ) | |
| 12986 | .I $G(PSG ORD)["P",$ G(PSGAT),$ G(PSGS0Y), ($G(PSGOSC H)]"") I P SGAT'=PSGS 0Y D | |
| 12987 | "RTN","PSG OEF",128,0 ) | |
| 12988 | ..S PSGNS TAT=1 W $C (7),!!,"PL EASE NOTE: This ord er's admin times (", PSGAT,")" | |
| 12989 | "RTN","PSG OEF",129,0 ) | |
| 12990 | ..W !?13, " do not m atch the w ard times (",PSGS0Y, ")" | |
| 12991 | "RTN","PSG OEF",130,0 ) | |
| 12992 | ..W !?13, " for this administr ation sche dule (",PS GOSCH,")", ! | |
| 12993 | "RTN","PSG OEF",131,0 ) | |
| 12994 | ..S DIR(0 )="EA",DIR ("A")="Pre ss Return to continu e..." D ^D IR K DIR W ! | |
| 12995 | "RTN","PSG OEF",132,0 ) | |
| 12996 | I $G(PSGS 0XT)="" S $P(^PS(53. 1,+PSGORD, 2),"^",6)= $S($P($G(Z ZND),"^",3 )'="":$P(Z ZND,"^",3) ,1:"") | |
| 12997 | "RTN","PSG OEF",133,0 ) | |
| 12998 | S CHK=0 S :$P($G(^PS (53.1,+PSG ORD,0)),U, 24)'="R" P SGSI=$$ENP C^PSJUTL(" U",+PSJSYS P,180,PSGS I) | |
| 12999 | "RTN","PSG OEF",134,0 ) | |
| 13000 | I '$G(PSJ TUD),$G(PS JNSS),($G( PSGOSCH)]" ") D NSSCO NT^PSGS0(P SGOSCH,PSG S0XT) K PS JNSS S PSG OSCH="" | |
| 13001 | "RTN","PSG OEF",135,0 ) | |
| 13002 | S PSGOEFF =PSGOSCH=" "+('$O(^PS (53.45,PSJ SYSP,2,0)) *10) | |
| 13003 | "RTN","PSG OEF",136,0 ) | |
| 13004 | I PSGOEFF S X=$S(PS GOEFF#2:" a SCHEDULE ",1:"")_$S (PSGOEFF=1 1:" and",1 :"")_$S(PS GOEFF>9:" at least o ne DISPENS E DRUG",1: "") | |
| 13005 | "RTN","PSG OEF",137,0 ) | |
| 13006 | I 'PSGOEF F I (($G(P SGS0XT)="D ")&($G(PSG AT)="")) S X=" Admin Times",PS GOEFF=1,PS GOEF39=1 | |
| 13007 | "RTN","PSG OEF",138,0 ) | |
| 13008 | ; *315 DR P If remov al flag in 50.7 is a 2 or a 3 then order must be r eviewed an d removal times ente red if req uired. | |
| 13009 | "RTN","PSG OEF",139,0 ) | |
| 13010 | S PSGRF=$ $GET1^DIQ( 50.7,$G(PS GPDRG),12) | |
| 13011 | "RTN","PSG OEF",140,0 ) | |
| 13012 | ; Abort F inish proc ess if no Stop Date entered ($ G(PSJRMABT )) | |
| 13013 | "RTN","PSG OEF",141,0 ) | |
| 13014 | I $G(PSGR F),$G(PSGD UR)="",'$G (PSGRMV),$ $FIND1^DIC (51.1,""," X",$G(PSGS CH)) S PSJ RMABT=0 D I PSJRMAB T D ABORTA CC Q | |
| 13015 | "RTN","PSG OEF",142,0 ) | |
| 13016 | . N PSGTM PST S PSGT MPST=$S($G (PSGST)="R ":$$GET1^D IQ(51.1,$$ FIND1^DIC( 51.1,,"X", PSGSCH),5, "I"),1:$G( PSGST)) ;H andle "Fil l on Reque st" | |
| 13017 | "RTN","PSG OEF",143,0 ) | |
| 13018 | . I ($G(P SGTMPST)'= "O"),($G(P SGTMPST)'= "P"),($G(P SGTMPST)'= "OC"),+$G( PSGRF)>1 S X="",PSGO EFF=1,PSGO EF39=1 | |
| 13019 | "RTN","PSG OEF",144,0 ) | |
| 13020 | . I $G(PS GTMPST)="O " S (PSGFD N,PSGFD)=" " D | |
| 13021 | "RTN","PSG OEF",145,0 ) | |
| 13022 | .. S F1=5 3.1,MSG=0, Y=$T(35),@ ("PSGFN(35 )="_$P(Y," ;",7)),PSG OEEF(+$P(Y ,";",3))=1 ,(PSGOEE,P SGOEEF)=1 W ! D @$P( $T(35),";" ,3) S CHK= 0 I 'PSGOE E S PSJRMA BT=1 | |
| 13023 | "RTN","PSG OEF",146,0 ) | |
| 13024 | .. W:PSJR MABT $C(7) ,!!,"INVAL ID STOP DA TE" S DIR (0)="EA",D IR("A")="P ress Retur n to conti nue..." D ^DIR K DIR W ! | |
| 13025 | "RTN","PSG OEF",147,0 ) | |
| 13026 | ..Q | |
| 13027 | "RTN","PSG OEF",148,0 ) | |
| 13028 | .Q | |
| 13029 | "RTN","PSG OEF",149,0 ) | |
| 13030 | ; | |
| 13031 | "RTN","PSG OEF",150,0 ) | |
| 13032 | I PSGOEFF ,X]"" S X= X_" before it can be finished. " | |
| 13033 | "RTN","PSG OEF",151,0 ) | |
| 13034 | I PSGOEFF ,X]"" S CH K=1 W $C(7 ),!!,"PLEA SE NOTE: T his order must have" F Q=1:1:$ L(X," ") S Y=$P(X," ",Q) W:$L( Y)+$X>78 ! W Y," " | |
| 13035 | "RTN","PSG OEF",152,0 ) | |
| 13036 | I $G(PSGO EF39) S PS GOEE=0,PSG OEFF=0 D I 'PSGOEE D REFRESH^ VALM G DON E | |
| 13037 | "RTN","PSG OEF",153,0 ) | |
| 13038 | .S F1=53. 1,MSG=0,Y= $T(39),@(" PSGFN(39)= "_$P(Y,";" ,7)),PSGOE EF(+$P(Y," ;",3))=1,( PSGOEEF,PS GOEE)=1 W ! D @$P($T (39),";",3 ) S CHK=0 | |
| 13039 | "RTN","PSG OEF",154,0 ) | |
| 13040 | .I $G(PSG RMVT),'PSG OEE D INIT ^PSJLMUDE( $G(PSGP),$ G(PSGORD)) ;*315 IF REMOVE TIM E SET THEN REDISPLAY DETAIL | |
| 13041 | "RTN","PSG OEF",155,0 ) | |
| 13042 | .Q | |
| 13043 | "RTN","PSG OEF",156,0 ) | |
| 13044 | I PSGOEFF =1 S F1=53 .1,MSG=0,Y =$T(38),@( "PSGFN(38) ="_$P(Y,"; ",7)),PSGO EEF(+$P(Y, ";",3))=1, (PSGOEE,PS GOEEF)=1 W ! D @$P($ T(38),";", 3) S CHK=0 G:'PSGOEE DONE | |
| 13045 | "RTN","PSG OEF",157,0 ) | |
| 13046 | I PSGOEFF =11 S F1=5 3.1,MSG=0, Y=$T(32),@ ("PSGFN(32 )="_$P(Y," ;",7)),PSG OEEF(+$P(Y ,";",3))=1 ,(PSGOEE,P SGOEEF)=1 W ! D @$P( $T(32),";" ,3) D G:' PSGOEE DON E | |
| 13047 | "RTN","PSG OEF",158,0 ) | |
| 13048 | .S F1=53. 1,MSG=0,Y= $T(38),@(" PSGFN(38)= "_$P(Y,";" ,7)),PSGOE EF(+$P(Y," ;",3))=1,( PSGOEE,PSG OEEF)=1 W ! D @$P($T (38),";",3 ) S CHK=0 | |
| 13049 | "RTN","PSG OEF",159,0 ) | |
| 13050 | I PSGOEFF >9 S CHK=7 D ENDRG^P SGOEF1(+PS GPD,0) I C HK D ABORT ACC Q | |
| 13051 | "RTN","PSG OEF",160,0 ) | |
| 13052 | I 'PSGOEF F D OC531^ PSGOESF ; check ever y dispense drug from CPRS | |
| 13053 | "RTN","PSG OEF",161,0 ) | |
| 13054 | S VALMBG= 1 | |
| 13055 | "RTN","PSG OEF",162,0 ) | |
| 13056 | I 'PSGOEF F&($D(PSGO RQF)) D RE ^VALM4 Q | |
| 13057 | "RTN","PSG OEF",163,0 ) | |
| 13058 | I $G(MSG) K DIR S D IR(0)="E" W !! D ^DI R | |
| 13059 | "RTN","PSG OEF",164,0 ) | |
| 13060 | I PSGOEFF D:PSGST=" " GTST^PSG OE6(+PSGOR D) | |
| 13061 | "RTN","PSG OEF",165,0 ) | |
| 13062 | S PSJLMFI N=1 | |
| 13063 | "RTN","PSG OEF",166,0 ) | |
| 13064 | K PSJACEP T I $O(^PS (53.1,+PSG ORD,12,0)) S PSJLMP2 =1 | |
| 13065 | "RTN","PSG OEF",167,0 ) | |
| 13066 | S PSGOEEN O=0,PSGSTA T=$S($P(PS JSYSP0,U,9 ):"ACTIVE" ,1:"NON-VE RIFIED") | |
| 13067 | "RTN","PSG OEF",168,0 ) | |
| 13068 | NEW PSJDO SE,PSJDOX, PSJDSFLG | |
| 13069 | "RTN","PSG OEF",169,0 ) | |
| 13070 | D DOSECHK ^PSJDOSE | |
| 13071 | "RTN","PSG OEF",170,0 ) | |
| 13072 | S:+$G(PSJ DSFLG) VAL MSG="Dosag e Ordered & Dispense Drug are not compat ible" | |
| 13073 | "RTN","PSG OEF",171,0 ) | |
| 13074 | I PSGODO= PSGDO S PS GOEEF(109) ="" | |
| 13075 | "RTN","PSG OEF",172,0 ) | |
| 13076 | I PSGODO' =PSGDO S P SGOEENO=1, VALMSG="Th is change will cause a new ord er to be c reated " | |
| 13077 | "RTN","PSG OEF",173,0 ) | |
| 13078 | ;I $G(PSG PDN)["CLOZ ",+$G(PSGC OMP) D COM PLEX^PSJCL OZ ;; RJS *327 | |
| 13079 | "RTN","PSG OEF",174,0 ) | |
| 13080 | D EN^VALM ("PSJU LM ACCEPT") | |
| 13081 | "RTN","PSG OEF",175,0 ) | |
| 13082 | I $G(PSJN SS) D S P SGOEEF(26) ="" K PSJA CEPT,PSJNS S | |
| 13083 | "RTN","PSG OEF",176,0 ) | |
| 13084 | .K DIR S DIR(0)="FO A",DIR("A" )="Invalid Schedule" D ^DIR K DIR | |
| 13085 | "RTN","PSG OEF",177,0 ) | |
| 13086 | I $G(PSGS 0XT)="D",' $G(PSGS0Y) ,'$G(PSGAT ),((",P,R, ")'[(","_$ G(PSGST)_" ,")) D S PSGOEEF(39 )="" K PSJ ACEPT | |
| 13087 | "RTN","PSG OEF",178,0 ) | |
| 13088 | .K DIR S DIR(0)="FO A",DIR("A" )=" WARN ING - Admi n times ar e required for DAY O F WEEK sch edules " D ^DIR K D IR | |
| 13089 | "RTN","PSG OEF",179,0 ) | |
| 13090 | ;***PSJ*5 *113 | |
| 13091 | "RTN","PSG OEF",180,0 ) | |
| 13092 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 13093 | "RTN","PSG OEF",181,0 ) | |
| 13094 | I $G(PSJA CEPT) D I $G(PSGORQ F) D ABORT ACC Q | |
| 13095 | "RTN","PSG OEF",182,0 ) | |
| 13096 | .I $G(PSG CLZ)!(+$G( PSGRDTX)) D | |
| 13097 | "RTN","PSG OEF",183,0 ) | |
| 13098 | ..I '$D(C LOZFLG),$G (PSGDRG),$ $GET1^DIQ( 50,PSGDRG, 17.5)="PSO CLO1" S CL OZFLG=1 | |
| 13099 | "RTN","PSG OEF",184,0 ) | |
| 13100 | ..I $G(CL OZFLG) D | |
| 13101 | "RTN","PSG OEF",185,0 ) | |
| 13102 | ...S DIR( 0)="N^12.5 :3000:1",D IR("A")="C LOZAPINE d osage (mg/ day) ? " D ^DIR K DI R I $D(DIR UT) S (CHK ,PSGORQF)= 1 Q ;G DO NE:$G(CHK) | |
| 13103 | "RTN","PSG OEF",186,0 ) | |
| 13104 | ...S (^TM P("PSJCOM" ,$J,+PSGOR D,"SAND"), PSOSAND)=X | |
| 13105 | "RTN","PSG OEF",187,0 ) | |
| 13106 | ...Q:$G(P SGFD) ; added by MZR to not overri de an exis ting Stop Date/Time | |
| 13107 | "RTN","PSG OEF",188,0 ) | |
| 13108 | ...D CLOZ PAT^PSJCLO Z | |
| 13109 | "RTN","PSG OEF",189,0 ) | |
| 13110 | ...S X1=P SGSD,X2=$S ($G(CLOZPA T)=2:28,$G (CLOZPAT)= 1:14,$G(CL OZPAT)=0:7 ,$G(CLOZPA T)=3:4,1:9 0) D C^%DT C | |
| 13111 | "RTN","PSG OEF",190,0 ) | |
| 13112 | ...S PSGF D=X,PSGFDN =$$ENDD^PS GMI(PSGFD) _"^"_$$END TC^PSGMI(P SGFD) | |
| 13113 | "RTN","PSG OEF",191,0 ) | |
| 13114 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 13115 | "RTN","PSG OEF",192,0 ) | |
| 13116 | I $G(PSGA T)="",(PSG ST="C"!(PS GST="R")) D | |
| 13117 | "RTN","PSG OEF",193,0 ) | |
| 13118 | .I $G(PSG S0XT) Q:$$ ODD^PSGS0( PSGS0XT) | |
| 13119 | "RTN","PSG OEF",194,0 ) | |
| 13120 | .Q:$$PRNO K^PSGS0($G (PSGSCH)) | |
| 13121 | "RTN","PSG OEF",195,0 ) | |
| 13122 | .Q:($P($G (ZZND),"^" ,5)'="C") | |
| 13123 | "RTN","PSG OEF",196,0 ) | |
| 13124 | .K PSJACE PT | |
| 13125 | "RTN","PSG OEF",197,0 ) | |
| 13126 | .K DIR S DIR(0)="FO A",DIR("A" )=" WARNI NG - Admin times are required for CONTIN UOUS order s " D ^DIR K DIR | |
| 13127 | "RTN","PSG OEF",198,0 ) | |
| 13128 | ;*** | |
| 13129 | "RTN","PSG OEF",199,0 ) | |
| 13130 | I '$G(PSJ ACEPT) D A BORTACC Q | |
| 13131 | "RTN","PSG OEF",200,0 ) | |
| 13132 | I $G(PSJR NF),$G(^PS (53.1,+PSG ORD,4)) D | |
| 13133 | "RTN","PSG OEF",201,0 ) | |
| 13134 | . W $C(7) ,!!,"ACCEP TING THIS ORDER WILL CHANGE TH E STATUS T O ACTIVE." | |
| 13135 | "RTN","PSG OEF",202,0 ) | |
| 13136 | . S DIR(0 )="Y",DIR( "A")="Do y ou wish to make this order Act ive",DIR(" ?",1)="Ent er ""N"" i f you wish to exit w ithout Act ivating th is order," | |
| 13137 | "RTN","PSG OEF",203,0 ) | |
| 13138 | . S DIR(" ?")="or "" Y"" to con tinue with the Activ ation proc ess." D ^D IR S:'Y Y= -1 K DIR | |
| 13139 | "RTN","PSG OEF",204,0 ) | |
| 13140 | I $G(PSJR NF),$G(Y)= -1 S PSJAC EPT=0 D AB ORTACC Q | |
| 13141 | "RTN","PSG OEF",205,0 ) | |
| 13142 | I $G(PSJR NF),$G(Y)= 1 S PSGOEA V=1 | |
| 13143 | "RTN","PSG OEF",206,0 ) | |
| 13144 | I $G(PSGE DTOI) D OC ^PSJOE1 | |
| 13145 | "RTN","PSG OEF",207,0 ) | |
| 13146 | I $S($G(P SGORQF):0, $G(PSGEDTO I):0,$G(PS GOEER)["10 9^PSGOE8": 1,$G(PSGOE ER)["3^PSG OE8":1,$G( PSGOEER)[" 26^PSGOE8" :1,$G(PSGO EER)["10^P SGOE81":1, $G(PSGOEER )["25^PSGO E81":1,1:0 ) D | |
| 13147 | "RTN","PSG OEF",208,0 ) | |
| 13148 | . NEW PSJ DD S PSJDD =+$$DD53P4 5^PSJMISC( ) | |
| 13149 | "RTN","PSG OEF",209,0 ) | |
| 13150 | . D:$G(PS JDD) IN^PS JOCDS($G(P SGORD),"UD ",PSJDD) | |
| 13151 | "RTN","PSG OEF",210,0 ) | |
| 13152 | I $G(PSGO RQF) S PSG OEENO=0,PS JACEPT=0 | |
| 13153 | "RTN","PSG OEF",211,0 ) | |
| 13154 | I PSGOEEN O S PSJNOO =$$ENNOO^P SJUTL5("E" ),PSJACEPT =$S(PSJNOO <0:0,1:1) | |
| 13155 | "RTN","PSG OEF",212,0 ) | |
| 13156 | ACCEPT ; | |
| 13157 | "RTN","PSG OEF",213,0 ) | |
| 13158 | N PSGUDFI N S PSGUDF IN=1 | |
| 13159 | "RTN","PSG OEF",214,0 ) | |
| 13160 | S VALMBCK =$S($G(PSJ ACEPT):"Q" ,1:"R") | |
| 13161 | "RTN","PSG OEF",215,0 ) | |
| 13162 | I '$G(PSJ ACEPT) D A BORTACC Q | |
| 13163 | "RTN","PSG OEF",216,0 ) | |
| 13164 | K PSGOES, PSGRSD,PSG RSDN D:PSG OEENO NEW3 ^PSGOEE D: 'PSGOEENO UPD^PSGOEF 1 I $D(PSG OEF)!PSGOE ENO S PSGC ANFL=-1 | |
| 13165 | "RTN","PSG OEF",217,0 ) | |
| 13166 | ;saves dr ug allergy signs/sym ptoms PSJ* 5*260 | |
| 13167 | "RTN","PSG OEF",218,0 ) | |
| 13168 | I $D(^TMP ("PSODAOC" ,$J,"ALLER GY")) D | |
| 13169 | "RTN","PSG OEF",219,0 ) | |
| 13170 | .N DA,OCC DT,ORN,ORL ,Z,RET,PSJ DAOC | |
| 13171 | "RTN","PSG OEF",220,0 ) | |
| 13172 | .S PSJDAO C="IP "_$S ($G(PSGORD )["P":"Pen ding/Non-V erified",$ G(PSGORD)[ "U":"Unit Dose",$G(P SGORD)["V" :"IV",1:"" )_" Allerg y",OCCDT=$ $NOW^XLFDT | |
| 13173 | "RTN","PSG OEF",221,0 ) | |
| 13174 | .I PSGORD ["P" S ORN =$P(^PS(53 .1,+PSGORD ,0),U,21) | |
| 13175 | "RTN","PSG OEF",222,0 ) | |
| 13176 | .I PSGORD ["U" S ORN =$P(^PS(55 ,DFN,5,+PS GORD,0),U, 21) | |
| 13177 | "RTN","PSG OEF",223,0 ) | |
| 13178 | .I PSGORD ["V" S ORN =$P(^PS(55 ,DFN,"IV", +PSGORD,0) ,U,21) | |
| 13179 | "RTN","PSG OEF",224,0 ) | |
| 13180 | .Q:'$G(OR N) | |
| 13181 | "RTN","PSG OEF",225,0 ) | |
| 13182 | . S PSJAG YSV=1 ;use in ^PSJOE to store allergy (a lso clean up this va r) | |
| 13183 | "RTN","PSG OEF",226,0 ) | |
| 13184 | D DONE1^P SGOEE | |
| 13185 | "RTN","PSG OEF",227,0 ) | |
| 13186 | D DONE | |
| 13187 | "RTN","PSG OEF",228,0 ) | |
| 13188 | Q | |
| 13189 | "RTN","PSG OEF",229,0 ) | |
| 13190 | BYPASS ; | |
| 13191 | "RTN","PSG OEF",230,0 ) | |
| 13192 | S PSGCANF L=1 | |
| 13193 | "RTN","PSG OEF",231,0 ) | |
| 13194 | ; | |
| 13195 | "RTN","PSG OEF",232,0 ) | |
| 13196 | DONE ; | |
| 13197 | "RTN","PSG OEF",233,0 ) | |
| 13198 | K CHK,DA, DIE,DR,DRG ,MSG,Q1,Q2 ,PSGNSTAT, PSGEDTOI,P SGOEER,ZZN D | |
| 13199 | "RTN","PSG OEF",234,0 ) | |
| 13200 | K PSJOVR | |
| 13201 | "RTN","PSG OEF",235,0 ) | |
| 13202 | Q | |
| 13203 | "RTN","PSG OEF",236,0 ) | |
| 13204 | ABORTACC ; Abort Acc ept proces s. | |
| 13205 | "RTN","PSG OEF",237,0 ) | |
| 13206 | ;*315 | |
| 13207 | "RTN","PSG OEF",238,0 ) | |
| 13208 | K PSGDUR, PSGRMVT,PS GRMV,PSGRF | |
| 13209 | "RTN","PSG OEF",239,0 ) | |
| 13210 | K PSJCT1, PSJOVR,PSJ OVRLP,PSJC T1A K ^TMP ("PSODAOC" ,$J) ;,^T MP("PSGCPL X",$J,$G(D FN)) | |
| 13211 | "RTN","PSG OEF",240,0 ) | |
| 13212 | D ABORT^P SGOEE K PS GOEEF D GE TUD^PSJLMG UD(PSGP,PS GORD),^PSG OEF,ENSFE^ PSGOEE0(PS GP,PSGORD) ,INIT^PSJL MUDE(PSGP, PSGORD) S VALMBCK="R ",PSGSD=PS GNESD,PSGF D=PSGNEFD Q | |
| 13213 | "RTN","PSG OEF",241,0 ) | |
| 13214 | ; | |
| 13215 | "RTN","PSG OEF",242,0 ) | |
| 13216 | ; | |
| 13217 | "RTN","PSG OEF",243,0 ) | |
| 13218 | 31 ;;101^P SGOE8;PSGO PD;PSGPD;1 01;1 | |
| 13219 | "RTN","PSG OEF",244,0 ) | |
| 13220 | 32 ;;109^P SGOE8;PSGO DO;PSGDO;1 09;PSGODO] "" | |
| 13221 | "RTN","PSG OEF",245,0 ) | |
| 13222 | 33 ;;10^PS GOE81;PSGO SD;PSGSD;1 0;0 | |
| 13223 | "RTN","PSG OEF",246,0 ) | |
| 13224 | 34 ;;3^PSG OE8;PSGOMR ;PSGMR;3;1 | |
| 13225 | "RTN","PSG OEF",247,0 ) | |
| 13226 | 35 ;;25^PS GOE81;PSGO FD;PSGFD;2 5;0 | |
| 13227 | "RTN","PSG OEF",248,0 ) | |
| 13228 | 36 ;;7^PSG OE8;PSGOST ;PSGST;7;0 | |
| 13229 | "RTN","PSG OEF",249,0 ) | |
| 13230 | 37 ;;5^PSG OE82;PSGOS M;PSGSM;5; 0 | |
| 13231 | "RTN","PSG OEF",250,0 ) | |
| 13232 | 38 ;;26^PS GOE8;PSGOS CH;PSGSCH; 26;1 | |
| 13233 | "RTN","PSG OEF",251,0 ) | |
| 13234 | 39 ;;39^PS GOE81;PSGO AT;PSGAT;3 9;0 | |
| 13235 | "RTN","PSG OEF",252,0 ) | |
| 13236 | 310 ;;1^PS GOE82;PSGO PR;PSGPR;1 ;1 | |
| 13237 | "RTN","PSG OEF",253,0 ) | |
| 13238 | 311 ;;8^PS GOE81;PSGO SI;PSGSI;8 ;0 | |
| 13239 | "RTN","PSG OEF",254,0 ) | |
| 13240 | 312 ;;2^PS GOE82;;;2; 0 | |
| 13241 | "RTN","PSG OEF",255,0 ) | |
| 13242 | 313 ;;40^P SGOE82;;;4 0;0 | |
| 13243 | "RTN","PSG OEF",256,0 ) | |
| 13244 | ; | |
| 13245 | "RTN","PSG OEF",257,0 ) | |
| 13246 | AH ; | |
| 13247 | "RTN","PSG OEF",258,0 ) | |
| 13248 | W !!?2,"A nswer 'YES ' to accep t this ord er as a NO N-VERIFIED UNIT DOSE order. A nswer",!," 'NO' to ed it this or der now. Enter '^' to BYPASS this order , leaving it as",!," a PENDING INPATIENT order." | |
| 13249 | "RTN","PSG OEF",259,0 ) | |
| 13250 | Q | |
| 13251 | "RTN","PSG OEF",260,0 ) | |
| 13252 | ; | |
| 13253 | "RTN","PSG OEF",261,0 ) | |
| 13254 | CLOZDRG() ;Callable to determi ne if PSGD RG is cloz apine, cop ied from o ther locat ions | |
| 13255 | "RTN","PSG OEF",262,0 ) | |
| 13256 | N PSGDRG | |
| 13257 | "RTN","PSG OEF",263,0 ) | |
| 13258 | ;I $D(PSJ XDOX("DD") ) S PSGDRG =$O(PSJXDO X("DD","") ) | |
| 13259 | "RTN","PSG OEF",264,0 ) | |
| 13260 | ;E N ORI FN S ORIFN =+$P($G(PS JXX1),U,21 ) I ORIFN D | |
| 13261 | "RTN","PSG OEF",265,0 ) | |
| 13262 | N ORIFN S ORIFN=+$P ($G(PSJXX1 ),U,21) I ORIFN D | |
| 13263 | "RTN","PSG OEF",266,0 ) | |
| 13264 | .N PSGPTR S PSGPTR= $$FIND1^DI C(100.045, ","_ORIFN_ ",","X","D RUG","ID") I PSGPTR D | |
| 13265 | "RTN","PSG OEF",267,0 ) | |
| 13266 | ..S PSGDR G=$$GET1^D IQ(100.045 ,PSGPTR_", "_ORIFN,1, "I") | |
| 13267 | "RTN","PSG OEF",268,0 ) | |
| 13268 | Q:$G(PSGD RG)="" 0 | |
| 13269 | "RTN","PSG OEF",269,0 ) | |
| 13270 | Q $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" | |
| 13271 | "RTN","PSG OER") | |
| 13272 | 0^13^B9041 8784 | |
| 13273 | "RTN","PSG OER",1,0) | |
| 13274 | PSGOER ;BI R/CML3 - R ENEW A SIN GLE ORDER ;Jul 26, 2 017@18:04: 02 | |
| 13275 | "RTN","PSG OER",2,0) | |
| 13276 | ;;5.0;INP ATIENT MED ICATIONS ; **11,30,29 ,35,70,58, 95,110,111 ,133,141,1 98,181,246 ,278,281,3 15,327**;1 6 DEC 97;B uild 64 | |
| 13277 | "RTN","PSG OER",3,0) | |
| 13278 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 13279 | "RTN","PSG OER",4,0) | |
| 13280 | ; | |
| 13281 | "RTN","PSG OER",5,0) | |
| 13282 | ; Referen ce to ^PS( 51.1 suppo rted by DB IA 2177. | |
| 13283 | "RTN","PSG OER",6,0) | |
| 13284 | ; Referen ce to ^PS( 55 support ed by DBIA 2191. | |
| 13285 | "RTN","PSG OER",7,0) | |
| 13286 | ; Referen ce to ^PSS LOCK is su pported by DBIA 2789 . | |
| 13287 | "RTN","PSG OER",8,0) | |
| 13288 | ; Referen ce to ^PSB APIPM is s upported b y DBIA 356 4. | |
| 13289 | "RTN","PSG OER",9,0) | |
| 13290 | ; Referen ce to ^PS( 59.7 is su pported by DBIA 2181 . | |
| 13291 | "RTN","PSG OER",10,0) | |
| 13292 | ; Referen ce to ^PSD RUG( is su pported by DBIA 2192 . | |
| 13293 | "RTN","PSG OER",11,0) | |
| 13294 | ; Referen ce to ^TMP ("PSODAOC" ,$J is sup ported by DBIA 6071. | |
| 13295 | "RTN","PSG OER",12,0) | |
| 13296 | ; | |
| 13297 | "RTN","PSG OER",13,0) | |
| 13298 | ; renew a single or der | |
| 13299 | "RTN","PSG OER",14,0) | |
| 13300 | I $G(PSJC OM) D ^PSJ COMR Q | |
| 13301 | "RTN","PSG OER",15,0) | |
| 13302 | N PSJEXPI R S PSJEXP IR=$$EXPIR ED(PSGP,PS GORD) I PS JEXPIR D Q | |
| 13303 | "RTN","PSG OER",16,0) | |
| 13304 | .W !!?3," THIS ORD ER" W:PSJE XPIR'=2 " HAS BEEN I NACTIVE FO R ONE OR M ORE SCHEDU LED",!?8," ADMINISTR ATIONS AND " | |
| 13305 | "RTN","PSG OER",17,0) | |
| 13306 | .W " CANN OT BE RENE WED!" D PA USE^VALM1 | |
| 13307 | "RTN","PSG OER",18,0) | |
| 13308 | I $G(PSGS CH)]"",($G (PSGS0XT)= "D"),($G(P SGAT)="") D Q | |
| 13309 | "RTN","PSG OER",19,0) | |
| 13310 | .N SWD,SD W,XABB,X,Q X S X=$G(P SGSCH) D D W^PSGS0 Q: ($G(X)="") I $G(PSG S0XT)="" S PSGS0XT=" D" | |
| 13311 | "RTN","PSG OER",20,0) | |
| 13312 | .Q:((",P, R,")[(","_ $G(PSGST)_ ",")) | |
| 13313 | "RTN","PSG OER",21,0) | |
| 13314 | .I $G(PSG S0XT)="D", $G(PSGAT)= "" S CHK=1 W !!?3,"T his order contains a 'DAY OF T HE WEEK' s chedule wi thout admi n times" | |
| 13315 | "RTN","PSG OER",22,0) | |
| 13316 | .W !?11," and CANNO T be renew ed!" D PAU SE^VALM1 | |
| 13317 | "RTN","PSG OER",23,0) | |
| 13318 | I $G(PSGS CH)]"",'$$ DOW^PSIVUT L(PSGSCH), '$$PRNOK^P SGS0(PSGSC H) I '$D(^ PS(51.1,"A C","PSJ",P SGSCH)) D Q | |
| 13319 | "RTN","PSG OER",24,0) | |
| 13320 | .W !!?3," This order contains an invalid schedule and CANNOT be renewe d!" D PAUS E^VALM1 | |
| 13321 | "RTN","PSG OER",25,0) | |
| 13322 | W !! K DI R S DIR(0) ="Y",DIR(" A")=$S($P( PSJSYSP0," ^",3):"REN EW THIS OR DER",1:"MA RK THIS OR DER FOR RE NEWAL"),DI R("B")="YE S" | |
| 13323 | "RTN","PSG OER",26,0) | |
| 13324 | S DIR("?" )="Answer 'YES' to " _$S($P(PSJ SYSP0,"^", 3):"renew this order ",1:"mark this order for renew al")_". A nswer 'NO' (or '^') to stop no w." D ^DIR | |
| 13325 | "RTN","PSG OER",27,0) | |
| 13326 | I '$D(DIR UT),Y D NE W S PSGCAN FL=1 D DON E Q | |
| 13327 | "RTN","PSG OER",28,0) | |
| 13328 | I '$D(DIR UT),PSJSYS U S PSGND4 =$G(^PS(55 ,PSGP,5,+P SGORD,4)) I $P(PSGND 4,"^",15), $P(PSGND4, "^",16) D UNMARK,DON E Q | |
| 13329 | "RTN","PSG OER",29,0) | |
| 13330 | D DONE,AB ORT^PSGOEE | |
| 13331 | "RTN","PSG OER",30,0) | |
| 13332 | Q | |
| 13333 | "RTN","PSG OER",31,0) | |
| 13334 | ; | |
| 13335 | "RTN","PSG OER",32,0) | |
| 13336 | UNMARK ; | |
| 13337 | "RTN","PSG OER",33,0) | |
| 13338 | W !!,"THI S ORDER HA S BEEN 'MA RKED FOR R ENEWAL'.", ! K DIR S DIR(0)="Y" ,DIR("A")= "DO YOU WA NT TO 'UNM ARK IT'",D IR("B")="N O" | |
| 13339 | "RTN","PSG OER",34,0) | |
| 13340 | S DIR("?" ,1)=" Ans wer 'YES' to unmark this order . Answer 'NO' (or ' ^') to lea ve the ord er",DIR("? ")="marked . (An ans wer is req uired.)" D ^DIR | |
| 13341 | "RTN","PSG OER",35,0) | |
| 13342 | I 'Y D AB ORT^PSGOEE G DONE | |
| 13343 | "RTN","PSG OER",36,0) | |
| 13344 | S DA(1)=P SGP,DA=+PS GORD,PSGAL ("C")=2118 0+PSJSYSU D ^PSGAL5 S $P(PSGND 4,"^",15,1 7)="^^",^P S(55,PSGP, 5,DA,4)=PS GND4 W ".. .DONE!" | |
| 13345 | "RTN","PSG OER",37,0) | |
| 13346 | ; | |
| 13347 | "RTN","PSG OER",38,0) | |
| 13348 | DONE ; | |
| 13349 | "RTN","PSG OER",39,0) | |
| 13350 | K %DT,DA, DIE,DIR,DR ,FDSD,PSGA L,PSGALR,P SGDL,PSGDL S,PSGFD,PS GFOK,PSGND 4,PSGOEE,P SGOER0,PSG OER1,PSGOE R2,PSGOERD P,PSGPOSA, PSGPOSD,PS GPR,PSGPX, PSGRD,PSGS D,PSGTOL,P SGTOO,PSGU OW,PSGWLL, RF Q | |
| 13351 | "RTN","PSG OER",40,0) | |
| 13352 | ; | |
| 13353 | "RTN","PSG OER",41,0) | |
| 13354 | NEW ; get info, writ e record | |
| 13355 | "RTN","PSG OER",42,0) | |
| 13356 | EXTEND ; e xtend stop date on r enewal ord er | |
| 13357 | "RTN","PSG OER",43,0) | |
| 13358 | N DUOUT,P SJABT,PSGD RG,PSJREN, PSGOREAS S PSGDRG=$P ($G(^PS(55 ,PSGP,5,+P SGORD,1,1, 0)),"^"),P SJREN=1 | |
| 13359 | "RTN","PSG OER",44,0) | |
| 13360 | I $G(PSGS T)="O" N A CT S ACT=$ $EN^PSBAPI PM(PSGP,PS GORD) I $P (ACT,"^",2 ),($P(ACT, "^",3)="G" ) I $P(ACT ,"^",2)>$P ($G(^PS(55 ,PSGP,5,+P SGORD,2)), "^",2) D Q | |
| 13361 | "RTN","PSG OER",45,0) | |
| 13362 | . W !!?5, "THIS ONE- TIME ORDER HAS ALREA DY BEEN GI VEN AND CA NNOT BE RE NEWED",! S (DIRUT,PS GORQF)=1 D READ | |
| 13363 | "RTN","PSG OER",46,0) | |
| 13364 | ;D OC55 | |
| 13365 | "RTN","PSG OER",47,0) | |
| 13366 | ;Q:$D(PSG ORQF) ; q uit if not to contin ue | |
| 13367 | "RTN","PSG OER",48,0) | |
| 13368 | ;; START NCC T4 MOD S >> 327*R JS | |
| 13369 | "RTN","PSG OER",49,0) | |
| 13370 | I '$G(PSG DRG) N PSG DRG S PSGD RG=$O(PSJX DOX("DD",0 )) | |
| 13371 | "RTN","PSG OER",50,0) | |
| 13372 | I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" N PSG PR S PSGPR =PSGOPR D CLOZ^PSJCL OZ(DFN,PSG DRG) S:$G( ANQX) PSGC ANFL=1 | |
| 13373 | "RTN","PSG OER",51,0) | |
| 13374 | ;; START NCC T4 MOD S >> 327*R JS | |
| 13375 | "RTN","PSG OER",52,0) | |
| 13376 | D NOW^%DT C S PSGDT= %,PSGND4=$ G(^PS(55,P SGP,5,+PSG ORD,4)) I '$P(PSJSYS P0,"^",3) D MARK Q | |
| 13377 | "RTN","PSG OER",53,0) | |
| 13378 | S PSGWLL= $S('$P(PSJ SYSW0,"^", 4):0,1:+$G (^PS(55,PS GP,5.1))), PSGOEE="R" K PSGOEOS | |
| 13379 | "RTN","PSG OER",54,0) | |
| 13380 | K ^PS(53. 45,PSJSYSP ,1),^(2) D MOVE(3,1) ,MOVE(1,2) | |
| 13381 | "RTN","PSG OER",55,0) | |
| 13382 | D DATE^PS GOER0(PSGP ,PSGORD,PS GDT) I ($G (X)="^")!' $D(PSGFOK( 106))!$G(D UOUT) D DO NE,ABORT^P SGOEE S VA LMBCK="R", COMQUIT=1 Q | |
| 13383 | "RTN","PSG OER",56,0) | |
| 13384 | ;D OC55 | |
| 13385 | "RTN","PSG OER",57,0) | |
| 13386 | ;I $G(PSG ORQF) D DO NE,ABORT^P SGOEE S VA LMBCK="R", COMQUIT=1 Q | |
| 13387 | "RTN","PSG OER",58,0) | |
| 13388 | SPEED ; | |
| 13389 | "RTN","PSG OER",59,0) | |
| 13390 | I +$G(PSJ SYSU)=3 D EN^PSGPEN( PSGORD) | |
| 13391 | "RTN","PSG OER",60,0) | |
| 13392 | Q:$G(DUOU T) | |
| 13393 | "RTN","PSG OER",61,0) | |
| 13394 | N PSGOEAV S PSGOEAV =+PSJSYSU | |
| 13395 | "RTN","PSG OER",62,0) | |
| 13396 | W !!,"... updating o rder..." K DA S DA(1 )=PSGP,DA= +PSGORD,PS GAL("C")=P SJSYSU*10+ 18000 D ^P SGAL5 W ". " | |
| 13397 | "RTN","PSG OER",63,0) | |
| 13398 | I $$LS^PS SLOCK(PSGP ,PSGORD) D UPDREN(PS GORD,PSGDT ,PSGOEPR,P SGOFD,PSJN OO),UPDREN OE(PSGP,PS GORD,PSGDT ) D UNL^PS SLOCK(PSGP ,PSGORD) | |
| 13399 | "RTN","PSG OER",64,0) | |
| 13400 | S ^TMP("P SODAOC",$J ,"IP IEN") =PSGORD ;set up wh ich IEN wi ll be used to store order chec ks | |
| 13401 | "RTN","PSG OER",65,0) | |
| 13402 | D SETOC^P SJNEWOC(PS GORD) ;PSJ *5*281 sto res order checks | |
| 13403 | "RTN","PSG OER",66,0) | |
| 13404 | K ^TMP("P SODAOC",$J ),^TMP("PS JDAOC",$J) | |
| 13405 | "RTN","PSG OER",67,0) | |
| 13406 | ; | |
| 13407 | "RTN","PSG OER",68,0) | |
| 13408 | I 'PSGOER DP,$P(PSJS YSW0,"^",4 ),PSGFD'<P SGWLL S $P (^PS(55,PS GP,5.1),"^ ")=+PSGFD | |
| 13409 | "RTN","PSG OER",69,0) | |
| 13410 | W ".DONE! " S VALMBC K="Q" Q | |
| 13411 | "RTN","PSG OER",70,0) | |
| 13412 | ; | |
| 13413 | "RTN","PSG OER",71,0) | |
| 13414 | MARK ; | |
| 13415 | "RTN","PSG OER",72,0) | |
| 13416 | I $P(PSGN D4,"^",15) ,$P(PSGND4 ,"^",16) W $C(7),!!? 3,"...THIS ORDER IS ALREADY MA RKED FOR R ENEWAL!... " Q | |
| 13417 | "RTN","PSG OER",73,0) | |
| 13418 | K DA S $P (PSGND4,"^ ",15,17)=" 1^"_DUZ_"^ "_PSGDT,^P S(55,PSGP, 5,+PSGORD, 4)=PSGND4, PSGAL("C") =13180,DA( 1)=PSGP,DA =+PSGORD W "." D ^PS GAL5 | |
| 13419 | "RTN","PSG OER",74,0) | |
| 13420 | I $D(PSJS YSO) S PSG ORD=+PSGOR D_"A",PSGP OSA="R",PS GPOSD=PSGD T D ENPOS^ PSGVDS | |
| 13421 | "RTN","PSG OER",75,0) | |
| 13422 | Q | |
| 13423 | "RTN","PSG OER",76,0) | |
| 13424 | MOVE(X,Y) ; Move com ments/disp ense drugs from 55 t o 53.45. | |
| 13425 | "RTN","PSG OER",77,0) | |
| 13426 | S Q=0 F S Q=$O(^PS (55,PSGP,5 ,+PSGORD,X ,Q)) Q:'Q S ^PS(53. 45,PSJSYSP ,Y,Q,0)=$G (^(Q,0)) | |
| 13427 | "RTN","PSG OER",78,0) | |
| 13428 | S:Q ^PS(5 3.45,Y,0)= "^53.450"_ Y_"P^"_Q_U _Q | |
| 13429 | "RTN","PSG OER",79,0) | |
| 13430 | Q | |
| 13431 | "RTN","PSG OER",80,0) | |
| 13432 | OC55 ;* Or der checks for Speed finish an d regular finish | |
| 13433 | "RTN","PSG OER",81,0) | |
| 13434 | ;PSJ*5*18 1 - no lon ger use (O C will be triggered from OC^PS GOER0) | |
| 13435 | "RTN","PSG OER",82,0) | |
| 13436 | Q | |
| 13437 | "RTN","PSG OER",83,0) | |
| 13438 | NEWOC55 ; | |
| 13439 | "RTN","PSG OER",84,0) | |
| 13440 | N INTERVE N,PSJDDI,P SJIREQ,PSJ RXREQ,PSJP DRG,PSJDD, PSJDD0,PSJ ALLGY | |
| 13441 | "RTN","PSG OER",85,0) | |
| 13442 | S Y=1,(PS JIREQ,PSJR XREQ,INTER VEN,X)="" | |
| 13443 | "RTN","PSG OER",86,0) | |
| 13444 | F PSGDDI= 0:0 S PSGD DI=$O(^PS( 55,PSGP,5, +PSGORD,1, PSGDDI)) Q :'+PSGDDI D | |
| 13445 | "RTN","PSG OER",87,0) | |
| 13446 | . S PSJDD 0=$G(^PS(5 5,PSGP,5,+ PSGORD,1,P SGDDI,0)) | |
| 13447 | "RTN","PSG OER",88,0) | |
| 13448 | . S PSJX= $P(PSJDD0, U,3) I PSJ X]"",(PSJX '>$G(PSGDT )) Q | |
| 13449 | "RTN","PSG OER",89,0) | |
| 13450 | . S PSJDD =+PSJDD0 | |
| 13451 | "RTN","PSG OER",90,0) | |
| 13452 | . S PSJX= $S('$D(^PS DRUG(+PSJD D,0)):1,$P ($G(^(2)), U,3)'["U": 1,$G(^("I" ))="":0,1: ^("I")'>$G (PSGDT)) | |
| 13453 | "RTN","PSG OER",91,0) | |
| 13454 | . Q:PSJX | |
| 13455 | "RTN","PSG OER",92,0) | |
| 13456 | . S PSJAL LGY(PSJDD) ="" | |
| 13457 | "RTN","PSG OER",93,0) | |
| 13458 | S PSJDD=$ O(PSJALLGY (0)) | |
| 13459 | "RTN","PSG OER",94,0) | |
| 13460 | I '+PSJDD W !!,"No active dis pense drug was found " D PAUSE^ PSJLMUT1 Q | |
| 13461 | "RTN","PSG OER",95,0) | |
| 13462 | K PSGORQF D ENDDC^P SGSICHK(PS GP,PSJDD) | |
| 13463 | "RTN","PSG OER",96,0) | |
| 13464 | D:'$G(PSG ORQF) IN^P SJOCDS(PSG ORD,"UD",P SJDD) Q:$G (PSGORQF) | |
| 13465 | "RTN","PSG OER",97,0) | |
| 13466 | Q | |
| 13467 | "RTN","PSG OER",98,0) | |
| 13468 | UPDREN(PSG ORD,RNWDT, PSGOEPR,PS GOFD,PSJNO O,RDUZ) ; update ren ewed order | |
| 13469 | "RTN","PSG OER",99,0) | |
| 13470 | N DR,DA,D IC,DIE,DD, DO,PSGRZER O,PSGRFOUR ,PSGOORD | |
| 13471 | "RTN","PSG OER",100,0 ) | |
| 13472 | S DR="",P SGOEENO=0, PSGOORD=PS GORD,PSGNE SD=PSGSD Q :'PSGORD!' RNWDT!'PSG OEPR!'PSGO FD S PSJN OO=$S($G(P SJNOO)]"": $G(PSJNOO) ,1:"E") | |
| 13473 | "RTN","PSG OER",101,0 ) | |
| 13474 | S PSGRZER O="^PS(55, "_PSGP_",5 ,"_+PSGORD _",0)",PSG OEORD=$P(@ PSGRZERO," ^",21) | |
| 13475 | "RTN","PSG OER",102,0 ) | |
| 13476 | ; PSJ*5*1 41 - chang ed PSGOEPR to PSGPR for field 1 of the D R string b elow. | |
| 13477 | "RTN","PSG OER",103,0 ) | |
| 13478 | S DA(1)=P SGP,DA=+PS GORD,DIE=" ^PS(55,"_P SGP_",5," S DR="34// //^S X=PSG FD" S:$G(P SGPR) DR=D R_";1////" _PSGPR_";1 10////"_PS JNOO D ^DI E | |
| 13479 | "RTN","PSG OER",104,0 ) | |
| 13480 | K DR,DA,D IC,DIE,DD, DO S DIC=" ^PS(55,"_P SGP_",5,"_ +PSGORD_", 14,",DIC(0 )="L",DIC( "P")="55.6 114DA",ND1 4=$G(@(DIC _"0)")),DI NUM=$P(ND1 4,"^",3)+1 ,DA(2)=PSG P,DA(1)=+P SGORD D | |
| 13481 | "RTN","PSG OER",105,0 ) | |
| 13482 | . S DIC(" DR")=".01/ ///"_$G(RN WDT)_";1// //"_$S($G( RDUZ):RDUZ ,1:$G(DUZ) )_";2////" _$G(PSGOEP R)_";3//// "_$G(PSGOF D)_";4//// "_+PSGOEOR D,X=$G(RNW DT) D FILE ^DICN | |
| 13483 | "RTN","PSG OER",106,0 ) | |
| 13484 | K DR,DA,D IC,DIE,DD, DO S DA(1) =PSGP,DA=+ PSGORD,DIE ="^PS(55," _PSGP_",5, ",DR="28// //A;105/// /@;107//// @" | |
| 13485 | "RTN","PSG OER",107,0 ) | |
| 13486 | ;PSJ*5*19 8 | |
| 13487 | "RTN","PSG OER",108,0 ) | |
| 13488 | S PSGRFOU R="^PS(55, "_PSGP_",5 ,"_+PSGORD _",4)",PSG RFOUR=@PSG RFOUR I $P (PSGRFOUR, "^",2)<RNW DT S DR=DR _";16////@ ;17////@" I $G(PSJOR D)["P",+PS JSYSU=1 S DR=DR_";18 ////@;19// //@" | |
| 13489 | "RTN","PSG OER",109,0 ) | |
| 13490 | I '$G(PSJ SPEED) I $ G(PSGAT)]" ",$G(PSGAT )'=$P($G(@ (DIE_+PSGO RD_",2)")) ,"^",5) S DR=DR_";41 ////"_PSGA T | |
| 13491 | "RTN","PSG OER",110,0 ) | |
| 13492 | D ^DIE | |
| 13493 | "RTN","PSG OER",111,0 ) | |
| 13494 | ; PSJ*5*2 78 - Check to re-ass ign ordera ble item | |
| 13495 | "RTN","PSG OER",112,0 ) | |
| 13496 | N PSGPOI S PSGPOI=$ $ACTIVE^PS JORREN(PSG P,PSGORD) Q:+PSGPOI= 1 ;Quit i f no chang e to OI | |
| 13497 | "RTN","PSG OER",113,0 ) | |
| 13498 | I +PSGPOI >1,$P(PSGP OI,U,2) D ;replace OI | |
| 13499 | "RTN","PSG OER",114,0 ) | |
| 13500 | . N DR,DA ,DIE S DA( 1)=PSGP,DA =+PSGORD,D IE="^PS(55 ,"_PSGP_", 5,",DR="10 8///^S X=$ P(PSGPOI,U ,2)" D ^DI E | |
| 13501 | "RTN","PSG OER",115,0 ) | |
| 13502 | Q | |
| 13503 | "RTN","PSG OER",116,0 ) | |
| 13504 | UPDRENOE(P SGP,PSGORD ,RDATE) ; | |
| 13505 | "RTN","PSG OER",117,0 ) | |
| 13506 | D EXPOE(P SGP,PSGORD ,$G(RDATE) ) ; expire original Orders Fil e order | |
| 13507 | "RTN","PSG OER",118,0 ) | |
| 13508 | I PSGORD' ["P" K DA, DR,DIE S D A(1)=DFN,D A=+PSGORD, DIE="^PS(5 5,"_DFN_$S (PSGORD="U ":",5,",1: ",""IV""," ),DR=$S(DI E["IV":110 ,1:66)_"// //@" D ^DI E | |
| 13509 | "RTN","PSG OER",119,0 ) | |
| 13510 | D ENUDTX^ PSJOREN(PS GP,PSGORD, "NR") | |
| 13511 | "RTN","PSG OER",120,0 ) | |
| 13512 | D EN1^PSJ HL2(PSGP," SN",PSGORD ,"ORDER RE NEWED") | |
| 13513 | "RTN","PSG OER",121,0 ) | |
| 13514 | Q | |
| 13515 | "RTN","PSG OER",122,0 ) | |
| 13516 | READ ; hol d screen | |
| 13517 | "RTN","PSG OER",123,0 ) | |
| 13518 | I $D(IOST ) Q:$E(IOS T)'="C" | |
| 13519 | "RTN","PSG OER",124,0 ) | |
| 13520 | W !?5,"Pr ess return to contin ue " R X: $S($D(DTIM E):DTIME,1 :300) | |
| 13521 | "RTN","PSG OER",125,0 ) | |
| 13522 | Q | |
| 13523 | "RTN","PSG OER",126,0 ) | |
| 13524 | EXPOE(DFN, PSJORDER,E XPDT) ; ex pire old O rders File entry | |
| 13525 | "RTN","PSG OER",127,0 ) | |
| 13526 | I PSJORDE R["P" S FI LE="^PS(53 .1,"_+PSJO RDER_",0)" ,PSJORDER= $P(@FILE," ^",25) | |
| 13527 | "RTN","PSG OER",128,0 ) | |
| 13528 | I (PSJORD ER'["U"),( PSJORDER'[ "V") Q | |
| 13529 | "RTN","PSG OER",129,0 ) | |
| 13530 | N CURDAT D NOW^%DTC S CURDAT= $$DATE2^PS JUTL2(%) | |
| 13531 | "RTN","PSG OER",130,0 ) | |
| 13532 | S PSJEXPO E=$S($G(EX PDT):EXPDT ,1:CURDAT) D EN1^PSJ HL2(DFN,"S C",PSJORDE R) K PSJEX POE | |
| 13533 | "RTN","PSG OER",131,0 ) | |
| 13534 | Q | |
| 13535 | "RTN","PSG OER",132,0 ) | |
| 13536 | EXPIRED(PS JX,PSJY) ; | |
| 13537 | "RTN","PSG OER",133,0 ) | |
| 13538 | ; INPUT | |
| 13539 | "RTN","PSG OER",134,0 ) | |
| 13540 | ; P SJX - Phar macy Patie nt, pointe r to ^PS(5 5 | |
| 13541 | "RTN","PSG OER",135,0 ) | |
| 13542 | ; P SJY - Inpa tient Orde r Number(a ppended wi th "V" or "U") | |
| 13543 | "RTN","PSG OER",136,0 ) | |
| 13544 | ; OUTPUT | |
| 13545 | "RTN","PSG OER",137,0 ) | |
| 13546 | ; 0 - Order has not excee ded the Ex pired Time Limit | |
| 13547 | "RTN","PSG OER",138,0 ) | |
| 13548 | ; 1 - Order has exceeded the Expire d Time Lim it | |
| 13549 | "RTN","PSG OER",139,0 ) | |
| 13550 | N STOP,ST ATUS,NOW,C UTOFF,FREQ ,LAST,ST,X ,DFN,U,PSG DT,SD,WD,P SJPSTO,PSG DW,PSGOC,Z ZND,LASTAT ,LSTSTR,PS BCNT S DFN =PSJX,U="^ ",CUTOFF=0 | |
| 13551 | "RTN","PSG OER",140,0 ) | |
| 13552 | S STATUS= $S(PSJY["U ":$P($G(^P S(55,PSJX, 5,+PSJY,0) ),"^",9),P SJY["V":$P ($G(^PS(55 ,PSJX,"IV" ,+PSJY,0)) ,"^",17),1 :"") | |
| 13553 | "RTN","PSG OER",141,0 ) | |
| 13554 | S NOW=$S( $G(PSGDT): PSGDT,1:$$ DATE^PSJUT L2()) | |
| 13555 | "RTN","PSG OER",142,0 ) | |
| 13556 | S STOP=$S (PSJY["U": $P($G(^PS( 55,PSJX,5, +PSJY,2)), U,4),1:$P( $G(^PS(55, PSJX,"IV", +PSJY,0)), "^",3)) | |
| 13557 | "RTN","PSG OER",143,0 ) | |
| 13558 | I NOW<STO P Q 0 | |
| 13559 | "RTN","PSG OER",144,0 ) | |
| 13560 | ;*315 ND2 P1 ON NEXT LINE | |
| 13561 | "RTN","PSG OER",145,0 ) | |
| 13562 | I PSJY["U " N ND2,ND 0 S ND0=$G (^PS(55,PS JX,5,+PSJY ,0)),ND2=$ G(^PS(55,P SJX,5,+PSJ Y,2)),ND2P 1=$G(^PS(5 5,PSJX,5,+ PSJY,2.1)) ,FREQ=$P(N D2,"^",6) D | |
| 13563 | "RTN","PSG OER",146,0 ) | |
| 13564 | .N SCHED S SCHED=$P ($G(^PS(55 ,PSJX,5,+P SJY,2)),"^ ") I SCHED ["PRN" S F REQ=$$PRNF REQ(SCHED) | |
| 13565 | "RTN","PSG OER",147,0 ) | |
| 13566 | .S LSTSTR =$P(ND2,"^ ",2)_"^"_$ P(ND2,"^", 4)_"^"_SCH ED_"^"_$P( ND0,"^",7) _"^^"_$P(N D2,"^",5) | |
| 13567 | "RTN","PSG OER",148,0 ) | |
| 13568 | .S LAST=$ $EN^PSBAPI PM(PSJX,PS JY) I LAST ,($P(ND0," ^",7)="O") ,($P(LAST, "^",3)="G" ) I LAST>$ P(ND2,"^", 2) S CUTOF F=$$FMADD^ XLFDT(NOW, ,-1) Q | |
| 13569 | "RTN","PSG OER",149,0 ) | |
| 13570 | .I 'LAST! (LAST>$P(N D2,"^",4)) S LAST=$$ LASTAT^PSJ ORP2(DFN,L STSTR) S:L AST CUTOFF =$$FMADD^X LFDT(LAST, ,,FREQ) Q | |
| 13571 | "RTN","PSG OER",150,0 ) | |
| 13572 | .I SCHED[ "PRN",($P( LSTSTR,"^" ,6)="") S CUTOFF=$$F MADD^XLFDT (LAST,,,FR EQ) Q | |
| 13573 | "RTN","PSG OER",151,0 ) | |
| 13574 | .I $$DOW^ PSIVUTL(SC HED) S CUT OFF=$$NXTD OW(DFN,$P( LSTSTR,"^" ),$P(LSTST R,"^",2),$ P(LSTSTR," ^",3),$P(L STSTR,"^", 6)) Q | |
| 13575 | "RTN","PSG OER",152,0 ) | |
| 13576 | .S LAST=$ $EN^PSBAPI PM(PSJX,PS JY) I 'LAS T!(LAST>$P (ND2,"^",4 )) S CUTOF F=$$FMADD^ XLFDT(NOW, ,-1) Q | |
| 13577 | "RTN","PSG OER",153,0 ) | |
| 13578 | .S $P(LST STR,"^")=$ $FMADD^XLF DT(LAST,,, ,1),$P(LST STR,"^",2) =$$FMADD^X LFDT(PSGDT ,,,FREQ) S CUTOFF=$$ ENQ^PSJORP 2(PSJX,LST STR) | |
| 13579 | "RTN","PSG OER",154,0 ) | |
| 13580 | I PSJY["V " N LIMIT S LIMIT=$P ($G(^PS(59 .7,1,31)), "^",4) S L IMIT=$S((L IMIT]""):+ LIMIT,1:24 ) S CUTOFF =$$FMADD^X LFDT(STOP, ,LIMIT) D | |
| 13581 | "RTN","PSG OER",155,0 ) | |
| 13582 | .I '($G(P (4))]"") N P,YP,XP S YP=$G(^PS (55,DFN,"I V",+PSJY,0 )) F XP=1: 1:23 S P(X P)=$P(YP,U ,XP) | |
| 13583 | "RTN","PSG OER",156,0 ) | |
| 13584 | .Q:'($G(P (4))]"") | |
| 13585 | "RTN","PSG OER",157,0 ) | |
| 13586 | .Q:'$$SCH REQ^PSJLIV FD(.P) | |
| 13587 | "RTN","PSG OER",158,0 ) | |
| 13588 | .N INTERV AL,LSTSTR, ND0,SCHED, IVSTYP S N D0=$G(^PS( 55,PSJX,"I V",+PSJY,0 )),INTERVA L=$P(ND0," ^",15),SCH ED=$P(ND0, "^",9) Q:S CHED="" | |
| 13589 | "RTN","PSG OER",159,0 ) | |
| 13590 | .S IVSTYP =$S($$DOW^ PSIVUTL(SC HED):"D",I NTERVAL="O ":"O",1:"C "),LSTSTR= $P(ND0,"^" ,2)_"^"_$P (ND0,"^",3 )_"^"_SCHE D_"^"_IVST YP_"^^"_$P (ND0,"^",1 1) | |
| 13591 | "RTN","PSG OER",160,0 ) | |
| 13592 | .S LAST=$ $EN^PSBAPI PM(PSJX,PS JY) I LAST ,IVSTYP="O ",LAST>$P( ND0,"^",2) ,($P(LAST, "^",3)="G" ) S CUTOFF =$$FMADD^X LFDT(NOW,, -1) Q | |
| 13593 | "RTN","PSG OER",161,0 ) | |
| 13594 | .I 'LAST! (LAST>$P(N D0,"^",3)) !(LAST&(IV STYP="O")) S CUTOFF= $$FMADD^XL FDT(NOW,,- 1) Q | |
| 13595 | "RTN","PSG OER",162,0 ) | |
| 13596 | .I IVSTYP ="D" S CUT OFF=$$NXTD OW(LAST,SC HED,$G(P(2 )),$P($G(P (9)),"@"), $G(P(11))) Q | |
| 13597 | "RTN","PSG OER",163,0 ) | |
| 13598 | .I SCHED[ "PRN" S FR EQ=$$PRNFR EQ(SCHED) S CUTOFF=$ $FMADD^XLF DT(LAST,,, FREQ) Q | |
| 13599 | "RTN","PSG OER",164,0 ) | |
| 13600 | .S LAST=$ $EN^PSBAPI PM(PSJX,PS JY) I 'LAS T!(LAST>$P (ND0,"^",3 )) S CUTOF F=$$FMADD^ XLFDT(NOW, ,-1) Q | |
| 13601 | "RTN","PSG OER",165,0 ) | |
| 13602 | .S $P(LST STR,"^")=$ $FMADD^XLF DT(LAST,,, ,1),$P(LST STR,"^",2) =$$FMADD^X LFDT(PSGDT ,31) S CUT OFF=$$ENQ^ PSJORP2(PS JX,LSTSTR) | |
| 13603 | "RTN","PSG OER",166,0 ) | |
| 13604 | K LYN,PSB DT,PSBFLAG ,PSBSTR | |
| 13605 | "RTN","PSG OER",167,0 ) | |
| 13606 | Q $S(CUTO FF<NOW:1,1 :0) | |
| 13607 | "RTN","PSG OER",168,0 ) | |
| 13608 | ; | |
| 13609 | "RTN","PSG OER",169,0 ) | |
| 13610 | NXTDOW(DOW DFN,DOWSD, DOWFD,DOWS CH,DOWAT) ; | |
| 13611 | "RTN","PSG OER",170,0 ) | |
| 13612 | N NXTADM, DOWSTR S D OWSTR=$$FM ADD^XLFDT( DOWFD,,,,1 )_"^"_$$FM ADD^XLFDT( DOWFD,7)_" ^"_DOWSCH_ "^D^^"_DOW AT S NXTAD M=$$ENQ^PS JORP2(DOWD FN,DOWSTR) | |
| 13613 | "RTN","PSG OER",171,0 ) | |
| 13614 | Q $S(NXTA DM:NXTADM, 1:DOWSD) | |
| 13615 | "RTN","PSG OER",172,0 ) | |
| 13616 | ; | |
| 13617 | "RTN","PSG OER",173,0 ) | |
| 13618 | PRNFREQ(SC HED) ; | |
| 13619 | "RTN","PSG OER",174,0 ) | |
| 13620 | N ZZND,D, DA,X,PSGAT ,PSGOES,PS GST,PSJNSS ,PSJPWD,TE ST,VALMBCK ,PSGS0XT,P SGS0Y,PSGD T | |
| 13621 | "RTN","PSG OER",175,0 ) | |
| 13622 | F X=$P(SC HED,"PRN") ,$P(SCHED, "PRN",2),$ P(SCHED," PRN"),$P(S CHED,"PRN ",2) Q:$P( $G(ZZND)," ^",4) D A DMIN^PSJOR POE | |
| 13623 | "RTN","PSG OER",176,0 ) | |
| 13624 | Q $S($G(P SGS0XT):PS GS0XT,1:14 40) | |
| 13625 | "RTN","PSG OER0") | |
| 13626 | 0^14^B2539 8399 | |
| 13627 | "RTN","PSG OER0",1,0) | |
| 13628 | PSGOER0 ;B IR/CML3 - EDIT FIELD S FOR RENE WAL ;Jul 2 6, 2017@18 :04:02 | |
| 13629 | "RTN","PSG OER0",2,0) | |
| 13630 | ;;5.0;INP ATIENT MED ICATIONS;* *11,45,47, 50,63,64,7 0,69,58,80 ,110,127,1 36,181,281 ,327**;16 DEC 97;Bui ld 64 | |
| 13631 | "RTN","PSG OER0",3,0) | |
| 13632 | ; | |
| 13633 | "RTN","PSG OER0",4,0) | |
| 13634 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
| 13635 | "RTN","PSG OER0",5,0) | |
| 13636 | ; Referen ce to ^VA( 200 is sup ported by DBIA 10060 . | |
| 13637 | "RTN","PSG OER0",6,0) | |
| 13638 | ; Referen ce to ^DD( 55.06 is s upported b y DBIA 225 3. | |
| 13639 | "RTN","PSG OER0",7,0) | |
| 13640 | ; Referen ce to ^%DT is suppor ted by DBI A 10003. | |
| 13641 | "RTN","PSG OER0",8,0) | |
| 13642 | ; Referen ce to ^DIC is suppor ted by DBI A 10006. | |
| 13643 | "RTN","PSG OER0",9,0) | |
| 13644 | ; | |
| 13645 | "RTN","PSG OER0",10,0 ) | |
| 13646 | DATE(PSGP, PSGORD,PSG DT) ; | |
| 13647 | "RTN","PSG OER0",11,0 ) | |
| 13648 | K PSGFOK, PSJNOO,PSG NEDFD,PSGO EPR,PSGOER 0,PSGPDRG, PSGOER2,PS GWLL,PSGOE RDP,PSGOFD ,PSGPRN,PS GPRI,PSGOS D,PSGOPR,P SGRNSD,PSG S0XT,PSGS0 Y,PSGST,PS GSCH,PSGSD N | |
| 13649 | "RTN","PSG OER0",12,0 ) | |
| 13650 | S F1=55.0 6,PSGWLL=+ $G(^PS(55, PSGP,5.1)) ,PSGOER0=$ G(^PS(55,P SGP,5,+PSG ORD,0)),PS GPDRG=+$G( ^(.2)),PSG OER2=$G(^( 2)) | |
| 13651 | "RTN","PSG OER0",13,0 ) | |
| 13652 | NEW XX S XX=$$ACTIV E^PSJORREN (PSGP,PSGO RD) S:+XX= 2 PSGPDRG= $P(XX,U,2) | |
| 13653 | "RTN","PSG OER0",14,0 ) | |
| 13654 | I '+XX W !,"No acti ve Orderab le Item wa s found.", ! G DONE | |
| 13655 | "RTN","PSG OER0",15,0 ) | |
| 13656 | S (PSGNED FD,PSGOERD P)=$P($$GT NEDFD^PSGO E7("U",PSG PDRG),U) | |
| 13657 | "RTN","PSG OER0",16,0 ) | |
| 13658 | S PSGSCH= $P(PSGOER2 ,"^"),PSGS T=$P(PSGOE R0,"^",7), PSGS0Y=$P( PSGOER2,"^ ",5),PSGS0 XT=$P(PSGO ER2,"^",6) | |
| 13659 | "RTN","PSG OER0",17,0 ) | |
| 13660 | S PSGOEPR =+$P(PSGOE R0,"^",2), (PSGOPR,PS GPR)=$S($P (PSJSYSU," ;",2):DUZ, 1:+PSGOEPR ) | |
| 13661 | "RTN","PSG OER0",18,0 ) | |
| 13662 | I $G(PSJS PEED) S PS GPR=$S($P( ND,"^",2): $P(ND,"^", 2),1:+PSGO EPR) | |
| 13663 | "RTN","PSG OER0",19,0 ) | |
| 13664 | S PSGOSD= +$P(PSGOER 2,"^",2) S PSGOFD=+$ P(PSGOER2, "^",4),PSG PRN=$$GET1 ^DIQ(200,P SGPR,.01), PSGPRI=$S( $P(PSJSYSU ,";",2):0, 1:$P($G(^( "PS")),"^" ,4)),PSGRO =0 S:PSGPR I PSGPRI=P SGPRI'>DT I PSGPRI S (PSGOPR,P SGPR,PSGPR N)="" | |
| 13665 | "RTN","PSG OER0",20,0 ) | |
| 13666 | S PSGRNSD =$S($G(PSG LI):PSGLI, 1:$G(PSGDT )) | |
| 13667 | "RTN","PSG OER0",21,0 ) | |
| 13668 | S PSGSD=$ G(PSGOSD) | |
| 13669 | "RTN","PSG OER0",22,0 ) | |
| 13670 | I PSGSD=" " S PSJREN =1,PSGSD=$ $ENSD^PSGN E3($S(PSGS T["P":"PRN ",1:$P(PSG OER2,U)),P SGS0Y,PSGD T,PSGOSD) S:PSGOSD>P SGSD PSGSD =PSGOSD K PSJREN | |
| 13671 | "RTN","PSG OER0",23,0 ) | |
| 13672 | S PSGSDN= $$ENDD^PSG MI(PSGSD) | |
| 13673 | "RTN","PSG OER0",24,0 ) | |
| 13674 | 10 ; | |
| 13675 | "RTN","PSG OER0",25,0 ) | |
| 13676 | ;W !,"STA RT DATE/TI ME: "_PSGS DN | |
| 13677 | "RTN","PSG OER0",26,0 ) | |
| 13678 | O25 ; | |
| 13679 | "RTN","PSG OER0",27,0 ) | |
| 13680 | N PSGSD,P SGNEFD S P SGSD=PSGDT | |
| 13681 | "RTN","PSG OER0",28,0 ) | |
| 13682 | D ENWALL^ PSGNE3(PSG SD,0,PSGP) | |
| 13683 | "RTN","PSG OER0",29,0 ) | |
| 13684 | S:'$G(PSG DT) PSGDT= $$DATE2^PS JUTL2($$NO W^XLFDT) | |
| 13685 | "RTN","PSG OER0",30,0 ) | |
| 13686 | N PSGNESD S PSGNESD =PSGDT D E NFD^PSGNE3 (PSGNESD) I $G(PSGNE FD) S (Y,P SGFD)=PSGN EFD | |
| 13687 | "RTN","PSG OER0",31,0 ) | |
| 13688 | S PSGFOK( 10)="" I P SGST="O" S PSGFD=$$E NOSD^PSJDC U(PSJSYSW0 ,PSGRNSD,P SGP) I PSG FD]"" S Y= PSGRNSD,X= 0 G 1 | |
| 13689 | "RTN","PSG OER0",32,0 ) | |
| 13690 | D25 K DUR, DURMIN N P KGFLG S PK GFLG=$S(PS GORD["U":5 ,PSGORD["V ":"IV",PSG ORD["P":"P ",1:"") I PKGFLG]"" S DUR=$$GE TDUR^PSJLI VMD(PSGP,+ $G(PSGORD) ,PKGFLG,1) I DUR]"" D | |
| 13691 | "RTN","PSG OER0",33,0 ) | |
| 13692 | .S DURMIN =($$DURMIN ^PSJLIVMD( DUR)\1) I DURMIN>1 S Y=$$FMADD ^XLFDT(PSG RNSD,,,DUR MIN) I Y>P SGRNSD S P SGFD=Y,X=0 | |
| 13693 | "RTN","PSG OER0",34,0 ) | |
| 13694 | I $P($G(P SGOER2),"^ ",4)>PSGFD S Y=$P(PS GOER2,"^", 4) | |
| 13695 | "RTN","PSG OER0",35,0 ) | |
| 13696 | I $G(DUR) ]"",($G(PS GORD)'["P" ) S DURMIN =$$DURMIN^ PSJLIVMD(D UR)\1 S Y= $$FMADD^XL FDT(PSGDT, ,,DURMIN) | |
| 13697 | "RTN","PSG OER0",36,0 ) | |
| 13698 | S:X&$P(PS JSYSW0,"^" ,7) $P(Y," .",2)=$P(P SJSYSW0,"^ ",7) S PSG FD=+Y,PSGF DN=$$ENDD^ PSGMI(PSGF D) | |
| 13699 | "RTN","PSG OER0",37,0 ) | |
| 13700 | 25 W !,"ST OP DATE/TI ME: "_PSGF DN_"// " R X:DTIME I X="^"!'$T W:'$T $C( 7) S:'$T X ="^" S PSG RO=1,COMQU IT=1 G DON E | |
| 13701 | "RTN","PSG OER0",38,0 ) | |
| 13702 | I X="" W " "_PSGF DN G W25 | |
| 13703 | "RTN","PSG OER0",39,0 ) | |
| 13704 | I $E(X)=" ^" D FF G: Y>0 @Y G 2 5 | |
| 13705 | "RTN","PSG OER0",40,0 ) | |
| 13706 | S PSGF2=2 5 I X="@"! (X?1."?") W:X="@" $C (7)," (Re quired)" S :X="@" X=" ?" D ENHLP ^PSGOEM(55 .06,25) | |
| 13707 | "RTN","PSG OER0",41,0 ) | |
| 13708 | I X=+X,X> 0,X'>20000 00 G 25:'$ $ENDL^PSGD L(PSGSCH,X ) K PSGDLS S PSGDL=X ,ND2=PSGOE R2,$P(ND2, "^",2)=PSG RNSD W " . ..dose lim it..." D E NGO^PSGDL | |
| 13709 | "RTN","PSG OER0",42,0 ) | |
| 13710 | K %DT S % DT="ERTX" D ^%DT K % DT G:Y'>0 25 S PSGFD =+Y,PSGFDN =$$ENDD^PS GMI(PSGFD) | |
| 13711 | "RTN","PSG OER0",43,0 ) | |
| 13712 | W25 I PSGF D<PSGDT W $C(7),!!?1 3,"*** WAR NING! THE STOP DATE ENTERED IS IN THE PA ST! ***",! | |
| 13713 | "RTN","PSG OER0",44,0 ) | |
| 13714 | I PSGFD<P SGSD W $C( 7),!!?3,"* ** The STO P date mus t be AFTER the START date. *** " G 25 | |
| 13715 | "RTN","PSG OER0",45,0 ) | |
| 13716 | S PSGFOK( 25)="" | |
| 13717 | "RTN","PSG OER0",46,0 ) | |
| 13718 | ;Display Expected F irst Dose; BHW;PSJ*5* 136 | |
| 13719 | "RTN","PSG OER0",47,0 ) | |
| 13720 | D EFDNEW^ PSJUTL | |
| 13721 | "RTN","PSG OER0",48,0 ) | |
| 13722 | I $G(PSGO NF),(+$G(P SGODDD(1)) '<+$G(PSGO NF)) S PSG FOK(1)="" Q | |
| 13723 | "RTN","PSG OER0",49,0 ) | |
| 13724 | 1 ; provid er | |
| 13725 | "RTN","PSG OER0",50,0 ) | |
| 13726 | G:+PSJSYS U<3&$P(PSJ SYSU,";",2 ) CHKDD S PSGF2=1 | |
| 13727 | "RTN","PSG OER0",51,0 ) | |
| 13728 | A1 ; | |
| 13729 | "RTN","PSG OER0",52,0 ) | |
| 13730 | S PSTMPI= PSGPR,PSTM PN=PSGPRN | |
| 13731 | "RTN","PSG OER0",53,0 ) | |
| 13732 | W !,"PROV IDER: ",$S (PSGPR:PSG PRN_"// ", 1:"") R X: DTIME I X= "^"!'$T W: '$T $C(7) S:'$T X="^ " S PSGRO= 1,COMQUIT= 1 G DONE | |
| 13733 | "RTN","PSG OER0",54,0 ) | |
| 13734 | I $S(X="" :'PSGPR,1: X="@") W $ C(7)," (R equired)" S X="?" D ENHLP^PSGO EM(55.06,1 ) G A1 | |
| 13735 | "RTN","PSG OER0",55,0 ) | |
| 13736 | I X="",PS GPR S X=PS GPRN I PSG PR'=PSGPRN ,$$GET1^DI Q(200,PSGP R,53.1,"I" ) W " " _$$GET1^DI Q(200,PSGP R,53.2)_" "_$$GET 1^DIQ(200, PSGPR,53.3 ) S PSGFOK (1)="" G:' $G(ANOX) O C55 | |
| 13737 | "RTN","PSG OER0",56,0 ) | |
| 13738 | I X?1."?" D ENHLP^P SGOEM(55.0 6,1) | |
| 13739 | "RTN","PSG OER0",57,0 ) | |
| 13740 | I $E(X)=" ^" D FF G: Y>0 @Y G A 1 | |
| 13741 | "RTN","PSG OER0",58,0 ) | |
| 13742 | K DIC S D IC="^VA(20 0,",DIC(0) ="EMQZ",DI C("S")="S X(1)=$G(^( ""PS"")) I X(1),$S(' $P((X(1)), ""^"",4):1 ,1:DT<$P(( X(1)),""^" ",4))" D ^ DIC K DIC I Y'>0 G A 1 | |
| 13743 | "RTN","PSG OER0",59,0 ) | |
| 13744 | S PSGPR=+ Y,PSGPRN=$ P(Y(0,0)," ^"),PSGFOK (1)="" | |
| 13745 | "RTN","PSG OER0",60,0 ) | |
| 13746 | ;; START NCC T4 MOD S >> 327*R JS | |
| 13747 | "RTN","PSG OER0",61,0 ) | |
| 13748 | A2 D CLOZP RV^PSGOE82 | |
| 13749 | "RTN","PSG OER0",62,0 ) | |
| 13750 | I $G(ANQX ) W ! S PS GPR=PSTMPI ,PSGPRN=PS TMPN K PS TMPN,PSTMP I G A1 | |
| 13751 | "RTN","PSG OER0",63,0 ) | |
| 13752 | K ANQX | |
| 13753 | "RTN","PSG OER0",64,0 ) | |
| 13754 | ;; END NC C T4 MODS << 327*RJS | |
| 13755 | "RTN","PSG OER0",65,0 ) | |
| 13756 | OC55 ; | |
| 13757 | "RTN","PSG OER0",66,0 ) | |
| 13758 | ;Order ch eck for Sp eed finish is trigge red from O C531^PSGOE SF | |
| 13759 | "RTN","PSG OER0",67,0 ) | |
| 13760 | I $G(PSGO RD)]"P",$G (PSJSPEED) Q | |
| 13761 | "RTN","PSG OER0",68,0 ) | |
| 13762 | I $G(PSJO CFG)="SPEE D RENEW" G CHKDD | |
| 13763 | "RTN","PSG OER0",69,0 ) | |
| 13764 | D NEWOC55 ^PSGOER | |
| 13765 | "RTN","PSG OER0",70,0 ) | |
| 13766 | I $G(PSGO RQF) S COM QUIT=1 G D ONE | |
| 13767 | "RTN","PSG OER0",71,0 ) | |
| 13768 | CHKDD ; | |
| 13769 | "RTN","PSG OER0",72,0 ) | |
| 13770 | G:$G(PSGR ENEW) 106 | |
| 13771 | "RTN","PSG OER0",73,0 ) | |
| 13772 | I PSGORD[ "P"!$$DDOK ^PSGOE2("^ PS(55,"_PS GP_",5,"_+ PSGORD_",1 ,",PSGPDRG ) G 106 | |
| 13773 | "RTN","PSG OER0",74,0 ) | |
| 13774 | ;I PSGORD ["P"!'$$CH KDD^PSGOE2 ("^PS(55," _PSGP_",5, "_+PSGORD_ ",") G 106 | |
| 13775 | "RTN","PSG OER0",75,0 ) | |
| 13776 | I $P(PSJS YSU,";")'= 3,'$P(PSJS YSP0,U,2) W !!,"This order's d ispense dr ug is inva lid, a pha rmacist mu st renew t his order. " Q | |
| 13777 | "RTN","PSG OER0",76,0 ) | |
| 13778 | K ^PS(53. 45,PSJSYSP ,1),^(2) | |
| 13779 | "RTN","PSG OER0",77,0 ) | |
| 13780 | W !!,"THE DISPENSE DRUG IS MI SSING FROM THIS ORDE R." | |
| 13781 | "RTN","PSG OER0",78,0 ) | |
| 13782 | D ENDRG^P SGOEF1(+$$ GET1^DIQ(5 5.06,+PSGO ED_","_PSG P,108,"I") ,0) | |
| 13783 | "RTN","PSG OER0",79,0 ) | |
| 13784 | I $G(DUOU T)!'$G(DRG ) S COMQUI T=1 Q | |
| 13785 | "RTN","PSG OER0",80,0 ) | |
| 13786 | 106 ; natu re of orde r | |
| 13787 | "RTN","PSG OER0",81,0 ) | |
| 13788 | S PSJNOO= $$ENNOO^PS JUTL5("R") S:PSJNOO< 0 COMQUIT= 1 | |
| 13789 | "RTN","PSG OER0",82,0 ) | |
| 13790 | S:PSJNOO' <0 PSGFOK( 106)="" | |
| 13791 | "RTN","PSG OER0",83,0 ) | |
| 13792 | DONE ; | |
| 13793 | "RTN","PSG OER0",84,0 ) | |
| 13794 | K F,F0,F1 ,PSGF2,F3, ND2,PSGDL, PSGDLS,PSG OROE1,PSGR O,SDT,X,Y Q | |
| 13795 | "RTN","PSG OER0",85,0 ) | |
| 13796 | FF ; "^" t o another field | |
| 13797 | "RTN","PSG OER0",86,0 ) | |
| 13798 | K DIC S D IC="^DD(55 .06,",DIC( 0)="EQ",DI C("S")="I $D(PSGFOK( +Y))",X=$E (X,2,255) D ^DIC K D IC | |
| 13799 | "RTN","PSG OER0",87,0 ) | |
| 13800 | S Y=+Y Q | |
| 13801 | "RTN","PSG OETO") | |
| 13802 | 0^29^B4574 6599 | |
| 13803 | "RTN","PSG OETO",1,0) | |
| 13804 | PSGOETO ;B IR/CML3-TR ANSCRIBE O RDERS ;Jul 26, 2017@ 18:04:02 | |
| 13805 | "RTN","PSG OETO",2,0) | |
| 13806 | ;;5.0;INP ATIENT MED ICATIONS;* *3,13,25,3 1,33,50,68 ,58,85,105 ,90,117,11 0,111,112, 161,254,26 7,268,315, 327**;16 D EC 97;Buil d 64 | |
| 13807 | "RTN","PSG OETO",3,0) | |
| 13808 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 13809 | "RTN","PSG OETO",4,0) | |
| 13810 | ; Referen ce to ^PS( 51.2 is su pported by DBIA #217 8. | |
| 13811 | "RTN","PSG OETO",5,0) | |
| 13812 | ; Referen ce to ^PS( 55 is supp orted by D BIA #2191. | |
| 13813 | "RTN","PSG OETO",6,0) | |
| 13814 | ; Referen ce to ^PS( 59.7 is su pported by DBIA #218 1. | |
| 13815 | "RTN","PSG OETO",7,0) | |
| 13816 | ; Referen ce to ^PSU HL is supp orted by D BIA 4803. | |
| 13817 | "RTN","PSG OETO",8,0) | |
| 13818 | ; | |
| 13819 | "RTN","PSG OETO",9,0) | |
| 13820 | W:'$D(PSG OEE)&'$D(P SGOES) !!, "...transc ribing thi s ",$S($D( PSGOES):"" ,'PSGOEAV: "non-verif ied ",1:"a ctive ")," order..." S PSGOETOF =1 S:PSGSM ="" PSGSM= 0 | |
| 13821 | "RTN","PSG OETO",10,0 ) | |
| 13822 | I PSGPR'= PSGOEPR D: '$D(^PS(55 ,PSGP,0)) ENSET0^PSG NE3(PSGP) S $P(^PS(5 5,PSGP,5.1 ),U,2)=PSG PR,PSGOEPR =PSGPR | |
| 13823 | "RTN","PSG OETO",11,0 ) | |
| 13824 | K ND4,DA D ENGNN:'P SGOEAV,ENG NA:PSGOEAV S PSGDT=$ $DATE^PSJU TL2() I $S ($D(ORACTI ON):0,$G(P SGOEE)="R" :1,+$G(^PS (55,PSGP,5 .1))>PSGDT :0,1:$G(PS GOEE)'="E" ) D ENWALL ^PSGNE3(PS GNESD,PSGN EFD,PSGP) | |
| 13825 | "RTN","PSG OETO",12,0 ) | |
| 13826 | I $D(^PS( 51.2,+PSGM R,0)),$P(^ (0),U,3)]" " S PSGMRN =$P(^(0),U ,3) | |
| 13827 | "RTN","PSG OETO",13,0 ) | |
| 13828 | S ND=DA_U _PSGPR_U_P SGMR_"^U^" _PSGSM_U_P SGHSM_U_PS GST_"^^"_$ S(PSGOEAV: "A",1:"N") _"^^^^^"_P SGDT_U_PSG P_U_PSGDT S:PSGNEDFD $P(ND,U,$ P(PSGNEDFD ,U)["L"+10 )=+PSGNEDF D | |
| 13829 | "RTN","PSG OETO",14,0 ) | |
| 13830 | S:$D(PSGO EE) $P(ND, U,24,25)=P SGOEE_U_PS GOORD S:'P SGOEAV $P( ND,U,18)=D A S ND2=PS GSCH_U_$S( +PSGNESD=P SGNESD:+PS GNESD,1:"" )_"^^"_+PS GNEFD_U_PS GS0Y_U_PSG S0XT_"^^^^ "_+PSJPWD | |
| 13831 | "RTN","PSG OETO",15,0 ) | |
| 13832 | S:$G(PSGR F)]"" ND2P 1=$G(PSGDU R)_U_$G(PS GRMVT)_U_$ G(PSGRMV)_ U_$G(PSGRF ) ;*315 dr p | |
| 13833 | "RTN","PSG OETO",16,0 ) | |
| 13834 | ; naked r eference b elow refer s to ^PS(5 5,PSGP,0) | |
| 13835 | "RTN","PSG OETO",17,0 ) | |
| 13836 | I PSGOEAV S F=^PS(5 5,PSGP,0) I $P(F,"^" ,7)="" S $ P(F,"^",7) =$P($P(ND, "^",16),". "),$P(F,"^ ",8)="A",^ (0)=F D LO GDFN^PSUHL (PSGP) | |
| 13837 | "RTN","PSG OETO",18,0 ) | |
| 13838 | S $P(ND4, U,7)=DUZ I PSGOEAV,P SJSYSU D | |
| 13839 | "RTN","PSG OETO",19,0 ) | |
| 13840 | .S $P(ND4 ,U,PSJSYSU ,PSJSYSU+1 )=DUZ_U_PS GDT,$P(ND4 ,U,+PSJSYS U=1+9)=1,$ P(ND4,U,+P SJSYSU=3+9 )=0 | |
| 13841 | "RTN","PSG OETO",20,0 ) | |
| 13842 | .S $P(ND4 ,U,9,10)=+ $P(ND4,U,9 )_U_+$P(ND 4,U,10) | |
| 13843 | "RTN","PSG OETO",21,0 ) | |
| 13844 | .I '$P(ND 4,U,9) S ^ PS(55,"APV ",PSGP,DA) ="" | |
| 13845 | "RTN","PSG OETO",22,0 ) | |
| 13846 | .I '$P(ND 4,U,10) S ^PS(55,"NP V",PSGP,DA )="" | |
| 13847 | "RTN","PSG OETO",23,0 ) | |
| 13848 | .I $P(ND4 ,U,9) K ^P S(55,"APV" ,PSGP,DA) | |
| 13849 | "RTN","PSG OETO",24,0 ) | |
| 13850 | .I $P(ND4 ,U,10) K ^ PS(55,"NPV ",PSGP,DA) | |
| 13851 | "RTN","PSG OETO",25,0 ) | |
| 13852 | S F="^PS( "_$S(PSGOE AV:"55,"_P SGP_",5",1 :53.1)_"," _DA_",",@( F_"0)")=ND | |
| 13853 | "RTN","PSG OETO",26,0 ) | |
| 13854 | ;naked re ference be low refers to full r eference i nside indi rection @( F_".2)") f or either file 53.1 or 55 | |
| 13855 | "RTN","PSG OETO",27,0 ) | |
| 13856 | S @(F_".2 )")=PSGPDR G_U_PSGDO_ U_PSJNOO S :$G(PSJDOS E("DO"))]" " $P(^(.2) ,U,5,6)=$P (PSJDOSE(" DO"),U,1,2 ) | |
| 13857 | "RTN","PSG OETO",28,0 ) | |
| 13858 | I '$D(PSJ DOSE("DO") ),$D(PSGOR D),PSGPDRG =$P(@("^PS ("_$S(PSGO RD["U":"55 ,"_PSGP_", 5",1:53.1) _","_+PSGO RD_",.2)") ,U) S $P(@ (F_".2)"), U,5,6)=$P( @("^PS("_$ S(PSGORD[" U":"55,"_P SGP_",5",1 :53.1)_"," _+PSGORD_" ,.2)"),U,5 ,6) | |
| 13859 | "RTN","PSG OETO",29,0 ) | |
| 13860 | ;naked re ference be low refers to full r eference i nside indi rection @( F_"2)") fo r either f ile 53.1 o r 55 | |
| 13861 | "RTN","PSG OETO",30,0 ) | |
| 13862 | S @(F_"2) ")=$S(PSGO EAV:ND2,1: $P(ND2,"^" ,1,6)),^(4 )=ND4 S:PS GSI]"" ^(6 )=PSGSI | |
| 13863 | "RTN","PSG OETO",31,0 ) | |
| 13864 | ;*315 DRP INSERT UP DATE FOR R EMOVAL FIE LDS HERE | |
| 13865 | "RTN","PSG OETO",32,0 ) | |
| 13866 | S:$G(ND2P 1)]"" @(F_ "2.1)")=ND 2P1 | |
| 13867 | "RTN","PSG OETO",33,0 ) | |
| 13868 | S X=-1 S: '$D(^PS(53 .45,+$G(DU Z),5,1,0)) X=$S($G(P SGORD):$$G ETSIOPI^PS JBCMA5(DFN ,PSGORD),1 :"") I X D FILESI^PS JBCMA5(PSG P,DA_$S(F[ "PS(55":"U ",1:"P")) | |
| 13869 | "RTN","PSG OETO",34,0 ) | |
| 13870 | S (C,X)=0 F S X=$O (^PS(53.45 ,PSJSYSP,2 ,X)) Q:'X S D=$G(^( X,0)) I D, $S('$P(D,U ,3):1,1:$P (D,U,3)>DT ) S C=C+1, @(F_"1,"_C _",0)")=$P (D,U,1,2), @(F_"1,""B "","_+D_", "_C_")")=" " | |
| 13871 | "RTN","PSG OETO",35,0 ) | |
| 13872 | S:C @(F_" 1,0)")=U_$ S(PSGOEAV: 55.07,1:53 .11)_"P^"_ C_U_C | |
| 13873 | "RTN","PSG OETO",36,0 ) | |
| 13874 | S (C,Q)=0 F S Q=$O (^PS(53.45 ,PSJSYSP,1 ,Q)) Q:'Q S X=$G(^( Q,0)) S:X] "" C=C+1,@ (F_"3,"_C_ ",0)")=X | |
| 13875 | "RTN","PSG OETO",37,0 ) | |
| 13876 | S:C @(F_" 3,0)")=U_$ S(PSGOEAV: 55.08,1:53 .12)_U_C_U _C | |
| 13877 | "RTN","PSG OETO",38,0 ) | |
| 13878 | I $P(ND,U ,24)="R" S %X="^PS(5 5,"_PSGP_" ,5,"_+PSGO RD_",12,", %Y=F_"12," D %XY^%RC R | |
| 13879 | "RTN","PSG OETO",39,0 ) | |
| 13880 | W "." D C RN:'PSGOEA V,CRA:PSGO EAV | |
| 13881 | "RTN","PSG OETO",40,0 ) | |
| 13882 | ; don't s end messag e to CPRS if from Or der Set an d autoveri fy turned off | |
| 13883 | "RTN","PSG OETO",41,0 ) | |
| 13884 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 13885 | "RTN","PSG OETO",42,0 ) | |
| 13886 | N ARR,FOU ND D FIND^ DIC(53.1,, .01,"Q",PS GP,,"AC",, ,"ARR") | |
| 13887 | "RTN","PSG OETO",43,0 ) | |
| 13888 | F I=2:1 Q :'$D(ARR(" DILIST",2, I)) I ARR ("DILIST", 2,I)=DA S FOUND=1 | |
| 13889 | "RTN","PSG OETO",44,0 ) | |
| 13890 | I $G(FOUN D)!($$GET1 ^DIQ(55.06 ,+$G(ND)_" ,"_DFN,.01 ,"I")) D | |
| 13891 | "RTN","PSG OETO",45,0 ) | |
| 13892 | .I +$G(PS GCTDD) N P SGTMP S PS GTDD=PSGCT DD,PSGTMP= DA K PSGCT DD | |
| 13893 | "RTN","PSG OETO",46,0 ) | |
| 13894 | .I +$G(PS GETDD) N P SGTMP S PS GTDD=PSGET DD,PSGTMP= DA K PSGET DD | |
| 13895 | "RTN","PSG OETO",47,0 ) | |
| 13896 | .I +$G(PS GNTDD) N P SGTMP S PS GTDD=PSGNT DD,PSGTMP= DA K PSGNT DD | |
| 13897 | "RTN","PSG OETO",48,0 ) | |
| 13898 | I +$G(ND) ["U" S PSG TMP=+$G(ND ) | |
| 13899 | "RTN","PSG OETO",49,0 ) | |
| 13900 | S:'+$G(PS GTMP) PSGT MP=DA | |
| 13901 | "RTN","PSG OETO",50,0 ) | |
| 13902 | I $G(PSGT DD) D | |
| 13903 | "RTN","PSG OETO",51,0 ) | |
| 13904 | .;/MZR ch anged the next line | |
| 13905 | "RTN","PSG OETO",52,0 ) | |
| 13906 | .I PSGOEA V,'$D(^TMP ("PSJCOM", $J,DA)) S ^TMP("PSJC OM",$J,DA, "SAND")=PS GTDD | |
| 13907 | "RTN","PSG OETO",53,0 ) | |
| 13908 | .S ^TMP($ J,"PSGCLOZ ",DFN,+$G( PSGTMP),"S AND")=PSGT DD K PSGTD D | |
| 13909 | "RTN","PSG OETO",54,0 ) | |
| 13910 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 13911 | "RTN","PSG OETO",55,0 ) | |
| 13912 | S PSGORD= DA_$S(PSGO EAV:"U",1: "P") | |
| 13913 | "RTN","PSG OETO",56,0 ) | |
| 13914 | I $G(PSGO ORD),$D(PS GOEE) N CL INAPPT S C LINAPPT=$S (PSGOORD[" U":$G(^PS( 55,PSGP,5, +PSGOORD,8 )),PSGOORD ["P":$G(^P S(53.1,+PS GOORD,"DSS ")),1:"") I CLINAPPT D | |
| 13915 | "RTN","PSG OETO",57,0 ) | |
| 13916 | .N DIE,DA ,DR | |
| 13917 | "RTN","PSG OETO",58,0 ) | |
| 13918 | .I PSGORD ["U" S DIE ="^PS(55," _PSGP_",5, ",DA=+PSGO RD,DA(1)=P SGP,DR="13 0////"_+CL INAPPT_";" S:$P(CLIN APPT,"^",2 ) DR=DR_"1 31////"_$P (CLINAPPT, "^",2)_";" | |
| 13919 | "RTN","PSG OETO",59,0 ) | |
| 13920 | .I PSGORD ["P" S DIE ="^PS(53.1 ,",DA=+PSG ORD,DR="11 3////"_+CL INAPPT_";" S:$P(CLIN APPT,"^",2 ) DR=DR_"1 26////"_$P (CLINAPPT, "^",2)_";" | |
| 13921 | "RTN","PSG OETO",60,0 ) | |
| 13922 | .I $G(DR) D ^DIE | |
| 13923 | "RTN","PSG OETO",61,0 ) | |
| 13924 | D:('$D(PS GOES))!(($ D(PSGOES)& (PSGOEAV)) ) ORSET^PS GOETO1 | |
| 13925 | "RTN","PSG OETO",62,0 ) | |
| 13926 | I $D(PSGO ES),'$D(PS GOESON) N PSGOESON S PSGOESON= PSGORD D D ISACTIO^PS JOE(DFN,PS GORD,0) D: PSGORD["U" &(PSGOESON =PSGORD)&( $P(@(PSGOE EWF_"0)"), "^",9)'="D ") EN^PSGP EN(PSGORD) G OUT | |
| 13927 | "RTN","PSG OETO",63,0 ) | |
| 13928 | D DONE S PSGCANFL=" " I '$D(PS GOEE) S PS JLM=1,PSGO EEF=0 D GE TUD^PSJLMG UD(PSGP,PS GORD),ENSF E^PSGOEE0( PSGP,PSGOR D),EN^VALM ("PSJ LM A CCEPT") I PSGCANFL=1 G OUT | |
| 13929 | "RTN","PSG OETO",64,0 ) | |
| 13930 | I $D(PSJS YSO) S PSG POSA="W",P SGPOSD=PSG DT D ENPOS ^PSGVDS | |
| 13931 | "RTN","PSG OETO",65,0 ) | |
| 13932 | S DA=+PSG ORD,X=$P(P SGORD,DA,2 ) I PSJSYS L,$S(PSGOE AV:1,1:PSJ SYSL<3),$S ("AOU"[X:' $D(^PS(55, PSGP,5,+PS GORD,7)),1 :'$D(^PS(5 3.1,+PSGOR D,7))) D | |
| 13933 | "RTN","PSG OETO",66,0 ) | |
| 13934 | .; naked ref below is from li ne above, ^PS(53.1,+ PSGORD,7) | |
| 13935 | "RTN","PSG OETO",67,0 ) | |
| 13936 | .S $P(^(7 ),U,1,2)=P SGDT_"^N"_ $G(PSGOEE) ,PSGUOW=DU Z,PSGTOL=2 ,PSGTOO=$S ("AOU"[X:1 ,1:2) D EN L^PSGVDS | |
| 13937 | "RTN","PSG OETO",68,0 ) | |
| 13938 | D STOREIN T^PSGSICH1 | |
| 13939 | "RTN","PSG OETO",69,0 ) | |
| 13940 | OUT ; | |
| 13941 | "RTN","PSG OETO",70,0 ) | |
| 13942 | K PSGOETO F | |
| 13943 | "RTN","PSG OETO",71,0 ) | |
| 13944 | ; ** Thi s is where the Autom ated Dispe nsing Mach ine hook i s called. Do NOT DEL ETE or cha nge locati on ** | |
| 13945 | "RTN","PSG OETO",72,0 ) | |
| 13946 | D NEWG^PS JADM | |
| 13947 | "RTN","PSG OETO",73,0 ) | |
| 13948 | ; ** END of Interf ace hook * * | |
| 13949 | "RTN","PSG OETO",74,0 ) | |
| 13950 | DONE ; | |
| 13951 | "RTN","PSG OETO",75,0 ) | |
| 13952 | I PSGOEAV L -^PS(55 ,PSGP,5,+P SGORD) | |
| 13953 | "RTN","PSG OETO",76,0 ) | |
| 13954 | I 'PSGOEA V L -^PS(5 3.1,+PSGOR D) | |
| 13955 | "RTN","PSG OETO",77,0 ) | |
| 13956 | K C,D,ND, ND2,ND4,PS GDO,PSGDRG ,PSGDRGN,P SGFOK,PSGH SM,PSGMR,P SGMRN,PSGN EDFD,PSGNE FD,PSGNESD ,PSGPDRG,P SGPDRGN,PS GSI,PSGSTN ,PSJDOSE,N D0,ND2P1 | |
| 13957 | "RTN","PSG OETO",78,0 ) | |
| 13958 | K ^PS(53. 45,+$G(DUZ ),5) | |
| 13959 | "RTN","PSG OETO",79,0 ) | |
| 13960 | Q | |
| 13961 | "RTN","PSG OETO",80,0 ) | |
| 13962 | CRA ; | |
| 13963 | "RTN","PSG OETO",81,0 ) | |
| 13964 | S:PSGPDRG ^PS(55,PS GP,5,"C",P SGPDRG,DA) ="" S (^PS (55,"AUE", PSGP,DA),^ PS(55,PSGP ,5,"AU",PS GST,+PSGNE FD,DA),^PS (55,PSGP,5 ,"AUS",+PS GNEFD,DA)) ="",^PS(55 ,"AUD",+$P (ND2,"^",4 ),PSGP,DA) ="",^PS(55 ,"AUDS",+$ P(ND2,"^", 2),PSGP,DA )="" | |
| 13965 | "RTN","PSG OETO",82,0 ) | |
| 13966 | I $$PATCH ^XPDUTL("P XRM*1.5*12 ") S X(1)= +PSGNESD,X (2)=+PSGNE FD,DA(1)=P SGP D SPSP A^PSJXRFS( .X,.DA,"UD ") | |
| 13967 | "RTN","PSG OETO",83,0 ) | |
| 13968 | S DA(1)=P SGP K DIK S DIK="^PS (55,"_DA(1 )_",5,",DI K(1)=125 D EN1^DIK K DIK | |
| 13969 | "RTN","PSG OETO",84,0 ) | |
| 13970 | K PSGALO, PSGALR S D A(1)=PSGP, PSGAL("C") =PSJSYSU*1 0+$S('$D(P SGOEE):225 00,PSGOEE= "E":22600, 1:22700) D ^PSGAL5 Q | |
| 13971 | "RTN","PSG OETO",85,0 ) | |
| 13972 | CRN ; | |
| 13973 | "RTN","PSG OETO",86,0 ) | |
| 13974 | S (^PS(53 .1,"AC",PS GP,DA),^PS (53.1,"AS" ,"N",PSGP, DA),^PS(53 .1,"B",DA, DA),^PS(53 .1,"C",PSG P,DA))="" S:PSGPDRG (^PS(53.1, "AOD",PSGP ,PSGPDRG,D A),^PS(53. 1,"D",PSGP DRG,DA))=" " Q | |
| 13975 | "RTN","PSG OETO",87,0 ) | |
| 13976 | ENGNA ; Ve rified | |
| 13977 | "RTN","PSG OETO",88,0 ) | |
| 13978 | F L +^PS (55,PSGP,5 ,0):$S($G( DILOCKTM)> 0:DILOCKTM ,1:3) S:'$ D(^PS(55,P SGP,0)) ^( 0)=PSGP,^P S(55,"B",P SGP,PSGP)= "" S ND=$S ($D(^PS(55 ,PSGP,5,0) ):^(0),1:" ^55.06IA") Q | |
| 13979 | "RTN","PSG OETO",89,0 ) | |
| 13980 | N PSGLCK S PSGLCK=0 | |
| 13981 | "RTN","PSG OETO",90,0 ) | |
| 13982 | F DA=$P(N D,U,3)+1:1 W "." I ' $D(^PS(55, PSGP,5,DA) ),'$D(^PS( 55,PSGP,5, "B",DA)) D I PSGLCK S ^PS(55, PSGP,5,DA, 0)=DA,^PS( 55,PSGP,5, "B",DA,DA) ="",$P(ND, U,3)=DA,$P (ND,U,4)=$ P(ND,U,4)+ 1,^PS(55,P SGP,5,0)=N D Q | |
| 13983 | "RTN","PSG OETO",91,0 ) | |
| 13984 | . L +^PS( 55,PSGP,5, DA):$S($G( DILOCKTM)> 0:DILOCKTM ,1:3) I S PSGLCK=1 | |
| 13985 | "RTN","PSG OETO",92,0 ) | |
| 13986 | L -^PS(55 ,PSGP,5,0) Q | |
| 13987 | "RTN","PSG OETO",93,0 ) | |
| 13988 | ENGNN ; No t Verified | |
| 13989 | "RTN","PSG OETO",94,0 ) | |
| 13990 | N ND F L +^PS(59.7 ,1,25):$S( $G(DILOCKT M)>0:DILOC KTM,1:3) I S DA=+$G (^PS(59.7, 1,25)) Q | |
| 13991 | "RTN","PSG OETO",95,0 ) | |
| 13992 | F DA=DA+1 :1 I '$D(^ PS(53.1,DA )),'$D(^PS (53.1,"B", DA)) L +^P S(53.1,DA) :$S($G(DIL OCKTM)>0:D ILOCKTM,1: 3) I S ^P S(59.7,1,2 5)=DA,^PS( 53.1,DA,0) =DA,^PS(53 .1,"B",DA, DA)="" Q | |
| 13993 | "RTN","PSG OETO",96,0 ) | |
| 13994 | F L +^PS (53.1,0):$ S($G(DILOC KTM)>0:DIL OCKTM,1:3) I S ND=$ G(^PS(53.1 ,0)),$P(ND ,U,3)=DA,$ P(ND,U,4)= $P(ND,U,4) +1,^(0)=ND Q | |
| 13995 | "RTN","PSG OETO",97,0 ) | |
| 13996 | L -^PS(59 .7,1,25),- ^PS(53.1,0 ) | |
| 13997 | "RTN","PSG OETO",98,0 ) | |
| 13998 | I $G(PSIV CHG) D | |
| 13999 | "RTN","PSG OETO",99,0 ) | |
| 14000 | .N PSGORD ,ON S ON=D A_"P" D SE TIVINT^PSG SICH1 | |
| 14001 | "RTN","PSG OETO",100, 0) | |
| 14002 | Q | |
| 14003 | "RTN","PSG OEV") | |
| 14004 | 0^9^B96139 745 | |
| 14005 | "RTN","PSG OEV",1,0) | |
| 14006 | PSGOEV ;BI R/CML3 - V ERIFY (MAK E ACTIVE) ORDERS ;Ju l 26, 2017 @18:04:02 | |
| 14007 | "RTN","PSG OEV",2,0) | |
| 14008 | ;;5.0;INP ATIENT MED ICATIONS;* *5,7,15,28 ,33,50,64, 58,77,78,8 0,110,111, 133,171,20 7,241,267, 268,260,28 8,199,281, 327**;16 D EC 97;Buil d 64 | |
| 14009 | "RTN","PSG OEV",3,0) | |
| 14010 | ; | |
| 14011 | "RTN","PSG OEV",4,0) | |
| 14012 | ; Referen ce to ^ORD (101 suppo rted by DB IA #872. | |
| 14013 | "RTN","PSG OEV",5,0) | |
| 14014 | ; Referen ce to ^PS( 50.7 suppo rted by DB IA #2180. | |
| 14015 | "RTN","PSG OEV",6,0) | |
| 14016 | ; Referen ce to ^PS( 55 support ed by DBIA #2191. | |
| 14017 | "RTN","PSG OEV",7,0) | |
| 14018 | ; Referen ce to ^PSS LOCK suppo rted by DB IA #2789. | |
| 14019 | "RTN","PSG OEV",8,0) | |
| 14020 | ; Referen ce to ^PSD RUG( suppo rted by DB IA# 2192. | |
| 14021 | "RTN","PSG OEV",9,0) | |
| 14022 | ; Referen ce to MAIN ^TIUEDIT i s supporte d by DBIA #2410. | |
| 14023 | "RTN","PSG OEV",10,0) | |
| 14024 | ; Referen ce to ^TMP ("PSODAOC" ,$J suppor ted by DBI A 6071 | |
| 14025 | "RTN","PSG OEV",11,0) | |
| 14026 | ; | |
| 14027 | "RTN","PSG OEV",12,0) | |
| 14028 | EN(PSGORD) ; | |
| 14029 | "RTN","PSG OEV",13,0) | |
| 14030 | ENSF ; Thi s entry po int is use d by Speed finish on ly. | |
| 14031 | "RTN","PSG OEV",14,0) | |
| 14032 | ; Send SN update to CPRS if a uto-verify off and f rom Order Set entry | |
| 14033 | "RTN","PSG OEV",15,0) | |
| 14034 | S:'$D(PSG OEAV) PSGO EAV=$P($G( PSJSYSP0), "^",9)&$G( PSJSYSU) | |
| 14035 | "RTN","PSG OEV",16,0) | |
| 14036 | I $D(PSGO ES),'PSGOE AV,PSGORD[ "P",$P($G( ^PS(53.1,+ PSGORD,0)) ,"^",21)'] "" D ORSET ^PSGOETO1 | |
| 14037 | "RTN","PSG OEV",17,0) | |
| 14038 | D FULL^VA LM1 I 'PSJ SYSU W $C( 7),$C(7),! !," THIS F UNCTION NO T AVAILABL E TO WARD STAFF." Q | |
| 14039 | "RTN","PSG OEV",18,0) | |
| 14040 | S CHK=0 I PSGORD["P " S X=$P($ G(^PS(53.1 ,+PSGORD,0 )),"^",19) I X,$D(^P S(55,PSGP, 5,$P(^(0), "^",19))) S CHK=+PSG ORD,PSGORD =X_"U" L - ^PS(53.1,C HK) L +^PS (55,PSGP,5 ,+PSGORD): 1 E W !!, "Another t erminal is editing t his order. " G DONE | |
| 14041 | "RTN","PSG OEV",19,0) | |
| 14042 | I +PSJSYS U=3 D DDCH K G:CHK DO NE | |
| 14043 | "RTN","PSG OEV",20,0) | |
| 14044 | I PSGORD[ "P" D CHK( $G(^PS(53. 1,+PSGORD, 0)),$G(^(. 2)),$G(^(2 ))) | |
| 14045 | "RTN","PSG OEV",21,0) | |
| 14046 | I $G(PSGS CH)]"" D | |
| 14047 | "RTN","PSG OEV",22,0) | |
| 14048 | .N X,Y,PS GS0Y,PSGS0 XT,PSGOES S PSGOES=1 S X=PSGSC H D ENOS^P SGS0 I $G( X)="" S CH K=4 | |
| 14049 | "RTN","PSG OEV",23,0) | |
| 14050 | I $G(CHK) Q:$D(PSJS PEED) D E N^VALM("PS JU LM ACCE PT") G:'$G (PSJACEPT) DONE ;G V FY | |
| 14051 | "RTN","PSG OEV",24,0) | |
| 14052 | I PSGORD[ "U" G:'$D( ^PS(55,PSG P,5,+PSGOR D,4)) VFY I +PSJSYSU =3,$P(^(4) ,"^",3) W $C(7),!!," THIS ORDER HAS ALREA DY BEEN VE RIFIED BY A PHARMACI ST." S PSG ACT=$P(PSG ACT,"V")_$ P(PSGACT," V",2) G DO NE | |
| 14053 | "RTN","PSG OEV",25,0) | |
| 14054 | I PSGORD[ "U" I +PSJ SYSU=1,+^P S(55,PSGP, 5,+PSGORD, 4) W $C(7) ,!!,"THIS ORDER HAS ALREADY BE EN VERIFIE D BY A NUR SE." S PSG ACT=$P(PSG ACT,"V")_$ P(PSGACT," V",2) G DO NE | |
| 14055 | "RTN","PSG OEV",26,0) | |
| 14056 | ; | |
| 14057 | "RTN","PSG OEV",27,0) | |
| 14058 | VFY ; chan ge status, move to 5 5, and cha nge label record **E NHANCEMENT S MADE IN PSJ*5.0*26 0 **CCR 62 14 **CCR 6 244 | |
| 14059 | "RTN","PSG OEV",28,0) | |
| 14060 | I PSGORD[ "P" S PSJC OM=+$P($G( ^PS(53.1,+ PSGORD,.2) ),"^",8) I PSJCOM D VFY^PSJCOM Q | |
| 14061 | "RTN","PSG OEV",29,0) | |
| 14062 | N PSJDOSE ,PSJDSFLG, PSJDIS,PSG ORQF,PSJCN T,PSJCNT1, PSJCNT2,LI ST,PSJFLG, PSGDN SET PSJDIS="", PSJCNT=0,P SJCNT1="", PSJCNT2="" ,LIST="PSG PRE",PSJFL G="",PSGDN ="" | |
| 14063 | "RTN","PSG OEV",30,0) | |
| 14064 | D DOSECHK ^PSJDOSE | |
| 14065 | "RTN","PSG OEV",31,0) | |
| 14066 | S PSJFLG= +$G(PSGORD ) | |
| 14067 | "RTN","PSG OEV",32,0) | |
| 14068 | F S PSJC NT=$O(^PS( 53.1,PSJFL G,1,PSJCNT )) Q:'+PSJ CNT D | |
| 14069 | "RTN","PSG OEV",33,0) | |
| 14070 | .I $D(^PS (53.1,PSJF LG,1,PSJCN T,0)) S PS GDN=$P($G( ^PS(53.1,P SJFLG,1,PS JCNT,0)),U ,1) | |
| 14071 | "RTN","PSG OEV",34,0) | |
| 14072 | .I +$G(PS GDN),($$GE T1^DIQ(50, PSGDN,3)'[ "S")&($E($ $GET1^DIQ( 50,PSGDN,2 ),1,2)'="X A") D | |
| 14073 | "RTN","PSG OEV",35,0) | |
| 14074 | ..D PROFI LE^PSJBLDO C($G(DFN), LIST,"I;"_ $G(PSGORD) ) | |
| 14075 | "RTN","PSG OEV",36,0) | |
| 14076 | ..F S PS JCNT1=$O(^ TMP($J,LIS T,"IN","PR OFILE",PSJ CNT1)) Q:( PSJCNT1="" )!(PSJDIS' ="") D | |
| 14077 | "RTN","PSG OEV",37,0) | |
| 14078 | ...S PSJC NT2=$P(PSJ CNT1,";",2 ) | |
| 14079 | "RTN","PSG OEV",38,0) | |
| 14080 | ...I PSJC NT2=$G(PSG ORD) SET P SJDIS=$P(^ TMP($J,LIS T,"IN","PR OFILE",PSJ CNT1),U,3) | |
| 14081 | "RTN","PSG OEV",39,0) | |
| 14082 | ..;**Do o rder check s if PSJDI S (Dispens e drug IEN ) has a va lue | |
| 14083 | "RTN","PSG OEV",40,0) | |
| 14084 | ..;IF $G( PSJNEWOE)= 0,'$G(PSJL MFIN),'$G( PSJSTARI), '$G(PSGCOP Y),$G(PSJD IS),'$G(PS JSPEED) D | |
| 14085 | "RTN","PSG OEV",41,0) | |
| 14086 | ..I '+$G( PSJNEWOE), '$G(PSJLMF IN),'$G(PS JSTARI),'$ G(PSGCOPY) ,$G(PSJDIS ),'$G(PSJS PEED) D | |
| 14087 | "RTN","PSG OEV",42,0) | |
| 14088 | ...D ALLE RGY($G(PSJ ORD),.PSJA LLGY),ENDD C^PSGSICHK ($G(PSGP), PSJDIS) D: ('$G(PSGOR QF)&'$G(PS JDSVFY)&'$ G(PSJSTARI )) IN^PSJO CDS($G(PSG ORD),"UD", PSJDIS) IF $G(PSGORQ F) K ^TMP( $J,LIST) D :$G(PSJORD )]"" EN^VA LM("PSJ LM UD ACTION ") QUIT | |
| 14089 | "RTN","PSG OEV",43,0) | |
| 14090 | I $G(PSGO RQF) QUIT | |
| 14091 | "RTN","PSG OEV",44,0) | |
| 14092 | D FULL^VA LM1 ;PSJ*5 *241 | |
| 14093 | "RTN","PSG OEV",45,0) | |
| 14094 | I +$G(PSJ DSFLG) D S ETVAR^PSJD OSE W !!,P SJDOSE("WA RN"),!,PSJ DOSE("WARN 1") I '$$C ONT() W !, "...order was not ve rified..." D PAUSE^V ALM1 D Q: '$G(PSJACE PT) | |
| 14095 | "RTN","PSG OEV",46,0) | |
| 14096 | . S PSGOE EF(109)=1 | |
| 14097 | "RTN","PSG OEV",47,0) | |
| 14098 | . S PSJAC EPT=0 | |
| 14099 | "RTN","PSG OEV",48,0) | |
| 14100 | . ;D EN^V ALM("PSJU LM ACCEPT" ) | |
| 14101 | "RTN","PSG OEV",49,0) | |
| 14102 | D DDCHK G :CHK DONE | |
| 14103 | "RTN","PSG OEV",50,0) | |
| 14104 | I $G(PSGS CH)]"",((" ,P,R,")'[( ","_PSGST_ ",")) D I CHK G DON E | |
| 14105 | "RTN","PSG OEV",51,0) | |
| 14106 | .N SWD,SD W,XABB,X,Q X S X=$G(P SGSCH) D D W^PSGS0 Q: ($G(X)="") I $G(PSG S0XT)="" S PSGS0XT=" D" | |
| 14107 | "RTN","PSG OEV",52,0) | |
| 14108 | .I $G(PSG S0XT)="D", $G(PSGAT)= "" S CHK=1 W !!,"Thi s is a 'DA Y OF WEEK' schedule and MUST h ave admin times.",! D PAUSE^VA LM1 | |
| 14109 | "RTN","PSG OEV",53,0) | |
| 14110 | I $G(PSGS CH)]"" D I CHK G DO NE | |
| 14111 | "RTN","PSG OEV",54,0) | |
| 14112 | .N X,Y,PS GS0XT,PSGS 0Y,PSGOES S PSGOES=2 ,X=PSGSCH D ENOS^PSG S0 I $G(X) ="" S CHK= 4 | |
| 14113 | "RTN","PSG OEV",55,0) | |
| 14114 | W !,"...a few momen ts, please ..." | |
| 14115 | "RTN","PSG OEV",56,0) | |
| 14116 | I PSGORD[ "P" D | |
| 14117 | "RTN","PSG OEV",57,0) | |
| 14118 | . N PND0, PSGORDR,PS JPRIO,PSJS CHED S PND 0=^PS(53.1 ,+PSGORD,0 ) I $P(PND 0,U,24)="R " S PSGORD R=$P(PND0, U,25) D Q | |
| 14119 | "RTN","PSG OEV",58,0) | |
| 14120 | .. N OEOR D,OOEORD,F ILE55,FILE 55N0 S FIL E55="^PS(5 5,"_DFN_$S ($P(PND0,U ,4)="U":", 5,",1:","" IV"","),FI LE55N0=FIL E55_+PSGOR DR_",0)" | |
| 14121 | "RTN","PSG OEV",59,0) | |
| 14122 | .. S OEOR D=$P(PND0, U,21) I PS GORDR S OO EORD=$P(@F ILE55N0,"^ ",21) I OE ORD'=OOEOR D D EXPOE^ PSGOER(DFN ,PSGORD,+$ $LASTREN^P SJLMPRI(DF N,PSGORD)) | |
| 14123 | "RTN","PSG OEV",60,0) | |
| 14124 | .. S PSGO RDP=PSGORD ,DIE="^PS( 53.1,",DA= +PSGORD,DR ="28////A; 104////@" W "." D ^D IE | |
| 14125 | "RTN","PSG OEV",61,0) | |
| 14126 | .. D STAR T^PSGOTR(P SGORD,+PSG ORDR) I OE ORD D | |
| 14127 | "RTN","PSG OEV",62,0) | |
| 14128 | ... K DA, DR,DIE S D A(1)=DFN,D A=+PSGORDR ,DIE=FILE5 5,DR=$S(DI E["IV":110 ,1:66)_"// //"_+OEORD D ^DIE S DIE=FILE55 _+PSGORDR_ ",0)",$P(@ DIE,U,21)= OEORD | |
| 14129 | "RTN","PSG OEV",63,0) | |
| 14130 | ... D EN1 ^PSJHL2(DF N,"SC",PSG ORDR),EN^P SGPEN(PSGO RDR),UNL^P SSLOCK(PSG P,PSGORDR) | |
| 14131 | "RTN","PSG OEV",64,0) | |
| 14132 | . S PSGOR DP=PSGORD ;Used in A CTLOG to u pdate acti vity log i n 55 | |
| 14133 | "RTN","PSG OEV",65,0) | |
| 14134 | . D REQDT ^PSJLIVMD( PSGORD) | |
| 14135 | "RTN","PSG OEV",66,0) | |
| 14136 | . S DIE=" ^PS(53.1," ,DA=+PSGOR D,DR="28// //A" W "." D ^DIE,^P SGOT | |
| 14137 | "RTN","PSG OEV",67,0) | |
| 14138 | . S PSJPR IO=$S(PSGO RD["P":$P( $G(^PS(53. 1,+PSGORD, .2)),"^",4 ),PSGORD[" U":$P($G(^ PS(55,DFN, 5,+PSGORD, .2)),"^",4 ),1:$P($G( ^PS(55,PSJ HLDFN,"IV" ,+PSGORD,. 2)),"^",4) ) | |
| 14139 | "RTN","PSG OEV",68,0) | |
| 14140 | . S PSJSC HED=$S(PSG ORD["P":$P ($G(^PS(53 .1,+PSGORD ,2)),"^"), PSGORD["U" :$P($G(^PS (55,DFN,5, +PSGORD,2) ),"^"),1:$ P($G(^PS(5 5,PSJHLDFN ,"IV",+PSG ORD,0)),"^ ",15)) | |
| 14141 | "RTN","PSG OEV",69,0) | |
| 14142 | . I (",S, A,")[(","_ $G(PSJPRIO )_",")!($G (PSJSCHED) ="NOW")!($ G(PSJSCHED )["STAT") D NOTIFY^P SJHL4(PSGO RD,DFN,$G( PSJPRIO),$ G(PSJSCHED )) | |
| 14143 | "RTN","PSG OEV",70,0) | |
| 14144 | . I $G(PS GRDTX)="" S PSGRDTX= $G(^PS(53. 1,+PSGORDP ,2.5)) | |
| 14145 | "RTN","PSG OEV",71,0) | |
| 14146 | S DA=+PSG ORD,DA(1)= PSGP,PSGAL ("C")=PSJS YSU*10+220 00 D ^PSGA L5 W "." S VND4=$G(^ PS(55,PSGP ,5,DA,4)) | |
| 14147 | "RTN","PSG OEV",72,0) | |
| 14148 | I $G(PSGR DTX) D NEW UDAL^PSGAL 5(PSGP,PSG ORD,6090," Requested Start Date ",+$G(PSGR DTX)) | |
| 14149 | "RTN","PSG OEV",73,0) | |
| 14150 | I $P($G(P SGRDTX),U, 3) D NEWUD AL^PSGAL5( PSGP,PSGOR D,6090,"Re quested St op Date",+ $P($G(PSGR DTX),U,3)) | |
| 14151 | "RTN","PSG OEV",74,0) | |
| 14152 | N DUR,DUR ON S DURON =$S($G(PSG ORD):$G(PS GORD),1:"" ) I DURON D | |
| 14153 | "RTN","PSG OEV",75,0) | |
| 14154 | . S DUR=$ S($P($G(PS GRDTX),U,2 )]"":$P($G (PSGRDTX), U,2),1:$$G ETDUR^PSJL IVMD(PSGP, +DURON,$S( $G(DURON)[ "P":"P",1: 5),1),1:"" ) | |
| 14155 | "RTN","PSG OEV",76,0) | |
| 14156 | I $G(DUR) ]"" S $P(^ PS(55,PSGP ,5,+PSGORD ,2.5),"^", 2)=DUR | |
| 14157 | "RTN","PSG OEV",77,0) | |
| 14158 | D:$D(PSGO RDP) ACTLO G(PSGORDP, PSGP,PSGOR D) | |
| 14159 | "RTN","PSG OEV",78,0) | |
| 14160 | K PSGRSD, PSGRFD,PSG ALFN | |
| 14161 | "RTN","PSG OEV",79,0) | |
| 14162 | NEW X S X =0 I $G(PS GONF),(+$G (PSGODDD(1 ))'<+$G(PS GONF)) S X =1 | |
| 14163 | "RTN","PSG OEV",80,0) | |
| 14164 | I +PSJSYS U=3,PSGORD '["O",$S(X :0,'$P(VND 4,"^",9):1 ,1:$P(VND4 ,"^",15)) D EN^PSGPE N(+PSGORD) | |
| 14165 | "RTN","PSG OEV",81,0) | |
| 14166 | S $P(VND4 ,"^",+PSJS YSU=1+9)=1 S:'$P(VND 4,U,+PSJSY SU=3+9) $P (VND4,U,+P SJSYSU=3+9 )=+$P(VND4 ,U,+PSJSYS U=3+9) | |
| 14167 | "RTN","PSG OEV",82,0) | |
| 14168 | I PSJSYSL >1 S $P(^P S(55,PSGP, 5,+PSGORD, 7),U)=PSGD T S:$P(^(7 ),U,2)="" $P(^(7),U, 2)="N"_$S( $P(^PS(55, PSGP,5,+PS GORD,0),"^ ",24)="E": "E",1:"") S PSGTOL=2 ,PSGUOW=DU Z,PSGTOO=1 ,DA=+PSGOR D D ENL^PS GVDS | |
| 14169 | "RTN","PSG OEV",83,0) | |
| 14170 | S:$P(VND4 ,"^",15)&' $P(VND4,"^ ",16) $P(V ND4,"^",15 )="" S:$P( VND4,"^",1 8)&'$P(VND 4,"^",19) $P(VND4,"^ ",18)="" S :$P(VND4," ^",22)&'$P (VND4,"^", 23) $P(VND 4,"^",22)= "" S $P(VN D4,"^",PSJ SYSU,PSJSY SU+1)=DUZ_ "^"_PSGDT, ^PS(55,PSG P,5,+PSGOR D,4)=VND4 | |
| 14171 | "RTN","PSG OEV",84,0) | |
| 14172 | I '$P(VND 4,U,9) S ^ PS(55,"APV ",PSGP,+PS GORD)="" | |
| 14173 | "RTN","PSG OEV",85,0) | |
| 14174 | I '$P(VND 4,U,10) S ^PS(55,"AN V",PSGP,+P SGORD)="" | |
| 14175 | "RTN","PSG OEV",86,0) | |
| 14176 | I $P(VND4 ,U,9) K ^P S(55,"APV" ,PSGP,+PSG ORD) | |
| 14177 | "RTN","PSG OEV",87,0) | |
| 14178 | I $P(VND4 ,U,10) K ^ PS(55,"ANV ",PSGP,+PS GORD) | |
| 14179 | "RTN","PSG OEV",88,0) | |
| 14180 | W:'$D(PSJ SPEED) ! W !,"ORDER VERIFIED." ,! | |
| 14181 | "RTN","PSG OEV",89,0) | |
| 14182 | I '$D(PSJ SPEED) K D IR S DIR(0 )="E" D ^D IR K DIR | |
| 14183 | "RTN","PSG OEV",90,0) | |
| 14184 | S:+PSJSYS U=3 ^PS(55 ,"AUE",PSG P,+PSGORD) ="" S PSGA CT="C"_$S( '$D(^PS(55 ,PSGP,5,+P SGORD,4)): "E",$P(^(4 ),"^",16): "",1:"E")_ "RS",PSGCA NFL=2 | |
| 14185 | "RTN","PSG OEV",91,0) | |
| 14186 | I $G(^TMP ($J,"PSGCL OZ",DFN,+$ G(PSJORD), "SAND")) D K ^TMP($ J,"PSGCLOZ ",DFN,+$G( PSJORD),"S AND") | |
| 14187 | "RTN","PSG OEV",92,0) | |
| 14188 | .N DIE,DA ,DR S DIE= "^PS(55,"_ DFN_",5,", DA=+$G(PSG ORD),DA(1) =DFN | |
| 14189 | "RTN","PSG OEV",93,0) | |
| 14190 | .S DR="30 1////"_$G( ^TMP($J,"P SGCLOZ",DF N,+$G(PSJO RD),"SAND" )) D ^DIE | |
| 14191 | "RTN","PSG OEV",94,0) | |
| 14192 | S VALMBCK ="Q" D EN1 ^PSJHL2(PS GP,$S(+PSJ SYSU=3:"SC ",+PSJSYSU =1:"SC",1: "XX"),+PSG ORD_"U") ; allow status ch ange to be sent for pharmacist s & nurses | |
| 14193 | "RTN","PSG OEV",95,0) | |
| 14194 | S ^TMP("P SODAOC",$J ,"IP IEN") =$G(PSJORD ),^TMP("PS ODAOC",$J, "IP NEW IE N")=$G(PSG ORD) | |
| 14195 | "RTN","PSG OEV",96,0) | |
| 14196 | ; -- RTC 198753 - c lean-up va riable - K PSJAGYSV | |
| 14197 | "RTN","PSG OEV",97,0) | |
| 14198 | D SETOC^P SJNEWOC(PS GORD) K PS JAGYSV | |
| 14199 | "RTN","PSG OEV",98,0) | |
| 14200 | ; **This is where the Automa ted Dispen sing Machi ne hook is called. D o NOT DELE TE or chan ge this lo cation ** | |
| 14201 | "RTN","PSG OEV",99,0) | |
| 14202 | ;; START NCC REMEDI ATION >> 3 27*RJS - n ext line | |
| 14203 | "RTN","PSG OEV",100,0 ) | |
| 14204 | D NEWJ^PS JADM,CLOZS ND^PSJOE | |
| 14205 | "RTN","PSG OEV",101,0 ) | |
| 14206 | ; **END o f Interfac e hook ** | |
| 14207 | "RTN","PSG OEV",102,0 ) | |
| 14208 | ; **END of Interfa ce hook ** | |
| 14209 | "RTN","PSG OEV",103,0 ) | |
| 14210 | D:+PSJSYS U=1 EN1^PS JHL2(PSGP, "ZV",+PSGO RD_"U") | |
| 14211 | "RTN","PSG OEV",104,0 ) | |
| 14212 | DONE ; | |
| 14213 | "RTN","PSG OEV",105,0 ) | |
| 14214 | W:CHK !!, "...order NOT verifi ed..." | |
| 14215 | "RTN","PSG OEV",106,0 ) | |
| 14216 | I '$D(PSJ SPEED),'CH K,+PSJSYSU =3,$G(PSJP RI)="D" D | |
| 14217 | "RTN","PSG OEV",107,0 ) | |
| 14218 | .N DIR W ! S DIR(0) ="S^Y:Yes; N:No",DIR( "A")="Do y ou want to enter a P rogress No te",DIR("B ")="No" D ^DIR | |
| 14219 | "RTN","PSG OEV",108,0 ) | |
| 14220 | .Q:Y="N" | |
| 14221 | "RTN","PSG OEV",109,0 ) | |
| 14222 | .D MAIN^T IUEDIT(3,. TIUDA,PSGP ,"","","", "",1) | |
| 14223 | "RTN","PSG OEV",110,0 ) | |
| 14224 | S VALMBCK ="Q" K CHK ,DA,DIE,F, DP,DR,ND,P SGAL,PSGOD A,PSGTOL,P SGTOO,PSGU OW,PSJDOSE ,PSJVAR,VN D4,X,ZZND Q | |
| 14225 | "RTN","PSG OEV",111,0 ) | |
| 14226 | ; | |
| 14227 | "RTN","PSG OEV",112,0 ) | |
| 14228 | LBL ; | |
| 14229 | "RTN","PSG OEV",113,0 ) | |
| 14230 | Q | |
| 14231 | "RTN","PSG OEV",114,0 ) | |
| 14232 | ; | |
| 14233 | "RTN","PSG OEV",115,0 ) | |
| 14234 | ALLERGY(PS GORD,PSJAL LGY) ;setu p PSJALLGY when non- vf was sel ected to v erify | |
| 14235 | "RTN","PSG OEV",116,0 ) | |
| 14236 | N PSGDDI, PSJDD,PSJX ,ARR | |
| 14237 | "RTN","PSG OEV",117,0 ) | |
| 14238 | I '+$G(PS GORD),($G( PSGORD)'[" P") Q | |
| 14239 | "RTN","PSG OEV",118,0 ) | |
| 14240 | D LIST^DI C(53.11,", "_+PSGORD_ ",",,"I",, ,,,,,"ARR" ) | |
| 14241 | "RTN","PSG OEV",119,0 ) | |
| 14242 | F I=1:1 Q :'$D(ARR(" DILIST",2, I)) S PSG DDI=ARR("D ILIST",2,I ) D | |
| 14243 | "RTN","PSG OEV",120,0 ) | |
| 14244 | . S PSJDD =+$$GET1^D IQ(53.11,P SGDDI_","_ +PSGORD,.0 1,"I") | |
| 14245 | "RTN","PSG OEV",121,0 ) | |
| 14246 | . S PSJX= $S('$L($$G ET1^DIQ(50 ,+PSJDD,.0 1)):1,$$GE T1^DIQ(50, +PSJDD,63, "I")'["U": 1,$$GET1^D IQ(50,+PSJ DD,100)="" :0,1:$$GET 1^DIQ(50,+ PSJDD,100, "I")'>$G(D T)) | |
| 14247 | "RTN","PSG OEV",122,0 ) | |
| 14248 | . Q:PSJX | |
| 14249 | "RTN","PSG OEV",123,0 ) | |
| 14250 | . S PSJAL LGY(PSJDD) ="" | |
| 14251 | "RTN","PSG OEV",124,0 ) | |
| 14252 | Q | |
| 14253 | "RTN","PSG OEV",125,0 ) | |
| 14254 | CHK(ND,DRG ,ND2) ; ch ecks for d ata in req uired fiel ds | |
| 14255 | "RTN","PSG OEV",126,0 ) | |
| 14256 | ; Input: ND - ^(PS (53.1,PSGO RD,0) | |
| 14257 | "RTN","PSG OEV",127,0 ) | |
| 14258 | ; DRG - ^(.2 ) | |
| 14259 | "RTN","PSG OEV",128,0 ) | |
| 14260 | ; ND2 - ^(2) | |
| 14261 | "RTN","PSG OEV",129,0 ) | |
| 14262 | S Y=$G(Y) | |
| 14263 | "RTN","PSG OEV",130,0 ) | |
| 14264 | S CHK="" I DRG,$D(^ PS(50.7,+D RG,0)) | |
| 14265 | "RTN","PSG OEV",131,0 ) | |
| 14266 | E S CHK= 1 | |
| 14267 | "RTN","PSG OEV",132,0 ) | |
| 14268 | I ND="" S CHK=CHK_2 3 | |
| 14269 | "RTN","PSG OEV",133,0 ) | |
| 14270 | E S CHK= CHK_$S($P( ND,"^",3): "",1:2)_$S ($P(ND,"^" ,7)]"":"", 1:3) | |
| 14271 | "RTN","PSG OEV",134,0 ) | |
| 14272 | ;The nake d referenc e on the l ine below refers to the variab le ND whic h is ^PS(5 3.1,PSGORD ,0). | |
| 14273 | "RTN","PSG OEV",135,0 ) | |
| 14274 | I ND2="" S CHK=CHK_ $S('$D(^(0 )):4,$P(^( 0),"^",7)= "OC":"",1: 4)_56 | |
| 14275 | "RTN","PSG OEV",136,0 ) | |
| 14276 | E S CHK= CHK_$S($P( ND2,"^")]" ":"",ND="" :4,$P(ND," ^",7)="OC" :"",1:4)_$ S($P(ND2," ^",2):"",1 :5)_$S($P( ND2,"^",4) :"",1:6) | |
| 14277 | "RTN","PSG OEV",137,0 ) | |
| 14278 | I $$CHECK ^PSGOE8(PS JSYSP),$P( DRG,U,2)=" " S CHK=CH K_8 | |
| 14279 | "RTN","PSG OEV",138,0 ) | |
| 14280 | K PSGDFLG ,PSGPFLG S PSGDI=0 | |
| 14281 | "RTN","PSG OEV",139,0 ) | |
| 14282 | S:'$$DDOK ^PSGOE2("^ PS(53.45," _PSJSYSP_" ,2,",+DRG) CHK=CHK_7 ,(PSGDFLG, PSGDI)=1 | |
| 14283 | "RTN","PSG OEV",140,0 ) | |
| 14284 | S:'$$OIOK ^PSGOE2(+D RG) PSGPFL G=1 | |
| 14285 | "RTN","PSG OEV",141,0 ) | |
| 14286 | I 'CHK,$G (PSGSCH)]" " D | |
| 14287 | "RTN","PSG OEV",142,0 ) | |
| 14288 | .N X,Y,PS GS0Y,PSGS0 XT,PSGOES S PSGOES=2 ,X=PSGSCH D ENOS^PSG S0 I $G(X) ="" S CHK= 4 | |
| 14289 | "RTN","PSG OEV",143,0 ) | |
| 14290 | Q:'CHK | |
| 14291 | "RTN","PSG OEV",144,0 ) | |
| 14292 | W $C(7) | |
| 14293 | "RTN","PSG OEV",145,0 ) | |
| 14294 | ; | |
| 14295 | "RTN","PSG OEV",146,0 ) | |
| 14296 | CHKM ; | |
| 14297 | "RTN","PSG OEV",147,0 ) | |
| 14298 | D FULL^VA LM1 K:CHK Y | |
| 14299 | "RTN","PSG OEV",148,0 ) | |
| 14300 | ; changed to remove ^DD ref | |
| 14301 | "RTN","PSG OEV",149,0 ) | |
| 14302 | ; PSJ*5*2 67 VMP Add the 8th c ondition | |
| 14303 | "RTN","PSG OEV",150,0 ) | |
| 14304 | W !!,"THE FOLLOWING ",$S($L(C HK)>1:"ARE ",1:"IS"), " EITHER I NVALID OR MISSING FR OM THIS OR DER:" F X= 1:1:8 W:CH K[X !?5,$P ("ORDERABL E ITEM^MED ROUTE^SCH EDULE TYPE ^SCHEDULE^ START DATE /TIME^STOP DATE/TIME ^DISPENSE DRUG^DOSAG E ORDERED" ,"^",X) | |
| 14305 | "RTN","PSG OEV",151,0 ) | |
| 14306 | I CHK=7 W !,"Orders with no d ispense dr ugs or mul tiple disp ense drugs ",!,"requi re dosage ordered" | |
| 14307 | "RTN","PSG OEV",152,0 ) | |
| 14308 | W:CHK]"" !!,$S($L(C HK)>1:"THE SE FIELDS ARE",1:"TH IS FIELD I S")," NECE SSARY FOR VERIFICATI ON." | |
| 14309 | "RTN","PSG OEV",153,0 ) | |
| 14310 | N DIR,DUO UT,DTOUT S DIR(0)="E " D ^DIR I $D(DUOUT) !$D(DTOUT) S CHK=1 Q | |
| 14311 | "RTN","PSG OEV",154,0 ) | |
| 14312 | Q | |
| 14313 | "RTN","PSG OEV",155,0 ) | |
| 14314 | ; | |
| 14315 | "RTN","PSG OEV",156,0 ) | |
| 14316 | CONT() ; | |
| 14317 | "RTN","PSG OEV",157,0 ) | |
| 14318 | NEW DIR,D IRUT,Y | |
| 14319 | "RTN","PSG OEV",158,0 ) | |
| 14320 | W ! K DIR ,DIRUT | |
| 14321 | "RTN","PSG OEV",159,0 ) | |
| 14322 | S DIR(0)= "Y",DIR("A ")="Would you like t o continue verifying the order ",DIR("B") ="No" | |
| 14323 | "RTN","PSG OEV",160,0 ) | |
| 14324 | D ^DIR | |
| 14325 | "RTN","PSG OEV",161,0 ) | |
| 14326 | Q Y | |
| 14327 | "RTN","PSG OEV",162,0 ) | |
| 14328 | ; | |
| 14329 | "RTN","PSG OEV",163,0 ) | |
| 14330 | DDCHK ; di spense dru g check | |
| 14331 | "RTN","PSG OEV",164,0 ) | |
| 14332 | S DRGF="^ PS("_$S(PS GORD["P":" 53.1,"_+PS GORD,1:"55 ,"_PSGP_", 5,"_+PSGOR D)_",",CHK =$S('$O(@( DRGF_"1,0) ")):7,1:0) | |
| 14333 | "RTN","PSG OEV",165,0 ) | |
| 14334 | S PSGPD=$ G(@(DRGF_" .2)")) | |
| 14335 | "RTN","PSG OEV",166,0 ) | |
| 14336 | S CHK=$S( '$$DDOK^PS GOE2(DRGF_ "1,",PSGPD ):7,1:0) | |
| 14337 | "RTN","PSG OEV",167,0 ) | |
| 14338 | Q:CHK=0 | |
| 14339 | "RTN","PSG OEV",168,0 ) | |
| 14340 | W $C(7),! !,"This or der must h ave at lea st one val id, active dispense drug to be verified. " | |
| 14341 | "RTN","PSG OEV",169,0 ) | |
| 14342 | ; | |
| 14343 | "RTN","PSG OEV",170,0 ) | |
| 14344 | DDEDIT ; | |
| 14345 | "RTN","PSG OEV",171,0 ) | |
| 14346 | ;*** Remo ve all dis pense drug for this order | |
| 14347 | "RTN","PSG OEV",172,0 ) | |
| 14348 | K @(DRGF_ "1)") | |
| 14349 | "RTN","PSG OEV",173,0 ) | |
| 14350 | ; The nak ed referen ce below r efers to t he indirec t full ref erence in DRGF_"1,"_ Q_")", whi ch is eith er ^PS(53. 1,+PSGORD, Q) or ^PS( 55,DFN,5,+ PSGORD,Q) | |
| 14351 | "RTN","PSG OEV",174,0 ) | |
| 14352 | K ^PS(53. 45,PSJSYSP ,2) S (X,Q )=0 F S Q =$O(@(DRGF _"1,"_Q_") ")) Q:'Q S Y=$G(^(Q ,0)),X=Q S ^PS(53.45 ,PSJSYSP,2 ,Q,0)=Y I Y S ^PS(53 .45,PSJSYS P,2,"B",+Y ,Q)="" | |
| 14353 | "RTN","PSG OEV",175,0 ) | |
| 14354 | I X S ^PS (53.45,PSJ SYSP,2,0)= "^53.4502P ^"_X_"^"_X | |
| 14355 | "RTN","PSG OEV",176,0 ) | |
| 14356 | D ENDRG^P SGOEF1(PSG PD,X) | |
| 14357 | "RTN","PSG OEV",177,0 ) | |
| 14358 | I 'CHK S %X="^PS(53 .45,"_PSJS YSP_",2,", %Y=DRGF_"1 ," D %XY^% RCR S $P(@ (DRGF_"1,0 )"),"^",2) =$S(DRGF[5 3.1:"53.11 P",1:"55.0 7P") | |
| 14359 | "RTN","PSG OEV",178,0 ) | |
| 14360 | K DRG,DRG F,%X,%Y,PS GPD Q | |
| 14361 | "RTN","PSG OEV",179,0 ) | |
| 14362 | ; | |
| 14363 | "RTN","PSG OEV",180,0 ) | |
| 14364 | AESCREEN() ; | |
| 14365 | "RTN","PSG OEV",181,0 ) | |
| 14366 | ; Output: 0 - Requi red fields missing a nd DON'T a llow accep t | |
| 14367 | "RTN","PSG OEV",182,0 ) | |
| 14368 | ; 1 - Requi red fields found. | |
| 14369 | "RTN","PSG OEV",183,0 ) | |
| 14370 | Q:'$G(CHK ) 1 | |
| 14371 | "RTN","PSG OEV",184,0 ) | |
| 14372 | S Y=$P($G (^ORD(101, +$G(^ORD(1 01,DA(1),1 0,DA,0)),0 )),U) I Y= "" Q 0 | |
| 14373 | "RTN","PSG OEV",185,0 ) | |
| 14374 | I Y="PSJU LM ACCEPT EDIT" Q 1 | |
| 14375 | "RTN","PSG OEV",186,0 ) | |
| 14376 | Q 0 | |
| 14377 | "RTN","PSG OEV",187,0 ) | |
| 14378 | ACTLOG(PSG ORDP,DFN,P SGORD) ;S tore 53.1 activity l og in loca l array to be moved to 55 | |
| 14379 | "RTN","PSG OEV",188,0 ) | |
| 14380 | ;PSGORDP: IEN from 53.1 | |
| 14381 | "RTN","PSG OEV",189,0 ) | |
| 14382 | ;PSGORD : IEN from 55 | |
| 14383 | "RTN","PSG OEV",190,0 ) | |
| 14384 | NEW PSGX, PSGXDA,PSG AL531,Q,QQ | |
| 14385 | "RTN","PSG OEV",191,0 ) | |
| 14386 | F PSGX=0: 0 S PSGX=$ O(^PS(53.1 ,+PSGORDP, "A",PSGX)) Q:'PSGX D | |
| 14387 | "RTN","PSG OEV",192,0 ) | |
| 14388 | . S PSGAL 531=$G(^PS (53.1,+PSG ORDP,"A",P SGX,0)) | |
| 14389 | "RTN","PSG OEV",193,0 ) | |
| 14390 | . S QQ=$G (^PS(55,DF N,5,+PSGOR D,9,0)) S: QQ="" QQ=" ^55.09D" F Q=$P(QQ,U ,3)+1:1 I '$D(^(Q)) S $P(QQ,U, 3,4)=Q_U_Q ,^(0)=QQ,P SGXDA=Q Q | |
| 14391 | "RTN","PSG OEV",194,0 ) | |
| 14392 | . S ^PS(5 5,DFN,5,+P SGORD,9,PS GXDA,0)=PS GAL531 | |
| 14393 | "RTN","PSG OEV",195,0 ) | |
| 14394 | . N TXTLN S TXTLN=" " F S TXT LN=$O(^PS( 53.1,+PSGO RDP,"A",PS GX,1,TXTLN )) Q:TXTLN ="" D | |
| 14395 | "RTN","PSG OEV",196,0 ) | |
| 14396 | .. I TXTL N=0 S ^PS( 55,DFN,5,+ PSGORD,9,P SGXDA,1,TX TLN)=^PS(5 3.1,+PSGOR DP,"A",PSG X,1,TXTLN) Q | |
| 14397 | "RTN","PSG OEV",197,0 ) | |
| 14398 | .. S ^PS( 55,DFN,5,+ PSGORD,9,P SGXDA,1,TX TLN,0)=^PS (53.1,+PSG ORDP,"A",P SGX,1,TXTL N,0) | |
| 14399 | "RTN","PSG OEV",198,0 ) | |
| 14400 | Q | |
| 14401 | "RTN","PSG ON") | |
| 14402 | 0^26^B4144 1741 | |
| 14403 | "RTN","PSG ON",1,0) | |
| 14404 | PSGON ;BIR /CML3-SELE CT ORDERS ;Jul 26, 2 017@18:04: 02 | |
| 14405 | "RTN","PSG ON",2,0) | |
| 14406 | ;;5.0;INP ATIENT MED ICATIONS ; **2,22,54, 327**;16 D EC 97;Buil d 64 | |
| 14407 | "RTN","PSG ON",3,0) | |
| 14408 | ENCHK ; | |
| 14409 | "RTN","PSG ON",4,0) | |
| 14410 | K PSGODDD S PSGODDD =1,PSGODDD (1)="" W:X ="-" " (A LL)" I X=" ALL"!(X="- ") S X="1- "_PSGLMT | |
| 14411 | "RTN","PSG ON",5,0) | |
| 14412 | E S:$E(X )="-" X=1_ X S:$E(X,$ L(X))="-" X=X_PSGLMT | |
| 14413 | "RTN","PSG ON",6,0) | |
| 14414 | F Q=1:1:$ L(X,",") S X1=$P(X," ,",Q) D SE T Q:'$D(X) | |
| 14415 | "RTN","PSG ON",7,0) | |
| 14416 | Q | |
| 14417 | "RTN","PSG ON",8,0) | |
| 14418 | ; | |
| 14419 | "RTN","PSG ON",9,0) | |
| 14420 | SET ; | |
| 14421 | "RTN","PSG ON",10,0) | |
| 14422 | I $S(X1>P SGLMT:1,X1 <1:1,X1?.N :0,1:X1'?1 .N1"-"1.N) K X Q | |
| 14423 | "RTN","PSG ON",11,0) | |
| 14424 | I X1'["-" S X2=X1 G SET1 | |
| 14425 | "RTN","PSG ON",12,0) | |
| 14426 | F X2=$P(X 1,"-"):1:$ P(X1,"-",2 ) D SET1 Q :'$D(X) | |
| 14427 | "RTN","PSG ON",13,0) | |
| 14428 | Q | |
| 14429 | "RTN","PSG ON",14,0) | |
| 14430 | ; | |
| 14431 | "RTN","PSG ON",15,0) | |
| 14432 | SET1 ; | |
| 14433 | "RTN","PSG ON",16,0) | |
| 14434 | S X2=+X2 I $S(X2<1: 1,X2>PSGLM T:1,$D(PSG EFN):'$D(P SGEFN(X2)) ,1:0) K X Q | |
| 14435 | "RTN","PSG ON",17,0) | |
| 14436 | I PSGODDD (PSGODDD) F QQ=+$G(P SGOESF):1: PSGODDD I ","_$G(PSG ODDD(QQ))[ (","_X2_", ") Q | |
| 14437 | "RTN","PSG ON",18,0) | |
| 14438 | I Q | |
| 14439 | "RTN","PSG ON",19,0) | |
| 14440 | I $L(PSGO DDD(PSGODD D))+$L(X2) >244 S PSG ODDD=PSGOD DD+1,PSGOD DD(PSGODDD )="" | |
| 14441 | "RTN","PSG ON",20,0) | |
| 14442 | S PSGODDD (PSGODDD)= PSGODDD(PS GODDD)_X2_ "," ;Q | |
| 14443 | "RTN","PSG ON",21,0) | |
| 14444 | Q | |
| 14445 | "RTN","PSG ON",22,0) | |
| 14446 | ; | |
| 14447 | "RTN","PSG ON",23,0) | |
| 14448 | ENASR ; ac tion/selec t read | |
| 14449 | "RTN","PSG ON",24,0) | |
| 14450 | ;S ACTION =$S($D(PSG PRF):0,PSG ONC:1,PSGO NV:1,$G(PS GONF):1,1: PSGONR>0) | |
| 14451 | "RTN","PSG ON",25,0) | |
| 14452 | S ACTION= 0 | |
| 14453 | "RTN","PSG ON",26,0) | |
| 14454 | RD1 ;W !!, $S($D(PSGP RF):"View" ,1:"Select "),$S(ACTI ON:" ACTIO N or",1:"" )," ORDER" ,$S(PSGLMT >1:"S (1-" _PSGLMT,1: " (1"),"): " R X:DTI ME W:'$T $ C(7) S:'$T X="^" I " ^"[X K ACT ION Q | |
| 14455 | "RTN","PSG ON",27,0) | |
| 14456 | W !!,$S($ D(PSGPRF): "View",1:" Select"),$ S(ACTION:" ACTION or ",1:"")," ORDER",$S( PSGLMT>1:" S (1-"_PSG LMT,1:" (1 "),"): " R X:DTIME W :'$T $C(7) S:'$T X=" ^" I X["^" K ACTION S X="^" Q | |
| 14457 | "RTN","PSG ON",28,0) | |
| 14458 | I X="" K ACTION Q | |
| 14459 | "RTN","PSG ON",29,0) | |
| 14460 | I X="DC", ACTION,PSG ONC W " ( DISCONTINU E)" S X="D " Q | |
| 14461 | "RTN","PSG ON",30,0) | |
| 14462 | I X="DC" W $C(7)," ??" G RD1 | |
| 14463 | "RTN","PSG ON",31,0) | |
| 14464 | I $P("DIS CONTINUE", X)="",ACTI ON,PSGONC W $P("DISC ONTINUE",X ,2) S X="D " Q | |
| 14465 | "RTN","PSG ON",32,0) | |
| 14466 | I $P("DIS CONTINUE", X)="" W $C (7)," ??" G RD1 | |
| 14467 | "RTN","PSG ON",33,0) | |
| 14468 | I $P("REN EW",X)="", ACTION,PSG ONR W $P(" RENEW",X,2 ) S X="R" Q | |
| 14469 | "RTN","PSG ON",34,0) | |
| 14470 | I $P("REN EW",X)="" W $C(7)," ??" G RD1 | |
| 14471 | "RTN","PSG ON",35,0) | |
| 14472 | I $P("VER IFY",X)="" ,ACTION,PS GONV W $P( "VERIFY",X ,2) S X="V " Q | |
| 14473 | "RTN","PSG ON",36,0) | |
| 14474 | I $P("VER IFY",X)="" W $C(7)," ??" G RD 1 | |
| 14475 | "RTN","PSG ON",37,0) | |
| 14476 | I $P("FIN ISH",X)="" ,ACTION,$G (PSGONF) W $P("FINIS H",X,2) S X="F" Q | |
| 14477 | "RTN","PSG ON",38,0) | |
| 14478 | I $P("FIN ISH",X)="" W $C(7)," ??" G RD1 | |
| 14479 | "RTN","PSG ON",39,0) | |
| 14480 | I $S(X="A LL":1,X["- ":1,1:X) D ENCHK Q:$ D(X) W $C (7)," ??" G RD1 | |
| 14481 | "RTN","PSG ON",40,0) | |
| 14482 | I X?1."?" D H1 G RD 1 | |
| 14483 | "RTN","PSG ON",41,0) | |
| 14484 | W $C(7)," ??" G RD 1 | |
| 14485 | "RTN","PSG ON",42,0) | |
| 14486 | ; | |
| 14487 | "RTN","PSG ON",43,0) | |
| 14488 | H1 ; | |
| 14489 | "RTN","PSG ON",44,0) | |
| 14490 | D FULL^VA LM1 W !!?2 I ACTION D | |
| 14491 | "RTN","PSG ON",45,0) | |
| 14492 | .W "Selec t ACTION t o take on order",$E( "s",PSGONR >1!(PSGONC >1)!(PSGON V>1)!($G(P SGONF)>1)) ,!,". Sele ct -",! W: PSGONC ?9, "D for DIS CONTINUE", ! W:PSGONR ?9,"R for RENEW",! W:PSGONV ? 9,"V for V ERIFY",! W :$G(PSGONF ) ?9,"F fo r FINISH", ! | |
| 14493 | "RTN","PSG ON",46,0) | |
| 14494 | W !,"Sele ct ORDER", $S(PSGLMT> 1:"S (1-"_ PSGLMT,1:" (1"),") t o view",$S ('$D(PSGPR F):" and/o r on which to take a ction",1:" "),"." D:X ?2."?" H2 | |
| 14495 | "RTN","PSG ON",47,0) | |
| 14496 | N DIR S D IR(0)="E" D ^DIR I $ D(VALM("LI NES")) D R E^VALM4 | |
| 14497 | "RTN","PSG ON",48,0) | |
| 14498 | Q | |
| 14499 | "RTN","PSG ON",49,0) | |
| 14500 | ; | |
| 14501 | "RTN","PSG ON",50,0) | |
| 14502 | ENWO ; whi ch orders | |
| 14503 | "RTN","PSG ON",51,0) | |
| 14504 | S PSGLMT= $S(PSGONW= "R":PSGONR ,PSGONW="V ":PSGONV,1 :PSGONC) | |
| 14505 | "RTN","PSG ON",52,0) | |
| 14506 | RDW ; | |
| 14507 | "RTN","PSG ON",53,0) | |
| 14508 | W !!,$S(P SGONW="V": "VERIFY wh ich orders ",PSGONW=" R":$S($P(P SJSYSP0,"^ ",3):"RENE W which or ders",1:"M ARK which orders for RENEWAL") ,1:$S($P(P SJSYSP0,"^ ",5):"DISC ONTINUE wh ich orders ",1:"MARK which orde rs for DIS CONTINUATI ON"))," (1 -",PSGLMT, "): " | |
| 14509 | "RTN","PSG ON",54,0) | |
| 14510 | R X:DTIME W:'$T $C( 7) S:'$T X ="^" I "^" [X Q | |
| 14511 | "RTN","PSG ON",55,0) | |
| 14512 | ;/RJS Beg in modific ations for PSJ*5.0*3 27 | |
| 14513 | "RTN","PSG ON",56,0) | |
| 14514 | I $$GET1^ DIQ(50,$G( PSJBLOOP), 17.5)="PSO CLO1" D Q | |
| 14515 | "RTN","PSG ON",57,0) | |
| 14516 | .W !,"Clo zapine ord ers cannot be renewe d." | |
| 14517 | "RTN","PSG ON",58,0) | |
| 14518 | .W !,"No order ente red!" | |
| 14519 | "RTN","PSG ON",59,0) | |
| 14520 | .D PAUSE^ VALM1 | |
| 14521 | "RTN","PSG ON",60,0) | |
| 14522 | ;/RJS End modificat ions for P SJ*5.0*327 | |
| 14523 | "RTN","PSG ON",61,0) | |
| 14524 | I X?1."?" W !!?2,"S elect orde r",$E("s", PSGLMT>1), " to ",$S( PSGONW="V" :"verify", PSGONW="R" :$S($P(PSJ SYSP0,"^", 3):"renew. ",1:"mark for renewa l."),1:$S( $P(PSJSYSP 0,"^",5):" discontinu e.",1:"mar k for disc ontinuatio n.")) D:X? 2."?" H2 G RDW | |
| 14525 | "RTN","PSG ON",62,0) | |
| 14526 | D ENCHK I '$D(X) W $C(7)," ? ?" G RDW | |
| 14527 | "RTN","PSG ON",63,0) | |
| 14528 | Q | |
| 14529 | "RTN","PSG ON",64,0) | |
| 14530 | ; | |
| 14531 | "RTN","PSG ON",65,0) | |
| 14532 | H2 ; | |
| 14533 | "RTN","PSG ON",66,0) | |
| 14534 | N X S X=$ S($D(PSGEF N):"field" ,1:"order" ) W !!?2," Select ",X ,"s either singularl y separate d by comma s (1,2,3), by a rang e of",!,X, "s separat ed by a da sh (1-3), or a combi nation (1, 2,4-6). T o select a ll" | |
| 14535 | "RTN","PSG ON",67,0) | |
| 14536 | W !,X,"s, enter 'AL L' or a da sh ('-'). You can a lso enter '-n' to se lect the" | |
| 14537 | "RTN","PSG ON",68,0) | |
| 14538 | W !,"firs t ",X," th rough the 'nth' ",X, " or enter 'n-' to s elect the 'nth' ",X, !,"through the last ",X,". If an ",X," is selecte d more tha n once, on ly the fir st",!,"sel ection is used (Ente ring '1,2, 1' would r eturn '1,2 '.)." | |
| 14539 | "RTN","PSG ON",69,0) | |
| 14540 | W:$D(PSGE FN) !!,?2, "Fields nu mbers are as follows :" | |
| 14541 | "RTN","PSG ON",70,0) | |
| 14542 | I '$D(P(" PON")) D | |
| 14543 | "RTN","PSG ON",71,0) | |
| 14544 | .Q:'$D(PS GEFN) | |
| 14545 | "RTN","PSG ON",72,0) | |
| 14546 | .N PS S P S=$S($G(PS JORD)["P": 1,$G(PSJOR D)["U":2,1 :2) | |
| 14547 | "RTN","PSG ON",73,0) | |
| 14548 | .W !?3,"* (1) Ordera ble Item", !,?3,$S(PS =1:" ",PS= 2:"*"),"(2 ) Dosage O rdered" | |
| 14549 | "RTN","PSG ON",74,0) | |
| 14550 | .W !?3,$S (PS=1:" ", PS=2:"*"), "(3) Start ",!?3,"*(4 ) Med Rout e",!?3,$S( PS=1:" ",P S=2:"*")," (5) Stop" | |
| 14551 | "RTN","PSG ON",75,0) | |
| 14552 | .W !?3," (6) Schedu le Type",! ?3," (7) S elf Med",! ?3,"*(8) S chedule" | |
| 14553 | "RTN","PSG ON",76,0) | |
| 14554 | .W !?3," (9) Admin Times",!?3 ,"*(10) Pr ovider",!? 3," (11) S pecial " | |
| 14555 | "RTN","PSG ON",77,0) | |
| 14556 | .W "Instr uctions",! ?3," (12) Dispense D rug" | |
| 14557 | "RTN","PSG ON",78,0) | |
| 14558 | E D | |
| 14559 | "RTN","PSG ON",79,0) | |
| 14560 | .Q:'$D(PS GEFN) | |
| 14561 | "RTN","PSG ON",80,0) | |
| 14562 | .N PS S P S=$S($G(PS JORD)["P": 1,$G(PSJOR D)["V":2,1 :2) | |
| 14563 | "RTN","PSG ON",81,0) | |
| 14564 | .W !?3,$S ($G(P("OT" ))="F":"*" ,PS=1:" ", PS=2:"*"), "(1) Addit ives",!?3, $S($G(P("O T"))="F":" *",P(4)="P ":" ",PS=1 :" ",PS=2: "*"),"(2) Solutions" ,!?3,$S(P( 4)="P":" " ,PS=1:" ", PS=2:"*"), "(3) Infus ion Rate" | |
| 14565 | "RTN","PSG ON",82,0) | |
| 14566 | .W !?3,$S (PS=1:" ", PS=2:"*"), "(4) Start ",!?3,"*(5 ) Med Rout e",!?3,$S( PS=1:" ",P S=2:"*")," (6) Stop" | |
| 14567 | "RTN","PSG ON",83,0) | |
| 14568 | .W !?3,"* (7) Schedu le",!?3," (8) Admin Times",!?3 ,"*(9) Pro vider" | |
| 14569 | "RTN","PSG ON",84,0) | |
| 14570 | .I $G(P(4 ))="P"!($G (P("DTYP") )=0) D | |
| 14571 | "RTN","PSG ON",85,0) | |
| 14572 | ..W !?3," *(10) Orde rable Item ",!?3," (1 1) Other P rint",!?3, " (12) Rem arks" | |
| 14573 | "RTN","PSG ON",86,0) | |
| 14574 | .E W !?3 ," (10) Ot her Print" ,!?3," (11 ) Remarks" | |
| 14575 | "RTN","PSG ON",87,0) | |
| 14576 | W ! K DIR S DIR(0)= "E" D ^DIR K DIR | |
| 14577 | "RTN","PSG ON",88,0) | |
| 14578 | Q | |
| 14579 | "RTN","PSG ON",89,0) | |
| 14580 | ; | |
| 14581 | "RTN","PSG ON",90,0) | |
| 14582 | ENEFA ; | |
| 14583 | "RTN","PSG ON",91,0) | |
| 14584 | N Q,X1,X2 I '$D(PSG EFN) K Y S Y="" Q | |
| 14585 | "RTN","PSG ON",92,0) | |
| 14586 | ; | |
| 14587 | "RTN","PSG ON",93,0) | |
| 14588 | EFA ; | |
| 14589 | "RTN","PSG ON",94,0) | |
| 14590 | K Y S Y=" " R !!,"Se lect FIELD S TO EDIT: ",X:DTIME E W $C(7 ) S X="^" Q | |
| 14591 | "RTN","PSG ON",95,0) | |
| 14592 | I "^"[X Q | |
| 14593 | "RTN","PSG ON",96,0) | |
| 14594 | ;I X?1."? " D:$D(P(" PON")) H2, @("DISPLAY ^PSJLIFN") D:'$D(P(" PON")) FUL L^VALM1,EF H G EFA | |
| 14595 | "RTN","PSG ON",97,0) | |
| 14596 | I X="??"& ('$D(P("PO N"))) D FU LL^VALM1,H 2 G EFA | |
| 14597 | "RTN","PSG ON",98,0) | |
| 14598 | I X?1."?" D FULL^VA LM1 D:'$D( P("PON")) EFH D:$D(P ("PON")) H 2,@("DISPL AY^PSJLIFN ") G EFA | |
| 14599 | "RTN","PSG ON",99,0) | |
| 14600 | ;* I X?1. "?" D EFH D:X?2."?" H2,READ^PS JUTL,@($S( '$D(PSJDTY P):"ENW^PS GOEEW",PSJ DTYP="OU": "ENW^PSJOE EW",PSJDTY P="O":"^PS IVORV1",1: "EN^PSIVOR V2")) G EF A | |
| 14601 | "RTN","PSG ON",100,0) | |
| 14602 | I X="-"!( $P("ALL",X )="") W $S (X="-":" (ALL)",1:$ P("ALL",X, 2)) F Q=0: 0 S Q=$O(P SGEFN(Q)) Q:'Q S Y= Y_Q_"," | |
| 14603 | "RTN","PSG ON",101,0) | |
| 14604 | I G FDON E | |
| 14605 | "RTN","PSG ON",102,0) | |
| 14606 | S:$E(X)=" -" X=+PSGE FN_X S:$E( $L(X))="-" X=X_$P(PS GEFN,":",2 ) | |
| 14607 | "RTN","PSG ON",103,0) | |
| 14608 | F Q=1:1:$ L(X,",") S X1=$P(X," ,",Q) D FS Q:'$D(X) | |
| 14609 | "RTN","PSG ON",104,0) | |
| 14610 | I '$D(X) W $C(7)," ??" G EFA | |
| 14611 | "RTN","PSG ON",105,0) | |
| 14612 | ; | |
| 14613 | "RTN","PSG ON",106,0) | |
| 14614 | FDONE ; | |
| 14615 | "RTN","PSG ON",107,0) | |
| 14616 | I '$D(Y) W $C(7)," ??" G EFA | |
| 14617 | "RTN","PSG ON",108,0) | |
| 14618 | S:Y Y=$E( Y,1,$L(Y)- 1) Q | |
| 14619 | "RTN","PSG ON",109,0) | |
| 14620 | ; | |
| 14621 | "RTN","PSG ON",110,0) | |
| 14622 | FS ; | |
| 14623 | "RTN","PSG ON",111,0) | |
| 14624 | I $S(X1?1 .N1"-"1.N: 0,X1'?1.N: 1,'$D(PSGE FN(X1)):1, 1:","_Y[X1 ) K X Q | |
| 14625 | "RTN","PSG ON",112,0) | |
| 14626 | I X1'["-" S Y=Y_X1_ "," Q | |
| 14627 | "RTN","PSG ON",113,0) | |
| 14628 | S X2=+X1, Y=Y_X2_"," F S X2=$ O(PSGEFN(X 2)) K:$S(X ="":1,","_ Y[X2:1,1:X 2>$P(X1,"- ",2)) Y Q: '$D(Y) S Y=Y_X2_"," Q:X2=$P(X 1,"-",2) | |
| 14629 | "RTN","PSG ON",114,0) | |
| 14630 | Q | |
| 14631 | "RTN","PSG ON",115,0) | |
| 14632 | ENEFA2 ; | |
| 14633 | "RTN","PSG ON",116,0) | |
| 14634 | I '$D(PSG EFN) K Y S Y="" Q | |
| 14635 | "RTN","PSG ON",117,0) | |
| 14636 | S Y=$P(XQ ORNOD(0)," =",2) | |
| 14637 | "RTN","PSG ON",118,0) | |
| 14638 | ; wasn't handling " 0#" correc tly, will strip off a leading zero on 1- 9 | |
| 14639 | "RTN","PSG ON",119,0) | |
| 14640 | N Q,X1 F Q=1:1:$L(Y ,",") S X1 =$P(Y,",", Q) D | |
| 14641 | "RTN","PSG ON",120,0) | |
| 14642 | .I X1?1"0 "1.2N S $P (Y,",",Q)= +X1 | |
| 14643 | "RTN","PSG ON",121,0) | |
| 14644 | Q | |
| 14645 | "RTN","PSG ON",122,0) | |
| 14646 | ; | |
| 14647 | "RTN","PSG ON",123,0) | |
| 14648 | EFH ; | |
| 14649 | "RTN","PSG ON",124,0) | |
| 14650 | W !!?2,"S elect the fields you wish to e dit, by nu mber. Onl y those fi elds with a",!,"numb er to the left of th e field na me are edi table." | |
| 14651 | "RTN","PSG ON",125,0) | |
| 14652 | Q | |
| 14653 | "RTN","PSG OT") | |
| 14654 | 0^19^B2768 7479 | |
| 14655 | "RTN","PSG OT",1,0) | |
| 14656 | PSGOT ;BIR /CML3-TRAN SFERS DATA FROM 53.1 TO 55 ;Ju l 26, 2017 @18:04:02 | |
| 14657 | "RTN","PSG OT",2,0) | |
| 14658 | ;;5.0;INP ATIENT MED ICATIONS;* *13,68,90, 110,173,13 4,161,254, 267,257,31 5,327**;16 DEC 97;Bu ild 64 | |
| 14659 | "RTN","PSG OT",3,0) | |
| 14660 | ; | |
| 14661 | "RTN","PSG OT",4,0) | |
| 14662 | ; Referen ce to ^PS( 55 support ed by DBIA 2191. | |
| 14663 | "RTN","PSG OT",5,0) | |
| 14664 | ; Referen ce to ^PSU HL support ed by DBIA 4803. | |
| 14665 | "RTN","PSG OT",6,0) | |
| 14666 | ; | |
| 14667 | "RTN","PSG OT",7,0) | |
| 14668 | START ; ge t internal record nu mber, lock record, a nd write | |
| 14669 | "RTN","PSG OT",8,0) | |
| 14670 | S ODA=+PS GORD S:$D( ^PS(55,PSG P,0))[0 ^( 0)=PSGP,^P S(55,"B",P SGP,PSGP)= "",$P(^PS( 55,0),U,3, 4)=PSGP_U_ ($P($G(^PS (55,0)),U, 4)+1) F L +^PS(55,P SGP,5,0):$ S($G(DILOC KTM)>0:DIL OCKTM,1:3) I Q | |
| 14671 | "RTN","PSG OT",9,0) | |
| 14672 | S ZND=$G( ^PS(55,PSG P,5,0)) S: ZND="" ZND ="^55.06IA " F DA=$P( ZND,"^",3) +1:1 I '$D (^PS(55,PS GP,5,DA)), '$D(^("B", DA)) L +^P S(55,PSGP, 5,DA):$S($ G(DILOCKTM )>0:DILOCK TM,1:3) I S $P(ZND, "^",3)=DA, $P(ZND,"^" ,4)=$P(ZND ,"^",4)+1, ^PS(55,PSG P,5,0)=ZND Q | |
| 14673 | "RTN","PSG OT",10,0) | |
| 14674 | L -^PS(55 ,PSGP,5,0) S ND0=^PS (53.1,ODA, 0),$P(ND0, "^",23)=PS JPWD,^PS(5 5,PSGP,5,D A,0)=ND0 | |
| 14675 | "RTN","PSG OT",11,0) | |
| 14676 | S (ND1,^P S(55,PSGP, 5,DA,.2))= $G(^PS(53. 1,ODA,.2)) ,^PS(55,PS GP,5,DA,.3 )=$G(^PS(5 3.1,ODA,.3 )),(ND2,^P S(55,PSGP, 5,DA,2))=^ PS(53.1,OD A,2) | |
| 14677 | "RTN","PSG OT",12,0) | |
| 14678 | S (ND2P1, ^PS(55,PSG P,5,DA,2.1 ))=$G(^PS( 53.1,ODA,2 .1)),^PS(5 5,PSGP,5,D A,4)=$G(^P S(53.1,ODA ,4)),^PS(5 5,"AUD",+$ P(ND2,"^", 4),PSGP,DA )="" | |
| 14679 | "RTN","PSG OT",13,0) | |
| 14680 | ;S (ND1,^ PS(55,PSGP ,5,DA,.2)) =$G(^PS(53 .1,ODA,.2) ),^PS(55,P SGP,5,DA,. 3)=$G(^PS( 53.1,ODA,. 3)),(ND2,^ PS(55,PSGP ,5,DA,2))= ^PS(53.1,O DA,2),(ND2 P1,^PS(55, PSGP,5,DA, 2.1))=$G(^ PS(53.1,OD A,2.1)) ;* 315 DRP | |
| 14681 | "RTN","PSG OT",14,0) | |
| 14682 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 14683 | "RTN","PSG OT",15,0) | |
| 14684 | I '$G(PSG DRG) N PSG DRG D | |
| 14685 | "RTN","PSG OT",16,0) | |
| 14686 | .N ORIFN, CLOZFLG S ORIFN=+$$G ET1^DIQ(55 .06,DA_"," _PSGP,66) I ORIFN D | |
| 14687 | "RTN","PSG OT",17,0) | |
| 14688 | ..N PSGPT R S PSGPTR =$$FIND1^D IC(100.045 ,","_ORIFN _",","X"," DRUG","ID" ) Q:'PSGPT R | |
| 14689 | "RTN","PSG OT",18,0) | |
| 14690 | ..S PSGDR G=$$GET1^D IQ(100.045 ,PSGPTR_", "_ORIFN,1, "I") | |
| 14691 | "RTN","PSG OT",19,0) | |
| 14692 | I $G(PSGD RG),$$GET1 ^DIQ(50,PS GDRG,17.5) ="PSOCLO1" S CLOZFLG =1 | |
| 14693 | "RTN","PSG OT",20,0) | |
| 14694 | I $G(CLOZ FLG) D | |
| 14695 | "RTN","PSG OT",21,0) | |
| 14696 | .I '$D(^T MP("PSJCOM ",$J,ODA," SAND")),$G (PSOSAND) S ^TMP("PS JCOM",$J,O DA,"SAND") =PSOSAND | |
| 14697 | "RTN","PSG OT",22,0) | |
| 14698 | .N DIE,DR S DIE="^P S(55,"_PSG P_",5,",DA (0)=PSGP,D R="301//// "_$G(^TMP( "PSJCOM",$ J,ODA,"SAN D")) D ^DI E | |
| 14699 | "RTN","PSG OT",23,0) | |
| 14700 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 14701 | "RTN","PSG OT",24,0) | |
| 14702 | S ^PS(55, PSGP,5,DA, 4)=$G(^PS( 53.1,ODA,4 )),^PS(55, "AUD",+$P( ND2,"^",4) ,PSGP,DA)= "" | |
| 14703 | "RTN","PSG OT",25,0) | |
| 14704 | S X=^PS(5 5,PSGP,0) I $P(X,"^" ,7)="" S $ P(X,"^",7) =$P($P(ND0 ,"^",16)," ."),$P(X," ^",8)="A", ^(0)=X D L OGDFN^PSUH L(PSGP) | |
| 14705 | "RTN","PSG OT",26,0) | |
| 14706 | I $P($G(^ PS(55,PSGP ,5,DA,2)), "^",6)="" S $P(^PS(5 5,PSGP,5,D A,2),"^",6 )=$S($G(PS GS0XT)'="" :PSGS0XT,$ P($G(ZZND) ,"^",3)'=" ":$P(ZZND, "^",3),1:" "),$P(^PS( 53.1,ODA,2 ),"^",6)=$ P(^PS(55,P SGP,5,DA,2 ),"^",6) | |
| 14707 | "RTN","PSG OT",27,0) | |
| 14708 | F X=6,7,1 3 I $D(^PS (53.1,ODA, X)) S ^PS( 55,PSGP,5, DA,X)=^(X) | |
| 14709 | "RTN","PSG OT",28,0) | |
| 14710 | I $D(^PS( 53.1,ODA," DSS")) S ^ PS(55,PSGP ,5,DA,8)=^ ("DSS") D CIMOU^PSJI MO1(PSGP,D A,"",ODA) | |
| 14711 | "RTN","PSG OT",29,0) | |
| 14712 | I $O(^PS( 53.1,ODA,1 ,0)) S (C, X)=0 F S X=$O(^PS(5 3.1,ODA,1, X)) Q:'X S:$D(^(X,0 )) C=C+1,^ PS(55,PSGP ,5,DA,1,C, 0)=^(0),^P S(55,PSGP, 5,DA,1,"B" ,+$P($G(^( 0)),U),C)= "" | |
| 14713 | "RTN","PSG OT",30,0) | |
| 14714 | I $O(^PS( 53.1,ODA,1 ,0)) S ^PS (55,PSGP,5 ,DA,1,0)=" ^55.07P^"_ C_"^"_C | |
| 14715 | "RTN","PSG OT",31,0) | |
| 14716 | F X=3,12 D S ^PS(5 5,PSGP,5,D A,X,0)="^5 5.0"_$S(X= 3:8,1:612) _U_CNT_U_C NT | |
| 14717 | "RTN","PSG OT",32,0) | |
| 14718 | .S CNT=0 F C=0:0 S C=$O(^PS(5 3.1,ODA,X, C)) Q:'C I $D(^(C,0 )) S ^PS(5 5,PSGP,5,D A,X,C,0)=^ (0),CNT=CN T+1 | |
| 14719 | "RTN","PSG OT",33,0) | |
| 14720 | S $P(^PS( 53.1,ODA,0 ),"^",19)= DA | |
| 14721 | "RTN","PSG OT",34,0) | |
| 14722 | D SETUDIN T^PSGSICH1 (ODA_"P",D A_"U") | |
| 14723 | "RTN","PSG OT",35,0) | |
| 14724 | CR ; set x -refs | |
| 14725 | "RTN","PSG OT",36,0) | |
| 14726 | N A | |
| 14727 | "RTN","PSG OT",37,0) | |
| 14728 | I $D(^PS( 55,PSGP,5. 1)),$P(^(5 .1),"^",6) S X=$P(^( 5.1),"^",6 ) I $P(ND2 ,"^",3),$P (ND2,"^",6 )'>X S $P( ^(5.1),"^" ,6)=$P(ND2 ,"^",3) | |
| 14729 | "RTN","PSG OT",38,0) | |
| 14730 | S ^PS(55, PSGP,5,"B" ,+ODA,DA)= "",^PS(55, PSGP,5,"AU ",$P(ND0," ^",7),+$P( ND2,"^",4) ,DA)="" | |
| 14731 | "RTN","PSG OT",39,0) | |
| 14732 | S ^PS(55, PSGP,5,"AU S",+$P(ND2 ,"^",4),DA )="" | |
| 14733 | "RTN","PSG OT",40,0) | |
| 14734 | S ^PS(55, PSGP,5,"C" ,+ND1,DA)= "",^PS(55, "AUE",PSGP ,DA)="" | |
| 14735 | "RTN","PSG OT",41,0) | |
| 14736 | S ^PS(55, "AUDS",+$P (ND2,"^",2 ),PSGP,DA) ="" | |
| 14737 | "RTN","PSG OT",42,0) | |
| 14738 | I $D(^PS( 55,PSGP,5, DA,8)) S A =^(8),^PS( 55,"AUDC", +$P(ND2,"^ ",4),+A,PS GP,DA)="" | |
| 14739 | "RTN","PSG OT",43,0) | |
| 14740 | I $$PATCH ^XPDUTL("P XRM*1.5*12 ") S X(1)= +$P(ND2,"^ ",2),X(2)= +$P(ND2,"^ ",4),DA(1) =PSGP D SP SPA^PSJXRF S(.X,.DA," UD") | |
| 14741 | "RTN","PSG OT",44,0) | |
| 14742 | K DIK S D A(1)=PSGP S DIK="^PS (55,"_DA(1 )_",5,",DI K(1)=125 D EN1^DIK K DIK | |
| 14743 | "RTN","PSG OT",45,0) | |
| 14744 | S PSGTOL= 2,PSGTOO=1 F PSGUOW= 0:0 S PSGU OW=$O(^PS( 53.41,2,1, PSGUOW)) Q :'PSGUOW I $D(^(PSG UOW,1,PSGP ,1,2,1,+OD A)) K ^(+O DA) D ENL^ PSGVDS | |
| 14745 | "RTN","PSG OT",46,0) | |
| 14746 | DONE I $D( PSGOE2),PS GOE2]"",$D (^TMP("PSJ ON",$J,PSG OE2)) S ^( PSGOE2)=DA _"U" | |
| 14747 | "RTN","PSG OT",47,0) | |
| 14748 | N PSJTMPT X,PSJOVRMX ,PSJTMPLIN | |
| 14749 | "RTN","PSG OT",48,0) | |
| 14750 | S PSGODA= ODA,PSGORD =DA_"U" | |
| 14751 | "RTN","PSG OT",49,0) | |
| 14752 | S PSGNODE =$G(^PS(55 ,PSGP,5,DA ,0)),PSG25 =$P(PSGNOD E,"^",25), PSG26=$P(P SGNODE,"^" ,26) | |
| 14753 | "RTN","PSG OT",50,0) | |
| 14754 | I PSG25 S X=$S(PSG2 5["V":"^PS (55,"_PSGP _",""IV"", ",PSG25["U "!(PSG25[" A"):"^PS(5 5,"_PSGP_" ,5,",1:"^P S(53.1,")_ +PSG25_"," _$E("02",P SG25["V"+1 )_")" I $D (@X) S $P( @X,"^",$S( PSG25["V": 6,1:26))=D A_"U" | |
| 14755 | "RTN","PSG OT",51,0) | |
| 14756 | I $P(PSGN ODE,"^",26 ),$P(PSGNO DE,"^",26) '["V",$D(^ PS(55,PSGP ,5,+$P(PSG NODE,"^",2 6),0)) S $ P(^(0),"^" ,25)=DA_"U " | |
| 14757 | "RTN","PSG OT",52,0) | |
| 14758 | F Q=0:0 S Q=$O(^PS( 53.44,Q)) Q:'Q I $D (^(Q,1,PSG P,+ODA,0)) S $P(^(0) ,"^",2)=DA | |
| 14759 | "RTN","PSG OT",53,0) | |
| 14760 | I $D(^PS( 53.1,+ODA, 15,0)) S ^ PS(55,PSGP ,5,DA,15,0 )="^55.613 5^"_$P($G( ^PS(53.1,+ ODA,15,0)) ,"^",3)_"^ "_$P($G(^P S(53.1,+OD A,15,0))," ^",4) D | |
| 14761 | "RTN","PSG OT",54,0) | |
| 14762 | .N LN,LNC NT,SIMSG S SIMSG="In structions too long. See Order View or B CMA for fu ll text." | |
| 14763 | "RTN","PSG OT",55,0) | |
| 14764 | .S LNCNT= 0,LN=9999 F S LN=$O (^PS(53.1, +ODA,15,LN ),-1) Q:'L N D | |
| 14765 | "RTN","PSG OT",56,0) | |
| 14766 | ..I 'LNCN T,($G(^PS( 53.1,+ODA, 15,LN,0))= "") Q | |
| 14767 | "RTN","PSG OT",57,0) | |
| 14768 | ..S ^PS(5 5,PSGP,5,D A,15,LN,0) =^PS(53.1, +ODA,15,LN ,0) S LNCN T=LNCNT+1 | |
| 14769 | "RTN","PSG OT",58,0) | |
| 14770 | .I LNCNT S $P(^PS(5 5,PSGP,5,D A,15,0),"^ ",3,4)=LNC NT_"^"_LNC NT | |
| 14771 | "RTN","PSG OT",59,0) | |
| 14772 | .S PSJTMP TX="",PSJO VRMX=0 S T MPLIN=0 F S TMPLIN= $O(^PS(55, +DFN,5,DA, 15,TMPLIN) ) Q:'TMPLI N!(PSJOVRM X) D | |
| 14773 | "RTN","PSG OT",60,0) | |
| 14774 | ..S:($L(P SJTMPTX)+$ L($G(^PS(5 5,+DFN,5,D A,15,TMPLI N,0))))>18 0 PSJOVRMX =1 Q:$G(PS JOVRMX) S PSJTMPTX= $G(PSJTMPT X)_$S($G(P SJTMPTX)]" ":" ",1:"" )_$G(^PS(5 5,+DFN,5,D A,15,TMPLI N,0)) | |
| 14775 | "RTN","PSG OT",61,0) | |
| 14776 | .S TXT=$S (PSJOVRMX: SIMSG,1:PS JTMPTX) | |
| 14777 | "RTN","PSG OT",62,0) | |
| 14778 | .S:($TR(T XT,"^ ")=" ")!'($D(^P S(55,PSGP, 5,DA,15,1) )) TXT="" S ^PS(55,P SGP,5,DA,6 )=TXT S $P (^PS(55,PS GP,5,DA,6) ,"^",2)=$P (^PS(53.1, +ODA,6),"^ ",2) | |
| 14779 | "RTN","PSG OT",63,0) | |
| 14780 | .N LSTLNU M,LSTLNTXT S LSTLNUM =$O(^PS(55 ,+PSGP,5,+ DA,15,""), -1) I LSTL NUM>1 S LS TLNTXT=$G( ^PS(55,+PS GP,5,+DA,1 5,LSTLNUM, 0)) I $TR( LSTLNTXT," ")="" D | |
| 14781 | "RTN","PSG OT",64,0) | |
| 14782 | ..K ^PS(5 5,+PSGP,5, +DA,15,LST LNUM,0) | |
| 14783 | "RTN","PSG OT",65,0) | |
| 14784 | L -^PS(53 .1,+ODA) L -^PS(55,P SGP,5,+DA) K CNT,ND, ODA,XX,ZND | |
| 14785 | "RTN","PSG OT",66,0) | |
| 14786 | Q | |
| 14787 | "RTN","PSG OT",67,0) | |
| 14788 | ; | |
| 14789 | "RTN","PSG PEN") | |
| 14790 | 0^23^B5897 3143 | |
| 14791 | "RTN","PSG PEN",1,0) | |
| 14792 | PSGPEN ;BI R/CML3 - F IND DEFAUL T FOR PRE- EXCHANGE N EEDS ;Jul 26, 2017@1 8:04:02 | |
| 14793 | "RTN","PSG PEN",2,0) | |
| 14794 | ;;5.0;INP ATIENT MED ICATIONS ; **30,37,50 ,58,115,11 0,127,129, 323,317,32 7**;16 DEC 97;Build 64 | |
| 14795 | "RTN","PSG PEN",3,0) | |
| 14796 | ; | |
| 14797 | "RTN","PSG PEN",4,0) | |
| 14798 | ; Referen ces to ^PS D(58.8 sup ported by DBIA #2283 . | |
| 14799 | "RTN","PSG PEN",5,0) | |
| 14800 | ; Referen ces to ^PS I(58.1 sup ported by DBIA #2284 . | |
| 14801 | "RTN","PSG PEN",6,0) | |
| 14802 | ; Referen ce to ^PS( 55 is supp orted by D BIA #2191. | |
| 14803 | "RTN","PSG PEN",7,0) | |
| 14804 | ; Referen ce to ^PSD RUG is sup ported by DBIA #2192 . | |
| 14805 | "RTN","PSG PEN",8,0) | |
| 14806 | ; Referen ce to ^PS( 59.7 is su pported by DBIA #218 1. | |
| 14807 | "RTN","PSG PEN",9,0) | |
| 14808 | ; | |
| 14809 | "RTN","PSG PEN",10,0) | |
| 14810 | EN(PSGPENO ) ; | |
| 14811 | "RTN","PSG PEN",11,0) | |
| 14812 | S PSGPENO =+PSGPENO | |
| 14813 | "RTN","PSG PEN",12,0) | |
| 14814 | N PSJPADE | |
| 14815 | "RTN","PSG PEN",13,0) | |
| 14816 | S PSJPADE =$$PADE($G (PSJPWD),P SGP,PSGPEN O_"U") ; PADE check - PSJ*5*3 17 | |
| 14817 | "RTN","PSG PEN",14,0) | |
| 14818 | N PSJSITE ,PSJPRN,PS JCLO,ND8 S PSJCLO=0, ND8=0 S PS JSITE=0,PS JSITE=$O(^ PS(59.7,PS JSITE)) I $P($G(^(PS JSITE,26)) ,U,5)=1 S PSJPRN=1 | |
| 14819 | "RTN","PSG PEN",15,0) | |
| 14820 | D NOW^%DT C S PSGDT= %,DT=$$DT^ XLFDT,PSGP EN="" S ND =$G(^PS(55 ,PSGP,5,PS GPENO,0)), ND8=$G(^PS (55,PSGP,5 ,PSGPENO,8 )) | |
| 14821 | "RTN","PSG PEN",16,0) | |
| 14822 | S:$P(ND8, "^",2) PSJ CLO=1 | |
| 14823 | "RTN","PSG PEN",17,0) | |
| 14824 | S PSGPENW S=0 I PSJP WD,'PSJCLO F Q=0:0 S Q=$O(^PS( 55,PSGP,5, PSGPENO,1, Q)) Q:'Q S ND=$G(^( Q,0)) I ND ,'$P(ND,"^ ",3),($D(^ PSI(58.1," D",+ND,PSJ PWD))!$D(^ PSD(58.8," D",+ND,PSJ PWD))) S P SGPENWS=1 Q | |
| 14825 | "RTN","PSG PEN",18,0) | |
| 14826 | I PSGPENW S F S Q=$ O(^PS(55,P SGP,5,PSGP ENO,1,Q)) Q:'Q S ND =$G(^(Q,0) ) I ND,'$P (ND,"^",3) S:'$D(^PS I(58.1,"D" ,+ND,PSJPW D))&'$D(^P SD(58.8,"D ",+ND,PSJP WD)) PSGPE NWS=0 Q:'P SGPENWS S $P(PSGPEN WS,"^",2)= 1 | |
| 14827 | "RTN","PSG PEN",19,0) | |
| 14828 | I PSJPADE &'PSGPENWS W !!,"The dispense drug",$S(P SJPADE>1:" s",1:"")," for this order ",$S (PSJPADE>1 :"are",1:" is a")," P ADE item", $S(PSJPADE >1:"s",1:" "),"." S P SGPEN=0 | |
| 14829 | "RTN","PSG PEN",20,0) | |
| 14830 | I PSJPADE &PSGPENWS W !!,"The dispense d rug",$S(PS JPADE>1:"s ",1:"")," for this o rder ",$S( PSJPADE>1: "are",1:"i s a")," WA RD STOCK/P ADE item", $S(PSJPADE >1:"s",1:" "),"." S P SGPEN=0 | |
| 14831 | "RTN","PSG PEN",21,0) | |
| 14832 | I PSGPENW S&'PSJPADE W !!,"The dispense drug",$E(" s",$P(PSGP ENWS,"^",2 ))," for t his order ",$S($P(PS GPENWS,"^" ,2):"are", 1:"is a"), " WARD STO CK item",$ E("s",$P(P SGPENWS,"^ ",2)),"." S PSGPEN=0 | |
| 14833 | "RTN","PSG PEN",22,0) | |
| 14834 | I 'PSGPEN WS,PSJPWD, 'PSJPADE S WG=+$O(^P S(57.5,"AB ",PSJPWD,0 )),PSGPLS= $P($G(^PS( 55,PSGP,5, PSGPENO,2) ),"^",2) I PSGPLS D | |
| 14835 | "RTN","PSG PEN",23,0) | |
| 14836 | .S PSGPLF =$O(^PS(53 .5,"AB",WG ,PSGDT)) | |
| 14837 | "RTN","PSG PEN",24,0) | |
| 14838 | .N RNDT,P SJRNOS S R NDT=$$LAST REN^PSJLMP RI(PSGP,$S ($G(PSJORD )["P":PSJO RD,1:"")), PSJRNOS=$P (RNDT,"^", 4) I PSJRN OS,'$G(PSJ REN) S PSG PLS=PSJRNO S | |
| 14839 | "RTN","PSG PEN",25,0) | |
| 14840 | .I $G(PSJ REN),$G(PS JORD)["U" S PSJRNOS= $P(^PS(55, PSGP,5,+PS JORD,2),"^ ",4) S PSG PLS=$S(PSJ RNOS>PSGDT :PSJRNOS,1 :$$DATE2^P SJUTL2(PSG DT)) | |
| 14841 | "RTN","PSG PEN",26,0) | |
| 14842 | .D:'PSGPL F GF I PSG PLF S PSGP LO=PSGPENO D NCE,^PS GPL0 S:PSG PLC'<0 PSG PEN=PSGPLC | |
| 14843 | "RTN","PSG PEN",27,0) | |
| 14844 | I $G(PSGP RIO)="DONE " S PSGPEN =0 | |
| 14845 | "RTN","PSG PEN",28,0) | |
| 14846 | ; | |
| 14847 | "RTN","PSG PEN",29,0) | |
| 14848 | UPDD ; | |
| 14849 | "RTN","PSG PEN",30,0) | |
| 14850 | N DIR S D IR(0)="NOA ^0:9999:0" ,DIR("A")= "Pre-Excha nge DOSES: ",DIR("?" )="^D DH^P SGPEN" S:P SGPEN]"" D IR("B")=PS GPEN W ! D ^DIR G:'Y DONE S PS GY=+Y W !! ,"...updat ing dispen se drug(s) ..." | |
| 14851 | "RTN","PSG PEN",31,0) | |
| 14852 | F FQ=0:0 S FQ=$O(^P S(55,PSGP, 5,PSGPENO, 1,FQ)) Q:' FQ S ND=$ G(^(FQ,0)) ,$P(^(0)," ^",9)="" I ND,'$P(ND ,"^",3) D DD | |
| 14853 | "RTN","PSG PEN",32,0) | |
| 14854 | ; | |
| 14855 | "RTN","PSG PEN",33,0) | |
| 14856 | DONE ; | |
| 14857 | "RTN","PSG PEN",34,0) | |
| 14858 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 14859 | "RTN","PSG PEN",35,0) | |
| 14860 | N PSGDN S PSGDN=$O( PSJXDOX("D D","")) | |
| 14861 | "RTN","PSG PEN",36,0) | |
| 14862 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 14863 | "RTN","PSG PEN",37,0) | |
| 14864 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 14865 | "RTN","PSG PEN",38,0) | |
| 14866 | K PSGID,P SGMAR,PSGO D,PSGPLC,P SGPLF,PSGP LO,PSGPLS, PSGPLUD,WG S:$G(PSJR EN) DUOUT= 0 Q | |
| 14867 | "RTN","PSG PEN",39,0) | |
| 14868 | ; | |
| 14869 | "RTN","PSG PEN",40,0) | |
| 14870 | NCE ; | |
| 14871 | "RTN","PSG PEN",41,0) | |
| 14872 | W !!,"The next cart exchange is ",$$END TC^PSGMI(P SGPLF),! Q | |
| 14873 | "RTN","PSG PEN",42,0) | |
| 14874 | ; | |
| 14875 | "RTN","PSG PEN",43,0) | |
| 14876 | GF ; | |
| 14877 | "RTN","PSG PEN",44,0) | |
| 14878 | S QQ=0 F Q=0:0 S Q= $O(^PS(53. 5,"AB",WG, Q)) Q:'Q S QQ=Q | |
| 14879 | "RTN","PSG PEN",45,0) | |
| 14880 | I QQ S QQ =$O(^PS(53 .5,"AB",WG ,QQ,0)) I QQ,$D(^PS( 53.5,QQ,0) ) S QQ=$P( ^(0),"^",4 ) I QQ>PSG DT S PSGPL F=QQ | |
| 14881 | "RTN","PSG PEN",46,0) | |
| 14882 | Q | |
| 14883 | "RTN","PSG PEN",47,0) | |
| 14884 | ; | |
| 14885 | "RTN","PSG PEN",48,0) | |
| 14886 | DD ; | |
| 14887 | "RTN","PSG PEN",49,0) | |
| 14888 | N DA S DR G=$S($P(ND ,"^")="":" NOT FOUND" ,'$D(^PSDR UG(+ND,0)) :"NOT FOUN D ("_$P(ND ,"^")_")", $P(^(0),"^ ")]"":$P(^ (0),"^"),1 :$P(ND,"^" )_";PSDRUG ("),UD=$S( '$P(ND,"^" ,2):1,1:$P (ND,"^",2) ) | |
| 14889 | "RTN","PSG PEN",50,0) | |
| 14890 | W !,"..." ,DRG,?45," U/D: ",UD, "..." | |
| 14891 | "RTN","PSG PEN",51,0) | |
| 14892 | S PSGDA=P SGY I 'PSG PENWS,'PSJ CLO,ND,PSJ PWD,($D(^P SI(58.1,"D ",+ND,PSJP WD))!$D(^P SD(58.8,"D ",+ND,PSJP WD))) D PS GPENWS Q:' PSGDA | |
| 14893 | "RTN","PSG PEN",52,0) | |
| 14894 | K DA,DR S PSGDA=$S( UD#1:(PSGD A*((UD\1)+ 1)),1:PSGD A*UD) | |
| 14895 | "RTN","PSG PEN",53,0) | |
| 14896 | S DIE="^P S(55,"_PSG P_",5,"_PS GPENO_",1, ",DA(2)=PS GP,DA(1)=P SGPENO,DA= FQ,DR=".09 ////"_PSGD A D ^DIE | |
| 14897 | "RTN","PSG PEN",54,0) | |
| 14898 | S PSGPXN= $G(PSGPXN) | |
| 14899 | "RTN","PSG PEN",55,0) | |
| 14900 | D:'PSGPXN | |
| 14901 | "RTN","PSG PEN",56,0) | |
| 14902 | .D NOW^%D TC L +^PS( 53.4,0):0 S ND=$G(^P S(53.4,0)) S:ND="" N D="PRE-EXC HANGE NEED S^53.4P" F PSGPXN=$P (ND,"^",3) +1:1 I '$D (^PS(53.4, PSGPXN)) L +^PS(53.4 ,PSGPXN):0 I S ^PS( 53.4,0)=$P (ND,"^",1, 2)_"^"_PSG PXN_"^"_($ P(ND,"^",4 )+1) L -^P S(53.4,0) Q | |
| 14903 | "RTN","PSG PEN",57,0) | |
| 14904 | .S ^PS(53 .4,PSGPXN, 0)=DUZ_"^" _%,^PS(53. 4,"B",DUZ, PSGPXN)="" ,^PS(53.4, "AUD",DUZ, %,PSGPXN)= "" L -^PS( 53.4,PSGPX N) Q | |
| 14905 | "RTN","PSG PEN",58,0) | |
| 14906 | I $D(^PS( 53.4,PSGPX N,1,PSGP,1 ,PSGPENO,1 ,FQ,0)) S $P(^(0),"^ ",2)=$P(^( 0),"^",2)+ PSGDA Q | |
| 14907 | "RTN","PSG PEN",59,0) | |
| 14908 | ; naked r eference b elow refer s to line above | |
| 14909 | "RTN","PSG PEN",60,0) | |
| 14910 | S ^(0)=FQ _"^"_PSGDA I $D(^PS( 53.4,PSGPX N,1,PSGP,1 ,PSGPENO,1 ,0)) S $P( ^(0),"^",3 ,4)=FQ_"^" _($P(^(0), "^",4)+1) Q | |
| 14911 | "RTN","PSG PEN",61,0) | |
| 14912 | ; naked r eference b elow refer s to line above | |
| 14913 | "RTN","PSG PEN",62,0) | |
| 14914 | S ^(0)="^ 53.401101A ^"_FQ_"^1" Q:$D(^PS( 53.4,PSGPX N,1,PSGP,1 ,PSGPENO,0 )) S ^(0) =PSGPENO | |
| 14915 | "RTN","PSG PEN",63,0) | |
| 14916 | I $D(^PS( 53.4,PSGPX N,1,PSGP,1 ,0)) S $P( ^(0),"^",3 ,4)=PSGPEN O_"^"_($P( ^(0),"^",4 )+1) Q | |
| 14917 | "RTN","PSG PEN",64,0) | |
| 14918 | ; naked r eference b elow is fr om line ab ove | |
| 14919 | "RTN","PSG PEN",65,0) | |
| 14920 | S ^(0)="^ 53.4011A^" _PSGPENO_" ^1" Q:$D(^ PS(53.4,PS GPXN,1,PSG P,0)) S ^ (0)=PSGP | |
| 14921 | "RTN","PSG PEN",66,0) | |
| 14922 | I $D(^PS( 53.4,PSGPX N,1,0)) S $P(^(0),"^ ",3,4)=PSG P_"^"_($P( ^(0),"^",4 )+1) Q | |
| 14923 | "RTN","PSG PEN",67,0) | |
| 14924 | ; naked r eference b elow is fr om line ab ove | |
| 14925 | "RTN","PSG PEN",68,0) | |
| 14926 | S ^(0)="^ 53.401PA^" _PSGP_"^1" Q | |
| 14927 | "RTN","PSG PEN",69,0) | |
| 14928 | ; | |
| 14929 | "RTN","PSG PEN",70,0) | |
| 14930 | DH ; | |
| 14931 | "RTN","PSG PEN",71,0) | |
| 14932 | W !!?2,"E nter a num ber from 0 to 9999, 0 decimal digits." | |
| 14933 | "RTN","PSG PEN",72,0) | |
| 14934 | W !!?2,"E nter the n umber DOSE S needed f or this or der until the next c art exchan ge.",!,"Th is will be the numbe r of times the order will be a dministere d to the p atient",!, "from the start of t he order u ntil the n ext cart e xchange." | |
| 14935 | "RTN","PSG PEN",73,0) | |
| 14936 | W !!?2,"P LEASE NOTE that this is DOSES, and NOT U NITS. The doses ent ered will be",!,"con verted to units for each dispe nse drug o f this ord er, as eac h dispense drug",!," may have a different units per dose." Q | |
| 14937 | "RTN","PSG PEN",74,0) | |
| 14938 | ; | |
| 14939 | "RTN","PSG PEN",75,0) | |
| 14940 | PSGPENWS ; | |
| 14941 | "RTN","PSG PEN",76,0) | |
| 14942 | W !,"This dispense drug is a WARD STOCK item." | |
| 14943 | "RTN","PSG PEN",77,0) | |
| 14944 | W !,"Woul d you like to:",!?3, "1 - Enter 0 (no) do ses needed for this dispense d rug.",!?3, "2 - Enter ",PSGDA," doses nee ded for th is dispens e drug.",! ?3,"3 - En ter anothe r amount a s the dose s needed f or this di spense dru g." | |
| 14945 | "RTN","PSG PEN",78,0) | |
| 14946 | K DIR S D IR(0)="SA^ 1:0 (no) d oses;2:"_P SGDA_" dos es;3:anoth er amount" ,DIR("A")= "Select AC TION: ",DI R("?")="^D WH^PSGPEN " W ! D ^D IR I Y=1!' Y S PSGDA= 0 Q | |
| 14947 | "RTN","PSG PEN",79,0) | |
| 14948 | Q:Y=2 K DIR S DIR( 0)="NA^0:9 999:0",DIR ("A")="Pre -Exchange DOSES for this dispe nse drug: ",DIR("?") ="^D WDH^P SGPEN" W ! D ^DIR S PSGDA=+Y Q | |
| 14949 | "RTN","PSG PEN",80,0) | |
| 14950 | ; | |
| 14951 | "RTN","PSG PEN",81,0) | |
| 14952 | WH ; | |
| 14953 | "RTN","PSG PEN",82,0) | |
| 14954 | S Q="This dispense drug ("_DR G_") is a ward stock item. Se lect:" | |
| 14955 | "RTN","PSG PEN",83,0) | |
| 14956 | W !! F Q1 =1:1:$L(Q, " ") S Q2= $P(Q," ",Q 1) W:$X+$L (Q2)>78 ! W Q2," " | |
| 14957 | "RTN","PSG PEN",84,0) | |
| 14958 | W !?3,"1 to enter 0 (no) pre- exchange d oses for t his dispen se drug.", !?3,"2 to enter ",PS GDA," dose s for this dispense drug.",!?3 ,"3 to ent er another amount fo r this dis pense drug ." Q | |
| 14959 | "RTN","PSG PEN",85,0) | |
| 14960 | ; | |
| 14961 | "RTN","PSG PEN",86,0) | |
| 14962 | WDH ; | |
| 14963 | "RTN","PSG PEN",87,0) | |
| 14964 | W !!?2,"E nter a num ber from 0 to 9999, 0 decimal digits. I f you ente r an '^' t o exit",!, "NO pre-ex change dos es will be entered f or this di spense dru g." Q | |
| 14965 | "RTN","PSG PEN",88,0) | |
| 14966 | ; | |
| 14967 | "RTN","PSG PEN",89,0) | |
| 14968 | PADE(PSJPW D,PSGP,PSG ORD) ; Ph armacy Aut omation Di spensing E quipment ( PADE) chec k - PSJ*5* 317 | |
| 14969 | "RTN","PSG PEN",90,0) | |
| 14970 | ; INPUT: PSJPWD = W ard locati on | |
| 14971 | "RTN","PSG PEN",91,0) | |
| 14972 | ; PSGP = P atient DFN | |
| 14973 | "RTN","PSG PEN",92,0) | |
| 14974 | ; PSGORD = O rder numbe r | |
| 14975 | "RTN","PSG PEN",93,0) | |
| 14976 | ; OUTPUT: PADE = Ca n this ord er be disp ensed via PADE? | |
| 14977 | "RTN","PSG PEN",94,0) | |
| 14978 | ; | |
| 14979 | "RTN","PSG PEN",95,0) | |
| 14980 | N PADE,DF N,PSJDDND, PSJWDFLG | |
| 14981 | "RTN","PSG PEN",96,0) | |
| 14982 | I '$G(PSJ PWD)!'$G(P SGP)!'$G(P SGORD) Q " " | |
| 14983 | "RTN","PSG PEN",97,0) | |
| 14984 | S PADE="" ,DFN=$G(PS GP) | |
| 14985 | "RTN","PSG PEN",98,0) | |
| 14986 | ; Check D EFAULT 0 O N PADE PRE -EXCHANGE parameter | |
| 14987 | "RTN","PSG PEN",99,0) | |
| 14988 | D GETS^DI Q(59.6,+$G (PSJSYSW), 8,"I","PSJ WDFLG") | |
| 14989 | "RTN","PSG PEN",100,0 ) | |
| 14990 | I $G(PSJW DFLG("59.6 ",+$G(PSJS YSW)_",",8 ,"I")) D | |
| 14991 | "RTN","PSG PEN",101,0 ) | |
| 14992 | .N PSJPDL OC,PSJORCL ,PSJCLNK | |
| 14993 | "RTN","PSG PEN",102,0 ) | |
| 14994 | .; If cli nic order, quit if c linic loca tion is no t linked t o PADE | |
| 14995 | "RTN","PSG PEN",103,0 ) | |
| 14996 | .S PSJORC L=$S($G(PS GORD)["P": $G(^PS(53. 1,+$G(PSGO RD),"DSS") ),$G(PSGOR D)["U":$G( ^PS(55,+$G (PSGP),5,+ $G(PSGORD) ,8)),$G(PS GORD)["V": $G(^PS(55, +$G(PSGP), "IV",+$G(P SGORD),"DS S")),1:"") | |
| 14997 | "RTN","PSG PEN",104,0 ) | |
| 14998 | .I PSJORC L,$P(PSJOR CL,"^",2) S PSJCLNK= $$PADECL^P SJPAD50(+$ G(PSJORCL) ) Q:'PSJCL NK | |
| 14999 | "RTN","PSG PEN",105,0 ) | |
| 15000 | .I '$G(PS JCLNK) Q:' $$PADEWD^P SJPAD50(PS JPWD) ; Quit if pa tient loca tion not l inked to P ADE | |
| 15001 | "RTN","PSG PEN",106,0 ) | |
| 15002 | .S PSJPDL OC=$S($G(P SGORD)["P" :+$G(^PS(5 3.1,+PSGOR D,"DSS"))_ "C",$G(PSG ORD)["U":+ $G(^PS(55, +$G(DFN),5 ,+$G(PSGOR D),8))_"C" ,1:"") | |
| 15003 | "RTN","PSG PEN",107,0 ) | |
| 15004 | .S:'PSJPD LOC PSJPDL OC=+$G(PSJ PWD) | |
| 15005 | "RTN","PSG PEN",108,0 ) | |
| 15006 | .N PADEFL AG,DDCNT S PADEFLAG= 1 | |
| 15007 | "RTN","PSG PEN",109,0 ) | |
| 15008 | .I $G(PSG ORD)["U" S Q=0 F DDC NT=0:1 S Q =$O(^PS(55 ,+$G(PSGP) ,5,+PSGORD ,1,Q)) Q:' Q!'PADEFLA G S PSJDD ND=$G(^(Q, 0)) D | |
| 15009 | "RTN","PSG PEN",110,0 ) | |
| 15010 | ..S PADEF LAG=+$$DRG QTY^PSJPAD SI(+PSJDDN D,$S(PSJPD LOC["C":"C L",1:"WD") ,+PSJPDLOC ) | |
| 15011 | "RTN","PSG PEN",111,0 ) | |
| 15012 | .I $G(PSG ORD)'["U" S Q=0 F DD CNT=0:1 S Q=$O(^PS(5 3.45,+$G(P SJSYSP),2, Q)) Q:'Q!' PADEFLAG S PSJDDND= $G(^(Q,0)) D | |
| 15013 | "RTN","PSG PEN",112,0 ) | |
| 15014 | ..S PADEF LAG=+$$DRG QTY^PSJPAD SI(+PSJDDN D,$S(PSJPD LOC["C":"C L",1:"WD") ,+PSJPDLOC ) | |
| 15015 | "RTN","PSG PEN",113,0 ) | |
| 15016 | .I DDCNT, PADEFLAG S PADE=DDCN T | |
| 15017 | "RTN","PSG PEN",114,0 ) | |
| 15018 | Q PADE | |
| 15019 | "RTN","PSJ 327P") | |
| 15020 | 0^38^B6886 19 | |
| 15021 | "RTN","PSJ 327P",1,0) | |
| 15022 | PSJ327P ; NCC/MIR - NCC POST I NSTALL;Jul 26, 2017@ 18:04:02 | |
| 15023 | "RTN","PSJ 327P",2,0) | |
| 15024 | ;;5.0;INP ATIENT MED ICATIONS ; **327**;01 DEC 15;Bu ild 64 | |
| 15025 | "RTN","PSJ 327P",3,0) | |
| 15026 | ; | |
| 15027 | "RTN","PSJ 327P",4,0) | |
| 15028 | ADDMENUS ; Add new m enu items to the mai n one | |
| 15029 | "RTN","PSJ 327P",5,0) | |
| 15030 | N RES | |
| 15031 | "RTN","PSJ 327P",6,0) | |
| 15032 | S RES=$$A DD^XPDMENU ("PSJL MAN AGER","PSO L REGISTER PATIENT", "",1) | |
| 15033 | "RTN","PSJ 327P",7,0) | |
| 15034 | S RES=$$A DD^XPDMENU ("PSJL MAN AGER","PSJ LAB LIST", "",2) | |
| 15035 | "RTN","PSJ 327P",8,0) | |
| 15036 | S RES=$$A DD^XPDMENU ("PSJL MAN AGER","PSJ LIST OVERR IDES","",3 ) | |
| 15037 | "RTN","PSJ 327P",9,0) | |
| 15038 | S RES=$$A DD^XPDMENU ("PSJL MAN AGER","PSO L EDIT","" ,4) | |
| 15039 | "RTN","PSJ 327P",10,0 ) | |
| 15040 | ; | |
| 15041 | "RTN","PSJ 327P",11,0 ) | |
| 15042 | S RES=$$A DD^XPDMENU ("PSJU MGR ","PSJL MA NAGER","", 2.98) | |
| 15043 | "RTN","PSJ 327P",12,0 ) | |
| 15044 | Q | |
| 15045 | "RTN","PSJ CLOLS") | |
| 15046 | 0^8^B10140 585 | |
| 15047 | "RTN","PSJ CLOLS",1,0 ) | |
| 15048 | PSJCLOLS ; ALB/RTW - LIST INPAT IENT CLOZA PINE ORDER S ENTERED BY OVERRID E ;Jul 26, 2017@18:0 4:02 | |
| 15049 | "RTN","PSJ CLOLS",2,0 ) | |
| 15050 | ;;5.0;INP ATIENT PHA RMACY;**32 7**;;Build 64 | |
| 15051 | "RTN","PSJ CLOLS",3,0 ) | |
| 15052 | ;RTW copi ed from ro utine PSOC LOLS and m odified fo r the NCC Clozapine inpatient pharmacy p roject | |
| 15053 | "RTN","PSJ CLOLS",4,0 ) | |
| 15054 | W !,"Prin t list of clozapine orders ove rriding lo ckout",! | |
| 15055 | "RTN","PSJ CLOLS",5,0 ) | |
| 15056 | DATE S %DT ="EAX",%DT ("A")="Beg inning dat e : " D ^% DT G EXIT: Y<0 S PSOB D=Y | |
| 15057 | "RTN","PSJ CLOLS",6,0 ) | |
| 15058 | S %DT("A" )="Ending date : " D ^%DT G EX IT:Y<0 S P SOED=Y+.3 I PSOED<PS OBD W !!," Ending dat e must be after begi nning date " G DATE | |
| 15059 | "RTN","PSJ CLOLS",7,0 ) | |
| 15060 | DEV S %ZIS ("B")="",% ZIS="MQ" D ^%ZIS G E XIT:POP ;I $E(IOST)' ="P" W !," Select a p rinter " G DEV | |
| 15061 | "RTN","PSJ CLOLS",8,0 ) | |
| 15062 | I $D(IO(" Q")) G QUE | |
| 15063 | "RTN","PSJ CLOLS",9,0 ) | |
| 15064 | DQ ;Entry to report | |
| 15065 | "RTN","PSJ CLOLS",10, 0) | |
| 15066 | K ^TMP($J ,"PSJORDT" ) D LIST^D IC(53.8,,. 01,"I",,PS OBD,,"B",, ,"^TMP($J, ""PSJORDT" ")") | |
| 15067 | "RTN","PSJ CLOLS",11, 0) | |
| 15068 | W:$Y @IOF D HD I '^ TMP($J,"PS JORDT","DI LIST",0) W !,?5,"NO ORDERS FOU ND",@IOF G EXIT | |
| 15069 | "RTN","PSJ CLOLS",12, 0) | |
| 15070 | I ^TMP($J ,"PSJORDT" ,"DILIST", 1,1)>PSOED W !,?5,"N O ORDERS F OUND",@IOF G EXIT | |
| 15071 | "RTN","PSJ CLOLS",13, 0) | |
| 15072 | F I=1:1 Q :'$D(^TMP( $J,"PSJORD T","DILIST ",1,I)) S PSJOD=^TM P($J,"PSJO RDT","DILI ST",1,I) Q :PSJOD>PSO ED D | |
| 15073 | "RTN","PSJ CLOLS",14, 0) | |
| 15074 | .S PSOI=+ ^TMP($J,"P SJORDT","D ILIST",2,I ) | |
| 15075 | "RTN","PSJ CLOLS",15, 0) | |
| 15076 | .D GETS^D IQ(53.8,PS OI,"*","I" ,"PSJDATA" ) S PSOJ=P SOI_"," D: $D(PSJDATA ) PRINT | |
| 15077 | "RTN","PSJ CLOLS",16, 0) | |
| 15078 | W @IOF | |
| 15079 | "RTN","PSJ CLOLS",17, 0) | |
| 15080 | EXIT D ^%Z ISC K %DT, PSJDRG,POP ,PSJOD,PSO I,PSOJ,PSJ DATA,PSJRX ,PSJUSR,PS JAPR,PSJRE A,PSJCOM,P SJPAT,PSOB D,PSOED,X, J,ZTDESC,Z TIO,ZTRTN, ZTSAVE,ZTS K | |
| 15081 | "RTN","PSJ CLOLS",18, 0) | |
| 15082 | K ^TMP($J ,"PSJORDT" ) Q | |
| 15083 | "RTN","PSJ CLOLS",19, 0) | |
| 15084 | ; | |
| 15085 | "RTN","PSJ CLOLS",20, 0) | |
| 15086 | PRINT I $Y +9>IOSL W @IOF D HD | |
| 15087 | "RTN","PSJ CLOLS",21, 0) | |
| 15088 | I '$D(PSJ DATA(53.8, PSOJ,1))!' $D(PSJDATA (53.8,PSOJ ,2))!'$D(P SJDATA(53. 8,PSOJ,3)) !'$D(PSJDA TA(53.8,PS OJ,4)) Q | |
| 15089 | "RTN","PSJ CLOLS",22, 0) | |
| 15090 | S PSJORD= +PSJDATA(5 3.8,PSOJ,1 ,"I"),PSJU SR=PSJDATA (53.8,PSOJ ,2,"I") | |
| 15091 | "RTN","PSJ CLOLS",23, 0) | |
| 15092 | S PSJAPR= PSJDATA(53 .8,PSOJ,3, "I"),PSJRE A=PSJDATA( 53.8,PSOJ, 4,"I") | |
| 15093 | "RTN","PSJ CLOLS",24, 0) | |
| 15094 | S PSJUSR= $$GET1^DIQ (200,PSJUS R,.01),PSJ APR=$$GET1 ^DIQ(200,P SJAPR,.01) | |
| 15095 | "RTN","PSJ CLOLS",25, 0) | |
| 15096 | S PSJCOM= PSJDATA(53 .8,PSOJ,5, "I") | |
| 15097 | "RTN","PSJ CLOLS",26, 0) | |
| 15098 | S PSJNUM= $$FIND1^DI C(100.045, ","_PSJORD _",","X"," DRUG","ID" ) | |
| 15099 | "RTN","PSJ CLOLS",27, 0) | |
| 15100 | S PSJDRG= $$GET1^DIQ (100.045,P SJNUM_","_ PSJORD,1) Q:'$D(PSJD RG) | |
| 15101 | "RTN","PSJ CLOLS",28, 0) | |
| 15102 | S PSJPAT= +$$GET1^DI Q(100,PSJO RD,.02),PS JDRG=$$GET 1^DIQ(50,P SJDRG,.01) | |
| 15103 | "RTN","PSJ CLOLS",29, 0) | |
| 15104 | W !,?3,"D ate : ",$E (PSJOD,4,5 ),"/",$E(P SJOD,6,7), "/",$E(PSJ OD,2,3),?2 5,"ORDER # : ",PSJOR D,?45,"Pat ient : ",P SJPAT | |
| 15105 | "RTN","PSJ CLOLS",30, 0) | |
| 15106 | W !,?3,"D RUG : ",PS JDRG | |
| 15107 | "RTN","PSJ CLOLS",31, 0) | |
| 15108 | W !,?3,"E ntered by : ",PSJUSR ,!,?3,"App roved by : ",PSJAPR | |
| 15109 | "RTN","PSJ CLOLS",32, 0) | |
| 15110 | W !,?3,"L ockout Rea son : ",$$ GET1^DIQ(5 2.54,PSJRE A,.01) | |
| 15111 | "RTN","PSJ CLOLS",33, 0) | |
| 15112 | W !,?3,"C omments : " I $L(PSJ COM)<65 W PSJCOM,!! Q | |
| 15113 | "RTN","PSJ CLOLS",34, 0) | |
| 15114 | F J=1:1 Q :$P(PSJCOM ," ",J,999 9)="" S X =$P(PSJCOM ," ",J) W: $L(X)+$X>7 0 !,?14 W X," " | |
| 15115 | "RTN","PSJ CLOLS",35, 0) | |
| 15116 | W !! Q | |
| 15117 | "RTN","PSJ CLOLS",36, 0) | |
| 15118 | HD U IO W !!,?5,"LIS T OF ORDER S WRITTEN FOR CLOZAP INE OVERRI DING LOCKO UT",!,?10, "FOR THE D ATE RANGE ",$E(PSOBD ,4,5),"/", $E(PSOBD,6 ,7),"/",$E (PSOBD,2,3 )," THROUG H ",$E(PSO ED,4,5),"/ ",$E(PSOED ,6,7),"/", $E(PSOED,2 ,3),! Q | |
| 15119 | "RTN","PSJ CLOLS",37, 0) | |
| 15120 | ; | |
| 15121 | "RTN","PSJ CLOLS",38, 0) | |
| 15122 | QUE ;queue job | |
| 15123 | "RTN","PSJ CLOLS",39, 0) | |
| 15124 | S ZTRTN=" DQ^PSJCLOL S",ZTDESC= "CLOZAPINE LIST",ZTS AVE("PSOBD ")="",ZTSA VE("PSOED" )="" D ^%Z TLOAD G EX IT | |
| 15125 | "RTN","PSJ CLOZ") | |
| 15126 | 0^3^B17451 2975 | |
| 15127 | "RTN","PSJ CLOZ",1,0) | |
| 15128 | PSJCLOZ ; DAL/RJS - INPATIENT CLOZAPINE ORDER CHEC K ; 1/8/16 6:50pm | |
| 15129 | "RTN","PSJ CLOZ",2,0) | |
| 15130 | ;;5.0;INP ATIENT MED ICATIONS ; **327**;01 DEC 15;Bu ild 64 | |
| 15131 | "RTN","PSJ CLOZ",3,0) | |
| 15132 | ; | |
| 15133 | "RTN","PSJ CLOZ",4,0) | |
| 15134 | CLOZ(DFN,D RUG) ; | |
| 15135 | "RTN","PSJ CLOZ",5,0) | |
| 15136 | ; DFN MUS T BE SET T O PATIENT IEN ; DRU G MUST BE SET TO DRU G IEN | |
| 15137 | "RTN","PSJ CLOZ",6,0) | |
| 15138 | I '$G(DFN )!('$G(DRU G)) S ANQX =0 Q | |
| 15139 | "RTN","PSJ CLOZ",7,0) | |
| 15140 | D PROVCHK ($G(PSGPR) ) Q:ANQX | |
| 15141 | "RTN","PSJ CLOZ",8,0) | |
| 15142 | N RTN | |
| 15143 | "RTN","PSJ CLOZ",9,0) | |
| 15144 | S RTN=$$G ET1^DIQ(50 ,DRUG,17.5 ) | |
| 15145 | "RTN","PSJ CLOZ",10,0 ) | |
| 15146 | D:$L(RTN) ^@RTN | |
| 15147 | "RTN","PSJ CLOZ",11,0 ) | |
| 15148 | Q | |
| 15149 | "RTN","PSJ CLOZ",12,0 ) | |
| 15150 | ; | |
| 15151 | "RTN","PSJ CLOZ",13,0 ) | |
| 15152 | PROVCHK(PR OV) ; | |
| 15153 | "RTN","PSJ CLOZ",14,0 ) | |
| 15154 | N PSJQUIT | |
| 15155 | "RTN","PSJ CLOZ",15,0 ) | |
| 15156 | ; | |
| 15157 | "RTN","PSJ CLOZ",16,0 ) | |
| 15158 | S (ANQX,P SJQUIT)=0 | |
| 15159 | "RTN","PSJ CLOZ",17,0 ) | |
| 15160 | I $G(PROV ) D | |
| 15161 | "RTN","PSJ CLOZ",18,0 ) | |
| 15162 | .I '$L($$ DEA^XUSER( ,PROV)) D | |
| 15163 | "RTN","PSJ CLOZ",19,0 ) | |
| 15164 | ..S (ANQX ,PSJQUIT)= 1 | |
| 15165 | "RTN","PSJ CLOZ",20,0 ) | |
| 15166 | ..W !," " ,!,"*** Pr ovider mus t have a D EA# or VA# to write prescripti ons for th is drug." | |
| 15167 | "RTN","PSJ CLOZ",21,0 ) | |
| 15168 | . Q:PSJQU IT | |
| 15169 | "RTN","PSJ CLOZ",22,0 ) | |
| 15170 | .I '$$FIN D1^DIC(200 .051,","_P ROV_",","X ","YSCL AU THORIZED") D | |
| 15171 | "RTN","PSJ CLOZ",23,0 ) | |
| 15172 | ..S (ANQX ,PSJQUIT)= 1 | |
| 15173 | "RTN","PSJ CLOZ",24,0 ) | |
| 15174 | ..W !," " ,!,"*** Pr ovider mus t hold YSC L AUTHORIZ ED key to write pres criptions for clozap ine." | |
| 15175 | "RTN","PSJ CLOZ",25,0 ) | |
| 15176 | Q | |
| 15177 | "RTN","PSJ CLOZ",26,0 ) | |
| 15178 | BEFQUIT ; | |
| 15179 | "RTN","PSJ CLOZ",27,0 ) | |
| 15180 | Q:'$G(QOA A) | |
| 15181 | "RTN","PSJ CLOZ",28,0 ) | |
| 15182 | N QODS,QO RF,ORMAX,O RCLPAT | |
| 15183 | "RTN","PSJ CLOZ",29,0 ) | |
| 15184 | S QODS=$$ FIND1^DIC( 101.41,,"X ","OR GTX DAYS SUPPL Y","AB") Q :'QODS | |
| 15185 | "RTN","PSJ CLOZ",30,0 ) | |
| 15186 | S QODS=$$ FIND1^DIC( 101.416,", "_ORX_",", "Q",QODS," D") Q:'QOD S | |
| 15187 | "RTN","PSJ CLOZ",31,0 ) | |
| 15188 | S QODS=$$ GET1^DIQ(1 01.416,QOD S_","_ORX, .01) | |
| 15189 | "RTN","PSJ CLOZ",32,0 ) | |
| 15190 | S QORF=$$ FIND1^DIC( 101.41,,"X ","OR GTX REFILLS"," AB") Q:'QO RF | |
| 15191 | "RTN","PSJ CLOZ",33,0 ) | |
| 15192 | S QORF=$$ FIND1^DIC( 101.416,", "_ORX_",", "Q",QORF," D") Q:'QOR F | |
| 15193 | "RTN","PSJ CLOZ",34,0 ) | |
| 15194 | S QORF=$$ GET1^DIQ(1 01.416,QOR F_","_ORX, .01) | |
| 15195 | "RTN","PSJ CLOZ",35,0 ) | |
| 15196 | S QORF=QO RF+1 | |
| 15197 | "RTN","PSJ CLOZ",36,0 ) | |
| 15198 | S ORCLPAT =$P(ORYS,U ,7) | |
| 15199 | "RTN","PSJ CLOZ",37,0 ) | |
| 15200 | S ORMAX=$ S(ORCLPAT= "M":28,ORC LPAT="B":1 4,ORCLPAT= "W":7,1:90 ) | |
| 15201 | "RTN","PSJ CLOZ",38,0 ) | |
| 15202 | I QORF*QO DS>ORMAX D | |
| 15203 | "RTN","PSJ CLOZ",39,0 ) | |
| 15204 | .K ORY | |
| 15205 | "RTN","PSJ CLOZ",40,0 ) | |
| 15206 | .S ORY=1_ U_ORCLOZ | |
| 15207 | "RTN","PSJ CLOZ",41,0 ) | |
| 15208 | .W !,?5," Problem Or dering Clo zapine Rel ated Medic ation"_U_O RCLOZ | |
| 15209 | "RTN","PSJ CLOZ",42,0 ) | |
| 15210 | .W !,?5," *** This p atient is only allow ed an orde r with a m aximum Day s Supply o f "_ORMAX_ "." | |
| 15211 | "RTN","PSJ CLOZ",43,0 ) | |
| 15212 | .W !,?5," This inclu des the am ounts adde d by any r efills ent ered in wi th the ord er also." | |
| 15213 | "RTN","PSJ CLOZ",44,0 ) | |
| 15214 | Q | |
| 15215 | "RTN","PSJ CLOZ",45,0 ) | |
| 15216 | OVERRIDE ; | |
| 15217 | "RTN","PSJ CLOZ",46,0 ) | |
| 15218 | I '$$FIND 1^DIC(200. 051,","_PR OV_",","X" ,"PSOLOCKC LOZ") D Q 1 | |
| 15219 | "RTN","PSJ CLOZ",47,0 ) | |
| 15220 | .N Y | |
| 15221 | "RTN","PSJ CLOZ",48,0 ) | |
| 15222 | .W !," ", !,?5,"*** You are no t authoriz ed to over ride Cloza pine order s.",!," " | |
| 15223 | "RTN","PSJ CLOZ",49,0 ) | |
| 15224 | .K DIR S DIR(0)="E" ,DIR("A")= "Press Ret urn to Con tinue..." D ^DIR K D IR W @IOF | |
| 15225 | "RTN","PSJ CLOZ",50,0 ) | |
| 15226 | Q | |
| 15227 | "RTN","PSJ CLOZ",51,0 ) | |
| 15228 | PSJFILE(DF N) ; | |
| 15229 | "RTN","PSJ CLOZ",52,0 ) | |
| 15230 | S PSJCLPA T=DFN | |
| 15231 | "RTN","PSJ CLOZ",53,0 ) | |
| 15232 | N PSJORN, PSJORDER I $G(PSJCOM ) D Q | |
| 15233 | "RTN","PSJ CLOZ",54,0 ) | |
| 15234 | .I $G(PSG ODA),$O(^T MP("PSJCOM ",$J,PSGOD A))'="" Q ; Put in to the fil e 53.8 jus t at the e nd | |
| 15235 | "RTN","PSJ CLOZ",55,0 ) | |
| 15236 | .N PSJORD 1 S PSJORD 1="" | |
| 15237 | "RTN","PSJ CLOZ",56,0 ) | |
| 15238 | .F S PSJ ORD1=$O(^T MP("PSJCOM ",$J,PSJOR D1)) Q:'PS JORD1 D | |
| 15239 | "RTN","PSJ CLOZ",57,0 ) | |
| 15240 | ..S ANQDA TA=$G(^TMP ("PSJCOM", $J,PSJORD1 ,"ANQDATA" )) Q:'$L(A NQDATA) | |
| 15241 | "RTN","PSJ CLOZ",58,0 ) | |
| 15242 | ..S PSJOR N=+$P(^TMP ("PSJCOM", $J,PSJORD1 ,0),"^",21 ) | |
| 15243 | "RTN","PSJ CLOZ",59,0 ) | |
| 15244 | ..D PSJFI LE1 | |
| 15245 | "RTN","PSJ CLOZ",60,0 ) | |
| 15246 | PSJFILE1 ; | |
| 15247 | "RTN","PSJ CLOZ",61,0 ) | |
| 15248 | I $D(ANQD ATA) D | |
| 15249 | "RTN","PSJ CLOZ",62,0 ) | |
| 15250 | .F D NOW ^%DTC I '$ D(^PS(53.8 ,"B",%)) S NOW=% Q | |
| 15251 | "RTN","PSJ CLOZ",63,0 ) | |
| 15252 | .S PSJPRO V=$P(ANQDA TA,"^",2), PSJ1PH=$P( ANQDATA,"^ "),PSJ2PH= $P(ANQDATA ,"^",5) | |
| 15253 | "RTN","PSJ CLOZ",64,0 ) | |
| 15254 | .S PSJREA SN=$P(ANQD ATA,"^",3) ,PSJREMRK= $P(ANQDATA ,"^",4) | |
| 15255 | "RTN","PSJ CLOZ",65,0 ) | |
| 15256 | .I $G(ORO ) S PSJPRO V=$P(ORO," ^",4) | |
| 15257 | "RTN","PSJ CLOZ",66,0 ) | |
| 15258 | .S:'$G(PS JORN)&$G(O RO) PSJORN =+ORO | |
| 15259 | "RTN","PSJ CLOZ",67,0 ) | |
| 15260 | .S PSJORD ER("PSJORN ")=PSJORN | |
| 15261 | "RTN","PSJ CLOZ",68,0 ) | |
| 15262 | .K DD,DO S DIC="^PS (53.8,",DI C(0)="L",D LAYGO=53.8 ,X=NOW | |
| 15263 | "RTN","PSJ CLOZ",69,0 ) | |
| 15264 | .D FILE^D ICN K DIC, DLAYGO,DD, DO,DA,DR | |
| 15265 | "RTN","PSJ CLOZ",70,0 ) | |
| 15266 | .N PS538 S (PS538,D A)=+Y,DIE= "^PS(53.8, ",DR="1/// /^S X=PSJO RDER(""PSJ ORN"")"_"; 3////^S X= PSJPROV;2/ ///^S X=PS J1PH;4//// ^S X=PSJRE ASN;5////^ S X=PSJREM RK;6////^S X=PSJ2PH" | |
| 15267 | "RTN","PSJ CLOZ",71,0 ) | |
| 15268 | .D ^DIE K DIE,DA,DR | |
| 15269 | "RTN","PSJ CLOZ",72,0 ) | |
| 15270 | .S XMY(PS JPROV)="", XMY(PSJ2PH )="" | |
| 15271 | "RTN","PSJ CLOZ",73,0 ) | |
| 15272 | .K ANQDAT A,X,Y,%,AN QREM | |
| 15273 | "RTN","PSJ CLOZ",74,0 ) | |
| 15274 | .W !,"THE OVERRIDDE N ORDER IS COMPLETE" ,! | |
| 15275 | "RTN","PSJ CLOZ",75,0 ) | |
| 15276 | .D ALERT | |
| 15277 | "RTN","PSJ CLOZ",76,0 ) | |
| 15278 | Q | |
| 15279 | "RTN","PSJ CLOZ",77,0 ) | |
| 15280 | ALERT ; se nd an aler t to the T WO approvi ng team me mbers | |
| 15281 | "RTN","PSJ CLOZ",78,0 ) | |
| 15282 | S XQADATA =PSCLPAT ; | |
| 15283 | "RTN","PSJ CLOZ",79,0 ) | |
| 15284 | S PSOLAST 4=$E($$GET 1^DIQ(2,PS CLPAT,.09) ,6,9) | |
| 15285 | "RTN","PSJ CLOZ",80,0 ) | |
| 15286 | S XQAARCH =1 | |
| 15287 | "RTN","PSJ CLOZ",81,0 ) | |
| 15288 | S XQAFLG= "D" | |
| 15289 | "RTN","PSJ CLOZ",82,0 ) | |
| 15290 | S XQA(PSJ 2PH)="",XQ A(PSJPROV) ="" | |
| 15291 | "RTN","PSJ CLOZ",83,0 ) | |
| 15292 | D NOW^%DT C S Y=% D DD^%DT S P SCDATE=Y | |
| 15293 | "RTN","PSJ CLOZ",84,0 ) | |
| 15294 | S XQAMSG= $$GET1^DIQ (2,PSCLPAT ,.01)_" (" _PSOLAST4_ ")"_": CLO ZAPINE OVE RRIDE RX P ROCESSED :"_PSCDATE | |
| 15295 | "RTN","PSJ CLOZ",85,0 ) | |
| 15296 | S XQAID=" PSI"_","_P SCLPAT | |
| 15297 | "RTN","PSJ CLOZ",86,0 ) | |
| 15298 | D SETUP^X QALERT | |
| 15299 | "RTN","PSJ CLOZ",87,0 ) | |
| 15300 | W !!,"OVE RRIDE ALER TS HAVE BE EN SENT TO THE APPRO VING TEAM MEMBERS",! ! | |
| 15301 | "RTN","PSJ CLOZ",88,0 ) | |
| 15302 | Q | |
| 15303 | "RTN","PSJ CLOZ",89,0 ) | |
| 15304 | ; | |
| 15305 | "RTN","PSJ CLOZ",90,0 ) | |
| 15306 | READ ; | |
| 15307 | "RTN","PSJ CLOZ",91,0 ) | |
| 15308 | S CLOZPAT =$P($P(XQX ,"patient ",2)," BY" ,1) | |
| 15309 | "RTN","PSJ CLOZ",92,0 ) | |
| 15310 | S DIR("A" )="Do you concurr wi th the req uested ove rride for "_CLOZPAT, DIR(0)="Y" ,DIR("B")= "N" D ^DIR G END:$D( DIRUT) K D IR D:'Y!($ D(DIRUT)) END | |
| 15311 | "RTN","PSJ CLOZ",93,0 ) | |
| 15312 | Q | |
| 15313 | "RTN","PSJ CLOZ",94,0 ) | |
| 15314 | TDD ; TOTO AL DAILY D OSE INPUT >> RJS | |
| 15315 | "RTN","PSJ CLOZ",95,0 ) | |
| 15316 | I $G(PSGP DN)["CLOZ" D | |
| 15317 | "RTN","PSJ CLOZ",96,0 ) | |
| 15318 | .S DIR(0) ="N^12.5:3 000:1",DIR ("A")="CLO ZAPINE dos age (mg/da y) ? " D ^ DIR K DIR I $D(DIRUT ) S (ANQX, PSGORQF)=1 Q | |
| 15319 | "RTN","PSJ CLOZ",97,0 ) | |
| 15320 | .S:+$G(PS JEDITO) PS GETDD=X | |
| 15321 | "RTN","PSJ CLOZ",98,0 ) | |
| 15322 | .S:+$G(PS GCOPY) PSG CTDD=X | |
| 15323 | "RTN","PSJ CLOZ",99,0 ) | |
| 15324 | .S PSOSAN D=X | |
| 15325 | "RTN","PSJ CLOZ",100, 0) | |
| 15326 | Q | |
| 15327 | "RTN","PSJ CLOZ",101, 0) | |
| 15328 | ORD ;/RJS Begin PSJ* 5.0*327 mo dification | |
| 15329 | "RTN","PSJ CLOZ",102, 0) | |
| 15330 | S PSGDRG= PSJDD | |
| 15331 | "RTN","PSJ CLOZ",103, 0) | |
| 15332 | I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" D CLO Z(PSGP,PSG DRG) I $G( ANQX) S PS GORQF=1 | |
| 15333 | "RTN","PSJ CLOZ",104, 0) | |
| 15334 | END ; | |
| 15335 | "RTN","PSJ CLOZ",105, 0) | |
| 15336 | K DIRUT,D IROUT,DIR | |
| 15337 | "RTN","PSJ CLOZ",106, 0) | |
| 15338 | Q | |
| 15339 | "RTN","PSJ CLOZ",107, 0) | |
| 15340 | ; | |
| 15341 | "RTN","PSJ CLOZ",108, 0) | |
| 15342 | CMPLX ;COM PLEX THEN ORDER LOGI C | |
| 15343 | "RTN","PSJ CLOZ",109, 0) | |
| 15344 | Q:'$$GET1 ^DIQ(53.1, +$G(PSGORD ),125,"I") | |
| 15345 | "RTN","PSJ CLOZ",110, 0) | |
| 15346 | Q:+$G(PSG COPY) | |
| 15347 | "RTN","PSJ CLOZ",111, 0) | |
| 15348 | D CLOZPAT ,ANDTHEN | |
| 15349 | "RTN","PSJ CLOZ",112, 0) | |
| 15350 | Q:$G(PSGT YP)="A" | |
| 15351 | "RTN","PSJ CLOZ",113, 0) | |
| 15352 | I $D(PSGT YP),'$D(^T MP("PSGCPL X",$J,DFN, +$G(PSGORD ))) S ^TMP ("PSGCPLX" ,$J,DFN,+$ G(PSGORD)) =PSGSD,PSG COMP=1 | |
| 15353 | "RTN","PSJ CLOZ",114, 0) | |
| 15354 | Q | |
| 15355 | "RTN","PSJ CLOZ",115, 0) | |
| 15356 | CMPLX2 ;SE COND COMPL EX THEN OR DER LOGIC | |
| 15357 | "RTN","PSJ CLOZ",116, 0) | |
| 15358 | Q:'$$GET1 ^DIQ(53.1, +$G(PSGORD ),125,"I") | |
| 15359 | "RTN","PSJ CLOZ",117, 0) | |
| 15360 | Q:+$G(PSG COPY) | |
| 15361 | "RTN","PSJ CLOZ",118, 0) | |
| 15362 | D CLOZPAT ,ANDTHEN | |
| 15363 | "RTN","PSJ CLOZ",119, 0) | |
| 15364 | I $G(PSGT YP)="A"!($ G(PSGTYP)= "AT") Q | |
| 15365 | "RTN","PSJ CLOZ",120, 0) | |
| 15366 | I $D(^TMP ("PSGCPLX" ,$J,DFN)) D | |
| 15367 | "RTN","PSJ CLOZ",121, 0) | |
| 15368 | .I $O(^TM P("PSGCPLX ",$J,DFN,0 )) S PSGTM P=$O(^TMP( "PSGCPLX", $J,DFN,0)) | |
| 15369 | "RTN","PSJ CLOZ",122, 0) | |
| 15370 | .I +$G(PS GTMP)'=+$G (PSGORD) D | |
| 15371 | "RTN","PSJ CLOZ",123, 0) | |
| 15372 | ..S $P(PS GRDTX,U,1) =$G(^TMP(" PSGCPLX",$ J,DFN,PSGT MP)) | |
| 15373 | "RTN","PSJ CLOZ",124, 0) | |
| 15374 | ..I $G(PS GRDTX(+$G( PSJORD),"P SGSD"))=+$ G(PSGRDTX) | |
| 15375 | "RTN","PSJ CLOZ",125, 0) | |
| 15376 | ..N X,X1, X2 S X1=+$ G(PSGRDTX) ,X2=$S($G( CLOZPAT)=2 :28,$G(CLO ZPAT)=1:14 ,$G(CLOZPA T)=0:7,$G( CLOZPAT)=3 :4,1:90) | |
| 15377 | "RTN","PSJ CLOZ",126, 0) | |
| 15378 | ..D C^%DT C S PSGFD= X,PSGFDN=$ $ENDD^PSGM I(PSGFD)_" ^"_$$ENDTC ^PSGMI(PSG FD) | |
| 15379 | "RTN","PSJ CLOZ",127, 0) | |
| 15380 | Q | |
| 15381 | "RTN","PSJ CLOZ",128, 0) | |
| 15382 | CMPLX3 ;SE COND COMPL EX THEN OR DER LOGIC | |
| 15383 | "RTN","PSJ CLOZ",129, 0) | |
| 15384 | Q:'$$GET1 ^DIQ(53.1, +$G(PSGORD ),125,"I") | |
| 15385 | "RTN","PSJ CLOZ",130, 0) | |
| 15386 | I PSGSTAT ="NON-VERI FIED" D DI SPCMP(PSGO RD,PSGFD) D Q | |
| 15387 | "RTN","PSJ CLOZ",131, 0) | |
| 15388 | .I $G(PSS D) S PSGFD =PSSD,PSGF DN=$$ENDD^ PSGMI(PSGF D)_"^"_$$E NDTC^PSGMI (PSGFD) K PSSD | |
| 15389 | "RTN","PSJ CLOZ",132, 0) | |
| 15390 | D CLOZPAT ,ANDTHEN | |
| 15391 | "RTN","PSJ CLOZ",133, 0) | |
| 15392 | I $G(PSGT YP)="T"!($ G(PSGTYP)= "TA") Q | |
| 15393 | "RTN","PSJ CLOZ",134, 0) | |
| 15394 | N X,X1,X2 S X1=+$G( PSGRDTX),X 2=$S($G(CL OZPAT)=2:2 8,$G(CLOZP AT)=1:14,$ G(CLOZPAT) =0:7,$G(CL OZPAT)=3:4 ,1:90) | |
| 15395 | "RTN","PSJ CLOZ",135, 0) | |
| 15396 | D C^%DTC S PSGFD=X, PSGFDN=$$E NDD^PSGMI( PSGFD)_"^" _$$ENDTC^P SGMI(PSGFD ) | |
| 15397 | "RTN","PSJ CLOZ",136, 0) | |
| 15398 | Q | |
| 15399 | "RTN","PSJ CLOZ",137, 0) | |
| 15400 | CLOZPAT ;V ERIFY PATI ENT IS A C LOZAPINE P ATIENT | |
| 15401 | "RTN","PSJ CLOZ",138, 0) | |
| 15402 | K CLOZPAT | |
| 15403 | "RTN","PSJ CLOZ",139, 0) | |
| 15404 | I $L($$GE T1^DIQ(55, DFN,53)),$ $GET1^DIQ( 55,DFN,54, "I")'="D" D | |
| 15405 | "RTN","PSJ CLOZ",140, 0) | |
| 15406 | .I $$GET1 ^DIQ(55,DF N,53)?1U6N S CLOZPAT =3 Q | |
| 15407 | "RTN","PSJ CLOZ",141, 0) | |
| 15408 | .N CLOZNU M,CLOZUID | |
| 15409 | "RTN","PSJ CLOZ",142, 0) | |
| 15410 | .S CLOZNU M=$$GET1^D IQ(55,DFN, 53) Q:CLOZ NUM="" | |
| 15411 | "RTN","PSJ CLOZ",143, 0) | |
| 15412 | .S CLOZUI D=$$FIND1^ DIC(603.01 ,,"X",CLOZ NUM) Q:'CL OZUID | |
| 15413 | "RTN","PSJ CLOZ",144, 0) | |
| 15414 | .S CLOZPA T=$$GET1^D IQ(603.01, CLOZUID,2, "I") | |
| 15415 | "RTN","PSJ CLOZ",145, 0) | |
| 15416 | .S CLOZPA T=$S($G(CL OZPAT)="M" :2,$G(CLOZ PAT)="B":1 ,$G(CLOZPA T)="W":0,1 :90) | |
| 15417 | "RTN","PSJ CLOZ",146, 0) | |
| 15418 | Q | |
| 15419 | "RTN","PSJ CLOZ",147, 0) | |
| 15420 | ANDTHEN ;C OMPLEX AND /THEN ORDE R | |
| 15421 | "RTN","PSJ CLOZ",148, 0) | |
| 15422 | Q:'$$GET1 ^DIQ(53.1, +$G(PSGORD ),125,"I") | |
| 15423 | "RTN","PSJ CLOZ",149, 0) | |
| 15424 | Q:+$G(PSG COPY) | |
| 15425 | "RTN","PSJ CLOZ",150, 0) | |
| 15426 | N PSGTMP, PSGID S PS GTMP=+$$GE T1^DIQ(53. 1,+$G(PSGO RD),125,"I "),PSGTYP= "" | |
| 15427 | "RTN","PSJ CLOZ",151, 0) | |
| 15428 | S PSGID=$ $FIND1^DIC (100.045," ,"_PSGTMP_ ",","X","C ONJ","ID") I PSGID D | |
| 15429 | "RTN","PSJ CLOZ",152, 0) | |
| 15430 | .S PSGTYP =PSGTYP_$$ GET1^DIQ(1 00.045,PSG ID_","_PSG TMP,1) | |
| 15431 | "RTN","PSJ CLOZ",153, 0) | |
| 15432 | Q | |
| 15433 | "RTN","PSJ CLOZ",154, 0) | |
| 15434 | DISPCMP(PS GORD,PSSD) ;COMPLEX ORDER CHEC K | |
| 15435 | "RTN","PSJ CLOZ",155, 0) | |
| 15436 | Q:'$$GET1 ^DIQ(53.1, +$G(PSGORD ),125,"I") | |
| 15437 | "RTN","PSJ CLOZ",156, 0) | |
| 15438 | S PSSD=+$ $GET1^DIQ( 53.1,+$G(P SGORD),117 ,"I") | |
| 15439 | "RTN","PSJ CLOZ",157, 0) | |
| 15440 | Q | |
| 15441 | "RTN","PSJ CLOZ",158, 0) | |
| 15442 | EXTDT ;VER IFY EXTERN AL DATE | |
| 15443 | "RTN","PSJ CLOZ",159, 0) | |
| 15444 | Q | |
| 15445 | "RTN","PSJ CLOZ",160, 0) | |
| 15446 | ;/RBN Beg in modific ations to comply wit h SACC sta ndard for routine le ngth limit s | |
| 15447 | "RTN","PSJ CLOZ",161, 0) | |
| 15448 | MSG1 ; | |
| 15449 | "RTN","PSJ CLOZ",162, 0) | |
| 15450 | W !!,"Per mission to dispense clozapine has been d enied. The results o f the late st",! | |
| 15451 | "RTN","PSJ CLOZ",163, 0) | |
| 15452 | W "Lab Te st drawn i n the past 7 days sh ow ANC res ults but N o Matching WBC.",! | |
| 15453 | "RTN","PSJ CLOZ",164, 0) | |
| 15454 | W "If you wish to d ispense ou tside the FDA and VA protocol ANC limits ,",! | |
| 15455 | "RTN","PSJ CLOZ",165, 0) | |
| 15456 | W "docume nt your re quest to R equest for Override of Pharmac y Lockout ",! | |
| 15457 | "RTN","PSJ CLOZ",166, 0) | |
| 15458 | W "(from VHA Handbo ok 1160.02 ) Director of the",! | |
| 15459 | "RTN","PSJ CLOZ",167, 0) | |
| 15460 | W "VA Nat ional Cloz apine Coor dinating C enter",! | |
| 15461 | "RTN","PSJ CLOZ",168, 0) | |
| 15462 | W "(Phone : 214-857- 0068 Fax: 214-857-03 39) for a one-time o verride pe rmission." ,! | |
| 15463 | "RTN","PSJ CLOZ",169, 0) | |
| 15464 | W !,"No o rder enter ed!" | |
| 15465 | "RTN","PSJ CLOZ",170, 0) | |
| 15466 | S ANQX=1 | |
| 15467 | "RTN","PSJ CLOZ",171, 0) | |
| 15468 | Q | |
| 15469 | "RTN","PSJ CLOZ",172, 0) | |
| 15470 | MSG2 ; | |
| 15471 | "RTN","PSJ CLOZ",173, 0) | |
| 15472 | W !!,"Per mission to dispense clozapine has been d enied. The results o f the late st",! | |
| 15473 | "RTN","PSJ CLOZ",174, 0) | |
| 15474 | W "Lab Te st drawn i n the past 7 days sh ow No ANC results. I f you wish to dispen se",! | |
| 15475 | "RTN","PSJ CLOZ",175, 0) | |
| 15476 | W "outsid e the FDA and VA pro tocol ANC limits, do cument you r request to Request ",! | |
| 15477 | "RTN","PSJ CLOZ",176, 0) | |
| 15478 | W "for Ov erride of Pharmacy L ockout (fr om VHA Han dbook 1160 .02) Direc tor of the ",! | |
| 15479 | "RTN","PSJ CLOZ",177, 0) | |
| 15480 | W "VA Nat ional Cloz apine Coor dinating C enter",! | |
| 15481 | "RTN","PSJ CLOZ",178, 0) | |
| 15482 | W "(Phone : 214-857- 0068 Fax: 214-857-03 39) for a one-time o verride pe rmission." ,! | |
| 15483 | "RTN","PSJ CLOZ",179, 0) | |
| 15484 | W !,"No o rder enter ed!" | |
| 15485 | "RTN","PSJ CLOZ",180, 0) | |
| 15486 | S ANQX=1 | |
| 15487 | "RTN","PSJ CLOZ",181, 0) | |
| 15488 | Q | |
| 15489 | "RTN","PSJ CLOZ",182, 0) | |
| 15490 | MSG3 ; | |
| 15491 | "RTN","PSJ CLOZ",183, 0) | |
| 15492 | W !,"A CB C/Differen tial inclu ding ANC M ust Be Ord ered and M onitored o n a",! | |
| 15493 | "RTN","PSJ CLOZ",184, 0) | |
| 15494 | W "Daily basis unti l the ANC above 1000 /mm3 with no signs o f infectio n.",! | |
| 15495 | "RTN","PSJ CLOZ",185, 0) | |
| 15496 | W "If ANC is betwee n 1000-149 9, therapy can be co ntinued bu t physicia n must ord er",! | |
| 15497 | "RTN","PSJ CLOZ",186, 0) | |
| 15498 | W "lab te st three t imes weekl y." | |
| 15499 | "RTN","PSJ CLOZ",187, 0) | |
| 15500 | Q | |
| 15501 | "RTN","PSJ CLOZ",188, 0) | |
| 15502 | MSG4 ; | |
| 15503 | "RTN","PSJ CLOZ",189, 0) | |
| 15504 | W !,"Perm ission to dispense c lozapine h as been de nied. If t he results of the la test" | |
| 15505 | "RTN","PSJ CLOZ",190, 0) | |
| 15506 | W !,"Lab Test drawn in the pa st 7 days show ANC b elow 1000/ mm3 and yo u wish to" | |
| 15507 | "RTN","PSJ CLOZ",191, 0) | |
| 15508 | W !,"disp ense outsi de the FDA and VA pr otocol ANC limits, d ocument yo ur request to" | |
| 15509 | "RTN","PSJ CLOZ",192, 0) | |
| 15510 | W !,"Requ est for Ov erride of Pharmacy L ockout (fr om VHA Han dbook 1160 .02)" | |
| 15511 | "RTN","PSJ CLOZ",193, 0) | |
| 15512 | W !,"Dire ctor of th e VA Natio nal Clozap ine Coordi nating Cen ter" | |
| 15513 | "RTN","PSJ CLOZ",194, 0) | |
| 15514 | W !,"(Pho ne: 214-85 7-0068 Fax : 214-857- 0339) for a one-time override permission .",! | |
| 15515 | "RTN","PSJ CLOZ",195, 0) | |
| 15516 | S ANQX=1 | |
| 15517 | "RTN","PSJ CLOZ",196, 0) | |
| 15518 | Q | |
| 15519 | "RTN","PSJ CLOZ",197, 0) | |
| 15520 | MSG5 ; | |
| 15521 | "RTN","PSJ CLOZ",198, 0) | |
| 15522 | W !!,"Per mission to dispense clozapine has been d enied. Ple ase contac t the" | |
| 15523 | "RTN","PSJ CLOZ",199, 0) | |
| 15524 | W !,"Dire ctor of th e VA Natio nal Clozap ine Coordi nating Cen ter" | |
| 15525 | "RTN","PSJ CLOZ",200, 0) | |
| 15526 | W !!,"Req uest for O verride of Pharmacy Lockout (f rom VHA Ha ndbook 116 0.02)" | |
| 15527 | "RTN","PSJ CLOZ",201, 0) | |
| 15528 | W !,"(Pho ne: 214-85 7-0068 Fax : 214-857- 0339).",! | |
| 15529 | "RTN","PSJ CLOZ",202, 0) | |
| 15530 | Q | |
| 15531 | "RTN","PSJ CLOZ",203, 0) | |
| 15532 | MSG6 ; ; * * START NC C REMEDIAT ION ** 457 AND PSJ 3 27/RTW MSG 6 added f or new cri tically lo w ANC leve ls clozapi ne overrid e requirem ents | |
| 15533 | "RTN","PSJ CLOZ",204, 0) | |
| 15534 | W !!,"Thi s clozapin e drug may not be di spensed to the patie nt at this time base d on the a vailable l ab tests r elated to the clozap ine treatm ent progra m." | |
| 15535 | "RTN","PSJ CLOZ",205, 0) | |
| 15536 | W !!,"Ple ase contac t the NCCC to reques t an overr ide in ord er to proc eed with d ispensing this drug. " | |
| 15537 | "RTN","PSJ CLOZ",206, 0) | |
| 15538 | W !!,"Req uest for O verride of Pharmacy Lockout (f rom VHA Ha ndbook 116 0.02)" | |
| 15539 | "RTN","PSJ CLOZ",207, 0) | |
| 15540 | W !!,"The matching ANC count s which ca used the l ockout are of lab te st results performed on " | |
| 15541 | "RTN","PSJ CLOZ",208, 0) | |
| 15542 | S ANQX=1, Y=$P(PSOYS ,"^",6) X ^DD("DD") W $P(Y,"@" ) | |
| 15543 | "RTN","PSJ CLOZ",209, 0) | |
| 15544 | W !!,?5," ANC: "_$P( PSOYS,"^", 4),! | |
| 15545 | "RTN","PSJ CLOZ",210, 0) | |
| 15546 | Q | |
| 15547 | "RTN","PSJ CLOZ",211, 0) | |
| 15548 | MSG9 ; | |
| 15549 | "RTN","PSJ CLOZ",212, 0) | |
| 15550 | W !,"*** Permission to dispen se clozapi ne has bee n denied b ased on th e availabl e" | |
| 15551 | "RTN","PSJ CLOZ",213, 0) | |
| 15552 | W !," lab tests related to the cloza pine treat ment progr am. ***" | |
| 15553 | "RTN","PSJ CLOZ",214, 0) | |
| 15554 | W !!,"For a Nationa l Override to dispen se at the patient's normal fre quency," | |
| 15555 | "RTN","PSJ CLOZ",215, 0) | |
| 15556 | W !,"plea se contact the VA Na tional Clo zapine Coo rdinating Center to contact" | |
| 15557 | "RTN","PSJ CLOZ",216, 0) | |
| 15558 | W !,"the VA Nationa l Clozapin e Coordina ting Cente r request an Overrid e of" | |
| 15559 | "RTN","PSJ CLOZ",217, 0) | |
| 15560 | W !,"Phar macy Locko ut (from V HA Handboo k 1160.02) " | |
| 15561 | "RTN","PSJ CLOZ",218, 0) | |
| 15562 | W !,"(Pho ne: 214-85 7-0068 Fax : 214-857- 0339)." | |
| 15563 | "RTN","PSJ CLOZ",219, 0) | |
| 15564 | W !,"A Sp ecial Cond itions Loc al Overrid e can be a pproved fo r" | |
| 15565 | "RTN","PSJ CLOZ",220, 0) | |
| 15566 | W !,"(1) weather-re lated cond itions, (2 ) mail ord er delays of clozapi ne, or" | |
| 15567 | "RTN","PSJ CLOZ",221, 0) | |
| 15568 | W !,"(3) inpatient going on l eave. With Provider' s document ation of a pproval," | |
| 15569 | "RTN","PSJ CLOZ",222, 0) | |
| 15570 | W !,"you may dispen se a one-t ime supply not to ex ceed 4 day s.",! | |
| 15571 | "RTN","PSJ CLOZ",223, 0) | |
| 15572 | Q | |
| 15573 | "RTN","PSJ CLOZ",224, 0) | |
| 15574 | ; | |
| 15575 | "RTN","PSJ CLOZ",225, 0) | |
| 15576 | ;/RBN Beg in of modi fications for new me ssage for IP 4 day o verrride. | |
| 15577 | "RTN","PSJ CLOZ",226, 0) | |
| 15578 | MSG10 ; | |
| 15579 | "RTN","PSJ CLOZ",227, 0) | |
| 15580 | W !,"*** Permission to dispen se clozapi ne has bee n denied b ased on th e availabl e" | |
| 15581 | "RTN","PSJ CLOZ",228, 0) | |
| 15582 | W !," lab tests related to the cloza pine treat ment progr am. ***" | |
| 15583 | "RTN","PSJ CLOZ",229, 0) | |
| 15584 | W !!,"For a Nationa l Override to dispen se at the patient's normal fre quency," | |
| 15585 | "RTN","PSJ CLOZ",230, 0) | |
| 15586 | W !,"plea se contact the VA Na tional Clo zapine Coo rdinating Center to request an " | |
| 15587 | "RTN","PSJ CLOZ",231, 0) | |
| 15588 | W !,"Over ride of Ph armacy Loc kout (from VHA Handb ook 1160.0 2) (Phone: 214-857-0 068" | |
| 15589 | "RTN","PSJ CLOZ",232, 0) | |
| 15590 | W !,"Fax: 214-857-0 339)." | |
| 15591 | "RTN","PSJ CLOZ",233, 0) | |
| 15592 | W !,"A Sp ecial Cond itions Loc al Overrid e for Inpa tients can be approv ed for an" | |
| 15593 | "RTN","PSJ CLOZ",234, 0) | |
| 15594 | W !,"IP O verride Or der with O utside Lab Results. With Provi der's docu mentation of" | |
| 15595 | "RTN","PSJ CLOZ",235, 0) | |
| 15596 | W !,"appr oval, you may dispen se a one-t ime IP sup ply not to exceed 4 days." | |
| 15597 | "RTN","PSJ CLOZ",236, 0) | |
| 15598 | W !,"The ANC from a nother fac ility must be record ed in the Progress n ote/commen ts" | |
| 15599 | "RTN","PSJ CLOZ",237, 0) | |
| 15600 | W !,"in p harmacy" | |
| 15601 | "RTN","PSJ CLOZ",238, 0) | |
| 15602 | Q | |
| 15603 | "RTN","PSJ CLOZ",239, 0) | |
| 15604 | ;/RBN End of modifi cations fo r new mess age for IP 4 day ove rrride. | |
| 15605 | "RTN","PSJ CLOZ",240, 0) | |
| 15606 | ; ** END NCC REMEDI ATION ** 4 57 AND PSJ 327/RTW | |
| 15607 | "RTN","PSJ CLOZ",241, 0) | |
| 15608 | ; | |
| 15609 | "RTN","PSJ CLOZ",242, 0) | |
| 15610 | COMPLEX ; Display Co mplex Orde r stop dat e warning message < <RJS | |
| 15611 | "RTN","PSJ CLOZ",243, 0) | |
| 15612 | Q:$G(PSGF LG) | |
| 15613 | "RTN","PSJ CLOZ",244, 0) | |
| 15614 | Q:'$$GET1 ^DIQ(53.1, +$G(PSGORD ),125,"I") | |
| 15615 | "RTN","PSJ CLOZ",245, 0) | |
| 15616 | N PSGFDT ;,PSGSD,P SGYS,X,X1, X2 | |
| 15617 | "RTN","PSJ CLOZ",246, 0) | |
| 15618 | D CLOZPAT | |
| 15619 | "RTN","PSJ CLOZ",247, 0) | |
| 15620 | S X1=+$G( PSGSD),X2= $S($G(CLOZ PAT)=2:28, $G(CLOZPAT )=1:14,$G( CLOZPAT)=0 :7,$G(CLOZ PAT)=3:4,1 :90) | |
| 15621 | "RTN","PSJ CLOZ",248, 0) | |
| 15622 | D C^%DTC S PSGFDT=$ E(X,4,5)_" /"_$E(X,6, 7)_"/"_$E( X,2,3) | |
| 15623 | "RTN","PSJ CLOZ",249, 0) | |
| 15624 | W !!,?25, "* WARNING *",!!,?10 ,"This ord er contain s a reques ted durati on." | |
| 15625 | "RTN","PSJ CLOZ",250, 0) | |
| 15626 | W !,?8,"P lease revi ew the sys tem calcul ated stop date",!,?5 ,"to confi rm that it is within the allow able durat ion" | |
| 15627 | "RTN","PSJ CLOZ",251, 0) | |
| 15628 | W !,?13," of the ord er based o n the pati ent's",!,? 11,"author ized cloza pine dispe nse freque ncy.",! | |
| 15629 | "RTN","PSJ CLOZ",252, 0) | |
| 15630 | W !,?10," Order stop date shou ld not exc eed ",PSGF DT,!,!,?1, "Review th e entire p rofile to determine appropriat e action(s ).",! | |
| 15631 | "RTN","PSJ CLOZ",253, 0) | |
| 15632 | K PSGCOMP D PAUSE^V ALM1 S PSG FLG=1 | |
| 15633 | "RTN","PSJ CLOZ",254, 0) | |
| 15634 | Q | |
| 15635 | "RTN","PSJ CLOZ",255, 0) | |
| 15636 | COMPLEX1 ; Display C omplex Ord er stop da te warning message <<RJS | |
| 15637 | "RTN","PSJ CLOZ",256, 0) | |
| 15638 | Q:$G(PSGF LG) | |
| 15639 | "RTN","PSJ CLOZ",257, 0) | |
| 15640 | Q:'$$GET1 ^DIQ(53.1, +$G(PSGORD ),125,"I") | |
| 15641 | "RTN","PSJ CLOZ",258, 0) | |
| 15642 | N PSGFDT, MSG | |
| 15643 | "RTN","PSJ CLOZ",259, 0) | |
| 15644 | D CLOZPAT | |
| 15645 | "RTN","PSJ CLOZ",260, 0) | |
| 15646 | S X1=+$G( PSGSD),X2= $S($G(CLOZ PAT)=2:28, $G(CLOZPAT )=1:14,$G( CLOZPAT)=0 :7,$G(CLOZ PAT)=3:4,1 :90) | |
| 15647 | "RTN","PSJ CLOZ",261, 0) | |
| 15648 | D C^%DTC S PSGFDT=$ E(X,4,5)_" /"_$E(X,6, 7)_"/"_$E( X,2,3) | |
| 15649 | "RTN","PSJ CLOZ",262, 0) | |
| 15650 | S MSG=$J( "",25)_"* WARNING *" D INSTR^V ALM1("",1, 9,80,1),IN STR^VALM1( MSG,1,10,8 0,1) | |
| 15651 | "RTN","PSJ CLOZ",263, 0) | |
| 15652 | S MSG=$J( "",10)_"Th is order c ontains a requested duration." D INSTR^V ALM1(MSG,1 ,11,80,1) | |
| 15653 | "RTN","PSJ CLOZ",264, 0) | |
| 15654 | S MSG=$J( "",8)_"Ple ase review the syste m calculat ed stop da te" D INST R^VALM1(MS G,1,12,80, 1) | |
| 15655 | "RTN","PSJ CLOZ",265, 0) | |
| 15656 | S MSG=$J( "",5)_"to confirm th at it is w ithin the allowable duration" D INSTR^VA LM1(MSG,1, 13,80,1) | |
| 15657 | "RTN","PSJ CLOZ",266, 0) | |
| 15658 | S MSG=$J( "",13)_"of the order based on the patien t's" D INS TR^VALM1(M SG,1,14,80 ,1) | |
| 15659 | "RTN","PSJ CLOZ",267, 0) | |
| 15660 | S MSG=$J( "",11)_"au thorized c lozapine d ispense fr equency." D INSTR^VA LM1(MSG,1, 15,80,1) | |
| 15661 | "RTN","PSJ CLOZ",268, 0) | |
| 15662 | S MSG=$J( "",10)_"Or der stop d ate should not excee d "_PSGFDT D INSTR^V ALM1(MSG,1 ,17,80,1) | |
| 15663 | "RTN","PSJ CLOZ",269, 0) | |
| 15664 | S MSG=" R eview the entire pro file to de termine ap propriate action(s). " D INSTR^ VALM1(MSG, 1,18,80,1) | |
| 15665 | "RTN","PSJ CLOZ",270, 0) | |
| 15666 | N LN F LN =16,19 D I NSTR^VALM1 ("",1,LN,8 0,1) | |
| 15667 | "RTN","PSJ CLOZ",271, 0) | |
| 15668 | K PSGCOMP D PAUSE^V ALM1 S PSG FLG=1 | |
| 15669 | "RTN","PSJ CLOZ",272, 0) | |
| 15670 | Q | |
| 15671 | "RTN","PSJ CLOZ",273, 0) | |
| 15672 | LASTCHLD(D FN,ON) ; L ast child of Complex order or not | |
| 15673 | "RTN","PSJ CLOZ",274, 0) | |
| 15674 | N FL,PSOR DA,PSORD1 I ON'["U", ON'["V" Q 1 | |
| 15675 | "RTN","PSJ CLOZ",275, 0) | |
| 15676 | I ON["U" D Q:'PSOR DA 1 Q:'P SORD1 1 Q 0 | |
| 15677 | "RTN","PSJ CLOZ",276, 0) | |
| 15678 | .S PSORDA =$$GET1^DI Q(55.06,+O N_","_DFN, 125,"I"),P SORD1=+$$G ET1^DIQ(55 .06,+ON_", "_DFN,66," I") | |
| 15679 | "RTN","PSJ CLOZ",277, 0) | |
| 15680 | .I 'PSORD A!'PSORD1 Q | |
| 15681 | "RTN","PSJ CLOZ",278, 0) | |
| 15682 | .N ORARR, MAX D LIST ^DIC(100.0 02,","_PSO RDA_",",," I",,,,,,," ORARR") S MAX=+ORARR ("DILIST", 0) | |
| 15683 | "RTN","PSJ CLOZ",279, 0) | |
| 15684 | .F I=1:1 Q:'$D(ORAR R("DILIST" ,2,I)) I ORARR("DIL IST",2,I)= PSORD1 Q | |
| 15685 | "RTN","PSJ CLOZ",280, 0) | |
| 15686 | .S:I=MAX PSORD1=0 Q | |
| 15687 | "RTN","PSJ CLOZ",281, 0) | |
| 15688 | I ON["V" D Q:'PSOR DA 1 Q:'P SORD1 1 Q 0 | |
| 15689 | "RTN","PSJ CLOZ",282, 0) | |
| 15690 | .S PSORDA =$$GET1^DI Q(55.01,+O N_","_DFN, 150,"I"),P SORD1=+$$G ET1^DIQ(55 .01,+ON_", "_DFN,110, "I") | |
| 15691 | "RTN","PSJ CLOZ",283, 0) | |
| 15692 | .I 'PSORD A!'PSORD1 Q | |
| 15693 | "RTN","PSJ CLOZ",284, 0) | |
| 15694 | .N ORARR, MAX D LIST ^DIC(100.0 02,","_PSO RDA_",",," I",,,,,,," ORARR") S MAX=+ORARR ("DILIST", 0) | |
| 15695 | "RTN","PSJ CLOZ",285, 0) | |
| 15696 | .F I=1:1 Q:'$D(ORAR R("DILIST" ,2,I)) I ORARR("DIL IST",2,I)= PSORD1 Q | |
| 15697 | "RTN","PSJ CLOZ",286, 0) | |
| 15698 | .S:I=MAX PSORD1=0 Q | |
| 15699 | "RTN","PSJ CLOZ",287, 0) | |
| 15700 | Q 1 | |
| 15701 | "RTN","PSJ COM") | |
| 15702 | 0^18^B4768 0485 | |
| 15703 | "RTN","PSJ COM",1,0) | |
| 15704 | PSJCOM ;BI R/CML3-FIN ISH COMPLE X UNIT DOS E ORDERS E NTERED THR OUGH OE/RR ;Jul 26, 2017@18:04 :02 | |
| 15705 | "RTN","PSJ COM",2,0) | |
| 15706 | ;;5.0;INP ATIENT MED ICATIONS;* *110,186,2 67,281,315 ,327**;16 DEC 97;Bui ld 64 | |
| 15707 | "RTN","PSJ COM",3,0) | |
| 15708 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 15709 | "RTN","PSJ COM",4,0) | |
| 15710 | ; Referen ce to ^VAL M1 is supp orted by D BIA 10116. | |
| 15711 | "RTN","PSJ COM",5,0) | |
| 15712 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
| 15713 | "RTN","PSJ COM",6,0) | |
| 15714 | ; Referen ce to ^%DT C is suppo rted by DB IA 10000. | |
| 15715 | "RTN","PSJ COM",7,0) | |
| 15716 | ; Referen ce to ^%RC R is suppo rted by DB IA 10022. | |
| 15717 | "RTN","PSJ COM",8,0) | |
| 15718 | ; Referen ce to ^DIR is suppor ted by DBI A 10026. | |
| 15719 | "RTN","PSJ COM",9,0) | |
| 15720 | ; Referen ce to ^TIU EDIT is su pported by DBIA 2410 . | |
| 15721 | "RTN","PSJ COM",10,0) | |
| 15722 | ; Referen ce to ^TMP ("PSODAOC" ,$J suppor ted by DBI A 6071. | |
| 15723 | "RTN","PSJ COM",11,0) | |
| 15724 | ; | |
| 15725 | "RTN","PSJ COM",12,0) | |
| 15726 | UPD ; | |
| 15727 | "RTN","PSJ COM",13,0) | |
| 15728 | Q:'PSJCOM | |
| 15729 | "RTN","PSJ COM",14,0) | |
| 15730 | M ^TMP("P SJCOM",$J, +PSGORD)=^ PS(53.1,+P SGORD) | |
| 15731 | "RTN","PSJ COM",15,0) | |
| 15732 | I PSGST=" ",(PSGSCH= "NOW"!(PSG SCH="ONCE" )) S PSGST ="O" | |
| 15733 | "RTN","PSJ COM",16,0) | |
| 15734 | S $P(^TMP ("PSJCOM", $J,+PSGORD ,0),"^",9) ="N",$P(^( 0),"^",4)= "U",$P(^(0 ),"^",7)=P SGST,$P(^T MP("PSJCOM ",$J,+PSGO RD,2),"^", 2)=PSGSD,$ P(^(2),"^" ,4)=PSGFD | |
| 15735 | "RTN","PSJ COM",17,0) | |
| 15736 | I $D(PSGS I),$P($G(^ PS(53.1,+P SGORD,0)), U,24)'="R" S ^TMP("P SJCOM",$J, +PSGORD,6) =PSGSI | |
| 15737 | "RTN","PSJ COM",18,0) | |
| 15738 | I $D(PSGS I),$P($G(^ PS(53.1,+P SGORD,0)), U,24)="R" S $P(^TMP( "PSJCOM",$ J,+PSGORD, 6),U)=$P(P SGSI,U) I $P(PSGSI,U )="" S $P( ^TMP("PSJC OM",$J,+PS GORD,6),U, 2)="" | |
| 15739 | "RTN","PSJ COM",19,0) | |
| 15740 | S:$D(PSGS CH) $P(^TM P("PSJCOM" ,$J,+PSGOR D,2),"^")= PSGSCH | |
| 15741 | "RTN","PSJ COM",20,0) | |
| 15742 | I PSGSM,P SGOHSM'=PS GHSM S $P( ^TMP("PSJC OM",$J,+PS GORD,0),"^ ",5)=PSGSM ,$P(^TMP(" PSJCOM",$J ,+PSGORD,0 ),"^",6)=P SGHSM | |
| 15743 | "RTN","PSJ COM",21,0) | |
| 15744 | W "." | |
| 15745 | "RTN","PSJ COM",22,0) | |
| 15746 | S PSGOEEW F="^TMP("" PSJCOM"",$ J,+PSGORD, " | |
| 15747 | "RTN","PSJ COM",23,0) | |
| 15748 | F Q=1,3 K @(PSGOEEW F_Q_")") S %X="^PS(5 3.45,"_PSJ SYSP_","_$ S(Q=1:2,1: 1)_",",%Y= PSGOEEWF_Q _"," K @(P SGOEEWF_Q_ ")") D %XY ^%RCR W ". " ;MOU-01 00-30945 | |
| 15749 | "RTN","PSJ COM",24,0) | |
| 15750 | S PSGND=$ G(^TMP("PS JCOM",$J,+ PSGORD,0)) ,X=$P(PSGN D,U,24) | |
| 15751 | "RTN","PSJ COM",25,0) | |
| 15752 | S PSJOWAL L=+$G(^PS( 55,PSGP,5. 1)) | |
| 15753 | "RTN","PSJ COM",26,0) | |
| 15754 | I $S(X="R ":1,+$G(^P S(55,PSGP, 5.1))>PSGD T:0,1:X'=" E") S X=$G (^TMP("PSJ COM",$J,+P SGORD,2)) D ENWALL^P SGNE3(+$P( X,U,2),+$P (X,U,4),PS GP) | |
| 15755 | "RTN","PSJ COM",27,0) | |
| 15756 | S $P(^TMP ("PSJCOM", $J,+PSGORD ,.2),U,2)= PSGDO,$P(^ TMP("PSJCO M",$J,+PSG ORD,2),U,5 )=PSGAT S: $G(PSGS0XT ) $P(^(2), U,6)=PSGS0 XT | |
| 15757 | "RTN","PSJ COM",28,0) | |
| 15758 | S:PSGRF]" " ^TMP("PS JCOM",$J,+ PSGORD,2.1 )=$G(PSGDU R)_U_$G(PS GRMVT)_U_$ G(PSGRMV)_ U_$G(PSGRF ) K PSGDUR ,PSGRMVT,P SGRMV,PSGR F ;315 | |
| 15759 | "RTN","PSJ COM",29,0) | |
| 15760 | I 'PSGOEA V D NEWNVA L(PSGORD,$ S(+PSJSYSU =3:22005,1 :22000)) | |
| 15761 | "RTN","PSJ COM",30,0) | |
| 15762 | I $D(^PS( 53.45,DUZ, 5,1,0)) D FILESI^PSJ BCMA5(PSGP ,PSGORD) N SIARRAY S SIARRAY=" " D NEWNVA L^PSGAL5(P SGORD,6000 ,"SPECIAL INSTRUCTIO NS",,.SIAR RAY) | |
| 15763 | "RTN","PSJ COM",31,0) | |
| 15764 | I PSGOEAV ,+PSJSYSU= 3 D VFY Q | |
| 15765 | "RTN","PSJ COM",32,0) | |
| 15766 | I PSGOEAV ,$G(PSJRNF ) D VFY | |
| 15767 | "RTN","PSJ COM",33,0) | |
| 15768 | Q | |
| 15769 | "RTN","PSJ COM",34,0) | |
| 15770 | VFY ; chan ge status, move to 5 5, and cha nge label record | |
| 15771 | "RTN","PSJ COM",35,0) | |
| 15772 | Q:'PSJCOM | |
| 15773 | "RTN","PSJ COM",36,0) | |
| 15774 | S ^TMP("P SODAOC",$J ,"IP IEN") =PSGORD | |
| 15775 | "RTN","PSJ COM",37,0) | |
| 15776 | D SETOC^P SJNEWOC(PS GORD) | |
| 15777 | "RTN","PSJ COM",38,0) | |
| 15778 | I '$D(^TM P("PSJCOM" ,$J,+PSGOR D)) M ^TMP ("PSJCOM", $J,+PSGORD )=^PS(53.1 ,+PSGORD) | |
| 15779 | "RTN","PSJ COM",39,0) | |
| 15780 | NEW PSJDO SE,PSJDSFL G | |
| 15781 | "RTN","PSJ COM",40,0) | |
| 15782 | D DOSECHK ^PSJDOSE | |
| 15783 | "RTN","PSJ COM",41,0) | |
| 15784 | I +$G(PSJ DSFLG) D S ETVAR^PSJD OSE W !!,P SJDOSE("WA RN"),!,PSJ DOSE("WARN 1") I '$$C ONT() W !, "...order was not ve rified..." D PAUSE^V ALM1 D Q: '$G(PSJACE PT) | |
| 15785 | "RTN","PSJ COM",42,0) | |
| 15786 | . S PSGOE EF(109)=1 | |
| 15787 | "RTN","PSJ COM",43,0) | |
| 15788 | . S PSJAC EPT=0 | |
| 15789 | "RTN","PSJ COM",44,0) | |
| 15790 | D DDCHK G :CHK DONE | |
| 15791 | "RTN","PSJ COM",45,0) | |
| 15792 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 15793 | "RTN","PSJ COM",46,0) | |
| 15794 | N PSGDRG S PSGDRG=+ ^TMP("PSJC OM",$J,+PS GORD,1,1,0 ) I 'PSGDR G S PSGDRG =+$$GET1^D IQ(53.11," 1,"_+$G(PS GORD),.01, "I") | |
| 15795 | "RTN","PSJ COM",47,0) | |
| 15796 | I $G(PSGD RG),$$GET1 ^DIQ(50,PS GDRG,17.5) ="PSOCLO1" ,'$G(^TMP( "PSJCOM",$ J,+PSGORD, "SAND")) D G:CHK DO NE | |
| 15797 | "RTN","PSJ COM",48,0) | |
| 15798 | .S DIR(0) ="N^12.5:3 000:1",DIR ("A")="CLO ZAPINE dos age (mg/da y) ? " D ^ DIR K DIR I $D(DIRUT ) S CHK=1 Q ;G DONE :$G(CHK) | |
| 15799 | "RTN","PSJ COM",49,0) | |
| 15800 | .S (^TMP( "PSJCOM",$ J,+PSGORD, "SAND"),PS OSAND)=X | |
| 15801 | "RTN","PSJ COM",50,0) | |
| 15802 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 15803 | "RTN","PSJ COM",51,0) | |
| 15804 | W !,"...a few momen ts, please ..." | |
| 15805 | "RTN","PSJ COM",52,0) | |
| 15806 | I PSGORD[ "P" D | |
| 15807 | "RTN","PSJ COM",53,0) | |
| 15808 | . S PSGOR DP=PSGORD ;Used in A CTLOG to u pdate acti vity log i n ^TMP | |
| 15809 | "RTN","PSJ COM",54,0) | |
| 15810 | . I '$D(^ TMP("PSJCO M2",$J,+PS GORD)) D Q | |
| 15811 | "RTN","PSJ COM",55,0) | |
| 15812 | .. NEW PS GX S PSGX= $G(^TMP("P SJCOM",$J, +PSGORD,2. 5)),PSGRSD =$P(PSGX,U ),PSGRFD=$ P(PSGX,U,3 ) | |
| 15813 | "RTN","PSJ COM",56,0) | |
| 15814 | .. S $P(^ TMP("PSJCO M",$J,+PSG ORD,0),"^" ,9)="A" W "." ;D ^PS GOT | |
| 15815 | "RTN","PSJ COM",57,0) | |
| 15816 | . NEW PS GX S PSGX= $G(^TMP("P SJCOM2",$J ,+PSGORD,2 .5)),PSGRS D=$P(PSGX, U),PSGRFD= $P(PSGX,U, 3) | |
| 15817 | "RTN","PSJ COM",58,0) | |
| 15818 | . S $P(^ TMP("PSJCO M2",$J,+PS GORD,0),"^ ",9)="A" W "." ;D ^P SGOT | |
| 15819 | "RTN","PSJ COM",59,0) | |
| 15820 | D NEWNVAL (+PSGORD,( PSJSYSU*10 +22000)) W "." | |
| 15821 | "RTN","PSJ COM",60,0) | |
| 15822 | S VND4=$S ('$D(^TMP( "PSJCOM2", $J,+PSGORD )):$G(^TMP ("PSJCOM", $J,+PSGORD ,4)),1:$G( ^TMP("PSJC OM2",$J,+P SGORD,4))) | |
| 15823 | "RTN","PSJ COM",61,0) | |
| 15824 | I $G(PSGR SD) D | |
| 15825 | "RTN","PSJ COM",62,0) | |
| 15826 | . S PSGRS D=$$ENDTC^ PSGMI(PSGR SD) D NEWN VAL(PSGORD ,6090,"Req uested Sta rt Date",P SGRSD) | |
| 15827 | "RTN","PSJ COM",63,0) | |
| 15828 | . S PSGRF D=$$ENDTC^ PSGMI(PSGR FD) D NEWN VAL(PSGORD ,6090,"Req uested Sto p Date",PS GRFD) | |
| 15829 | "RTN","PSJ COM",64,0) | |
| 15830 | N DUR,DUR ORD S DURO N=$S($G(ON )&($G(PSGO RD)["U"):O N,$G(PSGOR D):PSGORD, 1:"") Q:'D URON D | |
| 15831 | "RTN","PSJ COM",65,0) | |
| 15832 | . S DUR=$ S($P($G(PS GRDTX),U,2 )]"":$P($G (PSGRDTX), U,2),1:$$G ETDUR^PSJL IVMD(PSGP, +DURON,$S( $G(DURON)[ "P":"P",$G (DURON)["V ":"IV",1:5 ),1),1:"") | |
| 15833 | "RTN","PSJ COM",66,0) | |
| 15834 | I DUR]"" S $P(^TMP( "PSJCOM2", $J,+PSGORD ,2.5),"^", 2)=DUR | |
| 15835 | "RTN","PSJ COM",67,0) | |
| 15836 | ;D:$D(PSG ORDP) ACTL OG(PSGORDP ,PSGP,PSGO RD) | |
| 15837 | "RTN","PSJ COM",68,0) | |
| 15838 | K PSGRSD, PSGRFD,PSG ALFN | |
| 15839 | "RTN","PSJ COM",69,0) | |
| 15840 | NEW X S X =0 I $G(PS GONF),(+$G (PSGODDD(1 ))'<+$G(PS GONF)) S X =1 | |
| 15841 | "RTN","PSJ COM",70,0) | |
| 15842 | I +PSJSYS U=3,PSGORD '["O",$S(X :0,'$P(VND 4,"^",16): 1,1:$P(VND 4,"^",15)) ;D EN^PSG PEN(+PSGOR D) | |
| 15843 | "RTN","PSJ COM",71,0) | |
| 15844 | S:'$P(VND 4,U,+PSJSY SU=3+9) $P (VND4,U,+P SJSYSU=3+9 )=+$P(VND4 ,U,+PSJSYS U=3+9) | |
| 15845 | "RTN","PSJ COM",72,0) | |
| 15846 | S:$P(VND4 ,"^",15)&' $P(VND4,"^ ",16) $P(V ND4,"^",15 )="" S:$P( VND4,"^",1 8)&'$P(VND 4,"^",19) $P(VND4,"^ ",18)="" S :$P(VND4," ^",22)&'$P (VND4,"^", 23) $P(VND 4,"^",22)= "" | |
| 15847 | "RTN","PSJ COM",73,0) | |
| 15848 | S $P(VND4 ,"^",PSJSY SU,PSJSYSU +1)=DUZ_"^ "_PSGDT | |
| 15849 | "RTN","PSJ COM",74,0) | |
| 15850 | S:'$D(^TM P("PSJCOM2 ",$J,+PSGO RD)) ^TMP( "PSJCOM",$ J,+PSGORD, 4)=VND4 S: $D(^TMP("P SJCOM2",$J ,+PSGORD)) ^TMP("PSJ COM2",$J,+ PSGORD,4)= VND4 | |
| 15851 | "RTN","PSJ COM",75,0) | |
| 15852 | W:'$D(PSJ SPEED) ! W !,"ORDER VERIFIED." ,! | |
| 15853 | "RTN","PSJ COM",76,0) | |
| 15854 | I $G(PSGD RG),$$GET1 ^DIQ(50,PS GDRG,17.5) ="PSOCLO1" ,$L($G(ANQ DATA)) S ^ TMP("PSJCO M",$J,+PSG ORD,"ANQDA TA")=ANQDA TA | |
| 15855 | "RTN","PSJ COM",77,0) | |
| 15856 | I '$D(PSJ SPEED) K D IR S DIR(0 )="E" D ^D IR K DIR | |
| 15857 | "RTN","PSJ COM",78,0) | |
| 15858 | S VALMBCK ="Q" | |
| 15859 | "RTN","PSJ COM",79,0) | |
| 15860 | S ^TMP("P SJCOM",$J) ="A" S:$D( ^TMP("PSJC OM2",$J,+P SGORD)) ^T MP("PSJCOM 2",$J)="A" | |
| 15861 | "RTN","PSJ COM",80,0) | |
| 15862 | ; | |
| 15863 | "RTN","PSJ COM",81,0) | |
| 15864 | DONE ; | |
| 15865 | "RTN","PSJ COM",82,0) | |
| 15866 | W:CHK !!, "...order NOT verifi ed..." | |
| 15867 | "RTN","PSJ COM",83,0) | |
| 15868 | I '$D(PSJ SPEED),'CH K,+PSJSYSU =3,$G(PSJP RI)="D" D | |
| 15869 | "RTN","PSJ COM",84,0) | |
| 15870 | .N DIR W ! S DIR(0) ="S^Y:Yes; N:No",DIR( "A")="Do y ou want to enter a P rogress No te",DIR("B ")="No" D ^DIR | |
| 15871 | "RTN","PSJ COM",85,0) | |
| 15872 | .Q:Y="N" | |
| 15873 | "RTN","PSJ COM",86,0) | |
| 15874 | .D MAIN^T IUEDIT(3,. TIUDA,PSGP ,"","","", "",1) | |
| 15875 | "RTN","PSJ COM",87,0) | |
| 15876 | S VALMBCK ="Q" K CHK ,DA,DIE,F, DP,DR,ND,P SGAL,PSGOD A,PSJDOSE, PSJVAR,VND 4,X,%X,%Y, Q,QQ Q | |
| 15877 | "RTN","PSJ COM",88,0) | |
| 15878 | ; | |
| 15879 | "RTN","PSJ COM",89,0) | |
| 15880 | DDCHK ; di spense dru g check | |
| 15881 | "RTN","PSJ COM",90,0) | |
| 15882 | S DRGF=$S ('$D(^TMP( "PSJCOM2", $J,+PSGORD )):"^TMP(" "PSJCOM"", "_$J_","_+ PSGORD_"," ,1:"^TMP(" "PSJCOM2"" ,"_$J_","_ +PSGORD_", "),CHK=$S( '$O(@(DRGF _"1,0)")): 7,1:0) | |
| 15883 | "RTN","PSJ COM",91,0) | |
| 15884 | S PSGPD=$ G(@(DRGF_" .2)")) | |
| 15885 | "RTN","PSJ COM",92,0) | |
| 15886 | S CHK=$S( '$$DDOK^PS GOE2(DRGF_ "1,",PSGPD ):7,1:0) | |
| 15887 | "RTN","PSJ COM",93,0) | |
| 15888 | Q:CHK=0 | |
| 15889 | "RTN","PSJ COM",94,0) | |
| 15890 | W $C(7),! !,"This or der must h ave at lea st one val id, active dispense drug to be verified. " | |
| 15891 | "RTN","PSJ COM",95,0) | |
| 15892 | ; | |
| 15893 | "RTN","PSJ COM",96,0) | |
| 15894 | CONT() ; | |
| 15895 | "RTN","PSJ COM",97,0) | |
| 15896 | NEW DIR,D IRUT,Y | |
| 15897 | "RTN","PSJ COM",98,0) | |
| 15898 | W ! K DIR ,DIRUT | |
| 15899 | "RTN","PSJ COM",99,0) | |
| 15900 | S DIR(0)= "Y",DIR("A ")="Would you like t o continue verifying the order ",DIR("B") ="No" | |
| 15901 | "RTN","PSJ COM",100,0 ) | |
| 15902 | D ^DIR | |
| 15903 | "RTN","PSJ COM",101,0 ) | |
| 15904 | Q Y | |
| 15905 | "RTN","PSJ COM",102,0 ) | |
| 15906 | ; | |
| 15907 | "RTN","PSJ COM",103,0 ) | |
| 15908 | NEWNVAL(PS GALORD,PSG ALC,PSGFLD ,PSGOLD) ; | |
| 15909 | "RTN","PSJ COM",104,0 ) | |
| 15910 | ; | |
| 15911 | "RTN","PSJ COM",105,0 ) | |
| 15912 | ;Where P SGALORD = PSGORD (Re quired) | |
| 15913 | "RTN","PSJ COM",106,0 ) | |
| 15914 | ; P SGALC = ACTIVITY C ODE FROM # 53.3 (Requ ired) | |
| 15915 | "RTN","PSJ COM",107,0 ) | |
| 15916 | ; P SGFLD = FIELD THAT CHANGED ( Free text, optional) | |
| 15917 | "RTN","PSJ COM",108,0 ) | |
| 15918 | ; P SGOLD = THE FIELDS OLD DATA VALUE (Fre e text, op tional) | |
| 15919 | "RTN","PSJ COM",109,0 ) | |
| 15920 | ; | |
| 15921 | "RTN","PSJ COM",110,0 ) | |
| 15922 | ;N PSGALO RD,PSGALC, PSGFLD,PSG OLD | |
| 15923 | "RTN","PSJ COM",111,0 ) | |
| 15924 | ; | |
| 15925 | "RTN","PSJ COM",112,0 ) | |
| 15926 | ; Create 0 node act ivity log for order if none ex ists, and get next e ntry numbe r | |
| 15927 | "RTN","PSJ COM",113,0 ) | |
| 15928 | I '$D(^TM P("PSJCOM2 ",$J,+PSGA LORD)) D Q | |
| 15929 | "RTN","PSJ COM",114,0 ) | |
| 15930 | . S QQ=$G (^TMP("PSJ COM",$J,+P SGALORD,"A ",0)) S:QQ ="" QQ="^5 3.1119D" F Q=$P(QQ," ^",3)+1:1 I '$D(^(Q) ) S $P(QQ, "^",3,4)=Q _"^"_Q,^(0 )=QQ,PSGAL ("N")=Q Q | |
| 15931 | "RTN","PSJ COM",115,0 ) | |
| 15932 | . ;Set up data to b e held in activity l og record | |
| 15933 | "RTN","PSJ COM",116,0 ) | |
| 15934 | . D NOW^% DTC S PSGD T=+$E(%,1, 12) | |
| 15935 | "RTN","PSJ COM",117,0 ) | |
| 15936 | . I $L($G (PSGOLD))> 170 S PSGO LD=$E(PSGO LD,1,167)_ "..." ; Us e of ... i ndicates o ld data fi eld was gr eater than 170 chara cters | |
| 15937 | "RTN","PSJ COM",118,0 ) | |
| 15938 | . S Q=%_" ^"_$S(PSGA LC=6010:"A UTO CANCEL ",$D(DUZ)[ 0:"UNKNOWN ",DUZ]"":D UZ,1:"UNKN OWN")_"^"_ PSGALC_"^" _$S($D(PSG FLD):PSGFL D,1:"")_"^ "_$S($D(PS GOLD):PSGO LD,1:"") | |
| 15939 | "RTN","PSJ COM",119,0 ) | |
| 15940 | . ; Creat e activity log entry | |
| 15941 | "RTN","PSJ COM",120,0 ) | |
| 15942 | . S ^TMP( "PSJCOM",$ J,+PSGALOR D,"A",PSGA L("N"),0)= Q | |
| 15943 | "RTN","PSJ COM",121,0 ) | |
| 15944 | S QQ=$G(^ TMP("PSJCO M2",$J,+PS GALORD,"A" ,0)) S:QQ= "" QQ="^53 .1119D" F Q=$P(QQ,"^ ",3)+1:1 I '$D(^(Q)) S $P(QQ," ^",3,4)=Q_ "^"_Q,^(0) =QQ,PSGAL( "N")=Q Q | |
| 15945 | "RTN","PSJ COM",122,0 ) | |
| 15946 | ;Set up d ata to be held in ac tivity log record | |
| 15947 | "RTN","PSJ COM",123,0 ) | |
| 15948 | D NOW^%DT C S PSGDT= +$E(%,1,12 ) | |
| 15949 | "RTN","PSJ COM",124,0 ) | |
| 15950 | I $L($G(P SGOLD))>17 0 S PSGOLD =$E(PSGOLD ,1,167)_". .." ; Use of ... ind icates old data fiel d was grea ter than 1 70 charact ers | |
| 15951 | "RTN","PSJ COM",125,0 ) | |
| 15952 | S Q=%_"^" _$S(PSGALC =6010:"AUT O CANCEL", $D(DUZ)[0: "UNKNOWN", DUZ]"":DUZ ,1:"UNKNOW N")_"^"_PS GALC_"^"_$ S($D(PSGFL D):PSGFLD, 1:"")_"^"_ $S($D(PSGO LD):PSGOLD ,1:"") | |
| 15953 | "RTN","PSJ COM",126,0 ) | |
| 15954 | ; Create activity l og entry | |
| 15955 | "RTN","PSJ COM",127,0 ) | |
| 15956 | S ^TMP("P SJCOM2",$J ,+PSGALORD ,"A",PSGAL ("N"),0)=Q | |
| 15957 | "RTN","PSJ COM",128,0 ) | |
| 15958 | Q | |
| 15959 | "RTN","PSJ COM1") | |
| 15960 | 0^31^B5458 7887 | |
| 15961 | "RTN","PSJ COM1",1,0) | |
| 15962 | PSJCOM1 ;B IR/CML3-DI SPLAY COMP LEX ORDERS FOR DISCO NTINUE ;Ju l 26, 2017 @18:04:02 | |
| 15963 | "RTN","PSJ COM1",2,0) | |
| 15964 | ;;5.0;INP ATIENT MED ICATIONS;* *110,127,2 81,315,327 **;16 DEC 97;Build 6 4 | |
| 15965 | "RTN","PSJ COM1",3,0) | |
| 15966 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 15967 | "RTN","PSJ COM1",4,0) | |
| 15968 | ; Referen ce to ^VAL M1 is supp orted by D BIA 10116. | |
| 15969 | "RTN","PSJ COM1",5,0) | |
| 15970 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
| 15971 | "RTN","PSJ COM1",6,0) | |
| 15972 | ; Referen ce to ^%DT C is suppo rted by DB IA 10000. | |
| 15973 | "RTN","PSJ COM1",7,0) | |
| 15974 | ; Referen ce to ^PS( 51.2 is su pported by DBIA 2178 . | |
| 15975 | "RTN","PSJ COM1",8,0) | |
| 15976 | ; Referen ce to ^DIE is suppor ted by DBI A 10018. | |
| 15977 | "RTN","PSJ COM1",9,0) | |
| 15978 | ; Referen ce to ^DIR is suppor ted by DBI A 10026. | |
| 15979 | "RTN","PSJ COM1",10,0 ) | |
| 15980 | ; Referen ce to ^TMP ("PSODAOC" ,$J suppor ted by DBI A 6071 | |
| 15981 | "RTN","PSJ COM1",11,0 ) | |
| 15982 | ; | |
| 15983 | "RTN","PSJ COM1",12,0 ) | |
| 15984 | CMPLX(PSGP ,ON,PSGORD ) ; | |
| 15985 | "RTN","PSJ COM1",13,0 ) | |
| 15986 | D PAUSE K PSJCM | |
| 15987 | "RTN","PSJ COM1",14,0 ) | |
| 15988 | N PSJLINE ,PSX,PSCM | |
| 15989 | "RTN","PSJ COM1",15,0 ) | |
| 15990 | S PSJLINE =1 | |
| 15991 | "RTN","PSJ COM1",16,0 ) | |
| 15992 | I PSGORD[ "P" N PSJO S PSJO=0 F S PSJO= $O(^PS(53. 1,"ACX",ON ,PSJO)) Q: 'PSJO D | |
| 15993 | "RTN","PSJ COM1",17,0 ) | |
| 15994 | .Q:PSJO=+ PSGORD S PSJOO=PSGO RD D DSPLO RDU(PSGP,P SJO_"P") S PSJCM(PSJ O_"P",PSJL INE)="",PS JLINE=PSJL INE+1 | |
| 15995 | "RTN","PSJ COM1",18,0 ) | |
| 15996 | I PSGORD' ["P" N PSJ O,PSJOO S PSJOO="",P SJO=0 F S PSJO=$O(^ PS(55,"ACX ",ON,PSJO) ) Q:'PSJO F S PSJO O=$O(^PS(5 5,"ACX",ON ,PSJO,PSJO O)) Q:PSJO O="" D | |
| 15997 | "RTN","PSJ COM1",19,0 ) | |
| 15998 | .Q:PSJOO= PSGORD D: PSJOO["U" DSPLORDU(P SGP,PSJOO) D:PSJOO[" V" DSPLORD V(PSGP,PSJ OO) S PSJC M(PSJOO,PS JLINE)="", PSJLINE=PS JLINE+1 | |
| 15999 | "RTN","PSJ COM1",20,0 ) | |
| 16000 | N ON S ON ="" F S O N=$O(PSJCM (ON)) Q:ON ="" D | |
| 16001 | "RTN","PSJ COM1",21,0 ) | |
| 16002 | .W ! F PS X=0:0 S PS X=$O(PSJCM (ON,PSX)) Q:'PSX D | |
| 16003 | "RTN","PSJ COM1",22,0 ) | |
| 16004 | ..W !,PSJ CM(ON,PSX) D:'(PSX#6 ) PAUSE | |
| 16005 | "RTN","PSJ COM1",23,0 ) | |
| 16006 | W ! | |
| 16007 | "RTN","PSJ COM1",24,0 ) | |
| 16008 | Q | |
| 16009 | "RTN","PSJ COM1",25,0 ) | |
| 16010 | ; | |
| 16011 | "RTN","PSJ COM1",26,0 ) | |
| 16012 | CMPLX2(PSG P,ON,PSGOR D) ; | |
| 16013 | "RTN","PSJ COM1",27,0 ) | |
| 16014 | Q:$G(PSGO RD)'["U" | |
| 16015 | "RTN","PSJ COM1",28,0 ) | |
| 16016 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 16017 | "RTN","PSJ COM1",29,0 ) | |
| 16018 | I $$GET1^ DIQ(50,+$$ GET1^DIQ(5 5.07,"1,"_ +PSGORD_", "_PSGP,.01 ,"I"),17.5 )="PSOCLO1 " D ;I $G (PSGPDN)[" CLOZ"!($G( PSGOPDN)[" CLOZ") D | |
| 16019 | "RTN","PSJ COM1",30,0 ) | |
| 16020 | .N PSGDN S PSGDN=$O (PSJXDOX(" DD",0)) | |
| 16021 | "RTN","PSJ COM1",31,0 ) | |
| 16022 | .D PSJFIL E^PSJCLOZ( PSGP),INPS ND^YSCLTST 5 K:$D(^TM P($J,"CLOZ FLG",PSGP) ) ^TMP($J, "CLOZFLG", PSGP) | |
| 16023 | "RTN","PSJ COM1",32,0 ) | |
| 16024 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 16025 | "RTN","PSJ COM1",33,0 ) | |
| 16026 | N PSJLINE S PSJLINE =0 | |
| 16027 | "RTN","PSJ COM1",34,0 ) | |
| 16028 | D FULL^VA LM1 | |
| 16029 | "RTN","PSJ COM1",35,0 ) | |
| 16030 | D DSPLORD U(PSGP,PSG ORD) | |
| 16031 | "RTN","PSJ COM1",36,0 ) | |
| 16032 | W ! S PSJ LINE="" F S PSJLINE =$O(PSJCM( PSGORD,PSJ LINE)) Q:P SJLINE="" W !,PSJCM (PSGORD,PS JLINE) D:' ((PSJLINE+ 1)#6) PAUS E | |
| 16033 | "RTN","PSJ COM1",37,0 ) | |
| 16034 | D EN^PSGP EN(PSGORD) | |
| 16035 | "RTN","PSJ COM1",38,0 ) | |
| 16036 | S ^TMP("P SODAOC",$J ,"IP IEN") =PSJO_"P", ^TMP("PSOD AOC",$J,"I P NEW IEN" )=PSGORD | |
| 16037 | "RTN","PSJ COM1",39,0 ) | |
| 16038 | D SETOC^P SJNEWOC(PS GORD) | |
| 16039 | "RTN","PSJ COM1",40,0 ) | |
| 16040 | W ! | |
| 16041 | "RTN","PSJ COM1",41,0 ) | |
| 16042 | Q | |
| 16043 | "RTN","PSJ COM1",42,0 ) | |
| 16044 | ; | |
| 16045 | "RTN","PSJ COM1",43,0 ) | |
| 16046 | UPDATE ; R efresh arr ay, action s, & displ ay. | |
| 16047 | "RTN","PSJ COM1",44,0 ) | |
| 16048 | D GETUD^P SJLMGUD(DF N,ON),INIT ^PSJLMUDE( DFN,ON) S VALMBCK="R " | |
| 16049 | "RTN","PSJ COM1",45,0 ) | |
| 16050 | Q | |
| 16051 | "RTN","PSJ COM1",46,0 ) | |
| 16052 | HOLDHDR ; Freeze hea der text w hile proce ssing orde r actions | |
| 16053 | "RTN","PSJ COM1",47,0 ) | |
| 16054 | I $D(VALM ("TM")) S IOTM=VALM( "TM"),IOBM =IOSL W IO SC W @IOST BM W IORC | |
| 16055 | "RTN","PSJ COM1",48,0 ) | |
| 16056 | Q | |
| 16057 | "RTN","PSJ COM1",49,0 ) | |
| 16058 | ; | |
| 16059 | "RTN","PSJ COM1",50,0 ) | |
| 16060 | DSPLORDU(P SGP,ON) ; Display UD order f or order c heck as in the Inpat Profile. | |
| 16061 | "RTN","PSJ COM1",51,0 ) | |
| 16062 | NEW DRUGN AME,F,NODE 0,NODE2,PS JID,PSJX,S CH,SD,STAT ,X,Y K PSJ CM | |
| 16063 | "RTN","PSJ COM1",52,0 ) | |
| 16064 | S F=$S(ON ["U":"^PS( 55,PSGP,5, "_+ON_",", 1:"^PS(53. 1,"_+ON_", ") | |
| 16065 | "RTN","PSJ COM1",53,0 ) | |
| 16066 | S NODE0=$ G(@(F_"0)" )),NODE2=$ G(@(F_"2)" )) | |
| 16067 | "RTN","PSJ COM1",54,0 ) | |
| 16068 | D DRGDISP ^PSJLMUT1( PSGP,ON,39 ,54,.DRUGN AME,0) | |
| 16069 | "RTN","PSJ COM1",55,0 ) | |
| 16070 | I ON["P", $P(NODE0,U ,4)="F" D DSPLORDV(P SGP,ON) Q | |
| 16071 | "RTN","PSJ COM1",56,0 ) | |
| 16072 | S SCH=$P( NODE0,U,7) | |
| 16073 | "RTN","PSJ COM1",57,0 ) | |
| 16074 | S STAT=$P (NODE0,U,9 ) | |
| 16075 | "RTN","PSJ COM1",58,0 ) | |
| 16076 | D NOW^%DT C I "A"[ST AT I $P(NO DE2,U,4)<% D EXPIRE S STAT="E" | |
| 16077 | "RTN","PSJ COM1",59,0 ) | |
| 16078 | I STAT="A ",$P(NODE0 ,U,27)="R" S STAT="R " | |
| 16079 | "RTN","PSJ COM1",60,0 ) | |
| 16080 | I STAT'=" P" S PSJID =$E($$ENDT C^PSGMI($P (NODE2,U,2 )),1,5),SD =$E($$ENDT C^PSGMI($P (NODE2,U,4 )),1,5) | |
| 16081 | "RTN","PSJ COM1",61,0 ) | |
| 16082 | I STAT="P " S (PSJID ,SD)="**** *",SCH="?" | |
| 16083 | "RTN","PSJ COM1",62,0 ) | |
| 16084 | I $G(PSGP DN)["CLOZ" N PSGORD S PSGORD=+ $G(NODE0), PSSD="" D DISPCMP^PS JCLOZ(PSGO RD,.PSSD) I $G(PSSD) S SD=$E($ $ENDTC^PSG MI(PSSD),1 ,5) K PSSD | |
| 16085 | "RTN","PSJ COM1",63,0 ) | |
| 16086 | F PSJX=0: 0 S PSJX=$ O(DRUGNAME (PSJX)) Q: 'PSJX D | |
| 16087 | "RTN","PSJ COM1",64,0 ) | |
| 16088 | . S:PSJX= 1 X=SCH_" "_PSJID_" "_SD_" "_$E(STAT, 1) | |
| 16089 | "RTN","PSJ COM1",65,0 ) | |
| 16090 | . S:PSJX= 1 DRUGNAME (1)=$$SETS TR^VALM1(X ,$E(DRUGNA ME(1),1,40 ),42,20) | |
| 16091 | "RTN","PSJ COM1",66,0 ) | |
| 16092 | . S PSJCM (ON,PSJLIN E)=" "_DRUGNA ME(PSJX) | |
| 16093 | "RTN","PSJ COM1",67,0 ) | |
| 16094 | . S PSJLI NE=PSJLINE +1 | |
| 16095 | "RTN","PSJ COM1",68,0 ) | |
| 16096 | Q | |
| 16097 | "RTN","PSJ COM1",69,0 ) | |
| 16098 | DSPLORDV(D FN,ON) ; Display I V order fo r order ch eck as in the Inpat Profile. | |
| 16099 | "RTN","PSJ COM1",70,0 ) | |
| 16100 | N DRG,DRG I,DRGT,DRG X,FIL,ND,O N55,P,PSJI VFLG,PSJOR IFN,TYP,X, Y | |
| 16101 | "RTN","PSJ COM1",71,0 ) | |
| 16102 | S TYP="?" I ON["V" D | |
| 16103 | "RTN","PSJ COM1",72,0 ) | |
| 16104 | .S Y=$G(^ PS(55,DFN, "IV",+ON,0 )) F X=2,3 ,4,5,8,9,1 7,23 S P(X )=$P(Y,U,X ) | |
| 16105 | "RTN","PSJ COM1",73,0 ) | |
| 16106 | .D NOW^%D TC I "A"[P (17) I P(3 )<% D EXPI RE S P(17) ="E" | |
| 16107 | "RTN","PSJ COM1",74,0 ) | |
| 16108 | .S TYP=$$ ONE^PSJBCM A(DFN,ON,P (9),P(2),P (3)) I TYP '="O" S TY P="C" | |
| 16109 | "RTN","PSJ COM1",75,0 ) | |
| 16110 | .S ON55=O N,P("OT")= $S(P(4)="A ":"F",P(4) ="H":"H",1 :"I") D GT DRG^PSIVOR FB,GTOT^PS IVUTL(P(4) ) | |
| 16111 | "RTN","PSJ COM1",76,0 ) | |
| 16112 | S PSJCT=0 ,PSJL="" | |
| 16113 | "RTN","PSJ COM1",77,0 ) | |
| 16114 | I ON'["V" S (P(2),P (3))="",P( 17)=$P($G( ^PS(53.1,+ ON,0)),U,9 ),Y=$G(^(8 )),P(4)=$P (Y,U),P(8) =$P(Y,U,5) ,P(9)=$P($ G(^(2)),U) D GTDRG^P SIVORFA,GT OT^PSIVUTL (P(4)) | |
| 16115 | "RTN","PSJ COM1",78,0 ) | |
| 16116 | S PSJIVFL G=1 D PIVA D,SOL | |
| 16117 | "RTN","PSJ COM1",79,0 ) | |
| 16118 | Q | |
| 16119 | "RTN","PSJ COM1",80,0 ) | |
| 16120 | SOL ; | |
| 16121 | "RTN","PSJ COM1",81,0 ) | |
| 16122 | S PSJL=$S ($G(PSJIVF LG):PSJL,1 :"")_" in" | |
| 16123 | "RTN","PSJ COM1",82,0 ) | |
| 16124 | S DRG=0 F S DRG=+$ O(DRG("SOL ",DRG)) Q: 'DRG D NA ME^PSIVUTL (DRG("SOL" ,DRG),39,. NAME,0) S DRGX=0 F S DRGX=$O( NAME(DRGX) ) Q:'DRGX S PSJL=$$ SETSTR^VAL M1(NAME(DR GX),PSJL,1 2,60) D:$G (PSJIVFLG) PIV1 D SE TTMP S PSJ L=" " | |
| 16125 | "RTN","PSJ COM1",83,0 ) | |
| 16126 | Q | |
| 16127 | "RTN","PSJ COM1",84,0 ) | |
| 16128 | PIVAD ; Pr int IV Add itives. | |
| 16129 | "RTN","PSJ COM1",85,0 ) | |
| 16130 | F DRG=0:0 S DRG=$O( DRG("AD",D RG)) Q:'DR G D NAME^ PSIVUTL(DR G("AD",DRG ),39,.NAME ,1) F DRGX =0:0 S DRG X=$O(NAME( DRGX)) Q:' DRGX S PS JL=$$SETST R^VALM1(NA ME(DRGX),P SJL,9,60) D:$G(PSJIV FLG) PIV1 D SETTMP | |
| 16131 | "RTN","PSJ COM1",86,0 ) | |
| 16132 | Q | |
| 16133 | "RTN","PSJ COM1",87,0 ) | |
| 16134 | ; | |
| 16135 | "RTN","PSJ COM1",88,0 ) | |
| 16136 | PIV1 ; Pri nt Sched t ype, start /stop date s, and sta tus. | |
| 16137 | "RTN","PSJ COM1",89,0 ) | |
| 16138 | K PSJIVFL G | |
| 16139 | "RTN","PSJ COM1",90,0 ) | |
| 16140 | F X=2,3 S P(X)=$E($ $ENDTC^PSG MI(P(X)),1 ,$S($D(PSJ EXTP):8,1: 5)) | |
| 16141 | "RTN","PSJ COM1",91,0 ) | |
| 16142 | I '$D(PSJ EXTP) S PS JL=$$SETST R^VALM1(TY P,PSJL,50, 1),PSJL=$$ SETSTR^VAL M1(P(2),PS JL,53,7),P SJL=$$SETS TR^VALM1(P (3),PSJL,6 0,7),PSJL= $$SETSTR^V ALM1(P(17) ,PSJL,67,1 ) | |
| 16143 | "RTN","PSJ COM1",92,0 ) | |
| 16144 | E S PSJL =$$SETSTR^ VALM1(TYP, PSJL,50,1) ,PSJL=$$SE TSTR^VALM1 (P(2),53,7 ),PSJL=$$S ETSTR^VALM 1(P(3),PSJ L,63,7),PS JL=$$SETST R^VALM1(P( 17),PSJL,7 3,1) | |
| 16145 | "RTN","PSJ COM1",93,0 ) | |
| 16146 | Q | |
| 16147 | "RTN","PSJ COM1",94,0 ) | |
| 16148 | SETTMP ; | |
| 16149 | "RTN","PSJ COM1",95,0 ) | |
| 16150 | S PSJCM(O N,PSJLINE) =PSJL,PSJL INE=PSJLIN E+1 | |
| 16151 | "RTN","PSJ COM1",96,0 ) | |
| 16152 | Q | |
| 16153 | "RTN","PSJ COM1",97,0 ) | |
| 16154 | PAUSE ; | |
| 16155 | "RTN","PSJ COM1",98,0 ) | |
| 16156 | K DIR W ! S DIR(0)= "EA",DIR(" A")="Press Return to continue. .." D ^DIR W ! | |
| 16157 | "RTN","PSJ COM1",99,0 ) | |
| 16158 | Q | |
| 16159 | "RTN","PSJ COM1",100, 0) | |
| 16160 | NEW ; | |
| 16161 | "RTN","PSJ COM1",101, 0) | |
| 16162 | Q:'PSJCOM | |
| 16163 | "RTN","PSJ COM1",102, 0) | |
| 16164 | Q:PSGORD' ["P" | |
| 16165 | "RTN","PSJ COM1",103, 0) | |
| 16166 | M ^TMP("P SJCOM",$J, +PSGORD)=^ PS(53.1,+P SGORD) | |
| 16167 | "RTN","PSJ COM1",104, 0) | |
| 16168 | S PSGS0Y= PSGAT,PSGN ESD=PSGSD, PSGNEFD=PS GFD,PSGOEP R=PSGPR,PS GPDRG=PSGP D,PSGPDRGN =PSGPDN,PS GOEE="E" | |
| 16169 | "RTN","PSJ COM1",105, 0) | |
| 16170 | S $P(^TMP ("PSJCOM", $J,+PSGORD ,0),"^",27 )="E",$P(^ (0),"^",9) ="DE" | |
| 16171 | "RTN","PSJ COM1",106, 0) | |
| 16172 | W:'$D(PSG OEE)&'$D(P SGOES) !!, "...transc ribing thi s ",$S($D( PSGOES):"" ,'PSGOEAV: "non-verif ied ",1:"a ctive ")," order..." S PSGOETOF =1 S:PSGSM ="" PSGSM= 0 | |
| 16173 | "RTN","PSJ COM1",107, 0) | |
| 16174 | ;I PSGPR' =PSGOEPR D :'$D(^PS(5 5,PSGP,0)) ENSET0^PS GNE3(PSGP) S $P(^PS( 55,PSGP,5. 1),U,2)=PS GPR,PSGOEP R=PSGPR | |
| 16175 | "RTN","PSJ COM1",108, 0) | |
| 16176 | K ND4,DA D NOW^%DTC S PSGDT=+ $E(%,1,12) ,DA=+PSGOR D | |
| 16177 | "RTN","PSJ COM1",109, 0) | |
| 16178 | S PSJOWAL L=+$G(^PS( 55,PSGP,5. 1)) | |
| 16179 | "RTN","PSJ COM1",110, 0) | |
| 16180 | I $D(^PS( 51.2,+PSGM R,0)),$P(^ (0),U,3)]" " S PSGMRN =$P(^(0),U ,3) | |
| 16181 | "RTN","PSJ COM1",111, 0) | |
| 16182 | I PSGS0XT ="D",'PSGS 0Y S PSGS0 Y=$E(PSGNE SD_"00011" ,9,12) | |
| 16183 | "RTN","PSJ COM1",112, 0) | |
| 16184 | S ND=DA_U _PSGPR_U_P SGMR_"^U^" _PSGSM_U_P SGHSM_U_PS GST_"^^"_$ S(PSGOEAV: "A",1:"N") _"^^^^^"_P SGDT_U_PSG P_U_PSGDT S:PSGNEDFD $P(ND,U,$ P(PSGNEDFD ,U)["L"+10 )=+PSGNEDF D | |
| 16185 | "RTN","PSJ COM1",113, 0) | |
| 16186 | S:$D(PSGO EE) $P(ND, U,24,25)=P SGOEE_U_PS GORD S:'PS GOEAV $P(N D,U,18)=DA S ND2=PSG SCH_U_$S(+ PSGNESD=PS GNESD:+PSG NESD,1:"") _"^^"_+PSG NEFD_U_PSG S0Y_U_PSGS 0XT_"^^^^" _+PSJPWD | |
| 16187 | "RTN","PSJ COM1",114, 0) | |
| 16188 | S:$G(PSGR F)]"" ND2P 1=$G(PSGDU R)_U_$G(PS GRMVT)_U_$ G(PSGRMV)_ U_$G(PSGRF ) ;*315 | |
| 16189 | "RTN","PSJ COM1",115, 0) | |
| 16190 | S $P(ND4, U,7)=DUZ I PSGOEAV,P SJSYSU D | |
| 16191 | "RTN","PSJ COM1",116, 0) | |
| 16192 | .S $P(ND4 ,U,PSJSYSU ,PSJSYSU+1 )=DUZ_U_PS GDT,$P(ND4 ,U,+PSJSYS U=1+9)=1,$ P(ND4,U,+P SJSYSU=3+9 )=0 | |
| 16193 | "RTN","PSJ COM1",117, 0) | |
| 16194 | .S $P(ND4 ,U,9,10)=+ $P(ND4,U,9 )_U_+$P(ND 4,U,10) | |
| 16195 | "RTN","PSJ COM1",118, 0) | |
| 16196 | S F="^TMP (""PSJCOM2 "","_$J_", "_DA_",",@ (F_"0)")=N D | |
| 16197 | "RTN","PSJ COM1",119, 0) | |
| 16198 | ; Naked r eferences below refe rs to full reference in F whic h is ^TMP( "PSJCOM2", $J,DA, | |
| 16199 | "RTN","PSJ COM1",120, 0) | |
| 16200 | S @(F_".2 )")=PSGPDR G_U_PSGDO_ U_PSJNOO S :$G(PSJDOS E("DO"))]" " $P(^(.2) ,U,5,6)=$P (PSJDOSE(" DO"),U,1,2 ) S:PSJCOM ]"" $P(^(. 2),"^",8)= PSJCOM | |
| 16201 | "RTN","PSJ COM1",121, 0) | |
| 16202 | I '$D(PSJ DOSE("DO") ),$D(PSGOR D) S $P(@( F_".2)"),U ,5,6)=$P(@ ("^PS("_$S (PSGORD["U ":"55,"_PS GP_",5",1: 53.1)_","_ +PSGORD_", .2)"),U,5, 6) | |
| 16203 | "RTN","PSJ COM1",122, 0) | |
| 16204 | ; Naked r eferences below refe rs to full reference in F whic h is ^TMP( "PSJCOM2", $J,DA, | |
| 16205 | "RTN","PSJ COM1",123, 0) | |
| 16206 | S @(F_"2) ")=$P(ND2, "^",1,6),^ (4)=ND4 S: PSGSI]"" ^ (6)=PSGSI | |
| 16207 | "RTN","PSJ COM1",124, 0) | |
| 16208 | S @(F_"2. 1)")=ND2P1 ;*315 | |
| 16209 | "RTN","PSJ COM1",125, 0) | |
| 16210 | ; Naked r eferences below refe rs to full reference in F whic h is ^TMP( "PSJCOM2", $J,DA, | |
| 16211 | "RTN","PSJ COM1",126, 0) | |
| 16212 | S (C,X)=0 F S X=$O (^PS(53.45 ,PSJSYSP,2 ,X)) Q:'X S D=$G(^( X,0)) I D, $S('$P(D,U ,3):1,1:$P (D,U,3)>DT ) S C=C+1, @(F_"1,"_C _",0)")=$P (D,U,1,2), @(F_"1,""B "","_+D_", "_C_")")=" " | |
| 16213 | "RTN","PSJ COM1",127, 0) | |
| 16214 | S:C @(F_" 1,0)")=U_$ S(PSGOEAV: 55.07,1:53 .11)_"P^"_ C_U_C | |
| 16215 | "RTN","PSJ COM1",128, 0) | |
| 16216 | ; Naked r eferences below refe rs to full reference in F whic h is ^TMP( "PSJCOM2", $J,DA, | |
| 16217 | "RTN","PSJ COM1",129, 0) | |
| 16218 | S (C,Q)=0 F S Q=$O (^PS(53.45 ,PSJSYSP,1 ,Q)) Q:'Q S X=$G(^( Q,0)) S:X] "" C=C+1,@ (F_"3,"_C_ ",0)")=X | |
| 16219 | "RTN","PSJ COM1",130, 0) | |
| 16220 | S:C @(F_" 3,0)")=U_$ S(PSGOEAV: 55.08,1:53 .12)_U_C_U _C | |
| 16221 | "RTN","PSJ COM1",131, 0) | |
| 16222 | S:C @(F_" 12,0)")=U_ $S(PSGOEAV :55.0612,1 :53.1012)_ U_C_U_C | |
| 16223 | "RTN","PSJ COM1",132, 0) | |
| 16224 | W "." | |
| 16225 | "RTN","PSJ COM1",133, 0) | |
| 16226 | OUT ; | |
| 16227 | "RTN","PSJ COM1",134, 0) | |
| 16228 | K PSGOETO F | |
| 16229 | "RTN","PSJ COM1",135, 0) | |
| 16230 | DONE ; | |
| 16231 | "RTN","PSJ COM1",136, 0) | |
| 16232 | K C,D,ND, ND2,ND2P1, ND4,PSGDO, PSGDRG,PSG DRGN,PSGFO K,PSGHSM,P SGMR,PSGMR N,PSGNEDFD ,PSGNEFD,P SGNESD,PSG PDRG,PSGPD RGN,PSGSI, PSGSTN,PSJ DOSE,%,Q | |
| 16233 | "RTN","PSJ COM1",137, 0) | |
| 16234 | Q | |
| 16235 | "RTN","PSJ COM1",138, 0) | |
| 16236 | EXPIRE ;Ch ange statu s of order to expire d and send notice to OE/RR | |
| 16237 | "RTN","PSJ COM1",139, 0) | |
| 16238 | N DA,DIE, DR,PSGPO,P SIVACT | |
| 16239 | "RTN","PSJ COM1",140, 0) | |
| 16240 | Q:'$G(PSJ OO)!($G(PS JOO)["P") | |
| 16241 | "RTN","PSJ COM1",141, 0) | |
| 16242 | S STATUS= "E",(PSGPO ,PSIVACT)= 1,DA=+PSJO O,DA(1)=PS GP,DIE=$S( PSJOO["V": "^PS(55,"_ PSGP_",""I V"",",1:"^ PS(55,"_PS GP_",5,"), DR=$S(PSJO O["V":"100 ////E",1:" 28////E") D ^DIE | |
| 16243 | "RTN","PSJ COM1",142, 0) | |
| 16244 | D EN1^PSJ HL2(PSGP," SC",PSJOO) | |
| 16245 | "RTN","PSJ COM1",143, 0) | |
| 16246 | Q | |
| 16247 | "RTN","PSJ LMPRU") | |
| 16248 | 0^35^B2002 4383 | |
| 16249 | "RTN","PSJ LMPRU",1,0 ) | |
| 16250 | PSJLMPRU ; BIR/MLM - INPATIENT LISTMAN UD PROFILE U TILITIES ; Jul 26, 20 17@18:04:0 2 | |
| 16251 | "RTN","PSJ LMPRU",2,0 ) | |
| 16252 | ;;5.0;INP ATIENT MED ICATIONS;* *16,58,85, 110,185,18 1,267,323, 317,327**; 16 DEC 97; Build 64 | |
| 16253 | "RTN","PSJ LMPRU",3,0 ) | |
| 16254 | ; | |
| 16255 | "RTN","PSJ LMPRU",4,0 ) | |
| 16256 | ; Referen ce to ^PSD RUG is sup ported by DBIA 2192. | |
| 16257 | "RTN","PSJ LMPRU",5,0 ) | |
| 16258 | ; Referen ce to ^PS( 55 is supp orted by D BIA 2191. | |
| 16259 | "RTN","PSJ LMPRU",6,0 ) | |
| 16260 | ; Referen ce to $$GE T^XPAR is supported by DBIA 22 63 | |
| 16261 | "RTN","PSJ LMPRU",7,0 ) | |
| 16262 | ; | |
| 16263 | "RTN","PSJ LMPRU",8,0 ) | |
| 16264 | PUD(DFN,ON ,PSJF,DN) ; Setup LM profile v iew for UD | |
| 16265 | "RTN","PSJ LMPRU",9,0 ) | |
| 16266 | N PSJFLAG ,PSJV,PADE | |
| 16267 | "RTN","PSJ LMPRU",10, 0) | |
| 16268 | ; Naked r eferences on the two lines bel ow refer t o full ref erence ^PS (55,DFN,5, +ON in PSJ F using in direction. | |
| 16269 | "RTN","PSJ LMPRU",11, 0) | |
| 16270 | S ND=$G(@ (PSJF_+ON_ ",0)")),SC H=$G(^(2)) ,ND4=$G(^( 4)),ND6=$G (^(6)),NDP 2=$G(^(.2) ),PSJFLAG= $P(NDP2,U, 7),X=$P(DN ,U,2),DO=$ S('X:"",1: $G(^(+X))) S:X=.2 DO =$P(DO,U,2 ) | |
| 16271 | "RTN","PSJ LMPRU",12, 0) | |
| 16272 | S ND14=$G (@(PSJF_+O N_",14,0)" )),RNDT="" I $P(ND14 ,"^",3) S ND14=$G(^( $P(ND14,"^ ",3),0)),R NDT=$P(ND1 4,"^") | |
| 16273 | "RTN","PSJ LMPRU",13, 0) | |
| 16274 | I ("AO"[P SJC)!(PSJC ="DF") D | |
| 16275 | "RTN","PSJ LMPRU",14, 0) | |
| 16276 | .S V='$P( ND4,"^",UD U),PSJL=$$ SETSTR^VAL M1($S(ND4= "":" ",$P( ND4,"^",12 ):"D",$P(N D4,"^",19) &$P(ND4,"^ ",18):"H", $P(ND4,"^" ,23)&$P(ND 4,"^",22): "H",$P(ND4 ,"^",15)&( $P(ND4,"^" ,16)!V):"R ",1:" "),P SJL,5,1) | |
| 16277 | "RTN","PSJ LMPRU",15, 0) | |
| 16278 | .S PSJV=$ S($P(NDP2, U,4)="D":" d",1:" ")_ $S(+PSJSYS U=1&V:"->" ,+PSJSYSU= 3&V:"->",1 :" ") I PSJFLAG D CNTRL^VALM 10(PSJLN,1 ,4,IORVON, IORVOFF,0) | |
| 16279 | "RTN","PSJ LMPRU",16, 0) | |
| 16280 | .S PSJL=$ $SETSTR^VA LM1(PSJV,P SJL,6,3) | |
| 16281 | "RTN","PSJ LMPRU",17, 0) | |
| 16282 | S RTE=$P( ND,"^",3), SM=$S('$P( ND,"^",5): 0,$P(ND,"^ ",6):1,1:2 ),STAT=$S( $P(ND,U,28 )]"":$P(ND ,U,28),$P( ND,"^",9)] "":$P(ND," ^",9),1:"N F"),PF=$E( "*",$P(ND, "^",20)>0) ,PSGID=$P( SCH,"^",2) ,SD=$P(SCH ,"^",4),SC H=$P(SCH," ^") | |
| 16283 | "RTN","PSJ LMPRU",18, 0) | |
| 16284 | I STAT="A ",$P(ND,U, 27)="R" S STAT="R" | |
| 16285 | "RTN","PSJ LMPRU",19, 0) | |
| 16286 | S NF="",W S=$S(PSJPW D:$$WS^PSJ O(PSJPWD,P SGP,PSJF,+ ON),1:0) | |
| 16287 | "RTN","PSJ LMPRU",20, 0) | |
| 16288 | I $D(PSJC LIN) S WS= 0 ; PSJ*5 *323 | |
| 16289 | "RTN","PSJ LMPRU",21, 0) | |
| 16290 | ; PSJ*5*3 17 - If PS J PADE OE BALANCES p arameter i s YES, PAD E balances should di splay as i dentifier | |
| 16291 | "RTN","PSJ LMPRU",22, 0) | |
| 16292 | S PADE=0 I $$GET^XP AR("SYS"," PSJ PADE O E BALANCES ") D | |
| 16293 | "RTN","PSJ LMPRU",23, 0) | |
| 16294 | .N PSJORC L,PSJCLNK | |
| 16295 | "RTN","PSJ LMPRU",24, 0) | |
| 16296 | .; If cli nic order, quit if c linic loca tion is no t linked t o PADE | |
| 16297 | "RTN","PSJ LMPRU",25, 0) | |
| 16298 | .S PSJORC L=$S($G(ON )["P":$G(^ PS(53.1,+$ G(ON),"DSS ")),$G(ON) ["U":$G(^P S(55,+$G(P SGP),5,+$G (ON),8)),$ G(ON)["V": $G(^PS(55, +$G(PSGP), "IV",+$G(O N),"DSS")) ,1:"") | |
| 16299 | "RTN","PSJ LMPRU",26, 0) | |
| 16300 | .I PSJORC L,$P(PSJOR CL,"^",2) S PSJCLNK= $$PADECL^P SJPAD50(+$ G(PSJORCL) ) Q:'PSJCL NK | |
| 16301 | "RTN","PSJ LMPRU",27, 0) | |
| 16302 | .I '$G(VA IN(4)) N V AIN D INP^ VADPT | |
| 16303 | "RTN","PSJ LMPRU",28, 0) | |
| 16304 | .I '$G(PS JCLNK) Q:' $$PADEWD^P SJPAD50(+$ G(VAIN(4)) ) | |
| 16305 | "RTN","PSJ LMPRU",29, 0) | |
| 16306 | .S PADE=$ $DRGFLAG^P SJPADSI(PS GP,$G(ON), ,$G(ON),$G (PSJNEWOE) ) S:PADE=0 PADE=1 | |
| 16307 | "RTN","PSJ LMPRU",30, 0) | |
| 16308 | N PSJDISP F PSJDISP =0:0 S PSJ DISP=$O(@( PSJF_+ON_" ,1,"_PSJDI SP_")")) Q :'PSJDISP D | |
| 16309 | "RTN","PSJ LMPRU",31, 0) | |
| 16310 | .I $P($G( ^PSDRUG(+$ P($G(@(PSJ F_+ON_",1, "_PSJDISP_ ",0)")),"^ "),0)),"^" ,9)=1 S NF =1 | |
| 16311 | "RTN","PSJ LMPRU",32, 0) | |
| 16312 | NEW DRUGN AME,PSGID1 ,SD1,LEN,P SGID1,SD1 S LEN=$S($ D(PSJEXPT) :8,1:5) | |
| 16313 | "RTN","PSJ LMPRU",33, 0) | |
| 16314 | ; START N CC REMEDIA TION RJS-3 27 | |
| 16315 | "RTN","PSJ LMPRU",34, 0) | |
| 16316 | I $$GET1^ DIQ(50,+$$ GET1^DIQ(5 5.07,"1,"_ +ON_","_DF N,.01,"I") ,17.5)="PS OCLO1" D | |
| 16317 | "RTN","PSJ LMPRU",35, 0) | |
| 16318 | .D DISPCM P^PSJCLOZ( +$G(ND),.P SSD) S:$G( PSSD) SD=P SSD K PSSD | |
| 16319 | "RTN","PSJ LMPRU",36, 0) | |
| 16320 | ; END NCC REMEDIATI ON RJS-327 | |
| 16321 | "RTN","PSJ LMPRU",37, 0) | |
| 16322 | F X="PSGI D","SD" S @(X_1)=$S( PSJC["C":" *****",1:$ E($$ENDTC^ PSGMI(@X), 1,LEN)) | |
| 16323 | "RTN","PSJ LMPRU",38, 0) | |
| 16324 | D DRGDISP ^PSJLMUT1( PSGP,ON,39 ,54,.DRUGN AME,0) | |
| 16325 | "RTN","PSJ LMPRU",39, 0) | |
| 16326 | F PSJX=0: 0 S PSJX=$ O(DRUGNAME (PSJX)) Q: 'PSJX D | |
| 16327 | "RTN","PSJ LMPRU",40, 0) | |
| 16328 | .I PSJX=1 D | |
| 16329 | "RTN","PSJ LMPRU",41, 0) | |
| 16330 | ..I PSJFL AG D CNTRL ^VALM10(PS JLN,1,4,IO RVON,IORVO FF,0) | |
| 16331 | "RTN","PSJ LMPRU",42, 0) | |
| 16332 | ..S PSJL= $$SETSTR^V ALM1($S($E (PSJS)="*" :$P(PSJS," ^"),1:DRUG NAME(PSJX) ),PSJL,9,3 9) | |
| 16333 | "RTN","PSJ LMPRU",43, 0) | |
| 16334 | ..S PSJL= $$SETSTR^V ALM1($S(PS JC["C":"?" ,PSJSCHT'= "z":PSJSCH T,1:"?"),P SJL,50,3) | |
| 16335 | "RTN","PSJ LMPRU",44, 0) | |
| 16336 | ..S PSJL= PSJL_PSGID 1_" "_SD1 _" "_$E(ST AT,1,2)_$S ($L(STAT)= 1:" ", 1:" ")_ $S($G(RNDT ):$E($$END TC^PSGMI(R NDT),1,LEN ),1:"") | |
| 16337 | "RTN","PSJ LMPRU",45, 0) | |
| 16338 | ..I NF!WS !SM!PF!$G( PADE) S PS JL=$$SETST R^VALM1($S (NF:"NF ", (WS&PADE): "WP ",(PAD E&'WS):"PD ",WS:"WS ",SM:$E("H SM",SM,3), 1:""),PSJL ,69,3) S:P F PSJL=$$S ETSTR^VALM 1("*",PSJL ,79,1) | |
| 16339 | "RTN","PSJ LMPRU",46, 0) | |
| 16340 | . I PSJX> 1 S PSJL=" ",PSJL=$$S ETSTR^VALM 1(DRUGNAME (PSJX),PSJ L,11,66) | |
| 16341 | "RTN","PSJ LMPRU",47, 0) | |
| 16342 | . D SETTM P("PSJPRO" ,PSJL) I ( $P(NDP2,U, 4)="S"),ST AT="P" D C NTRL^VALM1 0((PSJLN-1 ),9,9+$L(P SJL),IOINH I_IOBON,IO INORM,0) | |
| 16343 | "RTN","PSJ LMPRU",48, 0) | |
| 16344 | I ND6'="" N X,PSJTX T3 S X=$$G ETSIOPI^PS JBCMA5(DFN ,ON) N TXT LN S TXTLN =0 F S TX TLN=$O(^PS (53.45,DUZ ,5,TXTLN)) Q:'TXTLN! $G(PSJTXT3 ) D | |
| 16345 | "RTN","PSJ LMPRU",49, 0) | |
| 16346 | .I ($O(^P S(53.45,DU Z,5," "),- 1)>3) S PS JTXT3=1 S PSJL="Inst ructions t oo long. S ee Order V iew for fu ll text." D PTXT(PSJ L,"PSJPRO" ,10,66) Q | |
| 16347 | "RTN","PSJ LMPRU",50, 0) | |
| 16348 | .S PSJL=^ PS(53.45,D UZ,5,TXTLN ,0) D PTXT (PSJL,"PSJ PRO",10,66 ) | |
| 16349 | "RTN","PSJ LMPRU",51, 0) | |
| 16350 | K ^PS(53. 45,DUZ,5) | |
| 16351 | "RTN","PSJ LMPRU",52, 0) | |
| 16352 | Q | |
| 16353 | "RTN","PSJ LMPRU",53, 0) | |
| 16354 | ; | |
| 16355 | "RTN","PSJ LMPRU",54, 0) | |
| 16356 | PTXT(TXT,S UB,LM,RM) ; Display Instructio ns/dosage ordered. | |
| 16357 | "RTN","PSJ LMPRU",55, 0) | |
| 16358 | ;* Input: TXT = Text to display. | |
| 16359 | "RTN","PSJ LMPRU",56, 0) | |
| 16360 | ; SUB = First sub script for ^TMP node , ** MUST be PSJ nam espace ** | |
| 16361 | "RTN","PSJ LMPRU",57, 0) | |
| 16362 | ; LM = Begin dis play of te xt after L M spaces. | |
| 16363 | "RTN","PSJ LMPRU",58, 0) | |
| 16364 | ; RM = Length of display t ext. | |
| 16365 | "RTN","PSJ LMPRU",59, 0) | |
| 16366 | ; | |
| 16367 | "RTN","PSJ LMPRU",60, 0) | |
| 16368 | ;BHW;PSJ* 5*185;Extr a spaces c auses disp lay to "sk ip" part o f the fiel d. | |
| 16369 | "RTN","PSJ LMPRU",61, 0) | |
| 16370 | ;S PSJL=" ",$P(PSJL, " ",LM)="" F X=1:1 S WRD=$P(TX T," ",X) Q :WRD="" D | |
| 16371 | "RTN","PSJ LMPRU",62, 0) | |
| 16372 | S PSJL="" ,$P(PSJL," ",LM)="" | |
| 16373 | "RTN","PSJ LMPRU",63, 0) | |
| 16374 | F X=1:1:$ L(TXT," ") S WRD=$P( TXT," ",X) D | |
| 16375 | "RTN","PSJ LMPRU",64, 0) | |
| 16376 | .;BHW;PSJ *5*185;che ck if end of string or just ex tra space | |
| 16377 | "RTN","PSJ LMPRU",65, 0) | |
| 16378 | .I WRD="" S PSJL=PS JL_" " Q | |
| 16379 | "RTN","PSJ LMPRU",66, 0) | |
| 16380 | .I $L(PSJ L_" "_WRD) '<RM D SET TMP(SUB,PS JL) S PSJL ="",$P(PSJ L," ",10)= "" | |
| 16381 | "RTN","PSJ LMPRU",67, 0) | |
| 16382 | .I $L(PSJ L_" "_WRD) '<RM S PSJ L=PSJL_" " _$E(WRD,1, (RM-10)) D SETTMP(SU B,PSJL) S PSJL="",$P (PSJL," ", 10)="",WRD =$E(WRD,(R M-9),$L(WR D)) | |
| 16383 | "RTN","PSJ LMPRU",68, 0) | |
| 16384 | .S PSJL=P SJL_" "_WR D | |
| 16385 | "RTN","PSJ LMPRU",69, 0) | |
| 16386 | D SETTMP( SUB,PSJL) | |
| 16387 | "RTN","PSJ LMPRU",70, 0) | |
| 16388 | Q | |
| 16389 | "RTN","PSJ LMPRU",71, 0) | |
| 16390 | SETTMP(SUB ,PSJL) ; | |
| 16391 | "RTN","PSJ LMPRU",72, 0) | |
| 16392 | S ^TMP(SU B,$J,PSJLN ,0)=PSJL,P SJLN=PSJLN +1 | |
| 16393 | "RTN","PSJ LMPRU",73, 0) | |
| 16394 | Q | |
| 16395 | "RTN","PSJ LMUDE") | |
| 16396 | 0^33^B8770 4533 | |
| 16397 | "RTN","PSJ LMUDE",1,0 ) | |
| 16398 | PSJLMUDE ; BIR/MLM-SH OW FIELDS FOR EDIT ( LISTMAN ST YLE) ;Jul 26, 2017@1 8:04:02 | |
| 16399 | "RTN","PSJ LMUDE",2,0 ) | |
| 16400 | ;;5.0;INP ATIENT MED ICATIONS;* *7,47,50,6 3,64,58,80 ,116,110,1 11,164,175 ,201,181,2 54,267,228 ,315,317,3 27**;16 DE C 97;Build 64 | |
| 16401 | "RTN","PSJ LMUDE",3,0 ) | |
| 16402 | ; | |
| 16403 | "RTN","PSJ LMUDE",4,0 ) | |
| 16404 | ;NFI-UD F r#:2 chgs@ init+4 to display no n-formular y (N/F) | |
| 16405 | "RTN","PSJ LMUDE",5,0 ) | |
| 16406 | ;also chg s @init+23 | |
| 16407 | "RTN","PSJ LMUDE",6,0 ) | |
| 16408 | ; | |
| 16409 | "RTN","PSJ LMUDE",7,0 ) | |
| 16410 | ; Referen ce to ^PS( 55 is supp orted by D BIA# 2191 | |
| 16411 | "RTN","PSJ LMUDE",8,0 ) | |
| 16412 | ; Referen ce to ^PSD RUG is sup ported by DBIA 2192 | |
| 16413 | "RTN","PSJ LMUDE",9,0 ) | |
| 16414 | ; Referen ce to $$GE T^XPAR is supported by DBIA #2 263 | |
| 16415 | "RTN","PSJ LMUDE",10, 0) | |
| 16416 | ; | |
| 16417 | "RTN","PSJ LMUDE",11, 0) | |
| 16418 | INIT(PSGP, PSGORD) ; | |
| 16419 | "RTN","PSJ LMUDE",12, 0) | |
| 16420 | N D,ND,PS JBCMA,PSJL ,PSJLM,PSJ LN,Q,QQ,PS JDUR,J K ^ TMP("PSJUD E",$J),^TM P($J,"GMRA ING") | |
| 16421 | "RTN","PSJ LMUDE",13, 0) | |
| 16422 | K:$G(PSJN ORD) PSGOE EF S PSJLN =1 | |
| 16423 | "RTN","PSJ LMUDE",14, 0) | |
| 16424 | D CLEAN^V ALM10 | |
| 16425 | "RTN","PSJ LMUDE",15, 0) | |
| 16426 | S PSJL=$S ($D(PSGEFN (1)):$E(" *",PSGEFN( 1)+1)_"(1) ",1:" ") ,PSJL=$$SE TSTR^VALM1 ("Orderabl e Item: "_ PSGPDN_$$O INF^PSJDIN (PSGPD),PS JL,5,74) D D SETTMP D:$G(PSGO EEF(108))! ($G(PSGOEE F(101))) H ILITE(1) | |
| 16427 | "RTN","PSJ LMUDE",16, 0) | |
| 16428 | . NEW Q,P SJDDA,PSJV D F Q=0:0 S Q=$O(^PS (53.45,PSJ SYSP,2,Q)) Q:'Q S P SJDDA(+$G( ^(Q,0)))=" " | |
| 16429 | "RTN","PSJ LMUDE",17, 0) | |
| 16430 | . S PSJVD =$$DINFLUD ^PSJDIN(PS GPD,.PSJDD A) | |
| 16431 | "RTN","PSJ LMUDE",18, 0) | |
| 16432 | . I $$OVR CHK^PSGSIC H1(PSGP,PS GORD) S PS JVD="<OCI> "_PSJVD | |
| 16433 | "RTN","PSJ LMUDE",19, 0) | |
| 16434 | . S PSJL= $$SETSTR^V ALM1(PSJVD ,PSJL,(80- $L(PSJVD)) ,80) | |
| 16435 | "RTN","PSJ LMUDE",20, 0) | |
| 16436 | . D:PSJVD ]"" CNTRL^ VALM10(1,8 0-$L(PSJVD ),$L(PSJVD ),IORVON,I ORVOFF,0) | |
| 16437 | "RTN","PSJ LMUDE",21, 0) | |
| 16438 | I $G(PSJO RD)["P" D REQDT^PSJL IVMD(PSJOR D) | |
| 16439 | "RTN","PSJ LMUDE",22, 0) | |
| 16440 | S PSJL="I nstruction s: "_PSGOI NST D PTXT ^PSJLMPRU( PSJL,"PSJU DE",6,80) | |
| 16441 | "RTN","PSJ LMUDE",23, 0) | |
| 16442 | S PSJL=$S ($D(PSGEFN (2)):$E(" *",PSGEFN( 2)+1)_"(2) ",1:" " ),PSJL=$$S ETSTR^VALM 1("Dosage Ordered: " _PSGDO,PSJ L,5,76) D SETTMP D:$ G(PSGOEEF( 109)) HILI TE(2) | |
| 16443 | "RTN","PSJ LMUDE",24, 0) | |
| 16444 | I $G(PSGR DTX) S PSJ DUR=$$FMTD UR^PSJLIVM D($P($G(PS GRDTX),U,2 )) | |
| 16445 | "RTN","PSJ LMUDE",25, 0) | |
| 16446 | I $G(PSJO RD),($G(PS JDUR)="") S P=$S(PSJ ORD["U":5, PSJORD["V" :"IV",PSJO RD["P":"P" ,1:-1) S P SJDUR=$$GE TDUR^PSJLI VMD(PSGP,+ PSJORD,P) | |
| 16447 | "RTN","PSJ LMUDE",26, 0) | |
| 16448 | S PSJL=$$ SETSTR^VAL M1("Durati on: "_$G(P SJDUR),PSJ L,11,25) | |
| 16449 | "RTN","PSJ LMUDE",27, 0) | |
| 16450 | S PSJL=$$ SETSTR^VAL M1($S($D(P SGEFN(3)): $E(" *",PS GEFN(3)+1) _"(3)",1:" ")_"St art: "_$P( PSGSDN,U,2 ),PSJL,54, 26) D:$G(P SGOEEF(10) ) HILITE(3 ) | |
| 16451 | "RTN","PSJ LMUDE",28, 0) | |
| 16452 | I $G(PSGO RD)["P" N ND0,OLDO S ND0=@(PSG OEEWF_"0)" ) I $P(ND0 ,"^",24)=" R" S OLDO= $P(ND0,"^" ,25) I OLD O,(OLDO["U ") D | |
| 16453 | "RTN","PSJ LMUDE",29, 0) | |
| 16454 | . N OSTRT ,OSTRTN S OSTRT=$G(@ ("^PS(55," _PSGP_",5, "_+OLDO_", 2)")),OSTR T=$P(OSTRT ,"^",2) Q: 'OSTRT S OSTRTN=$$E NDTC^PSGMI (+OSTRT) | |
| 16455 | "RTN","PSJ LMUDE",30, 0) | |
| 16456 | . S PSJL= $$SETSTR^V ALM1($S($D (PSGEFN(3) ):$E(" *", PSGEFN(3)+ 1)_"(3)",1 :" ")_" Start: "_O STRTN,PSJL ,54,26) | |
| 16457 | "RTN","PSJ LMUDE",31, 0) | |
| 16458 | D SETTMP | |
| 16459 | "RTN","PSJ LMUDE",32, 0) | |
| 16460 | S PSJL=$S ($D(PSGEFN (4)):$E(" *",PSGEFN( 4)+1)_"(4) ",1:" " ),PSJL=$$S ETSTR^VALM 1("Med Rou te: "_PSGM RN,PSJL,10 ,35) D:$G( PSGOEEF(3) ) HILITE(4 ) | |
| 16461 | "RTN","PSJ LMUDE",33, 0) | |
| 16462 | I $G(PSJO RD)["P" N PSGRNDT S PSGRNDT=$$ LASTREN^PS JLMPRI(DFN ,PSGORD) S :PSGRNDT P SGRNDT=$$E NDTC^PSGMI (+PSGRNDT) ,PSJL=$$SE TSTR^VALM1 ("Renewed: "_PSGRNDT ,PSJL,56,3 2) | |
| 16463 | "RTN","PSJ LMUDE",34, 0) | |
| 16464 | I '$G(PSG RNDT),$G(P SGRDTX) D | |
| 16465 | "RTN","PSJ LMUDE",35, 0) | |
| 16466 | . I $D(PS GRDTX)<10 S PSGRSDN= $$ENDTC^PS GMI(+PSGRD TX),PSJL=$ $SETSTR^VA LM1("REQUE STED START : "_PSGRSD N,PSJL,48, 32) Q | |
| 16467 | "RTN","PSJ LMUDE",36, 0) | |
| 16468 | . I $G(PS GRDTX(+$G( PSJORD),"P SGRSD")),$ P($G(PSGSD N),U,2) S PSGRSDN=$$ ENDTC^PSGM I(PSGRDTX( +PSJORD,"P SGRSD")),P SJL=$$SETS TR^VALM1(" Calc Start : "_PSGRSD N,PSJL,53, 32) D | |
| 16469 | "RTN","PSJ LMUDE",37, 0) | |
| 16470 | .. I PSGS D'=PSGRDTX (+PSJORD," PSGRSD") D CNTRL^VAL M10(5,53,8 0,IORVON,I ORVOFF) | |
| 16471 | "RTN","PSJ LMUDE",38, 0) | |
| 16472 | ; Indirec t referenc e in PSGOE EWF below refers to either ^PS (53.1 or ^ PS(55,DFN, 5,. Naked reference refers to full indir ect refere nce | |
| 16473 | "RTN","PSJ LMUDE",39, 0) | |
| 16474 | I $G(PSJO RD)["U" N ND14 S ND1 4=$G(@(PSG OEEWF_"14, 0)")) I ND 14]"" S ND 14=$G(^($P (ND14,"^", 3),0)),RND T=$P(ND14, "^") I RND T D | |
| 16475 | "RTN","PSJ LMUDE",40, 0) | |
| 16476 | . N PSGRN DT S PSGRN DT=$$ENDTC ^PSGMI(+RN DT),PSJL=$ $SETSTR^VA LM1("Renew ed: "_PSGR NDT,PSJL,5 6,32) | |
| 16477 | "RTN","PSJ LMUDE",41, 0) | |
| 16478 | D SETTMP | |
| 16479 | "RTN","PSJ LMUDE",42, 0) | |
| 16480 | I PSGORD] "" S PSJBC MA=$$BCMAL G^PSJUTL2( PSGP,PSGOR D) | |
| 16481 | "RTN","PSJ LMUDE",43, 0) | |
| 16482 | I $G(PSJB CMA)]"" S PSJL=$$SET STR^VALM1( PSJBCMA,PS JL,1,52) | |
| 16483 | "RTN","PSJ LMUDE",44, 0) | |
| 16484 | ; START N CC REMEDIA TION >> 32 7*RJS | |
| 16485 | "RTN","PSJ LMUDE",45, 0) | |
| 16486 | S PSJL=$$ SETSTR^VAL M1($S($D(P SGEFN(5)): $E(" *",PS GEFN(5)+1) _"(5)",1:" ")_" Stop: "_$P (PSGFDN,U, 2),PSJL,54 ,26) D SET TMP D:$G(P SGOEEF(25) )!($G(PSGO EEF(34))) HILITE(5) | |
| 16487 | "RTN","PSJ LMUDE",46, 0) | |
| 16488 | S PSJL=$S ($D(PSGEFN (6)):$E(" *",PSGEFN( 6)+1)_"(6) ",1:" ") ,PSJL=$$SE TSTR^VALM1 ("Schedule Type: "_P SGSTN,PSJL ,6,45) D:$ G(PSGOEEF( 7)) HILITE (6) | |
| 16489 | "RTN","PSJ LMUDE",47, 0) | |
| 16490 | I $G(PSJO RD)["P",$G (PSGRDTX(+ $G(PSJORD) ,"PSGRFD") ),$P($G(PS GFDN),U,2) S PSGRFDN =$$ENDTC^P SGMI(PSGRD TX(+PSJORD ,"PSGRFD") ),PSJL=$$S ETSTR^VALM 1("Calc St op: "_PSGR FDN,PSJL,5 4,26) D | |
| 16491 | "RTN","PSJ LMUDE",48, 0) | |
| 16492 | . I PSGFD '=PSGRDTX( +PSJORD,"P SGRFD") D CNTRL^VALM 10(7,54,80 ,IORVON,IO RVOFF) | |
| 16493 | "RTN","PSJ LMUDE",49, 0) | |
| 16494 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 16495 | "RTN","PSJ LMUDE",50, 0) | |
| 16496 | D SETTMP | |
| 16497 | "RTN","PSJ LMUDE",51, 0) | |
| 16498 | S PSGSMN= $P("NO^YES ",U,PSGSM+ 1) | |
| 16499 | "RTN","PSJ LMUDE",52, 0) | |
| 16500 | S PSJL=$S ($D(PSGEFN (8)):$E(" *",PSGEFN( 8)+1)_"(8) ",1:" ") ,PSJL=$$SE TSTR^VALM1 ("Schedule : "_PSGSCH _$G(SCHMSG ),PSJL,11, 68) D SETT MP D:$G(PS GOEEF(26)) HILITE(8) | |
| 16501 | "RTN","PSJ LMUDE",53, 0) | |
| 16502 | S PSJL=$S ($D(PSGEFN (9)):$E(" *",PSGEFN( 9)+1)_"(9) ",1:" ") ,PSJL=$$SE TSTR^VALM1 ("Admin Ti mes: "_PSG AT,PSJL,8, 71) D SETT MP D:'$G(P SGNOHI)&($ G(PSGOEEF( 39))!($G(P SGOEEF(41) ))) HILITE (9) ;*315 | |
| 16503 | "RTN","PSJ LMUDE",54, 0) | |
| 16504 | I +$G(PSG RF)>1 N PS GRMVD S PS GRMVD=$S(+ $G(PSGRMVT ):PSGRMVT, 1:"") S PS JL=$$SETST R^VALM1("R emoval Tim es: "_PSGR MVD,PSJL,6 ,71) D SET TMP ;*315 | |
| 16505 | "RTN","PSJ LMUDE",55, 0) | |
| 16506 | S PSJL=$S ($D(PSGEFN (10)):$E(" *",PSGEFN (10)+1)_"( 10)",1:" "),PSJL=$ $SETSTR^VA LM1("Provi der: "_PSG PRN,PSJL,1 1,68) D:$G (PSGOEEF(1 )) HILITE( 10) D SETT MP | |
| 16507 | "RTN","PSJ LMUDE",56, 0) | |
| 16508 | S PSJL=$S ($D(PSGEFN (11)):$E(" *",PSGEFN (11))_" (1 1)",1:" ")_" Speci al Instruc tions"_$S( $P(PSGSI," ^",2)=1:"! : ",1:": " ) D | |
| 16509 | "RTN","PSJ LMUDE",57, 0) | |
| 16510 | .I '$D(^P S(53.45,DU Z,5,1)),$G (PSGORD) D GETSI^PSJ BCMA5(PSGP ,PSGORD) | |
| 16511 | "RTN","PSJ LMUDE",58, 0) | |
| 16512 | .I '$P($G (^PS(53.45 ,DUZ,5,0)) ,"^",3) S PSJL=PSJL_ $P($G(PSGS I),"^") D PTXT^PSJLM PRU(PSJL," PSJUDE",1, 80) Q | |
| 16513 | "RTN","PSJ LMUDE",59, 0) | |
| 16514 | .S PSJL=P SJL_" (see below)" D SETTMP N I S I=0 F J=1:1 S I= $O(^PS(53. 45,DUZ,5,I )) Q:'I S PSJL=" "_^PS(5 3.45,DUZ,5 ,I,0) D SE TTMP | |
| 16515 | "RTN","PSJ LMUDE",60, 0) | |
| 16516 | S PSJL="" D SETTMP D:$G(PSGOE EF(8)) HIL ITE(11) | |
| 16517 | "RTN","PSJ LMUDE",61, 0) | |
| 16518 | ; E3R 161 30 | |
| 16519 | "RTN","PSJ LMUDE",62, 0) | |
| 16520 | I $O(^PS( 53.45,PSJS YSP,2,1)) F S PSJL= "" D SETTM P Q:PSJLN> 15 | |
| 16521 | "RTN","PSJ LMUDE",63, 0) | |
| 16522 | S PSJL=$S ($D(PSGEFN (12)):$E(" *",PSGEFN (12))_" (1 2)",1:" ")_" Dispe nse Drug", PSJL=$$SET STR^VALM1( "U/D",PSJL ,52,60),PS JL=$$SETST R^VALM1("I nactive Da te",PSJL,5 9,16) D D SETTMP,CN TRL^VALM10 (PSJLN-1,1 ,80,IOUON, IOUOFF,0) | |
| 16523 | "RTN","PSJ LMUDE",64, 0) | |
| 16524 | .I $$GET^ XPAR("SYS" ,"PSJ PADE OE BALANC ES") D | |
| 16525 | "RTN","PSJ LMUDE",65, 0) | |
| 16526 | ..I '$G(V AIN(4)) N VAIN,DFN S DFN=$G(PS GP) D INP^ VADPT | |
| 16527 | "RTN","PSJ LMUDE",66, 0) | |
| 16528 | ..N PSJOR CL,PSJCLNK | |
| 16529 | "RTN","PSJ LMUDE",67, 0) | |
| 16530 | ..; If cl inic order , quit if clinic loc ation is n ot linked to PADE | |
| 16531 | "RTN","PSJ LMUDE",68, 0) | |
| 16532 | ..S PSJOR CL=$S($G(P SGORD)["P" :$G(^PS(53 .1,+$G(PSG ORD),"DSS" )),$G(PSGO RD)["U":$G (^PS(55,+$ G(PSGP),5, +$G(PSGORD ),8)),$G(P SGORD)["V" :$G(^PS(55 ,+$G(PSGP) ,"IV",+$G( PSGORD),"D SS")),1:"" ) | |
| 16533 | "RTN","PSJ LMUDE",69, 0) | |
| 16534 | ..I PSJOR CL,$P(PSJO RCL,"^",2) S PSJCLNK =$$PADECL^ PSJPAD50(+ $G(PSJORCL )) Q:'PSJC LNK | |
| 16535 | "RTN","PSJ LMUDE",70, 0) | |
| 16536 | ..I '$G(P SJCLNK) Q: '$$PADEWD^ PSJPAD50(+ $G(VAIN(4) )) ; PAD E device I nactive? | |
| 16537 | "RTN","PSJ LMUDE",71, 0) | |
| 16538 | ..S PSJL= $$SETSTR^V ALM1("PADE ",PSJL,75, 5) | |
| 16539 | "RTN","PSJ LMUDE",72, 0) | |
| 16540 | NEW PSJX, PSJDLINE | |
| 16541 | "RTN","PSJ LMUDE",73, 0) | |
| 16542 | F Q=0:0 S Q=$O(^PS( 53.45,PSJS YSP,2,Q)) Q:'Q S ND =$G(^(Q,0) ) D | |
| 16543 | "RTN","PSJ LMUDE",74, 0) | |
| 16544 | .S D=$P(N D,"^"),PSG ID=$P(ND," ^",3) I PS GID S PSGI D=$$ENDTC^ PSGMI(PSGI D) | |
| 16545 | "RTN","PSJ LMUDE",75, 0) | |
| 16546 | .S D=$S(D ="":"NOT F OUND",'$D( ^PSDRUG(D, 0)):D,$P(^ (0),"^")]" ":$P(^(0), "^"),1:D_" ;PSDRUG(") | |
| 16547 | "RTN","PSJ LMUDE",76, 0) | |
| 16548 | .S PSJL=" "_D_ $$DDNF^PSJ DIN(+ND),P SJL=$$SETS TR^VALM1($ S($P(ND,"^ ",2):$S($P (ND,"^",2) =.5:"1/2", $P(ND,"^", 2)=.25:"1/ 4",1:$P(ND ,"^",2)),$ P(ND,"^",2 )=0:0,1:1) ,PSJL,52,6 3) S:PSGID PSJL=$$SE TSTR^VALM1 (PSGID,PSJ L,59,16) D D SETTMP | |
| 16549 | "RTN","PSJ LMUDE",77, 0) | |
| 16550 | ..; PSJ*5 *317 - If PSJ PADE O E BALANCES parameter is YES, P ADE balanc es should display as identifie r. | |
| 16551 | "RTN","PSJ LMUDE",78, 0) | |
| 16552 | ..I $$GET ^XPAR("SYS ","PSJ PAD E OE BALAN CES") D | |
| 16553 | "RTN","PSJ LMUDE",79, 0) | |
| 16554 | ...N PSJP DLOC,VAIN, PSJORCL,PS JCLNK,PSJC LND D INP^ VADPT | |
| 16555 | "RTN","PSJ LMUDE",80, 0) | |
| 16556 | ...; If c linic orde r, quit if clinic lo cation is not linked to PADE | |
| 16557 | "RTN","PSJ LMUDE",81, 0) | |
| 16558 | ...S PSJC LND=$S($G( PSGORD)["P ":$G(^PS(5 3.1,+$G(PS GORD),"DSS ")),$G(PSG ORD)["U":$ G(^PS(55,+ $G(PSGP),5 ,+$G(PSGOR D),8)),$G( PSGORD)["V ":$G(^PS(5 5,+$G(PSGP ),"IV",+$G (PSGORD)," DSS")),1:" ") | |
| 16559 | "RTN","PSJ LMUDE",82, 0) | |
| 16560 | ...S PSJO RCL=$S(+PS JCLND&$P(P SJCLND,"^" ,2):+PSJCL ND,1:"") | |
| 16561 | "RTN","PSJ LMUDE",83, 0) | |
| 16562 | ...I PSJO RCL,$P(PSJ CLND,"^",2 ) S PSJCLN K=$$PADECL ^PSJPAD50( +$G(PSJORC L)) Q:'PSJ CLNK | |
| 16563 | "RTN","PSJ LMUDE",84, 0) | |
| 16564 | ...I '$G( PSJCLNK) Q :'$$PADEWD ^PSJPAD50( +$G(VAIN(4 ))) ; Qu it if pati ent locati on not lin ked to PAD E | |
| 16565 | "RTN","PSJ LMUDE",85, 0) | |
| 16566 | ...S PSJP DLOC=$S($G (PSJCLNK): PSJORCL_"C ",1:"") | |
| 16567 | "RTN","PSJ LMUDE",86, 0) | |
| 16568 | ...S:'PSJ PDLOC PSJP DLOC=+$G(V AIN(4)) | |
| 16569 | "RTN","PSJ LMUDE",87, 0) | |
| 16570 | ...N PADE S PADE=$J ($$DRGQTY^ PSJPADSI(+ ND,$S(PSJP DLOC["C":" CL",1:"WD" ),+PSJPDLO C),5) | |
| 16571 | "RTN","PSJ LMUDE",88, 0) | |
| 16572 | ...S PSJL =$$SETSTR^ VALM1(PADE ,PSJL,74,5 ) | |
| 16573 | "RTN","PSJ LMUDE",89, 0) | |
| 16574 | ..S PSJX= $G(PSJX)+1 | |
| 16575 | "RTN","PSJ LMUDE",90, 0) | |
| 16576 | ..S PSJDL INE=$S($P( ^PS(53.45, PSJSYSP,2, 0),U,3)>1: 16,1:13) ; *228 - Hig hlight mul tiple disp ense drugs | |
| 16577 | "RTN","PSJ LMUDE",91, 0) | |
| 16578 | ..I $G(PS GOEEF(109) ) D CNTRL^ VALM10(PSJ DLINE+PSJX ,7,73,IORV ON_IOBON,I ORVOFF_IOB OFF,0) | |
| 16579 | "RTN","PSJ LMUDE",92, 0) | |
| 16580 | I $S(PSGO RD["P":$O( ^PS(53.1,+ $G(PSGORD) ,12,0)),1: $O(^PS(55, PSGP,5,+PS GORD,12,0) )) S PSJL= "Provider Comments:" D SETTMP S PSJL="" D | |
| 16581 | "RTN","PSJ LMUDE",93, 0) | |
| 16582 | .F Q=0:0 S Q=$S(PSG ORD["P":$O (^PS(53.1, +$G(PSGORD ),12,Q)),1 :$O(^PS(55 ,PSGP,5,+P SGORD,12,Q ))) Q:'Q S PSJL=$G( ^(Q,0)) D SETTMP | |
| 16583 | "RTN","PSJ LMUDE",94, 0) | |
| 16584 | D SETTMP S PSJL=$$S ETSTR^VALM 1($S($D(PS GEFN(7)):$ E(" *",PSG EFN(7)+1)_ "(7)",1:" ")_"Self Med: "_PS GSMN,PSJL, 1,24) | |
| 16585 | "RTN","PSJ LMUDE",95, 0) | |
| 16586 | S:PSGSM&P SGHSM PSJL =$$SETSTR^ VALM1(" ( HS)",PSJL, 16,7) D SE TTMP D:$G( PSGOEEF(5) ) HILITE(7 ) | |
| 16587 | "RTN","PSJ LMUDE",96, 0) | |
| 16588 | D SETTMP S PSJL="En try By: "_ PSGEBN,PSJ L=$$SETSTR ^VALM1("En try Date: "_$P(PSGLI N,U,2),PSJ L,51,39) D SETTMP | |
| 16589 | "RTN","PSJ LMUDE",97, 0) | |
| 16590 | I $G(PSGL RN) D SETT MP S PSJL= "Renewed B y: "_$$ENN PN^PSGMI($ P(PSGLRN," ^",2)) D S ETTMP | |
| 16591 | "RTN","PSJ LMUDE",98, 0) | |
| 16592 | D SETTMP S PSJL="(1 3)"_" Comm ents:" | |
| 16593 | "RTN","PSJ LMUDE",99, 0) | |
| 16594 | D:'$O(^PS (53.45,PSJ SYSP,1,0)) SETTMP | |
| 16595 | "RTN","PSJ LMUDE",100 ,0) | |
| 16596 | D SETTMP F Q=0:0 S Q=$O(^PS(5 3.45,PSJSY SP,1,Q)) Q :'Q S PSJ WPL=PSJL_$ S($E(PSJL) =" ":"",1: " ")_$G(^( Q,0)),PSJL ="" D DISP LAY | |
| 16597 | "RTN","PSJ LMUDE",101 ,0) | |
| 16598 | D SETTMP | |
| 16599 | "RTN","PSJ LMUDE",102 ,0) | |
| 16600 | I PSGORD[ "P",($P($G (^PS(53.1, +PSGORD,0) ),U,9)="P" ),$O(^PS(5 3.1,+PSGOR D,10,0)) D | |
| 16601 | "RTN","PSJ LMUDE",103 ,0) | |
| 16602 | .D SETTMP S PSJL="C PRS Order Checks:" D SETTMP | |
| 16603 | "RTN","PSJ LMUDE",104 ,0) | |
| 16604 | .F Q=0:0 S Q=$O(^PS (53.1,+PSG ORD,10,Q)) Q:'Q D | |
| 16605 | "RTN","PSJ LMUDE",105 ,0) | |
| 16606 | ..;S PSJL ="" D SETT MP S PSJL= $G(^PS(53. 1,+PSGORD, 10,Q,0)) D SETTMP | |
| 16607 | "RTN","PSJ LMUDE",106 ,0) | |
| 16608 | ..S PSJL= "" D SETTM P | |
| 16609 | "RTN","PSJ LMUDE",107 ,0) | |
| 16610 | ..D FORMA TTX($G(^PS (53.1,+PSG ORD,10,Q,0 ))) | |
| 16611 | "RTN","PSJ LMUDE",108 ,0) | |
| 16612 | ..S PSJL= "Overridin g Provider : "_$P($G( ^PS(53.1,+ PSGORD,10, Q,1)),U) D SETTMP | |
| 16613 | "RTN","PSJ LMUDE",109 ,0) | |
| 16614 | ..S PSJL= "Overridin g Reason: " F X=0:0 S X=$O(^PS (53.1,+PSG ORD,10,Q,2 ,X)) Q:'X D | |
| 16615 | "RTN","PSJ LMUDE",110 ,0) | |
| 16616 | ...S PSJL =PSJL_$G(^ PS(53.1,+P SGORD,10,Q ,2,X,0)) D SETTMP S PSJL=" " | |
| 16617 | "RTN","PSJ LMUDE",111 ,0) | |
| 16618 | ACTFLG ; | |
| 16619 | "RTN","PSJ LMUDE",112 ,0) | |
| 16620 | S ND4=$S( PSGORD["P" :$G(^PS(53 .1,+PSGORD ,4)),1:$G( ^PS(55,PSG P,5,+PSGOR D,4))) | |
| 16621 | "RTN","PSJ LMUDE",113 ,0) | |
| 16622 | S AT="",Y ="12,13,D, 18,19,H1,2 2,23,H0,15 ,16,R" F X =1:3:12 I $P(ND4,"^" ,$P(Y,",", X)),$P(ND4 ,"^",$P(Y, ",",X+1)) S AT=$P(Y, ",",X+2) Q | |
| 16623 | "RTN","PSJ LMUDE",114 ,0) | |
| 16624 | I AT="",' $P(ND4,"^" ,$S($P(PSJ SYSU,";",3 )>1:3,1:1) ) S AT="V" _$S($P(ND4 ,"^",18):" H1",$P(ND4 ,"^",22):" H0",$P(ND4 ,"^",15):" R",1:"") | |
| 16625 | "RTN","PSJ LMUDE",115 ,0) | |
| 16626 | I AT]"" D | |
| 16627 | "RTN","PSJ LMUDE",116 ,0) | |
| 16628 | .S PSJL=" " D SETTMP | |
| 16629 | "RTN","PSJ LMUDE",117 ,0) | |
| 16630 | .S PSJL=" ORDER "_$S (AT["V":"N OT VERIFIE D"_$S($P(A T,"V",2)=" ":"",1:" ( "_$S(AT["H 1":"ON HOL D",AT["H0" :"OFF HOLD ",1:"RENEW AL")_")"), 1:"MARKED TO BE "_$S (AT["D":"C ANCELLED", AT["H1":"P LACED ON H OLD",AT["H 0":"TAKEN OFF OF HOL D",1:"RENE WED")) | |
| 16631 | "RTN","PSJ LMUDE",118 ,0) | |
| 16632 | I AT'["V" ,AT["H1",$ D(^PS(55,P SGP,5.1)) S AT=^(5.1 ) I $P(AT, "^",7),$P( AT,"^",10) ]"" S PSJL =PSJL_" ( "_$P(AT,"^ ",10)_")" | |
| 16633 | "RTN","PSJ LMUDE",119 ,0) | |
| 16634 | D SETTMP | |
| 16635 | "RTN","PSJ LMUDE",120 ,0) | |
| 16636 | S VALMCNT =PSJLN-1 | |
| 16637 | "RTN","PSJ LMUDE",121 ,0) | |
| 16638 | K PSGSMN, Q,Y,Y1,Y2, PSGLRN | |
| 16639 | "RTN","PSJ LMUDE",122 ,0) | |
| 16640 | S VALM("T ITLE")=PSG STAT_" UNI T DOSE "_$ S((PSGSTAT ="PENDING" )&($G(PSGP RIO)]""):" ("_PSGPRIO _")",$G(PS GPRIO)="DO NE":"("_PS GPRIO_")", 1:"") I $D (PSJLMP2) S VALMBG=1 6 K PSJLMP 2 | |
| 16641 | "RTN","PSJ LMUDE",123 ,0) | |
| 16642 | TEST ; | |
| 16643 | "RTN","PSJ LMUDE",124 ,0) | |
| 16644 | I $G(PSGP FLG) S VAL MSG="INVAL ID ORDERAB LE ITEM" | |
| 16645 | "RTN","PSJ LMUDE",125 ,0) | |
| 16646 | I $G(PSGD I) S VALMS G=$S($G(VA LMSG)="":" INVALID",1 :VALMSG_", ")_" DISPE NSE DRUG" | |
| 16647 | "RTN","PSJ LMUDE",126 ,0) | |
| 16648 | I $G(PSGP I) S VALMS G=$S($G(VA LMSG)="":" INVALID",1 :VALMSG_", ")_" PROVI DER" | |
| 16649 | "RTN","PSJ LMUDE",127 ,0) | |
| 16650 | Q | |
| 16651 | "RTN","PSJ LMUDE",128 ,0) | |
| 16652 | DISPLAY ; | |
| 16653 | "RTN","PSJ LMUDE",129 ,0) | |
| 16654 | S PSJL=PS JWPL D SET TMP | |
| 16655 | "RTN","PSJ LMUDE",130 ,0) | |
| 16656 | Q | |
| 16657 | "RTN","PSJ LMUDE",131 ,0) | |
| 16658 | ; | |
| 16659 | "RTN","PSJ LMUDE",132 ,0) | |
| 16660 | SETTMP ; | |
| 16661 | "RTN","PSJ LMUDE",133 ,0) | |
| 16662 | S ^TMP("P SJUDE",$J, PSJLN,0)=P SJL,PSJLN= PSJLN+1,PS JL="" | |
| 16663 | "RTN","PSJ LMUDE",134 ,0) | |
| 16664 | Q | |
| 16665 | "RTN","PSJ LMUDE",135 ,0) | |
| 16666 | ; | |
| 16667 | "RTN","PSJ LMUDE",136 ,0) | |
| 16668 | HILITE(FLD ) ; | |
| 16669 | "RTN","PSJ LMUDE",137 ,0) | |
| 16670 | N COL,LIN ,WID,X | |
| 16671 | "RTN","PSJ LMUDE",138 ,0) | |
| 16672 | S X="$T(" _FLD_"^PSJ LMUDE)",@( "X="_X),X= $P(X,";;", 2),LIN=+X, COL=$P(X," ,",2),LAB= $P(X,",",3 ),X=$P(X," ,",4),WID= (LAB+$L(@X )) | |
| 16673 | "RTN","PSJ LMUDE",139 ,0) | |
| 16674 | I $G(PSGR F),FLD>9 S LIN=LIN+1 ;COMPENSA TE FOR REM OVAL TIMES | |
| 16675 | "RTN","PSJ LMUDE",140 ,0) | |
| 16676 | I FLD=7 S LIN=+$G(P SJLN)-1 Q: LIN<13 | |
| 16677 | "RTN","PSJ LMUDE",141 ,0) | |
| 16678 | D CNTRL^V ALM10(LIN, COL,WID,IO RVON_IOBON ,IORVOFF_I OBOFF,0) | |
| 16679 | "RTN","PSJ LMUDE",142 ,0) | |
| 16680 | Q | |
| 16681 | "RTN","PSJ LMUDE",143 ,0) | |
| 16682 | ; | |
| 16683 | "RTN","PSJ LMUDE",144 ,0) | |
| 16684 | FORMATTX(P SJX) ; | |
| 16685 | "RTN","PSJ LMUDE",145 ,0) | |
| 16686 | NEW PSJX1 ,Y,Y1 | |
| 16687 | "RTN","PSJ LMUDE",146 ,0) | |
| 16688 | S PSJX1=" " | |
| 16689 | "RTN","PSJ LMUDE",147 ,0) | |
| 16690 | F Y=1:1:$ L(PSJX," " ) S Y1=$P( PSJX," ",Y ) D | |
| 16691 | "RTN","PSJ LMUDE",148 ,0) | |
| 16692 | . I ($L(P SJX1)+$L(Y 1)+1)>79 S :$E(PSJX1, 1,1)=" " P SJX1=$E(PS JX1,2,$L(P SJX1)) S P SJL=PSJX1, PSJX1="" D SETTMP | |
| 16693 | "RTN","PSJ LMUDE",149 ,0) | |
| 16694 | . S PSJX1 =PSJX1_Y1_ " " | |
| 16695 | "RTN","PSJ LMUDE",150 ,0) | |
| 16696 | I PSJX1]" " S PSJL=P SJX1 D SET TMP | |
| 16697 | "RTN","PSJ LMUDE",151 ,0) | |
| 16698 | K PSJX1 | |
| 16699 | "RTN","PSJ LMUDE",152 ,0) | |
| 16700 | Q | |
| 16701 | "RTN","PSJ LMUDE",153 ,0) | |
| 16702 | ; | |
| 16703 | "RTN","PSJ LMUDE",154 ,0) | |
| 16704 | 1 ;;1,5,16 ,PSGPDN | |
| 16705 | "RTN","PSJ LMUDE",155 ,0) | |
| 16706 | 2 ;;3,5,16 ,PSGDO | |
| 16707 | "RTN","PSJ LMUDE",156 ,0) | |
| 16708 | 3 ;;4,58,7 ,PSGSDN | |
| 16709 | "RTN","PSJ LMUDE",157 ,0) | |
| 16710 | 4 ;;5,10,1 1,PSGMRN | |
| 16711 | "RTN","PSJ LMUDE",158 ,0) | |
| 16712 | 5 ;;6,59,6 ,PSGFDN | |
| 16713 | "RTN","PSJ LMUDE",159 ,0) | |
| 16714 | 6 ;;7,6,15 ,PSGSTN | |
| 16715 | "RTN","PSJ LMUDE",160 ,0) | |
| 16716 | 7 ;;18,5,1 4,PSGSMN | |
| 16717 | "RTN","PSJ LMUDE",161 ,0) | |
| 16718 | 8 ;;8,11,1 2,PSGSCH | |
| 16719 | "RTN","PSJ LMUDE",162 ,0) | |
| 16720 | 9 ;;9,8,13 ,PSGAT | |
| 16721 | "RTN","PSJ LMUDE",163 ,0) | |
| 16722 | 10 ;;10,11 ,10,PSGPRN | |
| 16723 | "RTN","PSJ LMUDE",164 ,0) | |
| 16724 | 11 ;;11,7, 22,PSGSI | |
| 16725 | "RTN","PSJ LMUDE",165 ,0) | |
| 16726 | ENKILL ; | |
| 16727 | "RTN","PSJ LMUDE",166 ,0) | |
| 16728 | K PSGNOHI ,PSGAT,PSG EB,PSGEFN, PSGFD,PSGH SM,PSGNEFD ,PSGNESD,P SGOEEF,PSG OEER,PSGOF D,PSGOHSM, PSGOMR,PSG OMRN,PSGOP D,PSGOPDN, PSGOPR,PSG OSCH,PSGOS D,PSGOSM,P SGOST,PSGP D,PSGPDN,P SGPR,PSGSD ,PSGSM Q | |
| 16729 | "RTN","PSJ OE") | |
| 16730 | 0^1^B11958 1461 | |
| 16731 | "RTN","PSJ OE",1,0) | |
| 16732 | PSJOE ;BIR /MLM - INP ATIENT ORD ER ENTRY ; 23 Oct 20 17 3:28 P M | |
| 16733 | "RTN","PSJ OE",2,0) | |
| 16734 | ;;5.0;INP ATIENT MED ICATIONS;* *7,26,29,3 3,42,50,56 ,72,58,85, 95,80,110, 111,133,14 0,151,149, 181,252,28 1,315,327* *;16 DEC 9 7;Build 64 | |
| 16735 | "RTN","PSJ OE",3,0) | |
| 16736 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 16737 | "RTN","PSJ OE",4,0) | |
| 16738 | ; Referen ce to ^PS( 55 is supp orted by D BIA #2191. | |
| 16739 | "RTN","PSJ OE",5,0) | |
| 16740 | ; Referen ce to EN^V ALM is sup ported by DBIA #1011 8. | |
| 16741 | "RTN","PSJ OE",6,0) | |
| 16742 | ; Referen ce to FULL ^VALM1 is supported by DBIA #1 0116. | |
| 16743 | "RTN","PSJ OE",7,0) | |
| 16744 | ; Referen ce to PAUS E^VALM1 is supported by DBIA # 10116. | |
| 16745 | "RTN","PSJ OE",8,0) | |
| 16746 | ; Referen ce to ^PSS LOCK is su pported by DBIA #278 9 | |
| 16747 | "RTN","PSJ OE",9,0) | |
| 16748 | ; Referen ce to ^DPT ( is suppo rted by DB IA #10035. | |
| 16749 | "RTN","PSJ OE",10,0) | |
| 16750 | ; Referen ce to ^ORC FLAG is su pported by DBIA #362 0. | |
| 16751 | "RTN","PSJ OE",11,0) | |
| 16752 | ; Referen ce to ^SDA MA203 is s upported b y DBIA #41 33. | |
| 16753 | "RTN","PSJ OE",12,0) | |
| 16754 | ; Referen ce to ^TMP ("PSODAOC" is suppor ted by DBI A #6071. | |
| 16755 | "RTN","PSJ OE",13,0) | |
| 16756 | ; | |
| 16757 | "RTN","PSJ OE",14,0) | |
| 16758 | EN ; Start Inpatient LM OE | |
| 16759 | "RTN","PSJ OE",15,0) | |
| 16760 | N PSJLK,P SJNEWOE,PS JLMCON,PSJ PROT,XQORS ,VALMEVL D ENCV^PSGS ETU,^PSIVX U | |
| 16761 | "RTN","PSJ OE",16,0) | |
| 16762 | I $D(XQUI T) K XQUIT G DONE | |
| 16763 | "RTN","PSJ OE",17,0) | |
| 16764 | K PSGVBY, PSJPR S (P SJOL,PSJAC OK,PSGOP,P SGNEF,PSGO EAV,PSGPXN )="" L +^P S(53.45,PS JSYSP):1 E D LOCKER R^PSJOE G DONE^PSJOE | |
| 16765 | "RTN","PSJ OE",18,0) | |
| 16766 | F S (PSJ LMCON,PSGP TMP)=0 D ^ PSJP,HK Q: PSGP'>0 S PSJPROT=3 ,DFN=PSGP D ^PSJAC D I PSJLK D UL^PSSLO CK(PSGP) | |
| 16767 | "RTN","PSJ OE",19,0) | |
| 16768 | .K ^TMP(" PSJ",$J) | |
| 16769 | "RTN","PSJ OE",20,0) | |
| 16770 | .S PSJLK= $$L^PSSLOC K(PSGP,1) I 'PSJLK W !,$C(7),$ P(PSJLK,U, 2) Q | |
| 16771 | "RTN","PSJ OE",21,0) | |
| 16772 | .K PSJLMP RO D EN^VA LM("PSJ LM BRIEF PAT IENT INFO" ) | |
| 16773 | "RTN","PSJ OE",22,0) | |
| 16774 | .N NXTPT S NXTPT=0 F Q:$G(NX TPT) D | |
| 16775 | "RTN","PSJ OE",23,0) | |
| 16776 | ..K PSGRD TX | |
| 16777 | "RTN","PSJ OE",24,0) | |
| 16778 | ..I $G(PS JLMCON)!$G (PSJNEWOE) D | |
| 16779 | "RTN","PSJ OE",25,0) | |
| 16780 | ...S PSJO L=$S(",S,L ,"[(","_$G (PSJOL)_", "):PSJOL,1 :"S") | |
| 16781 | "RTN","PSJ OE",26,0) | |
| 16782 | ...S PSJL MPRO=1,PSJ LMCON=1,PS JNEWOE=0 D EN^VALM(" PSJ LM OE" ) | |
| 16783 | "RTN","PSJ OE",27,0) | |
| 16784 | ..I $G(PS JNEWOE)!($ G(VALMBCK) ="Q") S PS JNEWOE=0 Q | |
| 16785 | "RTN","PSJ OE",28,0) | |
| 16786 | ..I $G(PS JLMCON)&$G (PSJLMPRO) &'$D(^TMP( "PSJ",$J)) D Q | |
| 16787 | "RTN","PSJ OE",29,0) | |
| 16788 | ...S PSJL MCON=0,PSJ LMPRO=0 D EN^VALM("P SJ LM BRIE F PATIENT INFO") | |
| 16789 | "RTN","PSJ OE",30,0) | |
| 16790 | ...I $G(P SJNEWOE) S NXTPT=0 Q | |
| 16791 | "RTN","PSJ OE",31,0) | |
| 16792 | ...S NXTP T=1 | |
| 16793 | "RTN","PSJ OE",32,0) | |
| 16794 | ..S NXTPT =1,PSJNEWO E=0 | |
| 16795 | "RTN","PSJ OE",33,0) | |
| 16796 | .S PSJOL= "S" | |
| 16797 | "RTN","PSJ OE",34,0) | |
| 16798 | .I $G(PSG PXN) I $P( PSJSYSW0,U ,29)]""!($ G(PSJCOM)) S PSGPXPT =PSGP D K PSGPXPT S PSGPXN=0 | |
| 16799 | "RTN","PSJ OE",35,0) | |
| 16800 | ..N DFN,P SGP,PSJPXD P | |
| 16801 | "RTN","PSJ OE",36,0) | |
| 16802 | ..I $P(PS JSYSW0,U,2 9)="" S PS JPDXP=1 D | |
| 16803 | "RTN","PSJ OE",37,0) | |
| 16804 | ...;N IO, ION,IOS D HOME^%ZIS S $P(PSJSY SW0,U,29)= +$G(IOS) | |
| 16805 | "RTN","PSJ OE",38,0) | |
| 16806 | ...D HOME ^%ZIS S $P (PSJSYSW0, U,29)=+$G( IOS) | |
| 16807 | "RTN","PSJ OE",39,0) | |
| 16808 | ..S (PSGP ,DFN)=PSGP XPT D ^PSG PER S:$G(P SJPDXP) $P (PSJSYSW0, U,29)="" K PSJPDXP | |
| 16809 | "RTN","PSJ OE",40,0) | |
| 16810 | .D ENCV^P SGSETU,^PS IVXU | |
| 16811 | "RTN","PSJ OE",41,0) | |
| 16812 | K PSJLMPR O,^TMP("PS JPRO",$J), ^TMP("PSJ" ,$J),^TMP( "PSJON",$J ) | |
| 16813 | "RTN","PSJ OE",42,0) | |
| 16814 | DONE ; | |
| 16815 | "RTN","PSJ OE",43,0) | |
| 16816 | ; -- RTC 198753 - c orrect typ o - r PSJA LGSV w PSJ AGYSV | |
| 16817 | "RTN","PSJ OE",44,0) | |
| 16818 | K PSJAGYS V,PSJEXCPT ,PSJOCER,^ TMP($J,"PS JPRE"),^TM P("PSODAOC ",$J),^TMP ("PSJDAOC" ,$J) | |
| 16819 | "RTN","PSJ OE",45,0) | |
| 16820 | K AC,ACTI ON,D1,D2,M I,N,ON,P3, PNOW,PSIVA T,PSIVLN,P SIVSTR L - ^PS(53.45, PSJSYSP) | |
| 16821 | "RTN","PSJ OE",46,0) | |
| 16822 | K DA,DRG, NE,PSGCF,P SGCANFL,PS GNEDFD,PSG NEF,PSGNEF D,PSGNEPR, PSGNESD,PS JACOK,PSJO E,PSJOECNT ,PSJOEPF,P SJORD,PSGO EA,PSGOEAV ,PSGOL,PSG OS,PSGON,P SGOP,PSGOR D,PSGS0XT, PSGS0Y,RCT ,ST,WD,XRE F,Z,PSJIVO RF,PSJIVPC L | |
| 16823 | "RTN","PSJ OE",47,0) | |
| 16824 | K PSGOEOR F,PSIVREA, PSJOPC,PSJ ORL,PSJORP CL,PSJORTO I,RF,WSCHA DM,PSJLM,P SJCT | |
| 16825 | "RTN","PSJ OE",48,0) | |
| 16826 | K DIU,DRG I,FLAG,FQC ,ND2,PRI,P SGOE,PSGPR I,PSGSDN,P SGOEDMR,PS GOEPR,PSGP TS,PSGTOL, PSGTOO,PSG UOW,PSJIVO F,PSJOCNT, PSJON,PSJO RQF,PSJORT OU,PSJORVP | |
| 16827 | "RTN","PSJ OE",49,0) | |
| 16828 | K PSIVENO ,PSGRMV,PS GRMVT,PSGD UR,PSGRF,N D2P1 ;*315 | |
| 16829 | "RTN","PSJ OE",50,0) | |
| 16830 | G:$G(PSGP XN) ^PSGPE R1 D ENIVK V^PSGSETU | |
| 16831 | "RTN","PSJ OE",51,0) | |
| 16832 | Q | |
| 16833 | "RTN","PSJ OE",52,0) | |
| 16834 | HK ; House keeping (a nice COBO L term) | |
| 16835 | "RTN","PSJ OE",53,0) | |
| 16836 | I PSGOP,P SGOP'=PSGP D | |
| 16837 | "RTN","PSJ OE",54,0) | |
| 16838 | .N PSJACP F,PSJACNWP ,PSJPWD,PS JSYSL,PSJS YSW,PSJSYS W0,DFN,VAI N,VAERR S DFN=PSGOP | |
| 16839 | "RTN","PSJ OE",55,0) | |
| 16840 | .D INP^VA DPT S PSJP WD=+VAIN(4 ) I PSJPWD S PSJACPF =10 D WP^P SJAC D:$P( PSJSYSL,"^ ",2)]"" EN QL^PSGLW | |
| 16841 | "RTN","PSJ OE",56,0) | |
| 16842 | Q:PSGP<0 | |
| 16843 | "RTN","PSJ OE",57,0) | |
| 16844 | S (DFN,PS GOP)=PSGP, X="" | |
| 16845 | "RTN","PSJ OE",58,0) | |
| 16846 | Q | |
| 16847 | "RTN","PSJ OE",59,0) | |
| 16848 | SELECT ; S elect orde r from lis t | |
| 16849 | "RTN","PSJ OE",60,0) | |
| 16850 | ;Variable PSJOCDSC is used in Complex o rder dosin g checks | |
| 16851 | "RTN","PSJ OE",61,0) | |
| 16852 | N PSGLMT, PSGODDD,PS JLMQT,PSJL MFIN,PSJUD PRF,PSGRDT X,PSJOCDSC ,PSJAGYSV K ^TMP("PS JCOM",$J), ^TMP("PSJC OM2",$J),P SJSTARI,^T MP("PSODAO C",$J),^TM P("PSJDAOC ",$J) | |
| 16853 | "RTN","PSJ OE",62,0) | |
| 16854 | K PSGDUR, PSGRMVT,PS GRMV,PSGRF ,ND2P1 ;*3 15 | |
| 16855 | "RTN","PSJ OE",63,0) | |
| 16856 | S PSGONC= 1,PSGLMT=^ TMP("PSJPR O",$J,0) D ENASR^PSG ON | |
| 16857 | "RTN","PSJ OE",64,0) | |
| 16858 | I "^"[X S VALMQUIT= 1 Q | |
| 16859 | "RTN","PSJ OE",65,0) | |
| 16860 | S PSJLM=1 ,PSJSEL=0 F S PSJSE L=$O(PSGOD DD(PSJSEL) ) Q:'PSJSE L!($G(Y)<0 ) F PSJSE L1=1:1:$L( PSGODDD(PS JSEL),",") -1 D | |
| 16861 | "RTN","PSJ OE",66,0) | |
| 16862 | .K PSJOCD SC | |
| 16863 | "RTN","PSJ OE",67,0) | |
| 16864 | .S PSJORD =$G(^TMP(" PSJON",$J, +$P(PSGODD D(PSJSEL), ",",PSJSEL 1))) D:PSJ ORD=+PSJOR D SELECT^P SJOEA Q:PS JORD=""!($ G(Y)<0) Q :PSJORD=+P SJORD D | |
| 16865 | "RTN","PSJ OE",68,0) | |
| 16866 | ..Q:('$$L S^PSSLOCK( PSGP,PSJOR D)) | |
| 16867 | "RTN","PSJ OE",69,0) | |
| 16868 | ..Q:PSJOR D=+PSJORD | |
| 16869 | "RTN","PSJ OE",70,0) | |
| 16870 | ..S PSGOR D="" | |
| 16871 | "RTN","PSJ OE",71,0) | |
| 16872 | ..D DISAC TIO(PSGP,P SJORD,"") S:PSJORD[" V" PSJORD= ON | |
| 16873 | "RTN","PSJ OE",72,0) | |
| 16874 | ..D UNL^P SSLOCK(PSG P,PSJORD) Q:$G(Y)<0 | |
| 16875 | "RTN","PSJ OE",73,0) | |
| 16876 | S VALMBCK ="Q" | |
| 16877 | "RTN","PSJ OE",74,0) | |
| 16878 | K PSJLM,P SJOCDSC | |
| 16879 | "RTN","PSJ OE",75,0) | |
| 16880 | Q | |
| 16881 | "RTN","PSJ OE",76,0) | |
| 16882 | DISACTIO(D FN,PSJORD, PSJPNV) ; Disp lay UD ord er and all ow actions . | |
| 16883 | "RTN","PSJ OE",77,0) | |
| 16884 | ; PSJORD - Order #_ location C ode (P:53. 1,V:55.01, U:55.06) | |
| 16885 | "RTN","PSJ OE",78,0) | |
| 16886 | ; PSJPNV - Invoked from Pendi ng/NV opti on; (gets different hidden men u) | |
| 16887 | "RTN","PSJ OE",79,0) | |
| 16888 | ; PSJDSVF Y - Flag i f non-vf o rder was e dited | |
| 16889 | "RTN","PSJ OE",80,0) | |
| 16890 | ; PSJENHO C=1 if DI, DT were di splay. Thi s will be used by do sing OC to check if error mess ages shoul d display or not | |
| 16891 | "RTN","PSJ OE",81,0) | |
| 16892 | ; PSJAGYS V=1 If UD was edited | |
| 16893 | "RTN","PSJ OE",82,0) | |
| 16894 | ;N PSGP,P SJIVFLG,PS GSDX,PSGFD X,PSJXX1,O N55,PSJDSV FY,PSJENHO C,PSJAGYSV | |
| 16895 | "RTN","PSJ OE",83,0) | |
| 16896 | N PSGP,PS JIVFLG,PSG SDX,PSGFDX ,PSJXX1,ON 55,PSJDSVF Y,PSJENHOC ,PSIVENO | |
| 16897 | "RTN","PSJ OE",84,0) | |
| 16898 | K PSGDUR, PSGRMVT,PS GRMV,PSGRF ,ND2P1 ;*3 15 | |
| 16899 | "RTN","PSJ OE",85,0) | |
| 16900 | D OLDCOM^ PSJOE0(DFN ,PSJORD) | |
| 16901 | "RTN","PSJ OE",86,0) | |
| 16902 | S PSGP=DF N D ENIV^P SJAC I PSJ ORD["V" D EN^PSJLIOR D(DFN,PSJO RD) Q | |
| 16903 | "RTN","PSJ OE",87,0) | |
| 16904 | D GETUD^P SJLMGUD(DF N,PSJORD) | |
| 16905 | "RTN","PSJ OE",88,0) | |
| 16906 | S PSGOEAV =$P(PSJSYS P0,"^",9)& PSJSYSU | |
| 16907 | "RTN","PSJ OE",89,0) | |
| 16908 | S:$G(PSJT UD) PSGPD= $G(PSJCOI) ,PSGPDN=$$ OINAME^PSJ LMUTL(+PSG PD) | |
| 16909 | "RTN","PSJ OE",90,0) | |
| 16910 | K PSGOENG I '$D(PSG PRF) D Q: $G(PSGOENG ) | |
| 16911 | "RTN","PSJ OE",91,0) | |
| 16912 | . I PSJOR D["U" L +^ PS(55,PSGP ,5,+PSJORD ):1 E S P SGOENG=1 | |
| 16913 | "RTN","PSJ OE",92,0) | |
| 16914 | . I PSJOR D["P" L +^ PS(53.1,+P SJORD):1 E S PSGOEN G=1 | |
| 16915 | "RTN","PSJ OE",93,0) | |
| 16916 | . I $G(PS GOENG) W ! ,"This ord er is bein g edited b y another terminal." ,! S PSGOE NG=1 K DIR S DIR(0)= "E" D ^DIR K DIR Q | |
| 16917 | "RTN","PSJ OE",94,0) | |
| 16918 | S PSGACT= $$ENACTION ^PSGOE1(PS GP,PSJORD) | |
| 16919 | "RTN","PSJ OE",95,0) | |
| 16920 | I PSJORD[ "P" S PSJX X1=$G(^PS( 53.1,+PSJO RD,0)) I P SGP'=$P(PS JXX1,U,15) !(DFN'=$P( PSJXX1,U,1 5)) L -^PS (53.1,+PSJ ORD) Q | |
| 16921 | "RTN","PSJ OE",96,0) | |
| 16922 | I PSJORD[ "P" D S P SJXX1=$P($ G(^PS(53.1 ,+PSJORD,0 )),U,9) I $S($G(PSJI VFLG):1,$G (Y)<0:1,"P ADE"[PSJXX 1:1,1:0) L -^PS(53.1 ,+PSJORD) Q | |
| 16923 | "RTN","PSJ OE",97,0) | |
| 16924 | .I $P(PSJ XX1,U,9)=" N",($P(PSJ XX1,U,4)'= "U") D Q | |
| 16925 | "RTN","PSJ OE",98,0) | |
| 16926 | .. S P("P ON")=PSJOR D,PSIVFLG= 1 | |
| 16927 | "RTN","PSJ OE",99,0) | |
| 16928 | .. N ON S ON=PSJORD D VF^PSIV ORC2 | |
| 16929 | "RTN","PSJ OE",100,0) | |
| 16930 | .I $P(PSJ XX1,U,9)=" P" D Q | |
| 16931 | "RTN","PSJ OE",101,0) | |
| 16932 | ..S:$G(PS JTUD) $P(P SJXX1,U,4) ="U" | |
| 16933 | "RTN","PSJ OE",102,0) | |
| 16934 | ..I $P(PS JXX1,U,4)= "U" D Q:$ G(PSJIVFLG ) | |
| 16935 | "RTN","PSJ OE",103,0) | |
| 16936 | ... N VAI P S CLINIC =$G(^PS(53 .1,+PSJORD ,"DSS")),A PPT=$P(CLI NIC,"^",2) ,CLINIC=$P (CLINIC,"^ ") I $$PAT CH^XPDUTL( "SD*5.3*28 5"),$$SDIM O^SDAMA203 (CLINIC,DF N)>-1 Q | |
| 16937 | "RTN","PSJ OE",104,0) | |
| 16938 | ... Q:'PS JPDD W !! ,"Cannot p rocess an Out-patien t Unit Dos e order fo r ",$P($G( ^DPT(+PSGP ,0)),U) D PAUSE^VALM 1 S PSJIVF LG=1 | |
| 16939 | "RTN","PSJ OE",105,0) | |
| 16940 | ..NEW PSG RSD,PSGRSD N,PSGRFD,P SGRFDN | |
| 16941 | "RTN","PSJ OE",106,0) | |
| 16942 | ..D REQDT ^PSJLIVMD( PSJORD) | |
| 16943 | "RTN","PSJ OE",107,0) | |
| 16944 | ..I $P(PS JXX1,U,4)= "U",($G(PS GSCH)="") W !!,"Inva lid schedu le, can't finish thi s order" D PAUSE^VAL M1 Q | |
| 16945 | "RTN","PSJ OE",108,0) | |
| 16946 | ..I $P(PS JXX1,U,4)= "U" N PSJL M,PSJOCFG S PSJLM=1, PSGORD=PSJ ORD,PSJOCF G="FN UD" D START^PS GOEF,ENSFE ^PSGOEE0(P SGP,PSGORD ) S:$G(PSJ TUD) PSJOC FG="FN UD" D @$S($G( PSJTUD):"F INISH^PSGO EF",1:"EN^ VALM(""PSJ LM PENDIN G EDIT"")" ) K PSJOCF G Q | |
| 16947 | "RTN","PSJ OE",109,0) | |
| 16948 | ..I $P(PS JXX1,U,4)' ="U",PSGP= $P(PSJXX1, U,15),DFN= $P(PSJXX1, U,15) S PS JLYN=PSJOR D,PSJOCFG= "FN IV" D EN^PSJLIFN S PSJIVFL G=1 K PSJL YN,PSJMAI, PSJOCFG | |
| 16949 | "RTN","PSJ OE",110,0) | |
| 16950 | I $G(PSIV FLG) K PSI VFLG Q | |
| 16951 | "RTN","PSJ OE",111,0) | |
| 16952 | S PSGACT= $$ENACTION ^PSGOE1(PS GP,PSJORD) ,PSGOEEF=0 D GETUD^P SJLMGUD(PS GP,PSJORD) ,ENSFE^PSG OEE0(PSGP, PSJORD),EN ^VALM("PSJ LM UD ACT ION") | |
| 16953 | "RTN","PSJ OE",112,0) | |
| 16954 | I PSJORD[ "P" L -^PS (53.1,+PSJ ORD) | |
| 16955 | "RTN","PSJ OE",113,0) | |
| 16956 | I PSJORD[ "U" L -^PS (55,PSGP,5 ,+PSJORD) | |
| 16957 | "RTN","PSJ OE",114,0) | |
| 16958 | ;Send SN to CPRS if auto-veri fy OFF and Order Set Entry and no 21st p iece | |
| 16959 | "RTN","PSJ OE",115,0) | |
| 16960 | S PSGOEAV =$P(PSJSYS P0,"^",9)& PSJSYSU | |
| 16961 | "RTN","PSJ OE",116,0) | |
| 16962 | I $D(PSGO ES),'PSGOE AV,$D(PSGO RD),PSGORD ["P",$P($G (^PS(53.1, +PSGORD,0) ),"^",21)' ]"" D ORSE T^PSGOETO1 | |
| 16963 | "RTN","PSJ OE",117,0) | |
| 16964 | I $G(PSGO EAV),($G(P SGOES)=1) D SETOC ;S tore aller gy for ord er set /w auto vf | |
| 16965 | "RTN","PSJ OE",118,0) | |
| 16966 | I '$G(PSG OEAV),($G( PSJORD)["P "),$S($G(P SJAGYSV):1 ,($G(PSJOC FG)="NEW U D"):1,1:0) D SETOC | |
| 16967 | "RTN","PSJ OE",119,0) | |
| 16968 | D UNL^PSS LOCK(PSGP, PSJORD) | |
| 16969 | "RTN","PSJ OE",120,0) | |
| 16970 | Q | |
| 16971 | "RTN","PSJ OE",121,0) | |
| 16972 | SETOC ; | |
| 16973 | "RTN","PSJ OE",122,0) | |
| 16974 | ;RTC 1787 89 | |
| 16975 | "RTN","PSJ OE",123,0) | |
| 16976 | S ^TMP("P SODAOC",$J ,"IP IEN") =PSJORD | |
| 16977 | "RTN","PSJ OE",124,0) | |
| 16978 | D SETOC^P SJNEWOC(PS JORD) | |
| 16979 | "RTN","PSJ OE",125,0) | |
| 16980 | K ^TMP("P SODAOC",$J ),^TMP("PS JDAOC",$J) ,PSJAGYSV, PSJOCFG | |
| 16981 | "RTN","PSJ OE",126,0) | |
| 16982 | Q | |
| 16983 | "RTN","PSJ OE",127,0) | |
| 16984 | EDIT(PSGP, PSGORD,PRO MPT) ; | |
| 16985 | "RTN","PSJ OE",128,0) | |
| 16986 | N PSJOP,A NQX,PSGEDT | |
| 16987 | "RTN","PSJ OE",129,0) | |
| 16988 | S (ANQX,P SJOP)=0,PS GEDT=1 | |
| 16989 | "RTN","PSJ OE",130,0) | |
| 16990 | S PSJOP=+ Y(1) | |
| 16991 | "RTN","PSJ OE",131,0) | |
| 16992 | S PSJOP=$ S(PSJOP=9: 0,PSJOP=11 :0,1:1) | |
| 16993 | "RTN","PSJ OE",132,0) | |
| 16994 | ;/RBN Beg in modific ation for NCC moved code to AC T^PSGOEE | |
| 16995 | "RTN","PSJ OE",133,0) | |
| 16996 | I "DE"[$$ GTSTATUS(P SGP,PSGORD ) W !,"Thi s order ma y not be e dited." D PAUSE^VALM 1 Q | |
| 16997 | "RTN","PSJ OE",134,0) | |
| 16998 | I PSGACT' ["E" W !," This order may not b e edited." D PAUSE^V ALM1 Q | |
| 16999 | "RTN","PSJ OE",135,0) | |
| 17000 | N PSJEDIT O S PSJEDI TO=1 | |
| 17001 | "RTN","PSJ OE",136,0) | |
| 17002 | S PSJAGYS V=1 ;Flag to store a llergy dat a in 100.0 5. | |
| 17003 | "RTN","PSJ OE",137,0) | |
| 17004 | S PSGNEDF D="" D HOL DHDR,@$S(' PROMPT:"EN EFA2^PSGON ",1:"ENEFA ^PSGON") I 'Y D ABOR T^PSGOEE Q | |
| 17005 | "RTN","PSJ OE",138,0) | |
| 17006 | I PSGORD[ "P" D ENF^ PSGOEE Q | |
| 17007 | "RTN","PSJ OE",139,0) | |
| 17008 | D ACT^PSG OEE | |
| 17009 | "RTN","PSJ OE",140,0) | |
| 17010 | Q | |
| 17011 | "RTN","PSJ OE",141,0) | |
| 17012 | RENEW(PSGP ,PSGORD) ; | |
| 17013 | "RTN","PSJ OE",142,0) | |
| 17014 | ;PSJOCFG - If defin ed, it's f or new ord er, renew or copy. ^ PSJOCDSD u sing this flag to no t display drug error . | |
| 17015 | "RTN","PSJ OE",143,0) | |
| 17016 | ;/RJS Beg in modific ations for PSJ*5.0*3 27 | |
| 17017 | "RTN","PSJ OE",144,0) | |
| 17018 | ;S:'$G(PS GDRG) PSGD RG=$O(PSJX DOX("DD",0 )) ;WRONG PSGDRG | |
| 17019 | "RTN","PSJ OE",145,0) | |
| 17020 | S PSGDRG= $O(PSJXDOX ("DD",0)) | |
| 17021 | "RTN","PSJ OE",146,0) | |
| 17022 | I $$GET1^ DIQ(50,$G( PSGDRG),17 .5)="PSOCL O1" D Q | |
| 17023 | "RTN","PSJ OE",147,0) | |
| 17024 | .W !,"Clo zapine ord ers cannot be renewe d." | |
| 17025 | "RTN","PSJ OE",148,0) | |
| 17026 | .W !,"No order ente red!" | |
| 17027 | "RTN","PSJ OE",149,0) | |
| 17028 | .D PAUSE^ VALM1 | |
| 17029 | "RTN","PSJ OE",150,0) | |
| 17030 | ;/RJS End modificat ions for P SJ*5.0*327 | |
| 17031 | "RTN","PSJ OE",151,0) | |
| 17032 | NEW PSJOC FG | |
| 17033 | "RTN","PSJ OE",152,0) | |
| 17034 | S PSJOCFG ="RENEW UD " | |
| 17035 | "RTN","PSJ OE",153,0) | |
| 17036 | D HOLDHDR | |
| 17037 | "RTN","PSJ OE",154,0) | |
| 17038 | I 'PSJSYS U,$P($G(^P S(55,PSGP, 5,+PSGORD, 4)),U,15), $P($G(^(4) ),U,16) W !!,"This o rder is al ready mark ed for ren ewal!" D P AUSE^VALM1 S VALMBCK ="R" Q | |
| 17039 | "RTN","PSJ OE",155,0) | |
| 17040 | I 'PSGRRF D ^PSGOER K PSJOCFG Q | |
| 17041 | "RTN","PSJ OE",156,0) | |
| 17042 | D ^PSGOER I | |
| 17043 | "RTN","PSJ OE",157,0) | |
| 17044 | K PSJOCFG | |
| 17045 | "RTN","PSJ OE",158,0) | |
| 17046 | Q | |
| 17047 | "RTN","PSJ OE",159,0) | |
| 17048 | GTSTATUS(D FN,ON) ; | |
| 17049 | "RTN","PSJ OE",160,0) | |
| 17050 | I ON["P" Q $P($G(^P S(53.1,+ON ,0)),U,9) | |
| 17051 | "RTN","PSJ OE",161,0) | |
| 17052 | I ON["U" Q $P($G(^P S(55,DFN,5 ,+ON,0)),U ,9) | |
| 17053 | "RTN","PSJ OE",162,0) | |
| 17054 | Q $P($G(^ PS(55,DFN, "IV",+ON,0 )),U,17) | |
| 17055 | "RTN","PSJ OE",163,0) | |
| 17056 | DC(DFN,PSJ ORD) ; DC IV, UD, or pending o rders. | |
| 17057 | "RTN","PSJ OE",164,0) | |
| 17058 | D HOLDHDR | |
| 17059 | "RTN","PSJ OE",165,0) | |
| 17060 | S X=$$GTS TATUS(DFN, PSJORD) I X="D"!(X=" DE")!(X="R ") W !,$S( X="R":"Thi s order ha s a pendin g renewal and cannot be DISCON TINUED.",1 :"This ord er has alr eady been DISCONTINU ED.") D PA USE^VALM1 Q | |
| 17061 | "RTN","PSJ OE",166,0) | |
| 17062 | D ENO^PSG OEC(DFN,PS JORD) ;,GE TUD^PSJLMG UD(DFN,PSJ ORD),INIT^ PSJLMUDE(D FN,PSJORD) S VALMBCK ="Q" | |
| 17063 | "RTN","PSJ OE",167,0) | |
| 17064 | S VALMBCK ="Q" | |
| 17065 | "RTN","PSJ OE",168,0) | |
| 17066 | Q | |
| 17067 | "RTN","PSJ OE",169,0) | |
| 17068 | HOLD(DFN,P SJORD) ; C hange orde r's status from ACTI VE<->HOLD | |
| 17069 | "RTN","PSJ OE",170,0) | |
| 17070 | D HOLDHDR | |
| 17071 | "RTN","PSJ OE",171,0) | |
| 17072 | I PSJORD[ "V" D H^PS IVOPT(DFN, PSJORD,P(1 7),P(3)) | |
| 17073 | "RTN","PSJ OE",172,0) | |
| 17074 | I PSJORD' ["V" D H^P SGOE1(DFN, PSJORD) | |
| 17075 | "RTN","PSJ OE",173,0) | |
| 17076 | D GETUD^P SJLMGUD(DF N,PSJORD), INIT^PSJLM UDE(DFN,PS JORD) S PS GACT=$$ENA CTION^PSGO E1(DFN,PSJ ORD),VALMB CK="R" | |
| 17077 | "RTN","PSJ OE",174,0) | |
| 17078 | Q | |
| 17079 | "RTN","PSJ OE",175,0) | |
| 17080 | COPY(PSGP, PSGORD) ; Copy an o rder (does not disco ntinue ori ginal orde r) | |
| 17081 | "RTN","PSJ OE",176,0) | |
| 17082 | NEW PSJOC FG | |
| 17083 | "RTN","PSJ OE",177,0) | |
| 17084 | I $D(PSGC OPY) W !!, "You canno t copy the order at this time" D PAUSE^V ALM1 Q | |
| 17085 | "RTN","PSJ OE",178,0) | |
| 17086 | I PSGORD[ "P" W !!," You cannot copy this "_$S($G(P SGSTAT)]"" :PSGSTAT,1 :"PENDING IV")_" ord er." D PAU SE^VALM1 Q | |
| 17087 | "RTN","PSJ OE",179,0) | |
| 17088 | I PSGORD[ "V" D Q | |
| 17089 | "RTN","PSJ OE",180,0) | |
| 17090 | .I $G(PSI VCOPY) W ! !,"You can not copy t he order a t this tim e" D PAUSE ^VALM1 Q | |
| 17091 | "RTN","PSJ OE",181,0) | |
| 17092 | .S PSJOCF G="COPY IV " | |
| 17093 | "RTN","PSJ OE",182,0) | |
| 17094 | .D COPY^P SIVOD(PSGP ,PSGORD) K PSJOCFG Q | |
| 17095 | "RTN","PSJ OE",183,0) | |
| 17096 | Q:'$$HIDD EN^PSJLMUT L("COPY") | |
| 17097 | "RTN","PSJ OE",184,0) | |
| 17098 | D ^PSJHVA RS | |
| 17099 | "RTN","PSJ OE",185,0) | |
| 17100 | I $P($G(^ PS(55,PSGP ,5,+PSGORD ,.2)),U,4) ="D",'$P($ G(^(4)),"^ ",3) W !!, "Nurse ver ified orde rs with a priority o f DONE may not be Co pied." D P AUSE^VALM1 Q | |
| 17101 | "RTN","PSJ OE",186,0) | |
| 17102 | S PSJOCFG ="COPY UD" | |
| 17103 | "RTN","PSJ OE",187,0) | |
| 17104 | S PSGOEAV =$P(PSJSYS P0,U,9)&PS JSYSU | |
| 17105 | "RTN","PSJ OE",188,0) | |
| 17106 | S PSGCOPY =1,ANQX=0 | |
| 17107 | "RTN","PSJ OE",189,0) | |
| 17108 | D FULL^VA LM1,^PSGOD | |
| 17109 | "RTN","PSJ OE",190,0) | |
| 17110 | ;/RBN Beg in modific ations PSJ *5.0*327 | |
| 17111 | "RTN","PSJ OE",191,0) | |
| 17112 | K:$G(ANQX ) PSGCOPY | |
| 17113 | "RTN","PSJ OE",192,0) | |
| 17114 | Q:$G(ANQX ) | |
| 17115 | "RTN","PSJ OE",193,0) | |
| 17116 | ;/RBN End modificat ions PSJ*5 .0*327 | |
| 17117 | "RTN","PSJ OE",194,0) | |
| 17118 | S VALMBCK ="R" | |
| 17119 | "RTN","PSJ OE",195,0) | |
| 17120 | K PSGCOPY ,PSJOCFG | |
| 17121 | "RTN","PSJ OE",196,0) | |
| 17122 | S PSGACT= $$ENACTION ^PSGOE1(PS GP,PSGORD) ; resets PSGACT aft er copy | |
| 17123 | "RTN","PSJ OE",197,0) | |
| 17124 | I $G(PSGP XN) N PSGT MPXN S PSG TMPXN=PSGP XN | |
| 17125 | "RTN","PSJ OE",198,0) | |
| 17126 | D RESTORE ^PSJHVARS I $G(PSGTM PXN) S PSG PXN=PSGTMP XN | |
| 17127 | "RTN","PSJ OE",199,0) | |
| 17128 | Q | |
| 17129 | "RTN","PSJ OE",200,0) | |
| 17130 | UPDATE ; R efresh arr ay, action s, & displ ay. | |
| 17131 | "RTN","PSJ OE",201,0) | |
| 17132 | D GETUD^P SJLMGUD(DF N,ON),INIT ^PSJLMUDE( DFN,ON) S VALMBCK="R " | |
| 17133 | "RTN","PSJ OE",202,0) | |
| 17134 | Q | |
| 17135 | "RTN","PSJ OE",203,0) | |
| 17136 | FINISH ; | |
| 17137 | "RTN","PSJ OE",204,0) | |
| 17138 | D FINISH^ PSGOEF,PAU SE^VALM1 | |
| 17139 | "RTN","PSJ OE",205,0) | |
| 17140 | Q | |
| 17141 | "RTN","PSJ OE",206,0) | |
| 17142 | LOG(DFN,PS GORD) ; | |
| 17143 | "RTN","PSJ OE",207,0) | |
| 17144 | D FULL^VA LM1,ENLM^P SGOEL(DFN, PSGORD),PA USE^VALM1 S VALMBCK= "R" | |
| 17145 | "RTN","PSJ OE",208,0) | |
| 17146 | Q | |
| 17147 | "RTN","PSJ OE",209,0) | |
| 17148 | NEWSEL ; | |
| 17149 | "RTN","PSJ OE",210,0) | |
| 17150 | N PSGLMT, PSGODDD,PS JLMQT,PSJL MFIN,PSJUD PRF,PSGRDT X,PSJOCDSC ,PSJAGYSV K ^TMP("PS JCOM",$J), ^TMP("PSJC OM2",$J),^ TMP("PSODA OC",$J),^T MP("PSJDAO C",$J) | |
| 17151 | "RTN","PSJ OE",211,0) | |
| 17152 | K PSGRMVT ,PSGRMV,PS GDUR,PSGRF ,ND2P1 ;*3 15 | |
| 17153 | "RTN","PSJ OE",212,0) | |
| 17154 | ;; START NCC REMEDI ATION >> 3 27*RJS ; Freeze hea der text w hile proce ssing orde r actions | |
| 17155 | "RTN","PSJ OE",213,0) | |
| 17156 | S IOTM=VA LM("TM"),I OBM=IOSL W IOSC W @I OSTBM W IO RC | |
| 17157 | "RTN","PSJ OE",214,0) | |
| 17158 | ;; END NC C REMEDIAT ION << 327 *RJS | |
| 17159 | "RTN","PSJ OE",215,0) | |
| 17160 | S X=$P(XQ ORNOD(0)," =",2) | |
| 17161 | "RTN","PSJ OE",216,0) | |
| 17162 | S PSGONC= 1,PSGLMT=^ TMP("PSJPR O",$J,0) | |
| 17163 | "RTN","PSJ OE",217,0) | |
| 17164 | D ENCHK^P SGON I '$O (PSGODDD(0 )) S VALMQ UIT=1 Q | |
| 17165 | "RTN","PSJ OE",218,0) | |
| 17166 | S PSJLM=1 ,PSJSEL=0 F S PSJSE L=$O(PSGOD DD(PSJSEL) ) Q:'PSJSE L F PSJSE L1=1:1:$L( PSGODDD(PS JSEL),",") -1 D | |
| 17167 | "RTN","PSJ OE",219,0) | |
| 17168 | .K PSJOCD SC,PSGDRG | |
| 17169 | "RTN","PSJ OE",220,0) | |
| 17170 | .S PSJORD =$G(^TMP(" PSJON",$J, +$P(PSGODD D(PSJSEL), ",",PSJSEL 1))) D:PSJ ORD=+PSJOR D SELECT^P SJOEA | |
| 17171 | "RTN","PSJ OE",221,0) | |
| 17172 | .Q:PSJORD =+PSJORD | |
| 17173 | "RTN","PSJ OE",222,0) | |
| 17174 | .Q:PSJORD =""!($G(Y) <0) Q:('$ $LS^PSSLOC K(PSGP,PSJ ORD)) D | |
| 17175 | "RTN","PSJ OE",223,0) | |
| 17176 | ..S PSGOR D="" | |
| 17177 | "RTN","PSJ OE",224,0) | |
| 17178 | ..S ON=PS JORD | |
| 17179 | "RTN","PSJ OE",225,0) | |
| 17180 | ..D DISAC TIO(PSGP,P SJORD,$G(P SJPNV)) S: PSJORD["V" PSJORD=ON | |
| 17181 | "RTN","PSJ OE",226,0) | |
| 17182 | ..D UNL^P SSLOCK(PSG P,PSJORD) | |
| 17183 | "RTN","PSJ OE",227,0) | |
| 17184 | ..I $G(PS JNOL) K PS JNOL I $D( ON),ON'=PS JORD D UNL ^PSSLOCK(P SGP,ON) | |
| 17185 | "RTN","PSJ OE",228,0) | |
| 17186 | ..Q:$G(Y) <0 | |
| 17187 | "RTN","PSJ OE",229,0) | |
| 17188 | I '$G(PSG OEAV),($G( PSJORD)["P "),$G(PSJA GYSV) D | |
| 17189 | "RTN","PSJ OE",230,0) | |
| 17190 | .;RTC 178 789 | |
| 17191 | "RTN","PSJ OE",231,0) | |
| 17192 | .S ^TMP(" PSODAOC",$ J,"IP IEN" )=PSJORD | |
| 17193 | "RTN","PSJ OE",232,0) | |
| 17194 | .D SETOC^ PSJNEWOC(P SJORD) | |
| 17195 | "RTN","PSJ OE",233,0) | |
| 17196 | .K ^TMP(" PSODAOC",$ J),^TMP("P SJDAOC",$J ),PSJAGYSV | |
| 17197 | "RTN","PSJ OE",234,0) | |
| 17198 | S VALMBCK ="Q" | |
| 17199 | "RTN","PSJ OE",235,0) | |
| 17200 | K PSJLM,P SJOCDSC | |
| 17201 | "RTN","PSJ OE",236,0) | |
| 17202 | Q | |
| 17203 | "RTN","PSJ OE",237,0) | |
| 17204 | HOLDHDR ; Freeze hea der text w hile proce ssing orde r actions | |
| 17205 | "RTN","PSJ OE",238,0) | |
| 17206 | I $D(VALM ("TM")) S IOTM=VALM( "TM"),IOBM =IOSL W IO SC W @IOST BM W IORC | |
| 17207 | "RTN","PSJ OE",239,0) | |
| 17208 | Q | |
| 17209 | "RTN","PSJ OE",240,0) | |
| 17210 | LOCKERR ; | |
| 17211 | "RTN","PSJ OE",241,0) | |
| 17212 | W !!,$C(7 ),"You are entering or editing an Inpati ent Medica tion order in anothe r session. ",!,"Only one order entry/edit session i s allowed for a user at a time .",!! N DI R S DIR(0) ="E" D ^DI R | |
| 17213 | "RTN","PSJ OE",242,0) | |
| 17214 | Q | |
| 17215 | "RTN","PSJ OE",243,0) | |
| 17216 | FLAG(DFN,P SJORD) ;Fl ag order t hrough CPR S entry po int. | |
| 17217 | "RTN","PSJ OE",244,0) | |
| 17218 | N ORIFN,N ODE0 | |
| 17219 | "RTN","PSJ OE",245,0) | |
| 17220 | S NODE0=$ S(PSJORD[" V":$G(^PS( 55,DFN,"IV ",+PSJORD, 0)),PSJORD ["U":$G(^P S(55,DFN,5 ,+PSJORD,0 )),1:^PS(5 3.1,+PSJOR D,0)) | |
| 17221 | "RTN","PSJ OE",246,0) | |
| 17222 | S ORIFN=$ P(NODE0,"^ ",21) | |
| 17223 | "RTN","PSJ OE",247,0) | |
| 17224 | D EN1^ORC FLAG(ORIFN ) | |
| 17225 | "RTN","PSJ OE",248,0) | |
| 17226 | D PAUSE^V ALM1 | |
| 17227 | "RTN","PSJ OE",249,0) | |
| 17228 | Q | |
| 17229 | "RTN","PSJ OE",250,0) | |
| 17230 | COMPLEX(DF N,ON) ; | |
| 17231 | "RTN","PSJ OE",251,0) | |
| 17232 | N NDP2,CO M | |
| 17233 | "RTN","PSJ OE",252,0) | |
| 17234 | S NDP2=$S (ON["P":$G (^PS(53.1, +ON,.2)),O N["U":$G(^ PS(55,DFN, 5,+ON,.2)) ,ON["V":$G (^PS(55,DF N,"IV",+ON ,.2)),1:"" ) | |
| 17235 | "RTN","PSJ OE",253,0) | |
| 17236 | S COM=$P( NDP2,"^",8 ) I COM Q 1 | |
| 17237 | "RTN","PSJ OE",254,0) | |
| 17238 | Q 0 | |
| 17239 | "RTN","PSJ OE",255,0) | |
| 17240 | CLOZSND ; SEND CLOZA PINE OVERR IDE MESSAG E AND ORDE R TO HINES DB | |
| 17241 | "RTN","PSJ OE",256,0) | |
| 17242 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 17243 | "RTN","PSJ OE",257,0) | |
| 17244 | I $$GET1^ DIQ(50,+$G (PSGDN),17 .5)="PSOCL O1" D PSJF ILE^PSJCLO Z(DFN),INP SND^YSCLTS T5 | |
| 17245 | "RTN","PSJ OE",258,0) | |
| 17246 | ;; END NC C REMEDIAT ION << 327 *RJS | |
| 17247 | "RTN","PSJ OE",259,0) | |
| 17248 | Q | |
| 17249 | "RTN","PSJ OE1") | |
| 17250 | 0^20^B4024 7164 | |
| 17251 | "RTN","PSJ OE1",1,0) | |
| 17252 | PSJOE1 ;BI R/CML3-UD OE FOR COM BINED OE ; Jul 26, 20 17@18:04:0 2 | |
| 17253 | "RTN","PSJ OE1",2,0) | |
| 17254 | ;;5.0;INP ATIENT MED ICATIONS;* *2,7,25,30 ,47,56,64, 179,181,25 2,281,315, 327**;16 D EC 97;Buil d 64 | |
| 17255 | "RTN","PSJ OE1",3,0) | |
| 17256 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 17257 | "RTN","PSJ OE1",4,0) | |
| 17258 | ; Referen ce to ^DIC N is suppo rted by DB IA# 10009 | |
| 17259 | "RTN","PSJ OE1",5,0) | |
| 17260 | ; Referen ce to ^VAL M is suppo rted by DB IA# 10118 | |
| 17261 | "RTN","PSJ OE1",6,0) | |
| 17262 | ; Referen ce to ^TMP ("PSODAOC" ,$J suppor ted by DBI A 6071 | |
| 17263 | "RTN","PSJ OE1",7,0) | |
| 17264 | ; | |
| 17265 | "RTN","PSJ OE1",8,0) | |
| 17266 | S PC=0 G AD | |
| 17267 | "RTN","PSJ OE1",9,0) | |
| 17268 | ; | |
| 17269 | "RTN","PSJ OE1",10,0) | |
| 17270 | EN ; | |
| 17271 | "RTN","PSJ OE1",11,0) | |
| 17272 | S PC=0 | |
| 17273 | "RTN","PSJ OE1",12,0) | |
| 17274 | ; | |
| 17275 | "RTN","PSJ OE1",13,0) | |
| 17276 | AD ; Ask D rug | |
| 17277 | "RTN","PSJ OE1",14,0) | |
| 17278 | ;PSJOCFG - If defin ed, it's f or new ord er, renew or copy. ^ PSJOCDSD u sing this flag to no t display drug error . | |
| 17279 | "RTN","PSJ OE1",15,0) | |
| 17280 | K PSJOCFG ,PSGDUR,PS GRMVT,PSGR MV,PSGRF,N D2P1,ANQX ;*315 | |
| 17281 | "RTN","PSJ OE1",16,0) | |
| 17282 | N PSJNORD ,PSGORQF,P SGSDX,PSGF DX,PSGNEFD O,PSGEDTOI ,PSJOCFG S PSJOCFG=" NEW UD" S PSJNORD=1 I $D(VALM( "TM")) S I OTM=VALM(" TM"),IOBM= IOSL W IOS C,@IOSTBM, IORC | |
| 17283 | "RTN","PSJ OE1",17,0) | |
| 17284 | K PSGORQF | |
| 17285 | "RTN","PSJ OE1",18,0) | |
| 17286 | D ^PSGOE7 | |
| 17287 | "RTN","PSJ OE1",19,0) | |
| 17288 | I $G(PSGO RQF) S PSJ ORQF=1 G D ONE | |
| 17289 | "RTN","PSJ OE1",20,0) | |
| 17290 | S PC=1,PS JORQF=0 I X?1"S."1.E D ^PSGOES G AD | |
| 17291 | "RTN","PSJ OE1",21,0) | |
| 17292 | D ^PSGOE4 :'$P(PSJSY SP0,"^",12 ),^PSGOE3: $P(PSJSYSP 0,"^",12) | |
| 17293 | "RTN","PSJ OE1",22,0) | |
| 17294 | G:$G(PSGO ROE1)=1 AD | |
| 17295 | "RTN","PSJ OE1",23,0) | |
| 17296 | K PSGEFN, PSGOEEF,PS GOEE,PSGOE OS S PSGEF N="1:13" F X=1:1:13 S PSGEFN(X )="" | |
| 17297 | "RTN","PSJ OE1",24,0) | |
| 17298 | S PSGPDN= $$OINAME^P SJLMUTL(PS GPDRG),PSG PD=PSGPDRG ,PSGOINST= "",PSGSDN= $$ENDD^PSG MI(PSGNESD )_U_$$ENDT C^PSGMI(PS GNESD),PSG FDN=$$ENDD ^PSGMI(PSG NEFD)_U_$$ ENDTC^PSGM I(PSGNEFD) | |
| 17299 | "RTN","PSJ OE1",25,0) | |
| 17300 | S PSGAT=P SGS0Y,PSGL IN=$$ENDD^ PSGMI(PSGD T)_U_$$END TC^PSGMI(P SGDT),PSGL I=PSGDT,PS GEBN=$$ENN PN^PSGMI(D UZ),PSGSTA T=$S(PSGOE AV:"ACTIVE ",1:"NON-V ERIFIED") | |
| 17301 | "RTN","PSJ OE1",26,0) | |
| 17302 | D CHK^PSG OEV("^^"_P SGMR_"^^^^ "_PSGST,PS GPDRG_U_PS GDO,PSGSCH _U_PSGNESD _"^^"_PSGN EFD) | |
| 17303 | "RTN","PSJ OE1",27,0) | |
| 17304 | S PSGSD=P SGNESD,PSG FD=PSGNEFD | |
| 17305 | "RTN","PSJ OE1",28,0) | |
| 17306 | K PSJACEP T S VALMBC K="Q" D:$D (Y) EN^VAL M("PSJU LM ACCEPT") | |
| 17307 | "RTN","PSJ OE1",29,0) | |
| 17308 | I $G(PSJA CEPT)=1 D I $G(ANQX ) D DONE G AD | |
| 17309 | "RTN","PSJ OE1",30,0) | |
| 17310 | . D OC | |
| 17311 | "RTN","PSJ OE1",31,0) | |
| 17312 | . ;D:'$G( PSGORQF) I N^PSJOCDS( $G(PSGORD) ,"UD",+$G( PSGDRG)) | |
| 17313 | "RTN","PSJ OE1",32,0) | |
| 17314 | ;If inter vention is not log t hen quit | |
| 17315 | "RTN","PSJ OE1",33,0) | |
| 17316 | I $G(PSGO RQF)=1 S P SJACEPT=0 | |
| 17317 | "RTN","PSJ OE1",34,0) | |
| 17318 | S PSJNOO= -1 I $G(PS JACEPT)=1 S PSJNOO=$ $ENNOO^PSJ UTL5("N") | |
| 17319 | "RTN","PSJ OE1",35,0) | |
| 17320 | I $G(PSJN OO)<0 K PS JACEPT W ! ,"No order created." G AD | |
| 17321 | "RTN","PSJ OE1",36,0) | |
| 17322 | K PSGOEE D ^PSGOETO S PSJORD= PSGORD | |
| 17323 | "RTN","PSJ OE1",37,0) | |
| 17324 | S ^TMP("P SODAOC",$J ,"IP IEN") =PSGORD | |
| 17325 | "RTN","PSJ OE1",38,0) | |
| 17326 | ;RTC 1787 46 - Don't store all ergy here. | |
| 17327 | "RTN","PSJ OE1",39,0) | |
| 17328 | ;D SETOC^ PSJNEWOC(P SGORD) | |
| 17329 | "RTN","PSJ OE1",40,0) | |
| 17330 | I PSGOEAV D G AD | |
| 17331 | "RTN","PSJ OE1",41,0) | |
| 17332 | .;; START NCC REMED IATION >> 327*RJS | |
| 17333 | "RTN","PSJ OE1",42,0) | |
| 17334 | .I '$G(PS GDRG) N AR R D FIND^D IC(50,,.01 ,"Q",PSGPD ,,"ASP",,, "ARR") S P SGDRG=+$G( ARR("DILIS T",2,2)) | |
| 17335 | "RTN","PSJ OE1",43,0) | |
| 17336 | .I $$GET1 ^DIQ(50,+$ G(PSGDRG), 17.5)="PSO CLO1" D | |
| 17337 | "RTN","PSJ OE1",44,0) | |
| 17338 | ..N DIE,D A,DR S DIE ="^PS(55," _PSGP_",5, ",DA=+$G(P SGORD),DA( 1)=PSGP,DR ="3001//// " | |
| 17339 | "RTN","PSJ OE1",45,0) | |
| 17340 | ..I $G(PS GNTDD) S D R=DR_PSGNT DD | |
| 17341 | "RTN","PSJ OE1",46,0) | |
| 17342 | ..E I $G (PSGETDD) S DR=DR_PS GETDD | |
| 17343 | "RTN","PSJ OE1",47,0) | |
| 17344 | ..E I $G (PSGCTDD) S DR=DR_PS GCTDD | |
| 17345 | "RTN","PSJ OE1",48,0) | |
| 17346 | ..E I $D (^TMP($J," PSGCLOZ",P SGP,+$G(PS GORD),"SAN D")) S DR= DR_$G(^TMP ($J,"PSGCL OZ",PSGP,+ $G(PSGORD) ,"SAND")) K ^TMP($J, "PSGCLOZ", PSGP,+$G(P SGORD),"SA ND") | |
| 17347 | "RTN","PSJ OE1",49,0) | |
| 17348 | ..D ^DIE | |
| 17349 | "RTN","PSJ OE1",50,0) | |
| 17350 | ..D CLOZS ND^PSJOE ; SEND OVER RIDE MESSA GE & XTMP TRANSACTIO N DATA | |
| 17351 | "RTN","PSJ OE1",51,0) | |
| 17352 | .;; END N CC REMEDIA TION >> 32 7*RJS | |
| 17353 | "RTN","PSJ OE1",52,0) | |
| 17354 | . D SETOC ^PSJNEWOC( PSGORD) ;R TC 17874 | |
| 17355 | "RTN","PSJ OE1",53,0) | |
| 17356 | .I '$D(PS GOEE),+PSJ SYSU=3 D E N^PSGPEN(P SGORD) | |
| 17357 | "RTN","PSJ OE1",54,0) | |
| 17358 | S PSGOEEF =0 D GETUD ^PSJLMGUD( PSGP,PSGOR D),ENSFE^P SGOEE0(PSG P,PSGORD), ^PSGOE1,EN ^VALM("PSJ LM UD ACT ION") | |
| 17359 | "RTN","PSJ OE1",55,0) | |
| 17360 | ;RTC 1787 46 - store allergy i f not veri fy the new ly created order. | |
| 17361 | "RTN","PSJ OE1",56,0) | |
| 17362 | I ($G(PSG ORD)["P"), ($P($G(^PS (53.1,+PSG ORD,0)),U, 9)="N"),($ G(PSJOCFG) ="NEW UD") D SETOC^P SJNEWOC(PS GORD) | |
| 17363 | "RTN","PSJ OE1",57,0) | |
| 17364 | G AD | |
| 17365 | "RTN","PSJ OE1",58,0) | |
| 17366 | Q | |
| 17367 | "RTN","PSJ OE1",59,0) | |
| 17368 | OC ; | |
| 17369 | "RTN","PSJ OE1",60,0) | |
| 17370 | NEW PSJDD ,PSJALLGY, PSJALGY1 | |
| 17371 | "RTN","PSJ OE1",61,0) | |
| 17372 | K PSGORQF | |
| 17373 | "RTN","PSJ OE1",62,0) | |
| 17374 | ;; START NCC REMEDI ATION >> 3 27*RJS | |
| 17375 | "RTN","PSJ OE1",63,0) | |
| 17376 | I '$G(PSG DRG) N ARR D FIND^DI C(50,,.01, "Q",PSGPD, ,"ASP",,," ARR") S PS GDRG=+$G(A RR("DILIST ",2,2)) | |
| 17377 | "RTN","PSJ OE1",64,0) | |
| 17378 | I $$GET1^ DIQ(50,+$G (PSGDRG),1 7.5)="PSOC LO1" D Q: $G(ANQX) | |
| 17379 | "RTN","PSJ OE1",65,0) | |
| 17380 | .S DIR(0) ="N^12.5:3 000:1",DIR ("A")="CLO ZAPINE dos age (mg/da y) ? " D ^ DIR K DIR I $D(DIRUT ) S (CHK,A NQX)=1 Q ;G DONE:$G (CHK) | |
| 17381 | "RTN","PSJ OE1",66,0) | |
| 17382 | .S PSGNTD D=X,PSGDN= PSGDRG,PSO SAND=PSGNT DD | |
| 17383 | "RTN","PSJ OE1",67,0) | |
| 17384 | ;; END NC C REMEDIAT ION >> 327 *RJS | |
| 17385 | "RTN","PSJ OE1",68,0) | |
| 17386 | D FULL^VA LM1 | |
| 17387 | "RTN","PSJ OE1",69,0) | |
| 17388 | S PSJDD=+ $$DD53P45^ PSJMISC() I 'PSJDD S PSGORQF=1 Q | |
| 17389 | "RTN","PSJ OE1",70,0) | |
| 17390 | I +$G(PSG EDTOI) D | |
| 17391 | "RTN","PSJ OE1",71,0) | |
| 17392 | . S PSJAL GY1=1 | |
| 17393 | "RTN","PSJ OE1",72,0) | |
| 17394 | . D ENDDC ^PSGSICHK( $G(PSGP),P SJDD) | |
| 17395 | "RTN","PSJ OE1",73,0) | |
| 17396 | D:'$G(PSG ORQF) IN^P SJOCDS($G( PSGORD),"U D",PSJDD) | |
| 17397 | "RTN","PSJ OE1",74,0) | |
| 17398 | Q | |
| 17399 | "RTN","PSJ OE1",75,0) | |
| 17400 | EDIT(PROMP T) ; | |
| 17401 | "RTN","PSJ OE1",76,0) | |
| 17402 | ; Edit fi elds in a UD order. | |
| 17403 | "RTN","PSJ OE1",77,0) | |
| 17404 | ; PROMPT= 0 - Select fields to edit by n umber. | |
| 17405 | "RTN","PSJ OE1",78,0) | |
| 17406 | ; PROMPT= 1 - Prompt to select fields fo r editing. | |
| 17407 | "RTN","PSJ OE1",79,0) | |
| 17408 | ; | |
| 17409 | "RTN","PSJ OE1",80,0) | |
| 17410 | ;D @$S('P ROMPT:"ENE FA2^PSGON" ,1:"ENEFA^ PSGON") Q: 'Y S PSGO EEG=3 D ED IT^PSGOEE ;$S(PSGOEE WF[53.1:3, 1:5) D:Y E DIT^PSGOEE | |
| 17411 | "RTN","PSJ OE1",81,0) | |
| 17412 | D @$S('PR OMPT:"ENEF A2^PSGON", 1:"ENEFA^P SGON") Q:' Y S:$G(PS JNEWOE) PS GOEEWF="^P S(53.1," S PSGOEEG=$ S('$D(PSGO EEWF):3,PS GOEEWF[53. 1:3,1:5) D EDIT^PSGO EE | |
| 17413 | "RTN","PSJ OE1",82,0) | |
| 17414 | I $G(PSJN EWOE) S PS GOEENO=0,D R="",VALMB CK="R" | |
| 17415 | "RTN","PSJ OE1",83,0) | |
| 17416 | I '$G(PSJ NEWOE) D E NNOU^PSGOE E0 I 'PSGO EENO,DR="" S VALMBCK ="R" Q | |
| 17417 | "RTN","PSJ OE1",84,0) | |
| 17418 | I 'PSGOEE NO,$D(PSGO ES) D ENNO U^PSGOEE0 ; only up date on or der sets | |
| 17419 | "RTN","PSJ OE1",85,0) | |
| 17420 | ;*179 No longer cal l CKDT^PSG OEE from h ere. | |
| 17421 | "RTN","PSJ OE1",86,0) | |
| 17422 | ;I 'PSGOE ENO,$G(PSG PDNX)=1 D CKDT^PSGOE E | |
| 17423 | "RTN","PSJ OE1",87,0) | |
| 17424 | I $G(PSGO EER)["101^ PSGOE8" S PSGEDTOI=1 | |
| 17425 | "RTN","PSJ OE1",88,0) | |
| 17426 | K VALMSG I PSGOEENO D | |
| 17427 | "RTN","PSJ OE1",89,0) | |
| 17428 | .S VALMSG ="This cha nge will c ause a new order to be created ." D GTSTA TUS^PSGOEE ,CHKDD^PSG OEE | |
| 17429 | "RTN","PSJ OE1",90,0) | |
| 17430 | .S PSGEBN =$$ENNPN^P SGMI(DUZ), PSGLIN=$$E NDD^PSGMI( PSGDT)_U_$ $ENDTC^PSG MI(PSGDT), PSGLI=PSGD T | |
| 17431 | "RTN","PSJ OE1",91,0) | |
| 17432 | D CHK^PSG OEV("^^"_P SGMR_"^^^^ "_PSGST,PS GPDRG_U_PS GDO,PSGSCH _U_PSGSD_" ^^"_PSGFD) | |
| 17433 | "RTN","PSJ OE1",92,0) | |
| 17434 | D INIT^PS JLMUDE(PSG P,$G(PSGOR D)) | |
| 17435 | "RTN","PSJ OE1",93,0) | |
| 17436 | Q | |
| 17437 | "RTN","PSJ OE1",94,0) | |
| 17438 | DONE ; | |
| 17439 | "RTN","PSJ OE1",95,0) | |
| 17440 | K %,DA,DI C,DIE,DR,D RG,DRGN,DR GO,ND,OC,O RIFN,ORIT, ORPK,ORSTO P,ORSTRT,O RSTS,ORTX, PC,PSGDO,P SGMR,PSGMR N,PSGNEDFD ,PSGNEFD,P SGNESD,PSG OES,PSGORO E1,PSGORD, PSGS0XT,PS GS0Y,PSGSC H,PSGSI,PS GX,Y,Z | |
| 17441 | "RTN","PSJ OE1",96,0) | |
| 17442 | K PSGEDTO I,PSJOCFG, PSGDUR,PSG RMVT,PSGRM V,PSGRF,ND 2,ND2P1 ;* 315 | |
| 17443 | "RTN","PSJ OE1",97,0) | |
| 17444 | Q | |
| 17445 | "RTN","PSJ OE1",98,0) | |
| 17446 | ; | |
| 17447 | "RTN","PSJ OE1",99,0) | |
| 17448 | GDO ; | |
| 17449 | "RTN","PSJ OE1",100,0 ) | |
| 17450 | W !!,"Dru g is not f ound in Fo rmulary Li st." F S %=1 W !,"W ould you l ike to try to search the list again" D Y N^DICN Q:% D TAM | |
| 17451 | "RTN","PSJ OE1",101,0 ) | |
| 17452 | Q:%<2 | |
| 17453 | "RTN","PSJ OE1",102,0 ) | |
| 17454 | FTD ; | |
| 17455 | "RTN","PSJ OE1",103,0 ) | |
| 17456 | R !!,"Ent er FREE TE XT DRUG: " ,PSGDRGN:D TIME E W $C(7) S PS GDRGN="^" Q | |
| 17457 | "RTN","PSJ OE1",104,0 ) | |
| 17458 | Q:"^"[PSG DRGN S X= $S(PSGDRGN '?.ANP:"Co ntrol char acter(s)", PSGDRGN["^ ":"Up-arro w ('^') in text",$L( PSGDRGN)>3 9:"Respons e longer t han 39 cha racters",1 :"") I X]" " W $C(7), " ??",!?2 ,"(",X," n ot allowed .)" G FTD | |
| 17459 | "RTN","PSJ OE1",105,0 ) | |
| 17460 | Q:PSGDRGN '?1."?" | |
| 17461 | "RTN","PSJ OE1",106,0 ) | |
| 17462 | W !!?2,"E NTER DRUG ORDERED (1 -39 CHARAC TERS).",!? 2,"Since t he drug ca nnot be fo und in the DRUG file , enter th e drug nam e here",!, "exactly a s ordered. Press th e RETURN k ey (or ent er an '^') to skip o ver this", !,"drug, o r to again search th e" | |
| 17463 | "RTN","PSJ OE1",107,0 ) | |
| 17464 | W " DRUG file for t his one." G FTD | |
| 17465 | "RTN","PSJ OE1",108,0 ) | |
| 17466 | ; | |
| 17467 | "RTN","PSJ OE1",109,0 ) | |
| 17468 | TAM ; Try Again Mess age | |
| 17469 | "RTN","PSJ OE1",110,0 ) | |
| 17470 | W !!," E nter a 'Y' to try ag ain to fin d the drug ordered f rom the Fo rmulary. (The",!,"o rder canno t become a ctive unti l a Formul ary drug h as been en tered.) E nter 'N'", !,"to ente r the drug ordered a s free tex t for late r referenc e." | |
| 17471 | "RTN","PSJ OE1",111,0 ) | |
| 17472 | W " Ente r '^' to e xit.",! Q | |
| 17473 | "RTN","PSJ OEA") | |
| 17474 | 0^36^B3215 4460 | |
| 17475 | "RTN","PSJ OEA",1,0) | |
| 17476 | PSJOEA ;BI R/MLM-INPA TIENT ORDE R ENTRY ;J ul 26, 201 7@18:04:02 | |
| 17477 | "RTN","PSJ OEA",2,0) | |
| 17478 | ;;5.0;INP ATIENT MED ICATIONS;* *110,127,1 33,167,171 ,254,315,3 27**;16 DE C 97;Build 64 | |
| 17479 | "RTN","PSJ OEA",3,0) | |
| 17480 | ;;Per VHA Directive 2004-038, this rout ine should not be mo dified. | |
| 17481 | "RTN","PSJ OEA",4,0) | |
| 17482 | ; Referen ce to ^PS( 55 is supp orted by D BIA #2191. | |
| 17483 | "RTN","PSJ OEA",5,0) | |
| 17484 | ; Referen ce to EN^V ALM is sup ported by DBIA #1011 8. | |
| 17485 | "RTN","PSJ OEA",6,0) | |
| 17486 | ; Referen ce to ^PSS LOCK is su pported by DBIA #278 9 | |
| 17487 | "RTN","PSJ OEA",7,0) | |
| 17488 | ; Referen ce to ^DPT is suppor ted by DBI A #10035. | |
| 17489 | "RTN","PSJ OEA",8,0) | |
| 17490 | ; Referen ce to SDIM O^SDAMA203 is suppor ted by DBI A #4133. | |
| 17491 | "RTN","PSJ OEA",9,0) | |
| 17492 | ; | |
| 17493 | "RTN","PSJ OEA",10,0) | |
| 17494 | LOCK(DFN,P SJORD) ; C heck to se e if the o rder is al ready lock ed | |
| 17495 | "RTN","PSJ OEA",11,0) | |
| 17496 | N Q S Q=0 | |
| 17497 | "RTN","PSJ OEA",12,0) | |
| 17498 | I PSJORD= +PSJORD N PSJO S PSJ O=0 F S P SJO=$O(^PS (53.1,"ACX ",PSJORD,P SJO)) Q:'P SJO S Q=$ $LS^PSSLOC K(DFN,PSJO _"P") I 'Q Q | |
| 17499 | "RTN","PSJ OEA",13,0) | |
| 17500 | I Q Q 1 | |
| 17501 | "RTN","PSJ OEA",14,0) | |
| 17502 | Q 0 | |
| 17503 | "RTN","PSJ OEA",15,0) | |
| 17504 | ; | |
| 17505 | "RTN","PSJ OEA",16,0) | |
| 17506 | SELECT ; | |
| 17507 | "RTN","PSJ OEA",17,0) | |
| 17508 | N PSJCLIN ,O | |
| 17509 | "RTN","PSJ OEA",18,0) | |
| 17510 | Q:PSJORD= ""!($G(Y)< 0) Q:('$$ LOCK^PSJOE A(PSGP,PSJ ORD)) | |
| 17511 | "RTN","PSJ OEA",19,0) | |
| 17512 | N PSJO S PSJO=0 F S PSJO=$O( ^PS(53.1," ACX",PSJOR D,PSJO)) Q :'PSJO D | |
| 17513 | "RTN","PSJ OEA",20,0) | |
| 17514 | .S PSGORD ="" S ON=P SJO_"P" | |
| 17515 | "RTN","PSJ OEA",21,0) | |
| 17516 | .D DISACT IO(PSGP,PS JO_"P",$G( PSJPNV)) S :$G(PSJO)[ "V" O=ON | |
| 17517 | "RTN","PSJ OEA",22,0) | |
| 17518 | K PSGCOMP ,PSGFLG ; CLEAN UP VARIABLE F OR COMPLEX ORDER MES SAGE RJS* 327 | |
| 17519 | "RTN","PSJ OEA",23,0) | |
| 17520 | I $D(^TMP ("PSJCOM", $J)) D CHK ^PSJOEA1 | |
| 17521 | "RTN","PSJ OEA",24,0) | |
| 17522 | S:'$G(PSG P) PSGP=$G (DFN) | |
| 17523 | "RTN","PSJ OEA",25,0) | |
| 17524 | N PSJO S PSJO=0 F S PSJO=$O( ^PS(53.1," ACX",PSJOR D,PSJO)) Q :'PSJO D | |
| 17525 | "RTN","PSJ OEA",26,0) | |
| 17526 | .D UNL^PS SLOCK(PSGP ,PSJO_"P") Q:$G(Y)<0 | |
| 17527 | "RTN","PSJ OEA",27,0) | |
| 17528 | D DONE | |
| 17529 | "RTN","PSJ OEA",28,0) | |
| 17530 | Q | |
| 17531 | "RTN","PSJ OEA",29,0) | |
| 17532 | ; | |
| 17533 | "RTN","PSJ OEA",30,0) | |
| 17534 | DISACTIO(D FN,PSJORD, PSJPNV) ; Disp lay UD ord er and all ow actions . | |
| 17535 | "RTN","PSJ OEA",31,0) | |
| 17536 | ; DFN - Patient IEN | |
| 17537 | "RTN","PSJ OEA",32,0) | |
| 17538 | ; PSJORD - Order #_ location C ode (P:53. 1,V:55.01, U:55.06) | |
| 17539 | "RTN","PSJ OEA",33,0) | |
| 17540 | ; PSJPNV - Invoked from Pendi ng/NV opti on; (gets different hidden men u) | |
| 17541 | "RTN","PSJ OEA",34,0) | |
| 17542 | N PSGP,PS JIVFLG,PSG SDX,PSGFDX ,PSJXX1,ON 55,PSJAPPT | |
| 17543 | "RTN","PSJ OEA",35,0) | |
| 17544 | Q:PSJORD' ["P" | |
| 17545 | "RTN","PSJ OEA",36,0) | |
| 17546 | Q:$G(PSJC LIN)=-2 | |
| 17547 | "RTN","PSJ OEA",37,0) | |
| 17548 | S PSGP=DF N D ENIV^P SJAC | |
| 17549 | "RTN","PSJ OEA",38,0) | |
| 17550 | D GETUD^P SJLMGUD(DF N,PSJORD) | |
| 17551 | "RTN","PSJ OEA",39,0) | |
| 17552 | S PSGOEAV =$P(PSJSYS P0,"^",9)& PSJSYSU | |
| 17553 | "RTN","PSJ OEA",40,0) | |
| 17554 | S:$G(PSJT UD) PSGPD= $G(PSJCOI) ,PSGPDN=$$ OINAME^PSJ LMUTL(+PSG PD) | |
| 17555 | "RTN","PSJ OEA",41,0) | |
| 17556 | K PSGOENG I '$D(PSG PRF) D Q: $G(PSGOENG ) | |
| 17557 | "RTN","PSJ OEA",42,0) | |
| 17558 | . I PSJOR D["P" L +^ PS(53.1,+P SJORD):1 E S PSGOEN G=1 | |
| 17559 | "RTN","PSJ OEA",43,0) | |
| 17560 | . I $G(PS GOENG) W ! ,"This ord er is bein g edited b y another terminal." ,! S PSGOE NG=1 K DIR S DIR(0)= "E" D ^DIR K DIR Q | |
| 17561 | "RTN","PSJ OEA",44,0) | |
| 17562 | S PSGACT= $$ENACTION ^PSGOE1(PS GP,PSJORD) | |
| 17563 | "RTN","PSJ OEA",45,0) | |
| 17564 | I PSJORD[ "P" S PSJX X1=$G(^PS( 53.1,+PSJO RD,0)) I P SGP'=$P(PS JXX1,U,15) !(DFN'=$P( PSJXX1,U,1 5)) Q ;L -^PS(53.1, +PSJORD) Q | |
| 17565 | "RTN","PSJ OEA",46,0) | |
| 17566 | I PSJORD[ "P" D S P SJXX1=$P($ G(^PS(53.1 ,+PSJORD,0 )),U,9) I $S($G(PSJI VFLG):1,$G (Y)<0:1,"P ADE"[PSJXX 1:1,1:0) Q ;L -^PS( 53.1,+PSJO RD) Q | |
| 17567 | "RTN","PSJ OEA",47,0) | |
| 17568 | .I $P(PSJ XX1,U,9)=" N",($P(PSJ XX1,U,4)'= "U") D Q | |
| 17569 | "RTN","PSJ OEA",48,0) | |
| 17570 | .. S P("P ON")=PSJOR D,PSIVFLG= 1 | |
| 17571 | "RTN","PSJ OEA",49,0) | |
| 17572 | .. D GT53 1^PSIVORFA (+PSGP,PSJ ORD),VF^PS IVORC2 | |
| 17573 | "RTN","PSJ OEA",50,0) | |
| 17574 | .I $P(PSJ XX1,U,9)=" P" D Q | |
| 17575 | "RTN","PSJ OEA",51,0) | |
| 17576 | ..S:$G(PS JTUD) $P(P SJXX1,U,4) ="U" | |
| 17577 | "RTN","PSJ OEA",52,0) | |
| 17578 | ..N VAIP S PSJCLIN= $G(^PS(53. 1,+PSJORD, "DSS")),PS JAPPT=$P(P SJCLIN,"^" ,2),PSJCLI N=$P(PSJCL IN,"^") | |
| 17579 | "RTN","PSJ OEA",53,0) | |
| 17580 | ..I $P(PS JXX1,U,4)= "U",(+PSJP DD) D Q:( PSJCLIN=-2 ) | |
| 17581 | "RTN","PSJ OEA",54,0) | |
| 17582 | ...I $$PA TCH^XPDUTL ("SD*5.3*2 85"),($$SD IMO^SDAMA2 03(PSJCLIN ,DFN)>-1) Q | |
| 17583 | "RTN","PSJ OEA",55,0) | |
| 17584 | ...W !!," Cannot pro cess an Ou t-patient Unit Dose order for ",$P($G(^D PT(+PSGP,0 )),U) D PA USE^VALM1 S PSJIVFLG =1,PSJCLIN =-2 | |
| 17585 | "RTN","PSJ OEA",56,0) | |
| 17586 | ..NEW PSG RSD,PSGRSD N,PSGRFD,P SGRFDN | |
| 17587 | "RTN","PSJ OEA",57,0) | |
| 17588 | ..D REQDT ^PSJLIVMD( PSJORD) | |
| 17589 | "RTN","PSJ OEA",58,0) | |
| 17590 | ..I $P(PS JXX1,U,4)= "U",($G(PS GSCH)="") W !!,"Inva lid schedu le, can't finish thi s order" D PAUSE^VAL M1 Q | |
| 17591 | "RTN","PSJ OEA",59,0) | |
| 17592 | ..I $P(PS JXX1,U,4)= "U" N PSJL M S PSJLM= 1,PSGORD=P SJORD D ST ART^PSGOEF ,ENSFE^PSG OEE0(PSGP, PSGORD),@$ S($G(PSJTU D):"FINISH ^PSGOEF",1 :"EN^VALM( ""PSJ LM P ENDING EDI T"")") D Q | |
| 17593 | "RTN","PSJ OEA",60,0) | |
| 17594 | ...K ^TMP ("PSJINTER ",$J),PSJO VR | |
| 17595 | "RTN","PSJ OEA",61,0) | |
| 17596 | ..I $P(PS JXX1,U,4)' ="U",PSGP= $P(PSJXX1, U,15),DFN= $P(PSJXX1, U,15) S PS JLYN=PSJOR D D EN^PSJ LIFN S PSJ IVFLG=1 K PSJLYN,PSJ MAI | |
| 17597 | "RTN","PSJ OEA",62,0) | |
| 17598 | I $G(PSIV FLG) K PSI VFLG Q | |
| 17599 | "RTN","PSJ OEA",63,0) | |
| 17600 | S PSGACT= $$ENACTION ^PSGOE1(PS GP,PSJORD) ,PSGOEEF=0 D GETUD^P SJLMGUD(PS GP,PSJORD) ,ENSFE^PSG OEE0(PSGP, PSJORD),EN ^VALM("PSJ LM UD ACT ION") | |
| 17601 | "RTN","PSJ OEA",64,0) | |
| 17602 | ;Send SN to CPRS if autoverif y OFF and Order Set Entry and no 21st pi ece | |
| 17603 | "RTN","PSJ OEA",65,0) | |
| 17604 | I $D(PSGO ES),'PSGOE AV,$D(PSGO RD),PSGORD ["P",$P($G (^PS(53.1, +PSGORD,0) ),"^",21)' ]"" D ORSE T^PSGOETO1 | |
| 17605 | "RTN","PSJ OEA",66,0) | |
| 17606 | Q | |
| 17607 | "RTN","PSJ OEA",67,0) | |
| 17608 | ; | |
| 17609 | "RTN","PSJ OEA",68,0) | |
| 17610 | ACTLOG(PSG ORDP,DFN,P SGORD) ;S tore 53.1 activity l og in loca l array to be moved to 55 | |
| 17611 | "RTN","PSJ OEA",69,0) | |
| 17612 | ;PSGORDP: IEN from 53.1 | |
| 17613 | "RTN","PSJ OEA",70,0) | |
| 17614 | ;PSGORD : IEN from 55 | |
| 17615 | "RTN","PSJ OEA",71,0) | |
| 17616 | NEW PSGX, PSGXDA,PSG AL531,Q,QQ | |
| 17617 | "RTN","PSJ OEA",72,0) | |
| 17618 | F PSGX=0: 0 S PSGX=$ O(^PS(53.1 ,+PSGORDP, "A",PSGX)) Q:'PSGX D | |
| 17619 | "RTN","PSJ OEA",73,0) | |
| 17620 | . S PSGAL 531=$G(^PS (53.1,+PSG ORDP,"A",P SGX,0)) | |
| 17621 | "RTN","PSJ OEA",74,0) | |
| 17622 | . S QQ=$G (^PS(55,DF N,5,+PSGOR D,9,0)) S: QQ="" QQ=" ^55.09D" F Q=$P(QQ,U ,3)+1:1 I '$D(^(Q)) S $P(QQ,U, 3,4)=Q_U_Q ,^(0)=QQ,P SGXDA=Q Q | |
| 17623 | "RTN","PSJ OEA",75,0) | |
| 17624 | . S ^PS(5 5,DFN,5,+P SGORD,9,PS GXDA,0)=PS GAL531 | |
| 17625 | "RTN","PSJ OEA",76,0) | |
| 17626 | Q | |
| 17627 | "RTN","PSJ OEA",77,0) | |
| 17628 | ; | |
| 17629 | "RTN","PSJ OEA",78,0) | |
| 17630 | UD ; | |
| 17631 | "RTN","PSJ OEA",79,0) | |
| 17632 | N DA,DR,D IE,PSJCMPD A D ENGNA^ PSGOETO S $P(^TMP("P SJCOM",$J, PSJO,0),"^ ",26)=DA_" U",$P(^TMP ("PSJCOM2" ,$J,PSJO,0 ),"^")=DA, $P(^(0),"^ ",18)=DA S PSJCMPDA= DA | |
| 17633 | "RTN","PSJ OEA",80,0) | |
| 17634 | M ^PS(55, PSGP,5,DA) =^TMP("PSJ COM2",$J,+ PSJO) M ^P S(53.1,+PS JO)=^TMP(" PSJCOM",$J ,+PSJO) D EN1^PSJHL2 (PSGP,"OD" ,+PSJO_"P" ) S PSJNOO =$P(^TMP(" PSJCOM2",$ J,+PSJO,.2 ),U,3) D E N1^PSJHL2( PSGP,"SN", +PSJCMPDA_ "U") | |
| 17635 | "RTN","PSJ OEA",81,0) | |
| 17636 | N PSGPDRG ,PSGST,PSG NESD,PSGNE FD,ND2,ND2 P1 | |
| 17637 | "RTN","PSJ OEA",82,0) | |
| 17638 | S PSGPDRG =$P($G(^PS (55,PSGP,5 ,PSJCMPDA, .2)),"^"), PSGST=$P($ G(^PS(55,P SGP,5,PSJC MPDA,0))," ^",7) | |
| 17639 | "RTN","PSJ OEA",83,0) | |
| 17640 | S ND2=$G( ^PS(55,PSG P,5,PSJCMP DA,2)),PSG NESD=$P(ND 2,"^",2),P SGNEFD=$P( ND2,"^",4) D CRA^PSG OETO | |
| 17641 | "RTN","PSJ OEA",84,0) | |
| 17642 | S ND2P1=$ G(^PS(55,P SGP,5,PSJC MPDA,2)),P SGRMVT=$P( ND2P1,"^", 2) ;*315 | |
| 17643 | "RTN","PSJ OEA",85,0) | |
| 17644 | K ^PS(53. 1,"ACX",PS JORD,PSJO) K PSJPREX | |
| 17645 | "RTN","PSJ OEA",86,0) | |
| 17646 | I $G(PSJC MPDA) D CM PLX2^PSJCO M1(PSGP,PS JORD,+PSJC MPDA_"U") I $G(PSGPX N) S PSJPR EX=1 | |
| 17647 | "RTN","PSJ OEA",87,0) | |
| 17648 | Q | |
| 17649 | "RTN","PSJ OEA",88,0) | |
| 17650 | IV ; | |
| 17651 | "RTN","PSJ OEA",89,0) | |
| 17652 | K ON55 I $P($G(^PS( 53.1,+PSJO ,0)),"^",2 4)="R",$P( $G(^PS(53. 1,+PSJO,0) ),"^",25) S ON55=$P( ^PS(53.1,+ PSJO,0),"^ ",25) | |
| 17653 | "RTN","PSJ OEA",90,0) | |
| 17654 | I '$G(ON5 5) D NEW55 ^PSIVORFB | |
| 17655 | "RTN","PSJ OEA",91,0) | |
| 17656 | S $P(^TMP ("PSJCOM", $J,PSJO,0) ,"^",26)=O N55,$P(^TM P("PSJCOM2 ",$J,PSJO, 0),"^")=+O N55 | |
| 17657 | "RTN","PSJ OEA",92,0) | |
| 17658 | S $P(^TMP ("PSJCOM2" ,$J,PSJO,2 ),U,5)=PSJ O_"P",$P(^ TMP("PSJCO M",$J,PSJO ,0),U,26)= ON55 | |
| 17659 | "RTN","PSJ OEA",93,0) | |
| 17660 | M ^PS(55, DFN,"IV",+ ON55)=^TMP ("PSJCOM2" ,$J,+PSJO) M ^PS(53. 1,+PSJO)=^ TMP("PSJCO M",$J,+PSJ O) D EN1^P SJHL2(PSGP ,"OD",+PSJ O_"P") S P ("NAT")=$P (^TMP("PSJ COM2",$J,+ PSJO,.2),U ,5) D EN1^ PSJHL2(PSG P,"SN",ON5 5) | |
| 17661 | "RTN","PSJ OEA",94,0) | |
| 17662 | K DA,DIK S DA(1)=DF N,DA=+ON55 ,DIK="^PS( 55,"_DA(1) _",""IV"", ",PSIVACT= 1 D IX^DIK K DA,DIK | |
| 17663 | "RTN","PSJ OEA",95,0) | |
| 17664 | K ^PS(53. 1,"ACX",PS JORD,PSJO) | |
| 17665 | "RTN","PSJ OEA",96,0) | |
| 17666 | Q | |
| 17667 | "RTN","PSJ OEA",97,0) | |
| 17668 | ; | |
| 17669 | "RTN","PSJ OEA",98,0) | |
| 17670 | DONE ; Cle an up | |
| 17671 | "RTN","PSJ OEA",99,0) | |
| 17672 | K PSGPD,P SGPDN,PSGS CH,PSIVACT ,PSJNOO | |
| 17673 | "RTN","PSJ OEA",100,0 ) | |
| 17674 | Q | |
| 17675 | "RTN","PSJ OEA1") | |
| 17676 | 0^37^B2990 5654 | |
| 17677 | "RTN","PSJ OEA1",1,0) | |
| 17678 | PSJOEA1 ;B IR/MLM-INP ATIENT ORD ER ENTRY ; Jul 26, 20 17@18:04:0 2 | |
| 17679 | "RTN","PSJ OEA1",2,0) | |
| 17680 | ;;5.0;INP ATIENT MED ICATIONS;* *110,127,1 33,171,254 ,327**;16 DEC 97;Bui ld 64 | |
| 17681 | "RTN","PSJ OEA1",3,0) | |
| 17682 | ; | |
| 17683 | "RTN","PSJ OEA1",4,0) | |
| 17684 | ; Referen ce to ^PS( 55 is supp orted by D BIA #2191. | |
| 17685 | "RTN","PSJ OEA1",5,0) | |
| 17686 | ; Referen ce to ^PSS LOCK is su pported by DBIA #278 9. | |
| 17687 | "RTN","PSJ OEA1",6,0) | |
| 17688 | ; | |
| 17689 | "RTN","PSJ OEA1",7,0) | |
| 17690 | CHK ;Check to be sur e all the orders in the comple x order se ries are c ompleted. | |
| 17691 | "RTN","PSJ OEA1",8,0) | |
| 17692 | N COMQUIT ,PSJCOMV,P SJOT,PSJST AT,PSJSTAT 2,PSGND2P5 ,DUR,ND14, PSJPREX S (PSJCOMV,C OMQUIT)=0, PSJSTAT2=" " K ^TMP(" PSJINTER", $J) | |
| 17693 | "RTN","PSJ OEA1",9,0) | |
| 17694 | I '$D(^TM P("PSJCOM" ,$J)) Q | |
| 17695 | "RTN","PSJ OEA1",10,0 ) | |
| 17696 | N PSJO S PSJO=0 F S PSJO=$O( ^PS(53.1," ACX",PSJOR D,PSJO)) Q :'PSJO Q: COMQUIT S PSJOT=$P( ^PS(53.1,P SJO,0),"^" ,4) D | |
| 17697 | "RTN","PSJ OEA1",11,0 ) | |
| 17698 | . I '$D(^ TMP("PSJCO M",$J,PSJO ,0)) M ^TM P("PSJCOM" ,$J,PSJO)= ^PS(53.1,P SJO) I '$D (^TMP("PSJ COM",$J,PS JO,0)) S C OMQUIT=2 Q :COMQUIT | |
| 17699 | "RTN","PSJ OEA1",12,0 ) | |
| 17700 | . S PSJST AT=$P(^TMP ("PSJCOM", $J,PSJO,0) ,"^",9) | |
| 17701 | "RTN","PSJ OEA1",13,0 ) | |
| 17702 | . I PSJST AT="DE" S PSJSTAT=$P ($G(^TMP(" PSJCOM2",$ J,PSJO,0)) ,"^",9) I PSJSTAT="" S COMQUIT =1 Q | |
| 17703 | "RTN","PSJ OEA1",14,0 ) | |
| 17704 | . S:PSJST AT2="" PSJ STAT2=PSJS TAT S:PSJS TAT'=PSJST AT2 COMQUI T=2 Q:COMQ UIT S PSJ STAT2=PSJS TAT | |
| 17705 | "RTN","PSJ OEA1",15,0 ) | |
| 17706 | I COMQUIT ,PSJOT="U" ,$G(^TMP(" PSJCOM",$J ))'="A" S: $G(PSJOWAL L)]"" $P(^ PS(55,PSGP ,5.1),U)=P SJOWALL | |
| 17707 | "RTN","PSJ OEA1",16,0 ) | |
| 17708 | I (COMQUI T=2)!(COMQ UIT&($G(^T MP("PSJCOM ",$J))'="A ")) D Q | |
| 17709 | "RTN","PSJ OEA1",17,0 ) | |
| 17710 | .K ^TMP(" PSJCOM",$J ),^TMP("PS JCOM2",$J) ,PSGCMPLX, PSGTMPSD | |
| 17711 | "RTN","PSJ OEA1",18,0 ) | |
| 17712 | .W !,"By not finish ing all th e orders, none of th e orders w ill be upd ated." D P AUSE^VALM1 | |
| 17713 | "RTN","PSJ OEA1",19,0 ) | |
| 17714 | I 'COMQUI T N PSJO S PSJO=0 F S PSJO=$O (^TMP("PSJ COM",$J,PS JO)) Q:'PS JO D | |
| 17715 | "RTN","PSJ OEA1",20,0 ) | |
| 17716 | .S PSGS0Y =$P($G(^TM P("PSJCOM" ,$J,+PSJO, 2)),"^",5) ,PSGS0XT=$ P($G(^TMP( "PSJCOM",$ J,+PSJO,2) ),"^",6) | |
| 17717 | "RTN","PSJ OEA1",21,0 ) | |
| 17718 | .N EDITS0 Y,EDITS0XT S EDITS0Y =$P($G(^TM P("PSJCOM2 ",$J,+PSJO ,2)),"^",5 ),EDITS0XT =$P($G(^TM P("PSJCOM2 ",$J,+PSJO ,2)),"^",6 ) D | |
| 17719 | "RTN","PSJ OEA1",22,0 ) | |
| 17720 | ..S:EDITS 0Y PSGS0Y= EDITS0Y I EDITS0XT!( ",O,D,"[(" ,"_EDITS0X T_",")) S PSGS0XT=ED ITS0XT | |
| 17721 | "RTN","PSJ OEA1",23,0 ) | |
| 17722 | .N DIE,DA ,DR S DR=" 28////^S X =$P(^TMP(" "PSJCOM"", $J,+PSJO,0 ),""^"",9) ",DA=+PSJO ,DIE="^PS( 53.1," D ^ DIE | |
| 17723 | "RTN","PSJ OEA1",24,0 ) | |
| 17724 | .N DIK,DA S DIK="^P S(53.1,",D A=+PSJO S: $G(DFN) DA (1)=DFN D IX^DIK K D IK,DA | |
| 17725 | "RTN","PSJ OEA1",25,0 ) | |
| 17726 | .M ^PS(53 .1,+PSJO)= ^TMP("PSJC OM",$J,+PS JO) | |
| 17727 | "RTN","PSJ OEA1",26,0 ) | |
| 17728 | .S PSGND= $G(^PS(53. 1,+PSJO,0) ),PSGND2P5 =$G(^PS(53 .1,+PSJO,2 .5)),DUR=$ P(PSGND2P5 ,"^",2),ND 14=$$LASTR EN^PSJLMPR I(DFN,+PSJ O_"P") | |
| 17729 | "RTN","PSJ OEA1",27,0 ) | |
| 17730 | .I $P(PSG ND,U,4)="U ",$P(PSGND ,U,24)="R" D | |
| 17731 | "RTN","PSJ OEA1",28,0 ) | |
| 17732 | ..N PND0, PSGORDR S PND0=^PS(5 3.1,+PSJO, 0) I $P(PN D0,U,24)=" R" S PSGOR DR=$P(PND0 ,U,25) D | |
| 17733 | "RTN","PSJ OEA1",29,0 ) | |
| 17734 | ...S:'$G( PSGP) PSGP =$G(DFN) Q :'$$LS^PSS LOCK(PSGP, PSGORDR) | |
| 17735 | "RTN","PSJ OEA1",30,0 ) | |
| 17736 | ...N OEOR D,OOEORD,F ILE55,FILE 55N0,PNDP2 S PNDP2=^ PS(53.1,+P SJO,.2),FI LE55="^PS( 55,"_DFN_$ S($P(PND0, U,4)="U":" ,5,",1:"," "IV"","),F ILE55N0=FI LE55_+PSGO RDR_",0)" | |
| 17737 | "RTN","PSJ OEA1",31,0 ) | |
| 17738 | ...S OEOR D=$P(PND0, U,21) I PS GORDR S OO EORD=$P(@F ILE55N0,"^ ",21) I OE ORD'=OOEOR D D EXPOE^ PSGOER(DFN ,+PSJO_"P" ,+$$LASTRE N^PSJLMPRI (DFN,+PSJO _"P")) | |
| 17739 | "RTN","PSJ OEA1",32,0 ) | |
| 17740 | ...S PSGO RDP=PSJO,D IE="^PS(53 .1,",DA=+P SJO,DR="28 ////A;104/ ///@" W ". " D ^DIE | |
| 17741 | "RTN","PSJ OEA1",33,0 ) | |
| 17742 | ...D STAR T^PSGOTR(+ PSJO_"P",+ PSGORDR) I OEORD D | |
| 17743 | "RTN","PSJ OEA1",34,0 ) | |
| 17744 | ....K DA, DR,DIE S D A(1)=DFN,D A=+PSGORDR ,DIE=FILE5 5,DR=$S(DI E["IV":110 ,1:66)_"// //"_+OEORD | |
| 17745 | "RTN","PSJ OEA1",35,0 ) | |
| 17746 | ....S:$P( PNDP2,U,8) DR=DR_";1 25////"_$P (PNDP2,U,8 ) D ^DIE S DIE=FILE5 5_+PSGORDR _",0)",$P( @DIE,U,21) =OEORD | |
| 17747 | "RTN","PSJ OEA1",36,0 ) | |
| 17748 | ....D EN1 ^PSJHL2(DF N,"SC",PSG ORDR),UNL^ PSSLOCK(DF N,PSGORDR) | |
| 17749 | "RTN","PSJ OEA1",37,0 ) | |
| 17750 | ..I '$G(C OMQUIT) S ND14=$$LAS TREN^PSJLM PRI(DFN,+P SJO_"P") I $G(ND14) S DA=+$P(P SGND,U,25) I DA D | |
| 17751 | "RTN","PSJ OEA1",38,0 ) | |
| 17752 | ...N PSGA T S PSGAT= $P($G(^TMP ("PSJCOM", $J,+PSJO,2 )),"^",5) | |
| 17753 | "RTN","PSJ OEA1",39,0 ) | |
| 17754 | ...D UPDR EN^PSGOER( DA,$P(ND14 ,U),$P(ND1 4,U,3),$P( ND14,U,4), $P($G(^PS( 53.1,+PSJO ,.2)),U,3) ,$P(ND14,U ,2)) | |
| 17755 | "RTN","PSJ OEA1",40,0 ) | |
| 17756 | ...K PSJP REX I $G(P SGORDR)["U " I $G(PSJ ORD)=+$G(P SJORD) D C MPLX2^PSJC OM1(DFN,PS JORD,PSGOR DR) I $G(P SGPXN) S P SJPREX=1 | |
| 17757 | "RTN","PSJ OEA1",41,0 ) | |
| 17758 | .I '$G(PS GP) S:$G(D FN) PSGP=D FN | |
| 17759 | "RTN","PSJ OEA1",42,0 ) | |
| 17760 | .I $P(PSG ND,U,4)'=" U",$P(PSGN D,U,24)="R ",$P(PSGND ,U,25),$P( $G(^PS(53. 1,+PSJO,2) ),U,2)<$P( $G(^PS(55, PSGP,"IV", +$P(PSGND, U,25),0)), U,3) D | |
| 17761 | "RTN","PSJ OEA1",43,0 ) | |
| 17762 | ..K DA,DR S DA(1)=P SGP,DA=+$P (PSGND,U,2 5),DIE="^P S(55,"_PSG P_",""IV"" ,",DR=".03 ////"_$P($ G(^PS(53.1 ,+PSJO,2)) ,U,2)_";11 6////"_$P( $G(^PS(55, PSGP,"IV", +$P(PSGND, U,25),0)), U,3) | |
| 17763 | "RTN","PSJ OEA1",44,0 ) | |
| 17764 | ..D ^DIE, EN1^PSJHL2 (PSGP,"XX" ,$P(PSGND, U,25)) L - ^PS(53.1,+ PSJO) | |
| 17765 | "RTN","PSJ OEA1",45,0 ) | |
| 17766 | .I $P(PSG ND,U,9)="D E",$D(^TMP ("PSJCOM2" ,$J,PSJO,0 )),(",N,A, "[$P(^TMP( "PSJCOM2", $J,PSJO,0) ,"^",9)) D | |
| 17767 | "RTN","PSJ OEA1",46,0 ) | |
| 17768 | ..S:'$G(P SGP) PSGP= DFN S PSGS 0Y=$P($G(^ TMP("PSJCO M2",$J,+PS JO,2)),"^" ,5) | |
| 17769 | "RTN","PSJ OEA1",47,0 ) | |
| 17770 | ..N DA,DR ,DIE D ENG NN^PSGOETO S $P(^TMP ("PSJCOM", $J,PSJO,0) ,"^",26)=D A_"P",$P(^ TMP("PSJCO M2",$J,PSJ O,0),"^")= DA,$P(^(0) ,"^",18)=D A | |
| 17771 | "RTN","PSJ OEA1",48,0 ) | |
| 17772 | ..S DR="2 8////^S X= $P(^TMP("" PSJCOM2"", $J,+PSJO,0 ),""^"",9) ",DIE="^PS (53.1," D ^DIE | |
| 17773 | "RTN","PSJ OEA1",49,0 ) | |
| 17774 | ..M ^PS(5 3.1,DA)=^T MP("PSJCOM 2",$J,+PSJ O) M ^TMP( "PSJCOM2", $J,DA)=^TM P("PSJCOM2 ",$J,+PSJO ) N PSJOCH IL S PSJOC HIL=$P(^PS (53.1,DA,. 2),"^",8) I PSJOCHIL S ^PS(53. 1,"ACX",+P SJOCHIL,DA )="" | |
| 17775 | "RTN","PSJ OEA1",50,0 ) | |
| 17776 | ..I $P(^P S(53.1,+PS JO,2),"^", 5)'=$P(^TM P("PSJCOM2 ",$J,+PSJO ,2),"^",5) S $P(^PS( 53.1,+PSJO ,2),"^",5) =$P(^TMP(" PSJCOM2",$ J,+PSJO,2) ,"^",5) | |
| 17777 | "RTN","PSJ OEA1",51,0 ) | |
| 17778 | ..D EN1^P SJHL2(PSGP ,"OD",+PSJ O_"P"),EN1 ^PSJHL2(PS GP,"SN",+D A_"P") | |
| 17779 | "RTN","PSJ OEA1",52,0 ) | |
| 17780 | ..K ^PS(5 3.1,"ACX", PSJORD,PSJ O) L -^PS( 53.1,+PSJO ) L -^PS(5 3.1,DA) | |
| 17781 | "RTN","PSJ OEA1",53,0 ) | |
| 17782 | ..D SETUD INT^PSGSIC H1(PSJO_"P ",DA_"P") | |
| 17783 | "RTN","PSJ OEA1",54,0 ) | |
| 17784 | I '$G(COM QUIT) N PS JO S PSJO= 0 F S PSJ O=$O(^PS(5 3.1,"ACX", PSJORD,PSJ O)) Q:'PSJ O Q:PSJCO MV D | |
| 17785 | "RTN","PSJ OEA1",55,0 ) | |
| 17786 | .I '$D(^T MP("PSJCOM ",$J,PSJO) ) D Q:$G( PSJCOMV) | |
| 17787 | "RTN","PSJ OEA1",56,0 ) | |
| 17788 | ..N EDITN D0,PREV,RE AS S EDITN D0=$G(^PS( 53.1,+PSJO ,0)) S PRE V=$P(EDITN D0,"^",25) ,REAS=$P(E DITND0,"^" ,24) | |
| 17789 | "RTN","PSJ OEA1",57,0 ) | |
| 17790 | ..I PREV, REAS="E" I $P($G(^PS (53.1,+PRE V,0)),"^", 9)="DE" M ^TMP("PSJC OM",$J,+PS JO)=^PS(53 .1,+PSJO) K ^TMP("PS JCOM",$J,+ PREV),^PS( 53.1,"ACX" ,+PREV) Q | |
| 17791 | "RTN","PSJ OEA1",58,0 ) | |
| 17792 | ..S PSJCO MV=1 | |
| 17793 | "RTN","PSJ OEA1",59,0 ) | |
| 17794 | .I $P(^TM P("PSJCOM" ,$J,PSJO,0 ),"^",9)'= "A",'$D(^T MP("PSJCOM 2",$J,PSJO ,0)) S PSJ COMV=1 Q | |
| 17795 | "RTN","PSJ OEA1",60,0 ) | |
| 17796 | .I $P($G( ^TMP("PSJC OM2",$J,PS JO,0)),"^" ,4)="U",$P (^TMP("PSJ COM",$J,PS JO,0),"^", 9)'="A",$P ($G(^TMP(" PSJCOM2",$ J,PSJO,0)) ,"^",9)'=" A" S PSJCO MV=1 Q | |
| 17797 | "RTN","PSJ OEA1",61,0 ) | |
| 17798 | .I $P($G( ^TMP("PSJC OM2",$J,PS JO,0)),"^" ,4)'="U",$ P(^TMP("PS JCOM",$J,P SJO,0),"^" ,9)'="A",$ P($G(^TMP( "PSJCOM2", $J,PSJO,0) ),"^",17)' ="A" S PSJ COMV=1 | |
| 17799 | "RTN","PSJ OEA1",62,0 ) | |
| 17800 | I ($G(COM QUIT)=2)!( ($G(COMQUI T)!PSJCOMV )&$G(^TMP( "PSJCOM",$ J))="A") K ^TMP("PSJ COM",$J),^ TMP("PSJCO M2",$J) W !,"By not verifying all the or ders, none of the or ders will be verifie d." D PAUS E^VALM1 Q | |
| 17801 | "RTN","PSJ OEA1",63,0 ) | |
| 17802 | ; | |
| 17803 | "RTN","PSJ OEA1",64,0 ) | |
| 17804 | D CHK^PSJ OEA2 | |
| 17805 | "RTN","PSJ OEA1",65,0 ) | |
| 17806 | Q | |
| 17807 | "RTN","PSJ RXLAB") | |
| 17808 | 0^7^B37740 898 | |
| 17809 | "RTN","PSJ RXLAB",1,0 ) | |
| 17810 | PSJRXLAB ; ALB/RTW - drug+lab result pri nt ;Jul 26 , 2017@18: 04:02 | |
| 17811 | "RTN","PSJ RXLAB",2,0 ) | |
| 17812 | ;;5.0;INP ATIENT PHA RMACY;**32 7**;DEC 19 97;Build 6 4 | |
| 17813 | "RTN","PSJ RXLAB",3,0 ) | |
| 17814 | ;RTW copi ed from ro utine PSOR XLAB and m odified fo r the Inpa tient NCC Clozapine inpatient pharmacy p roject | |
| 17815 | "RTN","PSJ RXLAB",4,0 ) | |
| 17816 | ;FSIG and FSIG2(for merly EN2) , are brou ght in fro m PSOUTLA and PSOUTL A1 | |
| 17817 | "RTN","PSJ RXLAB",5,0 ) | |
| 17818 | ;a routin e which lo op thru th e last fil l order of ^PS(55 an d gets | |
| 17819 | "RTN","PSJ RXLAB",6,0 ) | |
| 17820 | ;patients with a sp ecific dru g. then ge ts the lrd fn from th e | |
| 17821 | "RTN","PSJ RXLAB",7,0 ) | |
| 17822 | ;patient file and l oops thru the patien ts lab dat a to find | |
| 17823 | "RTN","PSJ RXLAB",8,0 ) | |
| 17824 | ;results within the date rang e you spec ify for th e lab test | |
| 17825 | "RTN","PSJ RXLAB",9,0 ) | |
| 17826 | ;used to minitor th e drug. it then prin ts the pat ient's nam e | |
| 17827 | "RTN","PSJ RXLAB",10, 0) | |
| 17828 | ;ssn, las t fill dat e, and the lab test results if any. | |
| 17829 | "RTN","PSJ RXLAB",11, 0) | |
| 17830 | ;this is intended a s a qa min itor and s hould not be run for | |
| 17831 | "RTN","PSJ RXLAB",12, 0) | |
| 17832 | ;more tha n a 30 day fill date interval, or 1 year lab test interval. | |
| 17833 | "RTN","PSJ RXLAB",13, 0) | |
| 17834 | ;External ref. to ^ LAB(60, is supp. by DBIA# 333 | |
| 17835 | "RTN","PSJ RXLAB",14, 0) | |
| 17836 | ;External ref. to ^ LR(LRDFN," CH", is su pp. by DBI A# 844 | |
| 17837 | "RTN","PSJ RXLAB",15, 0) | |
| 17838 | ;External ref. to ^ PSDRUG( is supp. by DBIA# 221 | |
| 17839 | "RTN","PSJ RXLAB",16, 0) | |
| 17840 | ;External ref. to ^ VA(200, is supp. by DBIA# 1006 0 | |
| 17841 | "RTN","PSJ RXLAB",17, 0) | |
| 17842 | PSJSITE K ^UTILITY(" DIQ1",$J), DIQ,^TMP($ J,"ORDERNU M") S DA=$ P($$SITE^V ASITE(),"^ ") | |
| 17843 | "RTN","PSJ RXLAB",18, 0) | |
| 17844 | N PSCNT S PSCNT=0 | |
| 17845 | "RTN","PSJ RXLAB",19, 0) | |
| 17846 | I $G(DA) D | |
| 17847 | "RTN","PSJ RXLAB",20, 0) | |
| 17848 | .S DIC=4, DIQ(0)="I" ,DR=".01;9 9" D EN^DI Q1 | |
| 17849 | "RTN","PSJ RXLAB",21, 0) | |
| 17850 | .S SITE=$ G(^UTILITY ("DIQ1",$J ,4,DA,.01, "I"))_" "_ $G(^UTILIT Y("DIQ1",$ J,4,DA,99, "I")) | |
| 17851 | "RTN","PSJ RXLAB",22, 0) | |
| 17852 | .K ^UTILI TY("DIQ1", $J),DA,DR, DIQ,DIC | |
| 17853 | "RTN","PSJ RXLAB",23, 0) | |
| 17854 | S Y=DT X ^DD("DD") S SITE=$G( SITE)_" "_ Y | |
| 17855 | "RTN","PSJ RXLAB",24, 0) | |
| 17856 | BDATE S %D T="EXTA",% DT("A")="B eginning f ill date: " D ^%DT G CLEAN:Y<0 S PSJBD=Y X ^DD("DD ") S PSJBD R=Y | |
| 17857 | "RTN","PSJ RXLAB",25, 0) | |
| 17858 | EDATE S %D T("A")="En ding last fill date: " D ^%DT G CLEAN:Y< 0 S PSJED= Y X ^DD("D D") S PSJE DR=Y | |
| 17859 | "RTN","PSJ RXLAB",26, 0) | |
| 17860 | LDATE S %D T("A")="Ea rliest dat e for lab results: " D ^%DT G CLEAN:Y<0 S LDATE=Y X ^DD("DD" ) S LDATER =Y | |
| 17861 | "RTN","PSJ RXLAB",27, 0) | |
| 17862 | DRUG R !," Enter the key word i n the Drug Generic n ame: ",PSJ DRUG:DTIME G CLEAN:' $T I "^"[P SJDRUG G C LEAN | |
| 17863 | "RTN","PSJ RXLAB",28, 0) | |
| 17864 | N DRGARRA Y D LIST^D IC(50,,.01 ,"I",,,$$U P^XLFSTR(P SJDRUG),"B ",,,"DRGAR RAY") | |
| 17865 | "RTN","PSJ RXLAB",29, 0) | |
| 17866 | I 'DRGARR AY("DILIST ",0) W !," No corresp onding ent ry, try ag ain or typ e return t o exit" G DRUG | |
| 17867 | "RTN","PSJ RXLAB",30, 0) | |
| 17868 | S PSJDRUG =$$UP^XLFS TR(PSJDRUG ) | |
| 17869 | "RTN","PSJ RXLAB",31, 0) | |
| 17870 | LABT S DIC ="^LAB(60, ",DIC(0)=" QEAM" D ^D IC K DIC G :Y<0 CLEAN S PSJLBT= $P(Y,"^"), PSJLABTN=$ P(Y,"^",2) G:PSJLBT= "" CLEAN | |
| 17871 | "RTN","PSJ RXLAB",32, 0) | |
| 17872 | ;I '$D(^L AB(60,PSJL BT,.2)) W !!,$C(7)," Data Name missing !! ",! K Y,PS JLBT G LAB T | |
| 17873 | "RTN","PSJ RXLAB",33, 0) | |
| 17874 | S PSJLABT =$$GET1^DI Q(60,PSJLB T,400,"I") | |
| 17875 | "RTN","PSJ RXLAB",34, 0) | |
| 17876 | W !,"Ente r the spec imen used in the lab for this test, seru m,plasma,b lood etc." | |
| 17877 | "RTN","PSJ RXLAB",35, 0) | |
| 17878 | PSJSP S DI C="^LAB(61 ,",DIC(0)= "QEAM" D ^ DIC G:Y<0 CLEAN S PS JSP=$P(Y," ^") G:PSJS P="" CLEAN ;;I $P($G (^LAB(60,P SJLBT,1,PS JSP,0)),"^ ",7)']"" W !!,$C(7), "Specimen data missi ng !!",! ; K Y,PSJSP G PSJSP | |
| 17879 | "RTN","PSJ RXLAB",36, 0) | |
| 17880 | PSJUNIT S PSJUNIT=$S ($G(PSJSP) ]"":$$GET1 ^DIQ(60.01 ,PSJSP_"," _PSJLBT,6) ,1:"") | |
| 17881 | "RTN","PSJ RXLAB",37, 0) | |
| 17882 | PSJANS R ! ,"Do you w ant Order info? N// ",PSJANS:D TIME G CLE AN:'$T S:P SJANS="" P SJANS="N" G:PSJANS=" ^" CLEAN2 I "YNyn"'[ $E(PSJANS) W !,"ANSW ER YES OR NO" G PSJA NS | |
| 17883 | "RTN","PSJ RXLAB",38, 0) | |
| 17884 | DEVICE K I OP S %ZIS= "MQ" D ^%Z IS G:POP C LEAN2 | |
| 17885 | "RTN","PSJ RXLAB",39, 0) | |
| 17886 | I $D(IO(" Q")) K IO( "Q") S ZTS AVE("*")=" ",ZTRTN="D Q^PSJRXLAB ",ZTDESC=" LAB LIST" D ^%ZTLOAD K ZTSK G CLEAN | |
| 17887 | "RTN","PSJ RXLAB",40, 0) | |
| 17888 | DQ S PSJLA BQ=0 S PSJ BD=PSJBD-1 ,PAGE=0 U IO W @IOF D HDR | |
| 17889 | "RTN","PSJ RXLAB",41, 0) | |
| 17890 | LOOP1 ; | |
| 17891 | "RTN","PSJ RXLAB",42, 0) | |
| 17892 | K ^TMP($J ,"PSORDT") D LIST^DI C(100,"",. 01,"I",,PS JBD,,"AD", ,,"^TMP($J ,""PSORDT" ")") | |
| 17893 | "RTN","PSJ RXLAB",43, 0) | |
| 17894 | N PSJ F P SJ=1:1 Q:' $D(^TMP($J ,"PSORDT", "DILIST",1 ,PSJ)) S PSJBD=^TMP ($J,"PSORD T","DILIST ",1,PSJ) Q :PSJBD>PSJ ED S PSJO RDN=0 D LO OP2 Q:$G(P SJLABQ) | |
| 17895 | "RTN","PSJ RXLAB",44, 0) | |
| 17896 | G CLEAN | |
| 17897 | "RTN","PSJ RXLAB",45, 0) | |
| 17898 | LOOP2 S PS JORDN=^TMP ($J,"PSORD T","DILIST ",2,PSJ) D CHECK1 | |
| 17899 | "RTN","PSJ RXLAB",46, 0) | |
| 17900 | Q | |
| 17901 | "RTN","PSJ RXLAB",47, 0) | |
| 17902 | CHECK1 ; | |
| 17903 | "RTN","PSJ RXLAB",48, 0) | |
| 17904 | N PSJNUM | |
| 17905 | "RTN","PSJ RXLAB",49, 0) | |
| 17906 | S PSJNUM= $$FIND1^DI C(100.045, ","_PSJORD N_",","X", "DRUG","ID ") Q:'PSJN UM | |
| 17907 | "RTN","PSJ RXLAB",50, 0) | |
| 17908 | S PSCNT=P SCNT+1 | |
| 17909 | "RTN","PSJ RXLAB",51, 0) | |
| 17910 | S ^TMP($J ,"ORDERNUM ",PSCNT)=P SJORDN | |
| 17911 | "RTN","PSJ RXLAB",52, 0) | |
| 17912 | S PSJDGN= $$GET1^DIQ (100.045,P SJNUM_","_ PSJORDN,1, "I"),PSJDR UGN=$$GET1 ^DIQ(50,PS JDGN,.01) | |
| 17913 | "RTN","PSJ RXLAB",53, 0) | |
| 17914 | Q:'$G(PSJ DGN) I PS JDRUGN'[PS JDRUG Q | |
| 17915 | "RTN","PSJ RXLAB",54, 0) | |
| 17916 | S PSJPROV =$$GET1^DI Q(100,PSJO RDN,1,"I") Q:'PSJPRO V | |
| 17917 | "RTN","PSJ RXLAB",55, 0) | |
| 17918 | S PSJPROV N=$$GET1^D IQ(200,PSJ PROV,.01), PSJPROT=$$ GET1^DIQ(2 00,PSJPROV ,9.21,"I") | |
| 17919 | "RTN","PSJ RXLAB",56, 0) | |
| 17920 | S PSJTYPE ="NONE" I PSJPROT S PSJTYPE=$P ("FULL TIM E^PART TIM E^C & A^FE E^STAFF"," ^",PSJPROT ) | |
| 17921 | "RTN","PSJ RXLAB",57, 0) | |
| 17922 | CHECK2 ; | |
| 17923 | "RTN","PSJ RXLAB",58, 0) | |
| 17924 | S PSJPT=+ $$GET1^DIQ (100,PSJOR DN,.02,"I" ) Q:'PSJPT W ! S DF N=PSJPT D PID^VADPT, PRINT2 | |
| 17925 | "RTN","PSJ RXLAB",59, 0) | |
| 17926 | S LRDFN=$ $GET1^DIQ( 2,PSJPT,63 ,"I") | |
| 17927 | "RTN","PSJ RXLAB",60, 0) | |
| 17928 | I 'LRDFN W ?55,"No lab data e xists",?81 ,$E(PSJPRO VN,1,20),? 106,PSJTYP E,! D:PSJA NS["Y"!(PS JANS["y") PSJORDNI Q | |
| 17929 | "RTN","PSJ RXLAB",61, 0) | |
| 17930 | S PSJLBEN T=0,PSJIND IC=0 | |
| 17931 | "RTN","PSJ RXLAB",62, 0) | |
| 17932 | LOOP3 ; | |
| 17933 | "RTN","PSJ RXLAB",63, 0) | |
| 17934 | N LRARRAY ,RESULT D LIST^DIC(6 3.04,","_L RDFN_",",, "I",,LDATE ,,,,,"LRAR RAY") | |
| 17935 | "RTN","PSJ RXLAB",64, 0) | |
| 17936 | F J2=1:1 Q:'$D(LRAR RAY("DILIS T",1,J2)) S PSJLDAT E=LRARRAY( "DILIST",1 ,J2) Q:PSJ LDATE>PSJB D | |
| 17937 | "RTN","PSJ RXLAB",65, 0) | |
| 17938 | I J2>1 S J2=J2-1,PS JLDATE=LRA RRAY("DILI ST",1,J2), PSJLBENT=L RARRAY("DI LIST",2,J2 ) D CHECK3 Q:$G(PSJL ABQ) | |
| 17939 | "RTN","PSJ RXLAB",66, 0) | |
| 17940 | I PSJINDI C=0 W ?55, "NO LAB DA TA IN RANG E",?81,$E( PSJPROVN,1 ,20),?106, PSJTYPE,! | |
| 17941 | "RTN","PSJ RXLAB",67, 0) | |
| 17942 | D:PSJANS[ "Y" PSJORD NI | |
| 17943 | "RTN","PSJ RXLAB",68, 0) | |
| 17944 | I $D(RESU LT(3)) F J 4=3:1 Q:'$ D(RESULT(J 4)) W ?55 ,RESULT(J4 ),! I $Y>( IOSL-6) D Q:$G(PSJL ABQ) W @I OF,SITE,! D HDR2 | |
| 17945 | "RTN","PSJ RXLAB",69, 0) | |
| 17946 | .I $E(IOS T)="C" K D IR S DIR(0 )="E" D ^D IR S:$D(DT OUT)!($D(D UOUT)) PSJ LABQ=1 | |
| 17947 | "RTN","PSJ RXLAB",70, 0) | |
| 17948 | Q | |
| 17949 | "RTN","PSJ RXLAB",71, 0) | |
| 17950 | CHECK3 ; | |
| 17951 | "RTN","PSJ RXLAB",72, 0) | |
| 17952 | N ARR,KEY ,TERM K RE SULT S RES ULT="",KEY =PSJLBENT_ ","_LRDFN D GETS^DIQ (63.04,KEY ,"*","I"," ARR") S KE Y=KEY_"," | |
| 17953 | "RTN","PSJ RXLAB",73, 0) | |
| 17954 | ; Loading of multip le results commented out MZR | |
| 17955 | "RTN","PSJ RXLAB",74, 0) | |
| 17956 | ;S J3=1 F S J3=$O( ARR(63.04, KEY,J3)) Q :'J3 I AR R(63.04,KE Y,J3,"I") D | |
| 17957 | "RTN","PSJ RXLAB",75, 0) | |
| 17958 | ;.I RESUL T'="" S RE SULT($I(TE RM))=$P(^D D(63.04,J3 ,0),"^")_" :"_ARR(63. 04,KEY,J3, "I") Q | |
| 17959 | "RTN","PSJ RXLAB",76, 0) | |
| 17960 | ;.S RESUL T=$P(^DD(6 3.04,J3,0) ,"^")_":"_ ARR(63.04, KEY,J3,"I" ) | |
| 17961 | "RTN","PSJ RXLAB",77, 0) | |
| 17962 | I $D(ARR( 63.04,KEY, PSJLABT,"I ")) S RESU LT=$P(^DD( 63.04,PSJL ABT,0),"^" )_":"_ARR( 63.04,KEY, PSJLABT,"I ") | |
| 17963 | "RTN","PSJ RXLAB",78, 0) | |
| 17964 | I RESULT' ="" D RESU LT | |
| 17965 | "RTN","PSJ RXLAB",79, 0) | |
| 17966 | Q | |
| 17967 | "RTN","PSJ RXLAB",80, 0) | |
| 17968 | RESULT Q:A RR(63.04,K EY,.05,"I" )'=PSJSP Q:'ARR(63. 04,KEY,.03 ,"I") | |
| 17969 | "RTN","PSJ RXLAB",81, 0) | |
| 17970 | S Y=PSJLD ATE X ^DD( "DD") W ?5 5,$E(Y,1,1 1),?68,RES ULT,! ;$P( ^LR(LRDFN, "CH",PSJLB ENT,PSJLAB T),"^")_" "_PSJUNIT, ?81,$E(PSJ PROVN,1,20 ),?106,PSJ TYPE W ! | |
| 17971 | "RTN","PSJ RXLAB",82, 0) | |
| 17972 | S PSJINDI C=1 Q | |
| 17973 | "RTN","PSJ RXLAB",83, 0) | |
| 17974 | Q | |
| 17975 | "RTN","PSJ RXLAB",84, 0) | |
| 17976 | PRINT2 I $ Y>(IOSL-6) D Q:$G(P SJLABQ) W @IOF,SITE ,! D HDR2 | |
| 17977 | "RTN","PSJ RXLAB",85, 0) | |
| 17978 | .I $E(IOS T)="C" K D IR S DIR(0 )="E" D ^D IR S:$D(DT OUT)!($D(D UOUT)) PSJ LABQ=1 | |
| 17979 | "RTN","PSJ RXLAB",86, 0) | |
| 17980 | W ?1,$E($ $GET1^DIQ( 2,PSJPT,.0 1),1,20),? 25,VA("PID ") S Y=PSJ BD X ^DD(" DD") W ?37 ,Y | |
| 17981 | "RTN","PSJ RXLAB",87, 0) | |
| 17982 | Q | |
| 17983 | "RTN","PSJ RXLAB",88, 0) | |
| 17984 | HDR W SITE ,!!,"Patie nts receiv ing "_PSJD RUG_" with fills bet ween "_PSJ BDR_" and "_PSJEDR,! ," with da te of coll ection and results f or lab tes t "_PSJLAB TN_" after ",LDATER, ! | |
| 17985 | "RTN","PSJ RXLAB",89, 0) | |
| 17986 | HDR2 S PAG E=PAGE+1 W !,"Name", ?25,"ID#", ?37,"Fill Date",?55, "Lab Date" ,?68,"Resu lts",?81," Order Prov ider",?106 ,"Type",?1 16,"Page " _PAGE,! | |
| 17987 | "RTN","PSJ RXLAB",90, 0) | |
| 17988 | F J=1:1:I OM-1 W "_" | |
| 17989 | "RTN","PSJ RXLAB",91, 0) | |
| 17990 | W ! Q | |
| 17991 | "RTN","PSJ RXLAB",92, 0) | |
| 17992 | PSJORDNI N DTOUT,DUO UT Q:$G(PS JLABQ) W "Order #: "_$$GET1^D IQ(100,PSJ ORDN,.01)_ " Drug: "_$$GET1^D IQ(50,PSJD GN,.01) | |
| 17993 | "RTN","PSJ RXLAB",93, 0) | |
| 17994 | I $D(RESU LT)>1 W ?5 5,RESULT(1 ) | |
| 17995 | "RTN","PSJ RXLAB",94, 0) | |
| 17996 | N SIGNUM S SIGNUM=$ $FIND1^DIC (100.045," ,"_PSJORDN _",","X"," SIG","ID") | |
| 17997 | "RTN","PSJ RXLAB",95, 0) | |
| 17998 | W !?1,"Si g: ",$$GET 1^DIQ(100. 0451,"1,"_ SIGNUM_"," _PSJORDN,. 01) | |
| 17999 | "RTN","PSJ RXLAB",96, 0) | |
| 18000 | I $D(RESU LT(2)) W ? 55,RESULT( 2) | |
| 18001 | "RTN","PSJ RXLAB",97, 0) | |
| 18002 | I $Y>(IOS L-6) D Q: $G(PSJLABQ ) W @IOF, SITE,! D H DR2 | |
| 18003 | "RTN","PSJ RXLAB",98, 0) | |
| 18004 | .I $E(IOS T)="C" K D IR S DIR(0 )="E" D ^D IR S:$D(DT OUT)!($D(D UOUT)) PSJ LABQ=1 | |
| 18005 | "RTN","PSJ RXLAB",99, 0) | |
| 18006 | W ! Q | |
| 18007 | "RTN","PSJ RXLAB",100 ,0) | |
| 18008 | CLEAN I $L ($G(IOF)) W @IOF | |
| 18009 | "RTN","PSJ RXLAB",101 ,0) | |
| 18010 | D ^%ZISC S:$D(ZTQUE UED) ZTREQ ="@" | |
| 18011 | "RTN","PSJ RXLAB",102 ,0) | |
| 18012 | CLEAN2 K P SJINDIC,PS JPT,PSJLDA TE,PAGE,PS JBD,PSJBDR ,PSJLBENT, PSJLABT,PS JDGN,PSJDR UGN,PSJDRU G,J,J1,J2, PSJORDN,PS JPROV,PSJP ROVN,LDATE ,LDATER,PS JED,PSJEDR ,PSJPROT,P SJTYPE,PSJ LABTN,PSJL BT,PSJSP,P SJUNIT,PSJ ANS,DIC,LR DFN,POP,SI TE,Y,%DT,P SJLABQ | |
| 18013 | "RTN","PSJ RXLAB",103 ,0) | |
| 18014 | K ZTDESC, ZTRTN,ZTSA VE,%ZIS,^T MP($J,"ORD ERNUM"),^T MP($J,"PSO RDT") Q | |
| 18015 | "RTN","PSJ RXLAB",104 ,0) | |
| 18016 | ; | |
| 18017 | "RTN","PSJ RXLAB",105 ,0) | |
| 18018 | FQUIT Q | |
| 18019 | "SEC","^DI C",53.8,53 .8,0,"AUDI T") | |
| 18020 | @ | |
| 18021 | "SEC","^DI C",53.8,53 .8,0,"DD") | |
| 18022 | @ | |
| 18023 | "SEC","^DI C",53.8,53 .8,0,"DEL" ) | |
| 18024 | @ | |
| 18025 | "SEC","^DI C",53.8,53 .8,0,"LAYG O") | |
| 18026 | @ | |
| 18027 | "SEC","^DI C",53.8,53 .8,0,"RD") | |
| 18028 | @ | |
| 18029 | "SEC","^DI C",53.8,53 .8,0,"WR") | |
| 18030 | @ | |
| 18031 | "UP",55,55 .06,-1) | |
| 18032 | 55^5 | |
| 18033 | "UP",55,55 .06,0) | |
| 18034 | 55.06 | |
| 18035 | "VER") | |
| 18036 | 8.0^22.2 | |
| 18037 | "^DD",53.8 ,53.8,0) | |
| 18038 | FIELD^^2^7 | |
| 18039 | "^DD",53.8 ,53.8,0,"D T") | |
| 18040 | 3160516 | |
| 18041 | "^DD",53.8 ,53.8,0,"I X","A",53. 8,1) | |
| 18042 | ||
| 18043 | "^DD",53.8 ,53.8,0,"I X","B",53. 8,.01) | |
| 18044 | ||
| 18045 | "^DD",53.8 ,53.8,0,"N M","CLOZAP INE MEDICA TION OVERR IDES") | |
| 18046 | ||
| 18047 | "^DD",53.8 ,53.8,0,"V RPK") | |
| 18048 | PSJ | |
| 18049 | "^DD",53.8 ,53.8,.01, 0) | |
| 18050 | DATE TIME^ MRDI^^0;1^ S %DT="EST XR" D ^%DT S X=Y K:X <1 X | |
| 18051 | "^DD",53.8 ,53.8,.01, 1,0) | |
| 18052 | ^.1 | |
| 18053 | "^DD",53.8 ,53.8,.01, 1,1,0) | |
| 18054 | 53.8^B | |
| 18055 | "^DD",53.8 ,53.8,.01, 1,1,1) | |
| 18056 | S ^PS(53.8 ,"B",$E(X, 1,30),DA)= "" | |
| 18057 | "^DD",53.8 ,53.8,.01, 1,1,2) | |
| 18058 | K ^PS(53.8 ,"B",$E(X, 1,30),DA) | |
| 18059 | "^DD",53.8 ,53.8,.01, 3) | |
| 18060 | (No range limit on d ate) | |
| 18061 | "^DD",53.8 ,53.8,.01, 21,0) | |
| 18062 | ^^2^2^3160 310^ | |
| 18063 | "^DD",53.8 ,53.8,.01, 21,1,0) | |
| 18064 | This is th e date and time of t he decisio n to overr ide the pr ohibition on | |
| 18065 | "^DD",53.8 ,53.8,.01, 21,2,0) | |
| 18066 | dispensing Clozaril. | |
| 18067 | "^DD",53.8 ,53.8,.01, "DT") | |
| 18068 | 3151222 | |
| 18069 | "^DD",53.8 ,53.8,1,0) | |
| 18070 | ORDER NUMB ER^RP100'I ^OR(100,^0 ;2^Q | |
| 18071 | "^DD",53.8 ,53.8,1,1, 0) | |
| 18072 | ^.1 | |
| 18073 | "^DD",53.8 ,53.8,1,1, 1,0) | |
| 18074 | 53.8^A | |
| 18075 | "^DD",53.8 ,53.8,1,1, 1,1) | |
| 18076 | S ^PS(53.8 ,"A",$E(X, 1,30),DA)= "" | |
| 18077 | "^DD",53.8 ,53.8,1,1, 1,2) | |
| 18078 | K ^PS(53.8 ,"A",$E(X, 1,30),DA) | |
| 18079 | "^DD",53.8 ,53.8,1,1, 1,"%D",0) | |
| 18080 | ^^1^1^3160 328^ | |
| 18081 | "^DD",53.8 ,53.8,1,1, 1,"%D",1,0 ) | |
| 18082 | Index on t he ORDER f ield (#1). | |
| 18083 | "^DD",53.8 ,53.8,1,1, 1,"DT") | |
| 18084 | 3160328 | |
| 18085 | "^DD",53.8 ,53.8,1,3) | |
| 18086 | Enter the order numb er. | |
| 18087 | "^DD",53.8 ,53.8,1,21 ,0) | |
| 18088 | ^.001^1^1^ 3160328^^^ | |
| 18089 | "^DD",53.8 ,53.8,1,21 ,1,0) | |
| 18090 | Contains t he order n umber. | |
| 18091 | "^DD",53.8 ,53.8,1,"D T") | |
| 18092 | 3160328 | |
| 18093 | "^DD",53.8 ,53.8,2,0) | |
| 18094 | USER ENTER ING^RP200' I^VA(200,^ 0;3^Q | |
| 18095 | "^DD",53.8 ,53.8,2,3) | |
| 18096 | Enter the name of th e individu al enterin g this ord er. | |
| 18097 | "^DD",53.8 ,53.8,2,21 ,0) | |
| 18098 | ^^1^1^3160 309^ | |
| 18099 | "^DD",53.8 ,53.8,2,21 ,1,0) | |
| 18100 | This recor ds the nam e of the i ndividual entering t he order. | |
| 18101 | "^DD",53.8 ,53.8,2,"D T") | |
| 18102 | 3160310 | |
| 18103 | "^DD",53.8 ,53.8,3,0) | |
| 18104 | APPROVING TEAM MEMBE R^RP200'I^ VA(200,^0; 4^Q | |
| 18105 | "^DD",53.8 ,53.8,3,3) | |
| 18106 | Enter the name of th e person w ho authori zed the or der to be filled. | |
| 18107 | "^DD",53.8 ,53.8,3,21 ,0) | |
| 18108 | ^^2^2^3160 309^ | |
| 18109 | "^DD",53.8 ,53.8,3,21 ,1,0) | |
| 18110 | This is th e member o f the cloz apine trea tment team who autho rized this | |
| 18111 | "^DD",53.8 ,53.8,3,21 ,2,0) | |
| 18112 | order to b e filled. | |
| 18113 | "^DD",53.8 ,53.8,3,"D T") | |
| 18114 | 3160310 | |
| 18115 | "^DD",53.8 ,53.8,4,0) | |
| 18116 | REASON FOR OVERRIDE^ RP52.54'I^ PS(52.54,^ 0;5^Q | |
| 18117 | "^DD",53.8 ,53.8,4,3) | |
| 18118 | Enter the reason for the overr ide. Input must be b etween 5 a nd 100 cha racters in length. | |
| 18119 | "^DD",53.8 ,53.8,4,21 ,0) | |
| 18120 | ^^2^2^3160 315^ | |
| 18121 | "^DD",53.8 ,53.8,4,21 ,1,0) | |
| 18122 | This field contains the reason for the C lozapine o verride as a pointer | |
| 18123 | "^DD",53.8 ,53.8,4,21 ,2,0) | |
| 18124 | to file 52 .54. It sh ould be be tween 5 an d 100 char acters in length. | |
| 18125 | "^DD",53.8 ,53.8,4,"D T") | |
| 18126 | 3160310 | |
| 18127 | "^DD",53.8 ,53.8,5,0) | |
| 18128 | COMMENTS^R FI^^0;6^K: $L(X)>200! ($L(X)<5) X | |
| 18129 | "^DD",53.8 ,53.8,5,3) | |
| 18130 | Enter comm ents descr ibing the reason to override t he lockout . Input m ust be bet ween 5 and 200 chara cters in l ength. | |
| 18131 | "^DD",53.8 ,53.8,5,21 ,0) | |
| 18132 | ^.001^1^1^ 3160315^^^ ^ | |
| 18133 | "^DD",53.8 ,53.8,5,21 ,1,0) | |
| 18134 | This is an y informat ion about why the or der was fi lled. | |
| 18135 | "^DD",53.8 ,53.8,5,"D T") | |
| 18136 | 3160310 | |
| 18137 | "^DD",53.8 ,53.8,6,0) | |
| 18138 | SECOND APP ROVING TEA M MEMBER^R P200'^VA(2 00,^1;1^Q | |
| 18139 | "^DD",53.8 ,53.8,6,3) | |
| 18140 | Enter the name of th e approvin g team mem ber. | |
| 18141 | "^DD",53.8 ,53.8,6,21 ,0) | |
| 18142 | ^^1^1^3160 516^^ | |
| 18143 | "^DD",53.8 ,53.8,6,21 ,1,0) | |
| 18144 | This field records t he name as a pointer to file 2 00. | |
| 18145 | "^DD",53.8 ,53.8,6,"D T") | |
| 18146 | 3160516 | |
| 18147 | "^DD",55,5 5.06,301,0 ) | |
| 18148 | CLOZAPINE DOSAGE (MG /DAY)^NJ4, 0^^SAND;1^ K:+X'=X!(X >3000)!(X< 0)!(X?.E1" ."1N.N) X | |
| 18149 | "^DD",55,5 5.06,301,3 ) | |
| 18150 | Type a num ber betwee n 0 and 30 00, 0 deci mal digits . | |
| 18151 | "^DD",55,5 5.06,301,2 1,0) | |
| 18152 | ^^2^2^3160 606^ | |
| 18153 | "^DD",55,5 5.06,301,2 1,1,0) | |
| 18154 | This is th e total da ily dosage of clozap ine if thi s order is | |
| 18155 | "^DD",55,5 5.06,301,2 1,2,0) | |
| 18156 | for the dr ug clozapi ne. This is used on ly for clo zapine. | |
| 18157 | "^DD",55,5 5.06,301," DT") | |
| 18158 | 3160606 | |
| 18159 | "^DIC",53. 8,53.8,0) | |
| 18160 | CLOZAPINE MEDICATION OVERRIDES ^53.8 | |
| 18161 | "^DIC",53. 8,53.8,0," GL") | |
| 18162 | ^PS(53.8, | |
| 18163 | "^DIC",53. 8,53.8,"%" ,0) | |
| 18164 | ^1.005^^0 | |
| 18165 | "^DIC",53. 8,53.8,"%D ",0) | |
| 18166 | ^^12^12^31 60310^ | |
| 18167 | "^DIC",53. 8,53.8,"%D ",1,0) | |
| 18168 | This file contains i nformation regarding who, when and why t he | |
| 18169 | "^DIC",53. 8,53.8,"%D ",2,0) | |
| 18170 | prohibitio n on a ord er for clo zapine was overridde n | |
| 18171 | "^DIC",53. 8,53.8,"%D ",3,0) | |
| 18172 | member of the team. Because o f the natu re of this drug and the | |
| 18173 | "^DIC",53. 8,53.8,"%D ",4,0) | |
| 18174 | restrictio ns placed upon dispe nsing it, all fields in this f ile | |
| 18175 | "^DIC",53. 8,53.8,"%D ",5,0) | |
| 18176 | are not to be edited through t he VA File Manager, b ut are to be set | |
| 18177 | "^DIC",53. 8,53.8,"%D ",6,0) | |
| 18178 | ONLY throu gh the ord er entry o ptions of the inpati ent pharma cy | |
| 18179 | "^DIC",53. 8,53.8,"%D ",7,0) | |
| 18180 | package. Reports ge nerated fr om this fi le should be generat ed only | |
| 18181 | "^DIC",53. 8,53.8,"%D ",8,0) | |
| 18182 | from the o ption prov ided by th e package. For thes e reasons, READ, | |
| 18183 | "^DIC",53. 8,53.8,"%D ",9,0) | |
| 18184 | WRITE, DEL ETE and LA YGO access to this f ile are se verely res tricted. | |
| 18185 | "^DIC",53. 8,53.8,"%D ",10,0) | |
| 18186 | ||
| 18187 | "^DIC",53. 8,53.8,"%D ",11,0) | |
| 18188 | UNDER NO C IRCUMSTANC ES SHOULD THE DATA D ICTIONARY FOR THIS F ILE | |
| 18189 | "^DIC",53. 8,53.8,"%D ",12,0) | |
| 18190 | BE MO DIFIED | |
| 18191 | "^DIC",53. 8,"B","CLO ZAPINE MED ICATION OV ERRIDES",5 3.8) | |
| 18192 | ||
| 18193 | **INSTALL NAME** | |
| 18194 | OR*3.0*427 | |
| 18195 | "BLD",1003 6,0) | |
| 18196 | OR*3.0*427 ^ORDER ENT RY/RESULTS REPORTING ^0^3171026 ^y | |
| 18197 | "BLD",1003 6,1,0) | |
| 18198 | ^^1^1^3161 213^^ | |
| 18199 | "BLD",1003 6,1,1,0) | |
| 18200 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 18201 | "BLD",1003 6,4,0) | |
| 18202 | ^9.64PA^^ | |
| 18203 | "BLD",1003 6,6.3) | |
| 18204 | 61 | |
| 18205 | "BLD",1003 6,"INID") | |
| 18206 | ^n | |
| 18207 | "BLD",1003 6,"INIT") | |
| 18208 | ORY427ES | |
| 18209 | "BLD",1003 6,"KRN",0) | |
| 18210 | ^9.67PA^77 9.2^20 | |
| 18211 | "BLD",1003 6,"KRN",.4 ,0) | |
| 18212 | .4 | |
| 18213 | "BLD",1003 6,"KRN",.4 01,0) | |
| 18214 | .401 | |
| 18215 | "BLD",1003 6,"KRN",.4 02,0) | |
| 18216 | .402 | |
| 18217 | "BLD",1003 6,"KRN",.4 03,0) | |
| 18218 | .403 | |
| 18219 | "BLD",1003 6,"KRN",.5 ,0) | |
| 18220 | .5 | |
| 18221 | "BLD",1003 6,"KRN",.8 4,0) | |
| 18222 | .84 | |
| 18223 | "BLD",1003 6,"KRN",3. 6,0) | |
| 18224 | 3.6 | |
| 18225 | "BLD",1003 6,"KRN",3. 8,0) | |
| 18226 | 3.8 | |
| 18227 | "BLD",1003 6,"KRN",9. 2,0) | |
| 18228 | 9.2 | |
| 18229 | "BLD",1003 6,"KRN",9. 8,0) | |
| 18230 | 9.8 | |
| 18231 | "BLD",1003 6,"KRN",9. 8,"NM",0) | |
| 18232 | ^9.68A^15^ 15 | |
| 18233 | "BLD",1003 6,"KRN",9. 8,"NM",1,0 ) | |
| 18234 | ORY4270^^0 ^B15564639 | |
| 18235 | "BLD",1003 6,"KRN",9. 8,"NM",2,0 ) | |
| 18236 | ORY4271^^0 ^B40435115 | |
| 18237 | "BLD",1003 6,"KRN",9. 8,"NM",3,0 ) | |
| 18238 | ORY4272^^0 ^B26767346 | |
| 18239 | "BLD",1003 6,"KRN",9. 8,"NM",4,0 ) | |
| 18240 | ORY4273^^0 ^B12998366 | |
| 18241 | "BLD",1003 6,"KRN",9. 8,"NM",5,0 ) | |
| 18242 | ORY4274^^0 ^B13528386 | |
| 18243 | "BLD",1003 6,"KRN",9. 8,"NM",6,0 ) | |
| 18244 | ORY42701^^ 0^B7074991 1 | |
| 18245 | "BLD",1003 6,"KRN",9. 8,"NM",7,0 ) | |
| 18246 | ORY42702^^ 0^B7801413 3 | |
| 18247 | "BLD",1003 6,"KRN",9. 8,"NM",8,0 ) | |
| 18248 | ORY42703^^ 0^B7832555 7 | |
| 18249 | "BLD",1003 6,"KRN",9. 8,"NM",9,0 ) | |
| 18250 | ORY42704^^ 0^B8364476 1 | |
| 18251 | "BLD",1003 6,"KRN",9. 8,"NM",10, 0) | |
| 18252 | ORY42705^^ 0^B6250124 2 | |
| 18253 | "BLD",1003 6,"KRN",9. 8,"NM",11, 0) | |
| 18254 | ORY42706^^ 0^B6755364 8 | |
| 18255 | "BLD",1003 6,"KRN",9. 8,"NM",12, 0) | |
| 18256 | ORY42707^^ 0^B6952583 0 | |
| 18257 | "BLD",1003 6,"KRN",9. 8,"NM",13, 0) | |
| 18258 | ORY42708^^ 0^B3461451 0 | |
| 18259 | "BLD",1003 6,"KRN",9. 8,"NM",14, 0) | |
| 18260 | ORY427ES^^ 0^B1259661 0 | |
| 18261 | "BLD",1003 6,"KRN",9. 8,"NM",15, 0) | |
| 18262 | ORALWORD^^ 0^B8568964 8 | |
| 18263 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORALWORD ",15) | |
| 18264 | ||
| 18265 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY4270" ,1) | |
| 18266 | ||
| 18267 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42701 ",6) | |
| 18268 | ||
| 18269 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42702 ",7) | |
| 18270 | ||
| 18271 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42703 ",8) | |
| 18272 | ||
| 18273 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42704 ",9) | |
| 18274 | ||
| 18275 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42705 ",10) | |
| 18276 | ||
| 18277 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42706 ",11) | |
| 18278 | ||
| 18279 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42707 ",12) | |
| 18280 | ||
| 18281 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY42708 ",13) | |
| 18282 | ||
| 18283 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY4271" ,2) | |
| 18284 | ||
| 18285 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY4272" ,3) | |
| 18286 | ||
| 18287 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY4273" ,4) | |
| 18288 | ||
| 18289 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY4274" ,5) | |
| 18290 | ||
| 18291 | "BLD",1003 6,"KRN",9. 8,"NM","B" ,"ORY427ES ",14) | |
| 18292 | ||
| 18293 | "BLD",1003 6,"KRN",19 ,0) | |
| 18294 | 19 | |
| 18295 | "BLD",1003 6,"KRN",19 .1,0) | |
| 18296 | 19.1 | |
| 18297 | "BLD",1003 6,"KRN",10 1,0) | |
| 18298 | 101 | |
| 18299 | "BLD",1003 6,"KRN",40 9.61,0) | |
| 18300 | 409.61 | |
| 18301 | "BLD",1003 6,"KRN",77 1,0) | |
| 18302 | 771 | |
| 18303 | "BLD",1003 6,"KRN",77 9.2,0) | |
| 18304 | 779.2 | |
| 18305 | "BLD",1003 6,"KRN",87 0,0) | |
| 18306 | 870 | |
| 18307 | "BLD",1003 6,"KRN",89 89.51,0) | |
| 18308 | 8989.51 | |
| 18309 | "BLD",1003 6,"KRN",89 89.52,0) | |
| 18310 | 8989.52 | |
| 18311 | "BLD",1003 6,"KRN",89 94,0) | |
| 18312 | 8994 | |
| 18313 | "BLD",1003 6,"KRN","B ",.4,.4) | |
| 18314 | ||
| 18315 | "BLD",1003 6,"KRN","B ",.401,.40 1) | |
| 18316 | ||
| 18317 | "BLD",1003 6,"KRN","B ",.402,.40 2) | |
| 18318 | ||
| 18319 | "BLD",1003 6,"KRN","B ",.403,.40 3) | |
| 18320 | ||
| 18321 | "BLD",1003 6,"KRN","B ",.5,.5) | |
| 18322 | ||
| 18323 | "BLD",1003 6,"KRN","B ",.84,.84) | |
| 18324 | ||
| 18325 | "BLD",1003 6,"KRN","B ",3.6,3.6) | |
| 18326 | ||
| 18327 | "BLD",1003 6,"KRN","B ",3.8,3.8) | |
| 18328 | ||
| 18329 | "BLD",1003 6,"KRN","B ",9.2,9.2) | |
| 18330 | ||
| 18331 | "BLD",1003 6,"KRN","B ",9.8,9.8) | |
| 18332 | ||
| 18333 | "BLD",1003 6,"KRN","B ",19,19) | |
| 18334 | ||
| 18335 | "BLD",1003 6,"KRN","B ",19.1,19. 1) | |
| 18336 | ||
| 18337 | "BLD",1003 6,"KRN","B ",101,101) | |
| 18338 | ||
| 18339 | "BLD",1003 6,"KRN","B ",409.61,4 09.61) | |
| 18340 | ||
| 18341 | "BLD",1003 6,"KRN","B ",771,771) | |
| 18342 | ||
| 18343 | "BLD",1003 6,"KRN","B ",779.2,77 9.2) | |
| 18344 | ||
| 18345 | "BLD",1003 6,"KRN","B ",870,870) | |
| 18346 | ||
| 18347 | "BLD",1003 6,"KRN","B ",8989.51, 8989.51) | |
| 18348 | ||
| 18349 | "BLD",1003 6,"KRN","B ",8989.52, 8989.52) | |
| 18350 | ||
| 18351 | "BLD",1003 6,"KRN","B ",8994,899 4) | |
| 18352 | ||
| 18353 | "BLD",1003 6,"QDEF") | |
| 18354 | ^^^^NO^^^^ NO^^NO | |
| 18355 | "BLD",1003 6,"QUES",0 ) | |
| 18356 | ^9.62^^ | |
| 18357 | "BLD",1003 6,"REQB",0 ) | |
| 18358 | ^9.611^1^1 | |
| 18359 | "BLD",1003 6,"REQB",1 ,0) | |
| 18360 | OR*3.0*243 ^2 | |
| 18361 | "BLD",1003 6,"REQB"," B","OR*3.0 *243",1) | |
| 18362 | ||
| 18363 | "INIT") | |
| 18364 | ORY427ES | |
| 18365 | "MBREQ") | |
| 18366 | 0 | |
| 18367 | "PKG",188, -1) | |
| 18368 | 1^1 | |
| 18369 | "PKG",188, 0) | |
| 18370 | ORDER ENTR Y/RESULTS REPORTING^ OR^Order E ntry/Resul ts Reporti ng | |
| 18371 | "PKG",188, 22,0) | |
| 18372 | ^9.49I^1^1 | |
| 18373 | "PKG",188, 22,1,0) | |
| 18374 | 3.0^297121 7^2981113^ 1 | |
| 18375 | "PKG",188, 22,1,"PAH" ,1,0) | |
| 18376 | 427^317102 6^52073644 9 | |
| 18377 | "PKG",188, 22,1,"PAH" ,1,1,0) | |
| 18378 | ^^1^1^3171 026 | |
| 18379 | "PKG",188, 22,1,"PAH" ,1,1,1,0) | |
| 18380 | MENTAL HEA LTH NCC PR OJECT 5.01 | |
| 18381 | "QUES","XP F1",0) | |
| 18382 | Y | |
| 18383 | "QUES","XP F1","??") | |
| 18384 | ^D REP^XPD H | |
| 18385 | "QUES","XP F1","A") | |
| 18386 | Shall I wr ite over y our |FLAG| File | |
| 18387 | "QUES","XP F1","B") | |
| 18388 | YES | |
| 18389 | "QUES","XP F1","M") | |
| 18390 | D XPF1^XPD IQ | |
| 18391 | "QUES","XP F2",0) | |
| 18392 | Y | |
| 18393 | "QUES","XP F2","??") | |
| 18394 | ^D DTA^XPD H | |
| 18395 | "QUES","XP F2","A") | |
| 18396 | Want my da ta |FLAG| yours | |
| 18397 | "QUES","XP F2","B") | |
| 18398 | YES | |
| 18399 | "QUES","XP F2","M") | |
| 18400 | D XPF2^XPD IQ | |
| 18401 | "QUES","XP I1",0) | |
| 18402 | YO | |
| 18403 | "QUES","XP I1","??") | |
| 18404 | ^D INHIBIT ^XPDH | |
| 18405 | "QUES","XP I1","A") | |
| 18406 | Want KIDS to INHIBIT LOGONs du ring the i nstall | |
| 18407 | "QUES","XP I1","B") | |
| 18408 | NO | |
| 18409 | "QUES","XP I1","M") | |
| 18410 | D XPI1^XPD IQ | |
| 18411 | "QUES","XP M1",0) | |
| 18412 | PO^VA(200, :EM | |
| 18413 | "QUES","XP M1","??") | |
| 18414 | ^D MG^XPDH | |
| 18415 | "QUES","XP M1","A") | |
| 18416 | Enter the Coordinato r for Mail Group '|F LAG|' | |
| 18417 | "QUES","XP M1","B") | |
| 18418 | ||
| 18419 | "QUES","XP M1","M") | |
| 18420 | D XPM1^XPD IQ | |
| 18421 | "QUES","XP O1",0) | |
| 18422 | Y | |
| 18423 | "QUES","XP O1","??") | |
| 18424 | ^D MENU^XP DH | |
| 18425 | "QUES","XP O1","A") | |
| 18426 | Want KIDS to Rebuild Menu Tree s Upon Com pletion of Install | |
| 18427 | "QUES","XP O1","B") | |
| 18428 | NO | |
| 18429 | "QUES","XP O1","M") | |
| 18430 | D XPO1^XPD IQ | |
| 18431 | "QUES","XP Z1",0) | |
| 18432 | Y | |
| 18433 | "QUES","XP Z1","??") | |
| 18434 | ^D OPT^XPD H | |
| 18435 | "QUES","XP Z1","A") | |
| 18436 | Want to DI SABLE Sche duled Opti ons, Menu Options, a nd Protoco ls | |
| 18437 | "QUES","XP Z1","B") | |
| 18438 | NO | |
| 18439 | "QUES","XP Z1","M") | |
| 18440 | D XPZ1^XPD IQ | |
| 18441 | "QUES","XP Z2",0) | |
| 18442 | Y | |
| 18443 | "QUES","XP Z2","??") | |
| 18444 | ^D RTN^XPD H | |
| 18445 | "QUES","XP Z2","A") | |
| 18446 | Want to MO VE routine s to other CPUs | |
| 18447 | "QUES","XP Z2","B") | |
| 18448 | NO | |
| 18449 | "QUES","XP Z2","M") | |
| 18450 | D XPZ2^XPD IQ | |
| 18451 | "RTN") | |
| 18452 | 15 | |
| 18453 | "RTN","ORA LWORD") | |
| 18454 | 0^15^B8568 9648 | |
| 18455 | "RTN","ORA LWORD",1,0 ) | |
| 18456 | ORALWORD ; SLC/JMH - Utilities for Check ing if an order can be ordered ; 5/10/17 8:55am | |
| 18457 | "RTN","ORA LWORD",2,0 ) | |
| 18458 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**2 43,427**;D ec 17, 199 7;Build 61 | |
| 18459 | "RTN","ORA LWORD",3,0 ) | |
| 18460 | ; | |
| 18461 | "RTN","ORA LWORD",4,0 ) | |
| 18462 | ALLWORD(OR Y,DFN,ORX, ORTYPE,PRO V) ; | |
| 18463 | "RTN","ORA LWORD",5,0 ) | |
| 18464 | N OROI,OR YS,QOIEN,Q PIEN,ORCLO Z,QOAA | |
| 18465 | "RTN","ORA LWORD",6,0 ) | |
| 18466 | S OROI=0 | |
| 18467 | "RTN","ORA LWORD",7,0 ) | |
| 18468 | ; | |
| 18469 | "RTN","ORA LWORD",8,0 ) | |
| 18470 | ;ORTYPE u sed to det ermine the type of d ata coming into the call | |
| 18471 | "RTN","ORA LWORD",9,0 ) | |
| 18472 | ;ORYTPE=" E" existin g order, O RX equal t he IEN fro m file 100 (used wit h | |
| 18473 | "RTN","ORA LWORD",10, 0) | |
| 18474 | ;copy,edi t function ality) | |
| 18475 | "RTN","ORA LWORD",11, 0) | |
| 18476 | ;ORTYPE=" Q" Quick O rder, ORX equal the IEN from f ile 101.43 | |
| 18477 | "RTN","ORA LWORD",12, 0) | |
| 18478 | ;ORTYPE=" N" New ord er, ORX eq ual the IE N from fil e 101.41 | |
| 18479 | "RTN","ORA LWORD",13, 0) | |
| 18480 | ; | |
| 18481 | "RTN","ORA LWORD",14, 0) | |
| 18482 | I ORTYPE= "E" S OROI =$G(^OR(10 0,ORX,.1,1 ,0)) | |
| 18483 | "RTN","ORA LWORD",15, 0) | |
| 18484 | I ORTYPE= "Q" D | |
| 18485 | "RTN","ORA LWORD",16, 0) | |
| 18486 | .S QPIEN= $O(^ORD(10 1.41,"AB", "OR GTX OR DERABLE IT EM","")) Q :QPIEN'>0 | |
| 18487 | "RTN","ORA LWORD",17, 0) | |
| 18488 | .S QOIEN= $O(^ORD(10 1.41,ORX,6 ,"D",QPIEN ,"")) Q:QO IEN'>0 | |
| 18489 | "RTN","ORA LWORD",18, 0) | |
| 18490 | .S OROI=$ G(^ORD(101 .41,ORX,6, QOIEN,1)) | |
| 18491 | "RTN","ORA LWORD",19, 0) | |
| 18492 | .S QOAA=$ P($G(^ORD( 101.41,ORX ,5)),U,8) | |
| 18493 | "RTN","ORA LWORD",20, 0) | |
| 18494 | I ORTYPE= "N" S OROI =ORX | |
| 18495 | "RTN","ORA LWORD",21, 0) | |
| 18496 | Q:OROI'>0 | |
| 18497 | "RTN","ORA LWORD",22, 0) | |
| 18498 | S ORY=0 | |
| 18499 | "RTN","ORA LWORD",23, 0) | |
| 18500 | ;checks i f the orde rable item (OROI) is a clozapi ne med | |
| 18501 | "RTN","ORA LWORD",24, 0) | |
| 18502 | ; if not returns O RY=0 | |
| 18503 | "RTN","ORA LWORD",25, 0) | |
| 18504 | S ORCLOZ= $$ISCLOZ(O ROI),ORY=O RY_U_ORCLO Z,ORY(0)=U _ORCLOZ | |
| 18505 | "RTN","ORA LWORD",26, 0) | |
| 18506 | Q:'ORCLOZ | |
| 18507 | "RTN","ORA LWORD",27, 0) | |
| 18508 | N ORQUIT | |
| 18509 | "RTN","ORA LWORD",28, 0) | |
| 18510 | S ORQUIT= 0 | |
| 18511 | "RTN","ORA LWORD",29, 0) | |
| 18512 | I '$G(PRO V) S PROV= DUZ | |
| 18513 | "RTN","ORA LWORD",30, 0) | |
| 18514 | I $G(PROV ) D | |
| 18515 | "RTN","ORA LWORD",31, 0) | |
| 18516 | .I '$L($$ DEA^XUSER( ,PROV)) D | |
| 18517 | "RTN","ORA LWORD",32, 0) | |
| 18518 | ..S ORQUI T=1,ORY=1 | |
| 18519 | "RTN","ORA LWORD",33, 0) | |
| 18520 | ..S ORQUI T=1,ORY=1 | |
| 18521 | "RTN","ORA LWORD",34, 0) | |
| 18522 | ..S ORY(1 )="*** You are not a uthorized to place C lozapine o rders." | |
| 18523 | "RTN","ORA LWORD",35, 0) | |
| 18524 | ..S ORY(2 )="You mus t have a D EA#. Plea se contact your" | |
| 18525 | "RTN","ORA LWORD",36, 0) | |
| 18526 | ..S ORY(3 )="CAC or IRM for mo re informa tion. ***" | |
| 18527 | "RTN","ORA LWORD",37, 0) | |
| 18528 | .Q:ORQUIT | |
| 18529 | "RTN","ORA LWORD",38, 0) | |
| 18530 | .I '$D(^X USEC("YSCL AUTHORIZE D",PROV)) D | |
| 18531 | "RTN","ORA LWORD",39, 0) | |
| 18532 | ..S ORQUI T=1,ORY=1 | |
| 18533 | "RTN","ORA LWORD",40, 0) | |
| 18534 | ..S ORY(1 )="*** You are not a uthorized to place C lozapine o rders." | |
| 18535 | "RTN","ORA LWORD",41, 0) | |
| 18536 | ..S ORY(2 )="You mus t hold key YSCL AUTH ORIZED. P lease cont act your" | |
| 18537 | "RTN","ORA LWORD",42, 0) | |
| 18538 | ..S ORY(3 )="CAC or IRM for mo re informa tion on th is key. ** *" | |
| 18539 | "RTN","ORA LWORD",43, 0) | |
| 18540 | Q:ORQUIT | |
| 18541 | "RTN","ORA LWORD",44, 0) | |
| 18542 | ; if is a cloz med , check i f patient (DFN) can have a clo zapine med | |
| 18543 | "RTN","ORA LWORD",45, 0) | |
| 18544 | S ORYS=$$ CL^YSCLTST 2(DFN) | |
| 18545 | "RTN","ORA LWORD",46, 0) | |
| 18546 | ; if y es returns ORY=0 | |
| 18547 | "RTN","ORA LWORD",47, 0) | |
| 18548 | I +ORYS>0 D BEFQUIT Q | |
| 18549 | "RTN","ORA LWORD",48, 0) | |
| 18550 | ; if n o | |
| 18551 | "RTN","ORA LWORD",49, 0) | |
| 18552 | ; re turns | |
| 18553 | "RTN","ORA LWORD",50, 0) | |
| 18554 | ; ORY= 1 | |
| 18555 | "RTN","ORA LWORD",51, 0) | |
| 18556 | ; ORY( 0)=CAPTION FOR DIALO G BOX | |
| 18557 | "RTN","ORA LWORD",52, 0) | |
| 18558 | ; ORY( 1-N)=MESSA GE TO DISP LAY | |
| 18559 | "RTN","ORA LWORD",53, 0) | |
| 18560 | S ORY=1_U _ORCLOZ,OR Y(0)="Prob lem Orderi ng Clozapi ne Related Medicatio n"_U_ORCLO Z | |
| 18561 | "RTN","ORA LWORD",54, 0) | |
| 18562 | ;patient not in clo zapine pat ient progr am | |
| 18563 | "RTN","ORA LWORD",55, 0) | |
| 18564 | ;; START NCC REMEDI ATION >> 4 27*RJS | |
| 18565 | "RTN","ORA LWORD",56, 0) | |
| 18566 | I +ORYS<0 D Q | |
| 18567 | "RTN","ORA LWORD",57, 0) | |
| 18568 | .S ORY(1) ="*** This patient i s not regi stered in the clozap ine treatm ent " | |
| 18569 | "RTN","ORA LWORD",58, 0) | |
| 18570 | .S ORY(2) ="program or has bee n disconti nued from the progra m. A new" | |
| 18571 | "RTN","ORA LWORD",59, 0) | |
| 18572 | .S ORY(3) ="registra tion numbe r must be assigned. If this is not an em ergency," | |
| 18573 | "RTN","ORA LWORD",60, 0) | |
| 18574 | .S ORY(4) ="contact the NCCC. For emerge ncy regist ration dur ing non-NC CC duty" | |
| 18575 | "RTN","ORA LWORD",61, 0) | |
| 18576 | .S ORY(5) ="hours, a written o rder to th e pharmaci st can be used to pr ocess a" | |
| 18577 | "RTN","ORA LWORD",62, 0) | |
| 18578 | .S ORY(6) ="registra tion overr ide. ***" | |
| 18579 | "RTN","ORA LWORD",63, 0) | |
| 18580 | ;problem with lab t ests | |
| 18581 | "RTN","ORA LWORD",64, 0) | |
| 18582 | I +ORYS=0 D Q | |
| 18583 | "RTN","ORA LWORD",65, 0) | |
| 18584 | .I $$OVER RIDE^YSCLT ST2(DFN) S ORY=0_U_O RCLOZ,ORY( 0)=U_ORCLO Z D BEFQUI T Q ;ove rride allo wed | |
| 18585 | "RTN","ORA LWORD",66, 0) | |
| 18586 | .I +$P(OR YS,"^",2), $P(ORYS,"^ ",4)<1000 D | |
| 18587 | "RTN","ORA LWORD",67, 0) | |
| 18588 | ..N COUNT S COUNT=0 | |
| 18589 | "RTN","ORA LWORD",68, 0) | |
| 18590 | ..S COUNT =COUNT+1,O RY(COUNT)= "*** This clozapine drug may n ot be disp ensed to t he patient at this " | |
| 18591 | "RTN","ORA LWORD",69, 0) | |
| 18592 | ..S COUNT =COUNT+1,O RY(COUNT)= "time base d on the a vailable l ab tests r elated to the clozap ine " | |
| 18593 | "RTN","ORA LWORD",70, 0) | |
| 18594 | ..S COUNT =COUNT+1,O RY(COUNT)= "treatment program. Please con tact the N CCC to req uest an ov erride in" | |
| 18595 | "RTN","ORA LWORD",71, 0) | |
| 18596 | ..S COUNT =COUNT+1,O RY(COUNT)= "order to proceed wi th dispens ing this d rug. ***" | |
| 18597 | "RTN","ORA LWORD",72, 0) | |
| 18598 | ..D DISPR SLT | |
| 18599 | "RTN","ORA LWORD",73, 0) | |
| 18600 | .I '$P(OR YS,U,2),$P (ORYS,U,4) D | |
| 18601 | "RTN","ORA LWORD",74, 0) | |
| 18602 | ..N COUNT S COUNT=0 | |
| 18603 | "RTN","ORA LWORD",75, 0) | |
| 18604 | ..S COUNT =COUNT+1,O RY(COUNT)= "*** Permi ssion to d ispense cl ozapine ha s been den ied based on the ava ilable" | |
| 18605 | "RTN","ORA LWORD",76, 0) | |
| 18606 | ..S COUNT =COUNT+1,O RY(COUNT)= "lab tests related t o the cloz apine trea tment prog ram.***" | |
| 18607 | "RTN","ORA LWORD",77, 0) | |
| 18608 | ..S COUNT =COUNT+1,O RY(COUNT)= "" | |
| 18609 | "RTN","ORA LWORD",78, 0) | |
| 18610 | ..S COUNT =COUNT+1,O RY(COUNT)= "The lates t lab test results d rawn in th e past 7 d ays have A NC results but no" | |
| 18611 | "RTN","ORA LWORD",79, 0) | |
| 18612 | ..S COUNT =COUNT+1,O RY(COUNT)= "matching WBC. Redo the lab te sts or con tact the N CCC for a National O verride" | |
| 18613 | "RTN","ORA LWORD",80, 0) | |
| 18614 | ..S COUNT =COUNT+1,O RY(COUNT)= "to dispen se clozapi ne with no matching WBC result s." | |
| 18615 | "RTN","ORA LWORD",81, 0) | |
| 18616 | ..D DISPR SLT | |
| 18617 | "RTN","ORA LWORD",82, 0) | |
| 18618 | .I '+$P(O RYS,"^",4) D MSG | |
| 18619 | "RTN","ORA LWORD",83, 0) | |
| 18620 | Q | |
| 18621 | "RTN","ORA LWORD",84, 0) | |
| 18622 | MSG ; | |
| 18623 | "RTN","ORA LWORD",85, 0) | |
| 18624 | N COUNT S COUNT=0 | |
| 18625 | "RTN","ORA LWORD",86, 0) | |
| 18626 | S COUNT=C OUNT+1,ORY (COUNT)="* ** Permiss ion to dis pense cloz apine has been denie d based on the" | |
| 18627 | "RTN","ORA LWORD",87, 0) | |
| 18628 | S COUNT=C OUNT+1,ORY (COUNT)="a vailable l ab tests r elated to the clozap ine treatm ent progra m. ***" | |
| 18629 | "RTN","ORA LWORD",88, 0) | |
| 18630 | S COUNT=C OUNT+1,ORY (COUNT)="" | |
| 18631 | "RTN","ORA LWORD",89, 0) | |
| 18632 | I $P($G(X 0),U)["PSJ " D DISPRS LT S COUNT =COUNT+1,O RY(COUNT)= "" | |
| 18633 | "RTN","ORA LWORD",90, 0) | |
| 18634 | S COUNT=C OUNT+1,ORY (COUNT)="F or a Natio nal Overri de to disp ense at th e patient' s normal" | |
| 18635 | "RTN","ORA LWORD",91, 0) | |
| 18636 | S COUNT=C OUNT+1,ORY (COUNT)="f requency, contact th e NCCC." | |
| 18637 | "RTN","ORA LWORD",92, 0) | |
| 18638 | S COUNT=C OUNT+1,ORY (COUNT)="" | |
| 18639 | "RTN","ORA LWORD",93, 0) | |
| 18640 | D:$D(X0) ;; NCC RE MEDIATION << 427 RTW Special C onditions selections for outpa tient and inpatient RTW | |
| 18641 | "RTN","ORA LWORD",94, 0) | |
| 18642 | .I $P(X0, U,1)["PSO" D | |
| 18643 | "RTN","ORA LWORD",95, 0) | |
| 18644 | ..S COUNT =COUNT+1,O RY(COUNT)= "A local e mergency o verride fo r an Outpa tient can be approve d for:" | |
| 18645 | "RTN","ORA LWORD",96, 0) | |
| 18646 | ..S COUNT =COUNT+1,O RY(COUNT)= "(1) weath er-related condition s, (2) mai l order de lays of cl ozapine," | |
| 18647 | "RTN","ORA LWORD",97, 0) | |
| 18648 | ..S COUNT =COUNT+1,O RY(COUNT)= "or (3) in patient go ing on lea ve." | |
| 18649 | "RTN","ORA LWORD",98, 0) | |
| 18650 | ..S COUNT =COUNT+1,O RY(COUNT)= "" | |
| 18651 | "RTN","ORA LWORD",99, 0) | |
| 18652 | ..S COUNT =COUNT+1,O RY(COUNT)= "For an Ou tpatient S pecial Con ditions Lo cal Overri de, a writ ten prescr iption fro m" | |
| 18653 | "RTN","ORA LWORD",100 ,0) | |
| 18654 | ..S COUNT =COUNT+1,O RY(COUNT)= "the provi der with d ocumentati on to the pharmacist is requir ed to disp ense" | |
| 18655 | "RTN","ORA LWORD",101 ,0) | |
| 18656 | ..S COUNT =COUNT+1,O RY(COUNT)= "a one-tim e emergenc y 4-day su pply." | |
| 18657 | "RTN","ORA LWORD",102 ,0) | |
| 18658 | .I $P(X0, U,1)["PSJ" D | |
| 18659 | "RTN","ORA LWORD",103 ,0) | |
| 18660 | ..S COUNT =COUNT+1,O RY(COUNT)= "A local e mergency o verride fo r an Inpat ient can b e approved for:" | |
| 18661 | "RTN","ORA LWORD",104 ,0) | |
| 18662 | ..S COUNT =COUNT+1,O RY(COUNT)= "IP Order Override w ith Outsid e Lab Resu lts" | |
| 18663 | "RTN","ORA LWORD",105 ,0) | |
| 18664 | ..S COUNT =COUNT+1,O RY(COUNT)= "" | |
| 18665 | "RTN","ORA LWORD",106 ,0) | |
| 18666 | ..S COUNT =COUNT+1,O RY(COUNT)= "For a Spe cial Condi tions Loca l Override , a writte n order fr om" | |
| 18667 | "RTN","ORA LWORD",107 ,0) | |
| 18668 | ..S COUNT =COUNT+1,O RY(COUNT)= "the provi der with d ocumentati on to the pharmacist is requir ed to" | |
| 18669 | "RTN","ORA LWORD",108 ,0) | |
| 18670 | ..S COUNT =COUNT+1,O RY(COUNT)= "dispense a one-time 4-day sup ply." | |
| 18671 | "RTN","ORA LWORD",109 ,0) | |
| 18672 | ..S COUNT =COUNT+1,O RY(COUNT)= "" | |
| 18673 | "RTN","ORA LWORD",110 ,0) | |
| 18674 | ..S COUNT =COUNT+1,O RY(COUNT)= "The provi der must r ecord the ANC from a nother fac ility incl uding date /time in b oth the Pr ovider Pro gress Note and Comme nt field i n CPRS." | |
| 18675 | "RTN","ORA LWORD",111 ,0) | |
| 18676 | Q | |
| 18677 | "RTN","ORA LWORD",112 ,0) | |
| 18678 | DISPRSLT ; Display L ab Tests | |
| 18679 | "RTN","ORA LWORD",113 ,0) | |
| 18680 | S COUNT=C OUNT+1,ORY (COUNT)="R elated Lab Test(s)" | |
| 18681 | "RTN","ORA LWORD",114 ,0) | |
| 18682 | S COUNT=C OUNT+1,ORY (COUNT)="= ========== ========" | |
| 18683 | "RTN","ORA LWORD",115 ,0) | |
| 18684 | I $L($P(O RYS,U,3)) S COUNT=CO UNT+1,ORY( COUNT)="WB C: "_($P( ORYS,U,2)/ 1000)_" K/ cmm" | |
| 18685 | "RTN","ORA LWORD",116 ,0) | |
| 18686 | E S COUN T=COUNT+1, ORY(COUNT) ="WBC: NO TEST RESU LTS FOUND" | |
| 18687 | "RTN","ORA LWORD",117 ,0) | |
| 18688 | I $L($P(O RYS,U,5)) S COUNT=CO UNT+1,ORY( COUNT)="AN C: "_($P( ORYS,U,4)/ 1000)_" K/ cmm" | |
| 18689 | "RTN","ORA LWORD",118 ,0) | |
| 18690 | E S COUN T=COUNT+1, ORY(COUNT) ="ANC: NO TEST RESU LTS FOUND" | |
| 18691 | "RTN","ORA LWORD",119 ,0) | |
| 18692 | S COUNT=C OUNT+1,ORY (COUNT)="D ate/Time o f last tes ts: "_$$DA TE^ORU($P( ORYS,U,6)) | |
| 18693 | "RTN","ORA LWORD",120 ,0) | |
| 18694 | Q | |
| 18695 | "RTN","ORA LWORD",121 ,0) | |
| 18696 | ;; END NC C REMEDIAT ION << 427 *RTW | |
| 18697 | "RTN","ORA LWORD",122 ,0) | |
| 18698 | BEFQUIT ; | |
| 18699 | "RTN","ORA LWORD",123 ,0) | |
| 18700 | Q:'$G(QOA A) | |
| 18701 | "RTN","ORA LWORD",124 ,0) | |
| 18702 | N QODS,QO RF,ORMAX,O RCLPAT | |
| 18703 | "RTN","ORA LWORD",125 ,0) | |
| 18704 | S QODS=$O (^ORD(101. 41,"AB","O R GTX DAYS SUPPLY"," ")) Q:QODS '>0 | |
| 18705 | "RTN","ORA LWORD",126 ,0) | |
| 18706 | S QODS=$O (^ORD(101. 41,ORX,6," D",QODS,"" )) Q:QOIEN '>0 | |
| 18707 | "RTN","ORA LWORD",127 ,0) | |
| 18708 | S QODS=$G (^ORD(101. 41,ORX,6,Q ODS,1)) | |
| 18709 | "RTN","ORA LWORD",128 ,0) | |
| 18710 | S QORF=$O (^ORD(101. 41,"AB","O R GTX REFI LLS","")) Q:QORF'>0 | |
| 18711 | "RTN","ORA LWORD",129 ,0) | |
| 18712 | S QORF=$O (^ORD(101. 41,ORX,6," D",QORF,"" )) Q:QOIEN '>0 | |
| 18713 | "RTN","ORA LWORD",130 ,0) | |
| 18714 | S QORF=$G (^ORD(101. 41,ORX,6,Q ORF,1)) | |
| 18715 | "RTN","ORA LWORD",131 ,0) | |
| 18716 | S QORF=QO RF+1 | |
| 18717 | "RTN","ORA LWORD",132 ,0) | |
| 18718 | S ORCLPAT =$P(ORYS,U ,7) | |
| 18719 | "RTN","ORA LWORD",133 ,0) | |
| 18720 | S ORMAX=$ S(ORYS="M" :28,ORYS=" B":14,ORYS ="W":7,1:9 0) | |
| 18721 | "RTN","ORA LWORD",134 ,0) | |
| 18722 | I QORF*QO DS>ORMAX D | |
| 18723 | "RTN","ORA LWORD",135 ,0) | |
| 18724 | .K ORY | |
| 18725 | "RTN","ORA LWORD",136 ,0) | |
| 18726 | .S ORY=1_ U_ORCLOZ,O RY(0)="Pro blem Order ing Clozap ine Relate d Medicati on"_U_ORCL OZ | |
| 18727 | "RTN","ORA LWORD",137 ,0) | |
| 18728 | .S ORY(1) ="*** This patient i s only all owed an or der with a maximum D ays Supply of "_ORMA X_"." | |
| 18729 | "RTN","ORA LWORD",138 ,0) | |
| 18730 | .S ORY(2) ="This inc ludes the amounts ad ded by any refills e ntered in with the o rder also. " | |
| 18731 | "RTN","ORA LWORD",139 ,0) | |
| 18732 | Q | |
| 18733 | "RTN","ORA LWORD",140 ,0) | |
| 18734 | ISCLOZ(ORO I) ; | |
| 18735 | "RTN","ORA LWORD",141 ,0) | |
| 18736 | N ORPSOI, ORPSDRUG,I SCLOZ | |
| 18737 | "RTN","ORA LWORD",142 ,0) | |
| 18738 | S ORPSOI= $$GET1^DIQ (101.43,OR OI,2) | |
| 18739 | "RTN","ORA LWORD",143 ,0) | |
| 18740 | I $P(ORPS OI,";",2)' ="99PSP" Q 0 | |
| 18741 | "RTN","ORA LWORD",144 ,0) | |
| 18742 | K ^TMP($J ,"ORCLOZ") | |
| 18743 | "RTN","ORA LWORD",145 ,0) | |
| 18744 | D ASP^PSS 50(+ORPSOI ,,,"ORCLOZ ") | |
| 18745 | "RTN","ORA LWORD",146 ,0) | |
| 18746 | S (ORPSDR UG,ISCLOZ) =0 | |
| 18747 | "RTN","ORA LWORD",147 ,0) | |
| 18748 | F S ORPS DRUG=$O(^T MP($J,"ORC LOZ",ORPSD RUG)) Q:'O RPSDRUG D Q:ISCLOZ | |
| 18749 | "RTN","ORA LWORD",148 ,0) | |
| 18750 | .K ^TMP($ J,"ORCLOZ2 ") | |
| 18751 | "RTN","ORA LWORD",149 ,0) | |
| 18752 | .D CLOZ^P SS50(ORPSD RUG,,,,,"O RCLOZ2") | |
| 18753 | "RTN","ORA LWORD",150 ,0) | |
| 18754 | .S ISCLOZ =$G(^TMP($ J,"ORCLOZ2 ",ORPSDRUG ,"CLOZ",0) ) S ISCLOZ =$S(ISCLOZ ="":0,ISCL OZ'["NO DA TA FOUND": 1,1:0) | |
| 18755 | "RTN","ORA LWORD",151 ,0) | |
| 18756 | K ^TMP($J ,"ORCLOZ") ,^TMP($J," ORCLOZ2") | |
| 18757 | "RTN","ORA LWORD",152 ,0) | |
| 18758 | Q ISCLOZ | |
| 18759 | "RTN","ORA LWORD",153 ,0) | |
| 18760 | ALLWRN(ORY ,ORN,REFIL LS) ;allow order to be renewed | |
| 18761 | "RTN","ORA LWORD",154 ,0) | |
| 18762 | ;ORN is t he order n umber | |
| 18763 | "RTN","ORA LWORD",155 ,0) | |
| 18764 | ;REFILLS is the num ber of ref ills to be included with the r enewed ord er | |
| 18765 | "RTN","ORA LWORD",156 ,0) | |
| 18766 | N ORDS,OR QT,ORUPD,O RSCH,ORDUR ,ORDFN,ORD RG,OROI,OR MAXDS,ORMA XQT,ORCLOZ ,ORREF,ORM AXREF | |
| 18767 | "RTN","ORA LWORD",157 ,0) | |
| 18768 | ;default return 1 ( ORY=1 mean s allow re new) | |
| 18769 | "RTN","ORA LWORD",158 ,0) | |
| 18770 | S ORY=1 | |
| 18771 | "RTN","ORA LWORD",159 ,0) | |
| 18772 | ;get DFN (ORDFN) | |
| 18773 | "RTN","ORA LWORD",160 ,0) | |
| 18774 | S ORDFN=+ $P(^OR(100 ,ORN,0),U, 2) | |
| 18775 | "RTN","ORA LWORD",161 ,0) | |
| 18776 | Q:'ORDFN | |
| 18777 | "RTN","ORA LWORD",162 ,0) | |
| 18778 | ;get if o rder is a clozapine order (ORC LOZ) | |
| 18779 | "RTN","ORA LWORD",163 ,0) | |
| 18780 | S OROI=$G (^OR(100,O RN,.1,1,0) ) Q:'OROI | |
| 18781 | "RTN","ORA LWORD",164 ,0) | |
| 18782 | S ORCLOZ= $$ISCLOZ(O ROI) | |
| 18783 | "RTN","ORA LWORD",165 ,0) | |
| 18784 | ;quit if order is n ot clozapi ne | |
| 18785 | "RTN","ORA LWORD",166 ,0) | |
| 18786 | I 'ORCLOZ Q | |
| 18787 | "RTN","ORA LWORD",167 ,0) | |
| 18788 | ;get sche dule from order (ORS CH) | |
| 18789 | "RTN","ORA LWORD",168 ,0) | |
| 18790 | S ORSCH=$ G(^OR(100, ORN,4.5,$O (^OR(100,O RN,4.5,"ID ","SCHEDUL E",0)),1)) | |
| 18791 | "RTN","ORA LWORD",169 ,0) | |
| 18792 | ;get unit s per dose from orde r (ORUPD) | |
| 18793 | "RTN","ORA LWORD",170 ,0) | |
| 18794 | S ORSCH=$ G(^OR(100, ORN,4.5,$O (^OR(100,O RN,4.5,"ID ","DOSE",0 )),1)) | |
| 18795 | "RTN","ORA LWORD",171 ,0) | |
| 18796 | S ORSCH=$ P(ORSCH,"& ",3) | |
| 18797 | "RTN","ORA LWORD",172 ,0) | |
| 18798 | ;get dura tion from order (ORD UR) | |
| 18799 | "RTN","ORA LWORD",173 ,0) | |
| 18800 | I '$O(^OR (100,ORN,4 .5,"ID","D URATION",0 )) S ORDUR ="~^" | |
| 18801 | "RTN","ORA LWORD",174 ,0) | |
| 18802 | E S ORSC H=$G(^OR(1 00,ORN,4.5 ,$O(^OR(10 0,ORN,4.5, "ID","DURA TION",0)), 1)) | |
| 18803 | "RTN","ORA LWORD",175 ,0) | |
| 18804 | ;get days supply fr om order ( ORDS) | |
| 18805 | "RTN","ORA LWORD",176 ,0) | |
| 18806 | S ORSCH=$ G(^OR(100, ORN,4.5,$O (^OR(100,O RN,4.5,"ID ","SUPPLY" ,0)),1)) | |
| 18807 | "RTN","ORA LWORD",177 ,0) | |
| 18808 | ;get drug (ptr50) f rom order (ORDRG) | |
| 18809 | "RTN","ORA LWORD",178 ,0) | |
| 18810 | S ORSCH=$ G(^OR(100, ORN,4.5,$O (^OR(100,O RN,4.5,"ID ","DRUG",0 )),1)) | |
| 18811 | "RTN","ORA LWORD",179 ,0) | |
| 18812 | ;get refi lls from o rder (ORRE F) | |
| 18813 | "RTN","ORA LWORD",180 ,0) | |
| 18814 | S ORSCH=$ G(^OR(100, ORN,4.5,$O (^OR(100,O RN,4.5,"ID ","REFILLS ",0)),1)) | |
| 18815 | "RTN","ORA LWORD",181 ,0) | |
| 18816 | ;get quan tity from order (ORQ T) | |
| 18817 | "RTN","ORA LWORD",182 ,0) | |
| 18818 | S ORSCH=$ G(^OR(100, ORN,4.5,$O (^OR(100,O RN,4.5,"ID ","QTY",0) ),1)) | |
| 18819 | "RTN","ORA LWORD",183 ,0) | |
| 18820 | ;get max days suppl y for orde r (ORMAXDS ) | |
| 18821 | "RTN","ORA LWORD",184 ,0) | |
| 18822 | S ORMAXDS =$$DEFSPLY ^ORWDPS1(O RDFN) | |
| 18823 | "RTN","ORA LWORD",185 ,0) | |
| 18824 | ;if ds fr om order i s > max ds return 0 (ORY=0) | |
| 18825 | "RTN","ORA LWORD",186 ,0) | |
| 18826 | I ORDS>OR MAXDS D Q | |
| 18827 | "RTN","ORA LWORD",187 ,0) | |
| 18828 | .S ORY=0 | |
| 18829 | "RTN","ORA LWORD",188 ,0) | |
| 18830 | .S ORY(0) ="Problem Renewing C lozapine R elated Med ication"_U _ORCLOZ | |
| 18831 | "RTN","ORA LWORD",189 ,0) | |
| 18832 | .S ORY(1) ="The Days Supply se t for this order is greater th an the Max Days Supp ly" | |
| 18833 | "RTN","ORA LWORD",190 ,0) | |
| 18834 | .S ORY(2) =" allo wed for th is patient ." | |
| 18835 | "RTN","ORA LWORD",191 ,0) | |
| 18836 | ;get max quantity f or order ( ORMAXQT) | |
| 18837 | "RTN","ORA LWORD",192 ,0) | |
| 18838 | D DAY2QTY ^ORWDPS2(. ORMAXQT,OR DS,ORUPD,O RSCH,ORDUR ,ORDFN,ORD RG) | |
| 18839 | "RTN","ORA LWORD",193 ,0) | |
| 18840 | ;if qt fr om order i s > max qt return 0 (ORY=0) | |
| 18841 | "RTN","ORA LWORD",194 ,0) | |
| 18842 | I ORQT>OR MAXQT D Q | |
| 18843 | "RTN","ORA LWORD",195 ,0) | |
| 18844 | .S ORY=0 | |
| 18845 | "RTN","ORA LWORD",196 ,0) | |
| 18846 | .S ORY(0) ="Problem Renewing C lozapine R elated Med ication"_U _ORCLOZ | |
| 18847 | "RTN","ORA LWORD",197 ,0) | |
| 18848 | .S ORY(1) ="The Quan tity set f or this or der is gre ater than the Max Qu antity" | |
| 18849 | "RTN","ORA LWORD",198 ,0) | |
| 18850 | .S ORY(2) =" allo wed for th is patient ." | |
| 18851 | "RTN","ORA LWORD",199 ,0) | |
| 18852 | ;get max refills fo r order (O RMAXREF) | |
| 18853 | "RTN","ORA LWORD",200 ,0) | |
| 18854 | D MAXREF^ ORWDPS2(.O RMAXREF,OR DFN,ORDRG, ORDS,OROI, 1) | |
| 18855 | "RTN","ORA LWORD",201 ,0) | |
| 18856 | ;if refil l from ord er is > ma x refills return 0 ( ORY=0) | |
| 18857 | "RTN","ORA LWORD",202 ,0) | |
| 18858 | I ORREF>O RMAXREF D Q | |
| 18859 | "RTN","ORA LWORD",203 ,0) | |
| 18860 | .S ORY=0 | |
| 18861 | "RTN","ORA LWORD",204 ,0) | |
| 18862 | .S ORY(0) ="Problem Renewing C lozapine R elated Med ication"_U _ORCLOZ | |
| 18863 | "RTN","ORA LWORD",205 ,0) | |
| 18864 | .S ORY(1) ="The Refi lls field set for th is order i s greater than the R efills" | |
| 18865 | "RTN","ORA LWORD",206 ,0) | |
| 18866 | .S ORY(2) =" allo wed for th is patient with the order havi ng a Days Supply " | |
| 18867 | "RTN","ORA LWORD",207 ,0) | |
| 18868 | .S ORY(3) =" of " _ORDS_"." | |
| 18869 | "RTN","ORA LWORD",208 ,0) | |
| 18870 | Q | |
| 18871 | "RTN","ORY 4270") | |
| 18872 | 0^1^B15564 639 | |
| 18873 | "RTN","ORY 4270",1,0) | |
| 18874 | ORY4270 ;S LC/RJS,CLA - OCX PAC KAGE RULE TRANSPORT ROUTINE (D elete afte r Install of OR*3*42 7) ;MAR 7, 2017 at 15 :12 | |
| 18875 | "RTN","ORY 4270",2,0) | |
| 18876 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 18877 | "RTN","ORY 4270",3,0) | |
| 18878 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 18879 | "RTN","ORY 4270",4,0) | |
| 18880 | ; | |
| 18881 | "RTN","ORY 4270",5,0) | |
| 18882 | S ; | |
| 18883 | "RTN","ORY 4270",6,0) | |
| 18884 | ; | |
| 18885 | "RTN","ORY 4270",7,0) | |
| 18886 | Q | |
| 18887 | "RTN","ORY 4270",8,0) | |
| 18888 | ; | |
| 18889 | "RTN","ORY 4270",9,0) | |
| 18890 | WARN(RTN,M SG,LINES) ; | |
| 18891 | "RTN","ORY 4270",10,0 ) | |
| 18892 | ; | |
| 18893 | "RTN","ORY 4270",11,0 ) | |
| 18894 | Q:$G(OCXA UTO) | |
| 18895 | "RTN","ORY 4270",12,0 ) | |
| 18896 | ; | |
| 18897 | "RTN","ORY 4270",13,0 ) | |
| 18898 | N DASH,LI NE,NLINE,P LINE | |
| 18899 | "RTN","ORY 4270",14,0 ) | |
| 18900 | ; | |
| 18901 | "RTN","ORY 4270",15,0 ) | |
| 18902 | S DASH="" ,$P(DASH," -",(55-$L( MSG)-2))=" -" | |
| 18903 | "RTN","ORY 4270",16,0 ) | |
| 18904 | W !!,"--- ---------- -",MSG,DAS H | |
| 18905 | "RTN","ORY 4270",17,0 ) | |
| 18906 | ; | |
| 18907 | "RTN","ORY 4270",18,0 ) | |
| 18908 | W !,RTN,? 10,"[NCCLA B1.AAC.VA. GOV] -> [" ,$$NETNAME ^OCXSEND," ] Line" | |
| 18909 | "RTN","ORY 4270",19,0 ) | |
| 18910 | ; | |
| 18911 | "RTN","ORY 4270",20,0 ) | |
| 18912 | I $O(LINE S($O(LINES (0)))) W " s: " | |
| 18913 | "RTN","ORY 4270",21,0 ) | |
| 18914 | E W ": " | |
| 18915 | "RTN","ORY 4270",22,0 ) | |
| 18916 | ; | |
| 18917 | "RTN","ORY 4270",23,0 ) | |
| 18918 | S LINE=0 F S LINE= $O(LINES(L INE)) Q:'L INE D | |
| 18919 | "RTN","ORY 4270",24,0 ) | |
| 18920 | .W:($X>60 ) !,?40 | |
| 18921 | "RTN","ORY 4270",25,0 ) | |
| 18922 | .S NLINE= LINE F S PLINE=NLIN E,NLINE=$O (LINES(NLI NE)) Q:(NL INE-PLINE- 1) | |
| 18923 | "RTN","ORY 4270",26,0 ) | |
| 18924 | .I (PLINE =LINE) W " ",LINE | |
| 18925 | "RTN","ORY 4270",27,0 ) | |
| 18926 | .E W " " ,LINE,"-", PLINE S LI NE=PLINE | |
| 18927 | "RTN","ORY 4270",28,0 ) | |
| 18928 | ; | |
| 18929 | "RTN","ORY 4270",29,0 ) | |
| 18930 | W ! Q | |
| 18931 | "RTN","ORY 4270",30,0 ) | |
| 18932 | ; | |
| 18933 | "RTN","ORY 4270",31,0 ) | |
| 18934 | TEXT(RTN,L INE) ; | |
| 18935 | "RTN","ORY 4270",32,0 ) | |
| 18936 | ; | |
| 18937 | "RTN","ORY 4270",33,0 ) | |
| 18938 | N TEXT X "S TEXT=$T (+"_(+LINE )_"^"_RTN_ ")" Q TEXT | |
| 18939 | "RTN","ORY 4270",34,0 ) | |
| 18940 | ; | |
| 18941 | "RTN","ORY 4270",35,0 ) | |
| 18942 | HEADER ; | |
| 18943 | "RTN","ORY 4270",36,0 ) | |
| 18944 | ; | |
| 18945 | "RTN","ORY 4270",37,0 ) | |
| 18946 | W !," Cre ated: MAR 7,2017 at 15:12 at NCCLAB1.A AC.VA.GOV" | |
| 18947 | "RTN","ORY 4270",38,0 ) | |
| 18948 | W !," Cur rent Date: ",$$NOW," at ",$$ NETNAME^OC XSEND,!! | |
| 18949 | "RTN","ORY 4270",39,0 ) | |
| 18950 | S LASTFIL E=0 K ^TMP ("OCXRULE" ,$J) | |
| 18951 | "RTN","ORY 4270",40,0 ) | |
| 18952 | S ^TMP("O CXRULE",$J )=($P($H," ,",2)+($H* 86400)+(1* 60*60))_" <- ^TMP EN TRY EXPIRA TION DATE FOR ^OCXOP URG" | |
| 18953 | "RTN","ORY 4270",41,0 ) | |
| 18954 | Q | |
| 18955 | "RTN","ORY 4270",42,0 ) | |
| 18956 | ; | |
| 18957 | "RTN","ORY 4270",43,0 ) | |
| 18958 | GETFILE(FI LE,RECNAME ,ARRAY) ; | |
| 18959 | "RTN","ORY 4270",44,0 ) | |
| 18960 | ; | |
| 18961 | "RTN","ORY 4270",45,0 ) | |
| 18962 | N CHECK,G LNEXT,GLRE F,LINES,RE C,DD,FLD | |
| 18963 | "RTN","ORY 4270",46,0 ) | |
| 18964 | S REC=$$L OOKUP(FILE ,RECNAME) | |
| 18965 | "RTN","ORY 4270",47,0 ) | |
| 18966 | I 'REC W !!,$$FILEN AME^OCXSEN DD(FILE)," : ",RECNAM E Q 0 | |
| 18967 | "RTN","ORY 4270",48,0 ) | |
| 18968 | I (REC=-1 ) W !!,$$F ILENAME^OC XSENDD(FIL E),": ",RE CNAME," d uplicate l ocal entri es.",! Q 0 | |
| 18969 | "RTN","ORY 4270",49,0 ) | |
| 18970 | I (REC=-2 ) W !!,$$F ILENAME^OC XSENDD(FIL E)," (",FI LE,") loca l file not found." W ! Q:$$PAU SE -10 Q R EC | |
| 18971 | "RTN","ORY 4270",50,0 ) | |
| 18972 | I (REC<0) W !!,$$FI LENAME^OCX SENDD(FILE ),": ",REC NAME," un known look up error." W ! Q:$$P AUSE -10 Q REC | |
| 18973 | "RTN","ORY 4270",51,0 ) | |
| 18974 | I (REC>0) D | |
| 18975 | "RTN","ORY 4270",52,0 ) | |
| 18976 | .S CHECK= 0,LINES=0 | |
| 18977 | "RTN","ORY 4270",53,0 ) | |
| 18978 | .D GETREC ($$FILE^OC XSENDD(FIL E,"GLOBAL NAME"),"AR RAY(",REC, .ARRAY) | |
| 18979 | "RTN","ORY 4270",54,0 ) | |
| 18980 | .S GLREF= "ARRAY" F S GLREF=$ Q(@GLREF) Q:'$L(GLRE F) Q:'($E (GLREF,1,6 )="ARRAY(" ) K:'$L(@ GLREF) @GL REF | |
| 18981 | "RTN","ORY 4270",55,0 ) | |
| 18982 | ; | |
| 18983 | "RTN","ORY 4270",56,0 ) | |
| 18984 | Q REC | |
| 18985 | "RTN","ORY 4270",57,0 ) | |
| 18986 | ; | |
| 18987 | "RTN","ORY 4270",58,0 ) | |
| 18988 | LKUPARRY(D D,KEY,ARRA Y) ; | |
| 18989 | "RTN","ORY 4270",59,0 ) | |
| 18990 | ; | |
| 18991 | "RTN","ORY 4270",60,0 ) | |
| 18992 | N D0 S D0 =0 F S D0 =$O(ARRAY( DD,D0)) Q: 'D0 Q:($G (ARRAY(DD, D0,.01,"E" ))=KEY) | |
| 18993 | "RTN","ORY 4270",61,0 ) | |
| 18994 | Q D0 | |
| 18995 | "RTN","ORY 4270",62,0 ) | |
| 18996 | ; | |
| 18997 | "RTN","ORY 4270",63,0 ) | |
| 18998 | LOOKUP(FIL E,KEY) ; | |
| 18999 | "RTN","ORY 4270",64,0 ) | |
| 19000 | I $O(^TMP ("OCXRULE" ,$J,"B",FI LE,KEY,0)) Q 0 | |
| 19001 | "RTN","ORY 4270",65,0 ) | |
| 19002 | N RECNAM, REC,D0,CNT ,SHORT S ( REC,CNT)=0 | |
| 19003 | "RTN","ORY 4270",66,0 ) | |
| 19004 | S GL=$$FI LE^OCXSEND D(FILE,"GL OBAL NAME" ) Q:'$L(GL ) -2 S GL= $E(GL,1,$L (GL)-1)_") " | |
| 19005 | "RTN","ORY 4270",67,0 ) | |
| 19006 | S SHORT=$ E(KEY,1,30 ),RECNAM=S HORT D F S RECNAM= $O(@GL@("B ",RECNAM)) Q:'$L(REC NAM) Q:'( $E(RECNAM, 1,$L(SHORT ))=SHORT) D | |
| 19007 | "RTN","ORY 4270",68,0 ) | |
| 19008 | .S D0=0 F S D0=$O( @GL@("B",R ECNAM,D0)) Q:'D0 I ($P($G(@GL @(D0,0)),U ,1)=KEY) S CNT=CNT+1 ,REC=D0_U_ RECNAME | |
| 19009 | "RTN","ORY 4270",69,0 ) | |
| 19010 | Q:(CNT>1) -1 | |
| 19011 | "RTN","ORY 4270",70,0 ) | |
| 19012 | S:$L($P(R EC,U,2)) ^ TMP("OCXRU LE",$J,"A" ,FILE,$P(R EC,U,2))=" " | |
| 19013 | "RTN","ORY 4270",71,0 ) | |
| 19014 | Q +REC | |
| 19015 | "RTN","ORY 4270",72,0 ) | |
| 19016 | ; | |
| 19017 | "RTN","ORY 4270",73,0 ) | |
| 19018 | GETREC(GL, PATH,D0,RE M) ; | |
| 19019 | "RTN","ORY 4270",74,0 ) | |
| 19020 | ; | |
| 19021 | "RTN","ORY 4270",75,0 ) | |
| 19022 | Q:'($P($G (@(GL_"0)" )),U,2)) | |
| 19023 | "RTN","ORY 4270",76,0 ) | |
| 19024 | N S1,DATA ,DD | |
| 19025 | "RTN","ORY 4270",77,0 ) | |
| 19026 | S DATA="" D DIQ(GL, D0,.DATA) | |
| 19027 | "RTN","ORY 4270",78,0 ) | |
| 19028 | S DD=$O(D ATA(0)) Q: 'DD | |
| 19029 | "RTN","ORY 4270",79,0 ) | |
| 19030 | ; | |
| 19031 | "RTN","ORY 4270",80,0 ) | |
| 19032 | I $L($$FI LE^OCXSEND D(DD,"NAME ")) S PATH =PATH_"""" _DD_":"_D0 _"""" | |
| 19033 | "RTN","ORY 4270",81,0 ) | |
| 19034 | I '$L($$F ILE^OCXSEN DD(DD,"NAM E")) S PAT H=PATH_"," ""_DD_":"_ D0_"""" | |
| 19035 | "RTN","ORY 4270",82,0 ) | |
| 19036 | M @(PATH_ ")")=DATA( DD,D0) | |
| 19037 | "RTN","ORY 4270",83,0 ) | |
| 19038 | ; | |
| 19039 | "RTN","ORY 4270",84,0 ) | |
| 19040 | S S1="" F S S1=$O( @(GL_D0_", "_$$SUB(S1 )_")")) Q: '$L(S1) I ($D(@(GL_ D0_","_$$S UB(S1)_")" ))>3) D | |
| 19041 | "RTN","ORY 4270",85,0 ) | |
| 19042 | .N D1,GLR EF S GLREF =GL_D0_"," _$$SUB(S1) _"," | |
| 19043 | "RTN","ORY 4270",86,0 ) | |
| 19044 | .S D1=0 F S D1=$O( @(GLREF_D1 _")")) Q:' D1 D GETR EC(GLREF,P ATH,D1,.RE M) | |
| 19045 | "RTN","ORY 4270",87,0 ) | |
| 19046 | ; | |
| 19047 | "RTN","ORY 4270",88,0 ) | |
| 19048 | Q | |
| 19049 | "RTN","ORY 4270",89,0 ) | |
| 19050 | ; | |
| 19051 | "RTN","ORY 4270",90,0 ) | |
| 19052 | SUB(X) Q:' (X=+X) """ "_X_"""" Q X | |
| 19053 | "RTN","ORY 4270",91,0 ) | |
| 19054 | ; | |
| 19055 | "RTN","ORY 4270",92,0 ) | |
| 19056 | DIQ(DIC,DA ,OCXARY) ; | |
| 19057 | "RTN","ORY 4270",93,0 ) | |
| 19058 | N DR,DIQ S DR=".01: 99999",DIQ ="OCXARY(" ,DIQ(0)="E N" D EN^DI Q1 | |
| 19059 | "RTN","ORY 4270",94,0 ) | |
| 19060 | Q | |
| 19061 | "RTN","ORY 4270",95,0 ) | |
| 19062 | ; | |
| 19063 | "RTN","ORY 4270",96,0 ) | |
| 19064 | PAUSE() W " Press E nter " R X :DTIME W ! Q (X[U) | |
| 19065 | "RTN","ORY 4270",97,0 ) | |
| 19066 | ; | |
| 19067 | "RTN","ORY 4270",98,0 ) | |
| 19068 | NOW() N X, Y,%DT S X= "N",%DT="T " D ^%DT S Y=$$DATE^ OCXSENDD(Y ) S:(Y["@" ) Y=$P(Y," @",1)_" at "_$P(Y,"@ ",2) Q Y | |
| 19069 | "RTN","ORY 4270",99,0 ) | |
| 19070 | ; | |
| 19071 | "RTN","ORY 42701") | |
| 19072 | 0^6^B70749 911 | |
| 19073 | "RTN","ORY 42701",1,0 ) | |
| 19074 | ORY42701 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 19075 | "RTN","ORY 42701",2,0 ) | |
| 19076 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 19077 | "RTN","ORY 42701",3,0 ) | |
| 19078 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 19079 | "RTN","ORY 42701",4,0 ) | |
| 19080 | ; | |
| 19081 | "RTN","ORY 42701",5,0 ) | |
| 19082 | S ; | |
| 19083 | "RTN","ORY 42701",6,0 ) | |
| 19084 | ; | |
| 19085 | "RTN","ORY 42701",7,0 ) | |
| 19086 | D DOT^ORY 427ES | |
| 19087 | "RTN","ORY 42701",8,0 ) | |
| 19088 | ; | |
| 19089 | "RTN","ORY 42701",9,0 ) | |
| 19090 | ; | |
| 19091 | "RTN","ORY 42701",10, 0) | |
| 19092 | K REMOTE, LOCAL,OPCO DE,REF | |
| 19093 | "RTN","ORY 42701",11, 0) | |
| 19094 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 19095 | "RTN","ORY 42701",12, 0) | |
| 19096 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 19097 | "RTN","ORY 42701",13, 0) | |
| 19098 | ; | |
| 19099 | "RTN","ORY 42701",14, 0) | |
| 19100 | G ^ORY427 02 | |
| 19101 | "RTN","ORY 42701",15, 0) | |
| 19102 | ; | |
| 19103 | "RTN","ORY 42701",16, 0) | |
| 19104 | Q | |
| 19105 | "RTN","ORY 42701",17, 0) | |
| 19106 | ; | |
| 19107 | "RTN","ORY 42701",18, 0) | |
| 19108 | DATA ; | |
| 19109 | "RTN","ORY 42701",19, 0) | |
| 19110 | ; | |
| 19111 | "RTN","ORY 42701",20, 0) | |
| 19112 | ;;ROOT^OC XS(860.2,0 )^ORDER CH ECK RULE^8 60.2I | |
| 19113 | "RTN","ORY 42701",21, 0) | |
| 19114 | ;;ROOT^OC XS(860.3,0 )^ORDER CH ECK ELEMEN T^860.3 | |
| 19115 | "RTN","ORY 42701",22, 0) | |
| 19116 | ;;ROOT^OC XS(860.4,0 )^ORDER CH ECK DATA F IELD^860.4 I | |
| 19117 | "RTN","ORY 42701",23, 0) | |
| 19118 | ;;ROOT^OC XS(860.5,0 )^ORDER CH ECK DATA S OURCE^860. 5 | |
| 19119 | "RTN","ORY 42701",24, 0) | |
| 19120 | ;;ROOT^OC XS(860.6,0 )^ORDER CH ECK DATA C ONTEXT^860 .6 | |
| 19121 | "RTN","ORY 42701",25, 0) | |
| 19122 | ;;ROOT^OC XS(860.8,0 )^ORDER CH ECK COMPIL ER FUNCTIO NS^860.8 | |
| 19123 | "RTN","ORY 42701",26, 0) | |
| 19124 | ;;ROOT^OC XS(860.9,0 )^ORDER CH ECK NATION AL TERM^86 0.9 | |
| 19125 | "RTN","ORY 42701",27, 0) | |
| 19126 | ;;ROOT^OC XS(863,0)^ OCX MDD CL ASS^863 | |
| 19127 | "RTN","ORY 42701",28, 0) | |
| 19128 | ;;ROOT^OC XS(863.1,0 )^OCX MDD APPLICATIO N^863.1 | |
| 19129 | "RTN","ORY 42701",29, 0) | |
| 19130 | ;;ROOT^OC XS(863.2,0 )^OCX MDD SUBJECT^86 3.2 | |
| 19131 | "RTN","ORY 42701",30, 0) | |
| 19132 | ;;ROOT^OC XS(863.3,0 )^OCX MDD LINK^863.3 I | |
| 19133 | "RTN","ORY 42701",31, 0) | |
| 19134 | ;;ROOT^OC XS(863.4,0 )^OCX MDD ATTRIBUTE^ 863.4 | |
| 19135 | "RTN","ORY 42701",32, 0) | |
| 19136 | ;;ROOT^OC XS(863.5,0 )^OCX MDD VALUES^863 .5 | |
| 19137 | "RTN","ORY 42701",33, 0) | |
| 19138 | ;;ROOT^OC XS(863.6,0 )^OCX MDD METHOD^863 .6 | |
| 19139 | "RTN","ORY 42701",34, 0) | |
| 19140 | ;;ROOT^OC XS(863.7,0 )^OCX MDD PUBLIC FUN CTION^863. 7 | |
| 19141 | "RTN","ORY 42701",35, 0) | |
| 19142 | ;;ROOT^OC XS(863.8,0 )^OCX MDD PARAMETER^ 863.8 | |
| 19143 | "RTN","ORY 42701",36, 0) | |
| 19144 | ;;ROOT^OC XS(863.9,0 )^OCX MDD CONDITION/ FUNCTION^8 63.9I | |
| 19145 | "RTN","ORY 42701",37, 0) | |
| 19146 | ;;ROOT^OC XS(864,0)^ OCX MDD SI TE PREFERE NCES^864P | |
| 19147 | "RTN","ORY 42701",38, 0) | |
| 19148 | ;;ROOT^OC XS(864.1,0 )^OCX MDD DATATYPE^8 64.1 | |
| 19149 | "RTN","ORY 42701",39, 0) | |
| 19150 | ;;ROOT^OC XD(860.1,0 )^ORDER CH ECK PATIEN T ACTIVE D ATA^860.1P | |
| 19151 | "RTN","ORY 42701",40, 0) | |
| 19152 | ;;ROOT^OC XD(860.7,0 )^ORDER CH ECK PATIEN T RULE EVE NT^860.7P | |
| 19153 | "RTN","ORY 42701",41, 0) | |
| 19154 | ;;ROOT^OC XD(861,0)^ ORDER CHEC K RAW DATA LOG^861 | |
| 19155 | "RTN","ORY 42701",42, 0) | |
| 19156 | ;;SOF^863 .8 OCX MD D PARAMETE R | |
| 19157 | "RTN","ORY 42701",43, 0) | |
| 19158 | ;;KEY^863 .8:^COMPAR ISON VALUE | |
| 19159 | "RTN","ORY 42701",44, 0) | |
| 19160 | ;;R^"863. 8:",.01,"E " | |
| 19161 | "RTN","ORY 42701",45, 0) | |
| 19162 | ;;D^COMPA RISON VALU E | |
| 19163 | "RTN","ORY 42701",46, 0) | |
| 19164 | ;;R^"863. 8:",.02,"E " | |
| 19165 | "RTN","ORY 42701",47, 0) | |
| 19166 | ;;D^CVAL | |
| 19167 | "RTN","ORY 42701",48, 0) | |
| 19168 | ;;R^"863. 8:",1,2 | |
| 19169 | "RTN","ORY 42701",49, 0) | |
| 19170 | ;;D^ Th is is a va lue to be compared w ith PRIMAR Y DATA FIE LD | |
| 19171 | "RTN","ORY 42701",50, 0) | |
| 19172 | ;;R^"863. 8:",1,3 | |
| 19173 | "RTN","ORY 42701",51, 0) | |
| 19174 | ;;D^ in a truth con ditional. | |
| 19175 | "RTN","ORY 42701",52, 0) | |
| 19176 | ;;EOR^ | |
| 19177 | "RTN","ORY 42701",53, 0) | |
| 19178 | ;;KEY^863 .8:^DATA T YPE | |
| 19179 | "RTN","ORY 42701",54, 0) | |
| 19180 | ;;R^"863. 8:",.01,"E " | |
| 19181 | "RTN","ORY 42701",55, 0) | |
| 19182 | ;;D^DATA TYPE | |
| 19183 | "RTN","ORY 42701",56, 0) | |
| 19184 | ;;R^"863. 8:",.02,"E " | |
| 19185 | "RTN","ORY 42701",57, 0) | |
| 19186 | ;;D^DATA TYPE | |
| 19187 | "RTN","ORY 42701",58, 0) | |
| 19188 | ;;R^"863. 8:",1,1 | |
| 19189 | "RTN","ORY 42701",59, 0) | |
| 19190 | ;;D^An MD D data typ e; i.e., a n entry in the OCX M DD DATA TY PE file. | |
| 19191 | "RTN","ORY 42701",60, 0) | |
| 19192 | ;;R^"863. 8:","863.8 4:6",.01," E" | |
| 19193 | "RTN","ORY 42701",61, 0) | |
| 19194 | ;;D^QUERY | |
| 19195 | "RTN","ORY 42701",62, 0) | |
| 19196 | ;;R^"863. 8:","863.8 4:6",1,"E" | |
| 19197 | "RTN","ORY 42701",63, 0) | |
| 19198 | ;;D^Enter the datat ype | |
| 19199 | "RTN","ORY 42701",64, 0) | |
| 19200 | ;;R^"863. 8:","863.8 4:7",.01," E" | |
| 19201 | "RTN","ORY 42701",65, 0) | |
| 19202 | ;;D^DIC | |
| 19203 | "RTN","ORY 42701",66, 0) | |
| 19204 | ;;R^"863. 8:","863.8 4:7",1,"E" | |
| 19205 | "RTN","ORY 42701",67, 0) | |
| 19206 | ;;D^864.1 | |
| 19207 | "RTN","ORY 42701",68, 0) | |
| 19208 | ;;R^"863. 8:","863.8 4:8",.01," E" | |
| 19209 | "RTN","ORY 42701",69, 0) | |
| 19210 | ;;D^DATA TYPE | |
| 19211 | "RTN","ORY 42701",70, 0) | |
| 19212 | ;;R^"863. 8:","863.8 4:8",1,"E" | |
| 19213 | "RTN","ORY 42701",71, 0) | |
| 19214 | ;;D^POINT ER TO A FI LEMAN FILE | |
| 19215 | "RTN","ORY 42701",72, 0) | |
| 19216 | ;;R^"863. 8:","863.8 4:9",.01," E" | |
| 19217 | "RTN","ORY 42701",73, 0) | |
| 19218 | ;;D^DIC L OOKUP INDE X STRING | |
| 19219 | "RTN","ORY 42701",74, 0) | |
| 19220 | ;;R^"863. 8:","863.8 4:9",1,"E" | |
| 19221 | "RTN","ORY 42701",75, 0) | |
| 19222 | ;;D^B^C | |
| 19223 | "RTN","ORY 42701",76, 0) | |
| 19224 | ;;EOR^ | |
| 19225 | "RTN","ORY 42701",77, 0) | |
| 19226 | ;;KEY^863 .8:^DIC | |
| 19227 | "RTN","ORY 42701",78, 0) | |
| 19228 | ;;R^"863. 8:",.01,"E " | |
| 19229 | "RTN","ORY 42701",79, 0) | |
| 19230 | ;;D^DIC | |
| 19231 | "RTN","ORY 42701",80, 0) | |
| 19232 | ;;R^"863. 8:",.02,"E " | |
| 19233 | "RTN","ORY 42701",81, 0) | |
| 19234 | ;;D^DIC | |
| 19235 | "RTN","ORY 42701",82, 0) | |
| 19236 | ;;R^"863. 8:",1,1 | |
| 19237 | "RTN","ORY 42701",83, 0) | |
| 19238 | ;;D^An op en referen ce used to specify t he file in a DIC loo kup | |
| 19239 | "RTN","ORY 42701",84, 0) | |
| 19240 | ;;R^"863. 8:","863.8 4:1",.01," E" | |
| 19241 | "RTN","ORY 42701",85, 0) | |
| 19242 | ;;D^DATA TYPE | |
| 19243 | "RTN","ORY 42701",86, 0) | |
| 19244 | ;;R^"863. 8:","863.8 4:1",1,"E" | |
| 19245 | "RTN","ORY 42701",87, 0) | |
| 19246 | ;;D^POINT ER TO A FI LEMAN FILE | |
| 19247 | "RTN","ORY 42701",88, 0) | |
| 19248 | ;;R^"863. 8:","863.8 4:2",.01," E" | |
| 19249 | "RTN","ORY 42701",89, 0) | |
| 19250 | ;;D^DIC | |
| 19251 | "RTN","ORY 42701",90, 0) | |
| 19252 | ;;R^"863. 8:","863.8 4:2",1,"E" | |
| 19253 | "RTN","ORY 42701",91, 0) | |
| 19254 | ;;D^1 | |
| 19255 | "RTN","ORY 42701",92, 0) | |
| 19256 | ;;R^"863. 8:","863.8 4:3",.01," E" | |
| 19257 | "RTN","ORY 42701",93, 0) | |
| 19258 | ;;D^QUERY | |
| 19259 | "RTN","ORY 42701",94, 0) | |
| 19260 | ;;R^"863. 8:","863.8 4:3",1,"E" | |
| 19261 | "RTN","ORY 42701",95, 0) | |
| 19262 | ;;D^Enter the name of the fil e you are pointing t o | |
| 19263 | "RTN","ORY 42701",96, 0) | |
| 19264 | ;;EOR^ | |
| 19265 | "RTN","ORY 42701",97, 0) | |
| 19266 | ;;KEY^863 .8:^DIC LO OKUP INDEX STRING | |
| 19267 | "RTN","ORY 42701",98, 0) | |
| 19268 | ;;R^"863. 8:",.01,"E " | |
| 19269 | "RTN","ORY 42701",99, 0) | |
| 19270 | ;;D^DIC L OOKUP INDE X STRING | |
| 19271 | "RTN","ORY 42701",100 ,0) | |
| 19272 | ;;R^"863. 8:",.02,"E " | |
| 19273 | "RTN","ORY 42701",101 ,0) | |
| 19274 | ;;D^DICIX | |
| 19275 | "RTN","ORY 42701",102 ,0) | |
| 19276 | ;;R^"863. 8:",1,1 | |
| 19277 | "RTN","ORY 42701",103 ,0) | |
| 19278 | ;;D^Conta ins the na mes of ind ices to be used in a DIC looku p in a com ma | |
| 19279 | "RTN","ORY 42701",104 ,0) | |
| 19280 | ;;R^"863. 8:",1,2 | |
| 19281 | "RTN","ORY 42701",105 ,0) | |
| 19282 | ;;D^delim ited strin g. | |
| 19283 | "RTN","ORY 42701",106 ,0) | |
| 19284 | ;;R^"863. 8:","863.8 4:1",.01," E" | |
| 19285 | "RTN","ORY 42701",107 ,0) | |
| 19286 | ;;D^DATA TYPE | |
| 19287 | "RTN","ORY 42701",108 ,0) | |
| 19288 | ;;R^"863. 8:","863.8 4:1",1,"E" | |
| 19289 | "RTN","ORY 42701",109 ,0) | |
| 19290 | ;;D^FREE TEXT | |
| 19291 | "RTN","ORY 42701",110 ,0) | |
| 19292 | ;;R^"863. 8:","863.8 4:2",.01," E" | |
| 19293 | "RTN","ORY 42701",111 ,0) | |
| 19294 | ;;D^QUERY | |
| 19295 | "RTN","ORY 42701",112 ,0) | |
| 19296 | ;;R^"863. 8:","863.8 4:2",1,"E" | |
| 19297 | "RTN","ORY 42701",113 ,0) | |
| 19298 | ;;D^Enter a DIC loo kup index string | |
| 19299 | "RTN","ORY 42701",114 ,0) | |
| 19300 | ;;R^"863. 8:","863.8 4:3",.01," E" | |
| 19301 | "RTN","ORY 42701",115 ,0) | |
| 19302 | ;;D^HELP MESSAGE | |
| 19303 | "RTN","ORY 42701",116 ,0) | |
| 19304 | ;;R^"863. 8:","863.8 4:3",1,"E" | |
| 19305 | "RTN","ORY 42701",117 ,0) | |
| 19306 | ;;D^This is an '^' delimited string whi ch contain s the name s of indic es which a re to be u sed in a D IC lookup; e.g., B^C ^DOB. | |
| 19307 | "RTN","ORY 42701",118 ,0) | |
| 19308 | ;;EOR^ | |
| 19309 | "RTN","ORY 42701",119 ,0) | |
| 19310 | ;;KEY^863 .8:^FILE | |
| 19311 | "RTN","ORY 42701",120 ,0) | |
| 19312 | ;;R^"863. 8:",.01,"E " | |
| 19313 | "RTN","ORY 42701",121 ,0) | |
| 19314 | ;;D^FILE | |
| 19315 | "RTN","ORY 42701",122 ,0) | |
| 19316 | ;;R^"863. 8:",.02,"E " | |
| 19317 | "RTN","ORY 42701",123 ,0) | |
| 19318 | ;;D^FILE | |
| 19319 | "RTN","ORY 42701",124 ,0) | |
| 19320 | ;;R^"863. 8:",1,1 | |
| 19321 | "RTN","ORY 42701",125 ,0) | |
| 19322 | ;;D^The i nternal en try number of a file . | |
| 19323 | "RTN","ORY 42701",126 ,0) | |
| 19324 | ;;R^"863. 8:","863.8 4:6",.01," E" | |
| 19325 | "RTN","ORY 42701",127 ,0) | |
| 19326 | ;;D^QUERY | |
| 19327 | "RTN","ORY 42701",128 ,0) | |
| 19328 | ;;R^"863. 8:","863.8 4:6",1,"E" | |
| 19329 | "RTN","ORY 42701",129 ,0) | |
| 19330 | ;;D^File | |
| 19331 | "RTN","ORY 42701",130 ,0) | |
| 19332 | ;;R^"863. 8:","863.8 4:7",.01," E" | |
| 19333 | "RTN","ORY 42701",131 ,0) | |
| 19334 | ;;D^DATA TYPE | |
| 19335 | "RTN","ORY 42701",132 ,0) | |
| 19336 | ;;R^"863. 8:","863.8 4:7",1,"E" | |
| 19337 | "RTN","ORY 42701",133 ,0) | |
| 19338 | ;;D^POINT ER TO A FI LEMAN FILE | |
| 19339 | "RTN","ORY 42701",134 ,0) | |
| 19340 | ;;R^"863. 8:","863.8 4:8",.01," E" | |
| 19341 | "RTN","ORY 42701",135 ,0) | |
| 19342 | ;;D^DIC | |
| 19343 | "RTN","ORY 42701",136 ,0) | |
| 19344 | ;;R^"863. 8:","863.8 4:8",1,"E" | |
| 19345 | "RTN","ORY 42701",137 ,0) | |
| 19346 | ;;D^1 | |
| 19347 | "RTN","ORY 42701",138 ,0) | |
| 19348 | ;;EOR^ | |
| 19349 | "RTN","ORY 42701",139 ,0) | |
| 19350 | ;;KEY^863 .8:^FM MAS K | |
| 19351 | "RTN","ORY 42701",140 ,0) | |
| 19352 | ;;R^"863. 8:",.01,"E " | |
| 19353 | "RTN","ORY 42701",141 ,0) | |
| 19354 | ;;D^FM MA SK | |
| 19355 | "RTN","ORY 42701",142 ,0) | |
| 19356 | ;;R^"863. 8:",.02,"E " | |
| 19357 | "RTN","ORY 42701",143 ,0) | |
| 19358 | ;;D^FM MA SK | |
| 19359 | "RTN","ORY 42701",144 ,0) | |
| 19360 | ;;R^"863. 8:",1,1 | |
| 19361 | "RTN","ORY 42701",145 ,0) | |
| 19362 | ;;D^Tag^r outine whe re code is located t o parse th e FM DD an d override the param eter value | |
| 19363 | "RTN","ORY 42701",146 ,0) | |
| 19364 | ;;R^"863. 8:","863.8 4:4",.01," E" | |
| 19365 | "RTN","ORY 42701",147 ,0) | |
| 19366 | ;;D^QUERY | |
| 19367 | "RTN","ORY 42701",148 ,0) | |
| 19368 | ;;R^"863. 8:","863.8 4:4",1,"E" | |
| 19369 | "RTN","ORY 42701",149 ,0) | |
| 19370 | ;;D^Enter tag^routi ne where t he FM MASK parser is located | |
| 19371 | "RTN","ORY 42701",150 ,0) | |
| 19372 | ;;R^"863. 8:","863.8 4:5",.01," E" | |
| 19373 | "RTN","ORY 42701",151 ,0) | |
| 19374 | ;;D^DATA TYPE | |
| 19375 | "RTN","ORY 42701",152 ,0) | |
| 19376 | ;;R^"863. 8:","863.8 4:5",1,"E" | |
| 19377 | "RTN","ORY 42701",153 ,0) | |
| 19378 | ;;D^LINE TAG | |
| 19379 | "RTN","ORY 42701",154 ,0) | |
| 19380 | ;;EOR^ | |
| 19381 | "RTN","ORY 42701",155 ,0) | |
| 19382 | ;;KEY^863 .8:^FREE T EXT MAXIMU M LENGTH | |
| 19383 | "RTN","ORY 42701",156 ,0) | |
| 19384 | ;;R^"863. 8:",.01,"E " | |
| 19385 | "RTN","ORY 42701",157 ,0) | |
| 19386 | ;;D^FREE TEXT MAXIM UM LENGTH | |
| 19387 | "RTN","ORY 42701",158 ,0) | |
| 19388 | ;;R^"863. 8:",.02,"E " | |
| 19389 | "RTN","ORY 42701",159 ,0) | |
| 19390 | ;;D^FMAX | |
| 19391 | "RTN","ORY 42701",160 ,0) | |
| 19392 | ;;R^"863. 8:",1,1 | |
| 19393 | "RTN","ORY 42701",161 ,0) | |
| 19394 | ;;D^Maxim um string length all owed | |
| 19395 | "RTN","ORY 42701",162 ,0) | |
| 19396 | ;;R^"863. 8:",2,"E" | |
| 19397 | "RTN","ORY 42701",163 ,0) | |
| 19398 | ;;D^245 | |
| 19399 | "RTN","ORY 42701",164 ,0) | |
| 19400 | ;;R^"863. 8:","863.8 4:3",.01," E" | |
| 19401 | "RTN","ORY 42701",165 ,0) | |
| 19402 | ;;D^QUERY | |
| 19403 | "RTN","ORY 42701",166 ,0) | |
| 19404 | ;;R^"863. 8:","863.8 4:3",1,"E" | |
| 19405 | "RTN","ORY 42701",167 ,0) | |
| 19406 | ;;D^Maxim um text st ring lengt h allowed | |
| 19407 | "RTN","ORY 42701",168 ,0) | |
| 19408 | ;;R^"863. 8:","863.8 4:4",.01," E" | |
| 19409 | "RTN","ORY 42701",169 ,0) | |
| 19410 | ;;D^FM MA SK | |
| 19411 | "RTN","ORY 42701",170 ,0) | |
| 19412 | ;;R^"863. 8:","863.8 4:4",1,"E" | |
| 19413 | "RTN","ORY 42701",171 ,0) | |
| 19414 | ;;D^FMAX^ OCXF6 | |
| 19415 | "RTN","ORY 42701",172 ,0) | |
| 19416 | ;;R^"863. 8:","863.8 4:5",.01," E" | |
| 19417 | "RTN","ORY 42701",173 ,0) | |
| 19418 | ;;D^DATA TYPE | |
| 19419 | "RTN","ORY 42701",174 ,0) | |
| 19420 | ;;R^"863. 8:","863.8 4:5",1,"E" | |
| 19421 | "RTN","ORY 42701",175 ,0) | |
| 19422 | ;;D^POSIT IVE INTEGE R | |
| 19423 | "RTN","ORY 42701",176 ,0) | |
| 19424 | ;;EOR^ | |
| 19425 | "RTN","ORY 42701",177 ,0) | |
| 19426 | ;;KEY^863 .8:^HELP M ESSAGE | |
| 19427 | "RTN","ORY 42701",178 ,0) | |
| 19428 | ;;R^"863. 8:",.01,"E " | |
| 19429 | "RTN","ORY 42701",179 ,0) | |
| 19430 | ;;D^HELP MESSAGE | |
| 19431 | "RTN","ORY 42701",180 ,0) | |
| 19432 | ;;R^"863. 8:",.02,"E " | |
| 19433 | "RTN","ORY 42701",181 ,0) | |
| 19434 | ;;D^HELP | |
| 19435 | "RTN","ORY 42701",182 ,0) | |
| 19436 | ;;R^"863. 8:",1,1 | |
| 19437 | "RTN","ORY 42701",183 ,0) | |
| 19438 | ;;D^A tex t string 1 -250 chara cters long which ove rrides the Fileman h elp | |
| 19439 | "RTN","ORY 42701",184 ,0) | |
| 19440 | ;;R^"863. 8:",1,2 | |
| 19441 | "RTN","ORY 42701",185 ,0) | |
| 19442 | ;;D^messa ge. | |
| 19443 | "RTN","ORY 42701",186 ,0) | |
| 19444 | ;;R^"863. 8:","863.8 4:10",.01, "E" | |
| 19445 | "RTN","ORY 42701",187 ,0) | |
| 19446 | ;;D^QUERY | |
| 19447 | "RTN","ORY 42701",188 ,0) | |
| 19448 | ;;R^"863. 8:","863.8 4:10",1,"E " | |
| 19449 | "RTN","ORY 42701",189 ,0) | |
| 19450 | ;;D^Enter a brief h elp messag e | |
| 19451 | "RTN","ORY 42701",190 ,0) | |
| 19452 | ;;R^"863. 8:","863.8 4:8",.01," E" | |
| 19453 | "RTN","ORY 42701",191 ,0) | |
| 19454 | ;;D^DATA TYPE | |
| 19455 | "RTN","ORY 42701",192 ,0) | |
| 19456 | ;;R^"863. 8:","863.8 4:8",1,"E" | |
| 19457 | "RTN","ORY 42701",193 ,0) | |
| 19458 | ;;D^FREE TEXT | |
| 19459 | "RTN","ORY 42701",194 ,0) | |
| 19460 | ;;R^"863. 8:","863.8 4:9",.01," E" | |
| 19461 | "RTN","ORY 42701",195 ,0) | |
| 19462 | ;;D^FM MA SK | |
| 19463 | "RTN","ORY 42701",196 ,0) | |
| 19464 | ;;R^"863. 8:","863.8 4:9",1,"E" | |
| 19465 | "RTN","ORY 42701",197 ,0) | |
| 19466 | ;;D^HELP^ OCXF6 | |
| 19467 | "RTN","ORY 42701",198 ,0) | |
| 19468 | ;;EOR^ | |
| 19469 | "RTN","ORY 42701",199 ,0) | |
| 19470 | ;;KEY^863 .8:^LOOP Q UERY | |
| 19471 | "RTN","ORY 42701",200 ,0) | |
| 19472 | ;;R^"863. 8:",.01,"E " | |
| 19473 | "RTN","ORY 42701",201 ,0) | |
| 19474 | ;;D^LOOP QUERY | |
| 19475 | "RTN","ORY 42701",202 ,0) | |
| 19476 | ;;R^"863. 8:",.02,"E " | |
| 19477 | "RTN","ORY 42701",203 ,0) | |
| 19478 | ;;D^LOOP QUERY | |
| 19479 | "RTN","ORY 42701",204 ,0) | |
| 19480 | ;;R^"863. 8:",1,1 | |
| 19481 | "RTN","ORY 42701",205 ,0) | |
| 19482 | ;;D^Alter nate query used when repeated answers ar e required | |
| 19483 | "RTN","ORY 42701",206 ,0) | |
| 19484 | ;;R^"863. 8:","863.8 4:1",.01," E" | |
| 19485 | "RTN","ORY 42701",207 ,0) | |
| 19486 | ;;D^DATA TYPE | |
| 19487 | "RTN","ORY 42701",208 ,0) | |
| 19488 | ;;R^"863. 8:","863.8 4:1",1,"E" | |
| 19489 | "RTN","ORY 42701",209 ,0) | |
| 19490 | ;;D^FREE TEXT | |
| 19491 | "RTN","ORY 42701",210 ,0) | |
| 19492 | ;;R^"863. 8:","863.8 4:2",.01," E" | |
| 19493 | "RTN","ORY 42701",211 ,0) | |
| 19494 | ;;D^QUERY | |
| 19495 | "RTN","ORY 42701",212 ,0) | |
| 19496 | ;;R^"863. 8:","863.8 4:2",1,"E" | |
| 19497 | "RTN","ORY 42701",213 ,0) | |
| 19498 | ;;D^Enter loop quer y text | |
| 19499 | "RTN","ORY 42701",214 ,0) | |
| 19500 | ;;R^"863. 8:","863.8 4:3",.01," E" | |
| 19501 | "RTN","ORY 42701",215 ,0) | |
| 19502 | ;;D^HELP MESSAGE | |
| 19503 | "RTN","ORY 42701",216 ,0) | |
| 19504 | ;;R^"863. 8:","863.8 4:3",1,"E" | |
| 19505 | "RTN","ORY 42701",217 ,0) | |
| 19506 | ;;D^This is the que ry text fo r all entr ies after the first one | |
| 19507 | "RTN","ORY 42701",218 ,0) | |
| 19508 | ;;EOR^ | |
| 19509 | "RTN","ORY 42701",219 ,0) | |
| 19510 | ;;KEY^863 .8:^MANDAT ORY MESSAG E | |
| 19511 | "RTN","ORY 42701",220 ,0) | |
| 19512 | ;;R^"863. 8:",.01,"E " | |
| 19513 | "RTN","ORY 42701",221 ,0) | |
| 19514 | ;;D^MANDA TORY MESSA GE | |
| 19515 | "RTN","ORY 42701",222 ,0) | |
| 19516 | ;;R^"863. 8:",.02,"E " | |
| 19517 | "RTN","ORY 42701",223 ,0) | |
| 19518 | ;;D^MAND MSG | |
| 19519 | "RTN","ORY 42701",224 ,0) | |
| 19520 | ;;R^"863. 8:",1,1 | |
| 19521 | "RTN","ORY 42701",225 ,0) | |
| 19522 | ;;D^Messa ge sent to user tell ing him th at his ent ry is mand atory | |
| 19523 | "RTN","ORY 42701",226 ,0) | |
| 19524 | ;;R^"863. 8:",2,"E" | |
| 19525 | "RTN","ORY 42701",227 ,0) | |
| 19526 | ;;D^Manda tory answe r. You mu st enter a value or '^' to exi t. | |
| 19527 | "RTN","ORY 42701",228 ,0) | |
| 19528 | ;;R^"863. 8:","863.8 4:4",.01," E" | |
| 19529 | "RTN","ORY 42701",229 ,0) | |
| 19530 | ;;D^QUERY | |
| 19531 | "RTN","ORY 42701",230 ,0) | |
| 19532 | ;;R^"863. 8:","863.8 4:4",1,"E" | |
| 19533 | "RTN","ORY 42701",231 ,0) | |
| 19534 | ;;D^Enter message | |
| 19535 | "RTN","ORY 42701",232 ,0) | |
| 19536 | ;;R^"863. 8:","863.8 4:5",.01," E" | |
| 19537 | "RTN","ORY 42701",233 ,0) | |
| 19538 | ;;D^DATA TYPE | |
| 19539 | "RTN","ORY 42701",234 ,0) | |
| 19540 | ;;R^"863. 8:","863.8 4:5",1,"E" | |
| 19541 | "RTN","ORY 42701",235 ,0) | |
| 19542 | ;;D^FREE TEXT | |
| 19543 | "RTN","ORY 42701",236 ,0) | |
| 19544 | ;;EOR^ | |
| 19545 | "RTN","ORY 42701",237 ,0) | |
| 19546 | ;;KEY^863 .8:^OCXO D ATA DRIVE SOURCE | |
| 19547 | "RTN","ORY 42701",238 ,0) | |
| 19548 | ;;R^"863. 8:",.01,"E " | |
| 19549 | "RTN","ORY 42701",239 ,0) | |
| 19550 | ;;D^OCXO DATA DRIVE SOURCE | |
| 19551 | "RTN","ORY 42701",240 ,0) | |
| 19552 | ;;EOR^ | |
| 19553 | "RTN","ORY 42701",241 ,0) | |
| 19554 | ;;KEY^863 .8:^OCXO E XTERNAL FU NCTION CAL L | |
| 19555 | "RTN","ORY 42701",242 ,0) | |
| 19556 | ;;R^"863. 8:",.01,"E " | |
| 19557 | "RTN","ORY 42701",243 ,0) | |
| 19558 | ;;D^OCXO EXTERNAL F UNCTION CA LL | |
| 19559 | "RTN","ORY 42701",244 ,0) | |
| 19560 | ;;EOR^ | |
| 19561 | "RTN","ORY 42701",245 ,0) | |
| 19562 | ;;KEY^863 .8:^OCXO F ILE POINTE R | |
| 19563 | "RTN","ORY 42701",246 ,0) | |
| 19564 | ;;R^"863. 8:",.01,"E " | |
| 19565 | "RTN","ORY 42701",247 ,0) | |
| 19566 | ;;D^OCXO FILE POINT ER | |
| 19567 | "RTN","ORY 42701",248 ,0) | |
| 19568 | ;;EOR^ | |
| 19569 | "RTN","ORY 42701",249 ,0) | |
| 19570 | ;;KEY^863 .8:^OCXO G ENERATE CO DE FUNCTIO N | |
| 19571 | "RTN","ORY 42701",250 ,0) | |
| 19572 | ;;R^"863. 8:",.01,"E " | |
| 19573 | "RTN","ORY 42701",251 ,0) | |
| 19574 | ;;D^OCXO GENERATE C ODE FUNCTI ON | |
| 19575 | "RTN","ORY 42701",252 ,0) | |
| 19576 | ;;R^"863. 8:",.02,"E " | |
| 19577 | "RTN","ORY 42701",253 ,0) | |
| 19578 | ;;D^GEN | |
| 19579 | "RTN","ORY 42701",254 ,0) | |
| 19580 | ;;EOR^ | |
| 19581 | "RTN","ORY 42701",255 ,0) | |
| 19582 | ;;KEY^863 .8:^OCXO H L7 SEGMENT ID | |
| 19583 | "RTN","ORY 42701",256 ,0) | |
| 19584 | ;;R^"863. 8:",.01,"E " | |
| 19585 | "RTN","ORY 42701",257 ,0) | |
| 19586 | ;;D^OCXO HL7 SEGMEN T ID | |
| 19587 | "RTN","ORY 42701",258 ,0) | |
| 19588 | ;;R^"863. 8:",.02,"E " | |
| 19589 | "RTN","ORY 42701",259 ,0) | |
| 19590 | ;;D^HL7SE GID | |
| 19591 | "RTN","ORY 42701",260 ,0) | |
| 19592 | ;;EOR^ | |
| 19593 | "RTN","ORY 42701",261 ,0) | |
| 19594 | ;;KEY^863 .8:^OCXO S EMI-COLON PIECE NUMB ER | |
| 19595 | "RTN","ORY 42701",262 ,0) | |
| 19596 | ;;R^"863. 8:",.01,"E " | |
| 19597 | "RTN","ORY 42701",263 ,0) | |
| 19598 | ;;D^OCXO SEMI-COLON PIECE NUM BER | |
| 19599 | "RTN","ORY 42701",264 ,0) | |
| 19600 | ;;EOR^ | |
| 19601 | "RTN","ORY 42701",265 ,0) | |
| 19602 | ;;KEY^863 .8:^OCXO U P-ARROW PI ECE NUMBER | |
| 19603 | "RTN","ORY 42701",266 ,0) | |
| 19604 | ;;R^"863. 8:",.01,"E " | |
| 19605 | "RTN","ORY 42701",267 ,0) | |
| 19606 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 19607 | "RTN","ORY 42701",268 ,0) | |
| 19608 | ;;EOR^ | |
| 19609 | "RTN","ORY 42701",269 ,0) | |
| 19610 | ;;KEY^863 .8:^OCXO V ARIABLE NA ME | |
| 19611 | "RTN","ORY 42701",270 ,0) | |
| 19612 | ;;R^"863. 8:",.01,"E " | |
| 19613 | "RTN","ORY 42701",271 ,0) | |
| 19614 | ;;D^OCXO VARIABLE N AME | |
| 19615 | "RTN","ORY 42701",272 ,0) | |
| 19616 | ;;EOR^ | |
| 19617 | "RTN","ORY 42701",273 ,0) | |
| 19618 | ;;KEY^863 .8:^OCXO V T-BAR PIEC E NUMBER | |
| 19619 | "RTN","ORY 42701",274 ,0) | |
| 19620 | ;;R^"863. 8:",.01,"E " | |
| 19621 | "RTN","ORY 42701",275 ,0) | |
| 19622 | ;;D^OCXO VT-BAR PIE CE NUMBER | |
| 19623 | "RTN","ORY 42701",276 ,0) | |
| 19624 | ;;EOR^ | |
| 19625 | "RTN","ORY 42701",277 ,0) | |
| 19626 | ;;KEY^863 .8:^PRIMAR Y DATA FIE LD | |
| 19627 | "RTN","ORY 42701",278 ,0) | |
| 19628 | ;;R^"863. 8:",.01,"E " | |
| 19629 | "RTN","ORY 42701",279 ,0) | |
| 19630 | ;;D^PRIMA RY DATA FI ELD | |
| 19631 | "RTN","ORY 42701",280 ,0) | |
| 19632 | ;1; | |
| 19633 | "RTN","ORY 42701",281 ,0) | |
| 19634 | ; | |
| 19635 | "RTN","ORY 42702") | |
| 19636 | 0^7^B78014 133 | |
| 19637 | "RTN","ORY 42702",1,0 ) | |
| 19638 | ORY42702 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 19639 | "RTN","ORY 42702",2,0 ) | |
| 19640 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 19641 | "RTN","ORY 42702",3,0 ) | |
| 19642 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 19643 | "RTN","ORY 42702",4,0 ) | |
| 19644 | ; | |
| 19645 | "RTN","ORY 42702",5,0 ) | |
| 19646 | S ; | |
| 19647 | "RTN","ORY 42702",6,0 ) | |
| 19648 | ; | |
| 19649 | "RTN","ORY 42702",7,0 ) | |
| 19650 | D DOT^ORY 427ES | |
| 19651 | "RTN","ORY 42702",8,0 ) | |
| 19652 | ; | |
| 19653 | "RTN","ORY 42702",9,0 ) | |
| 19654 | ; | |
| 19655 | "RTN","ORY 42702",10, 0) | |
| 19656 | K REMOTE, LOCAL,OPCO DE,REF | |
| 19657 | "RTN","ORY 42702",11, 0) | |
| 19658 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 19659 | "RTN","ORY 42702",12, 0) | |
| 19660 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 19661 | "RTN","ORY 42702",13, 0) | |
| 19662 | ; | |
| 19663 | "RTN","ORY 42702",14, 0) | |
| 19664 | G ^ORY427 03 | |
| 19665 | "RTN","ORY 42702",15, 0) | |
| 19666 | ; | |
| 19667 | "RTN","ORY 42702",16, 0) | |
| 19668 | Q | |
| 19669 | "RTN","ORY 42702",17, 0) | |
| 19670 | ; | |
| 19671 | "RTN","ORY 42702",18, 0) | |
| 19672 | DATA ; | |
| 19673 | "RTN","ORY 42702",19, 0) | |
| 19674 | ; | |
| 19675 | "RTN","ORY 42702",20, 0) | |
| 19676 | ;;R^"863. 8:",.02,"E " | |
| 19677 | "RTN","ORY 42702",21, 0) | |
| 19678 | ;;D^PDFLD | |
| 19679 | "RTN","ORY 42702",22, 0) | |
| 19680 | ;;R^"863. 8:",1,2 | |
| 19681 | "RTN","ORY 42702",23, 0) | |
| 19682 | ;;D^ Pri mary data field in a compariso n expressi on that | |
| 19683 | "RTN","ORY 42702",24, 0) | |
| 19684 | ;;R^"863. 8:",1,3 | |
| 19685 | "RTN","ORY 42702",25, 0) | |
| 19686 | ;;D^ is t o be teste d. | |
| 19687 | "RTN","ORY 42702",26, 0) | |
| 19688 | ;;EOR^ | |
| 19689 | "RTN","ORY 42702",27, 0) | |
| 19690 | ;;KEY^863 .8:^QUERY | |
| 19691 | "RTN","ORY 42702",28, 0) | |
| 19692 | ;;R^"863. 8:",.01,"E " | |
| 19693 | "RTN","ORY 42702",29, 0) | |
| 19694 | ;;D^QUERY | |
| 19695 | "RTN","ORY 42702",30, 0) | |
| 19696 | ;;R^"863. 8:",.02,"E " | |
| 19697 | "RTN","ORY 42702",31, 0) | |
| 19698 | ;;D^QUERY | |
| 19699 | "RTN","ORY 42702",32, 0) | |
| 19700 | ;;R^"863. 8:",1,1 | |
| 19701 | "RTN","ORY 42702",33, 0) | |
| 19702 | ;;D^Used with metho ds that ma nage inter active dia logues. E quivalent to DIC("A" ) | |
| 19703 | "RTN","ORY 42702",34, 0) | |
| 19704 | ;;R^"863. 8:","863.8 4:1",.01," E" | |
| 19705 | "RTN","ORY 42702",35, 0) | |
| 19706 | ;;D^DATA TYPE | |
| 19707 | "RTN","ORY 42702",36, 0) | |
| 19708 | ;;R^"863. 8:","863.8 4:1",1,"E" | |
| 19709 | "RTN","ORY 42702",37, 0) | |
| 19710 | ;;D^FREE TEXT | |
| 19711 | "RTN","ORY 42702",38, 0) | |
| 19712 | ;;R^"863. 8:","863.8 4:2",.01," E" | |
| 19713 | "RTN","ORY 42702",39, 0) | |
| 19714 | ;;D^QUERY | |
| 19715 | "RTN","ORY 42702",40, 0) | |
| 19716 | ;;R^"863. 8:","863.8 4:2",1,"E" | |
| 19717 | "RTN","ORY 42702",41, 0) | |
| 19718 | ;;D^Enter the query (free tex t string) | |
| 19719 | "RTN","ORY 42702",42, 0) | |
| 19720 | ;;EOR^ | |
| 19721 | "RTN","ORY 42702",43, 0) | |
| 19722 | ;;KEY^863 .8:^REPEAT THE QUERY | |
| 19723 | "RTN","ORY 42702",44, 0) | |
| 19724 | ;;R^"863. 8:",.01,"E " | |
| 19725 | "RTN","ORY 42702",45, 0) | |
| 19726 | ;;D^REPEA T THE QUER Y | |
| 19727 | "RTN","ORY 42702",46, 0) | |
| 19728 | ;;R^"863. 8:",.02,"E " | |
| 19729 | "RTN","ORY 42702",47, 0) | |
| 19730 | ;;D^LOOP | |
| 19731 | "RTN","ORY 42702",48, 0) | |
| 19732 | ;;R^"863. 8:",1,1 | |
| 19733 | "RTN","ORY 42702",49, 0) | |
| 19734 | ;;D^Set t his = 1 to repetitiv ely ask th e user to enter a va lue | |
| 19735 | "RTN","ORY 42702",50, 0) | |
| 19736 | ;;R^"863. 8:","863.8 4:1",.01," E" | |
| 19737 | "RTN","ORY 42702",51, 0) | |
| 19738 | ;;D^DATA TYPE | |
| 19739 | "RTN","ORY 42702",52, 0) | |
| 19740 | ;;R^"863. 8:","863.8 4:1",1,"E" | |
| 19741 | "RTN","ORY 42702",53, 0) | |
| 19742 | ;;D^YES N O | |
| 19743 | "RTN","ORY 42702",54, 0) | |
| 19744 | ;;R^"863. 8:","863.8 4:2",.01," E" | |
| 19745 | "RTN","ORY 42702",55, 0) | |
| 19746 | ;;D^HELP MESSAGE | |
| 19747 | "RTN","ORY 42702",56, 0) | |
| 19748 | ;;R^"863. 8:","863.8 4:2",1,"E" | |
| 19749 | "RTN","ORY 42702",57, 0) | |
| 19750 | ;;D^Answe r 'YES' if you want the user t o repetiti vely enter a value. | |
| 19751 | "RTN","ORY 42702",58, 0) | |
| 19752 | ;;R^"863. 8:","863.8 4:3",.01," E" | |
| 19753 | "RTN","ORY 42702",59, 0) | |
| 19754 | ;;D^QUERY | |
| 19755 | "RTN","ORY 42702",60, 0) | |
| 19756 | ;;R^"863. 8:","863.8 4:3",1,"E" | |
| 19757 | "RTN","ORY 42702",61, 0) | |
| 19758 | ;;D^Is th e query re petitive | |
| 19759 | "RTN","ORY 42702",62, 0) | |
| 19760 | ;;EOR^ | |
| 19761 | "RTN","ORY 42702",63, 0) | |
| 19762 | ;;KEY^863 .8:^TERMIN ATOR | |
| 19763 | "RTN","ORY 42702",64, 0) | |
| 19764 | ;;R^"863. 8:",.01,"E " | |
| 19765 | "RTN","ORY 42702",65, 0) | |
| 19766 | ;;D^TERMI NATOR | |
| 19767 | "RTN","ORY 42702",66, 0) | |
| 19768 | ;;R^"863. 8:",.02,"E " | |
| 19769 | "RTN","ORY 42702",67, 0) | |
| 19770 | ;;D^TERMI NATOR | |
| 19771 | "RTN","ORY 42702",68, 0) | |
| 19772 | ;;R^"863. 8:",1,1 | |
| 19773 | "RTN","ORY 42702",69, 0) | |
| 19774 | ;;D^A tex t string t erminator; e.g., '?' , ': ', '= >' | |
| 19775 | "RTN","ORY 42702",70, 0) | |
| 19776 | ;;R^"863. 8:",2,"E" | |
| 19777 | "RTN","ORY 42702",71, 0) | |
| 19778 | ;;D^: | |
| 19779 | "RTN","ORY 42702",72, 0) | |
| 19780 | ;;R^"863. 8:","863.8 4:4",.01," E" | |
| 19781 | "RTN","ORY 42702",73, 0) | |
| 19782 | ;;D^QUERY | |
| 19783 | "RTN","ORY 42702",74, 0) | |
| 19784 | ;;R^"863. 8:","863.8 4:4",1,"E" | |
| 19785 | "RTN","ORY 42702",75, 0) | |
| 19786 | ;;D^Enter text stri ng termina tor | |
| 19787 | "RTN","ORY 42702",76, 0) | |
| 19788 | ;;R^"863. 8:","863.8 4:5",.01," E" | |
| 19789 | "RTN","ORY 42702",77, 0) | |
| 19790 | ;;D^DATA TYPE | |
| 19791 | "RTN","ORY 42702",78, 0) | |
| 19792 | ;;R^"863. 8:","863.8 4:5",1,"E" | |
| 19793 | "RTN","ORY 42702",79, 0) | |
| 19794 | ;;D^FREE TEXT | |
| 19795 | "RTN","ORY 42702",80, 0) | |
| 19796 | ;;R^"863. 8:","863.8 4:6",.01," E" | |
| 19797 | "RTN","ORY 42702",81, 0) | |
| 19798 | ;;D^FREE TEXT MAXIM UM LENGTH | |
| 19799 | "RTN","ORY 42702",82, 0) | |
| 19800 | ;;R^"863. 8:","863.8 4:6",1,"E" | |
| 19801 | "RTN","ORY 42702",83, 0) | |
| 19802 | ;;D^9 | |
| 19803 | "RTN","ORY 42702",84, 0) | |
| 19804 | ;;EOR^ | |
| 19805 | "RTN","ORY 42702",85, 0) | |
| 19806 | ;;KEY^863 .8:^VALUE CALL | |
| 19807 | "RTN","ORY 42702",86, 0) | |
| 19808 | ;;R^"863. 8:",.01,"E " | |
| 19809 | "RTN","ORY 42702",87, 0) | |
| 19810 | ;;D^VALUE CALL | |
| 19811 | "RTN","ORY 42702",88, 0) | |
| 19812 | ;;R^"863. 8:",.02,"E " | |
| 19813 | "RTN","ORY 42702",89, 0) | |
| 19814 | ;;D^VAL C ALL | |
| 19815 | "RTN","ORY 42702",90, 0) | |
| 19816 | ;;R^"863. 8:",.03,"E " | |
| 19817 | "RTN","ORY 42702",91, 0) | |
| 19818 | ;;D^NO | |
| 19819 | "RTN","ORY 42702",92, 0) | |
| 19820 | ;;R^"863. 8:",1,1 | |
| 19821 | "RTN","ORY 42702",93, 0) | |
| 19822 | ;;D^tag^r outine whi ch manages the dialo gue for co llecting a nd validat ing a valu e | |
| 19823 | "RTN","ORY 42702",94, 0) | |
| 19824 | ;;R^"863. 8:","863.8 4:3",.01," E" | |
| 19825 | "RTN","ORY 42702",95, 0) | |
| 19826 | ;;D^QUERY | |
| 19827 | "RTN","ORY 42702",96, 0) | |
| 19828 | ;;R^"863. 8:","863.8 4:3",1,"E" | |
| 19829 | "RTN","ORY 42702",97, 0) | |
| 19830 | ;;D^Enter tag^routi ne | |
| 19831 | "RTN","ORY 42702",98, 0) | |
| 19832 | ;;R^"863. 8:","863.8 4:4",.01," E" | |
| 19833 | "RTN","ORY 42702",99, 0) | |
| 19834 | ;;D^DATA TYPE | |
| 19835 | "RTN","ORY 42702",100 ,0) | |
| 19836 | ;;R^"863. 8:","863.8 4:4",1,"E" | |
| 19837 | "RTN","ORY 42702",101 ,0) | |
| 19838 | ;;D^LINE TAG | |
| 19839 | "RTN","ORY 42702",102 ,0) | |
| 19840 | ;;EOR^ | |
| 19841 | "RTN","ORY 42702",103 ,0) | |
| 19842 | ;;EOF^OCX S(863.8)^1 | |
| 19843 | "RTN","ORY 42702",104 ,0) | |
| 19844 | ;;SOF^864 .1 OCX MD D DATATYPE | |
| 19845 | "RTN","ORY 42702",105 ,0) | |
| 19846 | ;;KEY^864 .1:^BOOLEA N | |
| 19847 | "RTN","ORY 42702",106 ,0) | |
| 19848 | ;;R^"864. 1:",.01,"E " | |
| 19849 | "RTN","ORY 42702",107 ,0) | |
| 19850 | ;;D^BOOLE AN | |
| 19851 | "RTN","ORY 42702",108 ,0) | |
| 19852 | ;;R^"864. 1:",.02,"E " | |
| 19853 | "RTN","ORY 42702",109 ,0) | |
| 19854 | ;;D^BOOL | |
| 19855 | "RTN","ORY 42702",110 ,0) | |
| 19856 | ;;EOR^ | |
| 19857 | "RTN","ORY 42702",111 ,0) | |
| 19858 | ;;KEY^864 .1:^FREE T EXT | |
| 19859 | "RTN","ORY 42702",112 ,0) | |
| 19860 | ;;R^"864. 1:",.01,"E " | |
| 19861 | "RTN","ORY 42702",113 ,0) | |
| 19862 | ;;D^FREE TEXT | |
| 19863 | "RTN","ORY 42702",114 ,0) | |
| 19864 | ;;R^"864. 1:",.02,"E " | |
| 19865 | "RTN","ORY 42702",115 ,0) | |
| 19866 | ;;D^FT | |
| 19867 | "RTN","ORY 42702",116 ,0) | |
| 19868 | ;;R^"864. 1:",2,"E" | |
| 19869 | "RTN","ORY 42702",117 ,0) | |
| 19870 | ;;D^GENER IC | |
| 19871 | "RTN","ORY 42702",118 ,0) | |
| 19872 | ;;R^"864. 1:","864.1 1:1",.01," E" | |
| 19873 | "RTN","ORY 42702",119 ,0) | |
| 19874 | ;;D^VALUE CALL | |
| 19875 | "RTN","ORY 42702",120 ,0) | |
| 19876 | ;;R^"864. 1:","864.1 1:1",1,"E" | |
| 19877 | "RTN","ORY 42702",121 ,0) | |
| 19878 | ;;D^FT^OC XFDFT | |
| 19879 | "RTN","ORY 42702",122 ,0) | |
| 19880 | ;;R^"864. 1:","864.1 1:2",.01," E" | |
| 19881 | "RTN","ORY 42702",123 ,0) | |
| 19882 | ;;D^QUERY | |
| 19883 | "RTN","ORY 42702",124 ,0) | |
| 19884 | ;;R^"864. 1:","864.1 1:2",1,"E" | |
| 19885 | "RTN","ORY 42702",125 ,0) | |
| 19886 | ;;D^Enter a free te xt string | |
| 19887 | "RTN","ORY 42702",126 ,0) | |
| 19888 | ;;R^"864. 1:","864.1 1:3",.01," E" | |
| 19889 | "RTN","ORY 42702",127 ,0) | |
| 19890 | ;;D^FREE TEXT MAXIM UM LENGTH | |
| 19891 | "RTN","ORY 42702",128 ,0) | |
| 19892 | ;;R^"864. 1:","864.1 1:3",1,"E" | |
| 19893 | "RTN","ORY 42702",129 ,0) | |
| 19894 | ;;D^240 | |
| 19895 | "RTN","ORY 42702",130 ,0) | |
| 19896 | ;;R^"864. 1:","864.1 1:4",.01," E" | |
| 19897 | "RTN","ORY 42702",131 ,0) | |
| 19898 | ;;D^HELP MESSAGE | |
| 19899 | "RTN","ORY 42702",132 ,0) | |
| 19900 | ;;R^"864. 1:","864.1 1:4",1,"E" | |
| 19901 | "RTN","ORY 42702",133 ,0) | |
| 19902 | ;;D^Enter a free te xt string. Do not u se control character s. |FTMM HELP| | |
| 19903 | "RTN","ORY 42702",134 ,0) | |
| 19904 | ;;R^"864. 1:","864.1 1:5",.01," E" | |
| 19905 | "RTN","ORY 42702",135 ,0) | |
| 19906 | ;;D^LOOP QUERY | |
| 19907 | "RTN","ORY 42702",136 ,0) | |
| 19908 | ;;R^"864. 1:","864.1 1:5",1,"E" | |
| 19909 | "RTN","ORY 42702",137 ,0) | |
| 19910 | ;;D^Enter another f ree text s tring | |
| 19911 | "RTN","ORY 42702",138 ,0) | |
| 19912 | ;;R^"864. 1:","864.1 1:6",.01," E" | |
| 19913 | "RTN","ORY 42702",139 ,0) | |
| 19914 | ;;D^REPEA T THE QUER Y | |
| 19915 | "RTN","ORY 42702",140 ,0) | |
| 19916 | ;;R^"864. 1:","864.1 1:6",1,"E" | |
| 19917 | "RTN","ORY 42702",141 ,0) | |
| 19918 | ;;D^0 | |
| 19919 | "RTN","ORY 42702",142 ,0) | |
| 19920 | ;;EOR^ | |
| 19921 | "RTN","ORY 42702",143 ,0) | |
| 19922 | ;;KEY^864 .1:^GENERI C | |
| 19923 | "RTN","ORY 42702",144 ,0) | |
| 19924 | ;;R^"864. 1:",.01,"E " | |
| 19925 | "RTN","ORY 42702",145 ,0) | |
| 19926 | ;;D^GENER IC | |
| 19927 | "RTN","ORY 42702",146 ,0) | |
| 19928 | ;;R^"864. 1:",.02,"E " | |
| 19929 | "RTN","ORY 42702",147 ,0) | |
| 19930 | ;;D^GENER IC | |
| 19931 | "RTN","ORY 42702",148 ,0) | |
| 19932 | ;;R^"864. 1:","864.1 1:11",.01, "E" | |
| 19933 | "RTN","ORY 42702",149 ,0) | |
| 19934 | ;;D^MANDA TORY MESSA GE | |
| 19935 | "RTN","ORY 42702",150 ,0) | |
| 19936 | ;;R^"864. 1:","864.1 1:11",1,"E " | |
| 19937 | "RTN","ORY 42702",151 ,0) | |
| 19938 | ;;D^This answer is mandatory. Enter a response o r press '^ ' to exit. | |
| 19939 | "RTN","ORY 42702",152 ,0) | |
| 19940 | ;;R^"864. 1:","864.1 1:12",.01, "E" | |
| 19941 | "RTN","ORY 42702",153 ,0) | |
| 19942 | ;;D^TERMI NATOR | |
| 19943 | "RTN","ORY 42702",154 ,0) | |
| 19944 | ;;R^"864. 1:","864.1 1:12",1,"E " | |
| 19945 | "RTN","ORY 42702",155 ,0) | |
| 19946 | ;;D^: | |
| 19947 | "RTN","ORY 42702",156 ,0) | |
| 19948 | ;;R^"864. 1:","864.1 1:13",.01, "E" | |
| 19949 | "RTN","ORY 42702",157 ,0) | |
| 19950 | ;;D^LOOP QUERY | |
| 19951 | "RTN","ORY 42702",158 ,0) | |
| 19952 | ;;R^"864. 1:","864.1 1:13",1,"E " | |
| 19953 | "RTN","ORY 42702",159 ,0) | |
| 19954 | ;;D^Enter another v alue | |
| 19955 | "RTN","ORY 42702",160 ,0) | |
| 19956 | ;;R^"864. 1:","864.1 1:7",.01," E" | |
| 19957 | "RTN","ORY 42702",161 ,0) | |
| 19958 | ;;D^VALUE CALL | |
| 19959 | "RTN","ORY 42702",162 ,0) | |
| 19960 | ;;R^"864. 1:","864.1 1:7",1,"E" | |
| 19961 | "RTN","ORY 42702",163 ,0) | |
| 19962 | ;;D^GEN^O CXFDMOM | |
| 19963 | "RTN","ORY 42702",164 ,0) | |
| 19964 | ;;R^"864. 1:","864.1 1:8",.01," E" | |
| 19965 | "RTN","ORY 42702",165 ,0) | |
| 19966 | ;;D^QUERY | |
| 19967 | "RTN","ORY 42702",166 ,0) | |
| 19968 | ;;R^"864. 1:","864.1 1:8",1,"E" | |
| 19969 | "RTN","ORY 42702",167 ,0) | |
| 19970 | ;;D^Enter a value | |
| 19971 | "RTN","ORY 42702",168 ,0) | |
| 19972 | ;;R^"864. 1:","864.1 1:9",.01," E" | |
| 19973 | "RTN","ORY 42702",169 ,0) | |
| 19974 | ;;D^HELP MESSAGE | |
| 19975 | "RTN","ORY 42702",170 ,0) | |
| 19976 | ;;R^"864. 1:","864.1 1:9",1,"E" | |
| 19977 | "RTN","ORY 42702",171 ,0) | |
| 19978 | ;;D^ | |
| 19979 | "RTN","ORY 42702",172 ,0) | |
| 19980 | ;;EOR^ | |
| 19981 | "RTN","ORY 42702",173 ,0) | |
| 19982 | ;;KEY^864 .1:^NUMERI C | |
| 19983 | "RTN","ORY 42702",174 ,0) | |
| 19984 | ;;R^"864. 1:",.01,"E " | |
| 19985 | "RTN","ORY 42702",175 ,0) | |
| 19986 | ;;D^NUMER IC | |
| 19987 | "RTN","ORY 42702",176 ,0) | |
| 19988 | ;;R^"864. 1:",.02,"E " | |
| 19989 | "RTN","ORY 42702",177 ,0) | |
| 19990 | ;;D^NUMER IC | |
| 19991 | "RTN","ORY 42702",178 ,0) | |
| 19992 | ;;R^"864. 1:",2,"E" | |
| 19993 | "RTN","ORY 42702",179 ,0) | |
| 19994 | ;;D^GENER IC | |
| 19995 | "RTN","ORY 42702",180 ,0) | |
| 19996 | ;;R^"864. 1:","864.1 1:1",.01," E" | |
| 19997 | "RTN","ORY 42702",181 ,0) | |
| 19998 | ;;D^VALUE CALL | |
| 19999 | "RTN","ORY 42702",182 ,0) | |
| 20000 | ;;R^"864. 1:","864.1 1:1",1,"E" | |
| 20001 | "RTN","ORY 42702",183 ,0) | |
| 20002 | ;;D^NU^OC XFDNU | |
| 20003 | "RTN","ORY 42702",184 ,0) | |
| 20004 | ;;R^"864. 1:","864.1 1:2",.01," E" | |
| 20005 | "RTN","ORY 42702",185 ,0) | |
| 20006 | ;;D^QUERY | |
| 20007 | "RTN","ORY 42702",186 ,0) | |
| 20008 | ;;R^"864. 1:","864.1 1:2",1,"E" | |
| 20009 | "RTN","ORY 42702",187 ,0) | |
| 20010 | ;;D^Enter a number | |
| 20011 | "RTN","ORY 42702",188 ,0) | |
| 20012 | ;;R^"864. 1:","864.1 1:3",.01," E" | |
| 20013 | "RTN","ORY 42702",189 ,0) | |
| 20014 | ;;D^LOOP QUERY | |
| 20015 | "RTN","ORY 42702",190 ,0) | |
| 20016 | ;;R^"864. 1:","864.1 1:3",1,"E" | |
| 20017 | "RTN","ORY 42702",191 ,0) | |
| 20018 | ;;D^Enter another n umber | |
| 20019 | "RTN","ORY 42702",192 ,0) | |
| 20020 | ;;R^"864. 1:","864.1 1:4",.01," E" | |
| 20021 | "RTN","ORY 42702",193 ,0) | |
| 20022 | ;;D^REPEA T THE QUER Y | |
| 20023 | "RTN","ORY 42702",194 ,0) | |
| 20024 | ;;R^"864. 1:","864.1 1:4",1,"E" | |
| 20025 | "RTN","ORY 42702",195 ,0) | |
| 20026 | ;;D^0 | |
| 20027 | "RTN","ORY 42702",196 ,0) | |
| 20028 | ;;EOR^ | |
| 20029 | "RTN","ORY 42702",197 ,0) | |
| 20030 | ;;EOF^OCX S(864.1)^1 | |
| 20031 | "RTN","ORY 42702",198 ,0) | |
| 20032 | ;;SOF^863 .7 OCX MD D PUBLIC F UNCTION | |
| 20033 | "RTN","ORY 42702",199 ,0) | |
| 20034 | ;;KEY^863 .7:^GCC BO OLEAN LOGI CAL FALSE | |
| 20035 | "RTN","ORY 42702",200 ,0) | |
| 20036 | ;;R^"863. 7:",.01,"E " | |
| 20037 | "RTN","ORY 42702",201 ,0) | |
| 20038 | ;;D^GCC B OOLEAN LOG ICAL FALSE | |
| 20039 | "RTN","ORY 42702",202 ,0) | |
| 20040 | ;;R^"863. 7:",.02,"E " | |
| 20041 | "RTN","ORY 42702",203 ,0) | |
| 20042 | ;;D^EXTRI NSIC FUNCT ION | |
| 20043 | "RTN","ORY 42702",204 ,0) | |
| 20044 | ;;R^"863. 7:",3,"E" | |
| 20045 | "RTN","ORY 42702",205 ,0) | |
| 20046 | ;;D^FALSE ^OCXF23 | |
| 20047 | "RTN","ORY 42702",206 ,0) | |
| 20048 | ;;R^"863. 7:","863.7 4:1",.01," E" | |
| 20049 | "RTN","ORY 42702",207 ,0) | |
| 20050 | ;;D^PRIMA RY DATA FI ELD | |
| 20051 | "RTN","ORY 42702",208 ,0) | |
| 20052 | ;;R^"863. 7:","863.7 4:1",1.1," E" | |
| 20053 | "RTN","ORY 42702",209 ,0) | |
| 20054 | ;;D^1 | |
| 20055 | "RTN","ORY 42702",210 ,0) | |
| 20056 | ;;EOR^ | |
| 20057 | "RTN","ORY 42702",211 ,0) | |
| 20058 | ;;KEY^863 .7:^GCC BO OLEAN LOGI CAL TRUE | |
| 20059 | "RTN","ORY 42702",212 ,0) | |
| 20060 | ;;R^"863. 7:",.01,"E " | |
| 20061 | "RTN","ORY 42702",213 ,0) | |
| 20062 | ;;D^GCC B OOLEAN LOG ICAL TRUE | |
| 20063 | "RTN","ORY 42702",214 ,0) | |
| 20064 | ;;R^"863. 7:",.02,"E " | |
| 20065 | "RTN","ORY 42702",215 ,0) | |
| 20066 | ;;D^EXTRI NSIC FUNCT ION | |
| 20067 | "RTN","ORY 42702",216 ,0) | |
| 20068 | ;;R^"863. 7:",3,"E" | |
| 20069 | "RTN","ORY 42702",217 ,0) | |
| 20070 | ;;D^TRUE^ OCXF23 | |
| 20071 | "RTN","ORY 42702",218 ,0) | |
| 20072 | ;;R^"863. 7:","863.7 4:1",.01," E" | |
| 20073 | "RTN","ORY 42702",219 ,0) | |
| 20074 | ;;D^PRIMA RY DATA FI ELD | |
| 20075 | "RTN","ORY 42702",220 ,0) | |
| 20076 | ;;R^"863. 7:","863.7 4:1",1.1," E" | |
| 20077 | "RTN","ORY 42702",221 ,0) | |
| 20078 | ;;D^1 | |
| 20079 | "RTN","ORY 42702",222 ,0) | |
| 20080 | ;;EOR^ | |
| 20081 | "RTN","ORY 42702",223 ,0) | |
| 20082 | ;;KEY^863 .7:^GCC FR EE TEXT EQ UALS | |
| 20083 | "RTN","ORY 42702",224 ,0) | |
| 20084 | ;;R^"863. 7:",.01,"E " | |
| 20085 | "RTN","ORY 42702",225 ,0) | |
| 20086 | ;;D^GCC F REE TEXT E QUALS | |
| 20087 | "RTN","ORY 42702",226 ,0) | |
| 20088 | ;;R^"863. 7:",.02,"E " | |
| 20089 | "RTN","ORY 42702",227 ,0) | |
| 20090 | ;;D^EXTRI NSIC FUNCT ION | |
| 20091 | "RTN","ORY 42702",228 ,0) | |
| 20092 | ;;R^"863. 7:",3,"E" | |
| 20093 | "RTN","ORY 42702",229 ,0) | |
| 20094 | ;;D^AEQ^O CXF22 | |
| 20095 | "RTN","ORY 42702",230 ,0) | |
| 20096 | ;;R^"863. 7:","863.7 4:1",.01," E" | |
| 20097 | "RTN","ORY 42702",231 ,0) | |
| 20098 | ;;D^PRIMA RY DATA FI ELD | |
| 20099 | "RTN","ORY 42702",232 ,0) | |
| 20100 | ;;R^"863. 7:","863.7 4:1",1.1," E" | |
| 20101 | "RTN","ORY 42702",233 ,0) | |
| 20102 | ;;D^1 | |
| 20103 | "RTN","ORY 42702",234 ,0) | |
| 20104 | ;;R^"863. 7:","863.7 4:2",.01," E" | |
| 20105 | "RTN","ORY 42702",235 ,0) | |
| 20106 | ;;D^COMPA RISON VALU E | |
| 20107 | "RTN","ORY 42702",236 ,0) | |
| 20108 | ;;R^"863. 7:","863.7 4:2",1.1," E" | |
| 20109 | "RTN","ORY 42702",237 ,0) | |
| 20110 | ;;D^2 | |
| 20111 | "RTN","ORY 42702",238 ,0) | |
| 20112 | ;;EOR^ | |
| 20113 | "RTN","ORY 42702",239 ,0) | |
| 20114 | ;;KEY^863 .7:^GCC FR EE TEXT ST ARTS WITH | |
| 20115 | "RTN","ORY 42702",240 ,0) | |
| 20116 | ;;R^"863. 7:",.01,"E " | |
| 20117 | "RTN","ORY 42702",241 ,0) | |
| 20118 | ;;D^GCC F REE TEXT S TARTS WITH | |
| 20119 | "RTN","ORY 42702",242 ,0) | |
| 20120 | ;;R^"863. 7:",.02,"E " | |
| 20121 | "RTN","ORY 42702",243 ,0) | |
| 20122 | ;;D^EXTRI NSIC FUNCT ION | |
| 20123 | "RTN","ORY 42702",244 ,0) | |
| 20124 | ;;R^"863. 7:",3,"E" | |
| 20125 | "RTN","ORY 42702",245 ,0) | |
| 20126 | ;;D^START ^OCXF22 | |
| 20127 | "RTN","ORY 42702",246 ,0) | |
| 20128 | ;;R^"863. 7:","863.7 4:1",.01," E" | |
| 20129 | "RTN","ORY 42702",247 ,0) | |
| 20130 | ;;D^PRIMA RY DATA FI ELD | |
| 20131 | "RTN","ORY 42702",248 ,0) | |
| 20132 | ;;R^"863. 7:","863.7 4:1",1.1," E" | |
| 20133 | "RTN","ORY 42702",249 ,0) | |
| 20134 | ;;D^1 | |
| 20135 | "RTN","ORY 42702",250 ,0) | |
| 20136 | ;;R^"863. 7:","863.7 4:2",.01," E" | |
| 20137 | "RTN","ORY 42702",251 ,0) | |
| 20138 | ;;D^COMPA RISON VALU E | |
| 20139 | "RTN","ORY 42702",252 ,0) | |
| 20140 | ;;R^"863. 7:","863.7 4:2",1.1," E" | |
| 20141 | "RTN","ORY 42702",253 ,0) | |
| 20142 | ;;D^2 | |
| 20143 | "RTN","ORY 42702",254 ,0) | |
| 20144 | ;;EOR^ | |
| 20145 | "RTN","ORY 42702",255 ,0) | |
| 20146 | ;;KEY^863 .7:^GCC NU MERIC GREA TER THAN | |
| 20147 | "RTN","ORY 42702",256 ,0) | |
| 20148 | ;;R^"863. 7:",.01,"E " | |
| 20149 | "RTN","ORY 42702",257 ,0) | |
| 20150 | ;;D^GCC N UMERIC GRE ATER THAN | |
| 20151 | "RTN","ORY 42702",258 ,0) | |
| 20152 | ;;R^"863. 7:",.02,"E " | |
| 20153 | "RTN","ORY 42702",259 ,0) | |
| 20154 | ;;D^EXTRI NSIC FUNCT ION | |
| 20155 | "RTN","ORY 42702",260 ,0) | |
| 20156 | ;;R^"863. 7:",3,"E" | |
| 20157 | "RTN","ORY 42702",261 ,0) | |
| 20158 | ;;D^GRT^O CXF20 | |
| 20159 | "RTN","ORY 42702",262 ,0) | |
| 20160 | ;;R^"863. 7:","863.7 4:1",.01," E" | |
| 20161 | "RTN","ORY 42702",263 ,0) | |
| 20162 | ;;D^PRIMA RY DATA FI ELD | |
| 20163 | "RTN","ORY 42702",264 ,0) | |
| 20164 | ;;R^"863. 7:","863.7 4:1",1.1," E" | |
| 20165 | "RTN","ORY 42702",265 ,0) | |
| 20166 | ;;D^1 | |
| 20167 | "RTN","ORY 42702",266 ,0) | |
| 20168 | ;;R^"863. 7:","863.7 4:2",.01," E" | |
| 20169 | "RTN","ORY 42702",267 ,0) | |
| 20170 | ;;D^COMPA RISON VALU E | |
| 20171 | "RTN","ORY 42702",268 ,0) | |
| 20172 | ;;R^"863. 7:","863.7 4:2",1.1," E" | |
| 20173 | "RTN","ORY 42702",269 ,0) | |
| 20174 | ;;D^2 | |
| 20175 | "RTN","ORY 42702",270 ,0) | |
| 20176 | ;;EOR^ | |
| 20177 | "RTN","ORY 42702",271 ,0) | |
| 20178 | ;;KEY^863 .7:^GCC NU MERIC LESS THAN | |
| 20179 | "RTN","ORY 42702",272 ,0) | |
| 20180 | ;;R^"863. 7:",.01,"E " | |
| 20181 | "RTN","ORY 42702",273 ,0) | |
| 20182 | ;;D^GCC N UMERIC LES S THAN | |
| 20183 | "RTN","ORY 42702",274 ,0) | |
| 20184 | ;;R^"863. 7:",.02,"E " | |
| 20185 | "RTN","ORY 42702",275 ,0) | |
| 20186 | ;;D^EXTRI NSIC FUNCT ION | |
| 20187 | "RTN","ORY 42702",276 ,0) | |
| 20188 | ;;R^"863. 7:",3,"E" | |
| 20189 | "RTN","ORY 42702",277 ,0) | |
| 20190 | ;;D^LESS^ OCXF20 | |
| 20191 | "RTN","ORY 42702",278 ,0) | |
| 20192 | ;;R^"863. 7:","863.7 4:1",.01," E" | |
| 20193 | "RTN","ORY 42702",279 ,0) | |
| 20194 | ;;D^PRIMA RY DATA FI ELD | |
| 20195 | "RTN","ORY 42702",280 ,0) | |
| 20196 | ;;R^"863. 7:","863.7 4:1",1.1," E" | |
| 20197 | "RTN","ORY 42702",281 ,0) | |
| 20198 | ;;D^1 | |
| 20199 | "RTN","ORY 42702",282 ,0) | |
| 20200 | ;;R^"863. 7:","863.7 4:2",.01," E" | |
| 20201 | "RTN","ORY 42702",283 ,0) | |
| 20202 | ;;D^COMPA RISON VALU E | |
| 20203 | "RTN","ORY 42702",284 ,0) | |
| 20204 | ;;R^"863. 7:","863.7 4:2",1.1," E" | |
| 20205 | "RTN","ORY 42702",285 ,0) | |
| 20206 | ;;D^2 | |
| 20207 | "RTN","ORY 42702",286 ,0) | |
| 20208 | ;;EOR^ | |
| 20209 | "RTN","ORY 42702",287 ,0) | |
| 20210 | ;;EOF^OCX S(863.7)^1 | |
| 20211 | "RTN","ORY 42702",288 ,0) | |
| 20212 | ;;SOF^863 .9 OCX MD D CONDITIO N/FUNCTION | |
| 20213 | "RTN","ORY 42702",289 ,0) | |
| 20214 | ;;KEY^863 .9:^EQ FRE E TEXT | |
| 20215 | "RTN","ORY 42702",290 ,0) | |
| 20216 | ;;R^"863. 9:",.01,"E " | |
| 20217 | "RTN","ORY 42702",291 ,0) | |
| 20218 | ;;D^EQ FR EE TEXT | |
| 20219 | "RTN","ORY 42702",292 ,0) | |
| 20220 | ;;R^"863. 9:",.02,"E " | |
| 20221 | "RTN","ORY 42702",293 ,0) | |
| 20222 | ;;D^FREE TEXT | |
| 20223 | "RTN","ORY 42702",294 ,0) | |
| 20224 | ;;R^"863. 9:",.04,"E " | |
| 20225 | "RTN","ORY 42702",295 ,0) | |
| 20226 | ;;D^IS EQ UAL TO | |
| 20227 | "RTN","ORY 42702",296 ,0) | |
| 20228 | ;;R^"863. 9:","863.9 1:3",.01," E" | |
| 20229 | "RTN","ORY 42702",297 ,0) | |
| 20230 | ;;D^OCXO GENERATE C ODE FUNCTI ON | |
| 20231 | "RTN","ORY 42702",298 ,0) | |
| 20232 | ;;R^"863. 9:","863.9 1:3",1,"E" | |
| 20233 | "RTN","ORY 42702",299 ,0) | |
| 20234 | ;;D^GCC F REE TEXT E QUALS | |
| 20235 | "RTN","ORY 42702",300 ,0) | |
| 20236 | ;;R^"863. 9:","863.9 2:1",.01," E" | |
| 20237 | "RTN","ORY 42702",301 ,0) | |
| 20238 | ;;D^EQUAL S | |
| 20239 | "RTN","ORY 42702",302 ,0) | |
| 20240 | ;;EOR^ | |
| 20241 | "RTN","ORY 42702",303 ,0) | |
| 20242 | ;;KEY^863 .9:^GREATE R THAN | |
| 20243 | "RTN","ORY 42702",304 ,0) | |
| 20244 | ;;R^"863. 9:",.01,"E " | |
| 20245 | "RTN","ORY 42702",305 ,0) | |
| 20246 | ;;D^GREAT ER THAN | |
| 20247 | "RTN","ORY 42702",306 ,0) | |
| 20248 | ;;R^"863. 9:",.02,"E " | |
| 20249 | "RTN","ORY 42702",307 ,0) | |
| 20250 | ;;D^NUMER IC | |
| 20251 | "RTN","ORY 42702",308 ,0) | |
| 20252 | ;;R^"863. 9:",.04,"E " | |
| 20253 | "RTN","ORY 42702",309 ,0) | |
| 20254 | ;;D^IS GR EATER THAN | |
| 20255 | "RTN","ORY 42702",310 ,0) | |
| 20256 | ;;R^"863. 9:","863.9 1:3",.01," E" | |
| 20257 | "RTN","ORY 42702",311 ,0) | |
| 20258 | ;;D^OCXO GENERATE C ODE FUNCTI ON | |
| 20259 | "RTN","ORY 42702",312 ,0) | |
| 20260 | ;;R^"863. 9:","863.9 1:3",1,"E" | |
| 20261 | "RTN","ORY 42702",313 ,0) | |
| 20262 | ;;D^GCC N UMERIC GRE ATER THAN | |
| 20263 | "RTN","ORY 42702",314 ,0) | |
| 20264 | ;;EOR^ | |
| 20265 | "RTN","ORY 42702",315 ,0) | |
| 20266 | ;;KEY^863 .9:^LESS T HAN | |
| 20267 | "RTN","ORY 42702",316 ,0) | |
| 20268 | ;;R^"863. 9:",.01,"E " | |
| 20269 | "RTN","ORY 42702",317 ,0) | |
| 20270 | ;;D^LESS THAN | |
| 20271 | "RTN","ORY 42702",318 ,0) | |
| 20272 | ;;R^"863. 9:",.02,"E " | |
| 20273 | "RTN","ORY 42702",319 ,0) | |
| 20274 | ;;D^NUMER IC | |
| 20275 | "RTN","ORY 42702",320 ,0) | |
| 20276 | ;;R^"863. 9:",.04,"E " | |
| 20277 | "RTN","ORY 42702",321 ,0) | |
| 20278 | ;;D^IS LE SS THAN | |
| 20279 | "RTN","ORY 42702",322 ,0) | |
| 20280 | ;;R^"863. 9:","863.9 1:3",.01," E" | |
| 20281 | "RTN","ORY 42702",323 ,0) | |
| 20282 | ;;D^OCXO GENERATE C ODE FUNCTI ON | |
| 20283 | "RTN","ORY 42702",324 ,0) | |
| 20284 | ;1; | |
| 20285 | "RTN","ORY 42702",325 ,0) | |
| 20286 | ; | |
| 20287 | "RTN","ORY 42703") | |
| 20288 | 0^8^B78325 557 | |
| 20289 | "RTN","ORY 42703",1,0 ) | |
| 20290 | ORY42703 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 20291 | "RTN","ORY 42703",2,0 ) | |
| 20292 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 20293 | "RTN","ORY 42703",3,0 ) | |
| 20294 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 20295 | "RTN","ORY 42703",4,0 ) | |
| 20296 | ; | |
| 20297 | "RTN","ORY 42703",5,0 ) | |
| 20298 | S ; | |
| 20299 | "RTN","ORY 42703",6,0 ) | |
| 20300 | ; | |
| 20301 | "RTN","ORY 42703",7,0 ) | |
| 20302 | D DOT^ORY 427ES | |
| 20303 | "RTN","ORY 42703",8,0 ) | |
| 20304 | ; | |
| 20305 | "RTN","ORY 42703",9,0 ) | |
| 20306 | ; | |
| 20307 | "RTN","ORY 42703",10, 0) | |
| 20308 | K REMOTE, LOCAL,OPCO DE,REF | |
| 20309 | "RTN","ORY 42703",11, 0) | |
| 20310 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 20311 | "RTN","ORY 42703",12, 0) | |
| 20312 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 20313 | "RTN","ORY 42703",13, 0) | |
| 20314 | ; | |
| 20315 | "RTN","ORY 42703",14, 0) | |
| 20316 | G ^ORY427 04 | |
| 20317 | "RTN","ORY 42703",15, 0) | |
| 20318 | ; | |
| 20319 | "RTN","ORY 42703",16, 0) | |
| 20320 | Q | |
| 20321 | "RTN","ORY 42703",17, 0) | |
| 20322 | ; | |
| 20323 | "RTN","ORY 42703",18, 0) | |
| 20324 | DATA ; | |
| 20325 | "RTN","ORY 42703",19, 0) | |
| 20326 | ; | |
| 20327 | "RTN","ORY 42703",20, 0) | |
| 20328 | ;;R^"863. 9:","863.9 1:3",1,"E" | |
| 20329 | "RTN","ORY 42703",21, 0) | |
| 20330 | ;;D^GCC N UMERIC LES S THAN | |
| 20331 | "RTN","ORY 42703",22, 0) | |
| 20332 | ;;EOR^ | |
| 20333 | "RTN","ORY 42703",23, 0) | |
| 20334 | ;;KEY^863 .9:^LOGICA L FALSE | |
| 20335 | "RTN","ORY 42703",24, 0) | |
| 20336 | ;;R^"863. 9:",.01,"E " | |
| 20337 | "RTN","ORY 42703",25, 0) | |
| 20338 | ;;D^LOGIC AL FALSE | |
| 20339 | "RTN","ORY 42703",26, 0) | |
| 20340 | ;;R^"863. 9:",.02,"E " | |
| 20341 | "RTN","ORY 42703",27, 0) | |
| 20342 | ;;D^BOOLE AN | |
| 20343 | "RTN","ORY 42703",28, 0) | |
| 20344 | ;;R^"863. 9:",.03,"E " | |
| 20345 | "RTN","ORY 42703",29, 0) | |
| 20346 | ;;D^GCC B OOLEAN LOG ICAL FALSE | |
| 20347 | "RTN","ORY 42703",30, 0) | |
| 20348 | ;;R^"863. 9:",.04,"E " | |
| 20349 | "RTN","ORY 42703",31, 0) | |
| 20350 | ;;D^IS FA LSE | |
| 20351 | "RTN","ORY 42703",32, 0) | |
| 20352 | ;;R^"863. 9:","863.9 1:1",.01," E" | |
| 20353 | "RTN","ORY 42703",33, 0) | |
| 20354 | ;;D^OCXO GENERATE C ODE FUNCTI ON | |
| 20355 | "RTN","ORY 42703",34, 0) | |
| 20356 | ;;R^"863. 9:","863.9 1:1",1,"E" | |
| 20357 | "RTN","ORY 42703",35, 0) | |
| 20358 | ;;D^GCC B OOLEAN LOG ICAL FALSE | |
| 20359 | "RTN","ORY 42703",36, 0) | |
| 20360 | ;;R^"863. 9:","863.9 2:1",.01," E" | |
| 20361 | "RTN","ORY 42703",37, 0) | |
| 20362 | ;;D^FALSE | |
| 20363 | "RTN","ORY 42703",38, 0) | |
| 20364 | ;;EOR^ | |
| 20365 | "RTN","ORY 42703",39, 0) | |
| 20366 | ;;KEY^863 .9:^LOGICA L TRUE | |
| 20367 | "RTN","ORY 42703",40, 0) | |
| 20368 | ;;R^"863. 9:",.01,"E " | |
| 20369 | "RTN","ORY 42703",41, 0) | |
| 20370 | ;;D^LOGIC AL TRUE | |
| 20371 | "RTN","ORY 42703",42, 0) | |
| 20372 | ;;R^"863. 9:",.02,"E " | |
| 20373 | "RTN","ORY 42703",43, 0) | |
| 20374 | ;;D^BOOLE AN | |
| 20375 | "RTN","ORY 42703",44, 0) | |
| 20376 | ;;R^"863. 9:",.03,"E " | |
| 20377 | "RTN","ORY 42703",45, 0) | |
| 20378 | ;;D^GCC B OOLEAN LOG ICAL TRUE | |
| 20379 | "RTN","ORY 42703",46, 0) | |
| 20380 | ;;R^"863. 9:",.04,"E " | |
| 20381 | "RTN","ORY 42703",47, 0) | |
| 20382 | ;;D^IS TR UE | |
| 20383 | "RTN","ORY 42703",48, 0) | |
| 20384 | ;;R^"863. 9:","863.9 1:1",.01," E" | |
| 20385 | "RTN","ORY 42703",49, 0) | |
| 20386 | ;;D^OCXO GENERATE C ODE FUNCTI ON | |
| 20387 | "RTN","ORY 42703",50, 0) | |
| 20388 | ;;R^"863. 9:","863.9 1:1",1,"E" | |
| 20389 | "RTN","ORY 42703",51, 0) | |
| 20390 | ;;D^GCC B OOLEAN LOG ICAL TRUE | |
| 20391 | "RTN","ORY 42703",52, 0) | |
| 20392 | ;;R^"863. 9:","863.9 2:1",.01," E" | |
| 20393 | "RTN","ORY 42703",53, 0) | |
| 20394 | ;;D^TRUE | |
| 20395 | "RTN","ORY 42703",54, 0) | |
| 20396 | ;;EOR^ | |
| 20397 | "RTN","ORY 42703",55, 0) | |
| 20398 | ;;KEY^863 .9:^STARTS WITH | |
| 20399 | "RTN","ORY 42703",56, 0) | |
| 20400 | ;;R^"863. 9:",.01,"E " | |
| 20401 | "RTN","ORY 42703",57, 0) | |
| 20402 | ;;D^START S WITH | |
| 20403 | "RTN","ORY 42703",58, 0) | |
| 20404 | ;;R^"863. 9:",.02,"E " | |
| 20405 | "RTN","ORY 42703",59, 0) | |
| 20406 | ;;D^FREE TEXT | |
| 20407 | "RTN","ORY 42703",60, 0) | |
| 20408 | ;;R^"863. 9:",.04,"E " | |
| 20409 | "RTN","ORY 42703",61, 0) | |
| 20410 | ;;D^START S WITH | |
| 20411 | "RTN","ORY 42703",62, 0) | |
| 20412 | ;;R^"863. 9:","863.9 1:3",.01," E" | |
| 20413 | "RTN","ORY 42703",63, 0) | |
| 20414 | ;;D^OCXO GENERATE C ODE FUNCTI ON | |
| 20415 | "RTN","ORY 42703",64, 0) | |
| 20416 | ;;R^"863. 9:","863.9 1:3",1,"E" | |
| 20417 | "RTN","ORY 42703",65, 0) | |
| 20418 | ;;D^GCC F REE TEXT S TARTS WITH | |
| 20419 | "RTN","ORY 42703",66, 0) | |
| 20420 | ;;R^"863. 9:","863.9 2:1",.01," E" | |
| 20421 | "RTN","ORY 42703",67, 0) | |
| 20422 | ;;D^BEGIN S WITH | |
| 20423 | "RTN","ORY 42703",68, 0) | |
| 20424 | ;;EOR^ | |
| 20425 | "RTN","ORY 42703",69, 0) | |
| 20426 | ;;EOF^OCX S(863.9)^1 | |
| 20427 | "RTN","ORY 42703",70, 0) | |
| 20428 | ;;SOF^863 .4 OCX MD D ATTRIBUT E | |
| 20429 | "RTN","ORY 42703",71, 0) | |
| 20430 | ;;KEY^863 .4:^CLOZAP INE ANC W/ IN 7 FLAG | |
| 20431 | "RTN","ORY 42703",72, 0) | |
| 20432 | ;;R^"863. 4:",.01,"E " | |
| 20433 | "RTN","ORY 42703",73, 0) | |
| 20434 | ;;D^CLOZA PINE ANC W /IN 7 FLAG | |
| 20435 | "RTN","ORY 42703",74, 0) | |
| 20436 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20437 | "RTN","ORY 42703",75, 0) | |
| 20438 | ;;D^DATA TYPE | |
| 20439 | "RTN","ORY 42703",76, 0) | |
| 20440 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20441 | "RTN","ORY 42703",77, 0) | |
| 20442 | ;;D^BOOLE AN | |
| 20443 | "RTN","ORY 42703",78, 0) | |
| 20444 | ;;EOR^ | |
| 20445 | "RTN","ORY 42703",79, 0) | |
| 20446 | ;;KEY^863 .4:^CLOZAP INE ANC W/ IN 7 RESUL T | |
| 20447 | "RTN","ORY 42703",80, 0) | |
| 20448 | ;;R^"863. 4:",.01,"E " | |
| 20449 | "RTN","ORY 42703",81, 0) | |
| 20450 | ;;D^CLOZA PINE ANC W /IN 7 RESU LT | |
| 20451 | "RTN","ORY 42703",82, 0) | |
| 20452 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20453 | "RTN","ORY 42703",83, 0) | |
| 20454 | ;;D^DATA TYPE | |
| 20455 | "RTN","ORY 42703",84, 0) | |
| 20456 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20457 | "RTN","ORY 42703",85, 0) | |
| 20458 | ;;D^NUMER IC | |
| 20459 | "RTN","ORY 42703",86, 0) | |
| 20460 | ;;EOR^ | |
| 20461 | "RTN","ORY 42703",87, 0) | |
| 20462 | ;;KEY^863 .4:^CLOZAP INE LAB RE SULTS | |
| 20463 | "RTN","ORY 42703",88, 0) | |
| 20464 | ;;R^"863. 4:",.01,"E " | |
| 20465 | "RTN","ORY 42703",89, 0) | |
| 20466 | ;;D^CLOZA PINE LAB R ESULTS | |
| 20467 | "RTN","ORY 42703",90, 0) | |
| 20468 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20469 | "RTN","ORY 42703",91, 0) | |
| 20470 | ;;D^DATA TYPE | |
| 20471 | "RTN","ORY 42703",92, 0) | |
| 20472 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20473 | "RTN","ORY 42703",93, 0) | |
| 20474 | ;;D^FREE TEXT | |
| 20475 | "RTN","ORY 42703",94, 0) | |
| 20476 | ;;EOR^ | |
| 20477 | "RTN","ORY 42703",95, 0) | |
| 20478 | ;;KEY^863 .4:^CLOZAP INE MED | |
| 20479 | "RTN","ORY 42703",96, 0) | |
| 20480 | ;;R^"863. 4:",.01,"E " | |
| 20481 | "RTN","ORY 42703",97, 0) | |
| 20482 | ;;D^CLOZA PINE MED | |
| 20483 | "RTN","ORY 42703",98, 0) | |
| 20484 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20485 | "RTN","ORY 42703",99, 0) | |
| 20486 | ;;D^DATA TYPE | |
| 20487 | "RTN","ORY 42703",100 ,0) | |
| 20488 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20489 | "RTN","ORY 42703",101 ,0) | |
| 20490 | ;;D^BOOLE AN | |
| 20491 | "RTN","ORY 42703",102 ,0) | |
| 20492 | ;;EOR^ | |
| 20493 | "RTN","ORY 42703",103 ,0) | |
| 20494 | ;;KEY^863 .4:^CLOZAP INE WBC W/ IN 7 FLAG | |
| 20495 | "RTN","ORY 42703",104 ,0) | |
| 20496 | ;;R^"863. 4:",.01,"E " | |
| 20497 | "RTN","ORY 42703",105 ,0) | |
| 20498 | ;;D^CLOZA PINE WBC W /IN 7 FLAG | |
| 20499 | "RTN","ORY 42703",106 ,0) | |
| 20500 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20501 | "RTN","ORY 42703",107 ,0) | |
| 20502 | ;;D^DATA TYPE | |
| 20503 | "RTN","ORY 42703",108 ,0) | |
| 20504 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20505 | "RTN","ORY 42703",109 ,0) | |
| 20506 | ;;D^BOOLE AN | |
| 20507 | "RTN","ORY 42703",110 ,0) | |
| 20508 | ;;EOR^ | |
| 20509 | "RTN","ORY 42703",111 ,0) | |
| 20510 | ;;KEY^863 .4:^DISPEN SE DRUG | |
| 20511 | "RTN","ORY 42703",112 ,0) | |
| 20512 | ;;R^"863. 4:",.01,"E " | |
| 20513 | "RTN","ORY 42703",113 ,0) | |
| 20514 | ;;D^DISPE NSE DRUG | |
| 20515 | "RTN","ORY 42703",114 ,0) | |
| 20516 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20517 | "RTN","ORY 42703",115 ,0) | |
| 20518 | ;;D^DATA TYPE | |
| 20519 | "RTN","ORY 42703",116 ,0) | |
| 20520 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20521 | "RTN","ORY 42703",117 ,0) | |
| 20522 | ;;D^FREE TEXT | |
| 20523 | "RTN","ORY 42703",118 ,0) | |
| 20524 | ;;EOR^ | |
| 20525 | "RTN","ORY 42703",119 ,0) | |
| 20526 | ;;KEY^863 .4:^FILLER | |
| 20527 | "RTN","ORY 42703",120 ,0) | |
| 20528 | ;;R^"863. 4:",.01,"E " | |
| 20529 | "RTN","ORY 42703",121 ,0) | |
| 20530 | ;;D^FILLE R | |
| 20531 | "RTN","ORY 42703",122 ,0) | |
| 20532 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20533 | "RTN","ORY 42703",123 ,0) | |
| 20534 | ;;D^DATA TYPE | |
| 20535 | "RTN","ORY 42703",124 ,0) | |
| 20536 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20537 | "RTN","ORY 42703",125 ,0) | |
| 20538 | ;;D^FREE TEXT | |
| 20539 | "RTN","ORY 42703",126 ,0) | |
| 20540 | ;;EOR^ | |
| 20541 | "RTN","ORY 42703",127 ,0) | |
| 20542 | ;;KEY^863 .4:^HL7 FI LLER | |
| 20543 | "RTN","ORY 42703",128 ,0) | |
| 20544 | ;;R^"863. 4:",.01,"E " | |
| 20545 | "RTN","ORY 42703",129 ,0) | |
| 20546 | ;;D^HL7 F ILLER | |
| 20547 | "RTN","ORY 42703",130 ,0) | |
| 20548 | ;;R^"863. 4:",.02,"E " | |
| 20549 | "RTN","ORY 42703",131 ,0) | |
| 20550 | ;;D^HL7FI LLR | |
| 20551 | "RTN","ORY 42703",132 ,0) | |
| 20552 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20553 | "RTN","ORY 42703",133 ,0) | |
| 20554 | ;;D^DATA TYPE | |
| 20555 | "RTN","ORY 42703",134 ,0) | |
| 20556 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20557 | "RTN","ORY 42703",135 ,0) | |
| 20558 | ;;D^FREE TEXT | |
| 20559 | "RTN","ORY 42703",136 ,0) | |
| 20560 | ;;EOR^ | |
| 20561 | "RTN","ORY 42703",137 ,0) | |
| 20562 | ;;KEY^863 .4:^IEN | |
| 20563 | "RTN","ORY 42703",138 ,0) | |
| 20564 | ;;R^"863. 4:",.01,"E " | |
| 20565 | "RTN","ORY 42703",139 ,0) | |
| 20566 | ;;D^IEN | |
| 20567 | "RTN","ORY 42703",140 ,0) | |
| 20568 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20569 | "RTN","ORY 42703",141 ,0) | |
| 20570 | ;;D^DATA TYPE | |
| 20571 | "RTN","ORY 42703",142 ,0) | |
| 20572 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20573 | "RTN","ORY 42703",143 ,0) | |
| 20574 | ;;D^NUMER IC | |
| 20575 | "RTN","ORY 42703",144 ,0) | |
| 20576 | ;;EOR^ | |
| 20577 | "RTN","ORY 42703",145 ,0) | |
| 20578 | ;;KEY^863 .4:^ORDER MODE | |
| 20579 | "RTN","ORY 42703",146 ,0) | |
| 20580 | ;;R^"863. 4:",.01,"E " | |
| 20581 | "RTN","ORY 42703",147 ,0) | |
| 20582 | ;;D^ORDER MODE | |
| 20583 | "RTN","ORY 42703",148 ,0) | |
| 20584 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20585 | "RTN","ORY 42703",149 ,0) | |
| 20586 | ;;D^DATA TYPE | |
| 20587 | "RTN","ORY 42703",150 ,0) | |
| 20588 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20589 | "RTN","ORY 42703",151 ,0) | |
| 20590 | ;;D^FREE TEXT | |
| 20591 | "RTN","ORY 42703",152 ,0) | |
| 20592 | ;;EOR^ | |
| 20593 | "RTN","ORY 42703",153 ,0) | |
| 20594 | ;;KEY^863 .4:^ORDER PATIENT | |
| 20595 | "RTN","ORY 42703",154 ,0) | |
| 20596 | ;;R^"863. 4:",.01,"E " | |
| 20597 | "RTN","ORY 42703",155 ,0) | |
| 20598 | ;;D^ORDER PATIENT | |
| 20599 | "RTN","ORY 42703",156 ,0) | |
| 20600 | ;;R^"863. 4:","863.4 1:1",.01," E" | |
| 20601 | "RTN","ORY 42703",157 ,0) | |
| 20602 | ;;D^DATA TYPE | |
| 20603 | "RTN","ORY 42703",158 ,0) | |
| 20604 | ;;R^"863. 4:","863.4 1:1",1,"E" | |
| 20605 | "RTN","ORY 42703",159 ,0) | |
| 20606 | ;;D^NUMER IC | |
| 20607 | "RTN","ORY 42703",160 ,0) | |
| 20608 | ;;EOR^ | |
| 20609 | "RTN","ORY 42703",161 ,0) | |
| 20610 | ;;EOF^OCX S(863.4)^1 | |
| 20611 | "RTN","ORY 42703",162 ,0) | |
| 20612 | ;;SOF^863 .2 OCX MD D SUBJECT | |
| 20613 | "RTN","ORY 42703",163 ,0) | |
| 20614 | ;;KEY^863 .2:^PATIEN T | |
| 20615 | "RTN","ORY 42703",164 ,0) | |
| 20616 | ;;R^"863. 2:",.01,"E " | |
| 20617 | "RTN","ORY 42703",165 ,0) | |
| 20618 | ;;D^PATIE NT | |
| 20619 | "RTN","ORY 42703",166 ,0) | |
| 20620 | ;;R^"863. 2:","863.2 1:1",.01," E" | |
| 20621 | "RTN","ORY 42703",167 ,0) | |
| 20622 | ;;D^FILE | |
| 20623 | "RTN","ORY 42703",168 ,0) | |
| 20624 | ;;R^"863. 2:","863.2 1:1",1,"E" | |
| 20625 | "RTN","ORY 42703",169 ,0) | |
| 20626 | ;;D^2 | |
| 20627 | "RTN","ORY 42703",170 ,0) | |
| 20628 | ;;EOR^ | |
| 20629 | "RTN","ORY 42703",171 ,0) | |
| 20630 | ;;EOF^OCX S(863.2)^1 | |
| 20631 | "RTN","ORY 42703",172 ,0) | |
| 20632 | ;;SOF^863 .3 OCX MD D LINK | |
| 20633 | "RTN","ORY 42703",173 ,0) | |
| 20634 | ;;KEY^863 .3:^PATIEN T.CLOZAPIN E MED | |
| 20635 | "RTN","ORY 42703",174 ,0) | |
| 20636 | ;;R^"863. 3:",.01,"E " | |
| 20637 | "RTN","ORY 42703",175 ,0) | |
| 20638 | ;;D^PATIE NT.CLOZAPI NE MED | |
| 20639 | "RTN","ORY 42703",176 ,0) | |
| 20640 | ;;R^"863. 3:",.02,"E " | |
| 20641 | "RTN","ORY 42703",177 ,0) | |
| 20642 | ;;D^PATIE NT | |
| 20643 | "RTN","ORY 42703",178 ,0) | |
| 20644 | ;;R^"863. 3:",.05,"E " | |
| 20645 | "RTN","ORY 42703",179 ,0) | |
| 20646 | ;;D^CLOZA PINE MED | |
| 20647 | "RTN","ORY 42703",180 ,0) | |
| 20648 | ;;R^"863. 3:",.06,"E " | |
| 20649 | "RTN","ORY 42703",181 ,0) | |
| 20650 | ;;D^3555 | |
| 20651 | "RTN","ORY 42703",182 ,0) | |
| 20652 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20653 | "RTN","ORY 42703",183 ,0) | |
| 20654 | ;;D^OCXO EXTERNAL F UNCTION CA LL | |
| 20655 | "RTN","ORY 42703",184 ,0) | |
| 20656 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 20657 | "RTN","ORY 42703",185 ,0) | |
| 20658 | ;;D^CLOZL ABS^ORKLR( |PATIENT I EN|,7,|DIS P DRUG IEN |) | |
| 20659 | "RTN","ORY 42703",186 ,0) | |
| 20660 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 20661 | "RTN","ORY 42703",187 ,0) | |
| 20662 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 20663 | "RTN","ORY 42703",188 ,0) | |
| 20664 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 20665 | "RTN","ORY 42703",189 ,0) | |
| 20666 | ;;D^1 | |
| 20667 | "RTN","ORY 42703",190 ,0) | |
| 20668 | ;;EOR^ | |
| 20669 | "RTN","ORY 42703",191 ,0) | |
| 20670 | ;;KEY^863 .3:^PATIEN T.CLOZ_ANC _W/IN_7_FL AG | |
| 20671 | "RTN","ORY 42703",192 ,0) | |
| 20672 | ;;R^"863. 3:",.01,"E " | |
| 20673 | "RTN","ORY 42703",193 ,0) | |
| 20674 | ;;D^PATIE NT.CLOZ_AN C_W/IN_7_F LAG | |
| 20675 | "RTN","ORY 42703",194 ,0) | |
| 20676 | ;;R^"863. 3:",.02,"E " | |
| 20677 | "RTN","ORY 42703",195 ,0) | |
| 20678 | ;;D^PATIE NT | |
| 20679 | "RTN","ORY 42703",196 ,0) | |
| 20680 | ;;R^"863. 3:",.05,"E " | |
| 20681 | "RTN","ORY 42703",197 ,0) | |
| 20682 | ;;D^CLOZA PINE ANC W /IN 7 FLAG | |
| 20683 | "RTN","ORY 42703",198 ,0) | |
| 20684 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20685 | "RTN","ORY 42703",199 ,0) | |
| 20686 | ;;D^OCXO EXTERNAL F UNCTION CA LL | |
| 20687 | "RTN","ORY 42703",200 ,0) | |
| 20688 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 20689 | "RTN","ORY 42703",201 ,0) | |
| 20690 | ;;D^CLOZL ABS^ORKLR( |PATIENT I EN|,7,|DIS P DRUG IEN |) | |
| 20691 | "RTN","ORY 42703",202 ,0) | |
| 20692 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 20693 | "RTN","ORY 42703",203 ,0) | |
| 20694 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 20695 | "RTN","ORY 42703",204 ,0) | |
| 20696 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 20697 | "RTN","ORY 42703",205 ,0) | |
| 20698 | ;;D^3 | |
| 20699 | "RTN","ORY 42703",206 ,0) | |
| 20700 | ;;R^"863. 3:","863.3 2:3",.01," E" | |
| 20701 | "RTN","ORY 42703",207 ,0) | |
| 20702 | ;;D^OCXO SEMI-COLON PIECE NUM BER | |
| 20703 | "RTN","ORY 42703",208 ,0) | |
| 20704 | ;;R^"863. 3:","863.3 2:3",1,"E" | |
| 20705 | "RTN","ORY 42703",209 ,0) | |
| 20706 | ;;D^1 | |
| 20707 | "RTN","ORY 42703",210 ,0) | |
| 20708 | ;;EOR^ | |
| 20709 | "RTN","ORY 42703",211 ,0) | |
| 20710 | ;;KEY^863 .3:^PATIEN T.CLOZ_ANC _W/IN_7_RS LT | |
| 20711 | "RTN","ORY 42703",212 ,0) | |
| 20712 | ;;R^"863. 3:",.01,"E " | |
| 20713 | "RTN","ORY 42703",213 ,0) | |
| 20714 | ;;D^PATIE NT.CLOZ_AN C_W/IN_7_R SLT | |
| 20715 | "RTN","ORY 42703",214 ,0) | |
| 20716 | ;;R^"863. 3:",.02,"E " | |
| 20717 | "RTN","ORY 42703",215 ,0) | |
| 20718 | ;;D^PATIE NT | |
| 20719 | "RTN","ORY 42703",216 ,0) | |
| 20720 | ;;R^"863. 3:",.05,"E " | |
| 20721 | "RTN","ORY 42703",217 ,0) | |
| 20722 | ;;D^CLOZA PINE ANC W /IN 7 RESU LT | |
| 20723 | "RTN","ORY 42703",218 ,0) | |
| 20724 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20725 | "RTN","ORY 42703",219 ,0) | |
| 20726 | ;;D^OCXO EXTERNAL F UNCTION CA LL | |
| 20727 | "RTN","ORY 42703",220 ,0) | |
| 20728 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 20729 | "RTN","ORY 42703",221 ,0) | |
| 20730 | ;;D^CLOZL ABS^ORKLR( |PATIENT I EN|,7,|DIS P DRUG IEN |) | |
| 20731 | "RTN","ORY 42703",222 ,0) | |
| 20732 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 20733 | "RTN","ORY 42703",223 ,0) | |
| 20734 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 20735 | "RTN","ORY 42703",224 ,0) | |
| 20736 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 20737 | "RTN","ORY 42703",225 ,0) | |
| 20738 | ;;D^3 | |
| 20739 | "RTN","ORY 42703",226 ,0) | |
| 20740 | ;;R^"863. 3:","863.3 2:3",.01," E" | |
| 20741 | "RTN","ORY 42703",227 ,0) | |
| 20742 | ;;D^OCXO SEMI-COLON PIECE NUM BER | |
| 20743 | "RTN","ORY 42703",228 ,0) | |
| 20744 | ;;R^"863. 3:","863.3 2:3",1,"E" | |
| 20745 | "RTN","ORY 42703",229 ,0) | |
| 20746 | ;;D^2 | |
| 20747 | "RTN","ORY 42703",230 ,0) | |
| 20748 | ;;EOR^ | |
| 20749 | "RTN","ORY 42703",231 ,0) | |
| 20750 | ;;KEY^863 .3:^PATIEN T.CLOZ_LAB _RESULTS | |
| 20751 | "RTN","ORY 42703",232 ,0) | |
| 20752 | ;;R^"863. 3:",.01,"E " | |
| 20753 | "RTN","ORY 42703",233 ,0) | |
| 20754 | ;;D^PATIE NT.CLOZ_LA B_RESULTS | |
| 20755 | "RTN","ORY 42703",234 ,0) | |
| 20756 | ;;R^"863. 3:",.02,"E " | |
| 20757 | "RTN","ORY 42703",235 ,0) | |
| 20758 | ;;D^PATIE NT | |
| 20759 | "RTN","ORY 42703",236 ,0) | |
| 20760 | ;;R^"863. 3:",.05,"E " | |
| 20761 | "RTN","ORY 42703",237 ,0) | |
| 20762 | ;;D^CLOZA PINE LAB R ESULTS | |
| 20763 | "RTN","ORY 42703",238 ,0) | |
| 20764 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20765 | "RTN","ORY 42703",239 ,0) | |
| 20766 | ;;D^OCXO EXTERNAL F UNCTION CA LL | |
| 20767 | "RTN","ORY 42703",240 ,0) | |
| 20768 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 20769 | "RTN","ORY 42703",241 ,0) | |
| 20770 | ;;D^CLOZL ABS^ORKLR( |PATIENT I EN|,"",|DI SP DRUG IE N|) | |
| 20771 | "RTN","ORY 42703",242 ,0) | |
| 20772 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 20773 | "RTN","ORY 42703",243 ,0) | |
| 20774 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 20775 | "RTN","ORY 42703",244 ,0) | |
| 20776 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 20777 | "RTN","ORY 42703",245 ,0) | |
| 20778 | ;;D^4 | |
| 20779 | "RTN","ORY 42703",246 ,0) | |
| 20780 | ;;EOR^ | |
| 20781 | "RTN","ORY 42703",247 ,0) | |
| 20782 | ;;KEY^863 .3:^PATIEN T.CLOZ_WBC _W/IN_7_FL AG | |
| 20783 | "RTN","ORY 42703",248 ,0) | |
| 20784 | ;;R^"863. 3:",.01,"E " | |
| 20785 | "RTN","ORY 42703",249 ,0) | |
| 20786 | ;;D^PATIE NT.CLOZ_WB C_W/IN_7_F LAG | |
| 20787 | "RTN","ORY 42703",250 ,0) | |
| 20788 | ;;R^"863. 3:",.02,"E " | |
| 20789 | "RTN","ORY 42703",251 ,0) | |
| 20790 | ;;D^PATIE NT | |
| 20791 | "RTN","ORY 42703",252 ,0) | |
| 20792 | ;;R^"863. 3:",.05,"E " | |
| 20793 | "RTN","ORY 42703",253 ,0) | |
| 20794 | ;;D^CLOZA PINE WBC W /IN 7 FLAG | |
| 20795 | "RTN","ORY 42703",254 ,0) | |
| 20796 | ;;R^"863. 3:",.06,"E " | |
| 20797 | "RTN","ORY 42703",255 ,0) | |
| 20798 | ;;D^999 | |
| 20799 | "RTN","ORY 42703",256 ,0) | |
| 20800 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20801 | "RTN","ORY 42703",257 ,0) | |
| 20802 | ;;D^OCXO EXTERNAL F UNCTION CA LL | |
| 20803 | "RTN","ORY 42703",258 ,0) | |
| 20804 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 20805 | "RTN","ORY 42703",259 ,0) | |
| 20806 | ;;D^CLOZL ABS^ORKLR( |PATIENT I EN|,7,|DIS P DRUG IEN |) | |
| 20807 | "RTN","ORY 42703",260 ,0) | |
| 20808 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 20809 | "RTN","ORY 42703",261 ,0) | |
| 20810 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 20811 | "RTN","ORY 42703",262 ,0) | |
| 20812 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 20813 | "RTN","ORY 42703",263 ,0) | |
| 20814 | ;;D^2 | |
| 20815 | "RTN","ORY 42703",264 ,0) | |
| 20816 | ;;R^"863. 3:","863.3 2:3",.01," E" | |
| 20817 | "RTN","ORY 42703",265 ,0) | |
| 20818 | ;;D^OCXO SEMI-COLON PIECE NUM BER | |
| 20819 | "RTN","ORY 42703",266 ,0) | |
| 20820 | ;;R^"863. 3:","863.3 2:3",1,"E" | |
| 20821 | "RTN","ORY 42703",267 ,0) | |
| 20822 | ;;D^1 | |
| 20823 | "RTN","ORY 42703",268 ,0) | |
| 20824 | ;;EOR^ | |
| 20825 | "RTN","ORY 42703",269 ,0) | |
| 20826 | ;;KEY^863 .3:^PATIEN T.HL7_FILL ER | |
| 20827 | "RTN","ORY 42703",270 ,0) | |
| 20828 | ;;R^"863. 3:",.01,"E " | |
| 20829 | "RTN","ORY 42703",271 ,0) | |
| 20830 | ;;D^PATIE NT.HL7_FIL LER | |
| 20831 | "RTN","ORY 42703",272 ,0) | |
| 20832 | ;;R^"863. 3:",.02,"E " | |
| 20833 | "RTN","ORY 42703",273 ,0) | |
| 20834 | ;;D^PATIE NT | |
| 20835 | "RTN","ORY 42703",274 ,0) | |
| 20836 | ;;R^"863. 3:",.04,"E " | |
| 20837 | "RTN","ORY 42703",275 ,0) | |
| 20838 | ;;D^HL7 | |
| 20839 | "RTN","ORY 42703",276 ,0) | |
| 20840 | ;;R^"863. 3:",.05,"E " | |
| 20841 | "RTN","ORY 42703",277 ,0) | |
| 20842 | ;;D^HL7 F ILLER | |
| 20843 | "RTN","ORY 42703",278 ,0) | |
| 20844 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20845 | "RTN","ORY 42703",279 ,0) | |
| 20846 | ;;D^OCXO VT-BAR PIE CE NUMBER | |
| 20847 | "RTN","ORY 42703",280 ,0) | |
| 20848 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 20849 | "RTN","ORY 42703",281 ,0) | |
| 20850 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 20851 | "RTN","ORY 42703",282 ,0) | |
| 20852 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 20853 | "RTN","ORY 42703",283 ,0) | |
| 20854 | ;;D^2 | |
| 20855 | "RTN","ORY 42703",284 ,0) | |
| 20856 | ;;R^"863. 3:","863.3 2:3",.01," E" | |
| 20857 | "RTN","ORY 42703",285 ,0) | |
| 20858 | ;;D^OCXO VARIABLE N AME | |
| 20859 | "RTN","ORY 42703",286 ,0) | |
| 20860 | ;;R^"863. 3:","863.3 2:3",1,"E" | |
| 20861 | "RTN","ORY 42703",287 ,0) | |
| 20862 | ;;D^OCXOD ATA("ORC", 3) | |
| 20863 | "RTN","ORY 42703",288 ,0) | |
| 20864 | ;;R^"863. 3:","863.3 2:4",.01," E" | |
| 20865 | "RTN","ORY 42703",289 ,0) | |
| 20866 | ;;D^OCXO HL7 SEGMEN T ID | |
| 20867 | "RTN","ORY 42703",290 ,0) | |
| 20868 | ;;R^"863. 3:","863.3 2:5",.01," E" | |
| 20869 | "RTN","ORY 42703",291 ,0) | |
| 20870 | ;;D^OCXO DATA DRIVE SOURCE | |
| 20871 | "RTN","ORY 42703",292 ,0) | |
| 20872 | ;;R^"863. 3:","863.3 2:5",1,"E" | |
| 20873 | "RTN","ORY 42703",293 ,0) | |
| 20874 | ;;D^HL7 | |
| 20875 | "RTN","ORY 42703",294 ,0) | |
| 20876 | ;;R^"863. 3:","863.3 2:6",.01," E" | |
| 20877 | "RTN","ORY 42703",295 ,0) | |
| 20878 | ;;D^OCXO FILE POINT ER | |
| 20879 | "RTN","ORY 42703",296 ,0) | |
| 20880 | ;;EOR^ | |
| 20881 | "RTN","ORY 42703",297 ,0) | |
| 20882 | ;;KEY^863 .3:^PATIEN T.HL7_PATI ENT_ID | |
| 20883 | "RTN","ORY 42703",298 ,0) | |
| 20884 | ;;R^"863. 3:",.01,"E " | |
| 20885 | "RTN","ORY 42703",299 ,0) | |
| 20886 | ;;D^PATIE NT.HL7_PAT IENT_ID | |
| 20887 | "RTN","ORY 42703",300 ,0) | |
| 20888 | ;;R^"863. 3:",.02,"E " | |
| 20889 | "RTN","ORY 42703",301 ,0) | |
| 20890 | ;;D^PATIE NT | |
| 20891 | "RTN","ORY 42703",302 ,0) | |
| 20892 | ;;R^"863. 3:",.04,"E " | |
| 20893 | "RTN","ORY 42703",303 ,0) | |
| 20894 | ;;D^HL7 | |
| 20895 | "RTN","ORY 42703",304 ,0) | |
| 20896 | ;;R^"863. 3:",.05,"E " | |
| 20897 | "RTN","ORY 42703",305 ,0) | |
| 20898 | ;;D^IEN | |
| 20899 | "RTN","ORY 42703",306 ,0) | |
| 20900 | ;;R^"863. 3:",.06,"E " | |
| 20901 | "RTN","ORY 42703",307 ,0) | |
| 20902 | ;;D^99 | |
| 20903 | "RTN","ORY 42703",308 ,0) | |
| 20904 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20905 | "RTN","ORY 42703",309 ,0) | |
| 20906 | ;;D^OCXO HL7 SEGMEN T ID | |
| 20907 | "RTN","ORY 42703",310 ,0) | |
| 20908 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 20909 | "RTN","ORY 42703",311 ,0) | |
| 20910 | ;;D^OCXO VT-BAR PIE CE NUMBER | |
| 20911 | "RTN","ORY 42703",312 ,0) | |
| 20912 | ;;R^"863. 3:","863.3 2:3",.01," E" | |
| 20913 | "RTN","ORY 42703",313 ,0) | |
| 20914 | ;;D^OCXO VARIABLE N AME | |
| 20915 | "RTN","ORY 42703",314 ,0) | |
| 20916 | ;;R^"863. 3:","863.3 2:3",1,"E" | |
| 20917 | "RTN","ORY 42703",315 ,0) | |
| 20918 | ;;D^OCXOD ATA("PID", 3) | |
| 20919 | "RTN","ORY 42703",316 ,0) | |
| 20920 | ;;EOR^ | |
| 20921 | "RTN","ORY 42703",317 ,0) | |
| 20922 | ;;KEY^863 .3:^PATIEN T.IEN | |
| 20923 | "RTN","ORY 42703",318 ,0) | |
| 20924 | ;;R^"863. 3:",.01,"E " | |
| 20925 | "RTN","ORY 42703",319 ,0) | |
| 20926 | ;;D^PATIE NT.IEN | |
| 20927 | "RTN","ORY 42703",320 ,0) | |
| 20928 | ;;R^"863. 3:",.02,"E " | |
| 20929 | "RTN","ORY 42703",321 ,0) | |
| 20930 | ;;D^PATIE NT | |
| 20931 | "RTN","ORY 42703",322 ,0) | |
| 20932 | ;;R^"863. 3:",.05,"E " | |
| 20933 | "RTN","ORY 42703",323 ,0) | |
| 20934 | ;1; | |
| 20935 | "RTN","ORY 42703",324 ,0) | |
| 20936 | ; | |
| 20937 | "RTN","ORY 42704") | |
| 20938 | 0^9^B83644 761 | |
| 20939 | "RTN","ORY 42704",1,0 ) | |
| 20940 | ORY42704 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 20941 | "RTN","ORY 42704",2,0 ) | |
| 20942 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 20943 | "RTN","ORY 42704",3,0 ) | |
| 20944 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 20945 | "RTN","ORY 42704",4,0 ) | |
| 20946 | ; | |
| 20947 | "RTN","ORY 42704",5,0 ) | |
| 20948 | S ; | |
| 20949 | "RTN","ORY 42704",6,0 ) | |
| 20950 | ; | |
| 20951 | "RTN","ORY 42704",7,0 ) | |
| 20952 | D DOT^ORY 427ES | |
| 20953 | "RTN","ORY 42704",8,0 ) | |
| 20954 | ; | |
| 20955 | "RTN","ORY 42704",9,0 ) | |
| 20956 | ; | |
| 20957 | "RTN","ORY 42704",10, 0) | |
| 20958 | K REMOTE, LOCAL,OPCO DE,REF | |
| 20959 | "RTN","ORY 42704",11, 0) | |
| 20960 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 20961 | "RTN","ORY 42704",12, 0) | |
| 20962 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 20963 | "RTN","ORY 42704",13, 0) | |
| 20964 | ; | |
| 20965 | "RTN","ORY 42704",14, 0) | |
| 20966 | G ^ORY427 05 | |
| 20967 | "RTN","ORY 42704",15, 0) | |
| 20968 | ; | |
| 20969 | "RTN","ORY 42704",16, 0) | |
| 20970 | Q | |
| 20971 | "RTN","ORY 42704",17, 0) | |
| 20972 | ; | |
| 20973 | "RTN","ORY 42704",18, 0) | |
| 20974 | DATA ; | |
| 20975 | "RTN","ORY 42704",19, 0) | |
| 20976 | ; | |
| 20977 | "RTN","ORY 42704",20, 0) | |
| 20978 | ;;D^IEN | |
| 20979 | "RTN","ORY 42704",21, 0) | |
| 20980 | ;;R^"863. 3:",.06,"E " | |
| 20981 | "RTN","ORY 42704",22, 0) | |
| 20982 | ;;D^99 | |
| 20983 | "RTN","ORY 42704",23, 0) | |
| 20984 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 20985 | "RTN","ORY 42704",24, 0) | |
| 20986 | ;;D^OCXO VARIABLE N AME | |
| 20987 | "RTN","ORY 42704",25, 0) | |
| 20988 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 20989 | "RTN","ORY 42704",26, 0) | |
| 20990 | ;;D^DFN | |
| 20991 | "RTN","ORY 42704",27, 0) | |
| 20992 | ;;EOR^ | |
| 20993 | "RTN","ORY 42704",28, 0) | |
| 20994 | ;;KEY^863 .3:^PATIEN T.OERR_ORD ER_PATIENT | |
| 20995 | "RTN","ORY 42704",29, 0) | |
| 20996 | ;;R^"863. 3:",.01,"E " | |
| 20997 | "RTN","ORY 42704",30, 0) | |
| 20998 | ;;D^PATIE NT.OERR_OR DER_PATIEN T | |
| 20999 | "RTN","ORY 42704",31, 0) | |
| 21000 | ;;R^"863. 3:",.02,"E " | |
| 21001 | "RTN","ORY 42704",32, 0) | |
| 21002 | ;;D^PATIE NT | |
| 21003 | "RTN","ORY 42704",33, 0) | |
| 21004 | ;;R^"863. 3:",.05,"E " | |
| 21005 | "RTN","ORY 42704",34, 0) | |
| 21006 | ;;D^ORDER PATIENT | |
| 21007 | "RTN","ORY 42704",35, 0) | |
| 21008 | ;;R^"863. 3:",.06,"E " | |
| 21009 | "RTN","ORY 42704",36, 0) | |
| 21010 | ;;D^5567 | |
| 21011 | "RTN","ORY 42704",37, 0) | |
| 21012 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 21013 | "RTN","ORY 42704",38, 0) | |
| 21014 | ;;D^OCXO VARIABLE N AME | |
| 21015 | "RTN","ORY 42704",39, 0) | |
| 21016 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 21017 | "RTN","ORY 42704",40, 0) | |
| 21018 | ;;D^OCXOR D | |
| 21019 | "RTN","ORY 42704",41, 0) | |
| 21020 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 21021 | "RTN","ORY 42704",42, 0) | |
| 21022 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 21023 | "RTN","ORY 42704",43, 0) | |
| 21024 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 21025 | "RTN","ORY 42704",44, 0) | |
| 21026 | ;;D^1 | |
| 21027 | "RTN","ORY 42704",45, 0) | |
| 21028 | ;;EOR^ | |
| 21029 | "RTN","ORY 42704",46, 0) | |
| 21030 | ;;KEY^863 .3:^PATIEN T.OPS_DRUG _ID | |
| 21031 | "RTN","ORY 42704",47, 0) | |
| 21032 | ;;R^"863. 3:",.01,"E " | |
| 21033 | "RTN","ORY 42704",48, 0) | |
| 21034 | ;;D^PATIE NT.OPS_DRU G_ID | |
| 21035 | "RTN","ORY 42704",49, 0) | |
| 21036 | ;;R^"863. 3:",.02,"E " | |
| 21037 | "RTN","ORY 42704",50, 0) | |
| 21038 | ;;D^PATIE NT | |
| 21039 | "RTN","ORY 42704",51, 0) | |
| 21040 | ;;R^"863. 3:",.05,"E " | |
| 21041 | "RTN","ORY 42704",52, 0) | |
| 21042 | ;;D^DISPE NSE DRUG | |
| 21043 | "RTN","ORY 42704",53, 0) | |
| 21044 | ;;R^"863. 3:",.06,"E " | |
| 21045 | "RTN","ORY 42704",54, 0) | |
| 21046 | ;;D^33 | |
| 21047 | "RTN","ORY 42704",55, 0) | |
| 21048 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 21049 | "RTN","ORY 42704",56, 0) | |
| 21050 | ;;D^OCXO VARIABLE N AME | |
| 21051 | "RTN","ORY 42704",57, 0) | |
| 21052 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 21053 | "RTN","ORY 42704",58, 0) | |
| 21054 | ;;D^OCXPS D | |
| 21055 | "RTN","ORY 42704",59, 0) | |
| 21056 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 21057 | "RTN","ORY 42704",60, 0) | |
| 21058 | ;;D^OCXO VT-BAR PIE CE NUMBER | |
| 21059 | "RTN","ORY 42704",61, 0) | |
| 21060 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 21061 | "RTN","ORY 42704",62, 0) | |
| 21062 | ;;D^2 | |
| 21063 | "RTN","ORY 42704",63, 0) | |
| 21064 | ;;R^"863. 3:","863.3 2:3",.01," E" | |
| 21065 | "RTN","ORY 42704",64, 0) | |
| 21066 | ;;D^OCXO UP-ARROW P IECE NUMBE R | |
| 21067 | "RTN","ORY 42704",65, 0) | |
| 21068 | ;;R^"863. 3:","863.3 2:3",1,"E" | |
| 21069 | "RTN","ORY 42704",66, 0) | |
| 21070 | ;;D^4 | |
| 21071 | "RTN","ORY 42704",67, 0) | |
| 21072 | ;;EOR^ | |
| 21073 | "RTN","ORY 42704",68, 0) | |
| 21074 | ;;KEY^863 .3:^PATIEN T.OPS_FILL ER | |
| 21075 | "RTN","ORY 42704",69, 0) | |
| 21076 | ;;R^"863. 3:",.01,"E " | |
| 21077 | "RTN","ORY 42704",70, 0) | |
| 21078 | ;;D^PATIE NT.OPS_FIL LER | |
| 21079 | "RTN","ORY 42704",71, 0) | |
| 21080 | ;;R^"863. 3:",.02,"E " | |
| 21081 | "RTN","ORY 42704",72, 0) | |
| 21082 | ;;D^PATIE NT | |
| 21083 | "RTN","ORY 42704",73, 0) | |
| 21084 | ;;R^"863. 3:",.04,"E " | |
| 21085 | "RTN","ORY 42704",74, 0) | |
| 21086 | ;;D^OPS | |
| 21087 | "RTN","ORY 42704",75, 0) | |
| 21088 | ;;R^"863. 3:",.05,"E " | |
| 21089 | "RTN","ORY 42704",76, 0) | |
| 21090 | ;;D^FILLE R | |
| 21091 | "RTN","ORY 42704",77, 0) | |
| 21092 | ;;R^"863. 3:",.06,"E " | |
| 21093 | "RTN","ORY 42704",78, 0) | |
| 21094 | ;;D^99 | |
| 21095 | "RTN","ORY 42704",79, 0) | |
| 21096 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 21097 | "RTN","ORY 42704",80, 0) | |
| 21098 | ;;D^OCXO VARIABLE N AME | |
| 21099 | "RTN","ORY 42704",81, 0) | |
| 21100 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 21101 | "RTN","ORY 42704",82, 0) | |
| 21102 | ;;D^OCXPS D | |
| 21103 | "RTN","ORY 42704",83, 0) | |
| 21104 | ;;R^"863. 3:","863.3 2:2",.01," E" | |
| 21105 | "RTN","ORY 42704",84, 0) | |
| 21106 | ;;D^OCXO VT-BAR PIE CE NUMBER | |
| 21107 | "RTN","ORY 42704",85, 0) | |
| 21108 | ;;R^"863. 3:","863.3 2:2",1,"E" | |
| 21109 | "RTN","ORY 42704",86, 0) | |
| 21110 | ;;D^1 | |
| 21111 | "RTN","ORY 42704",87, 0) | |
| 21112 | ;;EOR^ | |
| 21113 | "RTN","ORY 42704",88, 0) | |
| 21114 | ;;KEY^863 .3:^PATIEN T.OPS_ORD_ MODE | |
| 21115 | "RTN","ORY 42704",89, 0) | |
| 21116 | ;;R^"863. 3:",.01,"E " | |
| 21117 | "RTN","ORY 42704",90, 0) | |
| 21118 | ;;D^PATIE NT.OPS_ORD _MODE | |
| 21119 | "RTN","ORY 42704",91, 0) | |
| 21120 | ;;R^"863. 3:",.02,"E " | |
| 21121 | "RTN","ORY 42704",92, 0) | |
| 21122 | ;;D^PATIE NT | |
| 21123 | "RTN","ORY 42704",93, 0) | |
| 21124 | ;;R^"863. 3:",.04,"E " | |
| 21125 | "RTN","ORY 42704",94, 0) | |
| 21126 | ;;D^OPS | |
| 21127 | "RTN","ORY 42704",95, 0) | |
| 21128 | ;;R^"863. 3:",.05,"E " | |
| 21129 | "RTN","ORY 42704",96, 0) | |
| 21130 | ;;D^ORDER MODE | |
| 21131 | "RTN","ORY 42704",97, 0) | |
| 21132 | ;;R^"863. 3:",.06,"E " | |
| 21133 | "RTN","ORY 42704",98, 0) | |
| 21134 | ;;D^99 | |
| 21135 | "RTN","ORY 42704",99, 0) | |
| 21136 | ;;R^"863. 3:","863.3 2:1",.01," E" | |
| 21137 | "RTN","ORY 42704",100 ,0) | |
| 21138 | ;;D^OCXO VARIABLE N AME | |
| 21139 | "RTN","ORY 42704",101 ,0) | |
| 21140 | ;;R^"863. 3:","863.3 2:1",1,"E" | |
| 21141 | "RTN","ORY 42704",102 ,0) | |
| 21142 | ;;D^OCXPS M | |
| 21143 | "RTN","ORY 42704",103 ,0) | |
| 21144 | ;;EOR^ | |
| 21145 | "RTN","ORY 42704",104 ,0) | |
| 21146 | ;;EOF^OCX S(863.3)^1 | |
| 21147 | "RTN","ORY 42704",105 ,0) | |
| 21148 | ;;SOF^860 .9 ORDER CHECK NATI ONAL TERM | |
| 21149 | "RTN","ORY 42704",106 ,0) | |
| 21150 | ;;KEY^860 .9:^ANGIOG RAM (PERIP HERAL) | |
| 21151 | "RTN","ORY 42704",107 ,0) | |
| 21152 | ;;R^"860. 9:",.01,"E " | |
| 21153 | "RTN","ORY 42704",108 ,0) | |
| 21154 | ;;D^ANGIO GRAM (PERI PHERAL) | |
| 21155 | "RTN","ORY 42704",109 ,0) | |
| 21156 | ;;R^"860. 9:",.02,"E " | |
| 21157 | "RTN","ORY 42704",110 ,0) | |
| 21158 | ;;D^101.4 3 | |
| 21159 | "RTN","ORY 42704",111 ,0) | |
| 21160 | ;;EOR^ | |
| 21161 | "RTN","ORY 42704",112 ,0) | |
| 21162 | ;;KEY^860 .9:^BLOOD SPECIMEN | |
| 21163 | "RTN","ORY 42704",113 ,0) | |
| 21164 | ;;R^"860. 9:",.01,"E " | |
| 21165 | "RTN","ORY 42704",114 ,0) | |
| 21166 | ;;D^BLOOD SPECIMEN | |
| 21167 | "RTN","ORY 42704",115 ,0) | |
| 21168 | ;;R^"860. 9:",.02,"E " | |
| 21169 | "RTN","ORY 42704",116 ,0) | |
| 21170 | ;;D^61 | |
| 21171 | "RTN","ORY 42704",117 ,0) | |
| 21172 | ;;EOR^ | |
| 21173 | "RTN","ORY 42704",118 ,0) | |
| 21174 | ;;KEY^860 .9:^DANGER OUS MEDS F OR PTS > 6 4 | |
| 21175 | "RTN","ORY 42704",119 ,0) | |
| 21176 | ;;R^"860. 9:",.01,"E " | |
| 21177 | "RTN","ORY 42704",120 ,0) | |
| 21178 | ;;D^DANGE ROUS MEDS FOR PTS > 64 | |
| 21179 | "RTN","ORY 42704",121 ,0) | |
| 21180 | ;;R^"860. 9:",.02,"E " | |
| 21181 | "RTN","ORY 42704",122 ,0) | |
| 21182 | ;;D^101.4 3 | |
| 21183 | "RTN","ORY 42704",123 ,0) | |
| 21184 | ;;R^"860. 9:",2,"E" | |
| 21185 | "RTN","ORY 42704",124 ,0) | |
| 21186 | ;;D^I $P( $G(^ORD(10 0.98,$P($G (^ORD(101. 43,+Y,0)), U,5),0)),U )="PHARMAC Y" | |
| 21187 | "RTN","ORY 42704",125 ,0) | |
| 21188 | ;;EOR^ | |
| 21189 | "RTN","ORY 42704",126 ,0) | |
| 21190 | ;;KEY^860 .9:^DNR | |
| 21191 | "RTN","ORY 42704",127 ,0) | |
| 21192 | ;;R^"860. 9:",.01,"E " | |
| 21193 | "RTN","ORY 42704",128 ,0) | |
| 21194 | ;;D^DNR | |
| 21195 | "RTN","ORY 42704",129 ,0) | |
| 21196 | ;;R^"860. 9:",.02,"E " | |
| 21197 | "RTN","ORY 42704",130 ,0) | |
| 21198 | ;;D^101.4 3 | |
| 21199 | "RTN","ORY 42704",131 ,0) | |
| 21200 | ;;EOR^ | |
| 21201 | "RTN","ORY 42704",132 ,0) | |
| 21202 | ;;KEY^860 .9:^EGFR | |
| 21203 | "RTN","ORY 42704",133 ,0) | |
| 21204 | ;;R^"860. 9:",.01,"E " | |
| 21205 | "RTN","ORY 42704",134 ,0) | |
| 21206 | ;;D^EGFR | |
| 21207 | "RTN","ORY 42704",135 ,0) | |
| 21208 | ;;R^"860. 9:",.02,"E " | |
| 21209 | "RTN","ORY 42704",136 ,0) | |
| 21210 | ;;D^60 | |
| 21211 | "RTN","ORY 42704",137 ,0) | |
| 21212 | ;;EOR^ | |
| 21213 | "RTN","ORY 42704",138 ,0) | |
| 21214 | ;;KEY^860 .9:^FOOD-D RUG INTERA CTION MED | |
| 21215 | "RTN","ORY 42704",139 ,0) | |
| 21216 | ;;R^"860. 9:",.01,"E " | |
| 21217 | "RTN","ORY 42704",140 ,0) | |
| 21218 | ;;D^FOOD- DRUG INTER ACTION MED | |
| 21219 | "RTN","ORY 42704",141 ,0) | |
| 21220 | ;;R^"860. 9:",.02,"E " | |
| 21221 | "RTN","ORY 42704",142 ,0) | |
| 21222 | ;;D^101.4 3 | |
| 21223 | "RTN","ORY 42704",143 ,0) | |
| 21224 | ;;R^"860. 9:",2,"E" | |
| 21225 | "RTN","ORY 42704",144 ,0) | |
| 21226 | ;;D^I $P( $G(^ORD(10 0.98,$P($G (^ORD(101. 43,+Y,0)), U,5),0)),U )="PHARMAC Y" | |
| 21227 | "RTN","ORY 42704",145 ,0) | |
| 21228 | ;;EOR^ | |
| 21229 | "RTN","ORY 42704",146 ,0) | |
| 21230 | ;;KEY^860 .9:^NPO | |
| 21231 | "RTN","ORY 42704",147 ,0) | |
| 21232 | ;;R^"860. 9:",.01,"E " | |
| 21233 | "RTN","ORY 42704",148 ,0) | |
| 21234 | ;;D^NPO | |
| 21235 | "RTN","ORY 42704",149 ,0) | |
| 21236 | ;;R^"860. 9:",.02,"E " | |
| 21237 | "RTN","ORY 42704",150 ,0) | |
| 21238 | ;;D^101.4 3 | |
| 21239 | "RTN","ORY 42704",151 ,0) | |
| 21240 | ;;EOR^ | |
| 21241 | "RTN","ORY 42704",152 ,0) | |
| 21242 | ;;KEY^860 .9:^ONE TI ME MED | |
| 21243 | "RTN","ORY 42704",153 ,0) | |
| 21244 | ;;R^"860. 9:",.01,"E " | |
| 21245 | "RTN","ORY 42704",154 ,0) | |
| 21246 | ;;D^ONE T IME MED | |
| 21247 | "RTN","ORY 42704",155 ,0) | |
| 21248 | ;;R^"860. 9:",.02,"E " | |
| 21249 | "RTN","ORY 42704",156 ,0) | |
| 21250 | ;;D^51.1 | |
| 21251 | "RTN","ORY 42704",157 ,0) | |
| 21252 | ;;R^"860. 9:",2,"E" | |
| 21253 | "RTN","ORY 42704",158 ,0) | |
| 21254 | ;;D^I $E( $P(^(0),U, 4),1,2)="P S" | |
| 21255 | "RTN","ORY 42704",159 ,0) | |
| 21256 | ;;EOR^ | |
| 21257 | "RTN","ORY 42704",160 ,0) | |
| 21258 | ;;KEY^860 .9:^PARTIA L THROMBOP LASTIN TIM E | |
| 21259 | "RTN","ORY 42704",161 ,0) | |
| 21260 | ;;R^"860. 9:",.01,"E " | |
| 21261 | "RTN","ORY 42704",162 ,0) | |
| 21262 | ;;D^PARTI AL THROMBO PLASTIN TI ME | |
| 21263 | "RTN","ORY 42704",163 ,0) | |
| 21264 | ;;R^"860. 9:",.02,"E " | |
| 21265 | "RTN","ORY 42704",164 ,0) | |
| 21266 | ;;D^101.4 3 | |
| 21267 | "RTN","ORY 42704",165 ,0) | |
| 21268 | ;;EOR^ | |
| 21269 | "RTN","ORY 42704",166 ,0) | |
| 21270 | ;;KEY^860 .9:^PROTHR OMBIN TIME | |
| 21271 | "RTN","ORY 42704",167 ,0) | |
| 21272 | ;;R^"860. 9:",.01,"E " | |
| 21273 | "RTN","ORY 42704",168 ,0) | |
| 21274 | ;;D^PROTH ROMBIN TIM E | |
| 21275 | "RTN","ORY 42704",169 ,0) | |
| 21276 | ;;R^"860. 9:",.02,"E " | |
| 21277 | "RTN","ORY 42704",170 ,0) | |
| 21278 | ;;D^101.4 3 | |
| 21279 | "RTN","ORY 42704",171 ,0) | |
| 21280 | ;;EOR^ | |
| 21281 | "RTN","ORY 42704",172 ,0) | |
| 21282 | ;;KEY^860 .9:^SERUM CREATININE | |
| 21283 | "RTN","ORY 42704",173 ,0) | |
| 21284 | ;;R^"860. 9:",.01,"E " | |
| 21285 | "RTN","ORY 42704",174 ,0) | |
| 21286 | ;;D^SERUM CREATININ E | |
| 21287 | "RTN","ORY 42704",175 ,0) | |
| 21288 | ;;R^"860. 9:",.02,"E " | |
| 21289 | "RTN","ORY 42704",176 ,0) | |
| 21290 | ;;D^60 | |
| 21291 | "RTN","ORY 42704",177 ,0) | |
| 21292 | ;;EOR^ | |
| 21293 | "RTN","ORY 42704",178 ,0) | |
| 21294 | ;;KEY^860 .9:^SERUM SPECIMEN | |
| 21295 | "RTN","ORY 42704",179 ,0) | |
| 21296 | ;;R^"860. 9:",.01,"E " | |
| 21297 | "RTN","ORY 42704",180 ,0) | |
| 21298 | ;;D^SERUM SPECIMEN | |
| 21299 | "RTN","ORY 42704",181 ,0) | |
| 21300 | ;;R^"860. 9:",.02,"E " | |
| 21301 | "RTN","ORY 42704",182 ,0) | |
| 21302 | ;;D^61 | |
| 21303 | "RTN","ORY 42704",183 ,0) | |
| 21304 | ;;EOR^ | |
| 21305 | "RTN","ORY 42704",184 ,0) | |
| 21306 | ;;KEY^860 .9:^SERUM UREA NITRO GEN | |
| 21307 | "RTN","ORY 42704",185 ,0) | |
| 21308 | ;;R^"860. 9:",.01,"E " | |
| 21309 | "RTN","ORY 42704",186 ,0) | |
| 21310 | ;;D^SERUM UREA NITR OGEN | |
| 21311 | "RTN","ORY 42704",187 ,0) | |
| 21312 | ;;R^"860. 9:",.02,"E " | |
| 21313 | "RTN","ORY 42704",188 ,0) | |
| 21314 | ;;D^60 | |
| 21315 | "RTN","ORY 42704",189 ,0) | |
| 21316 | ;;EOR^ | |
| 21317 | "RTN","ORY 42704",190 ,0) | |
| 21318 | ;;KEY^860 .9:^THROMB OPLASTIN T IME PARTIA L | |
| 21319 | "RTN","ORY 42704",191 ,0) | |
| 21320 | ;;R^"860. 9:",.01,"E " | |
| 21321 | "RTN","ORY 42704",192 ,0) | |
| 21322 | ;;D^THROM BOPLASTIN TIME PARTI AL | |
| 21323 | "RTN","ORY 42704",193 ,0) | |
| 21324 | ;;R^"860. 9:",.02,"E " | |
| 21325 | "RTN","ORY 42704",194 ,0) | |
| 21326 | ;;D^60 | |
| 21327 | "RTN","ORY 42704",195 ,0) | |
| 21328 | ;;EOR^ | |
| 21329 | "RTN","ORY 42704",196 ,0) | |
| 21330 | ;;KEY^860 .9:^WBC | |
| 21331 | "RTN","ORY 42704",197 ,0) | |
| 21332 | ;;R^"860. 9:",.01,"E " | |
| 21333 | "RTN","ORY 42704",198 ,0) | |
| 21334 | ;;D^WBC | |
| 21335 | "RTN","ORY 42704",199 ,0) | |
| 21336 | ;;R^"860. 9:",.02,"E " | |
| 21337 | "RTN","ORY 42704",200 ,0) | |
| 21338 | ;;D^60 | |
| 21339 | "RTN","ORY 42704",201 ,0) | |
| 21340 | ;;EOR^ | |
| 21341 | "RTN","ORY 42704",202 ,0) | |
| 21342 | ;;EOF^OCX S(860.9)^1 | |
| 21343 | "RTN","ORY 42704",203 ,0) | |
| 21344 | ;;SOF^860 .8 ORDER CHECK COMP ILER FUNCT IONS | |
| 21345 | "RTN","ORY 42704",204 ,0) | |
| 21346 | ;;KEY^860 .8:^CONVER T DATE FRO M FILEMAN FORMAT TO OCX FORMAT | |
| 21347 | "RTN","ORY 42704",205 ,0) | |
| 21348 | ;;R^"860. 8:",.01,"E " | |
| 21349 | "RTN","ORY 42704",206 ,0) | |
| 21350 | ;;D^CONVE RT DATE FR OM FILEMAN FORMAT TO OCX FORMA T | |
| 21351 | "RTN","ORY 42704",207 ,0) | |
| 21352 | ;;R^"860. 8:",.02,"E " | |
| 21353 | "RTN","ORY 42704",208 ,0) | |
| 21354 | ;;D^DT2IN T | |
| 21355 | "RTN","ORY 42704",209 ,0) | |
| 21356 | ;;R^"860. 8:",1,1 | |
| 21357 | "RTN","ORY 42704",210 ,0) | |
| 21358 | ;;D^ ;DT 2INT(OCXDT ) ; T his Local Extrinsic Function c onverts a date into an integer | |
| 21359 | "RTN","ORY 42704",211 ,0) | |
| 21360 | ;;R^"860. 8:",1,2 | |
| 21361 | "RTN","ORY 42704",212 ,0) | |
| 21362 | ;;D^ ; ; By taking the Years , Months, Days, Hour s and Minu tes conver ting | |
| 21363 | "RTN","ORY 42704",213 ,0) | |
| 21364 | ;;R^"860. 8:",1,3 | |
| 21365 | "RTN","ORY 42704",214 ,0) | |
| 21366 | ;;D^ ; ; Them into Seconds a nd then ad ding them all togeth er into on e big inte ger | |
| 21367 | "RTN","ORY 42704",215 ,0) | |
| 21368 | ;;R^"860. 8:",100,1 | |
| 21369 | "RTN","ORY 42704",216 ,0) | |
| 21370 | ;;D^ ;DT 2INT(OCXDT ) ; T his Local Extrinsic Function c onverts a date into an integer | |
| 21371 | "RTN","ORY 42704",217 ,0) | |
| 21372 | ;;R^"860. 8:",100,2 | |
| 21373 | "RTN","ORY 42704",218 ,0) | |
| 21374 | ;;D^ ; ; By taking the Years , Months, Days, Hour s and Minu tes conver ting | |
| 21375 | "RTN","ORY 42704",219 ,0) | |
| 21376 | ;;R^"860. 8:",100,3 | |
| 21377 | "RTN","ORY 42704",220 ,0) | |
| 21378 | ;;D^ ; ; Them into Seconds a nd then ad ding them all togeth er into on e big inte ger | |
| 21379 | "RTN","ORY 42704",221 ,0) | |
| 21380 | ;;R^"860. 8:",100,4 | |
| 21381 | "RTN","ORY 42704",222 ,0) | |
| 21382 | ;;D^ ; ; | |
| 21383 | "RTN","ORY 42704",223 ,0) | |
| 21384 | ;;R^"860. 8:",100,5 | |
| 21385 | "RTN","ORY 42704",224 ,0) | |
| 21386 | ;;D^ ; Q :'$L($G(OC XDT)) "" | |
| 21387 | "RTN","ORY 42704",225 ,0) | |
| 21388 | ;;R^"860. 8:",100,6 | |
| 21389 | "RTN","ORY 42704",226 ,0) | |
| 21390 | ;;D^ ; N OCXDIFF,O CXVAL S (O CXDIFF,OCX VAL)=0 | |
| 21391 | "RTN","ORY 42704",227 ,0) | |
| 21392 | ;;R^"860. 8:",100,7 | |
| 21393 | "RTN","ORY 42704",228 ,0) | |
| 21394 | ;;D^ ; ; | |
| 21395 | "RTN","ORY 42704",229 ,0) | |
| 21396 | ;;R^"860. 8:",100,8 | |
| 21397 | "RTN","ORY 42704",230 ,0) | |
| 21398 | ;;D^ ; I $L(OCXDT) ,'OCXDT,(O CXDT[" at ") D ; EX TERNAL EXP ERT SYSTEM FORMAT 1 TO EXTERNA L FORMAT | |
| 21399 | "RTN","ORY 42704",231 ,0) | |
| 21400 | ;;R^"860. 8:",100,9 | |
| 21401 | "RTN","ORY 42704",232 ,0) | |
| 21402 | ;;D^ ; . N OCXHR,OC XMIN,OCXTI ME | |
| 21403 | "RTN","ORY 42704",233 ,0) | |
| 21404 | ;;R^"860. 8:",100,10 | |
| 21405 | "RTN","ORY 42704",234 ,0) | |
| 21406 | ;;D^ ; . S OCXTIME= $P($P(OCXD T," at ",2 ),".",1),O CXHR=$P(OC XTIME,":", 1),OCXMIN= $P(OCXTIME ,":",2) | |
| 21407 | "RTN","ORY 42704",235 ,0) | |
| 21408 | ;;R^"860. 8:",100,11 | |
| 21409 | "RTN","ORY 42704",236 ,0) | |
| 21410 | ;;D^ ; . S:(OCXDT[" Midnight") OCXHR=00 | |
| 21411 | "RTN","ORY 42704",237 ,0) | |
| 21412 | ;;R^"860. 8:",100,12 | |
| 21413 | "RTN","ORY 42704",238 ,0) | |
| 21414 | ;;D^ ; . S:(OCXDT[" PM") OCXHR =OCXHR+12 | |
| 21415 | "RTN","ORY 42704",239 ,0) | |
| 21416 | ;;R^"860. 8:",100,13 | |
| 21417 | "RTN","ORY 42704",240 ,0) | |
| 21418 | ;;D^ ; . S OCXDT=$P (OCXDT," a t ")_"@"_$ E(OCXHR+10 0,2,3)_$E( OCXMIN+100 ,2,3) | |
| 21419 | "RTN","ORY 42704",241 ,0) | |
| 21420 | ;;R^"860. 8:",100,14 | |
| 21421 | "RTN","ORY 42704",242 ,0) | |
| 21422 | ;;D^ ; ; | |
| 21423 | "RTN","ORY 42704",243 ,0) | |
| 21424 | ;;R^"860. 8:",100,15 | |
| 21425 | "RTN","ORY 42704",244 ,0) | |
| 21426 | ;;D^ ; I $L(OCXDT) ,(OCXDT?1. 2N1"/"1.2N .1" ".2N.1 ":".2N) D ; EXTERNA L EXPERT S YSTEM FORM AT 2 TO EX TERNAL FOR MAT | |
| 21427 | "RTN","ORY 42704",245 ,0) | |
| 21428 | ;;R^"860. 8:",100,16 | |
| 21429 | "RTN","ORY 42704",246 ,0) | |
| 21430 | ;;D^ ; . N OCXMON | |
| 21431 | "RTN","ORY 42704",247 ,0) | |
| 21432 | ;;R^"860. 8:",100,17 | |
| 21433 | "RTN","ORY 42704",248 ,0) | |
| 21434 | ;;D^ ; . S OCXMON=$ P("January ^February^ March^Apri l^May^June ^July^Augu st^Septemb er^October ^November^ December", U,$P(OCXDT ,"/",1)) | |
| 21435 | "RTN","ORY 42704",249 ,0) | |
| 21436 | ;;R^"860. 8:",100,18 | |
| 21437 | "RTN","ORY 42704",250 ,0) | |
| 21438 | ;;D^ ; . I $L($P(OC XDT," ",2) ) S OCXDT= OCXMON_" " _$P($P(OCX DT," ",1), "/",2)_"@" _$TR($P(OC XDT," ",2) ,":","") | |
| 21439 | "RTN","ORY 42704",251 ,0) | |
| 21440 | ;;R^"860. 8:",100,19 | |
| 21441 | "RTN","ORY 42704",252 ,0) | |
| 21442 | ;;D^ ; . E S OCXDT =OCXMON_" "_$P($P(OC XDT," ",1) ,"/",2) | |
| 21443 | "RTN","ORY 42704",253 ,0) | |
| 21444 | ;;R^"860. 8:",100,20 | |
| 21445 | "RTN","ORY 42704",254 ,0) | |
| 21446 | ;;D^ ; ; | |
| 21447 | "RTN","ORY 42704",255 ,0) | |
| 21448 | ;;R^"860. 8:",100,21 | |
| 21449 | "RTN","ORY 42704",256 ,0) | |
| 21450 | ;;D^ ; I $L(OCXDT) ,(OCXDT?1. 2N1"/"1.2N 1"/"1.2N.1 " ".2N.1": ".2N) D ; EXTERNAL EXPERT SYS TEM FORMAT 3 TO EXTE RNAL FORMA T | |
| 21451 | "RTN","ORY 42704",257 ,0) | |
| 21452 | ;;R^"860. 8:",100,22 | |
| 21453 | "RTN","ORY 42704",258 ,0) | |
| 21454 | ;;D^ ; . N OCXMON | |
| 21455 | "RTN","ORY 42704",259 ,0) | |
| 21456 | ;;R^"860. 8:",100,23 | |
| 21457 | "RTN","ORY 42704",260 ,0) | |
| 21458 | ;;D^ ; . S OCXMON=$ P("January ^February^ March^Apri l^May^June ^July^Augu st^Septemb er^October ^November^ December", U,$P(OCXDT ,"/",1)) | |
| 21459 | "RTN","ORY 42704",261 ,0) | |
| 21460 | ;;R^"860. 8:",100,24 | |
| 21461 | "RTN","ORY 42704",262 ,0) | |
| 21462 | ;;D^ ; . I $L($P(OC XDT," ",2) ) S OCXDT= OCXMON_" " _$P($P(OCX DT," ",1), "/",2)_"," _$P($P(OCX DT," ",1), "/",3)_"@" _$TR($P(OC XDT," ",2) ,":","") | |
| 21463 | "RTN","ORY 42704",263 ,0) | |
| 21464 | ;;R^"860. 8:",100,25 | |
| 21465 | "RTN","ORY 42704",264 ,0) | |
| 21466 | ;;D^ ; . E S OCXDT =OCXMON_" "_$P($P(OC XDT," ",1) ,"/",2)_", "_$P($P(O CXDT," ",1 ),"/",3) | |
| 21467 | "RTN","ORY 42704",265 ,0) | |
| 21468 | ;;R^"860. 8:",100,26 | |
| 21469 | "RTN","ORY 42704",266 ,0) | |
| 21470 | ;;D^ ; ; | |
| 21471 | "RTN","ORY 42704",267 ,0) | |
| 21472 | ;;R^"860. 8:",100,27 | |
| 21473 | "RTN","ORY 42704",268 ,0) | |
| 21474 | ;;D^ ; I $L(OCXDT) ,'OCXDT D ; EXTERNA L FORMAT T O INTERNAL FILEMAN F ORMAT | |
| 21475 | "RTN","ORY 42704",269 ,0) | |
| 21476 | ;;R^"860. 8:",100,28 | |
| 21477 | "RTN","ORY 42704",270 ,0) | |
| 21478 | ;;D^ ; . I (OCXDT[" @0000") S OCXDT=$P(O CXDT,"@",1 ),OCXDIFF= 1 | |
| 21479 | "RTN","ORY 42704",271 ,0) | |
| 21480 | ;;R^"860. 8:",100,29 | |
| 21481 | "RTN","ORY 42704",272 ,0) | |
| 21482 | ;;D^ ; . N %DT,X,Y S X=OCXDT, %DT="" S:( OCXDT["@") !(OCXDT="N ") %DT="T" D ^%DT S OCXDT=+Y | |
| 21483 | "RTN","ORY 42704",273 ,0) | |
| 21484 | ;;R^"860. 8:",100,30 | |
| 21485 | "RTN","ORY 42704",274 ,0) | |
| 21486 | ;;D^ ; ; | |
| 21487 | "RTN","ORY 42704",275 ,0) | |
| 21488 | ;;R^"860. 8:",100,31 | |
| 21489 | "RTN","ORY 42704",276 ,0) | |
| 21490 | ;;D^ ; I ($L(OCXDT \1)>7) S O CXDT=$$HL7 TFM^XLFDT( OCXDT) ; HL7 FORMAT TO INTERN AL FILEMAN FORMAT | |
| 21491 | "RTN","ORY 42704",277 ,0) | |
| 21492 | ;;R^"860. 8:",100,32 | |
| 21493 | "RTN","ORY 42704",278 ,0) | |
| 21494 | ;1; | |
| 21495 | "RTN","ORY 42704",279 ,0) | |
| 21496 | ; | |
| 21497 | "RTN","ORY 42705") | |
| 21498 | 0^10^B6250 1242 | |
| 21499 | "RTN","ORY 42705",1,0 ) | |
| 21500 | ORY42705 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 21501 | "RTN","ORY 42705",2,0 ) | |
| 21502 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 21503 | "RTN","ORY 42705",3,0 ) | |
| 21504 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 21505 | "RTN","ORY 42705",4,0 ) | |
| 21506 | ; | |
| 21507 | "RTN","ORY 42705",5,0 ) | |
| 21508 | S ; | |
| 21509 | "RTN","ORY 42705",6,0 ) | |
| 21510 | ; | |
| 21511 | "RTN","ORY 42705",7,0 ) | |
| 21512 | D DOT^ORY 427ES | |
| 21513 | "RTN","ORY 42705",8,0 ) | |
| 21514 | ; | |
| 21515 | "RTN","ORY 42705",9,0 ) | |
| 21516 | ; | |
| 21517 | "RTN","ORY 42705",10, 0) | |
| 21518 | K REMOTE, LOCAL,OPCO DE,REF | |
| 21519 | "RTN","ORY 42705",11, 0) | |
| 21520 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 21521 | "RTN","ORY 42705",12, 0) | |
| 21522 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 21523 | "RTN","ORY 42705",13, 0) | |
| 21524 | ; | |
| 21525 | "RTN","ORY 42705",14, 0) | |
| 21526 | G ^ORY427 06 | |
| 21527 | "RTN","ORY 42705",15, 0) | |
| 21528 | ; | |
| 21529 | "RTN","ORY 42705",16, 0) | |
| 21530 | Q | |
| 21531 | "RTN","ORY 42705",17, 0) | |
| 21532 | ; | |
| 21533 | "RTN","ORY 42705",18, 0) | |
| 21534 | DATA ; | |
| 21535 | "RTN","ORY 42705",19, 0) | |
| 21536 | ; | |
| 21537 | "RTN","ORY 42705",20, 0) | |
| 21538 | ;;D^ ; ; | |
| 21539 | "RTN","ORY 42705",21, 0) | |
| 21540 | ;;R^"860. 8:",100,33 | |
| 21541 | "RTN","ORY 42705",22, 0) | |
| 21542 | ;;D^ ; I ($L(OCXDT \1)=7) S O CXDT=$$FMT H^XLFDT(+O CXDT) ; INTERNAL F ILEMAN FOR MAT TO $H FORMAT | |
| 21543 | "RTN","ORY 42705",23, 0) | |
| 21544 | ;;R^"860. 8:",100,34 | |
| 21545 | "RTN","ORY 42705",24, 0) | |
| 21546 | ;;D^ ; ; | |
| 21547 | "RTN","ORY 42705",25, 0) | |
| 21548 | ;;R^"860. 8:",100,35 | |
| 21549 | "RTN","ORY 42705",26, 0) | |
| 21550 | ;;D^ ; I (OCXDT?5N 1","1.5N) S OCXVAL=( OCXDT*8640 0)+$P(OCXD T,",",2) ; $H F ORMAT TO E XPERT SYST EM INTERNA L FORMAT | |
| 21551 | "RTN","ORY 42705",27, 0) | |
| 21552 | ;;R^"860. 8:",100,36 | |
| 21553 | "RTN","ORY 42705",28, 0) | |
| 21554 | ;;D^ ; ; | |
| 21555 | "RTN","ORY 42705",29, 0) | |
| 21556 | ;;R^"860. 8:",100,37 | |
| 21557 | "RTN","ORY 42705",30, 0) | |
| 21558 | ;;D^ ; Q OCXVAL | |
| 21559 | "RTN","ORY 42705",31, 0) | |
| 21560 | ;;R^"860. 8:",100,38 | |
| 21561 | "RTN","ORY 42705",32, 0) | |
| 21562 | ;;D^ ; ; | |
| 21563 | "RTN","ORY 42705",33, 0) | |
| 21564 | ;;EOR^ | |
| 21565 | "RTN","ORY 42705",34, 0) | |
| 21566 | ;;KEY^860 .8:^CONVER T DATE FRO M OCX FORM AT TO READ ABLE FORMA T | |
| 21567 | "RTN","ORY 42705",35, 0) | |
| 21568 | ;;R^"860. 8:",.01,"E " | |
| 21569 | "RTN","ORY 42705",36, 0) | |
| 21570 | ;;D^CONVE RT DATE FR OM OCX FOR MAT TO REA DABLE FORM AT | |
| 21571 | "RTN","ORY 42705",37, 0) | |
| 21572 | ;;R^"860. 8:",.02,"E " | |
| 21573 | "RTN","ORY 42705",38, 0) | |
| 21574 | ;;D^INT2D T | |
| 21575 | "RTN","ORY 42705",39, 0) | |
| 21576 | ;;R^"860. 8:",1,1 | |
| 21577 | "RTN","ORY 42705",40, 0) | |
| 21578 | ;;D^ ;IN T2DT(OCXDT ,OCXF) ; This L ocal Extri nsic Funct ion conver ts an OCX internal f ormat | |
| 21579 | "RTN","ORY 42705",41, 0) | |
| 21580 | ;;R^"860. 8:",1,2 | |
| 21581 | "RTN","ORY 42705",42, 0) | |
| 21582 | ;;D^ ; ; date into an Extern l Format ( Human Read able) date . 'OCXF= SHORT FORM AT OCXF=LO NG FORMAT | |
| 21583 | "RTN","ORY 42705",43, 0) | |
| 21584 | ;;R^"860. 8:",1,3 | |
| 21585 | "RTN","ORY 42705",44, 0) | |
| 21586 | ;;D^ ; ; | |
| 21587 | "RTN","ORY 42705",45, 0) | |
| 21588 | ;;R^"860. 8:",100,1 | |
| 21589 | "RTN","ORY 42705",46, 0) | |
| 21590 | ;;D^ ;IN T2DT(OCXDT ,OCXF) ; This L ocal Extri nsic Funct ion conver ts an OCX internal f ormat | |
| 21591 | "RTN","ORY 42705",47, 0) | |
| 21592 | ;;R^"860. 8:",100,2 | |
| 21593 | "RTN","ORY 42705",48, 0) | |
| 21594 | ;;D^ ; ; date into an Extern l Format ( Human Read able) date . 'OCXF= SHORT FORM AT OCXF=LO NG FORMAT | |
| 21595 | "RTN","ORY 42705",49, 0) | |
| 21596 | ;;R^"860. 8:",100,3 | |
| 21597 | "RTN","ORY 42705",50, 0) | |
| 21598 | ;;D^ ; ; | |
| 21599 | "RTN","ORY 42705",51, 0) | |
| 21600 | ;;R^"860. 8:",100,4 | |
| 21601 | "RTN","ORY 42705",52, 0) | |
| 21602 | ;;D^ ; Q :'$L($G(OC XDT)) "" S OCXF=+$G( OCXF) | |
| 21603 | "RTN","ORY 42705",53, 0) | |
| 21604 | ;;R^"860. 8:",100,5 | |
| 21605 | "RTN","ORY 42705",54, 0) | |
| 21606 | ;;D^ ; N OCXYR,OCX LPYR,OCXMO N,OCXDAY,O CXHR,OCXMI N,OCXSEC,O CXCYR | |
| 21607 | "RTN","ORY 42705",55, 0) | |
| 21608 | ;;R^"860. 8:",100,6 | |
| 21609 | "RTN","ORY 42705",56, 0) | |
| 21610 | ;;D^ ; S (OCXYR,OC XLPYR,OCXM ON,OCXDAY, OCXHR,OCXM IN,OCXSEC, OCXAP)="" | |
| 21611 | "RTN","ORY 42705",57, 0) | |
| 21612 | ;;R^"860. 8:",100,7 | |
| 21613 | "RTN","ORY 42705",58, 0) | |
| 21614 | ;;D^ ; S OCXSEC=$E (OCXDT#60+ 100,2,3),O CXDT=OCXDT \60 | |
| 21615 | "RTN","ORY 42705",59, 0) | |
| 21616 | ;;R^"860. 8:",100,8 | |
| 21617 | "RTN","ORY 42705",60, 0) | |
| 21618 | ;;D^ ; S OCXMIN=$E (OCXDT#60+ 100,2,3),O CXDT=OCXDT \60 | |
| 21619 | "RTN","ORY 42705",61, 0) | |
| 21620 | ;;R^"860. 8:",100,9 | |
| 21621 | "RTN","ORY 42705",62, 0) | |
| 21622 | ;;D^ ; S OCXHR=$E( OCXDT#24+1 00,2,3),OC XDT=OCXDT\ 24 | |
| 21623 | "RTN","ORY 42705",63, 0) | |
| 21624 | ;;R^"860. 8:",100,10 | |
| 21625 | "RTN","ORY 42705",64, 0) | |
| 21626 | ;;D^ ; S OCXCYR=($ H\1461)*4+ 1841+(($H# 1461)\365) | |
| 21627 | "RTN","ORY 42705",65, 0) | |
| 21628 | ;;R^"860. 8:",100,11 | |
| 21629 | "RTN","ORY 42705",66, 0) | |
| 21630 | ;;D^ ; S OCXYR=(OC XDT\1461)* 4+1841,OCX DT=OCXDT#1 461 | |
| 21631 | "RTN","ORY 42705",67, 0) | |
| 21632 | ;;R^"860. 8:",100,12 | |
| 21633 | "RTN","ORY 42705",68, 0) | |
| 21634 | ;;D^ ; S OCXLPYR=( OCXDT\365) ,OCXDT=OCX DT-(OCXLPY R*365),OCX YR=OCXYR+O CXLPYR | |
| 21635 | "RTN","ORY 42705",69, 0) | |
| 21636 | ;;R^"860. 8:",100,13 | |
| 21637 | "RTN","ORY 42705",70, 0) | |
| 21638 | ;;D^ ; S OCXCNT="0 31^059^090 ^120^151^1 81^212^243 ^273^304^3 34^365" | |
| 21639 | "RTN","ORY 42705",71, 0) | |
| 21640 | ;;R^"860. 8:",100,14 | |
| 21641 | "RTN","ORY 42705",72, 0) | |
| 21642 | ;;D^ ; S :(OCXLPYR= 3) OCXCNT= "031^060^0 91^121^152 ^182^213^2 44^274^305 ^335^366" | |
| 21643 | "RTN","ORY 42705",73, 0) | |
| 21644 | ;;R^"860. 8:",100,15 | |
| 21645 | "RTN","ORY 42705",74, 0) | |
| 21646 | ;;D^ ; F OCXMON=1: 1:12 Q:(OC XDT<$P(OCX CNT,U,OCXM ON)) | |
| 21647 | "RTN","ORY 42705",75, 0) | |
| 21648 | ;;R^"860. 8:",100,16 | |
| 21649 | "RTN","ORY 42705",76, 0) | |
| 21650 | ;;D^ ; S OCXDAY=OC XDT-$P(OCX CNT,U,OCXM ON-1)+1 | |
| 21651 | "RTN","ORY 42705",77, 0) | |
| 21652 | ;;R^"860. 8:",100,17 | |
| 21653 | "RTN","ORY 42705",78, 0) | |
| 21654 | ;;D^ ; I OCXF S OC XMON=$P("J anuary^Feb ruary^Marc h^April^Ma y^June^Jul y^August^S eptember^O ctober^Nov ember^Dece mber",U,OC XMON) | |
| 21655 | "RTN","ORY 42705",79, 0) | |
| 21656 | ;;R^"860. 8:",100,18 | |
| 21657 | "RTN","ORY 42705",80, 0) | |
| 21658 | ;;D^ ; E S OCXMON =$E(OCXMON +100,2,3) | |
| 21659 | "RTN","ORY 42705",81, 0) | |
| 21660 | ;;R^"860. 8:",100,19 | |
| 21661 | "RTN","ORY 42705",82, 0) | |
| 21662 | ;;D^ ; S OCXAP=$S( 'OCXHR:"Mi dnight",(O CXHR=12):" Noon",(OCX HR<12):"AM ",1:"PM") | |
| 21663 | "RTN","ORY 42705",83, 0) | |
| 21664 | ;;R^"860. 8:",100,20 | |
| 21665 | "RTN","ORY 42705",84, 0) | |
| 21666 | ;;D^ ; I OCXF S OC XHR=OCXHR# 12 S:'OCXH R OCXHR=12 | |
| 21667 | "RTN","ORY 42705",85, 0) | |
| 21668 | ;;R^"860. 8:",100,21 | |
| 21669 | "RTN","ORY 42705",86, 0) | |
| 21670 | ;;D^ ; Q :'OCXF $E( OCXMON+100 ,2,3)_"/"_ $E(OCXDAY+ 100,2,3)_$ S((OCXCYR= OCXYR):" " _OCXHR_":" _OCXMIN,1: "/"_$E(OCX YR,3,4)) | |
| 21671 | "RTN","ORY 42705",87, 0) | |
| 21672 | ;;R^"860. 8:",100,22 | |
| 21673 | "RTN","ORY 42705",88, 0) | |
| 21674 | ;;D^ ; Q :(OCXHR+OC XMIN+OCXSE C) OCXMON_ " "_OCXDAY _","_OCXYR _" at "_OC XHR_":"_OC XMIN_"."_O CXSEC_" "_ OCXAP | |
| 21675 | "RTN","ORY 42705",89, 0) | |
| 21676 | ;;R^"860. 8:",100,23 | |
| 21677 | "RTN","ORY 42705",90, 0) | |
| 21678 | ;;D^ ; Q OCXMON_" "_OCXDAY_" ,"_OCXYR | |
| 21679 | "RTN","ORY 42705",91, 0) | |
| 21680 | ;;R^"860. 8:",100,24 | |
| 21681 | "RTN","ORY 42705",92, 0) | |
| 21682 | ;;D^ ; ; | |
| 21683 | "RTN","ORY 42705",93, 0) | |
| 21684 | ;;EOR^ | |
| 21685 | "RTN","ORY 42705",94, 0) | |
| 21686 | ;;KEY^860 .8:^ELAPSE D ORDER CH ECK TIME L OGGER | |
| 21687 | "RTN","ORY 42705",95, 0) | |
| 21688 | ;;R^"860. 8:",.01,"E " | |
| 21689 | "RTN","ORY 42705",96, 0) | |
| 21690 | ;;D^ELAPS ED ORDER C HECK TIME LOGGER | |
| 21691 | "RTN","ORY 42705",97, 0) | |
| 21692 | ;;R^"860. 8:",.02,"E " | |
| 21693 | "RTN","ORY 42705",98, 0) | |
| 21694 | ;;D^TIMEL OG | |
| 21695 | "RTN","ORY 42705",99, 0) | |
| 21696 | ;;R^"860. 8:",100,1 | |
| 21697 | "RTN","ORY 42705",100 ,0) | |
| 21698 | ;;D^ ;TI MELOG(OCXM ODE,OCXCAL L) ; Log a n entry in the Elaps ed time lo g. | |
| 21699 | "RTN","ORY 42705",101 ,0) | |
| 21700 | ;;R^"860. 8:",100,2 | |
| 21701 | "RTN","ORY 42705",102 ,0) | |
| 21702 | ;;D^ ; ; | |
| 21703 | "RTN","ORY 42705",103 ,0) | |
| 21704 | ;;R^"860. 8:",100,3 | |
| 21705 | "RTN","ORY 42705",104 ,0) | |
| 21706 | ;;D^ ; ; | |
| 21707 | "RTN","ORY 42705",105 ,0) | |
| 21708 | ;;R^"860. 8:",100,4 | |
| 21709 | "RTN","ORY 42705",106 ,0) | |
| 21710 | ;;D^ ; Q 0 | |
| 21711 | "RTN","ORY 42705",107 ,0) | |
| 21712 | ;;R^"860. 8:",100,5 | |
| 21713 | "RTN","ORY 42705",108 ,0) | |
| 21714 | ;;D^ ; ; | |
| 21715 | "RTN","ORY 42705",109 ,0) | |
| 21716 | ;;EOR^ | |
| 21717 | "RTN","ORY 42705",110 ,0) | |
| 21718 | ;;KEY^860 .8:^EQUALS TERM OPER ATOR | |
| 21719 | "RTN","ORY 42705",111 ,0) | |
| 21720 | ;;R^"860. 8:",.01,"E " | |
| 21721 | "RTN","ORY 42705",112 ,0) | |
| 21722 | ;;D^EQUAL S TERM OPE RATOR | |
| 21723 | "RTN","ORY 42705",113 ,0) | |
| 21724 | ;;R^"860. 8:",.02,"E " | |
| 21725 | "RTN","ORY 42705",114 ,0) | |
| 21726 | ;;D^EQTER M | |
| 21727 | "RTN","ORY 42705",115 ,0) | |
| 21728 | ;;R^"860. 8:",100,1 | |
| 21729 | "RTN","ORY 42705",116 ,0) | |
| 21730 | ;;D^ ;EQ TERM(DATA, TERM) ; | |
| 21731 | "RTN","ORY 42705",117 ,0) | |
| 21732 | ;;R^"860. 8:",100,2 | |
| 21733 | "RTN","ORY 42705",118 ,0) | |
| 21734 | ;;D^ ; ; | |
| 21735 | "RTN","ORY 42705",119 ,0) | |
| 21736 | ;;R^"860. 8:",100,3 | |
| 21737 | "RTN","ORY 42705",120 ,0) | |
| 21738 | ;;D^T+; I $G(OCXTRA CE) W !,"% %%%",?20," Execution trace DA TA: ",$G(D ATA)," T ERM: ",$G( TERM) | |
| 21739 | "RTN","ORY 42705",121 ,0) | |
| 21740 | ;;R^"860. 8:",100,4 | |
| 21741 | "RTN","ORY 42705",122 ,0) | |
| 21742 | ;;D^ ; N OCXF,OCXL | |
| 21743 | "RTN","ORY 42705",123 ,0) | |
| 21744 | ;;R^"860. 8:",100,5 | |
| 21745 | "RTN","ORY 42705",124 ,0) | |
| 21746 | ;;D^ ; ; | |
| 21747 | "RTN","ORY 42705",125 ,0) | |
| 21748 | ;;R^"860. 8:",100,6 | |
| 21749 | "RTN","ORY 42705",126 ,0) | |
| 21750 | ;;D^ ; S OCXL="",O CXF=$$TERM LKUP(TERM, .OCXL) | |
| 21751 | "RTN","ORY 42705",127 ,0) | |
| 21752 | ;;R^"860. 8:",100,7 | |
| 21753 | "RTN","ORY 42705",128 ,0) | |
| 21754 | ;;D^T-; Q :'OCXF 0 | |
| 21755 | "RTN","ORY 42705",129 ,0) | |
| 21756 | ;;R^"860. 8:",100,8 | |
| 21757 | "RTN","ORY 42705",130 ,0) | |
| 21758 | ;;D^T+; I 'OCXF W:$ G(OCXTRACE ) !,"%%%%" ,?20," Ter m '",TERM, "' not in Order Chec k National Term File " Q 0 | |
| 21759 | "RTN","ORY 42705",131 ,0) | |
| 21760 | ;;R^"860. 8:",100,9 | |
| 21761 | "RTN","ORY 42705",132 ,0) | |
| 21762 | ;;D^T+; I '$O(OCXL( 0)) W:$G(O CXTRACE) ! ,"%%%%",?2 0," There are no loc al terms l isted for the Nation al Term '" ,TERM,"'." Q 0 | |
| 21763 | "RTN","ORY 42705",133 ,0) | |
| 21764 | ;;R^"860. 8:",100,10 | |
| 21765 | "RTN","ORY 42705",134 ,0) | |
| 21766 | ;;D^T+; I ($D(OCXL( DATA))!$D( OCXL("B",D ATA))) W:$ G(OCXTRACE ) !,"%%%%" ,?20," Dat a equals T erm" Q 1 | |
| 21767 | "RTN","ORY 42705",135 ,0) | |
| 21768 | ;;R^"860. 8:",100,11 | |
| 21769 | "RTN","ORY 42705",136 ,0) | |
| 21770 | ;;D^T-; I ($D(OCXL( DATA))!$D( OCXL("B",D ATA))) Q 1 | |
| 21771 | "RTN","ORY 42705",137 ,0) | |
| 21772 | ;;R^"860. 8:",100,12 | |
| 21773 | "RTN","ORY 42705",138 ,0) | |
| 21774 | ;;D^T-; Q 0 | |
| 21775 | "RTN","ORY 42705",139 ,0) | |
| 21776 | ;;R^"860. 8:",100,13 | |
| 21777 | "RTN","ORY 42705",140 ,0) | |
| 21778 | ;;D^T+; W :$G(OCXTRA CE) !,"%%% %",?20," D ata does n ot equal T erm" Q 0 | |
| 21779 | "RTN","ORY 42705",141 ,0) | |
| 21780 | ;;R^"860. 8:",100,14 | |
| 21781 | "RTN","ORY 42705",142 ,0) | |
| 21782 | ;;D^ ; ; | |
| 21783 | "RTN","ORY 42705",143 ,0) | |
| 21784 | ;;EOR^ | |
| 21785 | "RTN","ORY 42705",144 ,0) | |
| 21786 | ;;KEY^860 .8:^FILE D ATA IN PAT IENT ACTIV E DATA FIL E | |
| 21787 | "RTN","ORY 42705",145 ,0) | |
| 21788 | ;;R^"860. 8:",.01,"E " | |
| 21789 | "RTN","ORY 42705",146 ,0) | |
| 21790 | ;;D^FILE DATA IN PA TIENT ACTI VE DATA FI LE | |
| 21791 | "RTN","ORY 42705",147 ,0) | |
| 21792 | ;;R^"860. 8:",.02,"E " | |
| 21793 | "RTN","ORY 42705",148 ,0) | |
| 21794 | ;;D^FILE | |
| 21795 | "RTN","ORY 42705",149 ,0) | |
| 21796 | ;;R^"860. 8:",1,1 | |
| 21797 | "RTN","ORY 42705",150 ,0) | |
| 21798 | ;;D^ ;FI LE(DFN,OCX ELE,OCXDFL ) ; Th is Local E xtrinsic F unction fi les data | |
| 21799 | "RTN","ORY 42705",151 ,0) | |
| 21800 | ;;R^"860. 8:",1,2 | |
| 21801 | "RTN","ORY 42705",152 ,0) | |
| 21802 | ;;D^ ; ; in th e Order Ch eck Patien t Data Fil e | |
| 21803 | "RTN","ORY 42705",153 ,0) | |
| 21804 | ;;R^"860. 8:",1,3 | |
| 21805 | "RTN","ORY 42705",154 ,0) | |
| 21806 | ;;D^ ; ; | |
| 21807 | "RTN","ORY 42705",155 ,0) | |
| 21808 | ;;R^"860. 8:",100,1 | |
| 21809 | "RTN","ORY 42705",156 ,0) | |
| 21810 | ;;D^ ;FI LE(DFN,OCX ELE,OCXDFL ) ; Th is Local E xtrinsic F unction lo gs a valid ated event /element. | |
| 21811 | "RTN","ORY 42705",157 ,0) | |
| 21812 | ;;R^"860. 8:",100,2 | |
| 21813 | "RTN","ORY 42705",158 ,0) | |
| 21814 | ;;D^ ; ; | |
| 21815 | "RTN","ORY 42705",159 ,0) | |
| 21816 | ;;R^"860. 8:",100,3 | |
| 21817 | "RTN","ORY 42705",160 ,0) | |
| 21818 | ;;D^T+; I $G(OCXTRA CE) W !,"% %%%",?20," Execution trace DF N: ",DFN," OCXELE: ",+$G(OCX ELE)," O CXDFL: ",$ G(OCXDFL) | |
| 21819 | "RTN","ORY 42705",161 ,0) | |
| 21820 | ;;R^"860. 8:",100,4 | |
| 21821 | "RTN","ORY 42705",162 ,0) | |
| 21822 | ;;D^ ; N OCXTIMN,O CXTIML,OCX TIMT1,OCXT IMT2,OCXDA TA,OCXPC,O CXPC,OCXVA L,OCXSUB,O CXDFI | |
| 21823 | "RTN","ORY 42705",163 ,0) | |
| 21824 | ;;R^"860. 8:",100,5 | |
| 21825 | "RTN","ORY 42705",164 ,0) | |
| 21826 | ;;D^ ; S DFN=+$G(D FN),OCXELE =+$G(OCXEL E) | |
| 21827 | "RTN","ORY 42705",165 ,0) | |
| 21828 | ;;R^"860. 8:",100,6 | |
| 21829 | "RTN","ORY 42705",166 ,0) | |
| 21830 | ;;D^ ; ; | |
| 21831 | "RTN","ORY 42705",167 ,0) | |
| 21832 | ;;R^"860. 8:",100,7 | |
| 21833 | "RTN","ORY 42705",168 ,0) | |
| 21834 | ;;D^ ; Q :'DFN 1 Q: 'OCXELE 1 K OCXDATA | |
| 21835 | "RTN","ORY 42705",169 ,0) | |
| 21836 | ;;R^"860. 8:",100,8 | |
| 21837 | "RTN","ORY 42705",170 ,0) | |
| 21838 | ;;D^ ; ; | |
| 21839 | "RTN","ORY 42705",171 ,0) | |
| 21840 | ;;R^"860. 8:",100,9 | |
| 21841 | "RTN","ORY 42705",172 ,0) | |
| 21842 | ;;D^ ; S OCXDATA(D FN,OCXELE) =1 | |
| 21843 | "RTN","ORY 42705",173 ,0) | |
| 21844 | ;;R^"860. 8:",100,10 | |
| 21845 | "RTN","ORY 42705",174 ,0) | |
| 21846 | ;;D^ ; F OCXPC=1:1 :$L(OCXDFL ,",") S OC XDFI=$P(OC XDFL,",",O CXPC) I OC XDFI D | |
| 21847 | "RTN","ORY 42705",175 ,0) | |
| 21848 | ;;R^"860. 8:",100,11 | |
| 21849 | "RTN","ORY 42705",176 ,0) | |
| 21850 | ;;D^ ; . S OCXVAL=$ G(OCXDF(+O CXDFI)),OC XDATA(DFN, OCXELE,+OC XDFI)=OCXV AL | |
| 21851 | "RTN","ORY 42705",177 ,0) | |
| 21852 | ;;R^"860. 8:",100,12 | |
| 21853 | "RTN","ORY 42705",178 ,0) | |
| 21854 | ;;D^T+; . I $G(OCXTR ACE) W !," %%%%",?20, " ",$P($ G(^OCXS(86 0.4,+OCXDF I,0)),U,1) ," = """,O CXVAL,"""" | |
| 21855 | "RTN","ORY 42705",179 ,0) | |
| 21856 | ;;R^"860. 8:",100,13 | |
| 21857 | "RTN","ORY 42705",180 ,0) | |
| 21858 | ;;D^ ; ; | |
| 21859 | "RTN","ORY 42705",181 ,0) | |
| 21860 | ;;R^"860. 8:",100,14 | |
| 21861 | "RTN","ORY 42705",182 ,0) | |
| 21862 | ;;D^ ; M ^TMP("OCX CHK",$J,DF N)=OCXDATA (DFN) | |
| 21863 | "RTN","ORY 42705",183 ,0) | |
| 21864 | ;;R^"860. 8:",100,15 | |
| 21865 | "RTN","ORY 42705",184 ,0) | |
| 21866 | ;;D^ ; ; | |
| 21867 | "RTN","ORY 42705",185 ,0) | |
| 21868 | ;;R^"860. 8:",100,16 | |
| 21869 | "RTN","ORY 42705",186 ,0) | |
| 21870 | ;;D^ ; Q 0 | |
| 21871 | "RTN","ORY 42705",187 ,0) | |
| 21872 | ;;R^"860. 8:",100,17 | |
| 21873 | "RTN","ORY 42705",188 ,0) | |
| 21874 | ;;D^ ; ; | |
| 21875 | "RTN","ORY 42705",189 ,0) | |
| 21876 | ;;EOR^ | |
| 21877 | "RTN","ORY 42705",190 ,0) | |
| 21878 | ;;KEY^860 .8:^GENERA TE STRING CHECKSUM | |
| 21879 | "RTN","ORY 42705",191 ,0) | |
| 21880 | ;;R^"860. 8:",.01,"E " | |
| 21881 | "RTN","ORY 42705",192 ,0) | |
| 21882 | ;;D^GENER ATE STRING CHECKSUM | |
| 21883 | "RTN","ORY 42705",193 ,0) | |
| 21884 | ;;R^"860. 8:",.02,"E " | |
| 21885 | "RTN","ORY 42705",194 ,0) | |
| 21886 | ;;D^CKSUM | |
| 21887 | "RTN","ORY 42705",195 ,0) | |
| 21888 | ;;R^"860. 8:",100,1 | |
| 21889 | "RTN","ORY 42705",196 ,0) | |
| 21890 | ;;D^ ;CK SUM(STR) ; | |
| 21891 | "RTN","ORY 42705",197 ,0) | |
| 21892 | ;;R^"860. 8:",100,2 | |
| 21893 | "RTN","ORY 42705",198 ,0) | |
| 21894 | ;;D^ ; ; | |
| 21895 | "RTN","ORY 42705",199 ,0) | |
| 21896 | ;;R^"860. 8:",100,3 | |
| 21897 | "RTN","ORY 42705",200 ,0) | |
| 21898 | ;;D^ ; N CKSUM,PTR ,ASC S CKS UM=0 | |
| 21899 | "RTN","ORY 42705",201 ,0) | |
| 21900 | ;;R^"860. 8:",100,4 | |
| 21901 | "RTN","ORY 42705",202 ,0) | |
| 21902 | ;;D^ ; S STR=$TR(S TR,"abcdef ghijklmnop qrstuvwxyz ","ABCDEFG HIJKLMNOPQ RSTUVWXYZ" ) | |
| 21903 | "RTN","ORY 42705",203 ,0) | |
| 21904 | ;;R^"860. 8:",100,5 | |
| 21905 | "RTN","ORY 42705",204 ,0) | |
| 21906 | ;;D^ ; F PTR=$L(ST R):-1:1 S ASC=$A(STR ,PTR)-42 I (ASC>0),( ASC<51) S CKSUM=CKSU M*2+ASC | |
| 21907 | "RTN","ORY 42705",205 ,0) | |
| 21908 | ;;R^"860. 8:",100,6 | |
| 21909 | "RTN","ORY 42705",206 ,0) | |
| 21910 | ;;D^ ; Q +CKSUM | |
| 21911 | "RTN","ORY 42705",207 ,0) | |
| 21912 | ;;R^"860. 8:",100,7 | |
| 21913 | "RTN","ORY 42705",208 ,0) | |
| 21914 | ;;D^ ; ; | |
| 21915 | "RTN","ORY 42705",209 ,0) | |
| 21916 | ;;EOR^ | |
| 21917 | "RTN","ORY 42705",210 ,0) | |
| 21918 | ;;KEY^860 .8:^GET DA TA FROM TH E ACTIVE D ATA FILE | |
| 21919 | "RTN","ORY 42705",211 ,0) | |
| 21920 | ;;R^"860. 8:",.01,"E " | |
| 21921 | "RTN","ORY 42705",212 ,0) | |
| 21922 | ;;D^GET D ATA FROM T HE ACTIVE DATA FILE | |
| 21923 | "RTN","ORY 42705",213 ,0) | |
| 21924 | ;;R^"860. 8:",.02,"E " | |
| 21925 | "RTN","ORY 42705",214 ,0) | |
| 21926 | ;;D^GETDA TA | |
| 21927 | "RTN","ORY 42705",215 ,0) | |
| 21928 | ;;R^"860. 8:",100,1 | |
| 21929 | "RTN","ORY 42705",216 ,0) | |
| 21930 | ;;D^ ;GE TDATA(DFN, OCXL,OCXDF I) ; T his Local Extrinsic Function r eturns run time data | |
| 21931 | "RTN","ORY 42705",217 ,0) | |
| 21932 | ;;R^"860. 8:",100,2 | |
| 21933 | "RTN","ORY 42705",218 ,0) | |
| 21934 | ;;D^ ; ; | |
| 21935 | "RTN","ORY 42705",219 ,0) | |
| 21936 | ;;R^"860. 8:",100,3 | |
| 21937 | "RTN","ORY 42705",220 ,0) | |
| 21938 | ;;D^ ; N OCXE,VAL, PC S VAL=" " | |
| 21939 | "RTN","ORY 42705",221 ,0) | |
| 21940 | ;;R^"860. 8:",100,4 | |
| 21941 | "RTN","ORY 42705",222 ,0) | |
| 21942 | ;;D^ ; F PC=1:1:$L (OCXL,U) S OCXE=$P(O CXL,U,PC) I OCXE S V AL=$G(^TMP ("OCXCHK", $J,DFN,OCX E,OCXDFI)) Q:$L(VAL) | |
| 21943 | "RTN","ORY 42705",223 ,0) | |
| 21944 | ;1; | |
| 21945 | "RTN","ORY 42705",224 ,0) | |
| 21946 | ; | |
| 21947 | "RTN","ORY 42706") | |
| 21948 | 0^11^B6755 3648 | |
| 21949 | "RTN","ORY 42706",1,0 ) | |
| 21950 | ORY42706 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 21951 | "RTN","ORY 42706",2,0 ) | |
| 21952 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 21953 | "RTN","ORY 42706",3,0 ) | |
| 21954 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 21955 | "RTN","ORY 42706",4,0 ) | |
| 21956 | ; | |
| 21957 | "RTN","ORY 42706",5,0 ) | |
| 21958 | S ; | |
| 21959 | "RTN","ORY 42706",6,0 ) | |
| 21960 | ; | |
| 21961 | "RTN","ORY 42706",7,0 ) | |
| 21962 | D DOT^ORY 427ES | |
| 21963 | "RTN","ORY 42706",8,0 ) | |
| 21964 | ; | |
| 21965 | "RTN","ORY 42706",9,0 ) | |
| 21966 | ; | |
| 21967 | "RTN","ORY 42706",10, 0) | |
| 21968 | K REMOTE, LOCAL,OPCO DE,REF | |
| 21969 | "RTN","ORY 42706",11, 0) | |
| 21970 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 21971 | "RTN","ORY 42706",12, 0) | |
| 21972 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 21973 | "RTN","ORY 42706",13, 0) | |
| 21974 | ; | |
| 21975 | "RTN","ORY 42706",14, 0) | |
| 21976 | G ^ORY427 07 | |
| 21977 | "RTN","ORY 42706",15, 0) | |
| 21978 | ; | |
| 21979 | "RTN","ORY 42706",16, 0) | |
| 21980 | Q | |
| 21981 | "RTN","ORY 42706",17, 0) | |
| 21982 | ; | |
| 21983 | "RTN","ORY 42706",18, 0) | |
| 21984 | DATA ; | |
| 21985 | "RTN","ORY 42706",19, 0) | |
| 21986 | ; | |
| 21987 | "RTN","ORY 42706",20, 0) | |
| 21988 | ;;R^"860. 8:",100,5 | |
| 21989 | "RTN","ORY 42706",21, 0) | |
| 21990 | ;;D^ ; Q VAL | |
| 21991 | "RTN","ORY 42706",22, 0) | |
| 21992 | ;;R^"860. 8:",100,6 | |
| 21993 | "RTN","ORY 42706",23, 0) | |
| 21994 | ;;D^ ; ; | |
| 21995 | "RTN","ORY 42706",24, 0) | |
| 21996 | ;;EOR^ | |
| 21997 | "RTN","ORY 42706",25, 0) | |
| 21998 | ;;KEY^860 .8:^IN LIS T OPERATOR | |
| 21999 | "RTN","ORY 42706",26, 0) | |
| 22000 | ;;R^"860. 8:",.01,"E " | |
| 22001 | "RTN","ORY 42706",27, 0) | |
| 22002 | ;;D^IN LI ST OPERATO R | |
| 22003 | "RTN","ORY 42706",28, 0) | |
| 22004 | ;;R^"860. 8:",.02,"E " | |
| 22005 | "RTN","ORY 42706",29, 0) | |
| 22006 | ;;D^LIST | |
| 22007 | "RTN","ORY 42706",30, 0) | |
| 22008 | ;;R^"860. 8:",100,1 | |
| 22009 | "RTN","ORY 42706",31, 0) | |
| 22010 | ;;D^ ;LI ST(DATA,LI ST) ; IS THE DATA FIELD IN T HE LIST | |
| 22011 | "RTN","ORY 42706",32, 0) | |
| 22012 | ;;R^"860. 8:",100,2 | |
| 22013 | "RTN","ORY 42706",33, 0) | |
| 22014 | ;;D^ ; ; | |
| 22015 | "RTN","ORY 42706",34, 0) | |
| 22016 | ;;R^"860. 8:",100,3 | |
| 22017 | "RTN","ORY 42706",35, 0) | |
| 22018 | ;;D^T+; W :$G(OCXTRA CE) !,"%%% %",?20," $$LIST( """,DATA," "",""",LIS T,""")" | |
| 22019 | "RTN","ORY 42706",36, 0) | |
| 22020 | ;;R^"860. 8:",100,4 | |
| 22021 | "RTN","ORY 42706",37, 0) | |
| 22022 | ;;D^ ; S :'($E(LIST ,1)=",") L IST=","_LI ST S:'($E( LIST,$L(LI ST))=",") LIST=LIST_ "," S DATA =","_DATA_ "," | |
| 22023 | "RTN","ORY 42706",38, 0) | |
| 22024 | ;;R^"860. 8:",100,5 | |
| 22025 | "RTN","ORY 42706",39, 0) | |
| 22026 | ;;D^ ; Q (LIST[DAT A) | |
| 22027 | "RTN","ORY 42706",40, 0) | |
| 22028 | ;;R^"860. 8:",100,6 | |
| 22029 | "RTN","ORY 42706",41, 0) | |
| 22030 | ;;D^ ; ; | |
| 22031 | "RTN","ORY 42706",42, 0) | |
| 22032 | ;;EOR^ | |
| 22033 | "RTN","ORY 42706",43, 0) | |
| 22034 | ;;KEY^860 .8:^LOCAL TERM LOOKU P | |
| 22035 | "RTN","ORY 42706",44, 0) | |
| 22036 | ;;R^"860. 8:",.01,"E " | |
| 22037 | "RTN","ORY 42706",45, 0) | |
| 22038 | ;;D^LOCAL TERM LOOK UP | |
| 22039 | "RTN","ORY 42706",46, 0) | |
| 22040 | ;;R^"860. 8:",.02,"E " | |
| 22041 | "RTN","ORY 42706",47, 0) | |
| 22042 | ;;D^TERML KUP | |
| 22043 | "RTN","ORY 42706",48, 0) | |
| 22044 | ;;R^"860. 8:",1,2 | |
| 22045 | "RTN","ORY 42706",49, 0) | |
| 22046 | ;;D^ Thi s function allows a local site to define to Order Checking | |
| 22047 | "RTN","ORY 42706",50, 0) | |
| 22048 | ;;R^"860. 8:",1,3 | |
| 22049 | "RTN","ORY 42706",51, 0) | |
| 22050 | ;;D^ a te rm specifi c to that site. (ie. Lab Test Name, Radi ology | |
| 22051 | "RTN","ORY 42706",52, 0) | |
| 22052 | ;;R^"860. 8:",1,4 | |
| 22053 | "RTN","ORY 42706",53, 0) | |
| 22054 | ;;D^ proc edure name , etc.) | |
| 22055 | "RTN","ORY 42706",54, 0) | |
| 22056 | ;;R^"860. 8:",100,1 | |
| 22057 | "RTN","ORY 42706",55, 0) | |
| 22058 | ;;D^ ;TE RMLKUP(OCX TERM,OCXFI LE) ; | |
| 22059 | "RTN","ORY 42706",56, 0) | |
| 22060 | ;;R^"860. 8:",100,2 | |
| 22061 | "RTN","ORY 42706",57, 0) | |
| 22062 | ;;D^ ; ; | |
| 22063 | "RTN","ORY 42706",58, 0) | |
| 22064 | ;;R^"860. 8:",100,3 | |
| 22065 | "RTN","ORY 42706",59, 0) | |
| 22066 | ;;D^ ; Q | |
| 22067 | "RTN","ORY 42706",60, 0) | |
| 22068 | ;;R^"860. 8:",100,4 | |
| 22069 | "RTN","ORY 42706",61, 0) | |
| 22070 | ;;D^ ; ; | |
| 22071 | "RTN","ORY 42706",62, 0) | |
| 22072 | ;;EOR^ | |
| 22073 | "RTN","ORY 42706",63, 0) | |
| 22074 | ;;KEY^860 .8:^NEW RU LE MESSAGE | |
| 22075 | "RTN","ORY 42706",64, 0) | |
| 22076 | ;;R^"860. 8:",.01,"E " | |
| 22077 | "RTN","ORY 42706",65, 0) | |
| 22078 | ;;D^NEW R ULE MESSAG E | |
| 22079 | "RTN","ORY 42706",66, 0) | |
| 22080 | ;;R^"860. 8:",.02,"E " | |
| 22081 | "RTN","ORY 42706",67, 0) | |
| 22082 | ;;D^NEWRU LE | |
| 22083 | "RTN","ORY 42706",68, 0) | |
| 22084 | ;;R^"860. 8:",100,1 | |
| 22085 | "RTN","ORY 42706",69, 0) | |
| 22086 | ;;D^ ;NE WRULE(OCXD FN,OCXORD, OCXRUL,OCX REL,OCXNOT F,OCXMESS) ; Has thi s rule alr eady been triggered for this o rder numbe r | |
| 22087 | "RTN","ORY 42706",70, 0) | |
| 22088 | ;;R^"860. 8:",100,2 | |
| 22089 | "RTN","ORY 42706",71, 0) | |
| 22090 | ;;D^ ; ; | |
| 22091 | "RTN","ORY 42706",72, 0) | |
| 22092 | ;;R^"860. 8:",100,3 | |
| 22093 | "RTN","ORY 42706",73, 0) | |
| 22094 | ;;D^L+; S OCXERR=$$ TIMELOG("M ","NEWRULE ("_(+$G(OC XDFN))_"," _(+$G(OCXO RD))_","_( +$G(OCXRUL ))_","_(+$ G(OCXREL)) _","_(+$G( OCXNOTF))_ ","_$G(OCX MESS)_")") | |
| 22095 | "RTN","ORY 42706",74, 0) | |
| 22096 | ;;R^"860. 8:",100,4 | |
| 22097 | "RTN","ORY 42706",75, 0) | |
| 22098 | ;;D^ ; ; | |
| 22099 | "RTN","ORY 42706",76, 0) | |
| 22100 | ;;R^"860. 8:",100,5 | |
| 22101 | "RTN","ORY 42706",77, 0) | |
| 22102 | ;;D^ ; Q :'$G(OCXDF N) 0 Q:'$G (OCXRUL) 0 | |
| 22103 | "RTN","ORY 42706",78, 0) | |
| 22104 | ;;R^"860. 8:",100,6 | |
| 22105 | "RTN","ORY 42706",79, 0) | |
| 22106 | ;;D^ ; Q :'$G(OCXRE L) 0 Q:'$ G(OCXNOTF) 0 Q:'$L( $G(OCXMESS )) 0 | |
| 22107 | "RTN","ORY 42706",80, 0) | |
| 22108 | ;;R^"860. 8:",100,7 | |
| 22109 | "RTN","ORY 42706",81, 0) | |
| 22110 | ;;D^ ; S OCXORD=+$ G(OCXORD), OCXDFN=+OC XDFN | |
| 22111 | "RTN","ORY 42706",82, 0) | |
| 22112 | ;;R^"860. 8:",100,8 | |
| 22113 | "RTN","ORY 42706",83, 0) | |
| 22114 | ;;D^ ; ; | |
| 22115 | "RTN","ORY 42706",84, 0) | |
| 22116 | ;;R^"860. 8:",100,9 | |
| 22117 | "RTN","ORY 42706",85, 0) | |
| 22118 | ;;D^ ; N OCXNDX,OC XDATA,OCXD FI,OCXELE, OCXGR,OCXT IME,OCXCKS UM,OCXTSP, OCXTSPL | |
| 22119 | "RTN","ORY 42706",86, 0) | |
| 22120 | ;;R^"860. 8:",100,10 | |
| 22121 | "RTN","ORY 42706",87, 0) | |
| 22122 | ;;D^ ; ; | |
| 22123 | "RTN","ORY 42706",88, 0) | |
| 22124 | ;;R^"860. 8:",100,11 | |
| 22125 | "RTN","ORY 42706",89, 0) | |
| 22126 | ;;D^ ; S OCXTIME=( +$H) | |
| 22127 | "RTN","ORY 42706",90, 0) | |
| 22128 | ;;R^"860. 8:",100,12 | |
| 22129 | "RTN","ORY 42706",91, 0) | |
| 22130 | ;;D^ ; S OCXCKSUM= $$CKSUM(OC XMESS) | |
| 22131 | "RTN","ORY 42706",92, 0) | |
| 22132 | ;;R^"860. 8:",100,13 | |
| 22133 | "RTN","ORY 42706",93, 0) | |
| 22134 | ;;D^ ; ; | |
| 22135 | "RTN","ORY 42706",94, 0) | |
| 22136 | ;;R^"860. 8:",100,14 | |
| 22137 | "RTN","ORY 42706",95, 0) | |
| 22138 | ;;D^ ; S OCXTSP=($ H*86400)+$ P($H,",",2 ) | |
| 22139 | "RTN","ORY 42706",96, 0) | |
| 22140 | ;;R^"860. 8:",100,15 | |
| 22141 | "RTN","ORY 42706",97, 0) | |
| 22142 | ;;D^ ; S OCXTSPL=( $G(^OCXD(8 60.7,"AT", OCXTIME,OC XDFN,OCXRU L,+OCXORD, OCXCKSUM)) +$G(OCXTSP I,300)) | |
| 22143 | "RTN","ORY 42706",98, 0) | |
| 22144 | ;;R^"860. 8:",100,16 | |
| 22145 | "RTN","ORY 42706",99, 0) | |
| 22146 | ;;D^ ; ; | |
| 22147 | "RTN","ORY 42706",100 ,0) | |
| 22148 | ;;R^"860. 8:",100,17 | |
| 22149 | "RTN","ORY 42706",101 ,0) | |
| 22150 | ;;D^ ; Q :(OCXTSPL> OCXTSP) 0 | |
| 22151 | "RTN","ORY 42706",102 ,0) | |
| 22152 | ;;R^"860. 8:",100,18 | |
| 22153 | "RTN","ORY 42706",103 ,0) | |
| 22154 | ;;D^ ; ; | |
| 22155 | "RTN","ORY 42706",104 ,0) | |
| 22156 | ;;R^"860. 8:",100,19 | |
| 22157 | "RTN","ORY 42706",105 ,0) | |
| 22158 | ;;D^ ; K OCXDATA | |
| 22159 | "RTN","ORY 42706",106 ,0) | |
| 22160 | ;;R^"860. 8:",100,20 | |
| 22161 | "RTN","ORY 42706",107 ,0) | |
| 22162 | ;;D^ ; S OCXDATA(O CXDFN,0)=O CXDFN | |
| 22163 | "RTN","ORY 42706",108 ,0) | |
| 22164 | ;;R^"860. 8:",100,21 | |
| 22165 | "RTN","ORY 42706",109 ,0) | |
| 22166 | ;;D^ ; S OCXDATA(" B",OCXDFN, OCXDFN)="" | |
| 22167 | "RTN","ORY 42706",110 ,0) | |
| 22168 | ;;R^"860. 8:",100,22 | |
| 22169 | "RTN","ORY 42706",111 ,0) | |
| 22170 | ;;D^ ; S OCXDATA(" AT",OCXTIM E,OCXDFN,O CXRUL,+OCX ORD,OCXCKS UM)=OCXTSP | |
| 22171 | "RTN","ORY 42706",112 ,0) | |
| 22172 | ;;R^"860. 8:",100,23 | |
| 22173 | "RTN","ORY 42706",113 ,0) | |
| 22174 | ;;D^ ; ; | |
| 22175 | "RTN","ORY 42706",114 ,0) | |
| 22176 | ;;R^"860. 8:",100,24 | |
| 22177 | "RTN","ORY 42706",115 ,0) | |
| 22178 | ;;D^ ; S OCXGR="^O CXD(860.7" | |
| 22179 | "RTN","ORY 42706",116 ,0) | |
| 22180 | ;;R^"860. 8:",100,25 | |
| 22181 | "RTN","ORY 42706",117 ,0) | |
| 22182 | ;;D^T+; D SETAP(OCX GR_")",0," Patient",$ P($G(^DPT( OCXDFN,0)) ,U,1),.OCX DATA,OCXDF N) | |
| 22183 | "RTN","ORY 42706",118 ,0) | |
| 22184 | ;;R^"860. 8:",100,26 | |
| 22185 | "RTN","ORY 42706",119 ,0) | |
| 22186 | ;;D^T-; D SETAP(OCX GR_")",0,. OCXDATA,OC XDFN) | |
| 22187 | "RTN","ORY 42706",120 ,0) | |
| 22188 | ;;R^"860. 8:",100,27 | |
| 22189 | "RTN","ORY 42706",121 ,0) | |
| 22190 | ;;D^ ; ; | |
| 22191 | "RTN","ORY 42706",122 ,0) | |
| 22192 | ;;R^"860. 8:",100,28 | |
| 22193 | "RTN","ORY 42706",123 ,0) | |
| 22194 | ;;D^ ; K OCXDATA | |
| 22195 | "RTN","ORY 42706",124 ,0) | |
| 22196 | ;;R^"860. 8:",100,29 | |
| 22197 | "RTN","ORY 42706",125 ,0) | |
| 22198 | ;;D^ ; S OCXDATA(O CXRUL,0)=O CXRUL_U_(O CXTIME)_U_ (+OCXORD) | |
| 22199 | "RTN","ORY 42706",126 ,0) | |
| 22200 | ;;R^"860. 8:",100,30 | |
| 22201 | "RTN","ORY 42706",127 ,0) | |
| 22202 | ;;D^ ; S OCXDATA(O CXRUL,"M") =OCXMESS | |
| 22203 | "RTN","ORY 42706",128 ,0) | |
| 22204 | ;;R^"860. 8:",100,31 | |
| 22205 | "RTN","ORY 42706",129 ,0) | |
| 22206 | ;;D^ ; S OCXDATA(" B",OCXRUL, OCXRUL)="" | |
| 22207 | "RTN","ORY 42706",130 ,0) | |
| 22208 | ;;R^"860. 8:",100,32 | |
| 22209 | "RTN","ORY 42706",131 ,0) | |
| 22210 | ;;D^ ; S OCXGR=OCX GR_","_OCX DFN_",1" | |
| 22211 | "RTN","ORY 42706",132 ,0) | |
| 22212 | ;;R^"860. 8:",100,33 | |
| 22213 | "RTN","ORY 42706",133 ,0) | |
| 22214 | ;;D^T+; D SETAP(OCX GR_")","86 0.71P","Ru le",$P($G( ^OCXS(860. 2,OCXRUL,0 )),U,1),.O CXDATA,OCX RUL) | |
| 22215 | "RTN","ORY 42706",134 ,0) | |
| 22216 | ;;R^"860. 8:",100,34 | |
| 22217 | "RTN","ORY 42706",135 ,0) | |
| 22218 | ;;D^T-; D SETAP(OCX GR_")","86 0.71P",.OC XDATA,OCXR UL) | |
| 22219 | "RTN","ORY 42706",136 ,0) | |
| 22220 | ;;R^"860. 8:",100,35 | |
| 22221 | "RTN","ORY 42706",137 ,0) | |
| 22222 | ;;D^ ; ; | |
| 22223 | "RTN","ORY 42706",138 ,0) | |
| 22224 | ;;R^"860. 8:",100,36 | |
| 22225 | "RTN","ORY 42706",139 ,0) | |
| 22226 | ;;D^ ; K OCXDATA | |
| 22227 | "RTN","ORY 42706",140 ,0) | |
| 22228 | ;;R^"860. 8:",100,37 | |
| 22229 | "RTN","ORY 42706",141 ,0) | |
| 22230 | ;;D^ ; S OCXDATA(O CXREL,0)=O CXREL | |
| 22231 | "RTN","ORY 42706",142 ,0) | |
| 22232 | ;;R^"860. 8:",100,38 | |
| 22233 | "RTN","ORY 42706",143 ,0) | |
| 22234 | ;;D^ ; S OCXDATA(" B",OCXREL, OCXREL)="" | |
| 22235 | "RTN","ORY 42706",144 ,0) | |
| 22236 | ;;R^"860. 8:",100,39 | |
| 22237 | "RTN","ORY 42706",145 ,0) | |
| 22238 | ;;D^ ; S OCXGR=OCX GR_","_OCX RUL_",1" | |
| 22239 | "RTN","ORY 42706",146 ,0) | |
| 22240 | ;;R^"860. 8:",100,40 | |
| 22241 | "RTN","ORY 42706",147 ,0) | |
| 22242 | ;;D^T+; D SETAP(OCX GR_")","86 0.712","Re lation",OC XREL,.OCXD ATA,OCXREL ) | |
| 22243 | "RTN","ORY 42706",148 ,0) | |
| 22244 | ;;R^"860. 8:",100,41 | |
| 22245 | "RTN","ORY 42706",149 ,0) | |
| 22246 | ;;D^T-; D SETAP(OCX GR_")","86 0.712",.OC XDATA,OCXR EL) | |
| 22247 | "RTN","ORY 42706",150 ,0) | |
| 22248 | ;;R^"860. 8:",100,42 | |
| 22249 | "RTN","ORY 42706",151 ,0) | |
| 22250 | ;;D^ ; ; | |
| 22251 | "RTN","ORY 42706",152 ,0) | |
| 22252 | ;;R^"860. 8:",100,43 | |
| 22253 | "RTN","ORY 42706",153 ,0) | |
| 22254 | ;;D^ ; S OCXELE=0 F S OCXEL E=$O(^OCXS (860.2,OCX RUL,"C","C ",OCXELE)) Q:'OCXELE D | |
| 22255 | "RTN","ORY 42706",154 ,0) | |
| 22256 | ;;R^"860. 8:",100,44 | |
| 22257 | "RTN","ORY 42706",155 ,0) | |
| 22258 | ;;D^ ; . ; | |
| 22259 | "RTN","ORY 42706",156 ,0) | |
| 22260 | ;;R^"860. 8:",100,45 | |
| 22261 | "RTN","ORY 42706",157 ,0) | |
| 22262 | ;;D^ ; . N OCXGR1 | |
| 22263 | "RTN","ORY 42706",158 ,0) | |
| 22264 | ;;R^"860. 8:",100,46 | |
| 22265 | "RTN","ORY 42706",159 ,0) | |
| 22266 | ;;D^ ; . S OCXGR1=O CXGR_","_O CXREL_",1" | |
| 22267 | "RTN","ORY 42706",160 ,0) | |
| 22268 | ;;R^"860. 8:",100,47 | |
| 22269 | "RTN","ORY 42706",161 ,0) | |
| 22270 | ;;D^ ; . K OCXDATA | |
| 22271 | "RTN","ORY 42706",162 ,0) | |
| 22272 | ;;R^"860. 8:",100,48 | |
| 22273 | "RTN","ORY 42706",163 ,0) | |
| 22274 | ;;D^ ; . S OCXDATA( OCXELE,0)= OCXELE | |
| 22275 | "RTN","ORY 42706",164 ,0) | |
| 22276 | ;;R^"860. 8:",100,49 | |
| 22277 | "RTN","ORY 42706",165 ,0) | |
| 22278 | ;;D^ ; . S OCXDATA( OCXELE,"TI ME")=OCXTI ME | |
| 22279 | "RTN","ORY 42706",166 ,0) | |
| 22280 | ;;R^"860. 8:",100,50 | |
| 22281 | "RTN","ORY 42706",167 ,0) | |
| 22282 | ;;D^ ; . S OCXDATA( OCXELE,"LO G")=$G(OCX OLOG) | |
| 22283 | "RTN","ORY 42706",168 ,0) | |
| 22284 | ;;R^"860. 8:",100,51 | |
| 22285 | "RTN","ORY 42706",169 ,0) | |
| 22286 | ;;D^ ; . S OCXDATA( "B",OCXELE ,OCXELE)=" " | |
| 22287 | "RTN","ORY 42706",170 ,0) | |
| 22288 | ;;R^"860. 8:",100,52 | |
| 22289 | "RTN","ORY 42706",171 ,0) | |
| 22290 | ;;D^ ; . K ^OCXD(86 0.7,OCXDFN ,1,OCXRUL, 1,OCXREL,1 ,OCXELE) | |
| 22291 | "RTN","ORY 42706",172 ,0) | |
| 22292 | ;;R^"860. 8:",100,53 | |
| 22293 | "RTN","ORY 42706",173 ,0) | |
| 22294 | ;;D^T+; . D SETAP(OC XGR1_")"," 860.7122P" ,"Element" ,$P($G(^OC XS(860.3,O CXELE,0)), U,1),.OCXD ATA,OCXELE ) | |
| 22295 | "RTN","ORY 42706",174 ,0) | |
| 22296 | ;;R^"860. 8:",100,54 | |
| 22297 | "RTN","ORY 42706",175 ,0) | |
| 22298 | ;;D^T-; . D SETAP(OC XGR1_")"," 860.7122P" ,.OCXDATA, OCXELE) | |
| 22299 | "RTN","ORY 42706",176 ,0) | |
| 22300 | ;;R^"860. 8:",100,55 | |
| 22301 | "RTN","ORY 42706",177 ,0) | |
| 22302 | ;;D^ ; . ; | |
| 22303 | "RTN","ORY 42706",178 ,0) | |
| 22304 | ;;R^"860. 8:",100,56 | |
| 22305 | "RTN","ORY 42706",179 ,0) | |
| 22306 | ;;D^ ; . S OCXDFI=0 F S OCXD FI=$O(^TMP ("OCXCHK", $J,OCXDFN, OCXELE,OCX DFI)) Q:'O CXDFI D | |
| 22307 | "RTN","ORY 42706",180 ,0) | |
| 22308 | ;;R^"860. 8:",100,57 | |
| 22309 | "RTN","ORY 42706",181 ,0) | |
| 22310 | ;;D^ ; . .N OCXGR2 | |
| 22311 | "RTN","ORY 42706",182 ,0) | |
| 22312 | ;;R^"860. 8:",100,58 | |
| 22313 | "RTN","ORY 42706",183 ,0) | |
| 22314 | ;;D^ ; . .S OCXGR2= OCXGR1_"," _OCXELE_", 1" | |
| 22315 | "RTN","ORY 42706",184 ,0) | |
| 22316 | ;;R^"860. 8:",100,59 | |
| 22317 | "RTN","ORY 42706",185 ,0) | |
| 22318 | ;;D^ ; . .K OCXDATA | |
| 22319 | "RTN","ORY 42706",186 ,0) | |
| 22320 | ;;R^"860. 8:",100,60 | |
| 22321 | "RTN","ORY 42706",187 ,0) | |
| 22322 | ;;D^ ; . .S OCXDATA (OCXDFI,0) =OCXDFI | |
| 22323 | "RTN","ORY 42706",188 ,0) | |
| 22324 | ;;R^"860. 8:",100,61 | |
| 22325 | "RTN","ORY 42706",189 ,0) | |
| 22326 | ;;D^ ; . .S OCXDATA (OCXDFI,"V AL")=^TMP( "OCXCHK",$ J,OCXDFN,O CXELE,OCXD FI) | |
| 22327 | "RTN","ORY 42706",190 ,0) | |
| 22328 | ;;R^"860. 8:",100,62 | |
| 22329 | "RTN","ORY 42706",191 ,0) | |
| 22330 | ;;D^ ; . .S OCXDATA ("B",OCXDF I,OCXDFI)= "" | |
| 22331 | "RTN","ORY 42706",192 ,0) | |
| 22332 | ;;R^"860. 8:",100,63 | |
| 22333 | "RTN","ORY 42706",193 ,0) | |
| 22334 | ;;D^T+; . .D SETAP(O CXGR2_")", "860.71223 P","Data F ield",$P($ G(^OCXS(86 0.4,OCXDFI ,0)),U,1), .OCXDATA,O CXDFI) | |
| 22335 | "RTN","ORY 42706",194 ,0) | |
| 22336 | ;;R^"860. 8:",100,64 | |
| 22337 | "RTN","ORY 42706",195 ,0) | |
| 22338 | ;;D^T-; . .D SETAP(O CXGR2_")", "860.71223 P",.OCXDAT A,OCXDFI) | |
| 22339 | "RTN","ORY 42706",196 ,0) | |
| 22340 | ;;R^"860. 8:",100,65 | |
| 22341 | "RTN","ORY 42706",197 ,0) | |
| 22342 | ;;D^ ; ; | |
| 22343 | "RTN","ORY 42706",198 ,0) | |
| 22344 | ;;R^"860. 8:",100,66 | |
| 22345 | "RTN","ORY 42706",199 ,0) | |
| 22346 | ;;D^ ; Q 1 | |
| 22347 | "RTN","ORY 42706",200 ,0) | |
| 22348 | ;;R^"860. 8:",100,67 | |
| 22349 | "RTN","ORY 42706",201 ,0) | |
| 22350 | ;;D^ ; ; | |
| 22351 | "RTN","ORY 42706",202 ,0) | |
| 22352 | ;;R^"860. 8:",100,68 | |
| 22353 | "RTN","ORY 42706",203 ,0) | |
| 22354 | ;;D^T+;SE TAP(ROOT,D D,ITEM,ITE MNAME,DATA ,DA) ; Se t Rule Eve nt data | |
| 22355 | "RTN","ORY 42706",204 ,0) | |
| 22356 | ;;R^"860. 8:",100,69 | |
| 22357 | "RTN","ORY 42706",205 ,0) | |
| 22358 | ;;D^T-;SE TAP(ROOT,D D,DATA,DA) ; Set Ru le Event d ata | |
| 22359 | "RTN","ORY 42706",206 ,0) | |
| 22360 | ;;R^"860. 8:",100,70 | |
| 22361 | "RTN","ORY 42706",207 ,0) | |
| 22362 | ;;D^ ; M @ROOT=DAT A | |
| 22363 | "RTN","ORY 42706",208 ,0) | |
| 22364 | ;;R^"860. 8:",100,71 | |
| 22365 | "RTN","ORY 42706",209 ,0) | |
| 22366 | ;;D^ ; I +$G(DD) S @ROOT@(0) ="^"_($G(D D))_"^"_($ P($G(@ROOT @(0)),U,3) +1)_"^"_$G (DA) | |
| 22367 | "RTN","ORY 42706",210 ,0) | |
| 22368 | ;;R^"860. 8:",100,72 | |
| 22369 | "RTN","ORY 42706",211 ,0) | |
| 22370 | ;;D^ ; I '$G(DD) S $P(@ROOT@ (0),U,3,4) =($P($G(@R OOT@(0)),U ,3)+1)_"^" _$G(DA) | |
| 22371 | "RTN","ORY 42706",212 ,0) | |
| 22372 | ;;R^"860. 8:",100,73 | |
| 22373 | "RTN","ORY 42706",213 ,0) | |
| 22374 | ;;D^T+; W :$G(OCXTRA CE) !,"Fil e Active D ata ",$G(I TEM),": ", $G(ITEMNAM E) | |
| 22375 | "RTN","ORY 42706",214 ,0) | |
| 22376 | ;;R^"860. 8:",100,74 | |
| 22377 | "RTN","ORY 42706",215 ,0) | |
| 22378 | ;;D^ ; ; | |
| 22379 | "RTN","ORY 42706",216 ,0) | |
| 22380 | ;;R^"860. 8:",100,75 | |
| 22381 | "RTN","ORY 42706",217 ,0) | |
| 22382 | ;;D^ ; Q | |
| 22383 | "RTN","ORY 42706",218 ,0) | |
| 22384 | ;;R^"860. 8:",100,76 | |
| 22385 | "RTN","ORY 42706",219 ,0) | |
| 22386 | ;;D^ ; ; | |
| 22387 | "RTN","ORY 42706",220 ,0) | |
| 22388 | ;;R^"860. 8:",100,77 | |
| 22389 | "RTN","ORY 42706",221 ,0) | |
| 22390 | ;;D^ ; ; | |
| 22391 | "RTN","ORY 42706",222 ,0) | |
| 22392 | ;;EOR^ | |
| 22393 | "RTN","ORY 42706",223 ,0) | |
| 22394 | ;;KEY^860 .8:^RETURN POINTED T O VALUE | |
| 22395 | "RTN","ORY 42706",224 ,0) | |
| 22396 | ;;R^"860. 8:",.01,"E " | |
| 22397 | "RTN","ORY 42706",225 ,0) | |
| 22398 | ;;D^RETUR N POINTED TO VALUE | |
| 22399 | "RTN","ORY 42706",226 ,0) | |
| 22400 | ;;R^"860. 8:",.02,"E " | |
| 22401 | "RTN","ORY 42706",227 ,0) | |
| 22402 | ;;D^POINT ER | |
| 22403 | "RTN","ORY 42706",228 ,0) | |
| 22404 | ;;R^"860. 8:",1,1 | |
| 22405 | "RTN","ORY 42706",229 ,0) | |
| 22406 | ;;D^ ;PO INTER(OCXF ILE,D0) ; This Lo cal Extrin sic Functi on gets th e value of the name field | |
| 22407 | "RTN","ORY 42706",230 ,0) | |
| 22408 | ;;R^"860. 8:",1,2 | |
| 22409 | "RTN","ORY 42706",231 ,0) | |
| 22410 | ;;D^ ; ; of recor d D0 in fi le OCXFILE | |
| 22411 | "RTN","ORY 42706",232 ,0) | |
| 22412 | ;;R^"860. 8:",100,1 | |
| 22413 | "RTN","ORY 42706",233 ,0) | |
| 22414 | ;;D^ ;PO INTER(OCXF ILE,D0) ; This Lo cal Extrin sic Functi on gets th e value of the name field | |
| 22415 | "RTN","ORY 42706",234 ,0) | |
| 22416 | ;;R^"860. 8:",100,2 | |
| 22417 | "RTN","ORY 42706",235 ,0) | |
| 22418 | ;;D^ ; ; of recor d D0 in fi le OCXFILE | |
| 22419 | "RTN","ORY 42706",236 ,0) | |
| 22420 | ;;R^"860. 8:",100,3 | |
| 22421 | "RTN","ORY 42706",237 ,0) | |
| 22422 | ;;D^T+; I $G(OCXTRA CE) W !,"% %%%",?20," FILE: " ,$G(OCXFIL E)," D0: ",$G(D0) | |
| 22423 | "RTN","ORY 42706",238 ,0) | |
| 22424 | ;;R^"860. 8:",100,4 | |
| 22425 | "RTN","ORY 42706",239 ,0) | |
| 22426 | ;;D^ ; Q :'$G(D0) " " Q:'$L($G (OCXFILE)) "" | |
| 22427 | "RTN","ORY 42706",240 ,0) | |
| 22428 | ;;R^"860. 8:",100,5 | |
| 22429 | "RTN","ORY 42706",241 ,0) | |
| 22430 | ;;D^ ; N GLREF | |
| 22431 | "RTN","ORY 42706",242 ,0) | |
| 22432 | ;;R^"860. 8:",100,6 | |
| 22433 | "RTN","ORY 42706",243 ,0) | |
| 22434 | ;;D^ ; I '(OCXFILE =(+OCXFILE )) S GLREF =U_OCXFILE | |
| 22435 | "RTN","ORY 42706",244 ,0) | |
| 22436 | ;;R^"860. 8:",100,7 | |
| 22437 | "RTN","ORY 42706",245 ,0) | |
| 22438 | ;;D^ ; E S GLREF= $$FILE^OCX BDTD(+OCXF ILE,"GLOBA L NAME") Q :'$L(GLREF ) "" | |
| 22439 | "RTN","ORY 42706",246 ,0) | |
| 22440 | ;1; | |
| 22441 | "RTN","ORY 42706",247 ,0) | |
| 22442 | ; | |
| 22443 | "RTN","ORY 42707") | |
| 22444 | 0^12^B6952 5830 | |
| 22445 | "RTN","ORY 42707",1,0 ) | |
| 22446 | ORY42707 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 22447 | "RTN","ORY 42707",2,0 ) | |
| 22448 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 22449 | "RTN","ORY 42707",3,0 ) | |
| 22450 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 22451 | "RTN","ORY 42707",4,0 ) | |
| 22452 | ; | |
| 22453 | "RTN","ORY 42707",5,0 ) | |
| 22454 | S ; | |
| 22455 | "RTN","ORY 42707",6,0 ) | |
| 22456 | ; | |
| 22457 | "RTN","ORY 42707",7,0 ) | |
| 22458 | D DOT^ORY 427ES | |
| 22459 | "RTN","ORY 42707",8,0 ) | |
| 22460 | ; | |
| 22461 | "RTN","ORY 42707",9,0 ) | |
| 22462 | ; | |
| 22463 | "RTN","ORY 42707",10, 0) | |
| 22464 | K REMOTE, LOCAL,OPCO DE,REF | |
| 22465 | "RTN","ORY 42707",11, 0) | |
| 22466 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 22467 | "RTN","ORY 42707",12, 0) | |
| 22468 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 22469 | "RTN","ORY 42707",13, 0) | |
| 22470 | ; | |
| 22471 | "RTN","ORY 42707",14, 0) | |
| 22472 | G ^ORY427 08 | |
| 22473 | "RTN","ORY 42707",15, 0) | |
| 22474 | ; | |
| 22475 | "RTN","ORY 42707",16, 0) | |
| 22476 | Q | |
| 22477 | "RTN","ORY 42707",17, 0) | |
| 22478 | ; | |
| 22479 | "RTN","ORY 42707",18, 0) | |
| 22480 | DATA ; | |
| 22481 | "RTN","ORY 42707",19, 0) | |
| 22482 | ; | |
| 22483 | "RTN","ORY 42707",20, 0) | |
| 22484 | ;;R^"860. 8:",100,8 | |
| 22485 | "RTN","ORY 42707",21, 0) | |
| 22486 | ;;D^T+; I $G(OCXTRA CE) W !,"% %%%",?20," GLREF: ", GLREF," R ESOLVES TO : ",$P($G( @(GLREF_(+ D0)_",0)") ),U,1) | |
| 22487 | "RTN","ORY 42707",22, 0) | |
| 22488 | ;;R^"860. 8:",100,9 | |
| 22489 | "RTN","ORY 42707",23, 0) | |
| 22490 | ;;D^ ; Q $P($G(@(G LREF_(+D0) _",0)")),U ,1) | |
| 22491 | "RTN","ORY 42707",24, 0) | |
| 22492 | ;;R^"860. 8:",100,10 | |
| 22493 | "RTN","ORY 42707",25, 0) | |
| 22494 | ;;D^ ; ; | |
| 22495 | "RTN","ORY 42707",26, 0) | |
| 22496 | ;;EOR^ | |
| 22497 | "RTN","ORY 42707",27, 0) | |
| 22498 | ;;KEY^860 .8:^STRING CONTAINS ONE OF A L IST OF VAL UES | |
| 22499 | "RTN","ORY 42707",28, 0) | |
| 22500 | ;;R^"860. 8:",.01,"E " | |
| 22501 | "RTN","ORY 42707",29, 0) | |
| 22502 | ;;D^STRIN G CONTAINS ONE OF A LIST OF VA LUES | |
| 22503 | "RTN","ORY 42707",30, 0) | |
| 22504 | ;;R^"860. 8:",.02,"E " | |
| 22505 | "RTN","ORY 42707",31, 0) | |
| 22506 | ;;D^CLIST | |
| 22507 | "RTN","ORY 42707",32, 0) | |
| 22508 | ;;R^"860. 8:",100,1 | |
| 22509 | "RTN","ORY 42707",33, 0) | |
| 22510 | ;;D^ ;CL IST(DATA,L IST) ; D OES THE DA TA FIELD C ONTAIN AN ELEMENT IN THE LIST | |
| 22511 | "RTN","ORY 42707",34, 0) | |
| 22512 | ;;R^"860. 8:",100,2 | |
| 22513 | "RTN","ORY 42707",35, 0) | |
| 22514 | ;;D^ ; ; | |
| 22515 | "RTN","ORY 42707",36, 0) | |
| 22516 | ;;R^"860. 8:",100,3 | |
| 22517 | "RTN","ORY 42707",37, 0) | |
| 22518 | ;;D^T+; W :$G(OCXTRA CE) !!,"$$ CLIST(",DA TA,",""",L IST,""")" | |
| 22519 | "RTN","ORY 42707",38, 0) | |
| 22520 | ;;R^"860. 8:",100,4 | |
| 22521 | "RTN","ORY 42707",39, 0) | |
| 22522 | ;;D^ ; N PC F PC=1 :1:$L(LIST ,","),0 I PC,$L($P(L IST,",",PC )),(DATA[$ P(LIST,"," ,PC)) Q | |
| 22523 | "RTN","ORY 42707",40, 0) | |
| 22524 | ;;R^"860. 8:",100,5 | |
| 22525 | "RTN","ORY 42707",41, 0) | |
| 22526 | ;;D^ ; Q ''PC | |
| 22527 | "RTN","ORY 42707",42, 0) | |
| 22528 | ;;EOR^ | |
| 22529 | "RTN","ORY 42707",43, 0) | |
| 22530 | ;;EOF^OCX S(860.8)^1 | |
| 22531 | "RTN","ORY 42707",44, 0) | |
| 22532 | ;;SOF^860 .6 ORDER CHECK DATA CONTEXT | |
| 22533 | "RTN","ORY 42707",45, 0) | |
| 22534 | ;;KEY^860 .6:^CPRS O RDER PRESC AN | |
| 22535 | "RTN","ORY 42707",46, 0) | |
| 22536 | ;;R^"860. 6:",.01,"E " | |
| 22537 | "RTN","ORY 42707",47, 0) | |
| 22538 | ;;D^CPRS ORDER PRES CAN | |
| 22539 | "RTN","ORY 42707",48, 0) | |
| 22540 | ;;R^"860. 6:",.02,"E " | |
| 22541 | "RTN","ORY 42707",49, 0) | |
| 22542 | ;;D^OEPS | |
| 22543 | "RTN","ORY 42707",50, 0) | |
| 22544 | ;;R^"860. 6:",1,"E" | |
| 22545 | "RTN","ORY 42707",51, 0) | |
| 22546 | ;;D^DATA DRIVEN | |
| 22547 | "RTN","ORY 42707",52, 0) | |
| 22548 | ;;EOR^ | |
| 22549 | "RTN","ORY 42707",53, 0) | |
| 22550 | ;;KEY^860 .6:^CPRS O RDER PROTO COL | |
| 22551 | "RTN","ORY 42707",54, 0) | |
| 22552 | ;;R^"860. 6:",.01,"E " | |
| 22553 | "RTN","ORY 42707",55, 0) | |
| 22554 | ;;D^CPRS ORDER PROT OCOL | |
| 22555 | "RTN","ORY 42707",56, 0) | |
| 22556 | ;;R^"860. 6:",.02,"E " | |
| 22557 | "RTN","ORY 42707",57, 0) | |
| 22558 | ;;D^OERR | |
| 22559 | "RTN","ORY 42707",58, 0) | |
| 22560 | ;;R^"860. 6:",1,"E" | |
| 22561 | "RTN","ORY 42707",59, 0) | |
| 22562 | ;;D^DATA DRIVEN | |
| 22563 | "RTN","ORY 42707",60, 0) | |
| 22564 | ;;EOR^ | |
| 22565 | "RTN","ORY 42707",61, 0) | |
| 22566 | ;;KEY^860 .6:^DATABA SE LOOKUP | |
| 22567 | "RTN","ORY 42707",62, 0) | |
| 22568 | ;;R^"860. 6:",.01,"E " | |
| 22569 | "RTN","ORY 42707",63, 0) | |
| 22570 | ;;D^DATAB ASE LOOKUP | |
| 22571 | "RTN","ORY 42707",64, 0) | |
| 22572 | ;;R^"860. 6:",.02,"E " | |
| 22573 | "RTN","ORY 42707",65, 0) | |
| 22574 | ;;D^DL | |
| 22575 | "RTN","ORY 42707",66, 0) | |
| 22576 | ;;R^"860. 6:",1,"E" | |
| 22577 | "RTN","ORY 42707",67, 0) | |
| 22578 | ;;D^PACKA GE LOOKUP | |
| 22579 | "RTN","ORY 42707",68, 0) | |
| 22580 | ;;EOR^ | |
| 22581 | "RTN","ORY 42707",69, 0) | |
| 22582 | ;;KEY^860 .6:^GENERI C HL7 MESS AGE ARRAY | |
| 22583 | "RTN","ORY 42707",70, 0) | |
| 22584 | ;;R^"860. 6:",.01,"E " | |
| 22585 | "RTN","ORY 42707",71, 0) | |
| 22586 | ;;D^GENER IC HL7 MES SAGE ARRAY | |
| 22587 | "RTN","ORY 42707",72, 0) | |
| 22588 | ;;R^"860. 6:",.02,"E " | |
| 22589 | "RTN","ORY 42707",73, 0) | |
| 22590 | ;;D^HL7 | |
| 22591 | "RTN","ORY 42707",74, 0) | |
| 22592 | ;;R^"860. 6:",1,"E" | |
| 22593 | "RTN","ORY 42707",75, 0) | |
| 22594 | ;;D^DATA DRIVEN | |
| 22595 | "RTN","ORY 42707",76, 0) | |
| 22596 | ;;EOR^ | |
| 22597 | "RTN","ORY 42707",77, 0) | |
| 22598 | ;;EOF^OCX S(860.6)^1 | |
| 22599 | "RTN","ORY 42707",78, 0) | |
| 22600 | ;;SOF^860 .5 ORDER CHECK DATA SOURCE | |
| 22601 | "RTN","ORY 42707",79, 0) | |
| 22602 | ;;KEY^860 .5:^DATABA SE LOOKUP | |
| 22603 | "RTN","ORY 42707",80, 0) | |
| 22604 | ;;R^"860. 5:",.01,"E " | |
| 22605 | "RTN","ORY 42707",81, 0) | |
| 22606 | ;;D^DATAB ASE LOOKUP | |
| 22607 | "RTN","ORY 42707",82, 0) | |
| 22608 | ;;R^"860. 5:",.02,"E " | |
| 22609 | "RTN","ORY 42707",83, 0) | |
| 22610 | ;;D^DATAB ASE LOOKUP | |
| 22611 | "RTN","ORY 42707",84, 0) | |
| 22612 | ;;EOR^ | |
| 22613 | "RTN","ORY 42707",85, 0) | |
| 22614 | ;;KEY^860 .5:^HL7 CO MMON ORDER SEGMENT | |
| 22615 | "RTN","ORY 42707",86, 0) | |
| 22616 | ;;R^"860. 5:",.01,"E " | |
| 22617 | "RTN","ORY 42707",87, 0) | |
| 22618 | ;;D^HL7 C OMMON ORDE R SEGMENT | |
| 22619 | "RTN","ORY 42707",88, 0) | |
| 22620 | ;;R^"860. 5:",.02,"E " | |
| 22621 | "RTN","ORY 42707",89, 0) | |
| 22622 | ;;D^GENER IC HL7 MES SAGE ARRAY | |
| 22623 | "RTN","ORY 42707",90, 0) | |
| 22624 | ;;EOR^ | |
| 22625 | "RTN","ORY 42707",91, 0) | |
| 22626 | ;;KEY^860 .5:^HL7 PA TIENT ID S EGMENT | |
| 22627 | "RTN","ORY 42707",92, 0) | |
| 22628 | ;;R^"860. 5:",.01,"E " | |
| 22629 | "RTN","ORY 42707",93, 0) | |
| 22630 | ;;D^HL7 P ATIENT ID SEGMENT | |
| 22631 | "RTN","ORY 42707",94, 0) | |
| 22632 | ;;R^"860. 5:",.02,"E " | |
| 22633 | "RTN","ORY 42707",95, 0) | |
| 22634 | ;;D^GENER IC HL7 MES SAGE ARRAY | |
| 22635 | "RTN","ORY 42707",96, 0) | |
| 22636 | ;;EOR^ | |
| 22637 | "RTN","ORY 42707",97, 0) | |
| 22638 | ;;KEY^860 .5:^OERR O RDER EVENT FLAG PROT OCOL | |
| 22639 | "RTN","ORY 42707",98, 0) | |
| 22640 | ;;R^"860. 5:",.01,"E " | |
| 22641 | "RTN","ORY 42707",99, 0) | |
| 22642 | ;;D^OERR ORDER EVEN T FLAG PRO TOCOL | |
| 22643 | "RTN","ORY 42707",100 ,0) | |
| 22644 | ;;R^"860. 5:",.02,"E " | |
| 22645 | "RTN","ORY 42707",101 ,0) | |
| 22646 | ;;D^CPRS ORDER PROT OCOL | |
| 22647 | "RTN","ORY 42707",102 ,0) | |
| 22648 | ;;EOR^ | |
| 22649 | "RTN","ORY 42707",103 ,0) | |
| 22650 | ;;KEY^860 .5:^ORDER ENTRY ORDE R PRESCAN | |
| 22651 | "RTN","ORY 42707",104 ,0) | |
| 22652 | ;;R^"860. 5:",.01,"E " | |
| 22653 | "RTN","ORY 42707",105 ,0) | |
| 22654 | ;;D^ORDER ENTRY ORD ER PRESCAN | |
| 22655 | "RTN","ORY 42707",106 ,0) | |
| 22656 | ;;R^"860. 5:",.02,"E " | |
| 22657 | "RTN","ORY 42707",107 ,0) | |
| 22658 | ;;D^CPRS ORDER PRES CAN | |
| 22659 | "RTN","ORY 42707",108 ,0) | |
| 22660 | ;;EOR^ | |
| 22661 | "RTN","ORY 42707",109 ,0) | |
| 22662 | ;;EOF^OCX S(860.5)^1 | |
| 22663 | "RTN","ORY 42707",110 ,0) | |
| 22664 | ;;SOF^860 .4 ORDER CHECK DATA FIELD | |
| 22665 | "RTN","ORY 42707",111 ,0) | |
| 22666 | ;;KEY^860 .4:^CLOZAP INE ANC W/ IN 7 FLAG | |
| 22667 | "RTN","ORY 42707",112 ,0) | |
| 22668 | ;;R^"860. 4:",.01,"E " | |
| 22669 | "RTN","ORY 42707",113 ,0) | |
| 22670 | ;;D^CLOZA PINE ANC W /IN 7 FLAG | |
| 22671 | "RTN","ORY 42707",114 ,0) | |
| 22672 | ;;R^"860. 4:",1,"E" | |
| 22673 | "RTN","ORY 42707",115 ,0) | |
| 22674 | ;;D^CLOZ ANC FLAG | |
| 22675 | "RTN","ORY 42707",116 ,0) | |
| 22676 | ;;R^"860. 4:",101,"E " | |
| 22677 | "RTN","ORY 42707",117 ,0) | |
| 22678 | ;;D^BOOLE AN | |
| 22679 | "RTN","ORY 42707",118 ,0) | |
| 22680 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.01," E" | |
| 22681 | "RTN","ORY 42707",119 ,0) | |
| 22682 | ;;D^DATAB ASE LOOKUP | |
| 22683 | "RTN","ORY 42707",120 ,0) | |
| 22684 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.02," E" | |
| 22685 | "RTN","ORY 42707",121 ,0) | |
| 22686 | ;;D^DATAB ASE LOOKUP | |
| 22687 | "RTN","ORY 42707",122 ,0) | |
| 22688 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",1,"E" | |
| 22689 | "RTN","ORY 42707",123 ,0) | |
| 22690 | ;;D^PATIE NT.CLOZ_AN C_W/IN_7_F LAG | |
| 22691 | "RTN","ORY 42707",124 ,0) | |
| 22692 | ;;EOR^ | |
| 22693 | "RTN","ORY 42707",125 ,0) | |
| 22694 | ;;KEY^860 .4:^CLOZAP INE ANC W/ IN 7 RESUL T | |
| 22695 | "RTN","ORY 42707",126 ,0) | |
| 22696 | ;;R^"860. 4:",.01,"E " | |
| 22697 | "RTN","ORY 42707",127 ,0) | |
| 22698 | ;;D^CLOZA PINE ANC W /IN 7 RESU LT | |
| 22699 | "RTN","ORY 42707",128 ,0) | |
| 22700 | ;;R^"860. 4:",1,"E" | |
| 22701 | "RTN","ORY 42707",129 ,0) | |
| 22702 | ;;D^CLOZ ANC RSLT | |
| 22703 | "RTN","ORY 42707",130 ,0) | |
| 22704 | ;;R^"860. 4:",101,"E " | |
| 22705 | "RTN","ORY 42707",131 ,0) | |
| 22706 | ;;D^NUMER IC | |
| 22707 | "RTN","ORY 42707",132 ,0) | |
| 22708 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.01," E" | |
| 22709 | "RTN","ORY 42707",133 ,0) | |
| 22710 | ;;D^DATAB ASE LOOKUP | |
| 22711 | "RTN","ORY 42707",134 ,0) | |
| 22712 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.02," E" | |
| 22713 | "RTN","ORY 42707",135 ,0) | |
| 22714 | ;;D^DATAB ASE LOOKUP | |
| 22715 | "RTN","ORY 42707",136 ,0) | |
| 22716 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",1,"E" | |
| 22717 | "RTN","ORY 42707",137 ,0) | |
| 22718 | ;;D^PATIE NT.CLOZ_AN C_W/IN_7_R SLT | |
| 22719 | "RTN","ORY 42707",138 ,0) | |
| 22720 | ;;EOR^ | |
| 22721 | "RTN","ORY 42707",139 ,0) | |
| 22722 | ;;KEY^860 .4:^CLOZAP INE LAB RE SULTS | |
| 22723 | "RTN","ORY 42707",140 ,0) | |
| 22724 | ;;R^"860. 4:",.01,"E " | |
| 22725 | "RTN","ORY 42707",141 ,0) | |
| 22726 | ;;D^CLOZA PINE LAB R ESULTS | |
| 22727 | "RTN","ORY 42707",142 ,0) | |
| 22728 | ;;R^"860. 4:",1,"E" | |
| 22729 | "RTN","ORY 42707",143 ,0) | |
| 22730 | ;;D^CLOZ LAB RSLTS | |
| 22731 | "RTN","ORY 42707",144 ,0) | |
| 22732 | ;;R^"860. 4:",101,"E " | |
| 22733 | "RTN","ORY 42707",145 ,0) | |
| 22734 | ;;D^FREE TEXT | |
| 22735 | "RTN","ORY 42707",146 ,0) | |
| 22736 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.01," E" | |
| 22737 | "RTN","ORY 42707",147 ,0) | |
| 22738 | ;;D^DATAB ASE LOOKUP | |
| 22739 | "RTN","ORY 42707",148 ,0) | |
| 22740 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.02," E" | |
| 22741 | "RTN","ORY 42707",149 ,0) | |
| 22742 | ;;D^DATAB ASE LOOKUP | |
| 22743 | "RTN","ORY 42707",150 ,0) | |
| 22744 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",1,"E" | |
| 22745 | "RTN","ORY 42707",151 ,0) | |
| 22746 | ;;D^PATIE NT.CLOZ_LA B_RESULTS | |
| 22747 | "RTN","ORY 42707",152 ,0) | |
| 22748 | ;;EOR^ | |
| 22749 | "RTN","ORY 42707",153 ,0) | |
| 22750 | ;;KEY^860 .4:^CLOZAP INE MED | |
| 22751 | "RTN","ORY 42707",154 ,0) | |
| 22752 | ;;R^"860. 4:",.01,"E " | |
| 22753 | "RTN","ORY 42707",155 ,0) | |
| 22754 | ;;D^CLOZA PINE MED | |
| 22755 | "RTN","ORY 42707",156 ,0) | |
| 22756 | ;;R^"860. 4:",1,"E" | |
| 22757 | "RTN","ORY 42707",157 ,0) | |
| 22758 | ;;D^CLOZA PINE | |
| 22759 | "RTN","ORY 42707",158 ,0) | |
| 22760 | ;;R^"860. 4:",101,"E " | |
| 22761 | "RTN","ORY 42707",159 ,0) | |
| 22762 | ;;D^BOOLE AN | |
| 22763 | "RTN","ORY 42707",160 ,0) | |
| 22764 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.01," E" | |
| 22765 | "RTN","ORY 42707",161 ,0) | |
| 22766 | ;;D^DATAB ASE LOOKUP | |
| 22767 | "RTN","ORY 42707",162 ,0) | |
| 22768 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.02," E" | |
| 22769 | "RTN","ORY 42707",163 ,0) | |
| 22770 | ;;D^DATAB ASE LOOKUP | |
| 22771 | "RTN","ORY 42707",164 ,0) | |
| 22772 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",1,"E" | |
| 22773 | "RTN","ORY 42707",165 ,0) | |
| 22774 | ;;D^PATIE NT.CLOZAPI NE MED | |
| 22775 | "RTN","ORY 42707",166 ,0) | |
| 22776 | ;;EOR^ | |
| 22777 | "RTN","ORY 42707",167 ,0) | |
| 22778 | ;;KEY^860 .4:^CLOZAP INE WBC W/ IN 7 FLAG | |
| 22779 | "RTN","ORY 42707",168 ,0) | |
| 22780 | ;;R^"860. 4:",.01,"E " | |
| 22781 | "RTN","ORY 42707",169 ,0) | |
| 22782 | ;;D^CLOZA PINE WBC W /IN 7 FLAG | |
| 22783 | "RTN","ORY 42707",170 ,0) | |
| 22784 | ;;R^"860. 4:",1,"E" | |
| 22785 | "RTN","ORY 42707",171 ,0) | |
| 22786 | ;;D^CLOZ WBC FLAG | |
| 22787 | "RTN","ORY 42707",172 ,0) | |
| 22788 | ;;R^"860. 4:",101,"E " | |
| 22789 | "RTN","ORY 42707",173 ,0) | |
| 22790 | ;;D^BOOLE AN | |
| 22791 | "RTN","ORY 42707",174 ,0) | |
| 22792 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.01," E" | |
| 22793 | "RTN","ORY 42707",175 ,0) | |
| 22794 | ;;D^DATAB ASE LOOKUP | |
| 22795 | "RTN","ORY 42707",176 ,0) | |
| 22796 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.02," E" | |
| 22797 | "RTN","ORY 42707",177 ,0) | |
| 22798 | ;;D^DATAB ASE LOOKUP | |
| 22799 | "RTN","ORY 42707",178 ,0) | |
| 22800 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",1,"E" | |
| 22801 | "RTN","ORY 42707",179 ,0) | |
| 22802 | ;;D^PATIE NT.CLOZ_WB C_W/IN_7_F LAG | |
| 22803 | "RTN","ORY 42707",180 ,0) | |
| 22804 | ;;EOR^ | |
| 22805 | "RTN","ORY 42707",181 ,0) | |
| 22806 | ;;KEY^860 .4:^FILLER | |
| 22807 | "RTN","ORY 42707",182 ,0) | |
| 22808 | ;;R^"860. 4:",.01,"E " | |
| 22809 | "RTN","ORY 42707",183 ,0) | |
| 22810 | ;;D^FILLE R | |
| 22811 | "RTN","ORY 42707",184 ,0) | |
| 22812 | ;;R^"860. 4:",1,"E" | |
| 22813 | "RTN","ORY 42707",185 ,0) | |
| 22814 | ;;D^FILL | |
| 22815 | "RTN","ORY 42707",186 ,0) | |
| 22816 | ;;R^"860. 4:",101,"E " | |
| 22817 | "RTN","ORY 42707",187 ,0) | |
| 22818 | ;;D^FREE TEXT | |
| 22819 | "RTN","ORY 42707",188 ,0) | |
| 22820 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",.0 1,"E" | |
| 22821 | "RTN","ORY 42707",189 ,0) | |
| 22822 | ;;D^CPRS ORDER PRES CAN | |
| 22823 | "RTN","ORY 42707",190 ,0) | |
| 22824 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",.0 2,"E" | |
| 22825 | "RTN","ORY 42707",191 ,0) | |
| 22826 | ;;D^ORDER ENTRY ORD ER PRESCAN | |
| 22827 | "RTN","ORY 42707",192 ,0) | |
| 22828 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",1, "E" | |
| 22829 | "RTN","ORY 42707",193 ,0) | |
| 22830 | ;;D^PATIE NT.OPS_FIL LER | |
| 22831 | "RTN","ORY 42707",194 ,0) | |
| 22832 | ;;R^"860. 4:","860.4 1:GENERIC HL7 MESSAG E ARRAY^86 0.6",.01," E" | |
| 22833 | "RTN","ORY 42707",195 ,0) | |
| 22834 | ;;D^GENER IC HL7 MES SAGE ARRAY | |
| 22835 | "RTN","ORY 42707",196 ,0) | |
| 22836 | ;;R^"860. 4:","860.4 1:GENERIC HL7 MESSAG E ARRAY^86 0.6",.02," E" | |
| 22837 | "RTN","ORY 42707",197 ,0) | |
| 22838 | ;;D^HL7 C OMMON ORDE R SEGMENT | |
| 22839 | "RTN","ORY 42707",198 ,0) | |
| 22840 | ;;R^"860. 4:","860.4 1:GENERIC HL7 MESSAG E ARRAY^86 0.6",1,"E" | |
| 22841 | "RTN","ORY 42707",199 ,0) | |
| 22842 | ;;D^PATIE NT.HL7_FIL LER | |
| 22843 | "RTN","ORY 42707",200 ,0) | |
| 22844 | ;;EOR^ | |
| 22845 | "RTN","ORY 42707",201 ,0) | |
| 22846 | ;;KEY^860 .4:^ORDER MODE | |
| 22847 | "RTN","ORY 42707",202 ,0) | |
| 22848 | ;;R^"860. 4:",.01,"E " | |
| 22849 | "RTN","ORY 42707",203 ,0) | |
| 22850 | ;;D^ORDER MODE | |
| 22851 | "RTN","ORY 42707",204 ,0) | |
| 22852 | ;;R^"860. 4:",101,"E " | |
| 22853 | "RTN","ORY 42707",205 ,0) | |
| 22854 | ;;D^FREE TEXT | |
| 22855 | "RTN","ORY 42707",206 ,0) | |
| 22856 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",.0 1,"E" | |
| 22857 | "RTN","ORY 42707",207 ,0) | |
| 22858 | ;;D^CPRS ORDER PRES CAN | |
| 22859 | "RTN","ORY 42707",208 ,0) | |
| 22860 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",.0 2,"E" | |
| 22861 | "RTN","ORY 42707",209 ,0) | |
| 22862 | ;;D^ORDER ENTRY ORD ER PRESCAN | |
| 22863 | "RTN","ORY 42707",210 ,0) | |
| 22864 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",1, "E" | |
| 22865 | "RTN","ORY 42707",211 ,0) | |
| 22866 | ;;D^PATIE NT.OPS_ORD _MODE | |
| 22867 | "RTN","ORY 42707",212 ,0) | |
| 22868 | ;;EOR^ | |
| 22869 | "RTN","ORY 42707",213 ,0) | |
| 22870 | ;;KEY^860 .4:^PATIEN T IEN | |
| 22871 | "RTN","ORY 42707",214 ,0) | |
| 22872 | ;;R^"860. 4:",.01,"E " | |
| 22873 | "RTN","ORY 42707",215 ,0) | |
| 22874 | ;;D^PATIE NT IEN | |
| 22875 | "RTN","ORY 42707",216 ,0) | |
| 22876 | ;;R^"860. 4:",101,"E " | |
| 22877 | "RTN","ORY 42707",217 ,0) | |
| 22878 | ;;D^NUMER IC | |
| 22879 | "RTN","ORY 42707",218 ,0) | |
| 22880 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PROTOCO L^860.6",. 01,"E" | |
| 22881 | "RTN","ORY 42707",219 ,0) | |
| 22882 | ;;D^CPRS ORDER PROT OCOL | |
| 22883 | "RTN","ORY 42707",220 ,0) | |
| 22884 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PROTOCO L^860.6",. 02,"E" | |
| 22885 | "RTN","ORY 42707",221 ,0) | |
| 22886 | ;;D^OERR ORDER EVEN T FLAG PRO TOCOL | |
| 22887 | "RTN","ORY 42707",222 ,0) | |
| 22888 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PROTOCO L^860.6",1 ,"E" | |
| 22889 | "RTN","ORY 42707",223 ,0) | |
| 22890 | ;;D^PATIE NT.OERR_OR DER_PATIEN T | |
| 22891 | "RTN","ORY 42707",224 ,0) | |
| 22892 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.01," E" | |
| 22893 | "RTN","ORY 42707",225 ,0) | |
| 22894 | ;;D^DATAB ASE LOOKUP | |
| 22895 | "RTN","ORY 42707",226 ,0) | |
| 22896 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",.02," E" | |
| 22897 | "RTN","ORY 42707",227 ,0) | |
| 22898 | ;;D^DATAB ASE LOOKUP | |
| 22899 | "RTN","ORY 42707",228 ,0) | |
| 22900 | ;;R^"860. 4:","860.4 1:DATABASE LOOKUP^86 0.6",1,"E" | |
| 22901 | "RTN","ORY 42707",229 ,0) | |
| 22902 | ;;D^PATIE NT.IEN | |
| 22903 | "RTN","ORY 42707",230 ,0) | |
| 22904 | ;;R^"860. 4:","860.4 1:GENERIC HL7 MESSAG E ARRAY^86 0.6",.01," E" | |
| 22905 | "RTN","ORY 42707",231 ,0) | |
| 22906 | ;;D^GENER IC HL7 MES SAGE ARRAY | |
| 22907 | "RTN","ORY 42707",232 ,0) | |
| 22908 | ;;R^"860. 4:","860.4 1:GENERIC HL7 MESSAG E ARRAY^86 0.6",.02," E" | |
| 22909 | "RTN","ORY 42707",233 ,0) | |
| 22910 | ;;D^HL7 P ATIENT ID SEGMENT | |
| 22911 | "RTN","ORY 42707",234 ,0) | |
| 22912 | ;;R^"860. 4:","860.4 1:GENERIC HL7 MESSAG E ARRAY^86 0.6",1,"E" | |
| 22913 | "RTN","ORY 42707",235 ,0) | |
| 22914 | ;;D^PATIE NT.HL7_PAT IENT_ID | |
| 22915 | "RTN","ORY 42707",236 ,0) | |
| 22916 | ;;EOR^ | |
| 22917 | "RTN","ORY 42707",237 ,0) | |
| 22918 | ;;KEY^860 .4:^PHARMA CY LOCAL I D | |
| 22919 | "RTN","ORY 42707",238 ,0) | |
| 22920 | ;;R^"860. 4:",.01,"E " | |
| 22921 | "RTN","ORY 42707",239 ,0) | |
| 22922 | ;;D^PHARM ACY LOCAL ID | |
| 22923 | "RTN","ORY 42707",240 ,0) | |
| 22924 | ;;R^"860. 4:",1,"E" | |
| 22925 | "RTN","ORY 42707",241 ,0) | |
| 22926 | ;;D^DISP DRUG IEN | |
| 22927 | "RTN","ORY 42707",242 ,0) | |
| 22928 | ;;R^"860. 4:",101,"E " | |
| 22929 | "RTN","ORY 42707",243 ,0) | |
| 22930 | ;;D^FREE TEXT | |
| 22931 | "RTN","ORY 42707",244 ,0) | |
| 22932 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",.0 1,"E" | |
| 22933 | "RTN","ORY 42707",245 ,0) | |
| 22934 | ;;D^CPRS ORDER PRES CAN | |
| 22935 | "RTN","ORY 42707",246 ,0) | |
| 22936 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",.0 2,"E" | |
| 22937 | "RTN","ORY 42707",247 ,0) | |
| 22938 | ;;D^ORDER ENTRY ORD ER PRESCAN | |
| 22939 | "RTN","ORY 42707",248 ,0) | |
| 22940 | ;;R^"860. 4:","860.4 1:CPRS ORD ER PRESCAN ^860.6",1, "E" | |
| 22941 | "RTN","ORY 42707",249 ,0) | |
| 22942 | ;;D^PATIE NT.OPS_DRU G_ID | |
| 22943 | "RTN","ORY 42707",250 ,0) | |
| 22944 | ;;EOR^ | |
| 22945 | "RTN","ORY 42707",251 ,0) | |
| 22946 | ;;EOF^OCX S(860.4)^1 | |
| 22947 | "RTN","ORY 42707",252 ,0) | |
| 22948 | ;;SOF^860 .3 ORDER CHECK ELEM ENT | |
| 22949 | "RTN","ORY 42707",253 ,0) | |
| 22950 | ;;KEY^860 .3:^CLOZAP INE ANC < 1.0 | |
| 22951 | "RTN","ORY 42707",254 ,0) | |
| 22952 | ;;R^"860. 3:",.01,"E " | |
| 22953 | "RTN","ORY 42707",255 ,0) | |
| 22954 | ;;D^CLOZA PINE ANC < 1.0 | |
| 22955 | "RTN","ORY 42707",256 ,0) | |
| 22956 | ;;R^"860. 3:",.02,"E " | |
| 22957 | "RTN","ORY 42707",257 ,0) | |
| 22958 | ;;D^CPRS ORDER PRES CAN | |
| 22959 | "RTN","ORY 42707",258 ,0) | |
| 22960 | ;;R^"860. 3:","860.3 1:1",.01," E" | |
| 22961 | "RTN","ORY 42707",259 ,0) | |
| 22962 | ;;D^4 | |
| 22963 | "RTN","ORY 42707",260 ,0) | |
| 22964 | ;;R^"860. 3:","860.3 1:1",1,"E" | |
| 22965 | "RTN","ORY 42707",261 ,0) | |
| 22966 | ;;D^CLOZA PINE ANC W /IN 7 RESU LT | |
| 22967 | "RTN","ORY 42707",262 ,0) | |
| 22968 | ;;R^"860. 3:","860.3 1:1",2,"E" | |
| 22969 | "RTN","ORY 42707",263 ,0) | |
| 22970 | ;;D^LESS THAN | |
| 22971 | "RTN","ORY 42707",264 ,0) | |
| 22972 | ;;R^"860. 3:","860.3 1:1",3,"E" | |
| 22973 | "RTN","ORY 42707",265 ,0) | |
| 22974 | ;;D^1.0 | |
| 22975 | "RTN","ORY 42707",266 ,0) | |
| 22976 | ;;R^"860. 3:","860.3 1:2",.01," E" | |
| 22977 | "RTN","ORY 42707",267 ,0) | |
| 22978 | ;;D^5 | |
| 22979 | "RTN","ORY 42707",268 ,0) | |
| 22980 | ;;R^"860. 3:","860.3 1:2",1,"E" | |
| 22981 | "RTN","ORY 42707",269 ,0) | |
| 22982 | ;1; | |
| 22983 | "RTN","ORY 42707",270 ,0) | |
| 22984 | ; | |
| 22985 | "RTN","ORY 42708") | |
| 22986 | 0^13^B3461 4510 | |
| 22987 | "RTN","ORY 42708",1,0 ) | |
| 22988 | ORY42708 ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 22989 | "RTN","ORY 42708",2,0 ) | |
| 22990 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 22991 | "RTN","ORY 42708",3,0 ) | |
| 22992 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 22993 | "RTN","ORY 42708",4,0 ) | |
| 22994 | ; | |
| 22995 | "RTN","ORY 42708",5,0 ) | |
| 22996 | S ; | |
| 22997 | "RTN","ORY 42708",6,0 ) | |
| 22998 | ; | |
| 22999 | "RTN","ORY 42708",7,0 ) | |
| 23000 | D DOT^ORY 427ES | |
| 23001 | "RTN","ORY 42708",8,0 ) | |
| 23002 | ; | |
| 23003 | "RTN","ORY 42708",9,0 ) | |
| 23004 | ; | |
| 23005 | "RTN","ORY 42708",10, 0) | |
| 23006 | K REMOTE, LOCAL,OPCO DE,REF | |
| 23007 | "RTN","ORY 42708",11, 0) | |
| 23008 | F LINE=1: 1:500 S TE XT=$P($T(D ATA+LINE), ";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT | |
| 23009 | "RTN","ORY 42708",12, 0) | |
| 23010 | .S ^TMP(" OCXRULE",$ J,$O(^TMP( "OCXRULE", $J,"A"),-1 )+1)=TEXT | |
| 23011 | "RTN","ORY 42708",13, 0) | |
| 23012 | ; | |
| 23013 | "RTN","ORY 42708",14, 0) | |
| 23014 | ; | |
| 23015 | "RTN","ORY 42708",15, 0) | |
| 23016 | ; | |
| 23017 | "RTN","ORY 42708",16, 0) | |
| 23018 | Q | |
| 23019 | "RTN","ORY 42708",17, 0) | |
| 23020 | ; | |
| 23021 | "RTN","ORY 42708",18, 0) | |
| 23022 | DATA ; | |
| 23023 | "RTN","ORY 42708",19, 0) | |
| 23024 | ; | |
| 23025 | "RTN","ORY 42708",20, 0) | |
| 23026 | ;;D^CLOZA PINE ANC W /IN 7 FLAG | |
| 23027 | "RTN","ORY 42708",21, 0) | |
| 23028 | ;;R^"860. 3:","860.3 1:2",2,"E" | |
| 23029 | "RTN","ORY 42708",22, 0) | |
| 23030 | ;;D^LOGIC AL TRUE | |
| 23031 | "RTN","ORY 42708",23, 0) | |
| 23032 | ;;EOR^ | |
| 23033 | "RTN","ORY 42708",24, 0) | |
| 23034 | ;;KEY^860 .3:^CLOZAP INE ANC >= 1.0 & < 1 .5 | |
| 23035 | "RTN","ORY 42708",25, 0) | |
| 23036 | ;;R^"860. 3:",.01,"E " | |
| 23037 | "RTN","ORY 42708",26, 0) | |
| 23038 | ;;D^CLOZA PINE ANC > = 1.0 & < 1.5 | |
| 23039 | "RTN","ORY 42708",27, 0) | |
| 23040 | ;;R^"860. 3:",.02,"E " | |
| 23041 | "RTN","ORY 42708",28, 0) | |
| 23042 | ;;D^CPRS ORDER PRES CAN | |
| 23043 | "RTN","ORY 42708",29, 0) | |
| 23044 | ;;R^"860. 3:","860.3 1:1",.01," E" | |
| 23045 | "RTN","ORY 42708",30, 0) | |
| 23046 | ;;D^1 | |
| 23047 | "RTN","ORY 42708",31, 0) | |
| 23048 | ;;R^"860. 3:","860.3 1:1",1,"E" | |
| 23049 | "RTN","ORY 42708",32, 0) | |
| 23050 | ;;D^CLOZA PINE ANC W /IN 7 RESU LT | |
| 23051 | "RTN","ORY 42708",33, 0) | |
| 23052 | ;;R^"860. 3:","860.3 1:1",2,"E" | |
| 23053 | "RTN","ORY 42708",34, 0) | |
| 23054 | ;;D^GREAT ER THAN | |
| 23055 | "RTN","ORY 42708",35, 0) | |
| 23056 | ;;R^"860. 3:","860.3 1:1",3,"E" | |
| 23057 | "RTN","ORY 42708",36, 0) | |
| 23058 | ;;D^.999 | |
| 23059 | "RTN","ORY 42708",37, 0) | |
| 23060 | ;;R^"860. 3:","860.3 1:2",.01," E" | |
| 23061 | "RTN","ORY 42708",38, 0) | |
| 23062 | ;;D^2 | |
| 23063 | "RTN","ORY 42708",39, 0) | |
| 23064 | ;;R^"860. 3:","860.3 1:2",1,"E" | |
| 23065 | "RTN","ORY 42708",40, 0) | |
| 23066 | ;;D^CLOZA PINE ANC W /IN 7 RESU LT | |
| 23067 | "RTN","ORY 42708",41, 0) | |
| 23068 | ;;R^"860. 3:","860.3 1:2",2,"E" | |
| 23069 | "RTN","ORY 42708",42, 0) | |
| 23070 | ;;D^LESS THAN | |
| 23071 | "RTN","ORY 42708",43, 0) | |
| 23072 | ;;R^"860. 3:","860.3 1:2",3,"E" | |
| 23073 | "RTN","ORY 42708",44, 0) | |
| 23074 | ;;D^1.5 | |
| 23075 | "RTN","ORY 42708",45, 0) | |
| 23076 | ;;R^"860. 3:","860.3 1:3",.01," E" | |
| 23077 | "RTN","ORY 42708",46, 0) | |
| 23078 | ;;D^3 | |
| 23079 | "RTN","ORY 42708",47, 0) | |
| 23080 | ;;R^"860. 3:","860.3 1:3",1,"E" | |
| 23081 | "RTN","ORY 42708",48, 0) | |
| 23082 | ;;D^CLOZA PINE ANC W /IN 7 FLAG | |
| 23083 | "RTN","ORY 42708",49, 0) | |
| 23084 | ;;R^"860. 3:","860.3 1:3",2,"E" | |
| 23085 | "RTN","ORY 42708",50, 0) | |
| 23086 | ;;D^LOGIC AL TRUE | |
| 23087 | "RTN","ORY 42708",51, 0) | |
| 23088 | ;;EOR^ | |
| 23089 | "RTN","ORY 42708",52, 0) | |
| 23090 | ;;KEY^860 .3:^CLOZAP INE DRUG S ELECTED | |
| 23091 | "RTN","ORY 42708",53, 0) | |
| 23092 | ;;R^"860. 3:",.01,"E " | |
| 23093 | "RTN","ORY 42708",54, 0) | |
| 23094 | ;;D^CLOZA PINE DRUG SELECTED | |
| 23095 | "RTN","ORY 42708",55, 0) | |
| 23096 | ;;R^"860. 3:",.02,"E " | |
| 23097 | "RTN","ORY 42708",56, 0) | |
| 23098 | ;;D^CPRS ORDER PRES CAN | |
| 23099 | "RTN","ORY 42708",57, 0) | |
| 23100 | ;;R^"860. 3:","860.3 1:1",.01," E" | |
| 23101 | "RTN","ORY 42708",58, 0) | |
| 23102 | ;;D^1 | |
| 23103 | "RTN","ORY 42708",59, 0) | |
| 23104 | ;;R^"860. 3:","860.3 1:1",1,"E" | |
| 23105 | "RTN","ORY 42708",60, 0) | |
| 23106 | ;;D^ORDER MODE | |
| 23107 | "RTN","ORY 42708",61, 0) | |
| 23108 | ;;R^"860. 3:","860.3 1:1",2,"E" | |
| 23109 | "RTN","ORY 42708",62, 0) | |
| 23110 | ;;D^EQ FR EE TEXT | |
| 23111 | "RTN","ORY 42708",63, 0) | |
| 23112 | ;;R^"860. 3:","860.3 1:1",3,"E" | |
| 23113 | "RTN","ORY 42708",64, 0) | |
| 23114 | ;;D^SELEC T | |
| 23115 | "RTN","ORY 42708",65, 0) | |
| 23116 | ;;R^"860. 3:","860.3 1:2",.01," E" | |
| 23117 | "RTN","ORY 42708",66, 0) | |
| 23118 | ;;D^2 | |
| 23119 | "RTN","ORY 42708",67, 0) | |
| 23120 | ;;R^"860. 3:","860.3 1:2",1,"E" | |
| 23121 | "RTN","ORY 42708",68, 0) | |
| 23122 | ;;D^FILLE R | |
| 23123 | "RTN","ORY 42708",69, 0) | |
| 23124 | ;;R^"860. 3:","860.3 1:2",2,"E" | |
| 23125 | "RTN","ORY 42708",70, 0) | |
| 23126 | ;;D^START S WITH | |
| 23127 | "RTN","ORY 42708",71, 0) | |
| 23128 | ;;R^"860. 3:","860.3 1:2",3,"E" | |
| 23129 | "RTN","ORY 42708",72, 0) | |
| 23130 | ;;D^PS | |
| 23131 | "RTN","ORY 42708",73, 0) | |
| 23132 | ;;R^"860. 3:","860.3 1:5",.01," E" | |
| 23133 | "RTN","ORY 42708",74, 0) | |
| 23134 | ;;D^5 | |
| 23135 | "RTN","ORY 42708",75, 0) | |
| 23136 | ;;R^"860. 3:","860.3 1:5",1,"E" | |
| 23137 | "RTN","ORY 42708",76, 0) | |
| 23138 | ;;D^CLOZA PINE MED | |
| 23139 | "RTN","ORY 42708",77, 0) | |
| 23140 | ;;R^"860. 3:","860.3 1:5",2,"E" | |
| 23141 | "RTN","ORY 42708",78, 0) | |
| 23142 | ;;D^LOGIC AL TRUE | |
| 23143 | "RTN","ORY 42708",79, 0) | |
| 23144 | ;;EOR^ | |
| 23145 | "RTN","ORY 42708",80, 0) | |
| 23146 | ;;KEY^860 .3:^CLOZAP INE NO ANC W/IN 7 DA YS | |
| 23147 | "RTN","ORY 42708",81, 0) | |
| 23148 | ;;R^"860. 3:",.01,"E " | |
| 23149 | "RTN","ORY 42708",82, 0) | |
| 23150 | ;;D^CLOZA PINE NO AN C W/IN 7 D AYS | |
| 23151 | "RTN","ORY 42708",83, 0) | |
| 23152 | ;;R^"860. 3:",.02,"E " | |
| 23153 | "RTN","ORY 42708",84, 0) | |
| 23154 | ;;D^CPRS ORDER PRES CAN | |
| 23155 | "RTN","ORY 42708",85, 0) | |
| 23156 | ;;R^"860. 3:","860.3 1:6",.01," E" | |
| 23157 | "RTN","ORY 42708",86, 0) | |
| 23158 | ;;D^6 | |
| 23159 | "RTN","ORY 42708",87, 0) | |
| 23160 | ;;R^"860. 3:","860.3 1:6",1,"E" | |
| 23161 | "RTN","ORY 42708",88, 0) | |
| 23162 | ;;D^CLOZA PINE ANC W /IN 7 FLAG | |
| 23163 | "RTN","ORY 42708",89, 0) | |
| 23164 | ;;R^"860. 3:","860.3 1:6",2,"E" | |
| 23165 | "RTN","ORY 42708",90, 0) | |
| 23166 | ;;D^LOGIC AL FALSE | |
| 23167 | "RTN","ORY 42708",91, 0) | |
| 23168 | ;;EOR^ | |
| 23169 | "RTN","ORY 42708",92, 0) | |
| 23170 | ;;KEY^860 .3:^CLOZAP INE NO WBC W/IN 7 DA YS | |
| 23171 | "RTN","ORY 42708",93, 0) | |
| 23172 | ;;R^"860. 3:",.01,"E " | |
| 23173 | "RTN","ORY 42708",94, 0) | |
| 23174 | ;;D^CLOZA PINE NO WB C W/IN 7 D AYS | |
| 23175 | "RTN","ORY 42708",95, 0) | |
| 23176 | ;;R^"860. 3:",.02,"E " | |
| 23177 | "RTN","ORY 42708",96, 0) | |
| 23178 | ;;D^CPRS ORDER PRES CAN | |
| 23179 | "RTN","ORY 42708",97, 0) | |
| 23180 | ;;R^"860. 3:","860.3 1:4",.01," E" | |
| 23181 | "RTN","ORY 42708",98, 0) | |
| 23182 | ;;D^4 | |
| 23183 | "RTN","ORY 42708",99, 0) | |
| 23184 | ;;R^"860. 3:","860.3 1:4",1,"E" | |
| 23185 | "RTN","ORY 42708",100 ,0) | |
| 23186 | ;;D^CLOZA PINE WBC W /IN 7 FLAG | |
| 23187 | "RTN","ORY 42708",101 ,0) | |
| 23188 | ;;R^"860. 3:","860.3 1:4",2,"E" | |
| 23189 | "RTN","ORY 42708",102 ,0) | |
| 23190 | ;;D^LOGIC AL FALSE | |
| 23191 | "RTN","ORY 42708",103 ,0) | |
| 23192 | ;;EOR^ | |
| 23193 | "RTN","ORY 42708",104 ,0) | |
| 23194 | ;;EOF^OCX S(860.3)^1 | |
| 23195 | "RTN","ORY 42708",105 ,0) | |
| 23196 | ;;SOF^860 .2 ORDER CHECK RULE | |
| 23197 | "RTN","ORY 42708",106 ,0) | |
| 23198 | ;;KEY^860 .2:^CLOZAP INE | |
| 23199 | "RTN","ORY 42708",107 ,0) | |
| 23200 | ;;R^"860. 2:",.01,"E " | |
| 23201 | "RTN","ORY 42708",108 ,0) | |
| 23202 | ;;D^CLOZA PINE | |
| 23203 | "RTN","ORY 42708",109 ,0) | |
| 23204 | ;;R^"860. 2:","860.2 1:1",.01," E" | |
| 23205 | "RTN","ORY 42708",110 ,0) | |
| 23206 | ;;D^NO WB C W/IN 7 D AYS | |
| 23207 | "RTN","ORY 42708",111 ,0) | |
| 23208 | ;;R^"860. 2:","860.2 1:1",.02," E" | |
| 23209 | "RTN","ORY 42708",112 ,0) | |
| 23210 | ;;D^SIMPL E DEFINITI ON | |
| 23211 | "RTN","ORY 42708",113 ,0) | |
| 23212 | ;;R^"860. 2:","860.2 1:1",1,"E" | |
| 23213 | "RTN","ORY 42708",114 ,0) | |
| 23214 | ;;D^CLOZA PINE NO WB C W/IN 7 D AYS | |
| 23215 | "RTN","ORY 42708",115 ,0) | |
| 23216 | ;;R^"860. 2:","860.2 1:1",2,"E" | |
| 23217 | "RTN","ORY 42708",116 ,0) | |
| 23218 | ;;D^CLOZA PINE AND N O WBC W/IN 7 DAYS | |
| 23219 | "RTN","ORY 42708",117 ,0) | |
| 23220 | ;;R^"860. 2:","860.2 1:10",.01, "E" | |
| 23221 | "RTN","ORY 42708",118 ,0) | |
| 23222 | ;;D^1.0 > = ANC < 1. 5 | |
| 23223 | "RTN","ORY 42708",119 ,0) | |
| 23224 | ;;R^"860. 2:","860.2 1:10",.02, "E" | |
| 23225 | "RTN","ORY 42708",120 ,0) | |
| 23226 | ;;D^SIMPL E DEFINITI ON | |
| 23227 | "RTN","ORY 42708",121 ,0) | |
| 23228 | ;;R^"860. 2:","860.2 1:10",1,"E " | |
| 23229 | "RTN","ORY 42708",122 ,0) | |
| 23230 | ;;D^CLOZA PINE ANC > = 1.0 & < 1.5 | |
| 23231 | "RTN","ORY 42708",123 ,0) | |
| 23232 | ;;R^"860. 2:","860.2 1:4",.01," E" | |
| 23233 | "RTN","ORY 42708",124 ,0) | |
| 23234 | ;;D^ANC < 1.0 | |
| 23235 | "RTN","ORY 42708",125 ,0) | |
| 23236 | ;;R^"860. 2:","860.2 1:4",.02," E" | |
| 23237 | "RTN","ORY 42708",126 ,0) | |
| 23238 | ;;D^SIMPL E DEFINITI ON | |
| 23239 | "RTN","ORY 42708",127 ,0) | |
| 23240 | ;;R^"860. 2:","860.2 1:4",1,"E" | |
| 23241 | "RTN","ORY 42708",128 ,0) | |
| 23242 | ;;D^CLOZA PINE ANC < 1.0 | |
| 23243 | "RTN","ORY 42708",129 ,0) | |
| 23244 | ;;R^"860. 2:","860.2 1:6",.01," E" | |
| 23245 | "RTN","ORY 42708",130 ,0) | |
| 23246 | ;;D^NO AN C W/IN 7 D AYS | |
| 23247 | "RTN","ORY 42708",131 ,0) | |
| 23248 | ;;R^"860. 2:","860.2 1:6",.02," E" | |
| 23249 | "RTN","ORY 42708",132 ,0) | |
| 23250 | ;;D^SIMPL E DEFINITI ON | |
| 23251 | "RTN","ORY 42708",133 ,0) | |
| 23252 | ;;R^"860. 2:","860.2 1:6",1,"E" | |
| 23253 | "RTN","ORY 42708",134 ,0) | |
| 23254 | ;;D^CLOZA PINE NO AN C W/IN 7 D AYS | |
| 23255 | "RTN","ORY 42708",135 ,0) | |
| 23256 | ;;R^"860. 2:","860.2 1:7",.01," E" | |
| 23257 | "RTN","ORY 42708",136 ,0) | |
| 23258 | ;;D^CLOZA PINE | |
| 23259 | "RTN","ORY 42708",137 ,0) | |
| 23260 | ;;R^"860. 2:","860.2 1:7",.02," E" | |
| 23261 | "RTN","ORY 42708",138 ,0) | |
| 23262 | ;;D^SIMPL E DEFINITI ON | |
| 23263 | "RTN","ORY 42708",139 ,0) | |
| 23264 | ;;R^"860. 2:","860.2 1:7",1,"E" | |
| 23265 | "RTN","ORY 42708",140 ,0) | |
| 23266 | ;;D^CLOZA PINE DRUG SELECTED | |
| 23267 | "RTN","ORY 42708",141 ,0) | |
| 23268 | ;;R^"860. 2:","860.2 2:1",.01," E" | |
| 23269 | "RTN","ORY 42708",142 ,0) | |
| 23270 | ;;D^1 | |
| 23271 | "RTN","ORY 42708",143 ,0) | |
| 23272 | ;;R^"860. 2:","860.2 2:1",1,"E" | |
| 23273 | "RTN","ORY 42708",144 ,0) | |
| 23274 | ;;D^CLOZA PINE AND ( NO WBC W/I N 7 DAYS O R NO ANC W /IN 7 DAYS ) | |
| 23275 | "RTN","ORY 42708",145 ,0) | |
| 23276 | ;;R^"860. 2:","860.2 2:1",2,"E" | |
| 23277 | "RTN","ORY 42708",146 ,0) | |
| 23278 | ;;D^CLOZA PINE APPRO PRIATENESS | |
| 23279 | "RTN","ORY 42708",147 ,0) | |
| 23280 | ;;R^"860. 2:","860.2 2:1",6,"E" | |
| 23281 | "RTN","ORY 42708",148 ,0) | |
| 23282 | ;;D^Cloza pine order s require a CBC/Diff within pa st 7 days. Please o rder CBC/D iff with W BC and ANC immediate ly. Most recent res ults - |CL OZ LAB RSL TS| | |
| 23283 | "RTN","ORY 42708",149 ,0) | |
| 23284 | ;;R^"860. 2:","860.2 2:2",.01," E" | |
| 23285 | "RTN","ORY 42708",150 ,0) | |
| 23286 | ;;D^2 | |
| 23287 | "RTN","ORY 42708",151 ,0) | |
| 23288 | ;;R^"860. 2:","860.2 2:2",1,"E" | |
| 23289 | "RTN","ORY 42708",152 ,0) | |
| 23290 | ;;D^CLOZA PINE AND A NC < 1.0 | |
| 23291 | "RTN","ORY 42708",153 ,0) | |
| 23292 | ;;R^"860. 2:","860.2 2:2",2,"E" | |
| 23293 | "RTN","ORY 42708",154 ,0) | |
| 23294 | ;;D^CLOZA PINE APPRO PRIATENESS | |
| 23295 | "RTN","ORY 42708",155 ,0) | |
| 23296 | ;;R^"860. 2:","860.2 2:2",6,"E" | |
| 23297 | "RTN","ORY 42708",156 ,0) | |
| 23298 | ;;D^Moder ate/Severe Neutropen ia - pleas e repeat C BC/Diff in cluding WB C and ANC tests imme diately an d Daily un til ANC st abilizes t o greater than or eq ual to 100 0. Most re cent resul ts - |CLOZ LAB RSLTS | | |
| 23299 | "RTN","ORY 42708",157 ,0) | |
| 23300 | ;;R^"860. 2:","860.2 2:3",.01," E" | |
| 23301 | "RTN","ORY 42708",158 ,0) | |
| 23302 | ;;D^3 | |
| 23303 | "RTN","ORY 42708",159 ,0) | |
| 23304 | ;;R^"860. 2:","860.2 2:3",1,"E" | |
| 23305 | "RTN","ORY 42708",160 ,0) | |
| 23306 | ;;D^CLOZA PINE AND ( 1.0 >= ANC < 1.5) | |
| 23307 | "RTN","ORY 42708",161 ,0) | |
| 23308 | ;;R^"860. 2:","860.2 2:3",2,"E" | |
| 23309 | "RTN","ORY 42708",162 ,0) | |
| 23310 | ;;D^CLOZA PINE APPRO PRIATENESS | |
| 23311 | "RTN","ORY 42708",163 ,0) | |
| 23312 | ;;R^"860. 2:","860.2 2:3",6,"E" | |
| 23313 | "RTN","ORY 42708",164 ,0) | |
| 23314 | ;;D^Mild Neutropeni a - please repeat CB C/Diff inc luding WBC and ANC t ests immed iately and 3X weekly until ANC stabilize s to great er than or equal to 1500. Most recent re sults - |C LOZ LAB RS LTS| | |
| 23315 | "RTN","ORY 42708",165 ,0) | |
| 23316 | ;;EOR^ | |
| 23317 | "RTN","ORY 42708",166 ,0) | |
| 23318 | ;;EOF^OCX S(860.2)^1 | |
| 23319 | "RTN","ORY 42708",167 ,0) | |
| 23320 | ;1; | |
| 23321 | "RTN","ORY 42708",168 ,0) | |
| 23322 | ; | |
| 23323 | "RTN","ORY 4271") | |
| 23324 | 0^2^B40435 115 | |
| 23325 | "RTN","ORY 4271",1,0) | |
| 23326 | ORY4271 ;S LC/RJS,CLA - OCX PAC KAGE RULE TRANSPORT ROUTINE (D elete afte r Install of OR*3*42 7) ;MAR 7, 2017 at 15 :12 | |
| 23327 | "RTN","ORY 4271",2,0) | |
| 23328 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 23329 | "RTN","ORY 4271",3,0) | |
| 23330 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 23331 | "RTN","ORY 4271",4,0) | |
| 23332 | ; | |
| 23333 | "RTN","ORY 4271",5,0) | |
| 23334 | S ; | |
| 23335 | "RTN","ORY 4271",6,0) | |
| 23336 | ; | |
| 23337 | "RTN","ORY 4271",7,0) | |
| 23338 | Q | |
| 23339 | "RTN","ORY 4271",8,0) | |
| 23340 | ; | |
| 23341 | "RTN","ORY 4271",9,0) | |
| 23342 | ; | |
| 23343 | "RTN","ORY 4271",10,0 ) | |
| 23344 | COMPARE(L, R) ; | |
| 23345 | "RTN","ORY 4271",11,0 ) | |
| 23346 | ; | |
| 23347 | "RTN","ORY 4271",12,0 ) | |
| 23348 | Q:$$RES(" R") 1 | |
| 23349 | "RTN","ORY 4271",13,0 ) | |
| 23350 | ; | |
| 23351 | "RTN","ORY 4271",14,0 ) | |
| 23352 | Q:'$L($O( L(""))) $$ ADDREC^ORY 4272("R") | |
| 23353 | "RTN","ORY 4271",15,0 ) | |
| 23354 | ; | |
| 23355 | "RTN","ORY 4271",16,0 ) | |
| 23356 | N C,OCXDD M C=L,C=R S OCXDD=$ O(C("")) Q $$MULT("C ",OCXDD) | |
| 23357 | "RTN","ORY 4271",17,0 ) | |
| 23358 | ; | |
| 23359 | "RTN","ORY 4271",18,0 ) | |
| 23360 | Q 0 | |
| 23361 | "RTN","ORY 4271",19,0 ) | |
| 23362 | ; | |
| 23363 | "RTN","ORY 4271",20,0 ) | |
| 23364 | RES(REF) ; | |
| 23365 | "RTN","ORY 4271",21,0 ) | |
| 23366 | ; | |
| 23367 | "RTN","ORY 4271",22,0 ) | |
| 23368 | N QUIT,SU B | |
| 23369 | "RTN","ORY 4271",23,0 ) | |
| 23370 | S QUIT=0 | |
| 23371 | "RTN","ORY 4271",24,0 ) | |
| 23372 | S SUB="" F S SUB=$ O(@REF@(SU B)) Q:'$L( SUB) I (S UB[":") D Q:QUIT | |
| 23373 | "RTN","ORY 4271",25,0 ) | |
| 23374 | .N DD,DA | |
| 23375 | "RTN","ORY 4271",26,0 ) | |
| 23376 | .S DD=$P( SUB,":",1) ,DA=$P(SUB ,":",2) | |
| 23377 | "RTN","ORY 4271",27,0 ) | |
| 23378 | .I $L(DA) ,'(DA=+DA) D Q:QUIT | |
| 23379 | "RTN","ORY 4271",28,0 ) | |
| 23380 | ..N DANEW ,SUBNEW | |
| 23381 | "RTN","ORY 4271",29,0 ) | |
| 23382 | ..S DANEW =$O(^OCXS( $P(DA,U,2) ,"B",$P(DA ,U,1),0)) | |
| 23383 | "RTN","ORY 4271",30,0 ) | |
| 23384 | ..I 'DANE W W !!,$P( $G(^OCXS(+ $P(DA,U,2) ,0)),U,1), ": ",$P(DA ,U,1)," c ould not r esolve nam e.",!!," End Tran sport." S QUIT=1 Q | |
| 23385 | "RTN","ORY 4271",31,0 ) | |
| 23386 | ..S SUBNE W=DD_":"_D ANEW | |
| 23387 | "RTN","ORY 4271",32,0 ) | |
| 23388 | ..I $D(@R EF@(SUBNEW )) W !!," multiple # ",DANEW," already ex isted." S QUIT=1 Q | |
| 23389 | "RTN","ORY 4271",33,0 ) | |
| 23390 | ..M @REF@ (SUBNEW)=@ REF@(SUB) | |
| 23391 | "RTN","ORY 4271",34,0 ) | |
| 23392 | ..K @REF@ (SUB) | |
| 23393 | "RTN","ORY 4271",35,0 ) | |
| 23394 | ..S SUB=" " | |
| 23395 | "RTN","ORY 4271",36,0 ) | |
| 23396 | .I $L(SUB ),($D(@REF @(SUB))>9) S QUIT=$$ RES($NA(@R EF@(SUB))) | |
| 23397 | "RTN","ORY 4271",37,0 ) | |
| 23398 | ; | |
| 23399 | "RTN","ORY 4271",38,0 ) | |
| 23400 | Q QUIT | |
| 23401 | "RTN","ORY 4271",39,0 ) | |
| 23402 | ; | |
| 23403 | "RTN","ORY 4271",40,0 ) | |
| 23404 | MULT(CREF, OCXDD) ; | |
| 23405 | "RTN","ORY 4271",41,0 ) | |
| 23406 | ; | |
| 23407 | "RTN","ORY 4271",42,0 ) | |
| 23408 | N OCXSUB, LREF,RREF, QUIT,OCXFL D | |
| 23409 | "RTN","ORY 4271",43,0 ) | |
| 23410 | S LREF="L "_$E(CREF, 2,$L(CREF) ),RREF="R" _$E(CREF,2 ,$L(CREF)) | |
| 23411 | "RTN","ORY 4271",44,0 ) | |
| 23412 | ; | |
| 23413 | "RTN","ORY 4271",45,0 ) | |
| 23414 | S QUIT=0, OCXFLD="" F S OCXFL D=$O(@CREF @(OCXDD,OC XFLD)) Q:' $L(OCXFLD) D Q:QUI T | |
| 23415 | "RTN","ORY 4271",46,0 ) | |
| 23416 | .I (OCXFL D[":") D Q:QUIT | |
| 23417 | "RTN","ORY 4271",47,0 ) | |
| 23418 | ..Q:$$EXF LD(+OCXFLD ,0) | |
| 23419 | "RTN","ORY 4271",48,0 ) | |
| 23420 | ..I '$D(@ LREF@(OCXD D,OCXFLD,. 01,"E")) D M @LREF@ (OCXDD,OCX FLD)=@RREF @(OCXDD,OC XFLD) | |
| 23421 | "RTN","ORY 4271",49,0 ) | |
| 23422 | ...D WARN ("Missing multiple:" ,CREF,OCXD D,OCXFLD) | |
| 23423 | "RTN","ORY 4271",50,0 ) | |
| 23424 | ...S QUIT =$$ADDMULT ^ORY4273(C REF,OCXDD, OCXFLD) | |
| 23425 | "RTN","ORY 4271",51,0 ) | |
| 23426 | ..I '$D(@ RREF@(OCXD D,OCXFLD,. 01,"E")) D M @RREF@ (OCXDD,OCX FLD)=@LREF @(OCXDD,OC XFLD) | |
| 23427 | "RTN","ORY 4271",52,0 ) | |
| 23428 | ...D WARN ("Extra mu ltiple:",C REF,OCXDD, OCXFLD) | |
| 23429 | "RTN","ORY 4271",53,0 ) | |
| 23430 | ...S QUIT =$$DELMULT ^ORY4273($ $APPEND(CR EF,OCXDD), OCXFLD) | |
| 23431 | "RTN","ORY 4271",54,0 ) | |
| 23432 | .; | |
| 23433 | "RTN","ORY 4271",55,0 ) | |
| 23434 | .I (OCXFL D=+OCXFLD) ,'$$EXFLD( +OCXDD,OCX FLD) D | |
| 23435 | "RTN","ORY 4271",56,0 ) | |
| 23436 | ..I ($O(@ CREF@(OCXD D,OCXFLD," "))="E") D Q | |
| 23437 | "RTN","ORY 4271",57,0 ) | |
| 23438 | ...I $L($ G(@RREF@(O CXDD,OCXFL D,"E"))),' $L($G(@LRE F@(OCXDD,O CXFLD,"E") )) D Q | |
| 23439 | "RTN","ORY 4271",58,0 ) | |
| 23440 | ....D WAR N("Data Va lue Missin g in "_$$N ETNAME^OCX SEND,CREF, OCXDD,OCXF LD,"E") | |
| 23441 | "RTN","ORY 4271",59,0 ) | |
| 23442 | ....S QUI T=$$EDITFL D^ORY4274( CREF,OCXDD ,OCXFLD,"E ") | |
| 23443 | "RTN","ORY 4271",60,0 ) | |
| 23444 | ...I $L($ G(@LREF@(O CXDD,OCXFL D,"E"))),' $L($G(@RRE F@(OCXDD,O CXFLD,"E") )) D Q | |
| 23445 | "RTN","ORY 4271",61,0 ) | |
| 23446 | ....D WAR N("Extra D ata Value in "_$$NET NAME^OCXSE ND,CREF,OC XDD,OCXFLD ,"E") | |
| 23447 | "RTN","ORY 4271",62,0 ) | |
| 23448 | ....S QUI T=$$DELFLD ^ORY4274(C REF,OCXDD, OCXFLD,"E" ) | |
| 23449 | "RTN","ORY 4271",63,0 ) | |
| 23450 | ...I '(@L REF@(OCXDD ,OCXFLD,"E ")=@RREF@( OCXDD,OCXF LD,"E")) D | |
| 23451 | "RTN","ORY 4271",64,0 ) | |
| 23452 | ....D WAR N("Inconsi stent Data ",CREF,OCX DD,OCXFLD, "E") | |
| 23453 | "RTN","ORY 4271",65,0 ) | |
| 23454 | ....S QUI T=$$EDITFL D^ORY4274( CREF,OCXDD ,OCXFLD,"E ") | |
| 23455 | "RTN","ORY 4271",66,0 ) | |
| 23456 | ..S OCXSU B=0 F Q:Q UIT S OCX SUB=$O(@CR EF@(OCXDD, OCXFLD,OCX SUB)) Q:'O CXSUB I ' ($G(@RREF@ (OCXDD,OCX FLD,OCXSUB ))=$G(@LRE F@(OCXDD,O CXFLD,OCXS UB))) D Q | |
| 23457 | "RTN","ORY 4271",67,0 ) | |
| 23458 | ...D WARN ("Inconsis tent word Data",CREF ,OCXDD,OCX FLD,OCXSUB ) | |
| 23459 | "RTN","ORY 4271",68,0 ) | |
| 23460 | ...S QUIT =$$LOADWOR D^ORY4272( RREF,OCXDD ,OCXFLD,OC XSUB) | |
| 23461 | "RTN","ORY 4271",69,0 ) | |
| 23462 | .; | |
| 23463 | "RTN","ORY 4271",70,0 ) | |
| 23464 | .I 'QUIT, (OCXFLD[": ") S QUIT= $$MULT($$A PPEND(CREF ,OCXDD),OC XFLD) | |
| 23465 | "RTN","ORY 4271",71,0 ) | |
| 23466 | Q QUIT | |
| 23467 | "RTN","ORY 4271",72,0 ) | |
| 23468 | ; | |
| 23469 | "RTN","ORY 4271",73,0 ) | |
| 23470 | APPEND(ARR AY,OCXSUB) ; | |
| 23471 | "RTN","ORY 4271",74,0 ) | |
| 23472 | S:'(OCXSU B=+OCXSUB) OCXSUB="" ""_OCXSUB_ """" | |
| 23473 | "RTN","ORY 4271",75,0 ) | |
| 23474 | Q:'(ARRAY ["(") ARRA Y_"("_OCXS UB_")" | |
| 23475 | "RTN","ORY 4271",76,0 ) | |
| 23476 | Q $E(ARRA Y,1,$L(ARR AY)-1)_"," _OCXSUB_") " | |
| 23477 | "RTN","ORY 4271",77,0 ) | |
| 23478 | ; | |
| 23479 | "RTN","ORY 4271",78,0 ) | |
| 23480 | EXFLD(FILE ,OCXFLD) ; | |
| 23481 | "RTN","ORY 4271",79,0 ) | |
| 23482 | N OCXFNAM | |
| 23483 | "RTN","ORY 4271",80,0 ) | |
| 23484 | S OCXFNAM =$$FIELD^O CXSENDD(FI LE,OCXFLD, "LABEL") | |
| 23485 | "RTN","ORY 4271",81,0 ) | |
| 23486 | I (OCXFNA M["UNIQUE OBJECT IDE NTIFIER") Q 1 | |
| 23487 | "RTN","ORY 4271",82,0 ) | |
| 23488 | I (FILE=8 60.2),(OCX FLD=.02) Q 1 | |
| 23489 | "RTN","ORY 4271",83,0 ) | |
| 23490 | I (FILE=8 60.22),(OC XFLD=4) Q 1 | |
| 23491 | "RTN","ORY 4271",84,0 ) | |
| 23492 | I (FILE=8 60.3),(OCX FLD=3) Q 1 | |
| 23493 | "RTN","ORY 4271",85,0 ) | |
| 23494 | I (FILE=8 60.9),(OCX FLD=1) Q 1 | |
| 23495 | "RTN","ORY 4271",86,0 ) | |
| 23496 | I (FILE=8 60.91) Q 1 | |
| 23497 | "RTN","ORY 4271",87,0 ) | |
| 23498 | I (FILE=8 60.801) Q 1 | |
| 23499 | "RTN","ORY 4271",88,0 ) | |
| 23500 | I (FILE=8 60.81) Q 1 | |
| 23501 | "RTN","ORY 4271",89,0 ) | |
| 23502 | I (FILE=8 61.01) Q 1 | |
| 23503 | "RTN","ORY 4271",90,0 ) | |
| 23504 | I (FILE=8 63.02) Q 1 | |
| 23505 | "RTN","ORY 4271",91,0 ) | |
| 23506 | I (FILE=8 63.54) Q 1 | |
| 23507 | "RTN","ORY 4271",92,0 ) | |
| 23508 | I (FILE=8 63.61) Q 1 | |
| 23509 | "RTN","ORY 4271",93,0 ) | |
| 23510 | I (FILE=8 63.72) Q 1 | |
| 23511 | "RTN","ORY 4271",94,0 ) | |
| 23512 | I (FILE=8 63.81) Q 1 | |
| 23513 | "RTN","ORY 4271",95,0 ) | |
| 23514 | I ($E(OCX FNAM,1)="* ") Q 1 | |
| 23515 | "RTN","ORY 4271",96,0 ) | |
| 23516 | Q 0 | |
| 23517 | "RTN","ORY 4271",97,0 ) | |
| 23518 | ; | |
| 23519 | "RTN","ORY 4271",98,0 ) | |
| 23520 | WARN(MSG,C REF,OCXDD, OCXFLD,OCX SUB) ; | |
| 23521 | "RTN","ORY 4271",99,0 ) | |
| 23522 | ; | |
| 23523 | "RTN","ORY 4271",100, 0) | |
| 23524 | Q:$G(OCXA UTO) | |
| 23525 | "RTN","ORY 4271",101, 0) | |
| 23526 | ; | |
| 23527 | "RTN","ORY 4271",102, 0) | |
| 23528 | N D0,DASH ,OCXDDPTH, OCXDPTR,FI LE,FILEID, LREF,OCXPT R,RREF | |
| 23529 | "RTN","ORY 4271",103, 0) | |
| 23530 | ; | |
| 23531 | "RTN","ORY 4271",104, 0) | |
| 23532 | S DASH="" ,$P(DASH," -",(55-$L( MSG)))="-" | |
| 23533 | "RTN","ORY 4271",105, 0) | |
| 23534 | W !!,"--- ---------" ,MSG,DASH | |
| 23535 | "RTN","ORY 4271",106, 0) | |
| 23536 | D DSPHDR( CREF,OCXDD ,OCXFLD) | |
| 23537 | "RTN","ORY 4271",107, 0) | |
| 23538 | I $D(OCXS UB) D DSPF LD(CREF,OC XDD,OCXFLD ,OCXSUB) | |
| 23539 | "RTN","ORY 4271",108, 0) | |
| 23540 | I '$D(OCX SUB) D DSP REC(CREF,O CXDD,OCXFL D) | |
| 23541 | "RTN","ORY 4271",109, 0) | |
| 23542 | ; | |
| 23543 | "RTN","ORY 4271",110, 0) | |
| 23544 | W ! Q | |
| 23545 | "RTN","ORY 4271",111, 0) | |
| 23546 | ; | |
| 23547 | "RTN","ORY 4271",112, 0) | |
| 23548 | DSPREC(CRE F,OCXDD,OC XFLD) ; | |
| 23549 | "RTN","ORY 4271",113, 0) | |
| 23550 | ; | |
| 23551 | "RTN","ORY 4271",114, 0) | |
| 23552 | N OCXDPTR ,OCXDDPTH, LEVL,OCXCR EF,OCXSUB | |
| 23553 | "RTN","ORY 4271",115, 0) | |
| 23554 | S OCXCREF =$$APPEND( $$APPEND(C REF,OCXDD) ,OCXFLD) | |
| 23555 | "RTN","ORY 4271",116, 0) | |
| 23556 | S OCXDDPT H=$P($P(OC XCREF,"(", 2),")",1), LEVL=$L(OC XDDPTH,"," ) | |
| 23557 | "RTN","ORY 4271",117, 0) | |
| 23558 | S OCXSUB= "" F S OC XSUB=$O(@O CXCREF@(OC XSUB)) Q:' $L(OCXSUB) D | |
| 23559 | "RTN","ORY 4271",118, 0) | |
| 23560 | .; | |
| 23561 | "RTN","ORY 4271",119, 0) | |
| 23562 | .I '(OCXS UB[":"),'( (OCXSUB=.0 1)&$O(@OCX CREF@(OCXS UB))) D | |
| 23563 | "RTN","ORY 4271",120, 0) | |
| 23564 | ..N LINE | |
| 23565 | "RTN","ORY 4271",121, 0) | |
| 23566 | ..Q:$$EXF LD(+OCXFLD ,OCXSUB) | |
| 23567 | "RTN","ORY 4271",122, 0) | |
| 23568 | ..I OCXFL D W !,?(5+ ((LEVL)*4) ),$$FIELD^ OCXSENDD(+ OCXFLD,OCX SUB,"LABEL "),": ",$G (@OCXCREF@ (OCXSUB,"E ")) | |
| 23569 | "RTN","ORY 4271",123, 0) | |
| 23570 | ..S LINE= 0 F S LIN E=$O(@OCXC REF@(OCXSU B,LINE)) Q :'LINE D | |
| 23571 | "RTN","ORY 4271",124, 0) | |
| 23572 | ...W !,?( 5+(LEVL*4) ),$J(LINE, 3),">",@OC XCREF@(OCX SUB,LINE) | |
| 23573 | "RTN","ORY 4271",125, 0) | |
| 23574 | .; | |
| 23575 | "RTN","ORY 4271",126, 0) | |
| 23576 | .I (OCXSU B[":") D | |
| 23577 | "RTN","ORY 4271",127, 0) | |
| 23578 | ..N D0,OC XDD,FILENA ME | |
| 23579 | "RTN","ORY 4271",128, 0) | |
| 23580 | ..S D0=+$ P(OCXSUB," :",2),OCXD D=+OCXSUB | |
| 23581 | "RTN","ORY 4271",129, 0) | |
| 23582 | ..S FILEN AME=$$FILE NAME^OCXSE NDD(OCXDD) | |
| 23583 | "RTN","ORY 4271",130, 0) | |
| 23584 | ..I $L(FI LENAME) W !,?(5+($L( LEVL)*4)), FILENAME | |
| 23585 | "RTN","ORY 4271",131, 0) | |
| 23586 | ..E W !! ,?(5+(LEVL *4)),FILEN AME | |
| 23587 | "RTN","ORY 4271",132, 0) | |
| 23588 | ..W " ",D 0,": ",$G( @OCXCREF@( OCXSUB,.01 ,"E")) | |
| 23589 | "RTN","ORY 4271",133, 0) | |
| 23590 | ..D DSPRE C($$APPEND (CREF,OCXD D),OCXFLD, OCXSUB) | |
| 23591 | "RTN","ORY 4271",134, 0) | |
| 23592 | ; | |
| 23593 | "RTN","ORY 4271",135, 0) | |
| 23594 | Q | |
| 23595 | "RTN","ORY 4271",136, 0) | |
| 23596 | ; | |
| 23597 | "RTN","ORY 4271",137, 0) | |
| 23598 | DSPHDR(CRE F,OCXDD,OC XFLD) ; | |
| 23599 | "RTN","ORY 4271",138, 0) | |
| 23600 | ; | |
| 23601 | "RTN","ORY 4271",139, 0) | |
| 23602 | N D0,FILE ,FILEID,OC XPTR,OCXDD PTH | |
| 23603 | "RTN","ORY 4271",140, 0) | |
| 23604 | S OCXDDPT H=$P($P($$ APPEND($$A PPEND(CREF ,OCXDD),OC XFLD),"(", 2),")",1) | |
| 23605 | "RTN","ORY 4271",141, 0) | |
| 23606 | S FILE="" F OCXPTR= 1:1:$L(OCX DDPTH,",") D | |
| 23607 | "RTN","ORY 4271",142, 0) | |
| 23608 | .N OCXDD, D0,FILEID | |
| 23609 | "RTN","ORY 4271",143, 0) | |
| 23610 | .S FILEID =$P(OCXDDP TH,",",OCX PTR) | |
| 23611 | "RTN","ORY 4271",144, 0) | |
| 23612 | .I (FILEI D[":") D | |
| 23613 | "RTN","ORY 4271",145, 0) | |
| 23614 | ..S D0=+$ P(FILEID," :",2),OCXD D=+$E(FILE ID,2,$L(FI LEID)) | |
| 23615 | "RTN","ORY 4271",146, 0) | |
| 23616 | ..W !,?(5 +(OCXPTR*4 )),$$FILEN AME^OCXSEN DD(OCXDD) | |
| 23617 | "RTN","ORY 4271",147, 0) | |
| 23618 | ..S:$L(FI LE) FILE=F ILE_"," S FILE=FILE_ FILEID | |
| 23619 | "RTN","ORY 4271",148, 0) | |
| 23620 | ..I $D(@( "L("_FILE_ ",.01,""E" ")")) W ": ",@("L("_ FILE_",.01 ,""E"")") W:D0 " [", D0,"]" | |
| 23621 | "RTN","ORY 4271",149, 0) | |
| 23622 | ..E I $D (@("R("_FI LE_",.01," "E"")")) W ": ",@("R ("_FILE_", .01,""E"") ") W:D0 " [",D0,"]" | |
| 23623 | "RTN","ORY 4271",150, 0) | |
| 23624 | ; | |
| 23625 | "RTN","ORY 4271",151, 0) | |
| 23626 | Q | |
| 23627 | "RTN","ORY 4271",152, 0) | |
| 23628 | ; | |
| 23629 | "RTN","ORY 4271",153, 0) | |
| 23630 | DSPFLD(CRE F,OCXDD,OC XFLD,OCXSU B) ; | |
| 23631 | "RTN","ORY 4271",154, 0) | |
| 23632 | ; | |
| 23633 | "RTN","ORY 4271",155, 0) | |
| 23634 | N OCXDPTR ,LREF,RREF ,OCXDDPTH | |
| 23635 | "RTN","ORY 4271",156, 0) | |
| 23636 | ; | |
| 23637 | "RTN","ORY 4271",157, 0) | |
| 23638 | S OCXDDPT H=$P($P($$ APPEND(CRE F,OCXDD)," (",2),")", 1) | |
| 23639 | "RTN","ORY 4271",158, 0) | |
| 23640 | S LREF="L ("_OCXDDPT H_")",RREF ="R("_OCXD DPTH_")" | |
| 23641 | "RTN","ORY 4271",159, 0) | |
| 23642 | W !,?(5+( ($L(OCXDDP TH,",")+1) *4)),$$FIE LD^OCXSEND D(OCXDD,OC XFLD,"LABE L")," fiel d [",OCXFL D,"]" | |
| 23643 | "RTN","ORY 4271",160, 0) | |
| 23644 | I OCXSUB W " Line # ",OCXSUB | |
| 23645 | "RTN","ORY 4271",161, 0) | |
| 23646 | ; | |
| 23647 | "RTN","ORY 4271",162, 0) | |
| 23648 | W:($D(@RR EF@(OCXFLD ,OCXSUB))) !,?(5+(($ L(OCXDDPTH ,",")+2)*4 )),"(R) NC CLAB1.AAC. VA.GOV: ", @RREF@(OCX FLD,OCXSUB ) | |
| 23649 | "RTN","ORY 4271",163, 0) | |
| 23650 | W:($D(@LR EF@(OCXFLD ,OCXSUB))) !,?(5+(($ L(OCXDDPTH ,",")+2)*4 )),"(L) ", $$NETNAME^ OCXSEND,": ",@LREF@( OCXFLD,OCX SUB) | |
| 23651 | "RTN","ORY 4271",164, 0) | |
| 23652 | ; | |
| 23653 | "RTN","ORY 4271",165, 0) | |
| 23654 | Q | |
| 23655 | "RTN","ORY 4271",166, 0) | |
| 23656 | ; | |
| 23657 | "RTN","ORY 4271",167, 0) | |
| 23658 | W !,?10 Q 0 Q $$PAU SE | |
| 23659 | "RTN","ORY 4271",168, 0) | |
| 23660 | ; | |
| 23661 | "RTN","ORY 4271",169, 0) | |
| 23662 | PAUSE() W " Press E nter " R X :DTIME W ! Q (X[U) | |
| 23663 | "RTN","ORY 4271",170, 0) | |
| 23664 | ; | |
| 23665 | "RTN","ORY 4271",171, 0) | |
| 23666 | NOW() N X, Y,%DT S X= "N",%DT="T " D ^%DT S Y=$$DATE^ OCXSENDD(Y ) S:(Y["@" ) Y=$P(Y," @",1)_" at "_$P(Y,"@ ",2) Q Y | |
| 23667 | "RTN","ORY 4271",172, 0) | |
| 23668 | ; | |
| 23669 | "RTN","ORY 4272") | |
| 23670 | 0^3^B26767 346 | |
| 23671 | "RTN","ORY 4272",1,0) | |
| 23672 | ORY4272 ;S LC/RJS,CLA - OCX PAC KAGE RULE TRANSPORT ROUTINE (D elete afte r Install of OR*3*42 7) ;MAR 7, 2017 at 15 :12 | |
| 23673 | "RTN","ORY 4272",2,0) | |
| 23674 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 23675 | "RTN","ORY 4272",3,0) | |
| 23676 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 23677 | "RTN","ORY 4272",4,0) | |
| 23678 | ; | |
| 23679 | "RTN","ORY 4272",5,0) | |
| 23680 | S ; | |
| 23681 | "RTN","ORY 4272",6,0) | |
| 23682 | ; Record Utilities | |
| 23683 | "RTN","ORY 4272",7,0) | |
| 23684 | Q | |
| 23685 | "RTN","ORY 4272",8,0) | |
| 23686 | ; | |
| 23687 | "RTN","ORY 4272",9,0) | |
| 23688 | ADDREC(OCX CREF) ; | |
| 23689 | "RTN","ORY 4272",10,0 ) | |
| 23690 | ; | |
| 23691 | "RTN","ORY 4272",11,0 ) | |
| 23692 | N QUIT,OC XDD,OCXDA, OCXGREF,OC XNAME | |
| 23693 | "RTN","ORY 4272",12,0 ) | |
| 23694 | S OCXDD=$ O(@OCXCREF @("")) Q:' OCXDD 0 | |
| 23695 | "RTN","ORY 4272",13,0 ) | |
| 23696 | S OCXNAME =$G(@OCXCR EF@(OCXDD, .01,"E")) | |
| 23697 | "RTN","ORY 4272",14,0 ) | |
| 23698 | ; | |
| 23699 | "RTN","ORY 4272",15,0 ) | |
| 23700 | W " rec ord missin g..." | |
| 23701 | "RTN","ORY 4272",16,0 ) | |
| 23702 | I (OCXFLA G["D") Q 0 | |
| 23703 | "RTN","ORY 4272",17,0 ) | |
| 23704 | ; | |
| 23705 | "RTN","ORY 4272",18,0 ) | |
| 23706 | S OCXDA=0 D CREATE( OCXCREF,OC XDD,.OCXDA ,0) | |
| 23707 | "RTN","ORY 4272",19,0 ) | |
| 23708 | S:$L(OCXN AME) ^TMP( "OCXRULE", $J,"A",+OC XDD,OCXNAM E)="" | |
| 23709 | "RTN","ORY 4272",20,0 ) | |
| 23710 | ; | |
| 23711 | "RTN","ORY 4272",21,0 ) | |
| 23712 | Q 0 | |
| 23713 | "RTN","ORY 4272",22,0 ) | |
| 23714 | ; | |
| 23715 | "RTN","ORY 4272",23,0 ) | |
| 23716 | CREATE(OCX CREF,OCXDD ,OCXDA,OCX LVL) ; | |
| 23717 | "RTN","ORY 4272",24,0 ) | |
| 23718 | ; | |
| 23719 | "RTN","ORY 4272",25,0 ) | |
| 23720 | N OCXFLD, OCXGREF,OC XKEY | |
| 23721 | "RTN","ORY 4272",26,0 ) | |
| 23722 | ; | |
| 23723 | "RTN","ORY 4272",27,0 ) | |
| 23724 | I $L(OCXD A),'(OCXDA =+OCXDA) W !!,"Unres olved subs cript." Q | |
| 23725 | "RTN","ORY 4272",28,0 ) | |
| 23726 | ; | |
| 23727 | "RTN","ORY 4272",29,0 ) | |
| 23728 | S OCXKEY= @OCXCREF@( OCXDD,.01, "E") | |
| 23729 | "RTN","ORY 4272",30,0 ) | |
| 23730 | S OCXGREF =$$GETREF( +OCXDD,.OC XDA,OCXLVL ) Q:'$L(OC XGREF) | |
| 23731 | "RTN","ORY 4272",31,0 ) | |
| 23732 | I 'OCXDA D | |
| 23733 | "RTN","ORY 4272",32,0 ) | |
| 23734 | .S OCXDA= $O(^TMP("O CXRULE",$J ,"B",+OCXD D,OCXKEY,0 )) Q:OCXDA | |
| 23735 | "RTN","ORY 4272",33,0 ) | |
| 23736 | .S OCXDA= $O(@(OCXGR EF_""" "") "),-1)+1 | |
| 23737 | "RTN","ORY 4272",34,0 ) | |
| 23738 | .F OCXDA= OCXDA:1 Q: '$D(@(OCXG REF_OCXDA_ ",0)")) | |
| 23739 | "RTN","ORY 4272",35,0 ) | |
| 23740 | .I $D(@(O CXGREF_OCX DA_",0)")) S OCXDA=0 | |
| 23741 | "RTN","ORY 4272",36,0 ) | |
| 23742 | ; | |
| 23743 | "RTN","ORY 4272",37,0 ) | |
| 23744 | I 'OCXDA W !!,"Erro r adding r ecord..." Q | |
| 23745 | "RTN","ORY 4272",38,0 ) | |
| 23746 | ; | |
| 23747 | "RTN","ORY 4272",39,0 ) | |
| 23748 | I '$D(@(O CXGREF_"0) ")) S @(OC XGREF_"0)" )=U_$$FILE HDR^OCXSEN DD(+OCXDD) _U_U | |
| 23749 | "RTN","ORY 4272",40,0 ) | |
| 23750 | ; | |
| 23751 | "RTN","ORY 4272",41,0 ) | |
| 23752 | S OCXFLD= 0 F S OCX FLD=$O(@OC XCREF@(OCX DD,OCXFLD) ) Q:'OCXFL D Q:(OCXF LD[":") I '$$EXFLD^ ORY4271(+O CXDD,OCXFL D) D | |
| 23753 | "RTN","ORY 4272",42,0 ) | |
| 23754 | .I $L($G( @OCXCREF@( OCXDD,OCXF LD,"E"))) D DIE(OCXD D,OCXGREF, OCXFLD,@OC XCREF@(OCX DD,OCXFLD, "E"),.OCXD A,OCXLVL) | |
| 23755 | "RTN","ORY 4272",43,0 ) | |
| 23756 | .I $O(@OC XCREF@(OCX DD,OCXFLD, 0)) D WORD (OCXDD,OCX GREF,OCXFL D,.OCXDA,O CXCREF) | |
| 23757 | "RTN","ORY 4272",44,0 ) | |
| 23758 | ; | |
| 23759 | "RTN","ORY 4272",45,0 ) | |
| 23760 | D PUSH(.O CXDA) | |
| 23761 | "RTN","ORY 4272",46,0 ) | |
| 23762 | S OCXFLD= "" F S OC XFLD=$O(@O CXCREF@(OC XDD,OCXFLD )) Q:'$L(O CXFLD) I (OCXFLD[": ") D | |
| 23763 | "RTN","ORY 4272",47,0 ) | |
| 23764 | .S OCXDA= $P(OCXFLD, ":",2) W ! D CREATE( $$APPEND(O CXCREF,OCX DD),OCXFLD ,.OCXDA,OC XLVL+1) | |
| 23765 | "RTN","ORY 4272",48,0 ) | |
| 23766 | D POP(.OC XDA) | |
| 23767 | "RTN","ORY 4272",49,0 ) | |
| 23768 | Q | |
| 23769 | "RTN","ORY 4272",50,0 ) | |
| 23770 | ; | |
| 23771 | "RTN","ORY 4272",51,0 ) | |
| 23772 | LOADWORD(R REF,OCXDD, OCXFLD,OCX SUB) ; | |
| 23773 | "RTN","ORY 4272",52,0 ) | |
| 23774 | ; | |
| 23775 | "RTN","ORY 4272",53,0 ) | |
| 23776 | N QUIT,DD PATH,INDEX ,OCXDA,OCX GREF | |
| 23777 | "RTN","ORY 4272",54,0 ) | |
| 23778 | S DDPATH= $P($P($$AP PEND(RREF, OCXDD),"(" ,2),")",1) | |
| 23779 | "RTN","ORY 4272",55,0 ) | |
| 23780 | F INDEX=1 :1:$L(DDPA TH,",") S OCXDA($L(D DPATH,",") -INDEX)=+$ P($P(DDPAT H,",",INDE X),":",2) | |
| 23781 | "RTN","ORY 4272",56,0 ) | |
| 23782 | S OCXDA=$ G(OCXDA(0) ) K OCXDA( 0) | |
| 23783 | "RTN","ORY 4272",57,0 ) | |
| 23784 | Q:(OCXFLA G["D") 0 | |
| 23785 | "RTN","ORY 4272",58,0 ) | |
| 23786 | I (OCXFLA G["A") S Q UIT=$$READ ("Y"," Do you want t o reload t he local ' "_$$FIELD^ OCXSENDD(+ OCXDD,+OCX FLD,"LABEL ")_"' fiel d ?","YES" ) Q:'QUIT (QUIT[U) | |
| 23787 | "RTN","ORY 4272",59,0 ) | |
| 23788 | S OCXGREF =$$GETREF( +OCXDD,.OC XDA,$L(DDP ATH,",")-1 ) Q:'$L(OC XGREF) | |
| 23789 | "RTN","ORY 4272",60,0 ) | |
| 23790 | D WORD(OC XDD,OCXGRE F,OCXFLD,. OCXDA,RREF ) | |
| 23791 | "RTN","ORY 4272",61,0 ) | |
| 23792 | Q 0 | |
| 23793 | "RTN","ORY 4272",62,0 ) | |
| 23794 | ; | |
| 23795 | "RTN","ORY 4272",63,0 ) | |
| 23796 | GETREF(OCX DD,OCXDA,O CXLVL) ; | |
| 23797 | "RTN","ORY 4272",64,0 ) | |
| 23798 | ; | |
| 23799 | "RTN","ORY 4272",65,0 ) | |
| 23800 | Q:'OCXDD "" | |
| 23801 | "RTN","ORY 4272",66,0 ) | |
| 23802 | ; | |
| 23803 | "RTN","ORY 4272",67,0 ) | |
| 23804 | N OCXIENS ,OCXERR,OC XX | |
| 23805 | "RTN","ORY 4272",68,0 ) | |
| 23806 | S OCXIENS =$$IENS^DI LF(.OCXDA) ,OCXERR="" | |
| 23807 | "RTN","ORY 4272",69,0 ) | |
| 23808 | S OCXX=$$ ROOT^DILFD (OCXDD,OCX IENS,0,OCX ERR) | |
| 23809 | "RTN","ORY 4272",70,0 ) | |
| 23810 | Q OCXX | |
| 23811 | "RTN","ORY 4272",71,0 ) | |
| 23812 | ; | |
| 23813 | "RTN","ORY 4272",72,0 ) | |
| 23814 | WORD(DD,GR EF,FLD,DA, RREF) ; | |
| 23815 | "RTN","ORY 4272",73,0 ) | |
| 23816 | ; | |
| 23817 | "RTN","ORY 4272",74,0 ) | |
| 23818 | N SUB,GLR OOT,LINE | |
| 23819 | "RTN","ORY 4272",75,0 ) | |
| 23820 | S SUB=$P( $$FIELD^OC XSENDD(+DD ,FLD,"GLOB AL SUBSCRI PT LOCATIO N"),";",1) S:'(SUB=+ SUB) SUB=" """_SUB_"" "" | |
| 23821 | "RTN","ORY 4272",76,0 ) | |
| 23822 | S GLROOT= GREF_DA_", "_SUB_")" K @GLROOT | |
| 23823 | "RTN","ORY 4272",77,0 ) | |
| 23824 | S LINE=0 F S LINE= $O(@RREF@( DD,FLD,LIN E)) Q:'LIN E D | |
| 23825 | "RTN","ORY 4272",78,0 ) | |
| 23826 | .S @GLROO T@($O(@GLR OOT@(""),- 1)+1,0)=@R REF@(DD,FL D,LINE) | |
| 23827 | "RTN","ORY 4272",79,0 ) | |
| 23828 | S LINE=$O (@GLROOT@( ""),-1),@G LROOT@(0)= U_U_LINE_U _LINE_U_$$ DATE("T")_ U | |
| 23829 | "RTN","ORY 4272",80,0 ) | |
| 23830 | ; | |
| 23831 | "RTN","ORY 4272",81,0 ) | |
| 23832 | Q | |
| 23833 | "RTN","ORY 4272",82,0 ) | |
| 23834 | ; | |
| 23835 | "RTN","ORY 4272",83,0 ) | |
| 23836 | DATE(X) N %DT,Y S %D T="" D ^%D T Q +Y | |
| 23837 | "RTN","ORY 4272",84,0 ) | |
| 23838 | ; | |
| 23839 | "RTN","ORY 4272",85,0 ) | |
| 23840 | DIE(OCXDD, OCXDIC,OCX FLD,OCXVAL ,OCXDA,OCX LVL) ; | |
| 23841 | "RTN","ORY 4272",86,0 ) | |
| 23842 | ; | |
| 23843 | "RTN","ORY 4272",87,0 ) | |
| 23844 | N DIC,DIE ,X,Y,DR,DA ,OCXDVAL,O CXPTR,OCXG REF,D0,OCX SCR | |
| 23845 | "RTN","ORY 4272",88,0 ) | |
| 23846 | S (D0,DA) =OCXDA,(DI C,DIE)=OCX DIC,DR="" | |
| 23847 | "RTN","ORY 4272",89,0 ) | |
| 23848 | S:OCXLVL D0=OCXDA(1 ),DR="S DA (1)="_(+D0 )_",D0="_( +D0)_";" | |
| 23849 | "RTN","ORY 4272",90,0 ) | |
| 23850 | S:OCXVAL= "?" OCXVAL ="? " S DR =DR_OCXFLD _"///^S X= OCXVAL" | |
| 23851 | "RTN","ORY 4272",91,0 ) | |
| 23852 | I '(OCXVA L="@") W ! ,?(OCXLVL* 5),$$FIELD ^OCXSENDD( +OCXDD,OCX FLD,"LABEL "),": ",OC XVAL | |
| 23853 | "RTN","ORY 4272",92,0 ) | |
| 23854 | ; | |
| 23855 | "RTN","ORY 4272",93,0 ) | |
| 23856 | I '(OCXVA L="@") D | |
| 23857 | "RTN","ORY 4272",94,0 ) | |
| 23858 | .N OCXIEN ,SHORT | |
| 23859 | "RTN","ORY 4272",95,0 ) | |
| 23860 | .S OCXPTR =+$P($$FIE LD^OCXSEND D(+OCXDD,O CXFLD,"SPE CIFIER")," P",2) | |
| 23861 | "RTN","ORY 4272",96,0 ) | |
| 23862 | .Q:'OCXPT R | |
| 23863 | "RTN","ORY 4272",97,0 ) | |
| 23864 | .S OCXGRE F="^"_$$FI ELD^OCXSEN DD(+OCXDD, OCXFLD,"PO INTER") | |
| 23865 | "RTN","ORY 4272",98,0 ) | |
| 23866 | .I '($E(O CXGREF,1,4 )="^OCX"), '(OCXGREF= "^ORD(100. 9,"),'(OCX GREF="^ORD (100.8,") Q | |
| 23867 | "RTN","ORY 4272",99,0 ) | |
| 23868 | .Q:$$DIC( OCXGREF,OC XVAL,0) | |
| 23869 | "RTN","ORY 4272",100, 0) | |
| 23870 | .S OCXIEN =$$DIC(OCX GREF,OCXVA L,1) | |
| 23871 | "RTN","ORY 4272",101, 0) | |
| 23872 | .S ^TMP(" OCXRULE",$ J,"B",OCXP TR,OCXVAL, OCXIEN)="" | |
| 23873 | "RTN","ORY 4272",102, 0) | |
| 23874 | ; | |
| 23875 | "RTN","ORY 4272",103, 0) | |
| 23876 | S OCXSCR= 1 | |
| 23877 | "RTN","ORY 4272",104, 0) | |
| 23878 | D ^DIE | |
| 23879 | "RTN","ORY 4272",105, 0) | |
| 23880 | ; | |
| 23881 | "RTN","ORY 4272",106, 0) | |
| 23882 | ; I $D(Y) -> DIE FI LER ERROR | |
| 23883 | "RTN","ORY 4272",107, 0) | |
| 23884 | I $D(Y) W " ^DIE filer data error..." S OCXDIER =$G(OCXDIE R)+1 | |
| 23885 | "RTN","ORY 4272",108, 0) | |
| 23886 | I '$D(Y) W " ... Correct da ta Filed" | |
| 23887 | "RTN","ORY 4272",109, 0) | |
| 23888 | ; | |
| 23889 | "RTN","ORY 4272",110, 0) | |
| 23890 | Q | |
| 23891 | "RTN","ORY 4272",111, 0) | |
| 23892 | ; | |
| 23893 | "RTN","ORY 4272",112, 0) | |
| 23894 | DIC(DIC,X, OCXADD) N OCXSCR S D IC(0)="",O CXSCR=1 S: OCXADD DIC (0)="L" D ^DIC Q:(+Y >0) +Y Q 0 | |
| 23895 | "RTN","ORY 4272",113, 0) | |
| 23896 | ; | |
| 23897 | "RTN","ORY 4272",114, 0) | |
| 23898 | PUSH(OCXDA ) ; | |
| 23899 | "RTN","ORY 4272",115, 0) | |
| 23900 | N OCXSUB S OCXSUB=" " F S OCX SUB=$O(OCX DA(OCXSUB) ,-1) Q:'OC XSUB S OC XDA(OCXSUB +1)=OCXDA( OCXSUB) | |
| 23901 | "RTN","ORY 4272",116, 0) | |
| 23902 | S OCXDA(1 )=OCXDA,OC XDA=0 | |
| 23903 | "RTN","ORY 4272",117, 0) | |
| 23904 | Q | |
| 23905 | "RTN","ORY 4272",118, 0) | |
| 23906 | ; | |
| 23907 | "RTN","ORY 4272",119, 0) | |
| 23908 | POP(OCXDA) ; | |
| 23909 | "RTN","ORY 4272",120, 0) | |
| 23910 | N OCXSUB S OCXSUB=" " F S OCX SUB=$O(OCX DA(OCXSUB) ) Q:'OCXSU B S OCXDA (OCXSUB)=$ G(OCXDA(OC XSUB+1)) | |
| 23911 | "RTN","ORY 4272",121, 0) | |
| 23912 | S OCXDA=O CXDA(1) K OCXDA($O(O CXDA(""),- 1)) | |
| 23913 | "RTN","ORY 4272",122, 0) | |
| 23914 | Q | |
| 23915 | "RTN","ORY 4272",123, 0) | |
| 23916 | ; | |
| 23917 | "RTN","ORY 4272",124, 0) | |
| 23918 | APPEND(ARR AY,OCXSUB) ; | |
| 23919 | "RTN","ORY 4272",125, 0) | |
| 23920 | S:'(OCXSU B=+OCXSUB) OCXSUB="" ""_OCXSUB_ """" | |
| 23921 | "RTN","ORY 4272",126, 0) | |
| 23922 | Q:'(ARRAY ["(") ARRA Y_"("_OCXS UB_")" | |
| 23923 | "RTN","ORY 4272",127, 0) | |
| 23924 | Q $E(ARRA Y,1,$L(ARR AY)-1)_"," _OCXSUB_") " | |
| 23925 | "RTN","ORY 4272",128, 0) | |
| 23926 | ; | |
| 23927 | "RTN","ORY 4272",129, 0) | |
| 23928 | READ(OCXZ0 ,OCXZA,OCX ZB,OCXZL) ; | |
| 23929 | "RTN","ORY 4272",130, 0) | |
| 23930 | N OCXLINE ,DIR,DTOUT ,DUOUT,DIR UT,DIROUT | |
| 23931 | "RTN","ORY 4272",131, 0) | |
| 23932 | Q:'$L($G( OCXZ0)) U | |
| 23933 | "RTN","ORY 4272",132, 0) | |
| 23934 | S DIR(0)= OCXZ0 | |
| 23935 | "RTN","ORY 4272",133, 0) | |
| 23936 | S:$L($G(O CXZA)) DIR ("A")=OCXZ A | |
| 23937 | "RTN","ORY 4272",134, 0) | |
| 23938 | S:$L($G(O CXZB)) DIR ("B")=OCXZ B | |
| 23939 | "RTN","ORY 4272",135, 0) | |
| 23940 | F OCXLINE =1:1:($G(O CXZL)-1) W ! | |
| 23941 | "RTN","ORY 4272",136, 0) | |
| 23942 | D ^DIR | |
| 23943 | "RTN","ORY 4272",137, 0) | |
| 23944 | I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q U | |
| 23945 | "RTN","ORY 4272",138, 0) | |
| 23946 | Q Y | |
| 23947 | "RTN","ORY 4272",139, 0) | |
| 23948 | ; | |
| 23949 | "RTN","ORY 4272",140, 0) | |
| 23950 | PAUSE() W " Press E nter " R X :DTIME W ! Q (X[U) | |
| 23951 | "RTN","ORY 4272",141, 0) | |
| 23952 | ; | |
| 23953 | "RTN","ORY 4273") | |
| 23954 | 0^4^B12998 366 | |
| 23955 | "RTN","ORY 4273",1,0) | |
| 23956 | ORY4273 ;S LC/RJS,CLA - OCX PAC KAGE RULE TRANSPORT ROUTINE (D elete afte r Install of OR*3*42 7) ;MAR 7, 2017 at 15 :12 | |
| 23957 | "RTN","ORY 4273",2,0) | |
| 23958 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 23959 | "RTN","ORY 4273",3,0) | |
| 23960 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 23961 | "RTN","ORY 4273",4,0) | |
| 23962 | ; | |
| 23963 | "RTN","ORY 4273",5,0) | |
| 23964 | S ; | |
| 23965 | "RTN","ORY 4273",6,0) | |
| 23966 | ; Multip le Utiliti es | |
| 23967 | "RTN","ORY 4273",7,0) | |
| 23968 | Q | |
| 23969 | "RTN","ORY 4273",8,0) | |
| 23970 | ; | |
| 23971 | "RTN","ORY 4273",9,0) | |
| 23972 | ADDMULT(OC XCREF,OCXD D,OCXFLD) ; | |
| 23973 | "RTN","ORY 4273",10,0 ) | |
| 23974 | ; | |
| 23975 | "RTN","ORY 4273",11,0 ) | |
| 23976 | ; | |
| 23977 | "RTN","ORY 4273",12,0 ) | |
| 23978 | N QUIT,OC XDA,OCXGRE F,OCXNAME, DDPATH,IND EX | |
| 23979 | "RTN","ORY 4273",13,0 ) | |
| 23980 | ; | |
| 23981 | "RTN","ORY 4273",14,0 ) | |
| 23982 | S DDPATH= $P($P($$AP PEND($$APP END(OCXCRE F,OCXDD),O CXFLD),"(" ,2),")",1) | |
| 23983 | "RTN","ORY 4273",15,0 ) | |
| 23984 | F INDEX=1 :1:$L(DDPA TH,",") S OCXDA($L(D DPATH,",") -INDEX)=+$ P($P(DDPAT H,",",INDE X),":",2) | |
| 23985 | "RTN","ORY 4273",16,0 ) | |
| 23986 | S OCXDA=$ G(OCXDA(0) ) K OCXDA( 0) | |
| 23987 | "RTN","ORY 4273",17,0 ) | |
| 23988 | ; | |
| 23989 | "RTN","ORY 4273",18,0 ) | |
| 23990 | Q:(OCXFLA G["D") 0 | |
| 23991 | "RTN","ORY 4273",19,0 ) | |
| 23992 | I (OCXFLA G["A") S Q UIT=$$READ ("Y"," Do you want t o add a lo cal '"_$$F ILENAME^OC XSENDD(+OC XFLD)_"' m ultiple ?" ,"YES") Q: 'QUIT (QUI T[U) | |
| 23993 | "RTN","ORY 4273",20,0 ) | |
| 23994 | ; | |
| 23995 | "RTN","ORY 4273",21,0 ) | |
| 23996 | S OCXGREF =$$GETREF^ ORY4272(+O CXFLD,.OCX DA,1) | |
| 23997 | "RTN","ORY 4273",22,0 ) | |
| 23998 | D CREATE( $$APPEND(O CXCREF,OCX DD),OCXFLD ,.OCXDA,1) | |
| 23999 | "RTN","ORY 4273",23,0 ) | |
| 24000 | ; | |
| 24001 | "RTN","ORY 4273",24,0 ) | |
| 24002 | Q 0 | |
| 24003 | "RTN","ORY 4273",25,0 ) | |
| 24004 | ; | |
| 24005 | "RTN","ORY 4273",26,0 ) | |
| 24006 | DELMULT(OC XCREF,OCXD D) ; | |
| 24007 | "RTN","ORY 4273",27,0 ) | |
| 24008 | ; | |
| 24009 | "RTN","ORY 4273",28,0 ) | |
| 24010 | N QUIT,OC XGREF,DA,I NDEX,DDPAT H | |
| 24011 | "RTN","ORY 4273",29,0 ) | |
| 24012 | ; | |
| 24013 | "RTN","ORY 4273",30,0 ) | |
| 24014 | Q:(OCXFLA G["D") 0 | |
| 24015 | "RTN","ORY 4273",31,0 ) | |
| 24016 | I (OCXFLA G["A") S Q UIT=$$READ ("Y"," Do you want t o delete t he local ' "_$$FILENA ME^OCXSEND D(+OCXDD)_ "' multipl e ?","YES" ) Q:'QUIT (QUIT[U) | |
| 24017 | "RTN","ORY 4273",32,0 ) | |
| 24018 | ; | |
| 24019 | "RTN","ORY 4273",33,0 ) | |
| 24020 | S DDPATH= $P($P($$AP PEND(OCXCR EF,OCXDD), "(",2),")" ,1) | |
| 24021 | "RTN","ORY 4273",34,0 ) | |
| 24022 | F INDEX=1 :1:$L(DDPA TH,",") S DA($L(DDPA TH,",")-IN DEX)=+$P($ P(DDPATH," ,",INDEX), ":",2) | |
| 24023 | "RTN","ORY 4273",35,0 ) | |
| 24024 | S DA=$G(D A(0)) K DA (0) | |
| 24025 | "RTN","ORY 4273",36,0 ) | |
| 24026 | S OCXGREF =$$GETREF^ ORY4272(+O CXDD,.DA,1 ) | |
| 24027 | "RTN","ORY 4273",37,0 ) | |
| 24028 | ; | |
| 24029 | "RTN","ORY 4273",38,0 ) | |
| 24030 | D DIE^ORY 4272(+OCXD D,OCXGREF, .01,"@",.D A,$L(DDPAT H,",")-1) | |
| 24031 | "RTN","ORY 4273",39,0 ) | |
| 24032 | K @OCXCRE F@(OCXDD) W !!," de leted..." | |
| 24033 | "RTN","ORY 4273",40,0 ) | |
| 24034 | ; | |
| 24035 | "RTN","ORY 4273",41,0 ) | |
| 24036 | Q 0 | |
| 24037 | "RTN","ORY 4273",42,0 ) | |
| 24038 | ; | |
| 24039 | "RTN","ORY 4273",43,0 ) | |
| 24040 | CREATE(OCX CREF,OCXDD ,OCXDA,OCX LVL) ; | |
| 24041 | "RTN","ORY 4273",44,0 ) | |
| 24042 | ; | |
| 24043 | "RTN","ORY 4273",45,0 ) | |
| 24044 | N OCXFLD, OCXGREF | |
| 24045 | "RTN","ORY 4273",46,0 ) | |
| 24046 | ; | |
| 24047 | "RTN","ORY 4273",47,0 ) | |
| 24048 | S OCXGREF =$$GETREF^ ORY4272(+O CXDD,.OCXD A,OCXLVL) Q:'$L(OCXG REF) S:'O CXDA OCXDA =$O(@(OCXG REF_"""@"" )"),-1)+1 | |
| 24049 | "RTN","ORY 4273",48,0 ) | |
| 24050 | ; | |
| 24051 | "RTN","ORY 4273",49,0 ) | |
| 24052 | I '$D(@(O CXGREF_"0) ")) S @(OC XGREF_"0)" )=U_$$FILE HDR^OCXSEN DD(+OCXDD) _U_U | |
| 24053 | "RTN","ORY 4273",50,0 ) | |
| 24054 | ; | |
| 24055 | "RTN","ORY 4273",51,0 ) | |
| 24056 | S OCXFLD= 0 F S OCX FLD=$O(@OC XCREF@(OCX DD,OCXFLD) ) Q:'OCXFL D Q:(OCXF LD[":") I '$$EXFLD^ ORY4271(+O CXDD,OCXFL D) D | |
| 24057 | "RTN","ORY 4273",52,0 ) | |
| 24058 | .I $L($G( @OCXCREF@( OCXDD,OCXF LD,"E"))) D DIE^ORY4 272(OCXDD, OCXGREF,OC XFLD,@OCXC REF@(OCXDD ,OCXFLD,"E "),.OCXDA, OCXLVL) | |
| 24059 | "RTN","ORY 4273",53,0 ) | |
| 24060 | ; | |
| 24061 | "RTN","ORY 4273",54,0 ) | |
| 24062 | D PUSH(.O CXDA) | |
| 24063 | "RTN","ORY 4273",55,0 ) | |
| 24064 | S OCXFLD= "" F S OC XFLD=$O(@O CXCREF@(OC XDD,OCXFLD )) Q:'$L(O CXFLD) I (OCXFLD[": ") D | |
| 24065 | "RTN","ORY 4273",56,0 ) | |
| 24066 | .S OCXDA= $P(OCXFLD, ":",2) W ! D CREATE( $$APPEND(O CXCREF,OCX DD),OCXFLD ,.OCXDA,OC XLVL+1) | |
| 24067 | "RTN","ORY 4273",57,0 ) | |
| 24068 | D POP(.OC XDA) | |
| 24069 | "RTN","ORY 4273",58,0 ) | |
| 24070 | Q | |
| 24071 | "RTN","ORY 4273",59,0 ) | |
| 24072 | ; | |
| 24073 | "RTN","ORY 4273",60,0 ) | |
| 24074 | PUSH(OCXDA ) ; | |
| 24075 | "RTN","ORY 4273",61,0 ) | |
| 24076 | N OCXSUB S OCXSUB=" " F S OCX SUB=$O(OCX DA(OCXSUB) ,-1) Q:'OC XSUB S OC XDA(OCXSUB +1)=OCXDA( OCXSUB) | |
| 24077 | "RTN","ORY 4273",62,0 ) | |
| 24078 | S OCXDA(1 )=OCXDA,OC XDA=0 | |
| 24079 | "RTN","ORY 4273",63,0 ) | |
| 24080 | Q | |
| 24081 | "RTN","ORY 4273",64,0 ) | |
| 24082 | ; | |
| 24083 | "RTN","ORY 4273",65,0 ) | |
| 24084 | POP(OCXDA) ; | |
| 24085 | "RTN","ORY 4273",66,0 ) | |
| 24086 | N OCXSUB S OCXSUB=" " F S OCX SUB=$O(OCX DA(OCXSUB) ) Q:'OCXSU B S OCXDA (OCXSUB)=$ G(OCXDA(OC XSUB+1)) | |
| 24087 | "RTN","ORY 4273",67,0 ) | |
| 24088 | S OCXDA=O CXDA(1) K OCXDA($O(O CXDA(""),- 1)) | |
| 24089 | "RTN","ORY 4273",68,0 ) | |
| 24090 | Q | |
| 24091 | "RTN","ORY 4273",69,0 ) | |
| 24092 | ; | |
| 24093 | "RTN","ORY 4273",70,0 ) | |
| 24094 | APPEND(ARR AY,OCXSUB) ; | |
| 24095 | "RTN","ORY 4273",71,0 ) | |
| 24096 | S:'(OCXSU B=+OCXSUB) OCXSUB="" ""_OCXSUB_ """" | |
| 24097 | "RTN","ORY 4273",72,0 ) | |
| 24098 | Q:'(ARRAY ["(") ARRA Y_"("_OCXS UB_")" | |
| 24099 | "RTN","ORY 4273",73,0 ) | |
| 24100 | Q $E(ARRA Y,1,$L(ARR AY)-1)_"," _OCXSUB_") " | |
| 24101 | "RTN","ORY 4273",74,0 ) | |
| 24102 | ; | |
| 24103 | "RTN","ORY 4273",75,0 ) | |
| 24104 | READ(OCXZ0 ,OCXZA,OCX ZB,OCXZL) ; | |
| 24105 | "RTN","ORY 4273",76,0 ) | |
| 24106 | N OCXLINE ,DIR,DTOUT ,DUOUT,DIR UT,DIROUT | |
| 24107 | "RTN","ORY 4273",77,0 ) | |
| 24108 | Q:'$L($G( OCXZ0)) U | |
| 24109 | "RTN","ORY 4273",78,0 ) | |
| 24110 | S DIR(0)= OCXZ0 | |
| 24111 | "RTN","ORY 4273",79,0 ) | |
| 24112 | S:$L($G(O CXZA)) DIR ("A")=OCXZ A | |
| 24113 | "RTN","ORY 4273",80,0 ) | |
| 24114 | S:$L($G(O CXZB)) DIR ("B")=OCXZ B | |
| 24115 | "RTN","ORY 4273",81,0 ) | |
| 24116 | F OCXLINE =1:1:($G(O CXZL)-1) W ! | |
| 24117 | "RTN","ORY 4273",82,0 ) | |
| 24118 | D ^DIR | |
| 24119 | "RTN","ORY 4273",83,0 ) | |
| 24120 | I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q U | |
| 24121 | "RTN","ORY 4273",84,0 ) | |
| 24122 | Q Y | |
| 24123 | "RTN","ORY 4273",85,0 ) | |
| 24124 | ; | |
| 24125 | "RTN","ORY 4273",86,0 ) | |
| 24126 | PAUSE() W " Press E nter " R X :DTIME W ! Q (X[U) | |
| 24127 | "RTN","ORY 4273",87,0 ) | |
| 24128 | ; | |
| 24129 | "RTN","ORY 4274") | |
| 24130 | 0^5^B13528 386 | |
| 24131 | "RTN","ORY 4274",1,0) | |
| 24132 | ORY4274 ;S LC/RJS,CLA - OCX PAC KAGE RULE TRANSPORT ROUTINE (D elete afte r Install of OR*3*42 7) ;MAR 7, 2017 at 15 :12 | |
| 24133 | "RTN","ORY 4274",2,0) | |
| 24134 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 24135 | "RTN","ORY 4274",3,0) | |
| 24136 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 24137 | "RTN","ORY 4274",4,0) | |
| 24138 | ; | |
| 24139 | "RTN","ORY 4274",5,0) | |
| 24140 | S ; | |
| 24141 | "RTN","ORY 4274",6,0) | |
| 24142 | ; Field Utilities | |
| 24143 | "RTN","ORY 4274",7,0) | |
| 24144 | Q | |
| 24145 | "RTN","ORY 4274",8,0) | |
| 24146 | ; | |
| 24147 | "RTN","ORY 4274",9,0) | |
| 24148 | EDITFLD(OC XCREF,OCXD D,OCXFLD,O CXSUB) ; | |
| 24149 | "RTN","ORY 4274",10,0 ) | |
| 24150 | ; | |
| 24151 | "RTN","ORY 4274",11,0 ) | |
| 24152 | N DDPATH, OCXDA,OCXP C,OCXLVL,Q UIT | |
| 24153 | "RTN","ORY 4274",12,0 ) | |
| 24154 | ; | |
| 24155 | "RTN","ORY 4274",13,0 ) | |
| 24156 | S QUIT=0, DDPATH=$P( $P($$APPEN D(OCXCREF, OCXDD),"(" ,2),")",1) | |
| 24157 | "RTN","ORY 4274",14,0 ) | |
| 24158 | S OCXLVL= $L(DDPATH, ",") | |
| 24159 | "RTN","ORY 4274",15,0 ) | |
| 24160 | F OCXPC=1 :1:OCXLVL S OCXDA(OC XLVL-OCXPC )=+$P($P(D DPATH,",", OCXPC),":" ,2) | |
| 24161 | "RTN","ORY 4274",16,0 ) | |
| 24162 | S OCXDA=O CXDA(0) K OCXDA(0) | |
| 24163 | "RTN","ORY 4274",17,0 ) | |
| 24164 | I $L($G(@ OCXCREF@(O CXDD,OCXFL D,"E"))) D | |
| 24165 | "RTN","ORY 4274",18,0 ) | |
| 24166 | .N RESP | |
| 24167 | "RTN","ORY 4274",19,0 ) | |
| 24168 | .Q:(OCXFL AG["D") | |
| 24169 | "RTN","ORY 4274",20,0 ) | |
| 24170 | .I (OCXFL AG["A") S RESP=$$REA D("Y"," Do you want to change the local '"_$$FILEN AME^OCXSEN DD(+OCXDD) _"' field ?","YES") I 'RESP S QUIT=(RESP [U) Q | |
| 24171 | "RTN","ORY 4274",21,0 ) | |
| 24172 | .S OCXGRE F=$$GETREF ^ORY4272(+ OCXDD,.OCX DA,OCXLVL- 1) Q:'$L(O CXGREF) | |
| 24173 | "RTN","ORY 4274",22,0 ) | |
| 24174 | .D DIE^OR Y4272(OCXD D,OCXGREF, OCXFLD,@OC XCREF@(OCX DD,OCXFLD, "E"),.OCXD A,OCXLVL-1 ) | |
| 24175 | "RTN","ORY 4274",23,0 ) | |
| 24176 | ; | |
| 24177 | "RTN","ORY 4274",24,0 ) | |
| 24178 | Q QUIT | |
| 24179 | "RTN","ORY 4274",25,0 ) | |
| 24180 | ; | |
| 24181 | "RTN","ORY 4274",26,0 ) | |
| 24182 | DELFLD(OCX CREF,OCXDD ,OCXFLD,OC XSUB) ; | |
| 24183 | "RTN","ORY 4274",27,0 ) | |
| 24184 | ; | |
| 24185 | "RTN","ORY 4274",28,0 ) | |
| 24186 | N DDPATH, OCXDA,OCXP C,OCXLVL,Q UIT,RESP | |
| 24187 | "RTN","ORY 4274",29,0 ) | |
| 24188 | ; | |
| 24189 | "RTN","ORY 4274",30,0 ) | |
| 24190 | S QUIT=0, DDPATH=$P( $P($$APPEN D(OCXCREF, OCXDD),"(" ,2),")",1) | |
| 24191 | "RTN","ORY 4274",31,0 ) | |
| 24192 | S OCXLVL= $L(DDPATH, ",") | |
| 24193 | "RTN","ORY 4274",32,0 ) | |
| 24194 | F OCXPC=1 :1:OCXLVL S OCXDA(OC XLVL-OCXPC )=+$P($P(D DPATH,",", OCXPC),":" ,2) | |
| 24195 | "RTN","ORY 4274",33,0 ) | |
| 24196 | S OCXDA=O CXDA(0) K OCXDA(0) | |
| 24197 | "RTN","ORY 4274",34,0 ) | |
| 24198 | Q:(OCXFLA G["D") 0 | |
| 24199 | "RTN","ORY 4274",35,0 ) | |
| 24200 | I (OCXFLA G["A") S R ESP=$$READ ("Y"," Do you want t o Delete t he local ' "_$$FILENA ME^OCXSEND D(+OCXDD)_ "' value ? ","YES") I 'RESP S Q UIT=(RESP[ U) Q QUIT | |
| 24201 | "RTN","ORY 4274",36,0 ) | |
| 24202 | S OCXGREF =$$GETREF^ ORY4272(+O CXDD,.OCXD A,OCXLVL-1 ) Q:'$L(OC XGREF) | |
| 24203 | "RTN","ORY 4274",37,0 ) | |
| 24204 | D DIE^ORY 4272(OCXDD ,OCXGREF,O CXFLD,"@", .OCXDA,OCX LVL-1) | |
| 24205 | "RTN","ORY 4274",38,0 ) | |
| 24206 | ; | |
| 24207 | "RTN","ORY 4274",39,0 ) | |
| 24208 | Q QUIT | |
| 24209 | "RTN","ORY 4274",40,0 ) | |
| 24210 | ; | |
| 24211 | "RTN","ORY 4274",41,0 ) | |
| 24212 | CREATE(OCX CREF,OCXDD ,OCXDA,OCX LVL) ; | |
| 24213 | "RTN","ORY 4274",42,0 ) | |
| 24214 | ; | |
| 24215 | "RTN","ORY 4274",43,0 ) | |
| 24216 | N OCXFLD, OCXGREF | |
| 24217 | "RTN","ORY 4274",44,0 ) | |
| 24218 | ; | |
| 24219 | "RTN","ORY 4274",45,0 ) | |
| 24220 | S OCXGREF =$$GETREF^ ORY4272(+O CXDD,.OCXD A,OCXLVL) Q:'$L(OCXG REF) S:'O CXDA OCXDA =$O(@(OCXG REF_"""@"" )"),-1)+1 | |
| 24221 | "RTN","ORY 4274",46,0 ) | |
| 24222 | ; | |
| 24223 | "RTN","ORY 4274",47,0 ) | |
| 24224 | I '$D(@(O CXGREF_"0) ")) S @(OC XGREF_"0)" )=U_$$FILE HDR^OCXSEN DD(+OCXDD) _U_U | |
| 24225 | "RTN","ORY 4274",48,0 ) | |
| 24226 | ; | |
| 24227 | "RTN","ORY 4274",49,0 ) | |
| 24228 | S OCXFLD= 0 F S OCX FLD=$O(@OC XCREF@(OCX DD,OCXFLD) ) Q:'OCXFL D Q:(OCXF LD[":") I '$$EXFLD^ ORY4271(+O CXDD,OCXFL D) D | |
| 24229 | "RTN","ORY 4274",50,0 ) | |
| 24230 | .I $L($G( @OCXCREF@( OCXDD,OCXF LD,"E"))) D DIE^ORY4 272(OCXDD, OCXGREF,OC XFLD,@OCXC REF@(OCXDD ,OCXFLD,"E "),.OCXDA, OCXLVL) | |
| 24231 | "RTN","ORY 4274",51,0 ) | |
| 24232 | ; | |
| 24233 | "RTN","ORY 4274",52,0 ) | |
| 24234 | D PUSH(.O CXDA) | |
| 24235 | "RTN","ORY 4274",53,0 ) | |
| 24236 | S OCXFLD= "" F S OC XFLD=$O(@O CXCREF@(OC XDD,OCXFLD )) Q:'$L(O CXFLD) I (OCXFLD[": ") D | |
| 24237 | "RTN","ORY 4274",54,0 ) | |
| 24238 | .S OCXDA= $P(OCXFLD, ":",2) W ! D CREATE( $$APPEND(O CXCREF,OCX DD),OCXFLD ,.OCXDA,OC XLVL+1) | |
| 24239 | "RTN","ORY 4274",55,0 ) | |
| 24240 | D POP(.OC XDA) | |
| 24241 | "RTN","ORY 4274",56,0 ) | |
| 24242 | Q | |
| 24243 | "RTN","ORY 4274",57,0 ) | |
| 24244 | ; | |
| 24245 | "RTN","ORY 4274",58,0 ) | |
| 24246 | PUSH(OCXDA ) ; | |
| 24247 | "RTN","ORY 4274",59,0 ) | |
| 24248 | N OCXSUB S OCXSUB=" " F S OCX SUB=$O(OCX DA(OCXSUB) ,-1) Q:'OC XSUB S OC XDA(OCXSUB +1)=OCXDA( OCXSUB) | |
| 24249 | "RTN","ORY 4274",60,0 ) | |
| 24250 | S OCXDA(1 )=OCXDA,OC XDA=0 | |
| 24251 | "RTN","ORY 4274",61,0 ) | |
| 24252 | Q | |
| 24253 | "RTN","ORY 4274",62,0 ) | |
| 24254 | ; | |
| 24255 | "RTN","ORY 4274",63,0 ) | |
| 24256 | POP(OCXDA) ; | |
| 24257 | "RTN","ORY 4274",64,0 ) | |
| 24258 | N OCXSUB S OCXSUB=" " F S OCX SUB=$O(OCX DA(OCXSUB) ) Q:'OCXSU B S OCXDA (OCXSUB)=$ G(OCXDA(OC XSUB+1)) | |
| 24259 | "RTN","ORY 4274",65,0 ) | |
| 24260 | S OCXDA=O CXDA(1) K OCXDA($O(O CXDA(""),- 1)) | |
| 24261 | "RTN","ORY 4274",66,0 ) | |
| 24262 | Q | |
| 24263 | "RTN","ORY 4274",67,0 ) | |
| 24264 | ; | |
| 24265 | "RTN","ORY 4274",68,0 ) | |
| 24266 | APPEND(ARR AY,OCXSUB) ; | |
| 24267 | "RTN","ORY 4274",69,0 ) | |
| 24268 | S:'(OCXSU B=+OCXSUB) OCXSUB="" ""_OCXSUB_ """" | |
| 24269 | "RTN","ORY 4274",70,0 ) | |
| 24270 | Q:'(ARRAY ["(") ARRA Y_"("_OCXS UB_")" | |
| 24271 | "RTN","ORY 4274",71,0 ) | |
| 24272 | Q $E(ARRA Y,1,$L(ARR AY)-1)_"," _OCXSUB_") " | |
| 24273 | "RTN","ORY 4274",72,0 ) | |
| 24274 | ; | |
| 24275 | "RTN","ORY 4274",73,0 ) | |
| 24276 | READ(OCXZ0 ,OCXZA,OCX ZB,OCXZL) ; | |
| 24277 | "RTN","ORY 4274",74,0 ) | |
| 24278 | N OCXLINE ,DIR,DTOUT ,DUOUT,DIR UT,DIROUT | |
| 24279 | "RTN","ORY 4274",75,0 ) | |
| 24280 | Q:'$L($G( OCXZ0)) U | |
| 24281 | "RTN","ORY 4274",76,0 ) | |
| 24282 | S DIR(0)= OCXZ0 | |
| 24283 | "RTN","ORY 4274",77,0 ) | |
| 24284 | S:$L($G(O CXZA)) DIR ("A")=OCXZ A | |
| 24285 | "RTN","ORY 4274",78,0 ) | |
| 24286 | S:$L($G(O CXZB)) DIR ("B")=OCXZ B | |
| 24287 | "RTN","ORY 4274",79,0 ) | |
| 24288 | F OCXLINE =1:1:($G(O CXZL)-1) W ! | |
| 24289 | "RTN","ORY 4274",80,0 ) | |
| 24290 | D ^DIR | |
| 24291 | "RTN","ORY 4274",81,0 ) | |
| 24292 | I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q U | |
| 24293 | "RTN","ORY 4274",82,0 ) | |
| 24294 | Q Y | |
| 24295 | "RTN","ORY 4274",83,0 ) | |
| 24296 | ; | |
| 24297 | "RTN","ORY 4274",84,0 ) | |
| 24298 | PAUSE() W " Press E nter " R X :DTIME W ! Q (X[U) | |
| 24299 | "RTN","ORY 4274",85,0 ) | |
| 24300 | ; | |
| 24301 | "RTN","ORY 427ES") | |
| 24302 | 0^14^B1259 6610 | |
| 24303 | "RTN","ORY 427ES",1,0 ) | |
| 24304 | ORY427ES ; SLC/RJS,CL A - OCX PA CKAGE RULE TRANSPORT ROUTINE ( Delete aft er Install of OR*3*4 27) ;MAR 7 ,2017 at 1 5:12 | |
| 24305 | "RTN","ORY 427ES",2,0 ) | |
| 24306 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 27**;Dec 1 7,1997;Bui ld 61 | |
| 24307 | "RTN","ORY 427ES",3,0 ) | |
| 24308 | ;; ;;ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998 | |
| 24309 | "RTN","ORY 427ES",4,0 ) | |
| 24310 | ; | |
| 24311 | "RTN","ORY 427ES",5,0 ) | |
| 24312 | S ; | |
| 24313 | "RTN","ORY 427ES",6,0 ) | |
| 24314 | ; | |
| 24315 | "RTN","ORY 427ES",7,0 ) | |
| 24316 | N OCXDIER ,QUIT,LINE ,TEXT,REMO TE,LOCAL,D 0,OPCODE,R EF,OCXFLAG S QUIT=0 | |
| 24317 | "RTN","ORY 427ES",8,0 ) | |
| 24318 | N OCXAUTO ,OCZSCR | |
| 24319 | "RTN","ORY 427ES",9,0 ) | |
| 24320 | ; | |
| 24321 | "RTN","ORY 427ES",10, 0) | |
| 24322 | D DOT | |
| 24323 | "RTN","ORY 427ES",11, 0) | |
| 24324 | I $L($T(V ERSION^OCX OCMP)),($$ VERSION^OC XOCMP="ORD ER CHECK E XPERT vers ion 1.01 r eleased OC T 29,1998" ),1 | |
| 24325 | "RTN","ORY 427ES",12, 0) | |
| 24326 | E D Q | |
| 24327 | "RTN","ORY 427ES",13, 0) | |
| 24328 | .W ! | |
| 24329 | "RTN","ORY 427ES",14, 0) | |
| 24330 | .W !,"Rul e Transpor t aborted, version m ismatch." | |
| 24331 | "RTN","ORY 427ES",15, 0) | |
| 24332 | .W !,"Cur rent Local version: ",$$VERSIO N^OCXOCMP | |
| 24333 | "RTN","ORY 427ES",16, 0) | |
| 24334 | .W !," Rule Trans port Versi on: ORDER CHECK EXPE RT version 1.01 rele ased OCT 2 9,1998" | |
| 24335 | "RTN","ORY 427ES",17, 0) | |
| 24336 | I '$D(DTI ME) W !!," DTIME not defined !! ",!! Q | |
| 24337 | "RTN","ORY 427ES",18, 0) | |
| 24338 | W !!,"Ord er Check E xpert Syst em Rule Tr ansporter" | |
| 24339 | "RTN","ORY 427ES",19, 0) | |
| 24340 | W !," Cre ated: MAR 7,2017 at 15:12 at NCCLAB1.A AC.VA.GOV" | |
| 24341 | "RTN","ORY 427ES",20, 0) | |
| 24342 | W !," Cur rent Date: ",$$NOW^O RY4270," at ",$$NE TNAME^OCXS END,!! | |
| 24343 | "RTN","ORY 427ES",21, 0) | |
| 24344 | S LASTFIL E=0 K ^TMP ("OCXRULE" ,$J) | |
| 24345 | "RTN","ORY 427ES",22, 0) | |
| 24346 | S ^TMP("O CXRULE",$J )=($P($H," ,",2)+($H* 86400)+(1* 60*60))_" <- ^TMP EN TRY EXPIRA TION DATE FOR ^OCXOP URG" | |
| 24347 | "RTN","ORY 427ES",23, 0) | |
| 24348 | S OCXFLAG ="O" | |
| 24349 | "RTN","ORY 427ES",24, 0) | |
| 24350 | ; | |
| 24351 | "RTN","ORY 427ES",25, 0) | |
| 24352 | RUN ; | |
| 24353 | "RTN","ORY 427ES",26, 0) | |
| 24354 | ; | |
| 24355 | "RTN","ORY 427ES",27, 0) | |
| 24356 | W !,"Load ing Data " D ^ORY427 01 | |
| 24357 | "RTN","ORY 427ES",28, 0) | |
| 24358 | ; | |
| 24359 | "RTN","ORY 427ES",29, 0) | |
| 24360 | S LINE=0 F S LINE= $O(^TMP("O CXRULE",$J ,LINE)) Q: 'LINE D Q:QUIT | |
| 24361 | "RTN","ORY 427ES",30, 0) | |
| 24362 | .D:'(LINE #50) STATU S^OCXOPOST (LINE,$O(^ TMP("OCXRU LE",$J," " ),-1)) | |
| 24363 | "RTN","ORY 427ES",31, 0) | |
| 24364 | .S TEXT=$ G(^TMP("OC XRULE",$J, LINE)) I $ L(TEXT) D Q:QUIT | |
| 24365 | "RTN","ORY 427ES",32, 0) | |
| 24366 | ..S TEXT= $P(TEXT,"; ",2,999),O PCODE=$P(T EXT,U,1),T EXT=$P(TEX T,U,2,999) | |
| 24367 | "RTN","ORY 427ES",33, 0) | |
| 24368 | ..; | |
| 24369 | "RTN","ORY 427ES",34, 0) | |
| 24370 | ..I OPCOD E="KEY" D DOT S LOCA L="",D0=$$ GETFILE^OR Y4270(+$P( TEXT,U,1), $P(TEXT,U, 2),.LOCAL) S QUIT=(D 0=(-10)) Q | |
| 24371 | "RTN","ORY 427ES",35, 0) | |
| 24372 | ..I OPCOD E="R" S RE F="REMOTE( "_$P(TEXT, ":",1)_":" _D0_$P(TEX T,":",2,99 )_")" Q | |
| 24373 | "RTN","ORY 427ES",36, 0) | |
| 24374 | ..I OPCOD E="D",$D(R EF) S @REF =$P(TEXT,U ,1,999) K REF Q | |
| 24375 | "RTN","ORY 427ES",37, 0) | |
| 24376 | ..; | |
| 24377 | "RTN","ORY 427ES",38, 0) | |
| 24378 | ..I OPCOD E="EOR" S QUIT=$$COM PARE^ORY42 71(.LOCAL, .REMOTE) K LOCAL,REM OTE Q | |
| 24379 | "RTN","ORY 427ES",39, 0) | |
| 24380 | ..I OPCOD E="EOF" K LOCAL,REMO TE Q | |
| 24381 | "RTN","ORY 427ES",40, 0) | |
| 24382 | ..I OPCOD E="SOF" W !," Insta lling '",T EXT,"' rec ords... " Q | |
| 24383 | "RTN","ORY 427ES",41, 0) | |
| 24384 | ..I OPCOD E="ROOT" D Q | |
| 24385 | "RTN","ORY 427ES",42, 0) | |
| 24386 | ...N FILE ,DATA | |
| 24387 | "RTN","ORY 427ES",43, 0) | |
| 24388 | ...S FILE =U_$P(TEXT ,U,1),DATA =$P(TEXT,U ,2,3) | |
| 24389 | "RTN","ORY 427ES",44, 0) | |
| 24390 | ...I ($P( $G(@FILE), U,1,2)=DAT A) Q | |
| 24391 | "RTN","ORY 427ES",45, 0) | |
| 24392 | ...S $P(@ FILE,U,1,2 )=DATA | |
| 24393 | "RTN","ORY 427ES",46, 0) | |
| 24394 | ...W !," Restoring file #",( +$P(DATA,U ,2))," zer o node" | |
| 24395 | "RTN","ORY 427ES",47, 0) | |
| 24396 | ..; | |
| 24397 | "RTN","ORY 427ES",48, 0) | |
| 24398 | ..W !,"Un known OpCo de: ",OPCO DE," in: ",TEXT S Q UIT=$$PAUS E^ORY4270 W ! | |
| 24399 | "RTN","ORY 427ES",49, 0) | |
| 24400 | ; | |
| 24401 | "RTN","ORY 427ES",50, 0) | |
| 24402 | K ^TMP("O CXRULE",$J ) | |
| 24403 | "RTN","ORY 427ES",51, 0) | |
| 24404 | ; | |
| 24405 | "RTN","ORY 427ES",52, 0) | |
| 24406 | I $D(^OCX S) D | |
| 24407 | "RTN","ORY 427ES",53, 0) | |
| 24408 | .N FILE,D O,PD0,CNT | |
| 24409 | "RTN","ORY 427ES",54, 0) | |
| 24410 | .S FILE=0 F S FILE =$O(^OCXS( FILE)) Q:' FILE D | |
| 24411 | "RTN","ORY 427ES",55, 0) | |
| 24412 | ..S D0=0 F CNT=0:1 S PD0=D0,D 0=$O(^OCXS (FILE,D0)) Q:'D0 | |
| 24413 | "RTN","ORY 427ES",56, 0) | |
| 24414 | ..S $P(^O CXS(FILE,0 ),U,3,4)=C NT_U_PD0 | |
| 24415 | "RTN","ORY 427ES",57, 0) | |
| 24416 | ; | |
| 24417 | "RTN","ORY 427ES",58, 0) | |
| 24418 | I $G(OCXD IER) D | |
| 24419 | "RTN","ORY 427ES",59, 0) | |
| 24420 | .W !!!!!! ! | |
| 24421 | "RTN","ORY 427ES",60, 0) | |
| 24422 | .W !,?5," ********** ********** Warning * ********** ********* " | |
| 24423 | "RTN","ORY 427ES",61, 0) | |
| 24424 | .W !,?7,+ $G(OCXDIER )," data f iling erro r",$S(($G( OCXDIER)=1 ):"",1:"s" ),"." | |
| 24425 | "RTN","ORY 427ES",62, 0) | |
| 24426 | .W !,?7," Some exper t system r ules may b e incomple te." | |
| 24427 | "RTN","ORY 427ES",63, 0) | |
| 24428 | .W !,?5," ********** ********** Warning * ********** ********* " | |
| 24429 | "RTN","ORY 427ES",64, 0) | |
| 24430 | I '$G(OCX DIER) W !! ,?5," No d ata filing errors." | |
| 24431 | "RTN","ORY 427ES",65, 0) | |
| 24432 | W !!,"Tra nsport Fin ished..." | |
| 24433 | "RTN","ORY 427ES",66, 0) | |
| 24434 | ; | |
| 24435 | "RTN","ORY 427ES",67, 0) | |
| 24436 | D | |
| 24437 | "RTN","ORY 427ES",68, 0) | |
| 24438 | .N OCXOET IM | |
| 24439 | "RTN","ORY 427ES",69, 0) | |
| 24440 | .D BMES^X PDUTL("--- Creating O rder Check Routines- ---------- ---------- ---------- ----") | |
| 24441 | "RTN","ORY 427ES",70, 0) | |
| 24442 | .D AUTO^O CXOCMP | |
| 24443 | "RTN","ORY 427ES",71, 0) | |
| 24444 | ; | |
| 24445 | "RTN","ORY 427ES",72, 0) | |
| 24446 | Q | |
| 24447 | "RTN","ORY 427ES",73, 0) | |
| 24448 | ; | |
| 24449 | "RTN","ORY 427ES",74, 0) | |
| 24450 | DOT Q:$G(O CXAUTO) W :($X>70) ! W " ." Q | |
| 24451 | "RTN","ORY 427ES",75, 0) | |
| 24452 | ; | |
| 24453 | "RTN","ORY 427ES",76, 0) | |
| 24454 | READ(OCXZ0 ,OCXZA,OCX ZB,OCXZL) ; | |
| 24455 | "RTN","ORY 427ES",77, 0) | |
| 24456 | N OCXLINE ,DIR,DTOUT ,DUOUT,DIR UT,DIROUT | |
| 24457 | "RTN","ORY 427ES",78, 0) | |
| 24458 | Q:'$L($G( OCXZ0)) U | |
| 24459 | "RTN","ORY 427ES",79, 0) | |
| 24460 | S DIR(0)= OCXZ0 | |
| 24461 | "RTN","ORY 427ES",80, 0) | |
| 24462 | S:$L($G(O CXZA)) DIR ("A")=OCXZ A | |
| 24463 | "RTN","ORY 427ES",81, 0) | |
| 24464 | S:$L($G(O CXZB)) DIR ("B")=OCXZ B | |
| 24465 | "RTN","ORY 427ES",82, 0) | |
| 24466 | F OCXLINE =1:1:($G(O CXZL)-1) W ! | |
| 24467 | "RTN","ORY 427ES",83, 0) | |
| 24468 | D ^DIR | |
| 24469 | "RTN","ORY 427ES",84, 0) | |
| 24470 | I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q U | |
| 24471 | "RTN","ORY 427ES",85, 0) | |
| 24472 | Q Y | |
| 24473 | "RTN","ORY 427ES",86, 0) | |
| 24474 | ; | |
| 24475 | "VER") | |
| 24476 | 8.0^22.2 | |
| 24477 | **END** | |
| 24478 | **END** |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.