9. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 12/9/2016 1:23:26 PM Central 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.

9.1 Files compared

# Location File Last Modified
1 C:\Users\vhaisbforrez\AraxisComp\PUB_UN\EPIP_Test_Cases_Functional Testing_(OR_3.0_431)_201611.zip OR_3_431_TEST_V8.KID Tue Dec 6 17:15:08 2016 UTC
2 C:\Users\vhaisbforrez\AraxisComp\PUB_RE\EPIP_Test_Cases_Functional Testing_(OR_3.0_431)_201611.zip OR_3_431_TEST_V8.KID Thu Dec 8 16:50:52 2016 UTC

9.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 4 9974
Changed 3 6
Inserted 0 0
Removed 0 0

9.3 Comparison options

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

9.4 Active regular expressions

No regular expressions were active.

9.5 Comparison detail

  1                OR*3*431 T EST v8
  2                Extracted  from mail  message
  3                **KIDS**:O R*3.0*431^
  4               
  5                **INSTALL  NAME**
  6                OR*3.0*431
  7                "BLD",9881 ,0)
  8                OR*3.0*431 ^ORDER ENT RY/RESULTS  REPORTING ^0^3161117 ^y
  9                "BLD",9881 ,4,0)
  10                ^9.64PA^10 0.0074^6
  11                "BLD",9881 ,4,100.007 ,0)
  12                100.007
  13                "BLD",9881 ,4,100.007 ,222)
  14                y^y^f^^n^^ y^o^y
  15                "BLD",9881 ,4,100.007 1,0)
  16                100.0071
  17                "BLD",9881 ,4,100.007 1,222)
  18                y^y^f^^^^n
  19                "BLD",9881 ,4,100.007 2,0)
  20                100.0072
  21                "BLD",9881 ,4,100.007 2,222)
  22                y^y^f^^n^^ y^m^n
  23                "BLD",9881 ,4,100.007 3,0)
  24                100.0073
  25                "BLD",9881 ,4,100.007 3,222)
  26                y^y^f^^^^n
  27                "BLD",9881 ,4,100.007 4,0)
  28                100.0074
  29                "BLD",9881 ,4,100.007 4,222)
  30                y^y^f^^^^n ^^
  31                "BLD",9881 ,4,100.007 4,224)
  32                 
  33                "BLD",9881 ,4,200,0)
  34                200
  35                "BLD",9881 ,4,200,2,0 )
  36                ^9.641^200 .08^1
  37                "BLD",9881 ,4,200,2,2 00.08,0)
  38                DEFAULT EN COUNTER LO CATION  (s ub-file)
  39                "BLD",9881 ,4,200,2,2 00.08,1,0)
  40                ^9.6411^.0 1^1
  41                "BLD",9881 ,4,200,2,2 00.08,1,.0 1,0)
  42                DEFAULT EN COUNTER LO CATION
  43                "BLD",9881 ,4,200,222 )
  44                y^y^p^^^^n ^^n
  45                "BLD",9881 ,4,200,224 )
  46                 
  47                "BLD",9881 ,4,"APDD", 200,200.08 )
  48                 
  49                "BLD",9881 ,4,"APDD", 200,200.08 ,.01)
  50                 
  51                "BLD",9881 ,4,"B",100 .007,100.0 07)
  52                 
  53                "BLD",9881 ,4,"B",100 .0071,100. 0071)
  54                 
  55                "BLD",9881 ,4,"B",100 .0072,100. 0072)
  56                 
  57                "BLD",9881 ,4,"B",100 .0073,100. 0073)
  58                 
  59                "BLD",9881 ,4,"B",100 .0074,100. 0074)
  60                 
  61                "BLD",9881 ,4,"B",200 ,200)
  62                 
  63                "BLD",9881 ,6.3)
  64                30
  65                "BLD",9881 ,"ABPKG")
  66                n
  67                "BLD",9881 ,"INIT")
  68                POST^ORCP0 31
  69                "BLD",9881 ,"KRN",0)
  70                ^9.67PA^77 9.2^20
  71                "BLD",9881 ,"KRN",.4, 0)
  72                .4
  73                "BLD",9881 ,"KRN",.40 1,0)
  74                .401
  75                "BLD",9881 ,"KRN",.40 2,0)
  76                .402
  77                "BLD",9881 ,"KRN",.40 2,"NM",0)
  78                ^9.68A^6^6
  79                "BLD",9881 ,"KRN",.40 2,"NM",1,0 )
  80                ORPU EDIT  LOCAL NOTI CE    FILE  #100.0073 ^100.0073^ 0
  81                "BLD",9881 ,"KRN",.40 2,"NM",2,0 )
  82                ORPU EDIT  POPUP FLAG     FILE # 100.0072^1 00.0072^0
  83                "BLD",9881 ,"KRN",.40 2,"NM",3,0 )
  84                ORPU EDIT  TEMP ADDRE SS    FILE  #2^2^0
  85                "BLD",9881 ,"KRN",.40 2,"NM",4,0 )
  86                ORPU EDIT  TEXT    FI LE #100.00 7^100.007^ 0
  87                "BLD",9881 ,"KRN",.40 2,"NM",5,0 )
  88                ORPU EDIT  VESTING     FILE #100 .0074^100. 0074^0
  89                "BLD",9881 ,"KRN",.40 2,"NM",6,0 )
  90                ORPU POPUP  PATIENT E DIT    FIL E #100.007 1^100.0071 ^0
  91                "BLD",9881 ,"KRN",.40 2,"NM","B" ,"ORPU EDI T LOCAL NO TICE    FI LE #100.00 73",1)
  92                 
  93                "BLD",9881 ,"KRN",.40 2,"NM","B" ,"ORPU EDI T POPUP FL AG    FILE  #100.0072 ",2)
  94                 
  95                "BLD",9881 ,"KRN",.40 2,"NM","B" ,"ORPU EDI T TEMP ADD RESS    FI LE #2",3)
  96                 
  97                "BLD",9881 ,"KRN",.40 2,"NM","B" ,"ORPU EDI T TEXT     FILE #100. 007",4)
  98                 
  99                "BLD",9881 ,"KRN",.40 2,"NM","B" ,"ORPU EDI T VESTING     FILE #1 00.0074",5 )
  100                 
  101                "BLD",9881 ,"KRN",.40 2,"NM","B" ,"ORPU POP UP PATIENT  EDIT    F ILE #100.0 071",6)
  102                 
  103                "BLD",9881 ,"KRN",.40 3,0)
  104                .403
  105                "BLD",9881 ,"KRN",.5, 0)
  106                .5
  107                "BLD",9881 ,"KRN",.84 ,0)
  108                .84
  109                "BLD",9881 ,"KRN",3.6 ,0)
  110                3.6
  111                "BLD",9881 ,"KRN",3.8 ,0)
  112                3.8
  113                "BLD",9881 ,"KRN",9.2 ,0)
  114                9.2
  115                "BLD",9881 ,"KRN",9.8 ,0)
  116                9.8
  117                "BLD",9881 ,"KRN",9.8 ,"NM",0)
  118                ^9.68A^18^ 11
  119                "BLD",9881 ,"KRN",9.8 ,"NM",3,0)
  120                ORWDX^^0^B 78560931
  121                "BLD",9881 ,"KRN",9.8 ,"NM",5,0)
  122                ORWU^^0^B6 2954737
  123                "BLD",9881 ,"KRN",9.8 ,"NM",8,0)
  124                ORWU1^^0^B 53568040
  125                "BLD",9881 ,"KRN",9.8 ,"NM",10,0 )
  126                ORCLOC^^0^ B17673208
  127                "BLD",9881 ,"KRN",9.8 ,"NM",12,0 )
  128                ORPOCHF^^0 ^B860484
  129                "BLD",9881 ,"KRN",9.8 ,"NM",13,0 )
  130                ORPO7GUI^^ 0^B7153378
  131                "BLD",9881 ,"KRN",9.8 ,"NM",14,0 )
  132                ORPOMDRO^^ 0^B1921702 6
  133                "BLD",9881 ,"KRN",9.8 ,"NM",15,0 )
  134                ORPOOBS^^0 ^B13587829
  135                "BLD",9881 ,"KRN",9.8 ,"NM",16,0 )
  136                ORPOTIO^^0 ^B29447201
  137                "BLD",9881 ,"KRN",9.8 ,"NM",17,0 )
  138                ORPOVST^^0 ^B55262882
  139                "BLD",9881 ,"KRN",9.8 ,"NM",18,0 )
  140                ORWPT^^0^B 63673004
  141                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORCLOC",1 0)
  142                 
  143                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORPO7GUI" ,13)
  144                 
  145                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORPOCHF", 12)
  146                 
  147                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORPOMDRO" ,14)
  148                 
  149                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORPOOBS", 15)
  150                 
  151                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORPOTIO", 16)
  152                 
  153                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORPOVST", 17)
  154                 
  155                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORWDX",3)
  156                 
  157                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORWPT",18 )
  158                 
  159                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORWU",5)
  160                 
  161                "BLD",9881 ,"KRN",9.8 ,"NM","B", "ORWU1",8)
  162                 
  163                "BLD",9881 ,"KRN",19, 0)
  164                19
  165                "BLD",9881 ,"KRN",19, "NM",0)
  166                ^9.68A^10^ 10
  167                "BLD",9881 ,"KRN",19, "NM",1,0)
  168                OR PCE DEF AULT LOC A DMIN^^0
  169                "BLD",9881 ,"KRN",19, "NM",2,0)
  170                OR PCE DEF AULT LOCAT ION^^0
  171                "BLD",9881 ,"KRN",19, "NM",3,0)
  172                ORPU EDIT  LOCAL NOTI CE^^0
  173                "BLD",9881 ,"KRN",19, "NM",4,0)
  174                ORPU EDIT  POPUP FLAG ^^0
  175                "BLD",9881 ,"KRN",19, "NM",5,0)
  176                ORPU EDIT  POPUP PATI ENT FLAG^^ 0
  177                "BLD",9881 ,"KRN",19, "NM",6,0)
  178                ORPU EDIT  POPUP TEXT ^^0
  179                "BLD",9881 ,"KRN",19, "NM",7,0)
  180                ORPU EDIT  TEMP ADDRE SS^^0
  181                "BLD",9881 ,"KRN",19, "NM",8,0)
  182                ORPU MAIN  MENU^^0
  183                "BLD",9881 ,"KRN",19, "NM",9,0)
  184                ORPU PRINT  VESTING C ODES^^0
  185                "BLD",9881 ,"KRN",19, "NM",10,0)
  186                ORPU EDIT  VESTING^^0
  187                "BLD",9881 ,"KRN",19, "NM","B"," OR PCE DEF AULT LOC A DMIN",1)
  188                 
  189                "BLD",9881 ,"KRN",19, "NM","B"," OR PCE DEF AULT LOCAT ION",2)
  190                 
  191                "BLD",9881 ,"KRN",19, "NM","B"," ORPU EDIT  LOCAL NOTI CE",3)
  192                 
  193                "BLD",9881 ,"KRN",19, "NM","B"," ORPU EDIT  POPUP FLAG ",4)
  194                 
  195                "BLD",9881 ,"KRN",19, "NM","B"," ORPU EDIT  POPUP PATI ENT FLAG", 5)
  196                 
  197                "BLD",9881 ,"KRN",19, "NM","B"," ORPU EDIT  POPUP TEXT ",6)
  198                 
  199                "BLD",9881 ,"KRN",19, "NM","B"," ORPU EDIT  TEMP ADDRE SS",7)
  200                 
  201                "BLD",9881 ,"KRN",19, "NM","B"," ORPU EDIT  VESTING",1 0)
  202                 
  203                "BLD",9881 ,"KRN",19, "NM","B"," ORPU MAIN  MENU",8)
  204                 
  205                "BLD",9881 ,"KRN",19, "NM","B"," ORPU PRINT  VESTING C ODES",9)
  206                 
  207                "BLD",9881 ,"KRN",19. 1,0)
  208                19.1
  209                "BLD",9881 ,"KRN",101 ,0)
  210                101
  211                "BLD",9881 ,"KRN",409 .61,0)
  212                409.61
  213                "BLD",9881 ,"KRN",771 ,0)
  214                771
  215                "BLD",9881 ,"KRN",779 .2,0)
  216                779.2
  217                "BLD",9881 ,"KRN",870 ,0)
  218                870
  219                "BLD",9881 ,"KRN",898 9.51,0)
  220                8989.51
  221                "BLD",9881 ,"KRN",898 9.52,0)
  222                8989.52
  223                "BLD",9881 ,"KRN",899 4,0)
  224                8994
  225                "BLD",9881 ,"KRN","B" ,.4,.4)
  226                 
  227                "BLD",9881 ,"KRN","B" ,.401,.401 )
  228                 
  229                "BLD",9881 ,"KRN","B" ,.402,.402 )
  230                 
  231                "BLD",9881 ,"KRN","B" ,.403,.403 )
  232                 
  233                "BLD",9881 ,"KRN","B" ,.5,.5)
  234                 
  235                "BLD",9881 ,"KRN","B" ,.84,.84)
  236                 
  237                "BLD",9881 ,"KRN","B" ,3.6,3.6)
  238                 
  239                "BLD",9881 ,"KRN","B" ,3.8,3.8)
  240                 
  241                "BLD",9881 ,"KRN","B" ,9.2,9.2)
  242                 
  243                "BLD",9881 ,"KRN","B" ,9.8,9.8)
  244                 
  245                "BLD",9881 ,"KRN","B" ,19,19)
  246                 
  247                "BLD",9881 ,"KRN","B" ,19.1,19.1 )
  248                 
  249                "BLD",9881 ,"KRN","B" ,101,101)
  250                 
  251                "BLD",9881 ,"KRN","B" ,409.61,40 9.61)
  252                 
  253                "BLD",9881 ,"KRN","B" ,771,771)
  254                 
  255                "BLD",9881 ,"KRN","B" ,779.2,779 .2)
  256                 
  257                "BLD",9881 ,"KRN","B" ,870,870)
  258                 
  259                "BLD",9881 ,"KRN","B" ,8989.51,8 989.51)
  260                 
  261                "BLD",9881 ,"KRN","B" ,8989.52,8 989.52)
  262                 
  263                "BLD",9881 ,"KRN","B" ,8994,8994 )
  264                 
  265                "BLD",9881 ,"QDEF")
  266                ^^^^NO^^^^ NO^^NO
  267                "BLD",9881 ,"QUES",0)
  268                ^9.62^^
  269                "BLD",9881 ,"REQB",0)
  270                ^9.611^3^3
  271                "BLD",9881 ,"REQB",1, 0)
  272                OR*3.0*424 ^2
  273                "BLD",9881 ,"REQB",2, 0)
  274                OR*3.0*311 ^2
  275                "BLD",9881 ,"REQB",3, 0)
  276                OR*3.0*394 ^2
  277                "BLD",9881 ,"REQB","B ","OR*3.0* 311",2)
  278                 
  279                "BLD",9881 ,"REQB","B ","OR*3.0* 394",3)
  280                 
  281                "BLD",9881 ,"REQB","B ","OR*3.0* 424",1)
  282                 
  283                "DATA",100 .007,1,0)
  284                OBSERVATIO N^1
  285                "DATA",100 .007,1,1,0 )
  286                ^^2^2^3140 416^
  287                "DATA",100 .007,1,1,1 ,0)
  288                Is patient  in a 48 h our Observ ation ward ?  If so,  list the t ime there  and
  289                "DATA",100 .007,1,1,2 ,0)
  290                if it's >4 8 hours.
  291                "DATA",100 .007,1,2,0 )
  292                ^100.00702 ^2^2^31404 16^^^
  293                "DATA",100 .007,1,2,1 ,0)
  294                I $$GET1^D IQ(2,DFN,. 103)'["OBS ERVATION"  S ORPOQUIT =1 Q
  295                "DATA",100 .007,1,2,2 ,0)
  296                D GETTEXT^ ORPOOBS(.L ST,DFN)
  297                "DATA",100 .007,1,3,0 )
  298                ^100.00703 ^2^2^31610 27^^^^
  299                "DATA",100 .007,1,3,1 ,0)
  300                TEXT FOR T HIS POPUP  IS IMBEDDE D IN ROUTI NE ORPOORO BS
  301                "DATA",100 .007,1,3,2 ,0)
  302                MAX TIME=4 8
  303                "DATA",100 .007,2,0)
  304                LOCAL NOTI CE^1
  305                "DATA",100 .007,2,1,0 )
  306                ^100.00701 ^1^1^31403 04^^
  307                "DATA",100 .007,2,1,1 ,0)
  308                Does patie nt have a  local noti ce on file ?
  309                "DATA",100 .007,2,2,0 )
  310                ^^5^5^3140 304^
  311                "DATA",100 .007,2,2,1 ,0)
  312                S:'$O(^OR( 100.0073," B",DFN,0))  ORPOQUIT= 1
  313                "DATA",100 .007,2,2,2 ,0)
  314                D INC^ORPO 7GUI
  315                "DATA",100 .007,2,2,3 ,0)
  316                D TXT^ORPO 7GUI
  317                "DATA",100 .007,2,2,4 ,0)
  318                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  319                "DATA",100 .007,2,2,5 ,0)
  320                S LST(ILST )=$$GET1^D IQ(100.007 3,DFN,1)
  321                "DATA",100 .007,2,3,0 )
  322                ^100.00703 ^1^1^31610 21^^^^
  323                "DATA",100 .007,2,3,1 ,0)
  324                *** This p atient has  a local n otice with  the follo wing text
  325                "DATA",100 .007,3,0)
  326                COMBAT^1
  327                "DATA",100 .007,3,1,0 )
  328                ^100.00701 ^1^1^31402 25^^
  329                "DATA",100 .007,3,1,1 ,0)
  330                Last day f or Combat  Veteran el igibility.
  331                "DATA",100 .007,3,2,0 )
  332                ^100.00702 ^4^4^31402 25^^
  333                "DATA",100 .007,3,2,1 ,0)
  334                S:$$GET1^D IQ(2,DFN,. 5295,"I")< DT ORPOQUI T=1
  335                "DATA",100 .007,3,2,2 ,0)
  336                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  337                "DATA",100 .007,3,2,3 ,0)
  338                D TXT^ORPO 7GUI
  339                "DATA",100 .007,3,2,4 ,0)
  340                S LST(ILST )=LST(ILST )_" "_$$GE T1^DIQ(2,D FN,.5295)_ "."
  341                "DATA",100 .007,3,3,0 )
  342                ^100.00703 ^5^5^31610 25^^^^
  343                "DATA",100 .007,3,3,1 ,0)
  344                *** Patien t is an OE F/OIF Comb at Veteran  with up t o five (5)
  345                "DATA",100 .007,3,3,2 ,0)
  346                  years sp ecial elig ibility fo r medical  care under
  347                "DATA",100 .007,3,3,3 ,0)
  348                  the Nati onal Defen se Authori zation Act  of 2008
  349                "DATA",100 .007,3,3,4 ,0)
  350                  and is n ot subject  to copaym ents.
  351                "DATA",100 .007,3,3,5 ,0)
  352                >> This st atus is in  effect th rough
  353                "DATA",100 .007,4,0)
  354                ENDO^0
  355                "DATA",100 .007,4,1,0 )
  356                ^^1^1^3140 305^
  357                "DATA",100 .007,4,1,1 ,0)
  358                Requires r eminder: O RPO GLYCEM IA REPORT  D
  359                "DATA",100 .007,4,2,0 )
  360                ^^16^16^31 40225^
  361                "DATA",100 .007,4,2,1 ,0)
  362                ;IA#3148
  363                "DATA",100 .007,4,2,2 ,0)
  364                S:'$D(^XUS EC("ORES", DUZ)) ORPO QUIT=1
  365                "DATA",100 .007,4,2,3 ,0)
  366                S:+$$FLAGO K("ENDO")> 2 ORPOQUIT =1
  367                "DATA",100 .007,4,2,4 ,0)
  368                D INP^VADP T
  369                "DATA",100 .007,4,2,5 ,0)
  370                S:VAIN(4)' ["CU" ORPO QUIT=1
  371                "DATA",100 .007,4,2,6 ,0)
  372                S ORPOLIST (1)=$O(^PX D(811.9,"B ","ORPO GL YCEMIA REP ORT D",0))
  373                "DATA",100 .007,4,2,7 ,0)
  374                S:'+ORPOLI ST(1) ORPO QUIT=1
  375                "DATA",100 .007,4,2,8 ,0)
  376                D ALIST^OR QQPXRM(.OR PO,DFN,.OR POLIST)
  377                "DATA",100 .007,4,2,9 ,0)
  378                S:$P(ORPO( 1),"^",6)' =1 ORPOQUI T=1
  379                "DATA",100 .007,4,2,1 0,0)
  380                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  381                "DATA",100 .007,4,2,1 1,0)
  382                D TXT^ORPO 7GUI
  383                "DATA",100 .007,4,2,1 2,0)
  384               
  385                "DATA",100 .007,4,2,1 3,0)
  386                ^XTMP("ORP OFLAG"_DT, "ENDO",DUZ ,$G(DFN))= $G(^XTMP(" ORPOFLAG"_ DT,"ENDO", DUZ,
  387                "DATA",100 .007,4,2,1 4,0)
  388                $G(DFN)))+ 1
  389                "DATA",100 .007,4,2,1 5,0)
  390                S ^XTMP("O RPO","FLAG ","ENDO",$ $NOW^XLFDT ,DUZ,$G(DF N))=""
  391                "DATA",100 .007,4,2,1 6,0)
  392                K ORPO,ORP OLIST,VAIN
  393                "DATA",100 .007,4,3,0 )
  394                ^100.00703 ^5^5^31610 20^^^
  395                "DATA",100 .007,4,3,1 ,0)
  396                This patie nt has had  multiple  instances  of hypergl ycemia
  397                "DATA",100 .007,4,3,2 ,0)
  398                (defined a s blood su gar >120)  over the l ast 24 hou rs.
  399                "DATA",100 .007,4,3,3 ,0)
  400                Please con sider impl ementing t he INSULIN  PROTOCOL  order set
  401                "DATA",100 .007,4,3,4 ,0)
  402                which can  be found o n the Hine s PROTOCOL S & PATHWA YS
  403                "DATA",100 .007,4,3,5 ,0)
  404                of your CP RS order s creen.
  405                "DATA",100 .007,5,0)
  406                DENTAL^0
  407                "DATA",100 .007,5,1,0 )
  408                ^^1^1^3140 305^
  409                "DATA",100 .007,5,1,1 ,0)
  410                Requires r eminder: B ISPHOSPHON ATE DENTAL  SCREENIN
  411                "DATA",100 .007,5,2,0 )
  412                ^^10^10^31 40225^
  413                "DATA",100 .007,5,2,1 ,0)
  414                ;IA#3148
  415                "DATA",100 .007,5,2,2 ,0)
  416                S ORPO1="D ENTIST",OR PO12="DENT AL ASSISTA NT"
  417                "DATA",100 .007,5,2,3 ,0)
  418                S:'($$ISA^ USRLM(DUZ, ORPO1))!($ $ISA^USRLM (DUZ,ORPO1 2)) ORPOQU IT=1
  419                "DATA",100 .007,5,2,4 ,0)
  420                S ORPOLIST (1)=$O(^PX D(811.9,"B ","BISPHOS PHONATE DE NTAL SCREE NING",0))
  421                "DATA",100 .007,5,2,5 ,0)
  422                S:'+ORPOLI ST(1) ORPO QUIT=1
  423                "DATA",100 .007,5,2,6 ,0)
  424                D ALIST^OR QQPXRM(.OR PO,DFN,.OR POLIST)
  425                "DATA",100 .007,5,2,7 ,0)
  426                S:"0^1"'[$ P(ORPO(1), "^",6) ORP OQUIT=1
  427                "DATA",100 .007,5,2,8 ,0)
  428                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  429                "DATA",100 .007,5,2,9 ,0)
  430                D TXT^ORPO 7GUI 
  431                "DATA",100 .007,5,2,1 0,0)
  432                K ORPO,ORP OLIST,ORPO 1,ORPO12
  433                "DATA",100 .007,5,3,0 )
  434                ^100.00703 ^2^2^31610 27^^^^
  435                "DATA",100 .007,5,3,1 ,0)
  436                 Attention  DENTAL Pr oviders:
  437                "DATA",100 .007,5,3,2 ,0)
  438                 This is a n IV BISPH OSPHONATE  Patient.
  439                "DATA",100 .007,6,0)
  440                VESTING^1
  441                "DATA",100 .007,6,2,0 )
  442                ^^6^6^3140 225^
  443                "DATA",100 .007,6,2,1 ,0)
  444                S ORPOVEST =$$EN^ORPO VST(DFN)
  445                "DATA",100 .007,6,2,2 ,0)
  446                S:ORPOVEST ="VESTED"  ORPOQUIT=1
  447                "DATA",100 .007,6,2,3 ,0)
  448                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  449                "DATA",100 .007,6,2,4 ,0)
  450                D TXT^ORPO 7GUI
  451                "DATA",100 .007,6,2,5 ,0)
  452                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  453                "DATA",100 .007,6,2,6 ,0)
  454                K ORPOVEST
  455                "DATA",100 .007,6,3,0 )
  456                ^100.00703 ^1^1^31611 09^^^^
  457                "DATA",100 .007,6,3,1 ,0)
  458                 **** NON- VESTED *** *
  459                "DATA",100 .007,7,0)
  460                CPR^0
  461                "DATA",100 .007,7,1,0 )
  462                ^100.00701 ^1^1^31610 11^^
  463                "DATA",100 .007,7,1,1 ,0)
  464                Requires r eminder: O RPO DNR PO P-UP TRACK ER
  465                "DATA",100 .007,7,2,0 )
  466                ^100.00702 ^7^7^31610 11^^
  467                "DATA",100 .007,7,2,1 ,0)
  468                ;IA#3148
  469                "DATA",100 .007,7,2,2 ,0)
  470                S ORPOLIST (1)=$O(^PX D(811.9,"B ","ORPO DN R POP-UP T RACKER",0) )
  471                "DATA",100 .007,7,2,3 ,0)
  472                S:'+ORPOLI ST(1) ORPO QUIT=1
  473                "DATA",100 .007,7,2,4 ,0)
  474                D ALIST^OR QQPXRM(.OR PO,DFN,.OR POLIST)
  475                "DATA",100 .007,7,2,5 ,0)
  476                S:$P(ORPO( 1),"^",6)' =1 ORPOQUI T=1
  477                "DATA",100 .007,7,2,6 ,0)
  478                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  479                "DATA",100 .007,7,2,7 ,0)
  480                K ORPO,ORP OLIST
  481                "DATA",100 .007,8,0)
  482                FLUSEA^0
  483                "DATA",100 .007,8,1,0 )
  484                ^^1^1^3140 305^
  485                "DATA",100 .007,8,1,1 ,0)
  486                Requires r eminder: I NPT INFLUE NZA VACCIN E SCREENIN G
  487                "DATA",100 .007,8,2,0 )
  488                ^^12^12^31 40225^
  489                "DATA",100 .007,8,2,1 ,0)
  490                S:'+$$USER ^ORPO7GUI( DUZ) ORPOQ UIT=1
  491                "DATA",100 .007,8,2,2 ,0)
  492                S ORPOLIST (1)=$O(^PX D(811.9,"B ","INPT IN FLUENZA VA CCINE SCRE ENING",0))
  493                "DATA",100 .007,8,2,3 ,0)
  494                S:'+ORPOLI ST(1) ORPO QUIT=1
  495                "DATA",100 .007,8,2,4 ,0)
  496                D ALIST^OR QQPXRM(.OR PO,DFN,.OR POLIST)
  497                "DATA",100 .007,8,2,5 ,0)
  498                S:$P(ORPO( 1),"^",6)' =1 ORPOQUI T=1
  499                "DATA",100 .007,8,2,6 ,0)
  500                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  501                "DATA",100 .007,8,2,7 ,0)
  502                D TXT^ORPO 7GUI
  503                "DATA",100 .007,8,2,8 ,0)
  504                D INC^ORPO 7GUI
  505                "DATA",100 .007,8,2,9 ,0)
  506               
  507                "DATA",100 .007,8,2,1 0,0)
  508                ^XTMP("ORP OFLAG"_DT, "FLUSEA",D UZ,$G(DFN) )=$G(^XTMP ("ORPOFLAG "_DT,"FLUS EA",
  509                "DATA",100 .007,8,2,1 1,0)
  510                DUZ,$G(DFN )))+1
  511                "DATA",100 .007,8,2,1 2,0)
  512                K ORPOLIST ,ORPO,ORPO ERR
  513                "DATA",100 .007,8,3,0 )
  514                ^100.00703 ^2^2^31610 27^^^^
  515                "DATA",100 .007,8,3,1 ,0)
  516                 This pati ent has no t received  their flu  shot.
  517                "DATA",100 .007,8,3,2 ,0)
  518                 Please us e the clin ical remin der or the  Orders Ta b to order   the vacc ine.
  519                "DATA",100 .007,9,0)
  520                INELIGIBLE ^1
  521                "DATA",100 .007,9,1,0 )
  522                ^^2^2^3161 027^
  523                "DATA",100 .007,9,1,1 ,0)
  524                This flag  will test  a patient  for his el igibility  for treatm ent at a V
  525                "DATA",100 .007,9,1,2 ,0)
  526                facility.
  527                "DATA",100 .007,9,2,0 )
  528                ^^4^4^3161 027^
  529                "DATA",100 .007,9,2,1 ,0)
  530                S:$$GET1^D IQ(2,DFN,. 152)']"" O RPOQUIT=1
  531                "DATA",100 .007,9,2,2 ,0)
  532                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  533                "DATA",100 .007,9,2,3 ,0)
  534                D TXT^ORPO 7GUI
  535                "DATA",100 .007,9,2,4 ,0)
  536                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  537                "DATA",100 .007,9,3,0 )
  538                ^^1^1^3161 027^
  539                "DATA",100 .007,9,3,1 ,0)
  540                *** Inelig ible Patie nt ***
  541                "DATA",100 .007,10,0)
  542                STATE VETE RANS HOME^ 1
  543                "DATA",100 .007,10,2, 0)
  544                ^^4^4^3140 225^
  545                "DATA",100 .007,10,2, 1,0)
  546                I $$FL^ORP O7GUI(DFN, "SVH")=0 S  ORPOQUIT= 1
  547                "DATA",100 .007,10,2, 2,0)
  548                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  549                "DATA",100 .007,10,2, 3,0)
  550                D TXT^ORPO 7GUI
  551                "DATA",100 .007,10,2, 4,0)
  552                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  553                "DATA",100 .007,10,3, 0)
  554                ^100.00703 ^3^3^31610 25^^^^
  555                "DATA",100 .007,10,3, 1,0)
  556                 *****  ST ATE VETERA NS HOME RE SIDENT  ** ***
  557                "DATA",100 .007,10,3, 2,0)
  558                 ***** To  contact th e State Ve t Home, ca ll 638-215 0 *****
  559                "DATA",100 .007,10,3, 3,0)
  560                 ***** Int ernal VA Q uestions,  call x1740  or x6901  *****
  561                "DATA",100 .007,11,0)
  562                FLAG 1^1
  563                "DATA",100 .007,11,1, 0)
  564                ^100.00701 ^1^1^31610 20^^
  565                "DATA",100 .007,11,1, 1,0)
  566                This is a  descriptio n for flag  1.
  567                "DATA",100 .007,11,2, 0)
  568                ^100.00702 ^4^4^31610 20^^^
  569                "DATA",100 .007,11,2, 1,0)
  570                I $$FL^ORP O7GUI(DFN, "FLAG 1")= 0 S ORPOQU IT=1
  571                "DATA",100 .007,11,2, 2,0)
  572                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  573                "DATA",100 .007,11,2, 3,0)
  574                D TXT^ORPO 7GUI
  575                "DATA",100 .007,11,2, 4,0)
  576                D INC^ORPO 7GUI
  577                "DATA",100 .007,11,3, 0)
  578                ^100.00703 ^3^3^31611 16^^
  579                "DATA",100 .007,11,3, 1,0)
  580                 *****  FL AG 1  **** *
  581                "DATA",100 .007,11,3, 2,0)
  582                 *****  YO U CAN CHAN GE THIS FO R YOUR NEE DS *****
  583                "DATA",100 .007,11,3, 3,0)
  584                This messa ge is for  3 patients .
  585                "DATA",100 .007,12,0)
  586                FLAG 2^1
  587                "DATA",100 .007,12,2, 0)
  588                ^^4^4^3140 225^
  589                "DATA",100 .007,12,2, 1,0)
  590                I $$FL^ORP O7GUI(DFN, "FLAG 2")= 0 S ORPOQU IT=1
  591                "DATA",100 .007,12,2, 2,0)
  592                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  593                "DATA",100 .007,12,2, 3,0)
  594                D TXT^ORPO 7GUI
  595                "DATA",100 .007,12,2, 4,0)
  596                D INC^ORPO 7GUI
  597                "DATA",100 .007,12,3, 0)
  598                ^100.00703 ^2^2^31610 31^^^^
  599                "DATA",100 .007,12,3, 1,0)
  600                *****  FLA G 2  *****
  601                "DATA",100 .007,12,3, 2,0)
  602                *****  YOU  CAN CHANG E THIS FOR  YOUR NEED S *****
  603                "DATA",100 .007,13,0)
  604                CMI^0
  605                "DATA",100 .007,13,1, 0)
  606                ^^1^1^3140 305^
  607                "DATA",100 .007,13,1, 1,0)
  608                Requires f ile: AXVCM I MH PATIE NT (190050 )
  609                "DATA",100 .007,13,2, 0)
  610                ^^9^9^3140 225^
  611                "DATA",100 .007,13,2, 1,0)
  612                D INC^ORPO 7GUI
  613                "DATA",100 .007,13,2, 2,0)
  614                S ORPOFY=$ $GFY^ORPO7 GUI(DT)
  615                "DATA",100 .007,13,2, 3,0)
  616                S:$$GET1^D IQ(2,DFN,. 351,"I")]" " ORPOQUIT =1 ;SCREEN  OUT DEAD  PATIENTS
  617                "DATA",100 .007,13,2, 4,0)
  618                S:'$D(^DIZ (190050,"D ",ORPOFY," N",DFN)) O RPOQUIT=1  ;NOT CMI
  619                "DATA",100 .007,13,2, 5,0)
  620                S ORPOI=$O (^DIZ(1900 50,"D",ORP OFY,"N",DF N,0))
  621                "DATA",100 .007,13,2, 6,0)
  622                S ORPOIND= $P(^DIZ(19 0050,DFN,1 ,ORPOI,0), U,4)
  623                "DATA",100 .007,13,2, 7,0)
  624                S ORPOGP=$ P(^DIZ(190 050,DFN,1, ORPOI,0),U ,5)
  625                "DATA",100 .007,13,2, 8,0)
  626                D TXT^ORPO 7GUI
  627                "DATA",100 .007,13,2, 9,0)
  628                K ORPOFY,O RPOI,ORPOI ND,ORPOGP
  629                "DATA",100 .007,13,3, 0)
  630                ^^4^4^3140 225^
  631                "DATA",100 .007,13,3, 1,0)
  632                                ****  Patient is  VERA CMI  ****
  633                "DATA",100 .007,13,3, 2,0)
  634                 Needs 6 I ndividual  visits or  11 group v isits
  635                "DATA",100 .007,13,3, 3,0)
  636                                       The patie nt now has :
  637                "DATA",100 .007,13,3, 4,0)
  638                             |ORPOIND | Indiv an d |ORPOGP|  Grp visit
  639                "DATA",100 .007,14,0)
  640                MDRO^0
  641                "DATA",100 .007,14,2, 0)
  642                ^^6^6^3140 225^
  643                "DATA",100 .007,14,2, 1,0)
  644                S ORPOMDRO =$$EN^ORPO ORMDRO(DFN )
  645                "DATA",100 .007,14,2, 2,0)
  646                S:ORPOMDRO =0 ORPOQUI T=1
  647                "DATA",100 .007,14,2, 3,0)
  648                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  649                "DATA",100 .007,14,2, 4,0)
  650                D TXT^ORPO 7GUI
  651                "DATA",100 .007,14,2, 5,0)
  652                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  653                "DATA",100 .007,14,2, 6,0)
  654                K ORPOMDRO  S ORPOQUI T=1
  655                "DATA",100 .007,14,3, 0)
  656                ^100.00703 ^1^1^31610 20^^
  657                "DATA",100 .007,14,3, 1,0)
  658                 **** MDRO  PRECAUTIO NS ****
  659                "DATA",100 .007,15,0)
  660                CHF^0
  661                "DATA",100 .007,15,2, 0)
  662                ^^5^5^3140 225^
  663                "DATA",100 .007,15,2, 1,0)
  664                I $$EN^ORP OORCHF(DFN )=0 S ORPO QUIT=1
  665                "DATA",100 .007,15,2, 2,0)
  666                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  667                "DATA",100 .007,15,2, 3,0)
  668                D TXT^ORPO 7GUI
  669                "DATA",100 .007,15,2, 4,0)
  670                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  671                "DATA",100 .007,15,2, 5,0)
  672                S ORPOQUIT =1 
  673                "DATA",100 .007,15,3, 0)
  674                ^100.00703 ^1^1^31610 20^^
  675                "DATA",100 .007,15,3, 1,0)
  676                 DISCHARGE  CHF WITHI N 30 DAYS
  677                "DATA",100 .007,16,0)
  678                FLAGPOP^1
  679                "DATA",100 .007,16,1, 0)
  680                ^100.00701 ^1^1^31611 09^^^
  681                "DATA",100 .007,16,1, 1,0)
  682                This is a  new POPUP  FLAG FOR T EST
  683                "DATA",100 .007,16,2, 0)
  684                ^^4^4^3161 109^
  685                "DATA",100 .007,16,2, 1,0)
  686                I $$FL^ORP O7GUI(DFN, "FLAGPOP") =0 S ORPOQ UIT=1
  687                "DATA",100 .007,16,2, 2,0)
  688                D INC^ORPO 7GUI,NULL^ ORPO7GUI,I NC^ORPO7GU I
  689                "DATA",100 .007,16,2, 3,0)
  690                D TXT^ORPO 7GUI
  691                "DATA",100 .007,16,2, 4,0)
  692                D INC^ORPO 7GUI
  693                "DATA",100 .007,16,3, 0)
  694                ^100.00703 ^1^1^31611 09^^^
  695                "DATA",100 .007,16,3, 1,0)
  696                You are se eing a fla g for a sp ecific pat ient.
  697                "DATA",100 .007,17,0)
  698                FLAGALL^0
  699                "DATA",100 .007,17,1, 0)
  700                ^100.00701 ^1^1^31611 09^^
  701                "DATA",100 .007,17,1, 1,0)
  702                This is a  flag to be  displayed  for ALL p atients.
  703                "DATA",100 .007,17,2, 0)
  704                ^100.00702 ^3^3^31611 09^^
  705                "DATA",100 .007,17,2, 1,0)
  706                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  707                "DATA",100 .007,17,2, 2,0)
  708                D TXT^ORPO 7GUI
  709                "DATA",100 .007,17,2, 3,0)
  710                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  711                "DATA",100 .007,17,3, 0)
  712                ^100.00703 ^1^1^31611 09^^
  713                "DATA",100 .007,17,3, 1,0)
  714                This text  should pri nt for all  patients  in CPRS.
  715                "DATA",100 .007,18,0)
  716                FLDBALL^1
  717                "DATA",100 .007,18,1, 0)
  718                ^100.00701 ^1^1^31611 16^^
  719                "DATA",100 .007,18,1, 1,0)
  720                We are add ing a new  flag for g lobal disp lay.
  721                "DATA",100 .007,18,2, 0)
  722                ^100.00702 ^3^3^31611 16^^
  723                "DATA",100 .007,18,2, 1,0)
  724                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  725                "DATA",100 .007,18,2, 2,0)
  726                D TXT^ORPO 7GUI
  727                "DATA",100 .007,18,2, 3,0)
  728                D INC^ORPO 7GUI,NULL^ ORPO7GUI
  729                "DATA",100 .007,18,3, 0)
  730                ^^2^2^3161 116^
  731                "DATA",100 .007,18,3, 1,0)
  732                We are LOW  on Type O + blood.
  733                "DATA",100 .007,18,3, 2,0)
  734                We are get ting low o n Type A a lso.
  735                "DATA",100 .0072,1,0)
  736                FLAG 1
  737                "DATA",100 .0072,1,1)
  738                Flag to be  used in C PRS as Fla g 1.
  739                "DATA",100 .0072,2,0)
  740                FLAG 2
  741                "DATA",100 .0072,2,1)
  742                FLAG TWO
  743                "DATA",100 .0072,3,0)
  744                SVH
  745                "DATA",100 .0072,3,1)
  746                STATE VETE RANS HOME
  747                "DATA",100 .0072,4,0)
  748                FLAGPOP
  749                "DATA",100 .0072,4,1)
  750                New POPUP  FLAG for a ll patient s
  751                "FIA",100. 007)
  752                ORPU POPUP  XECUTEABL E CODE
  753                "FIA",100. 007,0)
  754                ^OR(100.00 7,
  755                "FIA",100. 007,0,0)
  756                100.007
  757                "FIA",100. 007,0,1)
  758                y^y^f^^n^^ y^o^y
  759                "FIA",100. 007,0,10)
  760                 
  761                "FIA",100. 007,0,11)
  762                 
  763                "FIA",100. 007,0,"RLR O")
  764                 
  765                "FIA",100. 007,0,"VR" )
  766                3.0^OR
  767                "FIA",100. 007,100.00 7)
  768                0
  769                "FIA",100. 007,100.00 701)
  770                0
  771                "FIA",100. 007,100.00 702)
  772                0
  773                "FIA",100. 007,100.00 703)
  774                0
  775                "FIA",100. 0071)
  776                ORPU POPUP  PATIENT F LAG
  777                "FIA",100. 0071,0)
  778                ^OR(100.00 71,
  779                "FIA",100. 0071,0,0)
  780                100.0071
  781                "FIA",100. 0071,0,1)
  782                y^y^f^^^^n
  783                "FIA",100. 0071,0,10)
  784                 
  785                "FIA",100. 0071,0,11)
  786                 
  787                "FIA",100. 0071,0,"RL RO")
  788                 
  789                "FIA",100. 0071,0,"VR ")
  790                3.0^OR
  791                "FIA",100. 0071,100.0 071)
  792                0
  793                "FIA",100. 0071,100.0 0711)
  794                0
  795                "FIA",100. 0071,100.0 0712)
  796                0
  797                "FIA",100. 0072)
  798                ORPU POPUP  FLAG
  799                "FIA",100. 0072,0)
  800                ^OR(100.00 72,
  801                "FIA",100. 0072,0,0)
  802                100.0072
  803                "FIA",100. 0072,0,1)
  804                y^y^f^^n^^ y^m^n
  805                "FIA",100. 0072,0,10)
  806                 
  807                "FIA",100. 0072,0,11)
  808                 
  809                "FIA",100. 0072,0,"RL RO")
  810                 
  811                "FIA",100. 0072,0,"VR ")
  812                3.0^OR
  813                "FIA",100. 0072,100.0 072)
  814                0
  815                "FIA",100. 0073)
  816                ORPU POPUP  LOCAL NOT ICE
  817                "FIA",100. 0073,0)
  818                ^OR(100.00 73,
  819                "FIA",100. 0073,0,0)
  820                100.0073
  821                "FIA",100. 0073,0,1)
  822                y^y^f^^^^n
  823                "FIA",100. 0073,0,10)
  824                 
  825                "FIA",100. 0073,0,11)
  826                 
  827                "FIA",100. 0073,0,"RL RO")
  828                 
  829                "FIA",100. 0073,0,"VR ")
  830                3.0^OR
  831                "FIA",100. 0073,100.0 073)
  832                0
  833                "FIA",100. 0074)
  834                ORPU POPUP  VESTING
  835                "FIA",100. 0074,0)
  836                ^OR(100.00 74,
  837                "FIA",100. 0074,0,0)
  838                100.0074V
  839                "FIA",100. 0074,0,1)
  840                y^y^f^^^^n ^^
  841                "FIA",100. 0074,0,10)
  842                 
  843                "FIA",100. 0074,0,11)
  844                 
  845                "FIA",100. 0074,0,"RL RO")
  846                 
  847                "FIA",100. 0074,0,"VR ")
  848                3.0^OR
  849                "FIA",100. 0074,100.0 074)
  850                0
  851                "FIA",200)
  852                NEW PERSON
  853                "FIA",200, 0)
  854                ^VA(200,
  855                "FIA",200, 0,0)
  856                200Is
  857                "FIA",200, 0,1)
  858                y^y^p^^^^n ^^n
  859                "FIA",200, 0,10)
  860                 
  861                "FIA",200, 0,11)
  862                 
  863                "FIA",200, 0,"RLRO")
  864                 
  865                "FIA",200, 0,"VR")
  866                3.0^OR
  867                "FIA",200, 200)
  868                1
  869                "FIA",200, 200,9500)
  870                 
  871                "FIA",200, 200.08)
  872                1
  873                "FIA",200, 200.08,.01 )
  874                 
  875                "INIT")
  876                POST^ORCP0 31
  877                "KRN",.402 ,2830,-1)
  878                0^3
  879                "KRN",.402 ,2830,0)
  880                ORPU EDIT  TEMP ADDRE SS^3120118 .1358^@^2^ ^@^3161116
  881                "KRN",.402 ,2830,"DR" ,1,2)
  882                .12105;.12 17;.1218;. 1211;.1214 ;.1215;.12 16;.1219;. 12111;
  883                "KRN",.402 ,2832,-1)
  884                0^5
  885                "KRN",.402 ,2832,0)
  886                ORPU EDIT  VESTING^31 40821.1307 ^@^100.007 4^^@^31611 16
  887                "KRN",.402 ,2832,"DR" ,1,100.007 4)
  888                S DLAYGO=1 00.0074;.0 1;
  889                "KRN",.402 ,2833,-1)
  890                0^6
  891                "KRN",.402 ,2833,0)
  892                ORPU POPUP  PATIENT E DIT^314020 6.0818^@^1 00.0071^^@ ^3161116
  893                "KRN",.402 ,2833,"DIA B",1,0,100 .0071,0)
  894                ALL
  895                "KRN",.402 ,2833,"DR" ,1,100.007 1)
  896                .01:2
  897                "KRN",.402 ,2833,"DR" ,2,100100. 711)
  898                .01:1
  899                "KRN",.402 ,2833,"DR" ,2,100100. 712)
  900                .01
  901                "KRN",.402 ,2833,"DR" ,3,100100. 7111)
  902                .01
  903                "KRN",.402 ,2836,-1)
  904                0^2
  905                "KRN",.402 ,2836,0)
  906                ORPU EDIT  POPUP FLAG ^3120118.1 205^@^100. 0072^^@^31 61109
  907                "KRN",.402 ,2836,"DIA B",1,0,100 .0072,0)
  908                ALL
  909                "KRN",.402 ,2836,"DR" ,1,100.007 2)
  910                .01:2
  911                "KRN",.402 ,2837,-1)
  912                0^1
  913                "KRN",.402 ,2837,0)
  914                ORPU EDIT  LOCAL NOTI CE^3131217 .1455^@^10 0.0073^^@^ 3161116
  915                "KRN",.402 ,2837,"DIA B",1,0,100 .0073,0)
  916                ALL
  917                "KRN",.402 ,2837,"DR" ,1,100.007 3)
  918                .01:1
  919                "KRN",.402 ,2841,-1)
  920                0^4
  921                "KRN",.402 ,2841,0)
  922                ORPU EDIT  TEXT^31403 03.1416^@^ 100.007^^@ ^3161116
  923                "KRN",.402 ,2841,"DR" ,1,100.007 )
  924                1;11;
  925                "KRN",19,2 921809,-1)
  926                0^2
  927                "KRN",19,2 921809,0)
  928                OR PCE DEF AULT LOCAT ION^Defaul t Encounte r Location s^^R^^^^^^ ^^^^
  929                "KRN",19,2 921809,1,0 )
  930                ^^7^7^3160 907^
  931                "KRN",19,2 921809,1,1 ,0)
  932                This optio n is used  to enter D EFAULT ENO UNTER LOCA TIONS for  selection  in 
  933                "KRN",19,2 921809,1,2 ,0)
  934                the Encoun ter Windox  bos in CP RS.  Entri es in this  option wi ll filter  to 
  935                "KRN",19,2 921809,1,3 ,0)
  936                the top of  the selec tion box i n order to  eliinate  the need f or searchi ng 
  937                "KRN",19,2 921809,1,4 ,0)
  938                through th e list of  possible e ncounter l ocations.   VistA sof tware will  
  939                "KRN",19,2 921809,1,5 ,0)
  940                select the  locations  entered h ere, along  with defa ults from  the 
  941                "KRN",19,2 921809,1,6 ,0)
  942                day-of-wee k clinics  KERNEL Sys tem Parame ter, TIU c linic defa ults, and  TIU
  943                "KRN",19,2 921809,1,7 ,0)
  944                day-of-wee k clinic d efaults.
  945                "KRN",19,2 921809,20)
  946                 
  947                "KRN",19,2 921809,25)
  948                PARAM^ORCL OC
  949                "KRN",19,2 921809,99. 1)
  950                63057,3803 3
  951                "KRN",19,2 921809,"U" )
  952                DEFAULT EN COUNTER LO CATIONS
  953                "KRN",19,2 921810,-1)
  954                0^1
  955                "KRN",19,2 921810,0)
  956                OR PCE DEF AULT LOC A DMIN^Defau lt Locatio ns Adminis tration^^R ^^^^^^^^^^
  957                "KRN",19,2 921810,1,0 )
  958                ^^5^5^3160 912^
  959                "KRN",19,2 921810,1,1 ,0)
  960                Option to  allow entr y of Defau lt Locatio ns for ind ividual ot her than 
  961                "KRN",19,2 921810,1,2 ,0)
  962                yourself.   The corre sponding o ption OR P CE DEFAULT  LOCATION  will alllo
  963                "KRN",19,2 921810,1,3 ,0)
  964                the update  of defaul t location s for a si ngle user;  whereas,  this optio
  965                "KRN",19,2 921810,1,4 ,0)
  966                allows the  user to b e prompted  for the e ntry from  the NEW PE RSON (#200
  967                "KRN",19,2 921810,1,5 ,0)
  968                file they  wish to ad just.
  969                "KRN",19,2 921810,20)
  970                 
  971                "KRN",19,2 921810,25)
  972                OTHER^ORCL OC
  973                "KRN",19,2 921810,99. 1)
  974                59841,5298 3
  975                "KRN",19,2 921810,"U" )
  976                DEFAULT LO CATIONS AD MINISTRATI
  977                "KRN",19,2 921825,-1)
  978                0^8
  979                "KRN",19,2 921825,0)
  980                ORPU MAIN  MENU^POPUP  FLAG MAIN  MENU^^M^^ ^^^^^^
  981                "KRN",19,2 921825,1,0 )
  982                ^19.06^2^2 ^3161114^^ ^^
  983                "KRN",19,2 921825,1,1 ,0)
  984                This edits  the vario us flag pa rameters f or pop up  messages w hen using 
  985                "KRN",19,2 921825,1,2 ,0)
  986                CPRS.
  987                "KRN",19,2 921825,10, 0)
  988                ^19.01IP^8 ^8
  989                "KRN",19,2 921825,10, 2,0)
  990                2921836^FL AG^3
  991                "KRN",19,2 921825,10, 2,"^")
  992                ORPU EDIT  POPUP FLAG
  993                "KRN",19,2 921825,10, 3,0)
  994                2921838^CO DE^4
  995                "KRN",19,2 921825,10, 3,"^")
  996                ORPU EDIT  POPUP TEXT
  997                "KRN",19,2 921825,10, 4,0)
  998                2921839^AD D^2
  999                "KRN",19,2 921825,10, 4,"^")
  1000                ORPU EDIT  TEMP ADDRE SS
  1001                "KRN",19,2 921825,10, 5,0)
  1002                2921835^LO C^5
  1003                "KRN",19,2 921825,10, 5,"^")
  1004                ORPU EDIT  LOCAL NOTI CE
  1005                "KRN",19,2 921825,10, 6,0)
  1006                2921840^VE ST
  1007                "KRN",19,2 921825,10, 6,"^")
  1008                ORPU EDIT  VESTING
  1009                "KRN",19,2 921825,10, 7,0)
  1010                2921841^PR T
  1011                "KRN",19,2 921825,10, 7,"^")
  1012                ORPU PRINT  VESTING C ODES
  1013                "KRN",19,2 921825,10, 8,0)
  1014                2921843^PA T^1
  1015                "KRN",19,2 921825,10, 8,"^")
  1016                ORPU EDIT  POPUP PATI ENT FLAG
  1017                "KRN",19,2 921825,99)
  1018                64191,4104 3
  1019                "KRN",19,2 921825,99. 1)
  1020                62699,5101 9
  1021                "KRN",19,2 921825,"U" )
  1022                POPUP FLAG  MAIN MENU
  1023                "KRN",19,2 921835,-1)
  1024                0^3
  1025                "KRN",19,2 921835,0)
  1026                ORPU EDIT  LOCAL NOTI CE^EDIT LO CAL NOTICE ^^E^^^^^^^ ^
  1027                "KRN",19,2 921835,30)
  1028                OR(100.007 3,
  1029                "KRN",19,2 921835,31)
  1030                AEMQL
  1031                "KRN",19,2 921835,50)
  1032                OR(100.007 3,
  1033                "KRN",19,2 921835,51)
  1034                [ORPU EDIT  LOCAL NOT ICE]
  1035                "KRN",19,2 921835,"U" )
  1036                EDIT LOCAL  NOTICE
  1037                "KRN",19,2 921836,-1)
  1038                0^4
  1039                "KRN",19,2 921836,0)
  1040                ORPU EDIT  POPUP FLAG ^EDIT FLAG ^^E^^XUPRO G^^^^^^
  1041                "KRN",19,2 921836,30)
  1042                OR(100.007 2,
  1043                "KRN",19,2 921836,31)
  1044                AEMQL
  1045                "KRN",19,2 921836,50)
  1046                OR(100.007 2,
  1047                "KRN",19,2 921836,51)
  1048                [ORPU EDIT  POPUP FLA G]
  1049                "KRN",19,2 921836,"U" )
  1050                EDIT FLAG
  1051                "KRN",19,2 921838,-1)
  1052                0^6
  1053                "KRN",19,2 921838,0)
  1054                ORPU EDIT  POPUP TEXT ^CPRS Pop- Up Text Ed it^^E^^^^^ ^^^
  1055                "KRN",19,2 921838,1,0 )
  1056                ^19.06^2^2 ^3161003^^ ^^
  1057                "KRN",19,2 921838,1,1 ,0)
  1058                Allows edi ting of th e file tha t controls  the pop-u ps appeari ng when yo
  1059                "KRN",19,2 921838,1,2 ,0)
  1060                frist sele ct a patie nt in CPRS .
  1061                "KRN",19,2 921838,30)
  1062                OR(100.007 ,
  1063                "KRN",19,2 921838,31)
  1064                AEMQ
  1065                "KRN",19,2 921838,50)
  1066                OR(100.007 ,
  1067                "KRN",19,2 921838,51)
  1068                [ORPU EDIT  TEXT]
  1069                "KRN",19,2 921838,"U" )
  1070                CPRS POP-U P TEXT EDI T
  1071                "KRN",19,2 921839,-1)
  1072                0^7
  1073                "KRN",19,2 921839,0)
  1074                ORPU EDIT  TEMP ADDRE SS^EDIT TE MPORARY AD DRESS^^E^^ ^^^^^^
  1075                "KRN",19,2 921839,30)
  1076                DPT(
  1077                "KRN",19,2 921839,31)
  1078                AEMQ
  1079                "KRN",19,2 921839,50)
  1080                DPT(
  1081                "KRN",19,2 921839,51)
  1082                [ORPU EDIT  TEMP ADDR ESS]
  1083                "KRN",19,2 921839,"U" )
  1084                EDIT TEMPO RARY ADDRE SS
  1085                "KRN",19,2 921840,-1)
  1086                0^10
  1087                "KRN",19,2 921840,0)
  1088                ORPU EDIT  VESTING^ED IT CPRS PO PUP VESTIN G^^E^^^^^^ ^^
  1089                "KRN",19,2 921840,30)
  1090                OR(100.007 4,
  1091                "KRN",19,2 921840,31)
  1092                AEMQL
  1093                "KRN",19,2 921840,50)
  1094                OR(100.007 4,
  1095                "KRN",19,2 921840,51)
  1096                [ORPU EDIT  VESTING]
  1097                "KRN",19,2 921840,"U" )
  1098                EDIT CPRS  POPUP VEST ING
  1099                "KRN",19,2 921841,-1)
  1100                0^9
  1101                "KRN",19,2 921841,0)
  1102                ORPU PRINT  VESTING C ODES^PRINT  CPT AND P ROVIDER TY PE CODES F OR VESTING ^^R^^^^^^^ ^
  1103                "KRN",19,2 921841,25)
  1104                PRTV^ORPOV ST
  1105                "KRN",19,2 921841,"U" )
  1106                PRINT CPT  AND PROVID ER TYPE CO
  1107                "KRN",19,2 921843,-1)
  1108                0^5
  1109                "KRN",19,2 921843,0)
  1110                ORPU EDIT  POPUP PATI ENT FLAG^E DIT POPUP  PATIENT FL AG^^E^^^^^ ^^^
  1111                "KRN",19,2 921843,30)
  1112                OR(100.007 1,
  1113                "KRN",19,2 921843,31)
  1114                AEMQL
  1115                "KRN",19,2 921843,50)
  1116                OR(100.007 1,
  1117                "KRN",19,2 921843,51)
  1118                [ORPU POPU P PATIENT  EDIT]
  1119                "KRN",19,2 921843,99. 1)
  1120                62469,4882 7
  1121                "KRN",19,2 921843,"U" )
  1122                EDIT POPUP  PATIENT F LAG
  1123                "MBREQ")
  1124                0
  1125                "ORD",7,.4 02)
  1126                .402;7;;;E DEOUT^DIFR OMSO(.402, DA,"",XPDA );FPRE^DIF ROMSI(.402 ,"",XPDA); EPRE^DIFRO MSI(.402,D A,$E("N",$ G(XPDNEW)) ,XPDA,"",O LDA);;EPOS T^DIFROMSI (.402,DA," ",XPDA);DE L^DIFROMSK (.402,"",% )
  1127                "ORD",7,.4 02,0)
  1128                INPUT TEMP LATE
  1129                "ORD",18,1 9)
  1130                19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
  1131                "ORD",18,1 9,0)
  1132                OPTION
  1133                "PKG",188, -1)
  1134                1^1
  1135                "PKG",188, 0)
  1136                ORDER ENTR Y/RESULTS  REPORTING^ OR^Order E ntry/Resul ts Reporti ng
  1137                "PKG",188, 20,0)
  1138                ^9.402P^^
  1139                "PKG",188, 22,0)
  1140                ^9.49I^1^1
  1141                "PKG",188, 22,1,0)
  1142                3.0^297121 7^2981113^ 1
  1143                "PKG",188, 22,1,"PAH" ,1,0)
  1144                431^316111 7
  1145                "QUES","XP F1",0)
  1146                Y
  1147                "QUES","XP F1","??")
  1148                ^D REP^XPD H
  1149                "QUES","XP F1","A")
  1150                Shall I wr ite over y our |FLAG|  File
  1151                "QUES","XP F1","B")
  1152                YES
  1153                "QUES","XP F1","M")
  1154                D XPF1^XPD IQ
  1155                "QUES","XP F2",0)
  1156                Y
  1157                "QUES","XP F2","??")
  1158                ^D DTA^XPD H
  1159                "QUES","XP F2","A")
  1160                Want my da ta |FLAG|  yours
  1161                "QUES","XP F2","B")
  1162                YES
  1163                "QUES","XP F2","M")
  1164                D XPF2^XPD IQ
  1165                "QUES","XP I1",0)
  1166                YO
  1167                "QUES","XP I1","??")
  1168                ^D INHIBIT ^XPDH
  1169                "QUES","XP I1","A")
  1170                Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  1171                "QUES","XP I1","B")
  1172                NO
  1173                "QUES","XP I1","M")
  1174                D XPI1^XPD IQ
  1175                "QUES","XP M1",0)
  1176                PO^VA(200, :EM
  1177                "QUES","XP M1","??")
  1178                ^D MG^XPDH
  1179                "QUES","XP M1","A")
  1180                Enter the  Coordinato r for Mail  Group '|F LAG|'
  1181                "QUES","XP M1","B")
  1182                 
  1183                "QUES","XP M1","M")
  1184                D XPM1^XPD IQ
  1185                "QUES","XP O1",0)
  1186                Y
  1187                "QUES","XP O1","??")
  1188                ^D MENU^XP DH
  1189                "QUES","XP O1","A")
  1190                Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  1191                "QUES","XP O1","B")
  1192                NO
  1193                "QUES","XP O1","M")
  1194                D XPO1^XPD IQ
  1195                "QUES","XP Z1",0)
  1196                Y
  1197                "QUES","XP Z1","??")
  1198                ^D OPT^XPD H
  1199                "QUES","XP Z1","A")
  1200                Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  1201                "QUES","XP Z1","B")
  1202                NO
  1203                "QUES","XP Z1","M")
  1204                D XPZ1^XPD IQ
  1205                "QUES","XP Z2",0)
  1206                Y
  1207                "QUES","XP Z2","??")
  1208                ^D RTN^XPD H
  1209                "QUES","XP Z2","A")
  1210                Want to MO VE routine s to other  CPUs
  1211                "QUES","XP Z2","B")
  1212                NO
  1213                "QUES","XP Z2","M")
  1214                D XPZ2^XPD IQ
  1215                "RTN")
  1216                12
  1217                "RTN","ORC LOC")
  1218                0^10^B1767 3208^n/a
  1219                "RTN","ORC LOC",1,0)
  1220                ORCLOC ;SL C/GRE - Ge neral Util ities for  Windows Ca lls ; 10 N ov 2016  9 :40 AM
  1221                "RTN","ORC LOC",2,0)
  1222                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;Aug 7 , 2002;Bui ld 30
  1223                "RTN","ORC LOC",3,0)
  1224                 Q
  1225                "RTN","ORC LOC",4,0)
  1226                 ;
  1227                "RTN","ORC LOC",5,0)
  1228                NEWLOC(Y,O RFROM,DIR, ORCTYP) ;  Return "CZ " location s from HOS PITAL LOCA TION file.
  1229                "RTN","ORC LOC",6,0)
  1230                 ; C=Clini cs, W=Ward s, Z=Other , screened  by $$ACTL OC^ORWU.
  1231                "RTN","ORC LOC",7,0)
  1232                 ; .Y=retu rned list,  ORFROM=te xt to $O f rom, DIR=$ O directio n.
  1233                "RTN","ORC LOC",8,0)
  1234                 N %Y,ORC, ORCI,ORCIE N,ORCDUP S  ORCI=0
  1235                "RTN","ORC LOC",9,0)
  1236                 D  ; ONCE  FOR PERSO NAL LIST
  1237                "RTN","ORC LOC",10,0)
  1238                 .Q:ORFROM '=""
  1239                "RTN","ORC LOC",11,0)
  1240                 .N ORCIEN ,ORCCNT S  ORCCNT=44
  1241                "RTN","ORC LOC",12,0)
  1242                 . S ORC=0  F  S ORC= $O(^VA(200 ,DUZ,"DELO C",ORC)) Q :'+ORC!(OR C'<ORCCNT)   D
  1243                "RTN","ORC LOC",13,0)
  1244                 . . S ORC IEN=$P($G( ^VA(200,DU Z,"DELOC", ORC,0)),"^ ",1) Q:'OR CIEN
  1245                "RTN","ORC LOC",14,0)
  1246                 . . Q:("C WZ"'[$$GET 1^DIQ(44,O RCIEN,2,"I ")!('$$ACT LOC^ORWU(O RCIEN)))
  1247                "RTN","ORC LOC",15,0)
  1248                 . . S ORC I=ORCI+1,Y (ORCI)=ORC IEN_"^ "_$ $GET1^DIQ( 44,ORCIEN, .01)
  1249                "RTN","ORC LOC",16,0)
  1250                 . . S ORC DUP(ORCIEN )=""
  1251                "RTN","ORC LOC",17,0)
  1252                 D  ; DAY- OF-WEEK CL INIC
  1253                "RTN","ORC LOC",18,0)
  1254                 .Q:ORFROM '=""
  1255                "RTN","ORC LOC",19,0)
  1256                 . N ORCEN T,ORCPAR,X ,ORCDOW,OR CDOWC
  1257                "RTN","ORC LOC",20,0)
  1258                 . S ORCEN T="USR.`"_ DUZ
  1259                "RTN","ORC LOC",21,0)
  1260                 . S X=DT  D DW^%DTC  S ORCDOW=X
  1261                "RTN","ORC LOC",22,0)
  1262                 . S ORCPA R="ORLP DE FAULT CLIN IC "_ORCDO W
  1263                "RTN","ORC LOC",23,0)
  1264                 . S ORCDO WC=$$GET^X PAR(ORCENT ,ORCPAR)
  1265                "RTN","ORC LOC",24,0)
  1266                 . I +ORCD OWC D  ;
  1267                "RTN","ORC LOC",25,0)
  1268                 .. Q:("CW Z"'[$$GET1 ^DIQ(44,OR CDOWC,2,"I ")!('$$ACT LOC^ORWU(O RCDOWC)))
  1269                "RTN","ORC LOC",26,0)
  1270                 .. Q:$D(O RCDUP(ORCD OWC))
  1271                "RTN","ORC LOC",27,0)
  1272                 .. S ORCD UP(ORCDOWC )=""
  1273                "RTN","ORC LOC",28,0)
  1274                 .. S ORCI =ORCI+1,Y( ORCI)=ORCD OWC_"^ "_$ $GET1^DIQ( 44,ORCDOWC ,.01)
  1275                "RTN","ORC LOC",29,0)
  1276                 D  ;TIU P REFERENCES  DEFAULT L OCATION
  1277                "RTN","ORC LOC",30,0)
  1278                 . Q:ORFRO M'=""
  1279                "RTN","ORC LOC",31,0)
  1280                 . N ORCTI U1,ORCTIU2
  1281                "RTN","ORC LOC",32,0)
  1282                 . Q:'$D(^ TIU(8926," B",DUZ))
  1283                "RTN","ORC LOC",33,0)
  1284                 . S ORCTI U1=$O(^TIU (8926,"B", DUZ,0)) Q: '+ORCTIU1
  1285                "RTN","ORC LOC",34,0)
  1286                 . S ORCTI U2=$$GET1^ DIQ(8926,O RCTIU1,.02 ,"I") Q:'+ ORCTIU2
  1287                "RTN","ORC LOC",35,0)
  1288                 . Q:("CWZ "'[$$GET1^ DIQ(44,ORC TIU2,2,"I" )!('$$ACTL OC^ORWU(OR CTIU2)))
  1289                "RTN","ORC LOC",36,0)
  1290                 . Q:$D(OR CDUP(ORCTI U2))
  1291                "RTN","ORC LOC",37,0)
  1292                 . S ORCDU P(ORCTIU2) =""
  1293                "RTN","ORC LOC",38,0)
  1294                 . S ORCI= ORCI+1,Y(O RCI)=ORCTI U2_"^ "_$$ GET1^DIQ(4 4,ORCTIU2, .01)
  1295                "RTN","ORC LOC",39,0)
  1296                 D  ;TIU D AY OF WEEK  LOCATION
  1297                "RTN","ORC LOC",40,0)
  1298                 . Q:ORFRO M'=""
  1299                "RTN","ORC LOC",41,0)
  1300                 . N ORCTI U1,ORCTIU2 ,ORCTIU3,O RCDOW,X
  1301                "RTN","ORC LOC",42,0)
  1302                 . S X=DT  D H^%DTC S  ORCDOW=%Y +1
  1303                "RTN","ORC LOC",43,0)
  1304                 . Q:'$D(^ TIU(8926," B",DUZ))
  1305                "RTN","ORC LOC",44,0)
  1306                 . S ORCTI U1=$O(^TIU (8926,"B", DUZ,0)) Q: '+ORCTIU1
  1307                "RTN","ORC LOC",45,0)
  1308                 . Q:'$D(^ TIU(8926,O RCTIU1,1," B",ORCDOW) )
  1309                "RTN","ORC LOC",46,0)
  1310                 . S ORCTI U2=$O(^TIU (8926,ORCT IU1,1,"B", ORCDOW,0))  Q:'+ORCTI U2
  1311                "RTN","ORC LOC",47,0)
  1312                 . S ORCTI U3=$P(^TIU (8926,ORCT IU1,1,ORCT IU2,0),"^" ,2) Q:'+OR CTIU3
  1313                "RTN","ORC LOC",48,0)
  1314                 . Q:("CWZ "'[$$GET1^ DIQ(44,ORC TIU3,2,"I" )!('$$ACTL OC^ORWU(OR CTIU3)))
  1315                "RTN","ORC LOC",49,0)
  1316                 . Q:$D(OR CDUP(ORCTI U3))
  1317                "RTN","ORC LOC",50,0)
  1318                 . S ORCDU P(ORCTIU3) =""
  1319                "RTN","ORC LOC",51,0)
  1320                 . S ORCI= ORCI+1,Y(O RCI)=ORCTI U3_"^ "_$$ GET1^DIQ(4 4,ORCTIU3, .01)
  1321                "RTN","ORC LOC",52,0)
  1322                 D  ;Re-so rt into al phabetical  order
  1323                "RTN","ORC LOC",53,0)
  1324                 . N ORCJ, ORCDFE,ORC HOLD,ORCDF EIEN,ORCDF ENAME,ORCJ 2
  1325                "RTN","ORC LOC",54,0)
  1326                 . S ORCJ= 0 F  S ORC J=$O(Y(ORC J)) Q:'+OR CJ  D
  1327                "RTN","ORC LOC",55,0)
  1328                 .. S ORCD FE=$G(Y(OR CJ)),ORCDF EIEN=$P(OR CDFE,U),OR CDFENAME=$ P(ORCDFE,U ,2)
  1329                "RTN","ORC LOC",56,0)
  1330                 .. S ORCH OLD(ORCDFE NAME,ORCJ, ORCDFEIEN) =""
  1331                "RTN","ORC LOC",57,0)
  1332                 . S ORCJ2 =0
  1333                "RTN","ORC LOC",58,0)
  1334                 . S ORCDF ENAME="" F   S ORCDFE NAME=$O(OR CHOLD(ORCD FENAME)) Q :ORCDFENAM E']""  D
  1335                "RTN","ORC LOC",59,0)
  1336                 .. S ORCJ =0 F  S OR CJ=$O(ORCH OLD(ORCDFE NAME,ORCJ) ) Q:'+ORCJ   D
  1337                "RTN","ORC LOC",60,0)
  1338                 ... S ORC DFEIEN=0 F   S ORCDFE IEN=$O(ORC HOLD(ORCDF ENAME,ORCJ ,ORCDFEIEN )) Q:'+ORC DFEIEN  D
  1339                "RTN","ORC LOC",61,0)
  1340                 .... S OR CJ2=ORCJ2+ 1 S Y(ORCJ 2)=ORCDFEI EN_U_ORCDF ENAME
  1341                "RTN","ORC LOC",62,0)
  1342                 D  ; SECO ND TIME FO R REGULAR  LIST
  1343                "RTN","ORC LOC",63,0)
  1344                 .I $G(ORC TYP)']"" S  ORCTYP="C "
  1345                "RTN","ORC LOC",64,0)
  1346                 .N ORCIEN ,ORCCNT S  ORCCNT=44
  1347                "RTN","ORC LOC",65,0)
  1348                 .F  Q:ORC I'<ORCCNT   S ORFROM= $O(^SC("B" ,ORFROM),D IR) Q:ORFR OM=""  D
  1349                "RTN","ORC LOC",66,0)
  1350                 .. S ORCI EN="" F  S  ORCIEN=$O (^SC("B",O RFROM,ORCI EN),DIR) Q :'ORCIEN   D
  1351                "RTN","ORC LOC",67,0)
  1352                 ... Q:(OR CTYP'[$$GE T1^DIQ(44, ORCIEN,2," I")!('$$AC TLOC^ORWU( ORCIEN)))
  1353                "RTN","ORC LOC",68,0)
  1354                 ... S ORC I=ORCI+1,Y (ORCI)=ORC IEN_"^"_OR FROM
  1355                "RTN","ORC LOC",69,0)
  1356                 Q
  1357                "RTN","ORC LOC",70,0)
  1358                 ;
  1359                "RTN","ORC LOC",71,0)
  1360                FILEDIC(OR CDIC,ORCDI C0,ORCDICA ,ORCDICB)   ; Basic s hell for D IC lookups
  1361                "RTN","ORC LOC",72,0)
  1362                 N X,Y,DTO UT,DUOUT,D IC
  1363                "RTN","ORC LOC",73,0)
  1364                 S DIC=ORC DIC,DIC(0) =ORCDIC0 S :$G(ORCDIC A)]"" DIC( "A")=ORCDI CA S:$G(OR CDICB)]""  DIC("B")=O RCDICB
  1365                "RTN","ORC LOC",74,0)
  1366                 D ^DIC K  DIC
  1367                "RTN","ORC LOC",75,0)
  1368                 S:Y>0 ORC FILES=+Y
  1369                "RTN","ORC LOC",76,0)
  1370                 Q
  1371                "RTN","ORC LOC",77,0)
  1372                 ;
  1373                "RTN","ORC LOC",78,0)
  1374                PARAM N OR CDUZ S ORC DUZ=DUZ
  1375                "RTN","ORC LOC",79,0)
  1376                P2 N DIC,D IE,DR,DA,I LOC,ORC,OR CNONE
  1377                "RTN","ORC LOC",80,0)
  1378                 W @IOF
  1379                "RTN","ORC LOC",81,0)
  1380                 W !,"Now  setting pr eferences  for defaul t HOSPITAL  LOCATIONS  for:"
  1381                "RTN","ORC LOC",82,0)
  1382                 W !?5,"-- >  ",$$GET 1^DIQ(200, ORCDUZ,.01 )
  1383                "RTN","ORC LOC",83,0)
  1384                 W !,"Curr ently sele cted locat ions are:"
  1385                "RTN","ORC LOC",84,0)
  1386                 S ILOC=0  F  S ILOC= $O(^VA(200 ,ORCDUZ,"D ELOC",ILOC )) Q:'+ILO C  D
  1387                "RTN","ORC LOC",85,0)
  1388                 . S ORCLO C=$P(^VA(2 00,ORCDUZ, "DELOC",IL OC,0),"^")
  1389                "RTN","ORC LOC",86,0)
  1390                 . W !?5,$ $GET1^DIQ( 44,ORCLOC, .01)
  1391                "RTN","ORC LOC",87,0)
  1392                 . S ORCNO NE=1
  1393                "RTN","ORC LOC",88,0)
  1394                 I '$G(ORC NONE) W !? 5,"None se lected..."
  1395                "RTN","ORC LOC",89,0)
  1396                 W !
  1397                "RTN","ORC LOC",90,0)
  1398                P3 W !
  1399                "RTN","ORC LOC",91,0)
  1400                 S DIC="^V A(200,ORCD UZ,""DELOC "","
  1401                "RTN","ORC LOC",92,0)
  1402                 S DIC(0)= "AEMQL"
  1403                "RTN","ORC LOC",93,0)
  1404                 S (DIC(1) ,DA(1))=OR CDUZ
  1405                "RTN","ORC LOC",94,0)
  1406                 D ^DIC
  1407                "RTN","ORC LOC",95,0)
  1408                 Q:Y=-1
  1409                "RTN","ORC LOC",96,0)
  1410                 S DIE=DIC  K DIC
  1411                "RTN","ORC LOC",97,0)
  1412                 S DA(1)=O RCDUZ
  1413                "RTN","ORC LOC",98,0)
  1414                 S DA=+Y
  1415                "RTN","ORC LOC",99,0)
  1416                 S DR=.01
  1417                "RTN","ORC LOC",100,0 )
  1418                 D ^DIE
  1419                "RTN","ORC LOC",101,0 )
  1420                 K DIE,DR, DA,Y
  1421                "RTN","ORC LOC",102,0 )
  1422                 G P3
  1423                "RTN","ORC LOC",103,0 )
  1424                 ;
  1425                "RTN","ORC LOC",104,0 )
  1426                OTHER N OR CDUZ
  1427                "RTN","ORC LOC",105,0 )
  1428                 N DIC S D IC=200,DIC (0)="AEMQ"  D ^DIC K  DIC Q:+Y<1   S ORCDUZ =+Y
  1429                "RTN","ORC LOC",106,0 )
  1430                 D P2
  1431                "RTN","ORC LOC",107,0 )
  1432                 W !! G OT HER
  1433                "RTN","ORC LOC",108,0 )
  1434                OTHQU Q
  1435                "RTN","ORC LOC",109,0 )
  1436                 ;
  1437                "RTN","ORC P031")
  1438                0^^B311118 5^n/a
  1439                "RTN","ORC P031",1,0)
  1440                ORCP031 ;E PIP/WLC -  Patch 31 P ost-instal l; 12 Sep  2016 ; 15  Sep 2016   9:37 AM
  1441                "RTN","ORC P031",2,0)
  1442                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;Sep 1 2, 2016;Bu ild 30
  1443                "RTN","ORC P031",3,0)
  1444                 ;
  1445                "RTN","ORC P031",4,0)
  1446                 Q
  1447                "RTN","ORC P031",5,0)
  1448                 ;
  1449                "RTN","ORC P031",6,0)
  1450                POST ; --  post insta llation fo r OR*3.0*4 31
  1451                "RTN","ORC P031",7,0)
  1452                 D OPADD
  1453                "RTN","ORC P031",8,0)
  1454                 Q
  1455                "RTN","ORC P031",9,0)
  1456                 ;
  1457                "RTN","ORC P031",10,0 )
  1458                OPADD ; ad d OR PCE o ptions to  Menus in O PTION file  #19
  1459                "RTN","ORC P031",11,0 )
  1460                 D BMES^XP DUTL("Addi ng OR PCE  options to  menus in  OPTION fil e #19")
  1461                "RTN","ORC P031",12,0 )
  1462                 ;
  1463                "RTN","ORC P031",13,0 )
  1464                 N ORCOPT, ERR
  1465                "RTN","ORC P031",14,0 )
  1466                 S ORCOPT= $$FIND1^DI C(19,,"AMX ","OR PCE  DEFAULT LO CATION")
  1467                "RTN","ORC P031",15,0 )
  1468                 I ORCOPT  D
  1469                "RTN","ORC P031",16,0 )
  1470                 . N DA
  1471                "RTN","ORC P031",17,0 )
  1472                 . N FDA,I ENS,X,Y
  1473                "RTN","ORC P031",18,0 )
  1474                 . S X=$O( ^DIC(19,"B ","ORPO ME NU",0))
  1475                "RTN","ORC P031",19,0 )
  1476                 . I $D(^D IC(19,X,10 ,"B",ORCOP T)) Q
  1477                "RTN","ORC P031",20,0 )
  1478                 . S Y="?+ 1,"
  1479                "RTN","ORC P031",21,0 )
  1480                 . S IENS= X_","
  1481                "RTN","ORC P031",22,0 )
  1482                 . N REC S  REC=$P($G (^DIC(19,X ,10,0)),U, 3)+1
  1483                "RTN","ORC P031",23,0 )
  1484                 . S FDA(1 9.01,"+"_R EC_","_X_" ,",.01)=OR COPT
  1485                "RTN","ORC P031",24,0 )
  1486                 . S FDA(1 9.01,"+"_R EC_","_X_" ,",2)="DL"
  1487                "RTN","ORC P031",25,0 )
  1488                 . D UPDAT E^DIE(""," FDA",,.ERR )
  1489                "RTN","ORC P031",26,0 )
  1490                 . I $D(ER R) D BMES^ XPDUTL("Er ror in add ing to ORP O MENU")
  1491                "RTN","ORC P031",27,0 )
  1492                 K ORCOPT  ; Add entr y for Clin ical Coord inator
  1493                "RTN","ORC P031",28,0 )
  1494                 S ORCOPT= $$FIND1^DI C(19,,"AMX ","OR PCE  DEFAULT LO C ADMIN")
  1495                "RTN","ORC P031",29,0 )
  1496                 I ORCOPT  D
  1497                "RTN","ORC P031",30,0 )
  1498                 . N DA
  1499                "RTN","ORC P031",31,0 )
  1500                 . N FDA,I ENS,X,Y
  1501                "RTN","ORC P031",32,0 )
  1502                 . S X=$O( ^DIC(19,"B ","OR PARA M COORDINA TOR MENU", 0))
  1503                "RTN","ORC P031",33,0 )
  1504                 . I $D(^D IC(19,X,10 ,"B",ORCOP T)) Q
  1505                "RTN","ORC P031",34,0 )
  1506                 . S Y="?+ 1,"
  1507                "RTN","ORC P031",35,0 )
  1508                 . S IENS= X_","
  1509                "RTN","ORC P031",36,0 )
  1510                 . N REC S  REC=$P($G (^DIC(19,X ,10,0)),U, 3)+1
  1511                "RTN","ORC P031",37,0 )
  1512                 . S FDA(1 9.01,"+"_R EC_","_X_" ,",.01)=OR COPT
  1513                "RTN","ORC P031",38,0 )
  1514                 . S FDA(1 9.01,"+"_R EC_","_X_" ,",2)="DL"
  1515                "RTN","ORC P031",39,0 )
  1516                 . D UPDAT E^DIE(""," FDA",,.ERR )
  1517                "RTN","ORC P031",40,0 )
  1518                 . I $D(ER R) D BMES^ XPDUTL("Er ror in add ing to OR  PARAM COOR DINATOR ME NU")
  1519                "RTN","ORC P031",41,0 )
  1520                 Q
  1521                "RTN","ORC P031",42,0 )
  1522                 ;
  1523                "RTN","ORP O7GUI")
  1524                0^13^B7153 378^n/a
  1525                "RTN","ORP O7GUI",1,0 )
  1526                ORPO7GUI ; HINES/RMS,  REGION 1/ KLD/RMM -  CPRS CHART  FLAGGING  FOR GUI ;  6-1-01; 1/ 27/12  3:4 0 PM
  1527                "RTN","ORP O7GUI",2,0 )
  1528                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;7/30/ 2012;Build  30
  1529                "RTN","ORP O7GUI",3,0 )
  1530                 ;IA 10076  XUSEC
  1531                "RTN","ORP O7GUI",4,0 )
  1532                 ;IA 2324
  1533                "RTN","ORP O7GUI",5,0 )
  1534                 ;CHANGE T HE VALUE F OR THE ORW OR AUTO CL OSE PT MSG  (SYSTEM)  PARAMETER  TO ADJUST  THE LENGTH  OF TIME T HE WINDOW  IS OPEN 0= INDEFINITE
  1535                "RTN","ORP O7GUI",6,0 )
  1536                 ;called f rom ORPOPA GU,WHICH I S CALLED F ROM ORWPT
  1537                "RTN","ORP O7GUI",7,0 )
  1538                HXDATA(LST ,DFN) ;ENT RY POINT F ROM ORWPT
  1539                "RTN","ORP O7GUI",8,0 )
  1540                EN ;FORMER  ENTRY POI NT FROM A7 RDPAGU
  1541                "RTN","ORP O7GUI",9,0 )
  1542                 N ORPOTI, ORPOQUIT,I LST S ILST =0
  1543                "RTN","ORP O7GUI",10, 0)
  1544                 F ORPOTI( "I")=0:0 S  ORPOTI("I ")=$O(^OR( 100.007,OR POTI("I")) ) Q:'ORPOT I("I")  D
  1545                "RTN","ORP O7GUI",11, 0)
  1546                 .Q:$$GET1 ^DIQ(100.0 07,ORPOTI( "I"),1)'=" YES"  ;Act ive
  1547                "RTN","ORP O7GUI",12, 0)
  1548                 .K ORPOQU IT ;S ILST =0
  1549                "RTN","ORP O7GUI",13, 0)
  1550                 .F ORPOTI ("II")=0:0  S ORPOTI( "II")=$O(^ OR(100.007 ,ORPOTI("I "),2,ORPOT I("II")))  Q:'ORPOTI( "II")!($D( ORPOQUIT))   D
  1551                "RTN","ORP O7GUI",14, 0)
  1552                 ..X ^OR(1 00.007,ORP OTI("I"),2 ,ORPOTI("I I"),0)
  1553                "RTN","ORP O7GUI",15, 0)
  1554                 Q
  1555                "RTN","ORP O7GUI",16, 0)
  1556                 ;
  1557                "RTN","ORP O7GUI",17, 0)
  1558                INC S ILST =$G(ILST)+ 1
  1559                "RTN","ORP O7GUI",18, 0)
  1560                 Q
  1561                "RTN","ORP O7GUI",19, 0)
  1562                 ;LST USED  BY CPRS G UI SOFTWAR E
  1563                "RTN","ORP O7GUI",20, 0)
  1564                NULL S LST (ILST)=" "
  1565                "RTN","ORP O7GUI",21, 0)
  1566                 Q
  1567                "RTN","ORP O7GUI",22, 0)
  1568                FL(ORPODFN ,ORPOFL) ; CHECK IF P ATIENT HAS  FLAG
  1569                "RTN","ORP O7GUI",23, 0)
  1570                 ;ORPODFN= PATIENT DF N
  1571                "RTN","ORP O7GUI",24, 0)
  1572                 ;ORPOFL=F LAG YOU AR E LOOKING  FOR
  1573                "RTN","ORP O7GUI",25, 0)
  1574                 N ORPOI,O RPOR S ORP OR=0
  1575                "RTN","ORP O7GUI",26, 0)
  1576                 F ORPOI=0 :0 S ORPOI =$O(^OR(10 0.0071,ORP ODFN,1,ORP OI)) Q:'OR POI  D
  1577                "RTN","ORP O7GUI",27, 0)
  1578                 .S:$$GET1 ^DIQ(100.0 0711,ORPOI _","_ORPOD FN,.01)=OR POFL ORPOR =1
  1579                "RTN","ORP O7GUI",28, 0)
  1580                 Q ORPOR
  1581                "RTN","ORP O7GUI",29, 0)
  1582                ADDT(X1,X2 ) ;ADD/SUB TRACT FROM  DATE
  1583                "RTN","ORP O7GUI",30, 0)
  1584                 N X D C^% DTC
  1585                "RTN","ORP O7GUI",31, 0)
  1586                 Q X
  1587                "RTN","ORP O7GUI",32, 0)
  1588                FDT(Y) ;FO RMAT INTER NAL TO EXT ERNAL DATE
  1589                "RTN","ORP O7GUI",33, 0)
  1590                 D DD^%DT
  1591                "RTN","ORP O7GUI",34, 0)
  1592                 Q Y
  1593                "RTN","ORP O7GUI",35, 0)
  1594                TXT ; PRIN T TEXT
  1595                "RTN","ORP O7GUI",36, 0)
  1596                 N ORPOI D  INC,NULL
  1597                "RTN","ORP O7GUI",37, 0)
  1598                 F ORPOI=0 :0:3 S ORP OI=$O(^OR( 100.007,OR POTI("I"), 3,ORPOI))  Q:'ORPOI   D
  1599                "RTN","ORP O7GUI",38, 0)
  1600                 .D INC S  LST(ILST)= ^OR(100.00 7,ORPOTI(" I"),3,ORPO I,0)
  1601                "RTN","ORP O7GUI",39, 0)
  1602                 .D:LST(IL ST)["|" VA R(LST(ILST ))
  1603                "RTN","ORP O7GUI",40, 0)
  1604                 Q
  1605                "RTN","ORP O7GUI",41, 0)
  1606                VAR(ORPO)  ;REMOVE ~  PRINT VARI ABLE
  1607                "RTN","ORP O7GUI",42, 0)
  1608                 N ORPOI,O RPOT,ORPOV AR
  1609                "RTN","ORP O7GUI",43, 0)
  1610                 F ORPOI=0 :0 S ORPOT =$F(ORPO," |") Q:'ORP OT  D
  1611                "RTN","ORP O7GUI",44, 0)
  1612                 .S ORPOVA R=$P(ORPO, "|",2),ORP O=$P(ORPO, "|")_@ORPO VAR_$P(ORP O,"|",3,20 0)
  1613                "RTN","ORP O7GUI",45, 0)
  1614                 S LST(ILS T)=ORPO
  1615                "RTN","ORP O7GUI",46, 0)
  1616                 Q
  1617                "RTN","ORP O7GUI",47, 0)
  1618                GFY(ORPODT ) ; GET FI SCAL YEAR
  1619                "RTN","ORP O7GUI",48, 0)
  1620                 N ORPOMO, ORPOYR
  1621                "RTN","ORP O7GUI",49, 0)
  1622                 S ORPOMO= $E(ORPODT, 4,5),ORPOY R=$E(ORPOD T,1,3)
  1623                "RTN","ORP O7GUI",50, 0)
  1624                 S ORPOYR= $S(ORPOMO> 9:ORPOYR+1 ,1:ORPOYR)
  1625                "RTN","ORP O7GUI",51, 0)
  1626                 S ORPOYR= $S($E(ORPO YR)=2:19_$ E(ORPOYR,2 ,3),$E(ORP OYR)=3:20_ $E(ORPOYR, 2,3),$E(OR POYR)=4:21 _$E(ORPOYR ,2,3),1:00 00)
  1627                "RTN","ORP O7GUI",52, 0)
  1628                 Q ORPOYR
  1629                "RTN","ORP O7GUI",53, 0)
  1630                FLAGOK(TYP E) ;RMS/HI NES 3-3-04  TO CONTRO L NUMBER O F FLAG VIE WS PER DAY
  1631                "RTN","ORP O7GUI",54, 0)
  1632                 N ORPOFDA T,X,X1,X2
  1633                "RTN","ORP O7GUI",55, 0)
  1634                 S X1=DT,X 2=+1 D C^% DTC S ORPO FDAT=X
  1635                "RTN","ORP O7GUI",56, 0)
  1636                 S ^XTMP(" ORPOFLAG"_ DT,0)=ORPO FDAT_U_DT_ U_"Pop-Up  Flag Daily  Usage Dat a"
  1637                "RTN","ORP O7GUI",57, 0)
  1638                 Q $G(^XTM P("ORPOFLA G"_DT,TYPE ,DUZ,+$G(D FN)))
  1639                "RTN","ORP O7GUI",58, 0)
  1640                USER(ORPOD UZ)  Q:$$I SA^USRLM(O RPODUZ,"PH YSICIAN",. ORPOERR) 1
  1641                "RTN","ORP O7GUI",59, 0)
  1642                 Q:$$ISA^U SRLM(ORPOD UZ,"PHYSIC IAN ASSIST ANT",.ORPO ERR) 1
  1643                "RTN","ORP O7GUI",60, 0)
  1644                 Q:$$ISA^U SRLM(ORPOD UZ,"NURSE  PRACTITION ER",.ORPOE RR) 1
  1645                "RTN","ORP O7GUI",61, 0)
  1646                 Q:$$ISA^U SRLM(ORPOD UZ,"MEDICA L STUDENT" ,.ORPOERR)  1
  1647                "RTN","ORP O7GUI",62, 0)
  1648                 Q:$D(^XUS EC("ORES", ORPODUZ))  1
  1649                "RTN","ORP O7GUI",63, 0)
  1650                 Q 0
  1651                "RTN","ORP O7GUI",64, 0)
  1652                 ;
  1653                "RTN","ORP OCHF")
  1654                0^12^B8604 84^n/a
  1655                "RTN","ORP OCHF",1,0)
  1656                ORPOCHF ;R 01/RMM - P op-Up for  Congestive  heart fai lure in CP RS ;12/4/2 013
  1657                "RTN","ORP OCHF",2,0)
  1658                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 30
  1659                "RTN","ORP OCHF",3,0)
  1660                 ;find pat ients disc harged wit hin 30 day s with a p rimary dia gnosis of  CHF icd 9  code of 42 8.x
  1661                "RTN","ORP OCHF",4,0)
  1662                 ;when icd  10 is rel eased this  will have  to be cha nged
  1663                "RTN","ORP OCHF",5,0)
  1664                 ;359 NAME : DBIA359
  1665                "RTN","ORP OCHF",6,0)
  1666                 Q  ;QUIT  IF NOT ENT RY POINT
  1667                "RTN","ORP OCHF",7,0)
  1668                EN(ORPODFN ) ;ENTRY P OINT, PATI ENT DFN
  1669                "RTN","ORP OCHF",8,0)
  1670                 N ORPOI,O RPOSDT,ORP ORET S ORP ORET=0 K ^ TMP("DILIS T",$J)
  1671                "RTN","ORP OCHF",9,0)
  1672                 S ORPOSDT =$$ADDT(DT ,-30)
  1673                "RTN","ORP OCHF",10,0 )
  1674                 D FIND^DI C(45,,"@;. 01I;79;70I ","Q",ORPO DFN,,"B")  ;PTF FILE
  1675                "RTN","ORP OCHF",11,0 )
  1676                 F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI))  Q:'ORPOI   D
  1677                "RTN","ORP OCHF",12,0 )
  1678                 .Q:^TMP(" DILIST",$J ,"ID",ORPO I,70)']""
  1679                "RTN","ORP OCHF",13,0 )
  1680                 .Q:^TMP(" DILIST",$J ,"ID",ORPO I,70)<ORPO SDT
  1681                "RTN","ORP OCHF",14,0 )
  1682                 .Q:^TMP(" DILIST",$J ,"ID",ORPO I,79)'["42 8."
  1683                "RTN","ORP OCHF",15,0 )
  1684                 .S ORPORE T=1
  1685                "RTN","ORP OCHF",16,0 )
  1686                 Q ORPORET
  1687                "RTN","ORP OCHF",17,0 )
  1688                ADDT(X1,X2 ) ;ADD/SUB TRACT FROM  DATE
  1689                "RTN","ORP OCHF",18,0 )
  1690                 N X D C^% DTC
  1691                "RTN","ORP OCHF",19,0 )
  1692                 Q X
  1693                "RTN","ORP OMDRO")
  1694                0^14^B1921 7026^n/a
  1695                "RTN","ORP OMDRO",1,0 )
  1696                ORPOMDRO ; R01/RMM -  POP-Up FOR  MRSA/MDRO  in CPRS ; 4/8/2013
  1697                "RTN","ORP OMDRO",2,0 )
  1698                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 30
  1699                "RTN","ORP OMDRO",3,0 )
  1700                 ;could no t find an  ICA for fi le 104.1
  1701                "RTN","ORP OMDRO",4,0 )
  1702                 ;
  1703                "RTN","ORP OMDRO",5,0 )
  1704                EN(DFN) ;E NTRY POINT
  1705                "RTN","ORP OMDRO",6,0 )
  1706                 N ORPOI,O RPOII,ORPO TEST,ORPO, ORPOA,ORPO RET,ORPOIN D,ORPORES, ORPOF,ORPO VAL,ORPOII I,ORPOD0 S  ORPORET=0 ,ORPOF=0
  1707                "RTN","ORP OMDRO",7,0 )
  1708                 D LIST^DI C(104.1,," @;.01IE"," Q",,,,"B")  ;MRSA TOO LS LAB SEA RCH/EXTRAC T FILE
  1709                "RTN","ORP OMDRO",8,0 )
  1710                 F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI))  Q:'ORPOI! (ORPORET=1 )  D
  1711                "RTN","ORP OMDRO",9,0 )
  1712                 .S ORPOD0 =^TMP("DIL IST",$J,2, ORPOI)
  1713                "RTN","ORP OMDRO",10, 0)
  1714                 .D LIST^D IC(104.15, ","_ORPOD0 _",","@;.0 1IE;1;2"," Q",,,,"B", ,,"ORPO")
  1715                "RTN","ORP OMDRO",11, 0)
  1716                 .K ORPOA  S ORPOF=0
  1717                "RTN","ORP OMDRO",12, 0)
  1718                 .F ORPOII =0:0 S ORP OII=$O(ORP O("DILIST" ,2,ORPOII) ) Q:'ORPOI I!(ORPORET =1)  D
  1719                "RTN","ORP OMDRO",13, 0)
  1720                 ..S ORPOR ET=$$FTEST (ORPO("DIL IST","ID", ORPOII,.01 ,"I"))
  1721                "RTN","ORP OMDRO",14, 0)
  1722                 ..Q:ORPOR ET=1
  1723                "RTN","ORP OMDRO",15, 0)
  1724                 ..S ORPOI ND=ORPO("D ILIST","ID ",ORPOII,1 )
  1725                "RTN","ORP OMDRO",16, 0)
  1726                 ..S:ORPOI ND="Contai ns" ORPOIN D="[",ORPO F=1 S:ORPO IND="Great er Than" O RPOIND=">" ,ORPOF=1
  1727                "RTN","ORP OMDRO",17, 0)
  1728                 ..S:ORPOI ND="Less T han" ORPOI ND="<",ORP OF=1 S:ORP OIND="Equa l To" ORPO IND="=",OR POF=1
  1729                "RTN","ORP OMDRO",18, 0)
  1730                 ..Q:ORPOF =0 
  1731                "RTN","ORP OMDRO",19, 0)
  1732                 ..S ORPOD 1=ORPO("DI LIST",2,OR POII),ORPO TEST=ORPO( "DILIST"," ID",ORPOII ,.01,"I")
  1733                "RTN","ORP OMDRO",20, 0)
  1734                 ..Q:$$GET 1^DIQ(60,O RPOTEST,40 0)=""
  1735                "RTN","ORP OMDRO",21, 0)
  1736                 ..S ORPO= $$ONE^ORPO TIO($$GET1 ^DIQ(60,OR POTEST,400 )_"^100^1Y ")
  1737                "RTN","ORP OMDRO",22, 0)
  1738                 ..F ORPOI II=0:0 S O RPOIII=$O( ^TMP("ORPO TIOB2",$J, ORPOIII))  Q:'ORPOIII   D
  1739                "RTN","ORP OMDRO",23, 0)
  1740                 ...S ORPO RES=""""_$ P(^TMP("OR POTIOB2",$ J,ORPOIII, 0),"@",2)_ """"
  1741                "RTN","ORP OMDRO",24, 0)
  1742                 ...S ORPO VAL=""""_O RPO("DILIS T","ID",OR POII,2)_"" ""
  1743                "RTN","ORP OMDRO",25, 0)
  1744                 ...Q:ORPO RES=""""""
  1745                "RTN","ORP OMDRO",26, 0)
  1746                 ...Q:ORPO VAL=""""""
  1747                "RTN","ORP OMDRO",27, 0)
  1748                 ...S ORPO RES=$TR(OR PORES,"abc defghijklm nopqrstuvw xyz","ABCD EFGHIJKLNM OPQRSTUVWX YZ")
  1749                "RTN","ORP OMDRO",28, 0)
  1750                 ...S ORPO VAL=$TR(OR POVAL,"abc defghijklm nopqrstuvw xyz","ABCD EFGHIJKLNM OPQRSTUVWX YZ")
  1751                "RTN","ORP OMDRO",29, 0)
  1752                 ...I @(OR PORES_ORPO IND_ORPOVA L) S ORPOR ET=1 ;"*** * MDRO PRE CAUTIONS * ***"
  1753                "RTN","ORP OMDRO",30, 0)
  1754                 W !,"EN:  ",ORPORET
  1755                "RTN","ORP OMDRO",31, 0)
  1756                 Q ORPORET
  1757                "RTN","ORP OMDRO",32, 0)
  1758                FTEST(ORPO T) ; FIND  MICROBIOLO GY TEST
  1759                "RTN","ORP OMDRO",33, 0)
  1760                 N ORPOLRD FN,ORPOI,O RPOII,ORPO ET,R2,R3,O RPOAS,ORPO D1,ORPORET  S ORPORET =0
  1761                "RTN","ORP OMDRO",34, 0)
  1762                 D LIST^DI C(104.109, ","_ORPOD0 _",","@;.0 1IE;","Q", ,,,"B",,," R2")  ;ETI OLOGY MULT IPLE
  1763                "RTN","ORP OMDRO",35, 0)
  1764                 F ORPOI=0 :0 S ORPOI =$O(R2("DI LIST",2,OR POI)) Q:'O RPOI  D
  1765                "RTN","ORP OMDRO",36, 0)
  1766                 .K ORPOET  S ORPOET= R2("DILIST ","ID",ORP OI,.01,"I" ),ORPOD1=R 2("DILIST" ,2,ORPOI)
  1767                "RTN","ORP OMDRO",37, 0)
  1768                 .D LIST^D IC(104.191 ,","_ORPOD 1_","_ORPO D0_",","@; .01;1;2"," Q",,,,"B", ,,"R3")  ; ANTIMICROB IAL SUSCEP TIBILITY M ULTIPLE
  1769                "RTN","ORP OMDRO",38, 0)
  1770                 .F ORPOII =0:0 S ORP OII=$O(R3( "DILIST",2 ,ORPOII))  Q:'ORPOII! (ORPORET=1 )  D
  1771                "RTN","ORP OMDRO",39, 0)
  1772                 ..S ORPOE T=R2("DILI ST","ID",O RPOI,.01," I")_U_R3(" DILIST","I D",ORPOII, .01)_U_R3( "DILIST"," ID",ORPOII ,2)
  1773                "RTN","ORP OMDRO",40, 0)
  1774                 ..S:R3("D ILIST","ID ",ORPOII,1 )="Contain s" ORPOET= ORPOET_U_" ["
  1775                "RTN","ORP OMDRO",41, 0)
  1776                 ..S:R3("D ILIST","ID ",ORPOII,1 )="Greater  Than" ORP OET=ORPOET _U_">"
  1777                "RTN","ORP OMDRO",42, 0)
  1778                 ..S:R3("D ILIST","ID ",ORPOII,1 )="Less Th an" ORPOET =ORPOET_U_ "<"
  1779                "RTN","ORP OMDRO",43, 0)
  1780                 ..S:R3("D ILIST","ID ",ORPOII,1 )="Equal T o" ORPOET= ORPOET_U_" ="
  1781                "RTN","ORP OMDRO",44, 0)
  1782                 ..S ORPOR ET=$$GORG( ORPOET) Q: ORPORET=1
  1783                "RTN","ORP OMDRO",45, 0)
  1784                 ..S ORPOR ET=$$GMYC( ORPOET) Q: ORPORET=1
  1785                "RTN","ORP OMDRO",46, 0)
  1786                 W !,"FORG : ",ORPORE T
  1787                "RTN","ORP OMDRO",47, 0)
  1788                 Q ORPORET
  1789                "RTN","ORP OMDRO",48, 0)
  1790                GORG(ORPOE ) ;GET ORG ANISM
  1791                "RTN","ORP OMDRO",49, 0)
  1792                 N ORPOLRD FN,ORPOBDT ,ORPOEDT,O RPOBRDT,OR POERDT,ORP OI,ORPOD1, ORPOD2,ORP OD,ORPORET
  1793                "RTN","ORP OMDRO",50, 0)
  1794                 S ORPOLRD FN=$$LRDFN ^LRPXAPIU( DFN),ORPOR ET=0
  1795                "RTN","ORP OMDRO",51, 0)
  1796                 S ORPOBDT =$$ADDT(DT ,-365),ORP OEDT=DT
  1797                "RTN","ORP OMDRO",52, 0)
  1798                 S ORPOBRD T=9999999- ORPOBDT,OR POERDT=999 9999-ORPOE DT
  1799                "RTN","ORP OMDRO",53, 0)
  1800                 F ORPOD1= ORPOERDT:0 :(ORPOBRDT _.9999) S  ORPOD1=$O( ^LR(ORPOLR DFN,"MI",O RPOD1)) Q: 'ORPOD1  D   ;LAB DAT A FILE MIC ROBIOLOGY  MULTIPLE
  1801                "RTN","ORP OMDRO",54, 0)
  1802                 .F ORPOD2 =0:0 S ORP OD2=$O(^LR (ORPOLRDFN ,"MI",ORPO D1,3,ORPOD 2)) Q:'ORP OD2  D
  1803                "RTN","ORP OMDRO",55, 0)
  1804                 ..D:$P(OR POE,U)=$P( ^LR(ORPOLR DFN,"MI",O RPOD1,3,OR POD2,0),U)
  1805                "RTN","ORP OMDRO",56, 0)
  1806                 ...S ORPO D=0,ORPOD= $O(^DD(63. 3,"B",$P(O RPOE,U,2), ORPOD))
  1807                "RTN","ORP OMDRO",57, 0)
  1808                 ...I @("" ""_$P(ORPO E,U,3)_""" "_$P(ORPOE ,U,4)_"""" _$$GET1^DI Q(63.3,ORP OD2_","_OR POD1_","_O RPOLRDFN,O RPOD)_"""" ) S ORPORE T=1
  1809                "RTN","ORP OMDRO",58, 0)
  1810                 W !,"GORG : ",ORPORE T
  1811                "RTN","ORP OMDRO",59, 0)
  1812                 Q ORPORET
  1813                "RTN","ORP OMDRO",60, 0)
  1814                GMYC(ORPOE ) ;GET MYC OBACTERIUM    ;^LR(D0 ,MI,D1,12, D2,0)= (#. 01) MYCOBA CTERIUM [1 P:61.2] ^  (#1) QUANT ITY [2F] ^  
  1815                "RTN","ORP OMDRO",61, 0)
  1816                 N ORPOLRD FN,ORPOBDT ,ORPOEDT,O RPOBRDT,OR POERDT,ORP OI,ORPOD1, ORPOD2,ORP OD,ORPORET
  1817                "RTN","ORP OMDRO",62, 0)
  1818                 S ORPOLRD FN=$$LRDFN ^LRPXAPIU( DFN),ORPOR ET=0
  1819                "RTN","ORP OMDRO",63, 0)
  1820                 S ORPOBDT =$$ADDT(DT ,-365),ORP OEDT=DT
  1821                "RTN","ORP OMDRO",64, 0)
  1822                 S ORPOBRD T=9999999- ORPOBDT,OR POERDT=999 9999-ORPOE DT
  1823                "RTN","ORP OMDRO",65, 0)
  1824                 F ORPOD1= ORPOERDT:0 :(ORPOBRDT _.9999) S  ORPOD1=$O( ^LR(ORPOLR DFN,"MI",O RPOD1)) Q: 'ORPOD1  D   ;LAB DAT A FILE MIC ROBIOLOGY  MULTIPLE
  1825                "RTN","ORP OMDRO",66, 0)
  1826                 .F ORPOD2 =0:0 S ORP OD2=$O(^LR (ORPOLRDFN ,"MI",ORPO D1,12,ORPO D2)) Q:'OR POD2  D
  1827                "RTN","ORP OMDRO",67, 0)
  1828                 ..D:$P(OR POE,U)=$P( ^LR(ORPOLR DFN,"MI",O RPOD1,12,O RPOD2,0),U )
  1829                "RTN","ORP OMDRO",68, 0)
  1830                 ...S ORPO D=0,ORPOD= $O(^DD(63. 39,"B",$P( ORPOE,U,2) ,ORPOD))
  1831                "RTN","ORP OMDRO",69, 0)
  1832                 ...I @("" ""_$P(ORPO E,U,3)_""" "_$P(ORPOE ,U,4)_"""" _$$GET1^DI Q(63.39,OR POD2_","_O RPOD1_","_ ORPOLRDFN, ORPOD)_""" ") S ORPOR ET=1
  1833                "RTN","ORP OMDRO",70, 0)
  1834                 W !,"GMYC : ",ORPORE T
  1835                "RTN","ORP OMDRO",71, 0)
  1836                 Q ORPORET
  1837                "RTN","ORP OMDRO",72, 0)
  1838                ADDT(X1,X2 ) ;ADD/SUB TRACT FROM  DATE
  1839                "RTN","ORP OMDRO",73, 0)
  1840                 N X D C^% DTC
  1841                "RTN","ORP OMDRO",74, 0)
  1842                 Q X
  1843                "RTN","ORP OOBS")
  1844                0^15^B1358 7829^n/a
  1845                "RTN","ORP OOBS",1,0)
  1846                ORPOOBS ;R 01/HAM3,RM M - Pop-Up  for OBSER VATION in  CPRS ;07/3 0/2012
  1847                "RTN","ORP OOBS",2,0)
  1848                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;7/30/ 2012;Build  30
  1849                "RTN","ORP OOBS",3,0)
  1850                 ;
  1851                "RTN","ORP OOBS",4,0)
  1852                GETADMFM(D FN) ; GET  THE FILEMA N FORMAT O F THE ADMI SSION DATE
  1853                "RTN","ORP OOBS",5,0)
  1854                 N VAIN
  1855                "RTN","ORP OOBS",6,0)
  1856                 D INP^VAD PT
  1857                "RTN","ORP OOBS",7,0)
  1858                 Q +VAIN(7 )
  1859                "RTN","ORP OOBS",8,0)
  1860                GMT(ORPOMX ) ;GET MAX  TIME FROM  TEXT FIEL D
  1861                "RTN","ORP OOBS",9,0)
  1862                 N ORPOI
  1863                "RTN","ORP OOBS",10,0 )
  1864                 F ORPOI=0 :0 S ORPOI =$O(^OR(10 0.007,ORPO TI("I"),3, ORPOI)) Q: 'ORPOI  D
  1865                "RTN","ORP OOBS",11,0 )
  1866                 .S:^OR(10 0.007,ORPO TI("I"),3, ORPOI,0)[" MAX TIME"  ORPOMX=$P( ^OR(100.00 7,ORPOTI(" I"),3,ORPO I,0),"=",2 )
  1867                "RTN","ORP OOBS",12,0 )
  1868                 Q
  1869                "RTN","ORP OOBS",13,0 )
  1870                GETDHSD(OR POFMDT) ;  GET THE DE CIMAL TIME  SINCE A F ILEMAN DAT E, ROUNDS  SECONDS UP   15.331 =  15.34
  1871                "RTN","ORP OOBS",14,0 )
  1872                 Q $FN($$F MDIFF^XLFD T($$NOW^XL FDT,ORPOFM DT,2)/3600 ,"",2)
  1873                "RTN","ORP OOBS",15,0 )
  1874                GETTMLFT(O RPODATE,OR POMAXT) ;  get the ti me left
  1875                "RTN","ORP OOBS",16,0 )
  1876                 N ORPOTIM E
  1877                "RTN","ORP OOBS",17,0 )
  1878                 S ORPOTIM E=$FN($$FM DIFF^XLFDT ($$NOW^XLF DT,ORPODAT E,2)/3600, "",2)
  1879                "RTN","ORP OOBS",18,0 )
  1880                 Q $$GETTX T3(ORPOTIM E,ORPOMAXT )
  1881                "RTN","ORP OOBS",19,0 )
  1882                GETTEXT(LS T,DFN) ; G ENERATE TH E LST ARRA Y TO BE US ED BASED O N THE ADMI T DATE
  1883                "RTN","ORP OOBS",20,0 )
  1884                 N ORPOADT ,ORPOMXT,O RPOOB,ORPO TM S ORPOM XT=0
  1885                "RTN","ORP OOBS",21,0 )
  1886                 D INC^ORP O7GUI,NULL ^ORPO7GUI
  1887                "RTN","ORP OOBS",22,0 )
  1888                 ;
  1889                "RTN","ORP OOBS",23,0 )
  1890                 ;change f or directi ve 1036
  1891                "RTN","ORP OOBS",24,0 )
  1892                 ;S ORPOMX T=23+(59/6 0) ;  MAX  HOURS AND  59 MINUTES    ; MAX A LLOWED TIM E
  1893                "RTN","ORP OOBS",25,0 )
  1894                 D GMT(.OR POMXT) ;GE T MAX TIME  FROM TEXT  FIELD
  1895                "RTN","ORP OOBS",26,0 )
  1896                 S:ORPOMXT =0 ORPOMXT =48 ;IF MA X TIME NOT  DEFINED I N TEXT FIE LD SET TO  48 HRS
  1897                "RTN","ORP OOBS",27,0 )
  1898                 S ORPOMXT =(ORPOMXT- 1)+(59/60)  ;  MAX HO URS AND 59  MINUTES    ; MAX ALL OWED TIME
  1899                "RTN","ORP OOBS",28,0 )
  1900                 ;
  1901                "RTN","ORP OOBS",29,0 )
  1902                 S ORPOADT =$$GETADMF M(DFN) ;GE T ADMIT DA TETIME
  1903                "RTN","ORP OOBS",30,0 )
  1904                 D GETTXT2 (.LST,ORPO ADT,ORPOMX T)
  1905                "RTN","ORP OOBS",31,0 )
  1906                 Q
  1907                "RTN","ORP OOBS",32,0 )
  1908                GETTXT2(LS T,ORPOADT, ORPOMXT) ;
  1909                "RTN","ORP OOBS",33,0 )
  1910                 N ORPOADT X,ORPOOB,O RPOTM
  1911                "RTN","ORP OOBS",34,0 )
  1912                 S ORPOADT X=$$FMTE^X LFDT(ORPOA DT)
  1913                "RTN","ORP OOBS",35,0 )
  1914                 S ORPOOB= $$GETTMLFT (ORPOADT,O RPOMXT) ;G ET TIME LE FT
  1915                "RTN","ORP OOBS",36,0 )
  1916                 S ORPOTM= $$GETDHSD( ORPOADT) ; get decima l time
  1917                "RTN","ORP OOBS",37,0 )
  1918                 I ORPOOB[ "EXCEEDED"  D
  1919                "RTN","ORP OOBS",38,0 )
  1920                 .D INC^OR PO7GUI S L ST(ILST)=" DISCHARGE  OR CHANGE  OBSERVATIO N TO INPT  STATUS NOW !"
  1921                "RTN","ORP OOBS",39,0 )
  1922                 .D INC^OR PO7GUI S L ST(ILST)=O RPOOB
  1923                "RTN","ORP OOBS",40,0 )
  1924                 .D INC^OR PO7GUI S L ST(ILST)=" Observatio n admit wa s at: "_OR POADTX
  1925                "RTN","ORP OOBS",41,0 )
  1926                 E  D
  1927                "RTN","ORP OOBS",42,0 )
  1928                 .;
  1929                "RTN","ORP OOBS",43,0 )
  1930                 .;change  for direct ive 1036
  1931                "RTN","ORP OOBS",44,0 )
  1932                 .;I ORPOT M>=23 D
  1933                "RTN","ORP OOBS",45,0 )
  1934                 .I ORPOTM >=$P(ORPOM XT,".") D
  1935                "RTN","ORP OOBS",46,0 )
  1936                 ..;
  1937                "RTN","ORP OOBS",47,0 )
  1938                 ..;D INC^ ORPO7GUI S  LST(ILST) ="23hr OBS ERVATION P ERIOD IS O VER!!"
  1939                "RTN","ORP OOBS",48,0 )
  1940                 ..D INC^O RPO7GUI S  LST(ILST)= $P(ORPOMXT ,".")_"th  HOUR OF OB SERVATION  IS OVER!"
  1941                "RTN","ORP OOBS",49,0 )
  1942                 ..D INC^O RPO7GUI S  LST(ILST)= "DISCHARGE  OR CHANGE  OBSERVATI ON TO INPT  STATUS NO W!"
  1943                "RTN","ORP OOBS",50,0 )
  1944                 ..D INC^O RPO7GUI S  LST(ILST)= ORPOOB
  1945                "RTN","ORP OOBS",51,0 )
  1946                 .E  D
  1947                "RTN","ORP OOBS",52,0 )
  1948                 ..D INC^O RPO7GUI S  LST(ILST)= "OBSERVATI ON ADMIT A T: "_ORPOA DTX
  1949                "RTN","ORP OOBS",53,0 )
  1950                 ..;
  1951                "RTN","ORP OOBS",54,0 )
  1952                 ..;change  for direc tive 1036
  1953                "RTN","ORP OOBS",55,0 )
  1954                 ..;I ORPO TM>=20 D
  1955                "RTN","ORP OOBS",56,0 )
  1956                 ..I ORPOT M>=($P(ORP OMXT,".")- 3) D
  1957                "RTN","ORP OOBS",57,0 )
  1958                 ...;
  1959                "RTN","ORP OOBS",58,0 )
  1960                 ...D INC^ ORPO7GUI S  LST(ILST) ="MAKE PLA NS FOR DIS CHARGE OR  FULL ADMIT ."
  1961                "RTN","ORP OOBS",59,0 )
  1962                 ...D INC^ ORPO7GUI S  LST(ILST) =ORPOOB
  1963                "RTN","ORP OOBS",60,0 )
  1964                 ..E  D
  1965                "RTN","ORP OOBS",61,0 )
  1966                 ...I ORPO TM>0 D
  1967                "RTN","ORP OOBS",62,0 )
  1968                 ....D INC ^ORPO7GUI  S LST(ILST )=ORPOOB
  1969                "RTN","ORP OOBS",63,0 )
  1970                 Q
  1971                "RTN","ORP OOBS",64,0 )
  1972                GETTXT3(OR PODECTIME, ORPOMAXTIM E) ;
  1973                "RTN","ORP OOBS",65,0 )
  1974                 N ORPODIF F,ORPOHRS, ORPOMINS,O RPORESULT
  1975                "RTN","ORP OOBS",66,0 )
  1976                 S ORPORES ULT=""
  1977                "RTN","ORP OOBS",67,0 )
  1978                 S ORPODIF F=+$FN(ORP OMAXTIME-O RPODECTIME ,"",2)
  1979                "RTN","ORP OOBS",68,0 )
  1980                 S ORPOHRS =+$P(ORPOD IFF,".",1)
  1981                "RTN","ORP OOBS",69,0 )
  1982                 S ORPOMIN S=$FN((ORP ODIFF-ORPO HRS)*60,"" ,0)
  1983                "RTN","ORP OOBS",70,0 )
  1984                 I ORPODIF F>0 S ORPO RESULT="Di scharge or  admit wit hin: "_ORP OHRS_" hou r"_$S(ORPO HRS=1:"",1 :"s")_" an d "_ORPOMI NS_" minut e"_$S(ORPO MINS=1:"", 1:"s")
  1985                "RTN","ORP OOBS",71,0 )
  1986                 I ORPODIF F=0 S ORPO RESULT="Di scharge or  admit wit hin: "_ORP OHRS_" hou r"_$S(ORPO HRS=1:"",1 :"s")_" an d "_ORPOMI NS_" minut e"_$S(ORPO MINS=1:"", 1:"s")
  1987                "RTN","ORP OOBS",72,0 )
  1988                 I ORPODIF F<0 S ORPO RESULT="OB SERVATION  EXCEEDED b y: "_-ORPO HRS_" hour "_$S(ORPOH RS=-1:"",1 :"s")_" an d "_-ORPOM INS_" minu te"_$S(ORP OMINS=-1:" ",1:"s")
  1989                "RTN","ORP OOBS",73,0 )
  1990                 Q ORPORES ULT
  1991                "RTN","ORP OOBS",74,0 )
  1992                 ;
  1993                "RTN","ORP OTIO")
  1994                0^16^B2944 7201^n/a
  1995                "RTN","ORP OTIO",1,0)
  1996                ORPOTIO ;  PHOENIX/KL D - Pop-Up  for TIU O BJECTS - L AB TESTS &  PANELS (T RENDS) in  CPRS ; 5/2 5/12  3:13  PM
  1997                "RTN","ORP OTIO",2,0)
  1998                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 30
  1999                "RTN","ORP OTIO",3,0)
  2000                 ;;IAs use d - 4245,  4246
  2001                "RTN","ORP OTIO",4,0)
  2002                ST Q
  2003                "RTN","ORP OTIO",5,0)
  2004                 ;
  2005                "RTN","ORP OTIO",6,0)
  2006                PANEL(X) ; Panel Lab  Test in a  time perio d object ( time=nM, n D, or nY)
  2007                "RTN","ORP OTIO",7,0)
  2008                 ;X should  be "Displ ay name^#  of occuran ces^time p eriod^prin t a second  line? (0  or 1)^Test  IENS from  file 63.0 4"
  2009                "RTN","ORP OTIO",8,0)
  2010                 ;Example:  X="Chem 7 ^3^2Y^1^2, 3,4:1:8,79 0"
  2011                "RTN","ORP OTIO",9,0)
  2012                 N ORPOTI  S ORPOTI(" C")=0,$P(O RPOTI("SP" )," ",30)= ""
  2013                "RTN","ORP OTIO",10,0 )
  2014                 S ORPOTI( "TN")=$P(X ,U,1,2),OR POTI("T")= $P(X,U,3), ORPOTI("LI NE2")=$P(X ,U,4),ORPO TI("TEST") =$P(X,U,5)
  2015                "RTN","ORP OTIO",11,0 )
  2016                 S ORPOTI( "CHK",1)=$ P(ORPOTI(" TEST"),"," ),ORPOTI(" CHK",2)=$P (ORPOTI("T EST"),",", 2)
  2017                "RTN","ORP OTIO",12,0 )
  2018                 F ORPOTI( "I")=1,2 S :ORPOTI("C HK",ORPOTI ("I"))[":"  ORPOTI("C HK",ORPOTI ("I"))=$P( ORPOTI("CH K",ORPOTI( "I")),":")
  2019                "RTN","ORP OTIO",13,0 )
  2020                 S:'ORPOTI ("CHK",2)& (ORPOTI("C HK",1)) OR POTI("CHK" ,2)=ORPOTI ("CHK",1)
  2021                "RTN","ORP OTIO",14,0 )
  2022                 F ORPOTI( "I")=1:1:$ P(ORPOTI(" TN"),U,2)  S ORPOTI(" TEST",ORPO TI("I"))=0  D
  2023                "RTN","ORP OTIO",15,0 )
  2024                 .X "F ORP OTI(""II"" )="_ORPOTI ("TEST")_"  S ORPOTI( ""TEST"",O RPOTI(""I" "),ORPOTI( ""II""))=" """ S ORPO TI(""VALID TESTS"",$$ TEST^LRPXA PIU(ORPOTI (""II""))) =ORPOTI("" II"")"
  2025                "RTN","ORP OTIO",16,0 )
  2026                 D GET I O RPOTI("TES T",1) D H( 0),DAT(0), SET("") D
  2027                "RTN","ORP OTIO",17,0 )
  2028                 .I ORPOTI ("LINE2")  S ORPOTI(" HOLD",1)=O RPOTI("HOL D") D H(OR POTI("HOLD ")),DAT(OR POTI("HOLD ",1))
  2029                "RTN","ORP OTIO",18,0 )
  2030                 Q "~@^TMP (""ORPOTIO B2"","_$J_ ")"
  2031                "RTN","ORP OTIO",19,0 )
  2032                 ;
  2033                "RTN","ORP OTIO",20,0 )
  2034                ONE(X) ;Si ngle lab t est in a t ime period  object.
  2035                "RTN","ORP OTIO",21,0 )
  2036                 ;X should  be "Data  name^# of  occurances ^time peri od (nM, nD , or nY)"
  2037                "RTN","ORP OTIO",22,0 )
  2038                 ;or X cou ld be "Pri nt string^ # of occur ances^time  period (n M, nD, or  nY)^Data n ame number ^Print com pleted tim e"
  2039                "RTN","ORP OTIO",23,0 )
  2040                 N ORPOTI  S ORPOTI(" TN")=X,ORP OTI("C")=0 ,$P(ORPOTI ("SP")," " ,50)=""
  2041                "RTN","ORP OTIO",24,0 )
  2042                 S ORPOTI( "N")=$P(OR POTI("TN") ,U,2),ORPO TI("T")=$P (ORPOTI("T N"),U,3)
  2043                "RTN","ORP OTIO",25,0 )
  2044                 S:'ORPOTI ("N") ORPO TI("N")=99  S:ORPOTI( "T")="" OR POTI("T")= "99Y"
  2045                "RTN","ORP OTIO",26,0 )
  2046                 S:'$P(ORP OTI("TN"), U,4) ORPOT I("TEST")= $O(^DD(63. 04,"B",$P( ORPOTI("TN "),U),0))
  2047                "RTN","ORP OTIO",27,0 )
  2048                 S:$P(ORPO TI("TN"),U ,4) ORPOTI ("TEST")=$ P(ORPOTI(" TN"),U,4)
  2049                "RTN","ORP OTIO",28,0 )
  2050                 I 'ORPOTI ("TEST") D   Q "~@^TM P(""ORPOTI OB2"","_$J _")"
  2051                "RTN","ORP OTIO",29,0 )
  2052                 .D K S ^T MP("ORPOTI OB2",$J,1, 0)=$P(ORPO TI("TN"),U )_" - INVA LID TEST N AME"
  2053                "RTN","ORP OTIO",30,0 )
  2054                 F ORPOTI( "I")=1:1:O RPOTI("N")  S ORPOTI( "TEST",ORP OTI("I"))= 0,ORPOTI(" TEST",ORPO TI("I"),OR POTI("TEST "))=""
  2055                "RTN","ORP OTIO",31,0 )
  2056                 S X=$$TES T^LRPXAPIU (ORPOTI("T EST")),ORP OTI("VALID TESTS",X)= ORPOTI("TE ST"),ORPOT I("VALIDTE STS","B",O RPOTI("TES T"))=X ;IA  4246
  2057                "RTN","ORP OTIO",32,0 )
  2058                 S (ORPOTI ("CHK",1), ORPOTI("CH K",2))=ORP OTI("TEST" ) D GET
  2059                "RTN","ORP OTIO",33,0 )
  2060                 D:$P(ORPO TI("TN"),U ,5)  ;also  display V erify Date
  2061                "RTN","ORP OTIO",34,0 )
  2062                 .F ORPOTI ("I")=9E9: 0 S ORPOTI ("I")=$O(^ TMP("ORPOT IOB2",$J,O RPOTI("I") ),-1) Q:'O RPOTI("I")   D
  2063                "RTN","ORP OTIO",35,0 )
  2064                 ..S ^TMP( "ORPOTIOB2 ",$J,ORPOT I("I")+2,0 )=^TMP("OR POTIOB2",$ J,ORPOTI(" I"),0)
  2065                "RTN","ORP OTIO",36,0 )
  2066                 .S ^TMP(" ORPOTIOB2" ,$J,1,0)="   TEST                     COLLE CTION DATE     RESULT       VERI FY DATE"
  2067                "RTN","ORP OTIO",37,0 )
  2068                 .S ^TMP(" ORPOTIOB2" ,$J,2,0)=" "
  2069                "RTN","ORP OTIO",38,0 )
  2070                ONEQ Q "~@ ^TMP(""ORP OTIOB2""," _$J_")"
  2071                "RTN","ORP OTIO",39,0 )
  2072                 ;
  2073                "RTN","ORP OTIO",40,0 )
  2074                GET ;Get d ata from ^ LR(DFN,"CH ")
  2075                "RTN","ORP OTIO",41,0 )
  2076                 N ORPOTIT EST,LRDFN, T,X S T=OR POTI("T")  D K,NONE
  2077                "RTN","ORP OTIO",42,0 )
  2078                 S ORPOTI( "N")=1
  2079                "RTN","ORP OTIO",43,0 )
  2080                 D RESULTS ^LRPXAPI(. ORPOTITEST ,DFN,"C",9 99,"","",D T,ORPOTI(" ED")) ;IA  4245
  2081                "RTN","ORP OTIO",44,0 )
  2082                 F ORPOTI( "I")=0:0 S  ORPOTI("I ")=$O(ORPO TI("VALIDT ESTS",ORPO TI("I")))  Q:'ORPOTI( "I")  D
  2083                "RTN","ORP OTIO",45,0 )
  2084                 .S ORPOTI ("VALIDTES TS","B",OR POTI("VALI DTESTS",OR POTI("I")) )=ORPOTI(" I")
  2085                "RTN","ORP OTIO",46,0 )
  2086                 S X="" F   S X=$O(OR POTITEST(X )) Q:X=""   D
  2087                "RTN","ORP OTIO",47,0 )
  2088                 .Q:'$P(OR POTITEST(X ),U,2)  Q: '$D(ORPOTI ("VALIDTES TS",$P(ORP OTITEST(X) ,U,2)))
  2089                "RTN","ORP OTIO",48,0 )
  2090                 .S ^TMP(" ORPOTIOB2" ,$J,"SORT" ,-ORPOTITE ST(X),$P(O RPOTITEST( X),U,2))=$ P(ORPOTITE ST(X),U,4, 5)
  2091                "RTN","ORP OTIO",49,0 )
  2092                 F ORPOTI( "I")=-9E9: 0 S ORPOTI ("I")=$O(^ TMP("ORPOT IOB2",$J," SORT",ORPO TI("I")))  Q:'ORPOTI( "I")  D
  2093                "RTN","ORP OTIO",50,0 )
  2094                 .S ORPOTI ("FLAG")=0
  2095                "RTN","ORP OTIO",51,0 )
  2096                 .F ORPOTI ("II")=0:0  S ORPOTI( "II")=$O(^ TMP("ORPOT IOB2",$J," SORT",ORPO TI("I"),OR POTI("II") )) Q:'ORPO TI("II")   D
  2097                "RTN","ORP OTIO",52,0 )
  2098                 ..Q:'$D(^ TMP("ORPOT IOB2",$J," SORT",ORPO TI("I"),OR POTI("VALI DTESTS","B ",ORPOTI(" CHK",1)))) !('$D(^TMP ("ORPOTIOB 2",$J,"SOR T",ORPOTI( "I"),ORPOT I("VALIDTE STS","B",O RPOTI("CHK ",2)))))
  2099                "RTN","ORP OTIO",53,0 )
  2100                 ..S ORPOT I("TEST")= ORPOTI("VA LIDTESTS", ORPOTI("II ")) Q:'$D( ORPOTI("TE ST",ORPOTI ("N"),ORPO TI("TEST") ))
  2101                "RTN","ORP OTIO",54,0 )
  2102                 ..S:'ORPO TI("TEST", ORPOTI("N" ),ORPOTI(" TEST")) OR POTI("TEST ",ORPOTI(" N"),ORPOTI ("TEST"))= ^TMP("ORPO TIOB2",$J, "SORT",ORP OTI("I"),O RPOTI("II" )),ORPOTI( "FLAG")=1
  2103                "RTN","ORP OTIO",55,0 )
  2104                 .S:ORPOTI ("FLAG") O RPOTI("TES T",ORPOTI( "N"))=-ORP OTI("I"),O RPOTI("N") =ORPOTI("N ")+1
  2105                "RTN","ORP OTIO",56,0 )
  2106                 K ^TMP("O RPOTIOB2", $J,"SORT")  Q
  2107                "RTN","ORP OTIO",57,0 )
  2108                 ;
  2109                "RTN","ORP OTIO",58,0 )
  2110                H(N) ;Head er line
  2111                "RTN","ORP OTIO",59,0 )
  2112                 N X S X=$ E($E($P(OR POTI("TN") ,U),1,11)_ " Coll. da te"_ORPOTI ("SP"),1,2 3)
  2113                "RTN","ORP OTIO",60,0 )
  2114                 F ORPOTI( "I")=N:0 S  ORPOTI("I ")=$O(ORPO TI("TEST", 1,ORPOTI(" I"))) Q:'O RPOTI("I") !($L(X)>72 )  D
  2115                "RTN","ORP OTIO",61,0 )
  2116                 .S ORPOTI ("XX")=ORP OTI("SP")
  2117                "RTN","ORP OTIO",62,0 )
  2118                 .S:ORPOTI ("XX")=""  ORPOTI("XX ")=$$LRDNM ^LRPXAPIU( ORPOTI("I" )),ORPOTI( "XX")=$E($ S(ORPOTI(" XX")]"":OR POTI("XX") ,1:"Unknow n"),1,8)_O RPOTI("SP" ) ;IA 4246
  2119                "RTN","ORP OTIO",63,0 )
  2120                 .S X=X_$E (ORPOTI("X X"),1,7)_"  " Q:$L(X) >72
  2121                "RTN","ORP OTIO",64,0 )
  2122                 D SET(X)  S ORPOTI(" HOLD")=ORP OTI("I")-. 1 Q
  2123                "RTN","ORP OTIO",65,0 )
  2124                 ;
  2125                "RTN","ORP OTIO",66,0 )
  2126                DAT(N) ;Da ta line
  2127                "RTN","ORP OTIO",67,0 )
  2128                 N X F ORP OTI("I")=1 :1:$P(ORPO TI("TN"),U ,2) Q:'ORP OTI("TEST" ,ORPOTI("I "))  D  D: $L(X)>72 S ET(X)
  2129                "RTN","ORP OTIO",68,0 )
  2130                 .S X=$$CO NV2(ORPOTI ("TEST",OR POTI("I")) )_ORPOTI(" SP"),X=$E( X,1,23)
  2131                "RTN","ORP OTIO",69,0 )
  2132                 .F ORPOTI ("TEST")=N :0 S ORPOT I("TEST")= $O(ORPOTI( "TEST",ORP OTI("I"),O RPOTI("TES T"))) D:'O RPOTI("TES T")&($L(X) <73) SET(X ) Q:'ORPOT I("TEST")   D  Q:$L(X )>72
  2133                "RTN","ORP OTIO",70,0 )
  2134                 ..S ORPOT I("XX")=$P (ORPOTI("T EST",ORPOT I("I"),ORP OTI("TEST" )),U) S:OR POTI("XX") >0&(ORPOTI ("XX")<1)& ($E(ORPOTI ("XX"))=". ") ORPOTI( "XX")=0_OR POTI("XX")
  2135                "RTN","ORP OTIO",71,0 )
  2136                 ..S:$P(OR POTI("TEST ",ORPOTI(" I"),ORPOTI ("TEST")), U,2)]"" OR POTI("XX") =ORPOTI("X X")_" "_$P (ORPOTI("T EST",ORPOT I("I"),ORP OTI("TEST" )),U,2)
  2137                "RTN","ORP OTIO",72,0 )
  2138                 ..S:$E(OR POTI("XX") ,8)?1A ORP OTI("XX")= $E(ORPOTI( "XX"),1,7) _" " S X=X _$E(ORPOTI ("XX")_ORP OTI("SP"), 1,8)
  2139                "RTN","ORP OTIO",73,0 )
  2140                 Q
  2141                "RTN","ORP OTIO",74,0 )
  2142                 ;
  2143                "RTN","ORP OTIO",75,0 )
  2144                CONV() Q $ $CONV2($$L RIDT^LRPXA PIU(ORPOTI ("TEST",OR POTI("I")) ))  ;IA 42 46
  2145                "RTN","ORP OTIO",76,0 )
  2146                CONV2(X) S  ORPOTI("X X")=$E($P( X,".",2)_" 0000",1,4)
  2147                "RTN","ORP OTIO",77,0 )
  2148                 S X=X_$E( ORPOTI("XX "),1,2)_": "_$E(ORPOT I("XX"),3, 4)
  2149                "RTN","ORP OTIO",78,0 )
  2150                 S X=$E(X, 4,5)_"/"_$ E(X,6,7)_" /"_$E(X,2, 3)_" @ "
  2151                "RTN","ORP OTIO",79,0 )
  2152                 S X=X_$E( ORPOTI("XX "),1,2)_": "_$E(ORPOT I("XX"),3, 4) Q X
  2153                "RTN","ORP OTIO",80,0 )
  2154                 ;
  2155                "RTN","ORP OTIO",81,0 )
  2156                SET(X) S O RPOTI("C") =ORPOTI("C ")+1,^TMP( "ORPOTIOB2 ",$J,ORPOT I("C"),0)= X,X="" Q
  2157                "RTN","ORP OTIO",82,0 )
  2158                 ;
  2159                "RTN","ORP OTIO",83,0 )
  2160                AGO N X1,X 2 S:'$D(OR POTI("T"))  ORPOTI("T ")=T
  2161                "RTN","ORP OTIO",84,0 )
  2162                 S X1=DT,X 2=+ORPOTI( "T"),X=$P( ORPOTI("T" ),X2,2),X2 =-X2
  2163                "RTN","ORP OTIO",85,0 )
  2164                 S X2=X2*$ S(X="M":30 ,X="W":7,X ="D":1,1:3 65)
  2165                "RTN","ORP OTIO",86,0 )
  2166                 D C^%DTC  S ORPOTI(" ED")=$$LRI DT^LRPXAPI U(X) Q  ;I A 4246
  2167                "RTN","ORP OTIO",87,0 )
  2168                 ;
  2169                "RTN","ORP OTIO",88,0 )
  2170                K K ^TMP(" ORPOTIOB2" ,$J) Q
  2171                "RTN","ORP OTIO",89,0 )
  2172                NONE S ^TM P("ORPOTIO B2",$J,1,0 )=$P(ORPOT I("TN"),U) _" - NONE  FOUND" Q
  2173                "RTN","ORP OTIO",90,0 )
  2174                D(Y) D DD^ %DT Q Y
  2175                "RTN","ORP OVST")
  2176                0^17^B5526 2882^n/a
  2177                "RTN","ORP OVST",1,0)
  2178                ORPOVST ;R 01/RMM Pop -Up for CH ECK PATIEN T VESTING  in CPRS ;3 /23/2012
  2179                "RTN","ORP OVST",2,0)
  2180                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 30
  2181                "RTN","ORP OVST",3,0)
  2182                 ;268 NAME : DBIA268- A
  2183                "RTN","ORP OVST",4,0)
  2184                 ;5408 NAM E: CPT/HCP CS Procedu re File 81
  2185                "RTN","ORP OVST",5,0)
  2186                 ;IA 1625  NAME: PERS ON CLASS A PI'S
  2187                "RTN","ORP OVST",6,0)
  2188                 ;
  2189                "RTN","ORP OVST",7,0)
  2190                 ;a patien t is conci dered vest ed if they  have an i npatient a dmission o r observat ion stay o f less tha n 24 hours
  2191                "RTN","ORP OVST",8,0)
  2192                 ;or outpa tient care  that in g eneral, eq uates to a  primary c are visit  by a clini cian autho rized to a dminister 
  2193                "RTN","ORP OVST",9,0)
  2194                 ;primary  care visit . A primar y care vis it is iden tified by  a list of  specific C urrent Pro cedural Te rminology 
  2195                "RTN","ORP OVST",10,0 )
  2196                 ;(CPT) co des identi fied in th is manual.  These cod es must be  administe red by at  least one  clinical p rovider 
  2197                "RTN","ORP OVST",11,0 )
  2198                 ;authoriz ed to comp lete the e quivalent  of a histo ry and phy sical. The  precise C PT codes a nd authori zed provid ers 
  2199                "RTN","ORP OVST",12,0 )
  2200                 ;are iden tified in  the docume ntation of  the Non-V ested pati ent class.  A patient  is requir ed to meet  the Vesti ng 
  2201                "RTN","ORP OVST",13,0 )
  2202                 ;criteria  once duri ng the cur rent year  or the pri or two fis cal years.  Patients  that do no t meet the  Vesting 
  2203                "RTN","ORP OVST",14,0 )
  2204                 ;requirem ents are p laced in t he Non-Ves ted patien t class.
  2205                "RTN","ORP OVST",15,0 )
  2206                EN(ORPODFN ) ;CALCULA TE VESTMEN T
  2207                "RTN","ORP OVST",16,0 )
  2208                 N ORPORET ,ORPOBD,OR POED,ORPOY ,ORPOM,ORP OI,ORPOII, ORPOA
  2209                "RTN","ORP OVST",17,0 )
  2210                 S ORPOY=$ E(DT,1,3), ORPOM=$E(D T,4,5),ORP OY=$S(ORPO M>9:ORPOY- 2,1:ORPOY- 3),ORPOBD= ORPOY_1001 ,ORPOED=DT ,ORPORET=" NON-VESTED "
  2211                "RTN","ORP OVST",18,0 )
  2212                 ;
  2213                "RTN","ORP OVST",19,0 )
  2214                 ;
  2215                "RTN","ORP OVST",20,0 )
  2216                 S ORPOI=" " F  S ORP OI=$O(^OR( 100.0074," B",ORPOI))  Q:ORPOI=" "  D
  2217                "RTN","ORP OVST",21,0 )
  2218                 .S:ORPOI[ "ICPT" ORP OA($$GET1^ DIQ(81,$P( ORPOI,";") ,.01))=""
  2219                "RTN","ORP OVST",22,0 )
  2220                 .S:ORPOI[ "USC" ORPO A($$GET1^D IQ(8932.1, $P(ORPOI," ;"),5))=""
  2221                "RTN","ORP OVST",23,0 )
  2222                 D CVS(ORP ODFN,.ORPO RET)
  2223                "RTN","ORP OVST",24,0 )
  2224                 Q ORPORET
  2225                "RTN","ORP OVST",25,0 )
  2226                CVS(ORPOPT ,ORPOR) ;C alculates  if a patie nt has the  required  local acti vity to be  considere d vested,  within the  current v esting per iod.
  2227                "RTN","ORP OVST",26,0 )
  2228                 ;The orde r of the s earch is l ocal ward  admission,  fee basis  inpatient  activity,  required  cpt code i n local ou tpatient a ctivity,
  2229                "RTN","ORP OVST",27,0 )
  2230                 ;and requ ired PERSO N CLASS in  fee basis  outpatien t activity .
  2231                "RTN","ORP OVST",28,0 )
  2232                 ;This fun ction is l ooking for  the first  occurrenc e within t he vesting  period. O nce an occ urrence is  found the  hunt is o ver.
  2233                "RTN","ORP OVST",29,0 )
  2234                 ;The cpt  codes used  in the se arch are f ound in fi le 100.007 4 and prov ider types  defined a s acceptab le person  classes 
  2235                "RTN","ORP OVST",30,0 )
  2236                 ;are in f ile 100.00 74
  2237                "RTN","ORP OVST",31,0 )
  2238                 I $G(ORPO PT)="" S O RPOR="INVA LID DFN" Q
  2239                "RTN","ORP OVST",32,0 )
  2240                 Q:ORPOR=" INVALID DF N"
  2241                "RTN","ORP OVST",33,0 )
  2242                 I '$D(^DP T(ORPOPT))  S ORPOR=" INVLAID DF N" Q
  2243                "RTN","ORP OVST",34,0 )
  2244                 S:$$GET1^ DIQ(2,ORPO PT,.152)]" " ORPOR="N OT ELIGIBL E"  ;scree n out pati ents not e ligible
  2245                "RTN","ORP OVST",35,0 )
  2246                 S:$$GET1^ DIQ(2,ORPO PT,1901,"I ")'="Y" OR POR="NON-V ETERAN" ;s creen out  non-vetera ns
  2247                "RTN","ORP OVST",36,0 )
  2248                 Q:ORPOR'= "NON-VESTE D"
  2249                "RTN","ORP OVST",37,0 )
  2250                 D ADM(ORP OPT,.ORPOR ) Q:ORPOR= "VESTED"
  2251                "RTN","ORP OVST",38,0 )
  2252                 D FEE(ORP OPT,.ORPOR ) Q:ORPOR= "VESTED"
  2253                "RTN","ORP OVST",39,0 )
  2254                 D FND(ORP OPT,.ORPOR )
  2255                "RTN","ORP OVST",40,0 )
  2256                 Q
  2257                "RTN","ORP OVST",41,0 )
  2258                 ;D LIST^D IC(162.02, ","_15682_ ","_38728_ ",","@;.01 I;","Q",,, ,"B") 
  2259                "RTN","ORP OVST",42,0 )
  2260                 ;D LIST^D IC(162.02, ","_15682_ ","_38728_ ",","@;.01 I;","Q",,, ,"B",,,"OR PO") 
  2261                "RTN","ORP OVST",43,0 )
  2262                 ;D LIST^D IC(162.03, ","_2_","_ 15682_","_ 38728_",", "@;.01;"," Q",,,,"B", ,,"ORPO") 
  2263                "RTN","ORP OVST",44,0 )
  2264                FND(ORPOPT ,ORPOR) ;
  2265                "RTN","ORP OVST",45,0 )
  2266                 N ORPOI,O RPOEP,ORPO FDT,ORPODT ,ORPORN,OR POPC,ORPOV N,ORPOII,O RPODOC
  2267                "RTN","ORP OVST",46,0 )
  2268                 ;^AUPNVCP T("AA",68, 82435,7009 871,376934 9)=""
  2269                "RTN","ORP OVST",47,0 )
  2270                 ;           PATIENT, CPT  ,REVE RSE DATE
  2271                "RTN","ORP OVST",48,0 )
  2272                 ;F ORPOI= 0:0 S ORPO I=$O(ORPOA (ORPOI)) Q :ORPOI["V"   D:$D(^AU PNVCPT("AA ",ORPOPT,O RPOI))  ;v isit xref  in v cpt f ile
  2273                "RTN","ORP OVST",49,0 )
  2274                 S ORPOI=" " F  S ORP OI=$O(ORPO A(ORPOI))  Q:ORPOI["V "!(ORPOI=" ")  D:$D(^ AUPNVCPT(" AA",ORPOPT ,ORPOI))   ;visit xre f in v cpt  file
  2275                "RTN","ORP OVST",50,0 )
  2276                 .S ORPODT =9999999-( ORPOED+1)  F  S ORPOD T=$O(^AUPN VCPT("AA", ORPOPT,ORP OI,ORPODT) ) Q:'ORPOD T!(ORPODT> (9999999-O RPOBD))  D
  2277                "RTN","ORP OVST",51,0 )
  2278                 ..S ORPOR N=$O(^AUPN VCPT("AA", ORPOPT,ORP OI,ORPODT, 0)),ORPOVN =$$GET1^DI Q(9000010. 18,ORPORN, .03,"I") ; visit ien
  2279                "RTN","ORP OVST",52,0 )
  2280                 ..S ORPOE P=$$GET1^D IQ(9000010 .18,ORPORN ,1204,"I")  S:ORPOEP] "" ORPODOC (ORPOEP)=" "  ;v cpt  file encou nter provi der
  2281                "RTN","ORP OVST",53,0 )
  2282                 ..;D:('OR POEP)&(ORP OVN)  ;if  no provide r, but vis it ien
  2283                "RTN","ORP OVST",54,0 )
  2284                 ..D:ORPOV N  ;if vis it ien
  2285                "RTN","ORP OVST",55,0 )
  2286                 ...D FIND ^DIC(90000 10.06,,"@; .01I;.04I" ,"Q",ORPOV N,,"AD") ; v provider  file
  2287                "RTN","ORP OVST",56,0 )
  2288                 ...F ORPO II=0:0 S O RPOII=$O(^ TMP("DILIS T",$J,2,OR POII)) Q:' ORPOII  D
  2289                "RTN","ORP OVST",57,0 )
  2290                 ....S ORP OEP=^TMP(" DILIST",$J ,"ID",ORPO II,.01) ;v isit provi der
  2291                "RTN","ORP OVST",58,0 )
  2292                 ....Q:'OR POEP  ;no  encounter  provider f or the cpt  code
  2293                "RTN","ORP OVST",59,0 )
  2294                 ....S ORP ODOC(ORPOE P)="" ;enc ounter pro vider
  2295                "RTN","ORP OVST",60,0 )
  2296                 ..F ORPOE P=0:0 S OR POEP=$O(OR PODOC(ORPO EP)) Q:'OR POEP  D
  2297                "RTN","ORP OVST",61,0 )
  2298                 ...S ORPO FDT=999999 9-ORPODT,O RPOPC=$$GE T^XUA4A72( ORPOEP,ORP OFDT)
  2299                "RTN","ORP OVST",62,0 )
  2300                 ...Q:ORPO PC=-1  ;no t a valid  user or pe rson class  never ass igned
  2301                "RTN","ORP OVST",63,0 )
  2302                 ...Q:ORPO PC=-2  ;no  active pe rson class  on that d ate
  2303                "RTN","ORP OVST",64,0 )
  2304                 ...Q:$P(O RPOPC,U,7) =""    ;QUIT IF N D A N C S D  
  2305                "RTN","ORP OVST",65,0 )
  2306                 ...S:$D(O RPOA($P(OR POPC,U,7)) ) ORPOR="V ESTED"
  2307                "RTN","ORP OVST",66,0 )
  2308                 Q
  2309                "RTN","ORP OVST",67,0 )
  2310                ADM(ORPOPT ,ORPOR) ;I F ADMITTED  IN LAST T WO YEARS V ESTED
  2311                "RTN","ORP OVST",68,0 )
  2312                 ;R01/RMM  ***MODIFIC ATION*** 8 /14/2015
  2313                "RTN","ORP OVST",69,0 )
  2314                 ;MODIFIED  TO FIND A LL INPATIE NTS DURNIN G VESTING  PERIOD
  2315                "RTN","ORP OVST",70,0 )
  2316                 ;THE OLD  CODE ONLY  FOUND PATI ENTS ADDMI TED DURING  THE VESTI NG PERIOD
  2317                "RTN","ORP OVST",71,0 )
  2318                 ;N ORPOAD
  2319                "RTN","ORP OVST",72,0 )
  2320                 ;S ORPOAD =ORPOBD F   S ORPOAD= $O(^DGPM(" APTT1",ORP OPT,ORPOAD )) Q:'ORPO AD!(ORPOAD >(ORPOED+. 9999))  D
  2321                "RTN","ORP OVST",73,0 )
  2322                 ;.S ORPOR ="VESTED"
  2323                "RTN","ORP OVST",74,0 )
  2324                 ;
  2325                "RTN","ORP OVST",75,0 )
  2326                 D FIND^DI C(45,,"@;. 01I;2I;11; 13I","Q",O RPOPT,,"B" ) ;PTF FIL E
  2327                "RTN","ORP OVST",76,0 )
  2328                 N ORPOI,O RPOF S ORP OF=0
  2329                "RTN","ORP OVST",77,0 )
  2330                 F ORPOI=0 :0  S ORPO I=$O(^TMP( "DILIST",$ J,2,ORPOI) ) Q:'ORPOI !(ORPOF=1)   D
  2331                "RTN","ORP OVST",78,0 )
  2332                 .Q:^TMP(" DILIST",$J ,"ID",ORPO I,.01)'=OR POPT
  2333                "RTN","ORP OVST",79,0 )
  2334                 .S:^TMP(" DILIST",$J ,"ID",ORPO I,2)>ORPOB D ORPOR="V ESTED",ORP OF=1
  2335                "RTN","ORP OVST",80,0 )
  2336                 .D:^TMP(" DILIST",$J ,"ID",ORPO I,11)="CEN SUS"
  2337                "RTN","ORP OVST",81,0 )
  2338                 ..D:^TMP( "DILIST",$ J,"ID",ORP OI,13)]""
  2339                "RTN","ORP OVST",82,0 )
  2340                 ...S:$$GE T1^DIQ(45. 86,^TMP("D ILIST",$J, "ID",ORPOI ,13),.01," I")>ORPOBD  ORPOR="VE STED",ORPO F=1
  2341                "RTN","ORP OVST",83,0 )
  2342                 ;*** END  MODIFICATI ON ***
  2343                "RTN","ORP OVST",84,0 )
  2344                 Q
  2345                "RTN","ORP OVST",85,0 )
  2346                 ;
  2347                "RTN","ORP OVST",86,0 )
  2348                FEE(ORPOPT ,ORPOR) ;  FEE BASIS  PATIENT
  2349                "RTN","ORP OVST",87,0 )
  2350                 N ORPOFP, ORPOTD,ORP OI,ORPOII, ORPOIII,OR POC,ORPOLS T,ORPOFDT, ORPOF,ORPO D3,ORPOVEN  S ORPOF=0
  2351                "RTN","ORP OVST",88,0 )
  2352                 S ORPOFP= 0 F  S ORP OFP=$O(^FB AAA("AQLVS ",ORPOPT,O RPOFP)) Q: 'ORPOFP  D
  2353                "RTN","ORP OVST",89,0 )
  2354                 .Q:ORPOFP =2  ;scree n out the  outpatient  fee basis  program
  2355                "RTN","ORP OVST",90,0 )
  2356                 .S ORPOTD =ORPOBD-1  F  S ORPOT D=$O(^FBAA A("AQLVS", ORPOPT,ORP OFP,ORPOTD )) Q:'ORPO TD  D
  2357                "RTN","ORP OVST",91,0 )
  2358                 ..S ORPOR ="VESTED"
  2359                "RTN","ORP OVST",92,0 )
  2360                 Q:ORPOR=" VESTED"
  2361                "RTN","ORP OVST",93,0 )
  2362                 D LIST^DI C(162.01," ,"_ORPOPT_ ",","@;.01 I;","Q",,, ,"B") ;FEE  BASIS PAY MENT PAYME NT
  2363                "RTN","ORP OVST",94,0 )
  2364                 F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI))  Q:'ORPOI! (ORPOF=1)   D
  2365                "RTN","ORP OVST",95,0 )
  2366                 .S ORPOVE N=^TMP("DI LIST",$J," ID",ORPOI, .01)
  2367                "RTN","ORP OVST",96,0 )
  2368                 .D LIST^D IC(162.02, ","_ORPOVE N_","_ORPO PT_",","@; .01I;","Q" ,,,,"B",,, "ORPOLST")
  2369                "RTN","ORP OVST",97,0 )
  2370                 .F ORPOII =0:0 S ORP OII=$O(ORP OLST("DILI ST",2,ORPO II)) Q:'OR POII!(ORPO F=1)  D
  2371                "RTN","ORP OVST",98,0 )
  2372                 ..S ORPOF DT=ORPOLST ("DILIST", "ID",ORPOI I,.01)
  2373                "RTN","ORP OVST",99,0 )
  2374                 ..Q:ORPOB D>ORPOFDT   ;SCREEN O UT IF BEGI NNING DATE  IS AFTER  DT
  2375                "RTN","ORP OVST",100, 0)
  2376                 ..Q:ORPOE D<ORPOFDT   ;SCREEN O UT IF END  DATE IS BE FORE DT
  2377                "RTN","ORP OVST",101, 0)
  2378                 ..S ORPOD 3=ORPOLST( "DILIST",2 ,ORPOII)
  2379                "RTN","ORP OVST",102, 0)
  2380                 ..D LIST^ DIC(162.03 ,","_ORPOD 3_","_ORPO VEN_","_OR POPT_","," @;.01;","Q ",,,,"B",, ,"ORPOC")
  2381                "RTN","ORP OVST",103, 0)
  2382                 ..F ORPOI II=0:0 S O RPOIII=$O( ORPOC("DIL IST",2,ORP OIII)) Q:' ORPOIII  D
  2383                "RTN","ORP OVST",104, 0)
  2384                 ...S:$D(O RPOA(ORPOC ("DILIST", "ID",ORPOI II,.01)))  ORPOR="VES TED",ORPOF =1
  2385                "RTN","ORP OVST",105, 0)
  2386                 Q
  2387                "RTN","ORP OVST",106, 0)
  2388                ADDT(X1,X2 ) ;ADD/SUB TRACT FROM  DATE
  2389                "RTN","ORP OVST",107, 0)
  2390                 N X D C^% DTC
  2391                "RTN","ORP OVST",108, 0)
  2392                 Q X
  2393                "RTN","ORP OVST",109, 0)
  2394                PRTV ;ENTR Y POINT FO R PRINTING  VESTING C ODES
  2395                "RTN","ORP OVST",110, 0)
  2396                 K ZTSAVE  D EN^XUTMD EVQ("START ^ORPOVST", "ORPOOR PR INT VESTIN G CODES")
  2397                "RTN","ORP OVST",111, 0)
  2398                 Q
  2399                "RTN","ORP OVST",112, 0)
  2400                START ;ENT RY POINT
  2401                "RTN","ORP OVST",113, 0)
  2402                 K ^TMP("D ILIST",$J) ,^TMP("ORP OORUTL",$J )
  2403                "RTN","ORP OVST",114, 0)
  2404                 D LIST^DI C(100.0074 ,,"@;.01I" ,"Q",,,,"B ")
  2405                "RTN","ORP OVST",115, 0)
  2406                 D GPTP,GC PT
  2407                "RTN","ORP OVST",116, 0)
  2408                 K ^TMP("D ILIST",$J) ,^TMP("ORP OORUTL",$J )
  2409                "RTN","ORP OVST",117, 0)
  2410                 Q
  2411                "RTN","ORP OVST",118, 0)
  2412                GPTP ;GET  PROVIDER T YPE
  2413                "RTN","ORP OVST",119, 0)
  2414                 N ORPOI,O RPOIEN,ORP O
  2415                "RTN","ORP OVST",120, 0)
  2416                 F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI))  Q:'ORPOI      ;PRINT  D A N C S D   S
  2417                "RTN","ORP OVST",121, 0)
  2418                 .Q:^TMP(" DILIST",$J ,"ID",ORPO I,.01)["IC PT"
  2419                "RTN","ORP OVST",122, 0)
  2420                 .S ORPOIE N=$P(^TMP( "DILIST",$ J,"ID",ORP OI,.01),"; ")
  2421                "RTN","ORP OVST",123, 0)
  2422                 .K ORPO
  2423                "RTN","ORP OVST",124, 0)
  2424                 .D FIND^D IC(8932.1, ,"@;5;6;", "Q","`"_OR POIEN,,,,, "ORPO")
  2425                "RTN","ORP OVST",125, 0)
  2426                 .S ^TMP(" ORPOORUTL" ,$J,ORPO(" DILIST","I D",1,5))=O RPO("DILIS T","ID",1, 6)
  2427                "RTN","ORP OVST",126, 0)
  2428                 D PTPV
  2429                "RTN","ORP OVST",127, 0)
  2430                 Q
  2431                "RTN","ORP OVST",128, 0)
  2432                GCPT ;GET  PROVIDER T YPE
  2433                "RTN","ORP OVST",129, 0)
  2434                 N ORPOI,O RPOIEN,ORP OCPT K ^TM P("ORPOORU TL",$J)
  2435                "RTN","ORP OVST",130, 0)
  2436                 F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI))  Q:'ORPOI      ;PRINT  D A N C S D   S
  2437                "RTN","ORP OVST",131, 0)
  2438                 .Q:^TMP(" DILIST",$J ,"ID",ORPO I,.01)["US C"
  2439                "RTN","ORP OVST",132, 0)
  2440                 .S ORPOIE N=$P(^TMP( "DILIST",$ J,"ID",ORP OI,.01),"; ")
  2441                "RTN","ORP OVST",133, 0)
  2442                 .S ORPOCP T=$$GET1^D IQ(81,ORPO IEN,.01)
  2443                "RTN","ORP OVST",134, 0)
  2444                 .S ^TMP(" ORPOORUTL" ,$J,ORPOCP T)=""
  2445                "RTN","ORP OVST",135, 0)
  2446                 D PTCPT
  2447                "RTN","ORP OVST",136, 0)
  2448                 Q
  2449                "RTN","ORP OVST",137, 0)
  2450                PTCPT ;PRI NT CPT
  2451                "RTN","ORP OVST",138, 0)
  2452                 N ORPOI,O RPOCOL,ORP OF,ORPORET  S ORPOCOL =0,ORPORET ="!",ORPOF =0
  2453                "RTN","ORP OVST",139, 0)
  2454                 W !!!!,"C PT codes f or CPRS ve sting",?40 ,"Print Da te: ",$$CN VDT(DT),!
  2455                "RTN","ORP OVST",140, 0)
  2456                 S ORPOI=" " F  S ORP OI=$O(^TMP ("ORPOORUT L",$J,ORPO I)) Q:ORPO I=""  D
  2457                "RTN","ORP OVST",141, 0)
  2458                 .I ORPORE T]"" W @OR PORET,?ORP OCOL,ORPOI
  2459                "RTN","ORP OVST",142, 0)
  2460                 .E   W ?O RPOCOL,ORP OI
  2461                "RTN","ORP OVST",143, 0)
  2462                 .S:ORPOCO L=60 ORPOC OL=0,ORPOR ET="!",ORP OF=1
  2463                "RTN","ORP OVST",144, 0)
  2464                 .S:ORPOCO L=50 ORPOC OL=60,ORPO RET=""
  2465                "RTN","ORP OVST",145, 0)
  2466                 .S:ORPOCO L=40 ORPOC OL=50,ORPO RET=""
  2467                "RTN","ORP OVST",146, 0)
  2468                 .S:ORPOCO L=30 ORPOC OL=40,ORPO RET=""
  2469                "RTN","ORP OVST",147, 0)
  2470                 .S:ORPOCO L=20 ORPOC OL=30,ORPO RET=""
  2471                "RTN","ORP OVST",148, 0)
  2472                 .S:ORPOCO L=10 ORPOC OL=20,ORPO RET=""
  2473                "RTN","ORP OVST",149, 0)
  2474                 .I ORPOCO L=0,ORPOF= 0 S ORPOCO L=10,ORPOR ET=""
  2475                "RTN","ORP OVST",150, 0)
  2476                 .S ORPOF= 0
  2477                "RTN","ORP OVST",151, 0)
  2478                 Q
  2479                "RTN","ORP OVST",152, 0)
  2480                CNVDT(Y) ; FORMAT INT ERNAL TO E XTERNAL DA TE
  2481                "RTN","ORP OVST",153, 0)
  2482                 D DD^%DT
  2483                "RTN","ORP OVST",154, 0)
  2484                 Q Y
  2485                "RTN","ORP OVST",155, 0)
  2486                PTPV ;PRIN T PROVIDER  TYPE
  2487                "RTN","ORP OVST",156, 0)
  2488                 N ORPOI,O RPOCOL,ORP OF,ORPORET  S ORPOCOL =0,ORPORET ="!",ORPOF =0
  2489                "RTN","ORP OVST",157, 0)
  2490                 W !!!,"Pr ovider Typ es for CPR S vesting" ,?45,"Prin t Date: ", $$CNVDT(DT ),!
  2491                "RTN","ORP OVST",158, 0)
  2492                 S ORPOI=" " F  S ORP OI=$O(^TMP ("ORPOORUT L",$J,ORPO I)) Q:ORPO I=""  D
  2493                "RTN","ORP OVST",159, 0)
  2494                 .I ORPORE T]"" W @OR PORET,?ORP OCOL,ORPOI ," - ",^TM P("ORPOORU TL",$J,ORP OI)
  2495                "RTN","ORP OVST",160, 0)
  2496                 .E   W ?O RPOCOL,ORP OI," - ",^ TMP("ORPOO RUTL",$J,O RPOI)
  2497                "RTN","ORP OVST",161, 0)
  2498                 .S:ORPOCO L=52 ORPOC OL=0,ORPOR ET="!",ORP OF=1
  2499                "RTN","ORP OVST",162, 0)
  2500                 .S:ORPOCO L=26 ORPOC OL=52,ORPO RET=""
  2501                "RTN","ORP OVST",163, 0)
  2502                 .I ORPOCO L=0,ORPOF= 0 S ORPOCO L=26,ORPOR ET=""
  2503                "RTN","ORP OVST",164, 0)
  2504                 .S ORPOF= 0
  2505                "RTN","ORP OVST",165, 0)
  2506                 Q
  2507                "RTN","ORP OVST",166, 0)
  2508                 ;
  2509                "RTN","ORP OVST",167, 0)
  2510                 ;
  2511                "RTN","ORP OVST",168, 0)
  2512                 ;
  2513                "RTN","ORP OVST",169, 0)
  2514                TEST(DT) ; *****  cod e used for  testing n ew dates   *****
  2515                "RTN","ORP OVST",170, 0)
  2516                 ;The tran sition to  the 2-year  rolling p opulation  will occur  increment ally over  the course  of three  consecutiv e VERA Mod els.
  2517                "RTN","ORP OVST",171, 0)
  2518                 ;Each of  the three  impending  models are  listed be low 
  2519                "RTN","ORP OVST",172, 0)
  2520                 ;VERA 201 5: Fund 2. 66 years o f Basic Ca re populat ion (i.e.  reduce thi rd year po pulation b y 33%) 
  2521                "RTN","ORP OVST",173, 0)
  2522                 ;VERA 201 6: Fund 2. 33 years o f Basic Ca re populat ion (i.e.  reduce thi rd year po pulation b y 66 %) 
  2523                "RTN","ORP OVST",174, 0)
  2524                 ;VERA 201 7: Fund ro lling 2-ye ar Basic C are patien t populati on.
  2525                "RTN","ORP OVST",175, 0)
  2526                 N ASV,ASV 1
  2527                "RTN","ORP OVST",176, 0)
  2528                 F ASV=1:1 :9 D  ;yea r
  2529                "RTN","ORP OVST",177, 0)
  2530                 .F ASV1=1 :1:12 D  ; month
  2531                "RTN","ORP OVST",178, 0)
  2532                 ..S DT=$E (DT,1,2)_A SV_$S($L(A SV1)=2:ASV 1,1:"0"_AS V1)_15 ; W  !,DT
  2533                "RTN","ORP OVST",179, 0)
  2534                 ..S ORPOY =$E(DT,1,3 ),ORPOM=$E (DT,4,5),O RPOY=$S(OR POM>9:ORPO Y-2,1:ORPO Y-3),ORPOB D=ORPOY_10 01,ORPOED= DT,ORPORET ="NON-VEST ED"
  2535                "RTN","ORP OVST",180, 0)
  2536                 ..W !!,DT ,?16,ORPOB D,?30,$$CN VDT(ORPOBD )
  2537                "RTN","ORP OVST",181, 0)
  2538                 ..S (ORPO Y,ORPOM,OR POBD)=""
  2539                "RTN","ORP OVST",182, 0)
  2540                 ..S ORPOY =$E(DT,1,3 ),ORPOM=$E (DT,4,5),O RPOED=DT,O RPORET="NO N-VESTED"  S:ORPOM>9  ORPOY=ORPO Y+1 ;,ORPO BD=ORPOY_1 001,
  2541                "RTN","ORP OVST",183, 0)
  2542                 ..D:ORPOY <315
  2543                "RTN","ORP OVST",184, 0)
  2544                 ...S ORPO Y=ORPOY-3, ORPOBD=ORP OY_1001
  2545                "RTN","ORP OVST",185, 0)
  2546                 ..D:ORPOY =315
  2547                "RTN","ORP OVST",186, 0)
  2548                 ...S ORPO Y=ORPOY-2, ORPOBD=ORP OY_"0201"
  2549                "RTN","ORP OVST",187, 0)
  2550                 ..D:ORPOY =316
  2551                "RTN","ORP OVST",188, 0)
  2552                 ...S ORPO Y=ORPOY-2, ORPOBD=ORP OY_"0601"
  2553                "RTN","ORP OVST",189, 0)
  2554                 ..D:ORPOY >=317
  2555                "RTN","ORP OVST",190, 0)
  2556                 ...S ORPO Y=ORPOY-2, ORPOBD=ORP OY_1001
  2557                "RTN","ORP OVST",191, 0)
  2558                 ..W !,$$C NVDT(DT),? 16,ORPOBD, ?30,$$CNVD T(ORPOBD)
  2559                "RTN","ORP OVST",192, 0)
  2560                 Q
  2561                "RTN","ORW DX")
  2562                0^3^B78560 931^B72026 068
  2563                "RTN","ORW DX",1,0)
  2564                ORWDX ; SL C/KCM/REV/ JLI - Orde r dialog u tilities ; 12/07/15   10:59
  2565                "RTN","ORW DX",2,0)
  2566                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**1 0,85,125,1 31,132,141 ,164,178,1 87,190,195 ,215,246,2 43,283,296 ,280,306,3 50,424,431 **;Dec 17,  1997;Buil d 30
  2567                "RTN","ORW DX",3,0)
  2568                 ;Per VHA  Directive  6402, this  routine s hould not  be modifie d.
  2569                "RTN","ORW DX",4,0)
  2570                 ;Referenc e to DIC(9 .4 support ed by IA # 2058
  2571                "RTN","ORW DX",5,0)
  2572                 ;
  2573                "RTN","ORW DX",6,0)
  2574                ORDITM(Y,F ROM,DIR,XR EF,QOCALL)  ; Subset  of orderab le items
  2575                "RTN","ORW DX",7,0)
  2576                 ; Y(n)=IE N^.01 Name ^.01 Name   -or-  IEN ^Synonym < .01 Name>^ .01 Name
  2577                "RTN","ORW DX",8,0)
  2578                 N I,IEN,C NT,X,DTXT, CURTM,DEFR OUTE
  2579                "RTN","ORW DX",9,0)
  2580                 S DEFROUT E=""
  2581                "RTN","ORW DX",10,0)
  2582                 S QOCALL= +$G(QOCALL )
  2583                "RTN","ORW DX",11,0)
  2584                 S I=0,CNT =44,CURTM= $$NOW^XLFD T
  2585                "RTN","ORW DX",12,0)
  2586                 F  Q:I'<C NT  S FROM =$O(^ORD(1 01.43,XREF ,FROM),DIR ) Q:FROM=" "  D
  2587                "RTN","ORW DX",13,0)
  2588                 . S IEN=" " F  S IEN =$O(^ORD(1 01.43,XREF ,FROM,IEN) ,DIR) Q:'I EN  D
  2589                "RTN","ORW DX",14,0)
  2590                 . . S X=^ ORD(101.43 ,XREF,FROM ,IEN)
  2591                "RTN","ORW DX",15,0)
  2592                 . . I +$P (X,U,3),$P (X,U,3)<CU RTM Q
  2593                "RTN","ORW DX",16,0)
  2594                 . . I '$$ START(XREF ,IEN) Q
  2595                "RTN","ORW DX",17,0)
  2596                 . . I 'QO CALL,$P(X, U,5) Q
  2597                "RTN","ORW DX",18,0)
  2598                 . . S I=I +1
  2599                "RTN","ORW DX",19,0)
  2600                 . . I 'X  S Y(I)=IEN _U_$P(X,U, 2)_U_$P(X, U,2)
  2601                "RTN","ORW DX",20,0)
  2602                 . . E  S  Y(I)=IEN_U _$P(X,U,2) _$C(9)_"<" _$P(X,U,4) _">"_U_$P( X,U,4)
  2603                "RTN","ORW DX",21,0)
  2604                 Q
  2605                "RTN","ORW DX",22,0)
  2606                 ;
  2607                "RTN","ORW DX",23,0)
  2608                START(INDE X,ET) ; Ch eck to see  if test i s part of  users DUZ( 2)
  2609                "RTN","ORW DX",24,0)
  2610                 ;
  2611                "RTN","ORW DX",25,0)
  2612                 S OUT=1
  2613                "RTN","ORW DX",26,0)
  2614                 I INDEX=" S.LAB" D
  2615                "RTN","ORW DX",27,0)
  2616                 . N NOD,P
  2617                "RTN","ORW DX",28,0)
  2618                 . S NOD=^ ORD(101.43 ,ET,0),P=$ P($P(NOD,U ,2),";")
  2619                "RTN","ORW DX",29,0)
  2620                 . I '$D(^ LAB(60,P))  Q
  2621                "RTN","ORW DX",30,0)
  2622                 . I '$D(^ LAB(60,P,8 )) Q
  2623                "RTN","ORW DX",31,0)
  2624                 . I '$D(^ LAB(60,P,8 ,DUZ(2)))  S OUT=0
  2625                "RTN","ORW DX",32,0)
  2626                 Q OUT
  2627                "RTN","ORW DX",33,0)
  2628                 ;
  2629                "RTN","ORW DX",34,0)
  2630                ODITMBC(Y, XREF,ODLST ) ;
  2631                "RTN","ORW DX",35,0)
  2632                 N CNT,NM, XRF
  2633                "RTN","ORW DX",36,0)
  2634                 S CNT=0,N M=0,XRF=XR EF
  2635                "RTN","ORW DX",37,0)
  2636                 F  S CNT= $O(ODLST(C NT)) Q:'CN T  D FNDIN FO(.Y,ODLS T(CNT))
  2637                "RTN","ORW DX",38,0)
  2638                 Q
  2639                "RTN","ORW DX",39,0)
  2640                FNDINFO(Y, ODIEN) ;
  2641                "RTN","ORW DX",40,0)
  2642                 D FNDINFO ^ORWDX1(.Y ,.ODIEN)
  2643                "RTN","ORW DX",41,0)
  2644                 Q
  2645                "RTN","ORW DX",42,0)
  2646                DLGDEF(LST ,DLG) ; Fo rmat mappi ng for a d lg
  2647                "RTN","ORW DX",43,0)
  2648                 D DLGDEF^ ORWDX1(.LS T,.DLG)
  2649                "RTN","ORW DX",44,0)
  2650                 Q
  2651                "RTN","ORW DX",45,0)
  2652                DLGQUIK(LS T,QO) ;(NO T USED)
  2653                "RTN","ORW DX",46,0)
  2654                 D LOADRSP (.LST,QO)
  2655                "RTN","ORW DX",47,0)
  2656                 Q
  2657                "RTN","ORW DX",48,0)
  2658                LOADRSP(LS T,RSPID,TR ANS) ; Loa d response s from 101 .41 or 100
  2659                "RTN","ORW DX",49,0)
  2660                 ; RSPID:   C123456;1 -3243 = ca ched copy,    134-323 4 = cached  quick
  2661                "RTN","ORW DX",50,0)
  2662                 ;          X123456;1       = ch ange order ,  134       = quick  dialog
  2663                "RTN","ORW DX",51,0)
  2664                 N I,J,DLG ,INST,ID,V AL,ILST,RO OT,ORLOC S  ROOT=""
  2665                "RTN","ORW DX",52,0)
  2666                 K ^TMP($J ,"ORWDX LO ADRSP","QO  SAVE")
  2667                "RTN","ORW DX",53,0)
  2668                 I +RSPID= $P(RSPID," -",1) D
  2669                "RTN","ORW DX",54,0)
  2670                 .S ^TMP($ J,"ORWDX L OADRSP","Q O SAVE")=+ RSPID
  2671                "RTN","ORW DX",55,0)
  2672                 I RSPID[" -" S ROOT= "^TMP(""OR WDXMQ"",$J ,"""_RSPID _""")" G X ROOT^ORWDX 2
  2673                "RTN","ORW DX",56,0)
  2674                 I $E(RSPI D)="X" S R OOT="^OR(1 00,"_+$P(R SPID,"X",2 )_",4.5)"   G XROOT^O RWDX2
  2675                "RTN","ORW DX",57,0)
  2676                 I +RSPID= RSPID  S R OOT="^ORD( 101.41,"_+ RSPID_",6) " G XROOT^ ORWDX2
  2677                "RTN","ORW DX",58,0)
  2678                 Q:ROOT=""
  2679                "RTN","ORW DX",59,0)
  2680                 G XROOT^O RWDX2
  2681                "RTN","ORW DX",60,0)
  2682                SAVE(REC,O RVP,ORNP,O RL,DLG,ORD G,ORIT,ORI FN,ORDIALO G,ORDEA,OR APPT,ORSRC ,OREVTDF)  ;
  2683                "RTN","ORW DX",61,0)
  2684                 ; ORVP=DF N, ORNP=Pr ovider, OR L=Location , DLG=Orde r Dialog,
  2685                "RTN","ORW DX",62,0)
  2686                 ; ORDG=Di splay Grou p, ORIT=Qu ick Order  Dialog, OR APPT=Appoi ntment
  2687                "RTN","ORW DX",63,0)
  2688                 N ORDUZ,O RSTS,OREVE NT,ORCAT,O RDA,ORTS,O RNEW,ORCHE CK,ORLOG,O RLEAD,ORTR AIL,ORPKG, ORWP94,ORC ATFN,OREVT YPE,ONPASS
  2689                "RTN","ORW DX",64,0)
  2690                 N XCNT,XC OMM,XDONE, XX  ;SBR
  2691                "RTN","ORW DX",65,0)
  2692                 S (XCOMM, XCNT)=""   ;SBR
  2693                "RTN","ORW DX",66,0)
  2694                 I $G(ORIF N)'="" D   ;SBR probl em only oc curs on ch ange or re new orders
  2695                "RTN","ORW DX",67,0)
  2696                 . S XCNT= $O(^OR(100 ,+ORIFN,4. 5,"ID","CO MMENT",XCN T))  ;SBR
  2697                "RTN","ORW DX",68,0)
  2698                 . I XCNT' ="" S XCOM M=$P($G(^O R(100,+ORI FN,4.5,XCN T,0)),"^", 2)  ;SBR
  2699                "RTN","ORW DX",69,0)
  2700                 . I XCOMM '="" S XDO NE=0,XX=""  F  S XX=$ O(ORDIALOG ("WP",XCOM M,1,XX)) Q :XX=""  D   ;SBR
  2701                "RTN","ORW DX",70,0)
  2702                 . . I ORD IALOG("WP" ,XCOMM,1,X X,0)'="" S  XDONE=1 Q   ;SBR
  2703                "RTN","ORW DX",71,0)
  2704                 . I XCOMM '="",'$G(X DONE),$D(O RDIALOG("W P",XCOMM))  K ORDIALO G("WP",XCO MM)  ;SBR
  2705                "RTN","ORW DX",72,0)
  2706                 S ORCATFN ="" I $L($ P(DLG,U,2) ) S ORCATF N=$P(DLG,U ,2),DLG=$P (DLG,U,1)
  2707                "RTN","ORW DX",73,0)
  2708                 ;Remove t reating fa cility if  inpatient  and IMO or der 26.42
  2709                "RTN","ORW DX",74,0)
  2710                 I $G(^DPT (ORVP,.1)) '="",$P($G (^ORD(100. 98,ORDG,0) ),U)="CLIN IC MEDICAT IONS" K OR DIALOG("OR TS")
  2711                "RTN","ORW DX",75,0)
  2712                 I $G(^DPT (ORVP,.1)) '="",$P($G (^ORD(100. 98,ORDG,0) ),U)="CLIN IC INFUSIO NS" K ORDI ALOG("ORTS ")
  2713                "RTN","ORW DX",76,0)
  2714                 I $G(ORDI ALOG("ORTS ")) S ORTS =ORDIALOG( "ORTS") K  ORDIALOG(" ORTS")
  2715                "RTN","ORW DX",77,0)
  2716                 I $G(ORDI ALOG("ORSL OG")) S OR LOG=ORDIAL OG("ORSLOG ") K ORDIA LOG("ORSLO G")
  2717                "RTN","ORW DX",78,0)
  2718                 I $D(ORDI ALOG("OREV ENT")) S O REVENT=ORD IALOG("ORE VENT") K O RDIALOG("O REVENT")
  2719                "RTN","ORW DX",79,0)
  2720                 ;======== ========== ========== ========== ========== =====
  2721                "RTN","ORW DX",80,0)
  2722                 ; Changed  for v26.2 7 (RV)
  2723                "RTN","ORW DX",81,0)
  2724                 S ORCAT=$ $INPT^ORCD ,ORCAT=$S( ORCAT=1:"I ",1:"O")
  2725                "RTN","ORW DX",82,0)
  2726                 ;I $L($G( OREVENT))  D
  2727                "RTN","ORW DX",83,0)
  2728                 ;. S ONPA SS=0
  2729                "RTN","ORW DX",84,0)
  2730                 ;. S OREV TYPE=$$TYP E^OREVNTX( OREVENT)
  2731                "RTN","ORW DX",85,0)
  2732                 ;. I OREV TYPE="T" D  ISPASS^OR EVNTX1(.ON PASS,+OREV ENT,"T")
  2733                "RTN","ORW DX",86,0)
  2734                 ;. S ORCA T=$S(OREVT YPE="A":"I ",OREVTYPE ="T":"I",O NPASS=1:"O ",1:"O")
  2735                "RTN","ORW DX",87,0)
  2736                 ;E  S ORC AT=$S($L($ P($G(^DPT( +ORVP,.1)) ,U)):"I",1 :"O")
  2737                "RTN","ORW DX",88,0)
  2738                 ;======== ========== ========== ========== ========== =====
  2739                "RTN","ORW DX",89,0)
  2740                 I DLG="PS  MEDS" S O RWP94=1 D
  2741                "RTN","ORW DX",90,0)
  2742                 . I ORIT= $O(^ORD(10 1.41,"AB", "PSO SUPPL Y",0)) S D LG="PSO SU PPLY"
  2743                "RTN","ORW DX",91,0)
  2744                 . I ORIT= $O(^ORD(10 1.41,"AB", "PSO OERR" ,0)) S DLG ="PSO OERR "
  2745                "RTN","ORW DX",92,0)
  2746                 . I ORIT= $O(^ORD(10 1.41,"AB", "PSJ OR PA T OE",0))  S DLG="PSJ  OR PAT OE "
  2747                "RTN","ORW DX",93,0)
  2748                 I DLG="PS O OERR"!(D LG="PSO SU PPLY") S O RCAT="O" I  $G(OREVEN T("EFFECTI VE")) D
  2749                "RTN","ORW DX",94,0)
  2750                 . S ORDIA LOG($O(^OR D(101.41," B","OR GTX  START DAT E"_$S($G(O RWP94):"/T IME",1:"") ,0)),1)=OR EVENT("EFF ECTIVE")
  2751                "RTN","ORW DX",95,0)
  2752                 I DLG="PS J OR PAT O E" S ORCAT ="I"
  2753                "RTN","ORW DX",96,0)
  2754                 I DLG="PS J OR CLINI C OE" S OR CAT="I"
  2755                "RTN","ORW DX",97,0)
  2756                 I DLG="CL INIC OR PA T FLUID OE " S ORCAT= "I"
  2757                "RTN","ORW DX",98,0)
  2758                 S:DLG="FH W1" ORCAT= "I" S:DLG? 1"FHW "2.7 U1" MEAL"  ORCAT="O"
  2759                "RTN","ORW DX",99,0)
  2760                 S ORVP=OR VP_";DPT(" ,ORL(2)=OR L_";SC(",O RL=ORL(2)
  2761                "RTN","ORW DX",100,0)
  2762                 I ORDG=$O (^ORD(100. 98,"B","LA B",0)) D   ;use secti on
  2763                "RTN","ORW DX",101,0)
  2764                 . N OI,SU B S OI=+$G (ORDIALOG( $$PTR^ORCD ("OR GTX O RDERABLE I TEM"),1))
  2765                "RTN","ORW DX",102,0)
  2766                 . S SUB=$ P($G(^ORD( 101.43,OI, "LR")),U,6 ),ORDG=$$D GRP^ORMLR( SUB)
  2767                "RTN","ORW DX",103,0)
  2768                 K:'ORDG O RDG K:'ORI T ORIT ; D grp & Quic k must be  non-zero
  2769                "RTN","ORW DX",104,0)
  2770                 M ORCHECK =ORDIALOG( "ORCHECK")  K ORDIALO G("ORCHECK ")
  2771                "RTN","ORW DX",105,0)
  2772                 S ORDIALO G=$O(^ORD( 101.41,"AB ",DLG,0))
  2773                "RTN","ORW DX",106,0)
  2774                 I 'ORDIAL OG S ORDIA LOG=$O(^OR D(101.41," B",DLG,0))
  2775                "RTN","ORW DX",107,0)
  2776                 I $D(ORDI ALOG("ORLE AD")) S OR LEAD=ORDIA LOG("ORLEA D")
  2777                "RTN","ORW DX",108,0)
  2778                 I $D(ORDI ALOG("ORTR AIL")) S O RTRAIL=ORD IALOG("ORT RAIL")
  2779                "RTN","ORW DX",109,0)
  2780                 D GETDLG1 ^ORCD(ORDI ALOG)
  2781                "RTN","ORW DX",110,0)
  2782                 I $L(ORCA TFN) S ORC AT=ORCATFN
  2783                "RTN","ORW DX",111,0)
  2784                 I $G(ORWP 94) D
  2785                "RTN","ORW DX",112,0)
  2786                 . N SIGPR MT S SIGPR MT=$O(^ORD (101.41,"B ","OR GTX  SIG",0))
  2787                "RTN","ORW DX",113,0)
  2788                 . N INSPR MT S INSPR MT=$O(^ORD (101.41,"B ","OR GTX  INSTRUCTIO NS",0))
  2789                "RTN","ORW DX",114,0)
  2790                 . I $L($G (ORDIALOG( SIGPRMT,1) )) S ORDIA LOG(INSPRM T,"FORMAT" )="@"
  2791                "RTN","ORW DX",115,0)
  2792                 . I ORCAT ="O" S ORP KG=$O(^DIC (9.4,"C"," PSO",0))
  2793                "RTN","ORW DX",116,0)
  2794                 . I ORCAT ="I" S ORP KG=$O(^DIC (9.4,"C"," PSJ",0))
  2795                "RTN","ORW DX",117,0)
  2796                 S ORSRC=$ G(ORSRC)
  2797                "RTN","ORW DX",118,0)
  2798                 D DELPI^O RWDX1 ;del ete empty  PI
  2799                "RTN","ORW DX",119,0)
  2800                 I $G(ORIF N)="" D  ;  new order
  2801                "RTN","ORW DX",120,0)
  2802                 . D EN^OR CSAVE
  2803                "RTN","ORW DX",121,0)
  2804                 . S REC=" " I ORIFN  D GETBYIFN ^ORWORR(.R EC,ORIFN)
  2805                "RTN","ORW DX",122,0)
  2806                 . I '$D(^ TMP("ORECA LL",$J,ORD IALOG)) M  ^TMP("OREC ALL",$J,OR DIALOG)=OR DIALOG
  2807                "RTN","ORW DX",123,0)
  2808                 E  D
  2809                "RTN","ORW DX",124,0)
  2810                 . N OR0
  2811                "RTN","ORW DX",125,0)
  2812                 . S OR0=$ G(^OR(100, +ORIFN,0)) ,ORSTS=$P( $G(^(3)),U ,3),ORDG=$ P(OR0,U,11 )
  2813                "RTN","ORW DX",126,0)
  2814                 . I $L($P (OR0,U,17) ),ORSTS=10  S OREVENT =$P(OR0,U, 17),OREVEN T("TS")=$P (OR0,U,13)
  2815                "RTN","ORW DX",127,0)
  2816                 . D XX^OR CSAVE ; ed it order
  2817                "RTN","ORW DX",128,0)
  2818                 . S REC=" " S ORIFN= +ORIFN_";" _ORDA D GE TBYIFN^ORW ORR(.REC,O RIFN)
  2819                "RTN","ORW DX",129,0)
  2820                 Q
  2821                "RTN","ORW DX",130,0)
  2822                SENDED(ORW LST,ORIENS ,TS,LOC) ;  Release E DOs to svc
  2823                "RTN","ORW DX",131,0)
  2824                 N OK,ORVP ,ORWERR,OR SIGST,ORDA ,ORNATURE, ORIX,X,PTE VT,ORIFN,J ,EVENT,LOC K,OR3
  2825                "RTN","ORW DX",132,0)
  2826                 S ORWERR= "",ORIX=0, LOC=LOC_"; SC("
  2827                "RTN","ORW DX",133,0)
  2828                 F  S ORIX =$O(ORIENS (ORIX)) Q: 'ORIX  D   Q:ORWERR]" "
  2829                "RTN","ORW DX",134,0)
  2830                 . S (ORIF N,ORWLST(O RIX))=ORIE NS(ORIX)
  2831                "RTN","ORW DX",135,0)
  2832                 . S PTEVT =$P(^OR(10 0,+ORIFN,0 ),U,17)
  2833                "RTN","ORW DX",136,0)
  2834                 . I PTEVT  D
  2835                "RTN","ORW DX",137,0)
  2836                 .. I $D(E VENT(PTEVT )) S LOCK= 1 Q
  2837                "RTN","ORW DX",138,0)
  2838                 .. S LOCK =$$LCKEVT^ ORX2(PTEVT ) S:LOCK E VENT(PTEVT )=""
  2839                "RTN","ORW DX",139,0)
  2840                 . I 'LOCK  S ORWERR= "1^delayed  event is  locked - a nother use r is proce ssing orde rs for thi s event" S  ORWLST(OR IX)=ORWLST (ORIX)_"^E ^"_ORWERR  Q
  2841                "RTN","ORW DX",140,0)
  2842                 . S ORDA= $P(ORIFN," ;",2) S:'O RDA ORDA=1
  2843                "RTN","ORW DX",141,0)
  2844                 . S ORVP= $P($G(^OR( 100,+ORIFN ,0)),U,2)
  2845                "RTN","ORW DX",142,0)
  2846                 . I $D(^O R(100,+ORI FN,8,ORDA, 0)) D
  2847                "RTN","ORW DX",143,0)
  2848                 .. S ORSI GST=$P($G( ^(0)),U,4) ,ORNATURE= $P($G(^(0) ),U,12) ;n aked refer ences refe r to OR(10 0,+ORIFN,8 ,ORDA on l ine above
  2849                "RTN","ORW DX",144,0)
  2850                 . S OK=$$ LOCK1^ORX2 (ORIFN) I  'OK S ORWE RR="1^"_$P (OK,U,2)
  2851                "RTN","ORW DX",145,0)
  2852                 . I OK,$G (LOCK) D
  2853                "RTN","ORW DX",146,0)
  2854                 .. S OR3= $G(^OR(100 ,+ORIFN,3) ) I $P(OR3 ,"^",3)'=1 0!($P(OR3, "^",9)]"")  D UNLK1^O RX2(ORIENS (ORIX)) Q   ;order al ready rele ased or ha s a parent
  2855                "RTN","ORW DX",147,0)
  2856                 .. S:$G(L OC) $P(^OR (100,+ORIF N,0),U,10) =LOC ;set  location
  2857                "RTN","ORW DX",148,0)
  2858                 .. S:$G(T S) $P(^OR( 100,+ORIFN ,0),U,13)= TS ;set sp ecialty
  2859                "RTN","ORW DX",149,0)
  2860                 .. D EN2^ ORCSEND(OR IENS(ORIX) ,ORSIGST,O RNATURE,.O RWERR),UNL K1^ORX2(OR IENS(ORIX) ) ;add ,LO CK to if s tatement f or 195
  2861                "RTN","ORW DX",150,0)
  2862                 . I $L(OR WERR) S OR WLST(ORIX) =ORWLST(OR IX)_"^E^"_ ORWERR Q
  2863                "RTN","ORW DX",151,0)
  2864                 . E  D
  2865                "RTN","ORW DX",152,0)
  2866                 .. S PTEV T=$P($G(^O R(100,+ORI ENS(ORIX), 0)),U,17)
  2867                "RTN","ORW DX",153,0)
  2868                 .. D:$$TY PE^OREVNTX (PTEVT)="M " SAVE^ORM EVNT1(ORIE NS(ORIX),P TEVT,2)
  2869                "RTN","ORW DX",154,0)
  2870                 . S X="RS "
  2871                "RTN","ORW DX",155,0)
  2872                 . S $P(OR WLST(ORIX) ,U,2)=X
  2873                "RTN","ORW DX",156,0)
  2874                 S J=0 F   S J=$O(EVE NT(J)) Q:' +J  D UNLE VT^ORX2(J)  ;195
  2875                "RTN","ORW DX",157,0)
  2876                 Q
  2877                "RTN","ORW DX",158,0)
  2878                SEND(ORWLS T,DFN,ORNP ,ORL,ES,OR WREC) ; Si gn
  2879                "RTN","ORW DX",159,0)
  2880                 ; DFN=Pat ient, ORNP =Provider,  ORL=Locat ion, ES=En crypted ES  code
  2881                "RTN","ORW DX",160,0)
  2882                 ; ORWREC( n)=ORIFN;A ction^Sign ature Sts^ Release St s^Nature o f Order
  2883                "RTN","ORW DX",161,0)
  2884                SEND1 N OR VP,ORWI,OR WERR,ORWRE L,ORWSIG,O RWNATR,ORD ERID,ORBEF ,ORLR,ORLA B,X,I
  2885                "RTN","ORW DX",162,0)
  2886                 S ORVP=DF N_";DPT(", ORL=ORL_"; SC(",ORL(2 )=ORL,ORWL ST=0
  2887                "RTN","ORW DX",163,0)
  2888                 F I="LR", "VBEC" S X =+$O(^DIC( 9.4,"C",I, 0)) S:X OR LR(X)=1
  2889                "RTN","ORW DX",164,0)
  2890                 S ORWI=0  F  S ORWI= $O(ORWREC( ORWI)) Q:' ORWI  D
  2891                "RTN","ORW DX",165,0)
  2892                 . S X=ORW REC(ORWI), ORWERR=""
  2893                "RTN","ORW DX",166,0)
  2894                 . S ORDER ID=$P(X,U) ,ORWSIG=$P (X,U,2),OR WREL=$P(X, U,3),ORWNA TR=$P(X,U, 4)
  2895                "RTN","ORW DX",167,0)
  2896                 . S ORBEF =0
  2897                "RTN","ORW DX",168,0)
  2898                 . I '$D(^ OR(100,+OR DERID,0))  Q
  2899                "RTN","ORW DX",169,0)
  2900                 . I $D(^O R(100,+ORD ERID,8,+$P (ORDERID," ;",2),0))  S ORBEF=$P (^OR(100,+ ORDERID,8, +$P(ORDERI D,";",2),0 ),U,15)
  2901                "RTN","ORW DX",170,0)
  2902                 . S:$D(^O R(100,+ORD ERID,8,+$P (ORDERID," ;",2),0))  ORWNATR=$S ($P(^OR(10 0,+ORDERID ,8,+$P(ORD ERID,";",2 ),0),"^",4 )=3:"",1:O RWNATR)
  2903                "RTN","ORW DX",171,0)
  2904                 . S ORWER R=$$CHKACT ^ORWDXR(OR DERID,ORWS IG,ORWREL, ORWNATR)
  2905                "RTN","ORW DX",172,0)
  2906                 . I $L(OR WERR) S OR WERR="1^"_ ORWERR
  2907                "RTN","ORW DX",173,0)
  2908                 . I '$L(O RWERR) D
  2909                "RTN","ORW DX",174,0)
  2910                 .. I $G(O RLR(+$P(^O R(100,+ORD ERID,0),U, 14))),'$G( ORLAB) D   ; lab batc h start
  2911                "RTN","ORW DX",175,0)
  2912                 ... I $L( $T(BHS^ORM BLD)) D BH S^ORMBLD(O RVP) S ORL AB=1
  2913                "RTN","ORW DX",176,0)
  2914                 .. N OK S  OK=$$LOCK 1^ORX2(ORD ERID) I 'O K S ORWERR ="1^"_$P(O K,U,2)
  2915                "RTN","ORW DX",177,0)
  2916                 .. I OK D  EN^ORCSEN D(ORDERID, "",ORWSIG, ORWREL,ORW NATR,"",.O RWERR),UNL K1^ORX2(OR DERID)
  2917                "RTN","ORW DX",178,0)
  2918                 . S ORWLS T(ORWI)=OR DERID,X=""
  2919                "RTN","ORW DX",179,0)
  2920                 . I $L(OR WERR) S OR WLST(ORWI) =ORWLST(OR WI)_"^E^"_ ORWERR Q
  2921                "RTN","ORW DX",180,0)
  2922                 . I ORWRE L,((ORBEF= 10)!(ORBEF =11)),($P( ^OR(100,+O RDERID,3), U,3)'=10)  S X="R"
  2923                "RTN","ORW DX",181,0)
  2924                 . I ORWSI G'=2 S X=X _"S"
  2925                "RTN","ORW DX",182,0)
  2926                 . S $P(OR WLST(ORWI) ,U,2)=X
  2927                "RTN","ORW DX",183,0)
  2928                 I $G(ORLA B) D BTS^O RMBLD(ORVP )
  2929                "RTN","ORW DX",184,0)
  2930                 I $D(ORWL ST)>9 D
  2931                "RTN","ORW DX",185,0)
  2932                 . N I,A
  2933                "RTN","ORW DX",186,0)
  2934                 . S I=0 F   S I=$O(O RWLST(I))  Q:I=""  S  A=$G(ORWLS T(I)) I A[ "Invalid P rocedure,  Inactive,  no Imaging  Type" D S M^ORWDX2(A )
  2935                "RTN","ORW DX",187,0)
  2936                 Q
  2937                "RTN","ORW DX",188,0)
  2938                DLGID(VAL, ORIFN) ; r eturn dlg  IEN for or der
  2939                "RTN","ORW DX",189,0)
  2940                 S VAL=$P( ^OR(100,+O RIFN,0),U, 5)
  2941                "RTN","ORW DX",190,0)
  2942                 S VAL=$S( $P(VAL,";" ,2)="ORD(1 01.41,":+V AL,1:0)
  2943                "RTN","ORW DX",191,0)
  2944                 Q
  2945                "RTN","ORW DX",192,0)
  2946                FORMID(VAL ,ORIFN) ;  Base dlg F ormID for  an order
  2947                "RTN","ORW DX",193,0)
  2948                 N DLG
  2949                "RTN","ORW DX",194,0)
  2950                 S VAL=0,D LG=$P(^OR( 100,+ORIFN ,0),U,5)
  2951                "RTN","ORW DX",195,0)
  2952                 Q:$P(DLG, ";",2)'="O RD(101.41, "
  2953                "RTN","ORW DX",196,0)
  2954                 D FORMID^ ORWDXM(.VA L,+DLG)
  2955                "RTN","ORW DX",197,0)
  2956                 Q
  2957                "RTN","ORW DX",198,0)
  2958                AGAIN(VAL, DLG) ; ret urn true t o keep dlg  for anoth er order
  2959                "RTN","ORW DX",199,0)
  2960                 S VAL=''$ P($G(^ORD( 101.41,DLG ,0)),U,9)
  2961                "RTN","ORW DX",200,0)
  2962                 Q
  2963                "RTN","ORW DX",201,0)
  2964                DGRP(VAL,D LG) ; Disp lay grp po inter for  a dlg
  2965                "RTN","ORW DX",202,0)
  2966                 S DLG=$S( $E(DLG)="` ":+$P(DLG, "`",2),1:$ O(^ORD(101 .41,"AB",D LG,0))) ;k cm
  2967                "RTN","ORW DX",203,0)
  2968                 S VAL=$P( $G(^ORD(10 1.41,DLG,0 )),U,5)
  2969                "RTN","ORW DX",204,0)
  2970                 Q
  2971                "RTN","ORW DX",205,0)
  2972                DGNM(VAL,N M) ; Displ ay grp poi nter for n ame
  2973                "RTN","ORW DX",206,0)
  2974                 S VAL=$O( ^ORD(100.9 8,"B",NM,0 ))
  2975                "RTN","ORW DX",207,0)
  2976                 Q
  2977                "RTN","ORW DX",208,0)
  2978                WRLST(LST, LOC) ; Lis t of dlgs  for writin g orders
  2979                "RTN","ORW DX",209,0)
  2980                 G WRLST1^ ORWDX1
  2981                "RTN","ORW DX",210,0)
  2982                MSG(LST,IE N) ; Msg t ext for or derable it em
  2983                "RTN","ORW DX",211,0)
  2984                 N I
  2985                "RTN","ORW DX",212,0)
  2986                 S I=0 F   S I=$O(^OR D(101.43,I EN,8,I)) Q :I'>0  S L ST(I)=^(I, 0)
  2987                "RTN","ORW DX",213,0)
  2988                 Q
  2989                "RTN","ORW DX",214,0)
  2990                DISMSG(VAL ,IEN) ; Di sabled mge  for order ing dlg
  2991                "RTN","ORW DX",215,0)
  2992                 S VAL=$P( $G(^ORD(10 1.41,+IEN, 0)),U,3)
  2993                "RTN","ORW DX",216,0)
  2994                 Q
  2995                "RTN","ORW DX",217,0)
  2996                LOCK(OK,DF N) ; Attem pt to lock  pt for or dering
  2997                "RTN","ORW DX",218,0)
  2998                 S OK=$$LO CK^ORX2(DF N)
  2999                "RTN","ORW DX",219,0)
  3000                 Q
  3001                "RTN","ORW DX",220,0)
  3002                UNLOCK(OK, DFN) ; Unl ock pt for  ordering
  3003                "RTN","ORW DX",221,0)
  3004                 D UNLOCK^ ORX2(DFN)  S OK=1
  3005                "RTN","ORW DX",222,0)
  3006                 Q
  3007                "RTN","ORW DX",223,0)
  3008                LOCKORD(OK ,ORIFN) ;  Attempt to  lock orde r
  3009                "RTN","ORW DX",224,0)
  3010                 S OK=$$LO CK1^ORX2(O RIFN)
  3011                "RTN","ORW DX",225,0)
  3012                 Q
  3013                "RTN","ORW DX",226,0)
  3014                UNLKORD(OK ,ORIFN) ;  Unlock ord er
  3015                "RTN","ORW DX",227,0)
  3016                 D UNLK1^O RX2(ORIFN)  S OK=1
  3017                "RTN","ORW DX",228,0)
  3018                 Q
  3019                "RTN","ORW DX",229,0)
  3020                UNLKOTH(OK ,ORIFN) ;  Unlock pt  not by thi s session
  3021                "RTN","ORW DX",230,0)
  3022                 K ^XTMP(" ORPTLK-"_O RIFN) S OK =1
  3023                "RTN","ORW DX",231,0)
  3024                 Q
  3025                "RTN","ORW PT")
  3026                0^18^B6367 3004^B6414 8022
  3027                "RTN","ORW PT",1,0)
  3028                ORWPT ; SL C/KCM/REV  - Patient  Lookup Fun ctions ;03 /26/13  09 :06
  3029                "RTN","ORW PT",2,0)
  3030                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**1 0,85,132,1 49,206,187 ,190,215,2 43,280,306 ,311,431** ;Dec 17, 1 997;Build  30
  3031                "RTN","ORW PT",3,0)
  3032                 ;
  3033                "RTN","ORW PT",4,0)
  3034                 ; Ref. to  ^UTILITY  via IA 100 61
  3035                "RTN","ORW PT",5,0)
  3036                 ;
  3037                "RTN","ORW PT",6,0)
  3038                IDINFO(REC ,DFN) ; Re turn ident ifying inf ormation f or a patie nt
  3039                "RTN","ORW PT",7,0)
  3040                 ; PID^DOB ^SEX^VET^S C%^WARD^RM -BED^NAME
  3041                "RTN","ORW PT",8,0)
  3042                 N X0,X1,X 101,X3,XV   ; name/do b/sex/ssn,  ward, roo m-bed, sc% , vet
  3043                "RTN","ORW PT",9,0)
  3044                 S X0=$G(^ DPT(DFN,0) ),X1=$G(^( .1)),X101= $G(^(.101) ),X3=$G(^( .3)),XV=$G (^("VET"))
  3045                "RTN","ORW PT",10,0)
  3046                 S REC=$$S SN^DPTLK1( DFN)_U_$$D OB^DPTLK1( DFN,2)_U_$ P(X0,U,2)_ U_$P(XV,U) _U_$P(X3,U ,2)_U_$P(X 1,U)_U_$P( X101,U)_U_ $P(X0,U) ; DG249
  3047                "RTN","ORW PT",11,0)
  3048                 Q
  3049                "RTN","ORW PT",12,0)
  3050                PTINQ(REF, DFN) ; Ret urn format ted pt inq uiry repor t
  3051                "RTN","ORW PT",13,0)
  3052                 K ^TMP("O RDATA",$J, 1)
  3053                "RTN","ORW PT",14,0)
  3054                 D DGINQ^O RCXPND1(DF N)
  3055                "RTN","ORW PT",15,0)
  3056                 S REF=$NA (^TMP("ORD ATA",$J,1) )
  3057                "RTN","ORW PT",16,0)
  3058                 Q
  3059                "RTN","ORW PT",17,0)
  3060                SCDIS(LST, DFN) ; Ret urn servic e connecte d % and ra ted disabi lities
  3061                "RTN","ORW PT",18,0)
  3062                 N VAEL,VA ERR,I,ILST ,DIS,SC,X
  3063                "RTN","ORW PT",19,0)
  3064                 D ELIG^VA DPT
  3065                "RTN","ORW PT",20,0)
  3066                 S LST(1)= "Service C onnected:  "_$S(+VAEL (3):$P(VAE L(3),U,2)_ "%",1:"NO" )
  3067                "RTN","ORW PT",21,0)
  3068                 I 'VAEL(4 ),'$P($G(^ DG(391,+VA EL(6),0)), U,2) S LST (2)="NOT A  VETERAN."  Q
  3069                "RTN","ORW PT",22,0)
  3070                 S I=0,ILS T=1 F  S I =$O(^DPT(D FN,.372,I) ) Q:'I  S  X=^(I,0) D
  3071                "RTN","ORW PT",23,0)
  3072                 . S DIS=$ P($G(^DIC( 31,+X,0)), U) Q:DIS=" "
  3073                "RTN","ORW PT",24,0)
  3074                 . S SC=$S ($P(X,U,3) :"SC",$P(X ,U,3)']"": "not speci fied",1:"N SC")
  3075                "RTN","ORW PT",25,0)
  3076                 . S ILST= ILST+1,LST (ILST)=DIS _" ("_$P(X ,U,2)_"% " _SC_")"
  3077                "RTN","ORW PT",26,0)
  3078                 I ILST=1  S LST(2)=" Rated Disa bilities:  NONE STATE D"
  3079                "RTN","ORW PT",27,0)
  3080                 Q
  3081                "RTN","ORW PT",28,0)
  3082                SHOW ; tem porary - s how patien t inquiry  screen
  3083                "RTN","ORW PT",29,0)
  3084                 N I,Y,DIC  S DIC=2,D IC(0)="AEM Q" D ^DIC  Q:'Y
  3085                "RTN","ORW PT",30,0)
  3086                 K ^TMP("O RDATA",$J, 1)
  3087                "RTN","ORW PT",31,0)
  3088                 D DGINQ^O RCXPND1(+Y )
  3089                "RTN","ORW PT",32,0)
  3090                 S I=0 F   S I=$O(^TM P("ORDATA" ,$J,1,I))  Q:'I  W !, ^(I)
  3091                "RTN","ORW PT",33,0)
  3092                 K ^TMP("O RDATA",$J, 1)
  3093                "RTN","ORW PT",34,0)
  3094                 Q
  3095                "RTN","ORW PT",35,0)
  3096                SELCHK(REC ,DFN) ; Ch eck for se nsitive pt
  3097                "RTN","ORW PT",36,0)
  3098                 ; SENSITI VE
  3099                "RTN","ORW PT",37,0)
  3100                 S REC=$$E N1^ORQPT2( DFN)
  3101                "RTN","ORW PT",38,0)
  3102                 Q
  3103                "RTN","ORW PT",39,0)
  3104                DIEDON(VAL ,DFN) ; Ch eck for a  date of de ath
  3105                "RTN","ORW PT",40,0)
  3106                 S VAL=+$G (^DPT(DFN, .35))
  3107                "RTN","ORW PT",41,0)
  3108                 Q
  3109                "RTN","ORW PT",42,0)
  3110                SELECT(REC ,DFN) ; Se lects pati ent & retu rns key in formation
  3111                "RTN","ORW PT",43,0)
  3112                 ;  1    2    3   4     5      6     7    8        9        10       11  12
  3113                "RTN","ORW PT",44,0)
  3114                 ; NAME^SE X^DOB^SSN^ LOCIEN^LOC NM^RMBD^CW AD^SENSITI VE^ADMITTE D^CONV^SC^
  3115                "RTN","ORW PT",45,0)
  3116                 ; 13  14   15  16  1 7
  3117                "RTN","ORW PT",46,0)
  3118                 ; SC%^ICN ^AGE^TS^TS SVC
  3119                "RTN","ORW PT",47,0)
  3120                 ;
  3121                "RTN","ORW PT",48,0)
  3122                 ; for CCO W (RV - 2/ 27/03)  na me="-1", l ocation=er ror messag e
  3123                "RTN","ORW PT",49,0)
  3124                 I '$D(^DP T(+DFN,0))  S REC="-1 ^^^^^Patie nt is unkn own to CPR S." Q
  3125                "RTN","ORW PT",50,0)
  3126                 ;
  3127                "RTN","ORW PT",51,0)
  3128                 N X
  3129                "RTN","ORW PT",52,0)
  3130                 I $G(XWB( "2","RPC") )="ORWPT S ELECT" K ^ TMP($J,"OC -OPOS") ;  delete onc e per orde r session  order chec ks
  3131                "RTN","ORW PT",53,0)
  3132                 K ^TMP("O RWPCE",$J)  ; delete  PCE 'cache ' when swi tching pat ients
  3133                "RTN","ORW PT",54,0)
  3134                 S X=^DPT( DFN,0),REC =$P(X,U,1, 3)_U_$P(X, U,9)_U_U_$ G(^(.1))_U _$G(^(.101 ))
  3135                "RTN","ORW PT",55,0)
  3136                 S X=$P(RE C,U,6) I $ L(X) S $P( REC,U,5)=+ $G(^DIC(42 ,+$O(^DIC( 42,"B",X,0 )),44))
  3137                "RTN","ORW PT",56,0)
  3138                 S $P(REC, U,8)=$$CWA D^ORQPT2(D FN)_U_$$EN 1^ORQPT2(D FN)
  3139                "RTN","ORW PT",57,0)
  3140                 ; I $P(RE C,U,9) D E N2^ORQPT2( DFN)  ;upd ate DG sec urity log  ; DG249
  3141                "RTN","ORW PT",58,0)
  3142                 S X=$G(^D PT(DFN,.10 5)) I X S  $P(REC,U,1 0)=$P($G(^ DGPM(X,0)) ,U)
  3143                "RTN","ORW PT",59,0)
  3144                 S:'$D(IOS T) IOST="P -OTHER"
  3145                "RTN","ORW PT",60,0)
  3146                 S $P(REC, U,11)=0
  3147                "RTN","ORW PT",61,0)
  3148                 D ELIG^VA DPT S $P(R EC,U,12)=$ G(VAEL(3))  ;two piec es: SC^SC%
  3149                "RTN","ORW PT",62,0)
  3150                 I $L($T(G ETICN^MPIF 001)) S X= +$$GETICN^ MPIF001(DF N) S:X>0 $ P(REC,U,14 )=X
  3151                "RTN","ORW PT",63,0)
  3152                 S $P(REC, U,15)=$$AG E(DFN,$P(R EC,U,3))
  3153                "RTN","ORW PT",64,0)
  3154                 S $P(REC, U,16)=+$G( ^DPT(DFN,. 103)) ; tr eating spe cialty
  3155                "RTN","ORW PT",65,0)
  3156                 I +$P(REC ,U,16)>0 D
  3157                "RTN","ORW PT",66,0)
  3158                 . N X,Y,Z
  3159                "RTN","ORW PT",67,0)
  3160                 . S (X,Y) =""
  3161                "RTN","ORW PT",68,0)
  3162                 . S X=$$T SDATA^DGAC T(45.7,+$P (REC,U,16) ,.Y,"")
  3163                "RTN","ORW PT",69,0)
  3164                 . I +X,+$ P($G(Y(2)) ,U,1)>0 S  (X,Z)="" S  X=$$TSDAT A^DGACT(42 .4,+$P($G( Y(2)),U,1) ,.Z,"")
  3165                "RTN","ORW PT",70,0)
  3166                 . I +X S  $P(REC,U,1 7)=$P($G(Z (3)),U,1)  ; treating   specialt y service
  3167                "RTN","ORW PT",71,0)
  3168                 K VAEL,VA ERR ;VADPT  call to k ill?
  3169                "RTN","ORW PT",72,0)
  3170                 S ^DISV(D UZ,"^DPT(" )=DFN
  3171                "RTN","ORW PT",73,0)
  3172                 Q
  3173                "RTN","ORW PT",74,0)
  3174                SHARE(VAL, IP,HWND,DF N) ; Set g lobal to s hare DFN w ith other  applicatio ns
  3175                "RTN","ORW PT",75,0)
  3176                 K ^TMP("O RWCHART",$ J),^TMP("O RECALL",$J ),^TMP("OR WORD",$J)
  3177                "RTN","ORW PT",76,0)
  3178                 K ^TMP("O RWDXMQ",$J )
  3179                "RTN","ORW PT",77,0)
  3180                 S ^TMP("O RWCHART",$ J,IP,HWND) =DFN
  3181                "RTN","ORW PT",78,0)
  3182                 Q
  3183                "RTN","ORW PT",79,0)
  3184                BYWARD(LST ,WARD) ; R eturn a li st of pati ents in a  ward
  3185                "RTN","ORW PT",80,0)
  3186                 N ILST,DF N
  3187                "RTN","ORW PT",81,0)
  3188                 I +$G(WAR D)<1 S LST (1)="^No w ard identi fied" Q
  3189                "RTN","ORW PT",82,0)
  3190                 S (ILST,D FN)=0
  3191                "RTN","ORW PT",83,0)
  3192                 S WARD=$P (^DIC(42,W ARD,0),"^" )   ;DBIA  #36
  3193                "RTN","ORW PT",84,0)
  3194                 F  S DFN= $O(^DPT("C N",WARD,DF N)) Q:DFN' >0  D
  3195                "RTN","ORW PT",85,0)
  3196                 . S ILST= ILST+1,LST (ILST)=+DF N_U_$P(^DP T(+DFN,0), U)_U_$G(^D PT(+DFN,.1 01))
  3197                "RTN","ORW PT",86,0)
  3198                 I ILST<1  S LST(1)=" ^No patien ts found."
  3199                "RTN","ORW PT",87,0)
  3200                 Q
  3201                "RTN","ORW PT",88,0)
  3202                LAST5(LST, ID) ; Retu rn a list  of patient s matching  A9999 ide ntifiers
  3203                "RTN","ORW PT",89,0)
  3204                 N I,IEN,X REF
  3205                "RTN","ORW PT",90,0)
  3206                 S (I,IEN) =0,XREF=$S ($L(ID)=5: "BS5",1:"B S")
  3207                "RTN","ORW PT",91,0)
  3208                 F  S IEN= $O(^DPT(XR EF,ID,IEN) ) Q:'IEN   D
  3209                "RTN","ORW PT",92,0)
  3210                 . S I=I+1 ,LST(I)=IE N_U_$P(^DP T(IEN,0),U )_U_$$DOB^ DPTLK1(IEN ,2)_U_$$SS N^DPTLK1(I EN)  ; DG2 49
  3211                "RTN","ORW PT",93,0)
  3212                 Q
  3213                "RTN","ORW PT",94,0)
  3214                 ;
  3215                "RTN","ORW PT",95,0)
  3216                LAST5RPL(L ST,ID) ; ;  Return li st matchin g A9999 id 's, but fr om RPL onl y.
  3217                "RTN","ORW PT",96,0)
  3218                 N ORRPL,O RCNT,ORPT, ORPIEN
  3219                "RTN","ORW PT",97,0)
  3220                 ; IA ____  allows re ad access  to NEW PER SON file n ode 101:
  3221                "RTN","ORW PT",98,0)
  3222                 S ORRPL=$ G(^VA(200, DUZ,101))
  3223                "RTN","ORW PT",99,0)
  3224                 S ORRPL=$ P(ORRPL,U, 2)
  3225                "RTN","ORW PT",100,0)
  3226                 I (('ORRP L)!(ORRPL= "")) S LST (0)="" Q
  3227                "RTN","ORW PT",101,0)
  3228                 ;
  3229                "RTN","ORW PT",102,0)
  3230                 S (ORCNT, ORPT)=0
  3231                "RTN","ORW PT",103,0)
  3232                 F  S ORPT =$O(^OR(10 0.21,ORRPL ,10,ORPT))  Q:'ORPT   D
  3233                "RTN","ORW PT",104,0)
  3234                 .S ORPIEN =+$G(^OR(1 00.21,ORRP L,10,ORPT, 0))
  3235                "RTN","ORW PT",105,0)
  3236                 .I ((ORPI EN<0)!(ORP IEN="")) Q
  3237                "RTN","ORW PT",106,0)
  3238                 .S ORCNT= ORCNT+1
  3239                "RTN","ORW PT",107,0)
  3240                 .S LST(OR CNT)=ORPIE N_U_$P(^DP T(ORPIEN,0 ),U)_U_$$D OB^DPTLK1( ORPIEN,2)_ U_$$SSN^DP TLK1(ORPIE N) ; DG249 .
  3241                "RTN","ORW PT",108,0)
  3242                 ;
  3243                "RTN","ORW PT",109,0)
  3244                 Q
  3245                "RTN","ORW PT",110,0)
  3246                 ;
  3247                "RTN","ORW PT",111,0)
  3248                FULLSSN(LS T,ID) ; Re turn a lis t of patie nts matchi ng full SS N entered
  3249                "RTN","ORW PT",112,0)
  3250                 N I,IEN
  3251                "RTN","ORW PT",113,0)
  3252                 S (I,IEN) =0
  3253                "RTN","ORW PT",114,0)
  3254                 F  S IEN= $O(^DPT("S SN",ID,IEN )) Q:'IEN   D
  3255                "RTN","ORW PT",115,0)
  3256                 . S I=I+1 ,LST(I)=IE N_U_$P(^DP T(IEN,0),U )_U_$$DOB^ DPTLK1(IEN ,2)_U_$$SS N^DPTLK1(I EN)  ; DG2 49
  3257                "RTN","ORW PT",116,0)
  3258                 Q
  3259                "RTN","ORW PT",117,0)
  3260                 ;
  3261                "RTN","ORW PT",118,0)
  3262                FSSNRPL(LS T,ID) ; Re turn list  matching F ull SSN, b ut from RP L only.
  3263                "RTN","ORW PT",119,0)
  3264                 N ORRPL,O RCNT,ORPT, ORLPT,ORPI EN
  3265                "RTN","ORW PT",120,0)
  3266                 ; IA ____  allows re ad access  to NEW PER SON file n ode 101:
  3267                "RTN","ORW PT",121,0)
  3268                 S ORRPL=$ G(^VA(200, DUZ,101))
  3269                "RTN","ORW PT",122,0)
  3270                 S ORRPL=$ P(ORRPL,U, 2)
  3271                "RTN","ORW PT",123,0)
  3272                 I (('ORRP L)!(ORRPL= "")) S LST (0)="" Q
  3273                "RTN","ORW PT",124,0)
  3274                 ;
  3275                "RTN","ORW PT",125,0)
  3276                 S (ORCNT, ORPT)=0
  3277                "RTN","ORW PT",126,0)
  3278                 F  S ORPT =$O(^DPT(" SSN",ID,OR PT)) Q:'OR PT  D
  3279                "RTN","ORW PT",127,0)
  3280                 .S ORLPT= 0
  3281                "RTN","ORW PT",128,0)
  3282                 .F  S ORL PT=$O(^OR( 100.21,ORR PL,10,ORLP T)) Q:'ORL PT  D
  3283                "RTN","ORW PT",129,0)
  3284                 ..S ORPIE N=+$G(^OR( 100.21,ORR PL,10,ORLP T,0))
  3285                "RTN","ORW PT",130,0)
  3286                 ..I ((ORP IEN<0)!(OR PIEN=""))  Q
  3287                "RTN","ORW PT",131,0)
  3288                 ..I (ORPI EN'=ORPT)  Q
  3289                "RTN","ORW PT",132,0)
  3290                 ..S ORCNT =ORCNT+1
  3291                "RTN","ORW PT",133,0)
  3292                 ..S LST(O RCNT)=ORPI EN_U_$P(^D PT(ORPIEN, 0),U)_U_$$ DOB^DPTLK1 (ORPIEN,2) _U_$$SSN^D PTLK1(ORPI EN) ; DG24 9.
  3293                "RTN","ORW PT",134,0)
  3294                 ;
  3295                "RTN","ORW PT",135,0)
  3296                 Q
  3297                "RTN","ORW PT",136,0)
  3298                 ;
  3299                "RTN","ORW PT",137,0)
  3300                TOP(LST) ;  Return to p for all  patients l ist (last  selected f or now)
  3301                "RTN","ORW PT",138,0)
  3302                 N IEN
  3303                "RTN","ORW PT",139,0)
  3304                 S IEN=$G( ^DISV(DUZ, "^DPT("))
  3305                "RTN","ORW PT",140,0)
  3306                 I IEN S L ST(1)=IEN_ U_$P($G(^D PT(IEN,0)) ,U)
  3307                "RTN","ORW PT",141,0)
  3308                 Q
  3309                "RTN","ORW PT",142,0)
  3310                ENCTITL(RE C,DFN,LOC, PROV) ; Re turn exter nal values  for encou nter
  3311                "RTN","ORW PT",143,0)
  3312                 ; LOCNAME ^LOCABBR^R OOMBED^PRO VNAME
  3313                "RTN","ORW PT",144,0)
  3314                 S $P(REC, U,1)=$P($G (^SC(+LOC, 0)),U,1,2)
  3315                "RTN","ORW PT",145,0)
  3316                 S $P(REC, U,3)=$P($G (^DPT(DFN, .101)),U)
  3317                "RTN","ORW PT",146,0)
  3318                 S $P(REC, U,4)=$P($G (^VA(200,+ PROV,0)),U )
  3319                "RTN","ORW PT",147,0)
  3320                 Q
  3321                "RTN","ORW PT",148,0)
  3322                LISTALL(Y, FROM,DIR)  ; Return a  bolus of  patient na mes.  From  is either  Name or I EN^Name.
  3323                "RTN","ORW PT",149,0)
  3324                 N I,IEN,C NT,FROMIEN ,ORIDNAME  S CNT=44,I =0,FROMIEN =0
  3325                "RTN","ORW PT",150,0)
  3326                 I $P(FROM ,U,2)'=""  S FROMIEN= $P(FROM,U, 1),FROM=$O (^DPT("B", $P(FROM,U, 2)),-DIR)
  3327                "RTN","ORW PT",151,0)
  3328                 F  S FROM =$O(^DPT(" B",FROM),D IR) Q:FROM =""  D  Q: I=CNT
  3329                "RTN","ORW PT",152,0)
  3330                 . S IEN=F ROMIEN,FRO MIEN=0 F   S IEN=$O(^ DPT("B",FR OM,IEN)) Q :'IEN  D   Q:I=CNT
  3331                "RTN","ORW PT",153,0)
  3332                 . . S ORI DNAME=""
  3333                "RTN","ORW PT",154,0)
  3334                 . . S ORI DNAME=$G(^ DPT(IEN,0) ) ; Get ze ro node na me.
  3335                "RTN","ORW PT",155,0)
  3336                 . . ; S X 1=$G(^DPT( IEN,.1))_"  "_$G(^DPT (IEN,.101) )
  3337                "RTN","ORW PT",156,0)
  3338                 . . S I=I +1 S Y(I)= IEN_U_FROM _U_U_U_U_$ P(ORIDNAME ,U) ;_"^"_ X ; _"^"_X 1  ;"   (" _X_")"
  3339                "RTN","ORW PT",157,0)
  3340                 Q
  3341                "RTN","ORW PT",158,0)
  3342                APPTLST(LS T,DFN) ; r eturn a li st of appo intments
  3343                "RTN","ORW PT",159,0)
  3344                 ; APPTTIM E^LOCIEN^L OCNAME^EXT STATUS
  3345                "RTN","ORW PT",160,0)
  3346                 N ERR,ERR MSG,VASD,V AERR K ^UT ILITY("VAS D",$J)  ;I A 10061
  3347                "RTN","ORW PT",161,0)
  3348                 S VASD("F ")=$$HTFM^ XLFDT($H-3 0,1)
  3349                "RTN","ORW PT",162,0)
  3350                 S VASD("T ")=$$HTFM^ XLFDT($H+1 ,1)_".2359 "
  3351                "RTN","ORW PT",163,0)
  3352                 S VASD("W ")="123456 789"
  3353                "RTN","ORW PT",164,0)
  3354                 D SDA^ORQ RY01(.ERR, .ERRMSG)
  3355                "RTN","ORW PT",165,0)
  3356                 I ERR K ^ UTILITY("V ASD",$J) K  LST S LST (1)=ERRMSG  Q
  3357                "RTN","ORW PT",166,0)
  3358                 S I=0 F   S I=$O(^UT ILITY("VAS D",$J,I))  Q:'I  D
  3359                "RTN","ORW PT",167,0)
  3360                 . S LST(I )=$P(^UTIL ITY("VASD" ,$J,I,"I") ,U,1,2)_U_ $P(^("E"), U,2,3)
  3361                "RTN","ORW PT",168,0)
  3362                 K ^UTILIT Y("VASD",$ J)
  3363                "RTN","ORW PT",169,0)
  3364                 Q
  3365                "RTN","ORW PT",170,0)
  3366                ADMITLST(L ST,DFN) ;  return a l ist of adm issions
  3367                "RTN","ORW PT",171,0)
  3368                 ; MOVETIM E^LOCIEN^L OCNAME^TYP E
  3369                "RTN","ORW PT",172,0)
  3370                 N TIM,MOV ,X0,Y,MTIM ,XTYP,XLOC ,HLOC,ILST  S ILST=0
  3371                "RTN","ORW PT",173,0)
  3372                 S TIM=""  F  S TIM=$ O(^DGPM("A TID1",DFN, TIM)) Q:TI M'>0  D
  3373                "RTN","ORW PT",174,0)
  3374                 . S MOV=0   F  S MOV =$O(^DGPM( "ATID1",DF N,TIM,MOV) ) Q:MOV'>0   D
  3375                "RTN","ORW PT",175,0)
  3376                 . . N VST R,TIUDA
  3377                "RTN","ORW PT",176,0)
  3378                 . . S X0= $G(^DGPM(M OV,0)) I X 0']"" Q
  3379                "RTN","ORW PT",177,0)
  3380                 . . S MTI M=$P(X0,U)
  3381                "RTN","ORW PT",178,0)
  3382                 . . S XTY P=$P($G(^D G(405.1,+$ P(X0,U,4), 0)),U,1)
  3383                "RTN","ORW PT",179,0)
  3384                 . . S XLO C=$P($G(^D IC(42,+$P( X0,U,6),0) ),U,1),HLO C=+$G(^(44 ))
  3385                "RTN","ORW PT",180,0)
  3386                 . . S VST R=HLOC_";" _MTIM_";H" ,TIUDA=$$H ASDS^TIULX (DFN,VSTR)
  3387                "RTN","ORW PT",181,0)
  3388                 . . S ILS T=ILST+1,L ST(ILST)=M TIM_U_HLOC _U_XLOC_U_ XTYP_U_MOV _U_TIUDA
  3389                "RTN","ORW PT",182,0)
  3390                 Q
  3391                "RTN","ORW PT",183,0)
  3392                CLINRNG(LS T) ; retur n date ran ges for cl inic appoi ntments
  3393                "RTN","ORW PT",184,0)
  3394                 S LST(1)= "T;T^Today "
  3395                "RTN","ORW PT",185,0)
  3396                 S LST(2)= "T+1;T+1^T omorrow"
  3397                "RTN","ORW PT",186,0)
  3398                 S LST(3)= "T-1;T-1^Y esterday"
  3399                "RTN","ORW PT",187,0)
  3400                 S LST(4)= "T-7;T^Pas t Week"
  3401                "RTN","ORW PT",188,0)
  3402                 S LST(5)= "T-31;T^Pa st Month"
  3403                "RTN","ORW PT",189,0)
  3404                 S LST(6)= "S^Specify  Date Rang e..."
  3405                "RTN","ORW PT",190,0)
  3406                 Q
  3407                "RTN","ORW PT",191,0)
  3408                 ;
  3409                "RTN","ORW PT",192,0)
  3410                 N %,%H,X, SUNDAY,STA RT
  3411                "RTN","ORW PT",193,0)
  3412                 S LST(1)= DT_";"_DT_ "^Today",X =$$HTFM^XL FDT($H+1,1 )
  3413                "RTN","ORW PT",194,0)
  3414                 S LST(2)= X_";"_X_"^ Tomorrow"
  3415                "RTN","ORW PT",195,0)
  3416                 S X=+$H F   Q:X#7=3   S X=X-1                           ; $H#7=3  is Sunday
  3417                "RTN","ORW PT",196,0)
  3418                 S LST(3)= $$HTFM^XLF DT(X)_";"_ $$HTFM^XLF DT(X+6)_"^ This Week"
  3419                "RTN","ORW PT",197,0)
  3420                 S LST(4)= $$HTFM^XLF DT(X+7)_"; "_$$HTFM^X LFDT(X+13) _"^Next We ek"
  3421                "RTN","ORW PT",198,0)
  3422                 S LST(5)= $E(DT,1,5) _"01;"_$E( DT,1,5)_"3 1^This Mon th"
  3423                "RTN","ORW PT",199,0)
  3424                 S X=$E(DT ,4,5)+1 S: X=13 X=1 S  X=$E(DT,1 ,3)_$TR($J (X,2)," ", 0)
  3425                "RTN","ORW PT",200,0)
  3426                 S LST(6)= X_"01;"_X_ "31^Next M onth"
  3427                "RTN","ORW PT",201,0)
  3428                 S LST(7)= "^Specify  Dates"
  3429                "RTN","ORW PT",202,0)
  3430                 Q
  3431                "RTN","ORW PT",203,0)
  3432                DFLTSRC(VA L) ; retur n default  patient li st source  (T, W, C,  P, S)
  3433                "RTN","ORW PT",204,0)
  3434                 N SRV S S RV=+$G(^VA (200,DUZ,5 ))
  3435                "RTN","ORW PT",205,0)
  3436                 S VAL=$$G ET^XPAR("A LL^SRV.`"_ SRV,"ORLP  DEFAULT LI ST SOURCE" )
  3437                "RTN","ORW PT",206,0)
  3438                 Q
  3439                "RTN","ORW PT",207,0)
  3440                SAVDFLT(OK ,X) ; save  new defau lt patient  list sett ings (X=ty pe^ien^sdt ;edt)
  3441                "RTN","ORW PT",208,0)
  3442                 G SAVDFLT ^ORWPT1
  3443                "RTN","ORW PT",209,0)
  3444                 ;
  3445                "RTN","ORW PT",210,0)
  3446                DISCHRG(Y, DFN,ADMITD T) ; Get d ischarge m ovement in formation
  3447                "RTN","ORW PT",211,0)
  3448                 N VAIP
  3449                "RTN","ORW PT",212,0)
  3450                 I +$G(ADM ITDT)=0 S  Y=DT Q
  3451                "RTN","ORW PT",213,0)
  3452                 S VAIP("D ")=ADMITDT  D 52^VADP T
  3453                "RTN","ORW PT",214,0)
  3454                 I +VAIP(1 7)=0 S Y=D T Q
  3455                "RTN","ORW PT",215,0)
  3456                 S Y=+VAIP (17,1)
  3457                "RTN","ORW PT",216,0)
  3458                 Q
  3459                "RTN","ORW PT",217,0)
  3460                CWAD(Y,DFN ) ;  retur ns CWAD fl ags for a  patient
  3461                "RTN","ORW PT",218,0)
  3462                 S Y=$$CWA D^ORQPT2(D FN)
  3463                "RTN","ORW PT",219,0)
  3464                 Q
  3465                "RTN","ORW PT",220,0)
  3466                LEGACY(ORL ST,DFN) ;  return mes sage if da ta on the  legacy sys tem
  3467                "RTN","ORW PT",221,0)
  3468                 ; ORLST(0 )=1 if dat a,  ORLST( n)=display  message i f data
  3469                "RTN","ORW PT",222,0)
  3470                 S ORLST(0 )=0
  3471                "RTN","ORW PT",223,0)
  3472                 D HXDATA^ ORPO7GUI(. ORLST,DFN)
  3473                "RTN","ORW PT",224,0)
  3474                 I $O(ORLS T(0)) S OR LST(0)=1
  3475                "RTN","ORW PT",225,0)
  3476                 Q
  3477                "RTN","ORW PT",226,0)
  3478                INPLOC(REC ,DFN) ; Re turn a pat ient's cur rent locat ion
  3479                "RTN","ORW PT",227,0)
  3480                 N X
  3481                "RTN","ORW PT",228,0)
  3482                 S X=$G(^D PT(DFN,.10 2)),REC=0
  3483                "RTN","ORW PT",229,0)
  3484                 I X S X=$ P($G(^DGPM (X,0)),U,6 )
  3485                "RTN","ORW PT",230,0)
  3486                 I X S REC =+$G(^DIC( 42,X,44))
  3487                "RTN","ORW PT",231,0)
  3488                 I X S $P( REC,U,2)=$ P($G(^DIC( 42,X,0)),U ,1)
  3489                "RTN","ORW PT",232,0)
  3490                 I X S X=$ P($G(^DIC( 42,X,0)),U ,3)
  3491                "RTN","ORW PT",233,0)
  3492                 S $P(REC, U,3)=X
  3493                "RTN","ORW PT",234,0)
  3494                 Q
  3495                "RTN","ORW PT",235,0)
  3496                AGE(DFN,BE G) ; retur ns age bas ed on date  of birth  and date o f death (o r DT)
  3497                "RTN","ORW PT",236,0)
  3498                 N END,X
  3499                "RTN","ORW PT",237,0)
  3500                 S END=+$G (^DPT(DFN, .35)),END= $S(END:END ,1:DT)
  3501                "RTN","ORW PT",238,0)
  3502                 S X=$E(EN D,1,3)-$E( BEG,1,3)-( $E(END,4,7 )<$E(BEG,4 ,7))
  3503                "RTN","ORW PT",239,0)
  3504                 Q X
  3505                "RTN","ORW PT",240,0)
  3506                ROK(X) ; R outine OK  (in UCI) ( NDBI)
  3507                "RTN","ORW PT",241,0)
  3508                 S X=$G(X)  Q:'$L(X)  0  Q:$L(X) >8 0  X ^% ZOSF("TEST ") Q:$T 1   Q 0
  3509                "RTN","ORW PT",242,0)
  3510                 ;
  3511                "RTN","ORW PT",243,0)
  3512                 ;NDBI(X)  ; National  Database  Integratio n site 1 =  yes  0 =  no
  3513                "RTN","ORW PT",244,0)
  3514                 ; N R,G S  X="A7RDUP " X ^%ZOSF ("TEST") S  R=$T,G=$S ($D(^A7RCP ):1,1:0),X =R+G,X=$S( X=2:1,1:0)  Q X
  3515                "RTN","ORW U")
  3516                0^5^B62954 737^B62136 332
  3517                "RTN","ORW U",1,0)
  3518                ORWU ;SLC/ KCM - GENE RAL UTILIT IES FOR WI NDOWS CALL S ; 15 Sep  2016  9:3 4 AM
  3519                "RTN","ORW U",2,0)
  3520                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**1 0,85,132,1 48,149,187 ,195,215,2 43,350,424 ,431**;Dec  17, 1997; Build 30
  3521                "RTN","ORW U",3,0)
  3522                 ;
  3523                "RTN","ORW U",4,0)
  3524                DT(Y,X,%DT ) ; Intern al Fileman  Date/Time
  3525                "RTN","ORW U",5,0)
  3526                 ; change  the '00:00 ' that cou ld be pass ed so File man doesn' t reject
  3527                "RTN","ORW U",6,0)
  3528                 I $L($P(X ,"@",2)),( "00000000" [$TR($P(X, "@",2),":" ,"")) S $P (X,"@",2)= "00:00:01"
  3529                "RTN","ORW U",7,0)
  3530                 S %DT=$G( %DT,"TS")  D ^%DT K % DT
  3531                "RTN","ORW U",8,0)
  3532                 Q
  3533                "RTN","ORW U",9,0)
  3534                VALDT(Y,X, %DT) ; Val idate date /time
  3535                "RTN","ORW U",10,0)
  3536                 S:'$D(%DT ) %DT="TX"  D ^%DT
  3537                "RTN","ORW U",11,0)
  3538                 Q
  3539                "RTN","ORW U",12,0)
  3540                USERINFO(R EC) ; Rele vant info  for curren t user
  3541                "RTN","ORW U",13,0)
  3542                 ; return  DUZ^NAME^U SRCLS^CANS IGN^ISPROV IDER^ORDER ROLE^NOORD ER^DTIME^
  3543                "RTN","ORW U",14,0)
  3544                 ;         COUNTDOWN^ ENABLEVERI FY^NOTIFYA PPS^MSGHAN G^DOMAIN^S ERVICE^
  3545                "RTN","ORW U",15,0)
  3546                 ;         AUTOSAVE^I NITTAB^LAS TTAB^WEBAC CESS^ALLOW HOLD^ISRPL ^RPLLIST^
  3547                "RTN","ORW U",16,0)
  3548                 ;         CORTABS^RP TTAB^STANU M^GECSTATU S^PRODACCT
  3549                "RTN","ORW U",17,0)
  3550                 N X,ORRPL ,ORRPL1,OR RPL2,ORTAB ,CORTABS,R PTTAB,ORDT ,OREFF,ORE XP,ORDATEO K
  3551                "RTN","ORW U",18,0)
  3552                 S REC=DUZ _U_$P(^VA( 200,DUZ,0) ,U)
  3553                "RTN","ORW U",19,0)
  3554                 S $P(REC, U,3)=$S($D (^XUSEC("O RES",DUZ)) :3,$D(^XUS EC("ORELSE ",DUZ)):2, $D(^XUSEC( "OREMAS",D UZ)):1,1:0 )
  3555                "RTN","ORW U",20,0)
  3556                 S $P(REC, U,4)=$D(^X USEC("ORES ",DUZ))&$D (^XUSEC("P ROVIDER",D UZ))
  3557                "RTN","ORW U",21,0)
  3558                 S $P(REC, U,5)=$D(^X USEC("PROV IDER",DUZ) )
  3559                "RTN","ORW U",22,0)
  3560                 S $P(REC, U,6)=$$ORD ROLE
  3561                "RTN","ORW U",23,0)
  3562                 S $P(REC, U,7)=$$GET ^XPAR("USR ^SYS^PKG", "ORWOR DIS ABLE ORDER ING",1,"I" )
  3563                "RTN","ORW U",24,0)
  3564                 S $P(REC, U,8)=$$GET ^XPAR("USR ^SYS","ORW OR TIMEOUT  CHART",1, "I")
  3565                "RTN","ORW U",25,0)
  3566                 I '$P(REC ,U,8),$G(D TIME) S $P (REC,U,8)= DTIME
  3567                "RTN","ORW U",26,0)
  3568                 S $P(REC, U,9)=$$GET ^XPAR("USR ^SYS^PKG", "ORWOR TIM EOUT COUNT DOWN",1,"I ")
  3569                "RTN","ORW U",27,0)
  3570                 S X=$$GET ^XPAR("USR ^SYS^PKG", "ORWOR ENA BLE VERIFY ",1,"I")
  3571                "RTN","ORW U",28,0)
  3572                 S $P(REC, U,10)=$S(X =1:1,X=2:0 ,1:'$P(REC ,U,7))
  3573                "RTN","ORW U",29,0)
  3574                 S $P(REC, U,11)=$$GE T^XPAR("US R^SYS^PKG" ,"ORWOR BR OADCAST ME SSAGES",1, "I")
  3575                "RTN","ORW U",30,0)
  3576                 S $P(REC, U,12)=$$GE T^XPAR("US R^SYS^PKG" ,"ORWOR AU TO CLOSE P T MSG",1," I")
  3577                "RTN","ORW U",31,0)
  3578                 S $P(REC, U,13)=$$KS P^XUPARAM( "WHERE")   ; domain
  3579                "RTN","ORW U",32,0)
  3580                 S $P(REC, U,14)=+$G( ^VA(200,DU Z,5))      ; service/ section
  3581                "RTN","ORW U",33,0)
  3582                 S $P(REC, U,15)=$$GE T^XPAR("US R^SYS^PKG" ,"ORWOR AU TOSAVE NOT E",1,"I")
  3583                "RTN","ORW U",34,0)
  3584                 S $P(REC, U,16)=$$GE T^XPAR("US R^DIV^SYS^ PKG","ORCH  INITIAL T AB",1,"I")
  3585                "RTN","ORW U",35,0)
  3586                 S $P(REC, U,17)=$$GE T^XPAR("US R^DIV^SYS^ PKG","ORCH  USE LAST  TAB",1,"I" )
  3587                "RTN","ORW U",36,0)
  3588                 S $P(REC, U,18)=$$GE T^XPAR("US R^DIV^SYS^ PKG","ORWO R DISABLE  WEB ACCESS ",1,"I")
  3589                "RTN","ORW U",37,0)
  3590                 S $P(REC, U,19)=$$GE T^XPAR("SY S^PKG","OR WOR DISABL E HOLD ORD ERS",1,"I" )
  3591                "RTN","ORW U",38,0)
  3592                 ; 2 piece s added by  PKS on 11 /5/2001 fo r "Reports  Only:"
  3593                "RTN","ORW U",39,0)
  3594                 ; IA# 100 60 allows  read acces s to ^VA(2 00 file.
  3595                "RTN","ORW U",40,0)
  3596                 S ORRPL=$ G(^VA(200, DUZ,101))             ; RPL node .
  3597                "RTN","ORW U",41,0)
  3598                 S ORRPL1= $P(ORRPL,U )
  3599                "RTN","ORW U",42,0)
  3600                 S $P(REC, U,20)=ORRP L1                    ; ISRPL pi ece.
  3601                "RTN","ORW U",43,0)
  3602                 S ORRPL2= $P(ORRPL,U ,2)
  3603                "RTN","ORW U",44,0)
  3604                 S $P(REC, U,21)=ORRP L2                    ; RPLLIST  piece.
  3605                "RTN","ORW U",45,0)
  3606                 ;
  3607                "RTN","ORW U",46,0)
  3608                 ; Additio nal pieces  for CPRS  tabs acces s:
  3609                "RTN","ORW U",47,0)
  3610                 ; IA# 100 60 allows  read acces s to ^VA(2 00.01013 m ultiple.
  3611                "RTN","ORW U",48,0)
  3612                 S ORDT=DT                                  ; Today.
  3613                "RTN","ORW U",49,0)
  3614                 S (CORTAB S,RPTTAB)= 0
  3615                "RTN","ORW U",50,0)
  3616                 S ORRPL=0
  3617                "RTN","ORW U",51,0)
  3618                 F  S ORRP L=$O(^VA(2 00,DUZ,"OR D",ORRPL))  Q:ORRPL<1   D
  3619                "RTN","ORW U",52,0)
  3620                 .S ORTAB= $G(^VA(200 ,DUZ,"ORD" ,ORRPL,0))
  3621                "RTN","ORW U",53,0)
  3622                 .I ORTAB= "" Q
  3623                "RTN","ORW U",54,0)
  3624                 .S OREFF= $P(ORTAB,U ,2)
  3625                "RTN","ORW U",55,0)
  3626                 .S OREXP= $P(ORTAB,U ,3)
  3627                "RTN","ORW U",56,0)
  3628                 .S ORTAB= $P(ORTAB,U )
  3629                "RTN","ORW U",57,0)
  3630                 .I ORTAB= "" Q
  3631                "RTN","ORW U",58,0)
  3632                 .S ORTAB= $G(^ORD(10 1.13,ORTAB ,0))
  3633                "RTN","ORW U",59,0)
  3634                 .I ORTAB= "" Q
  3635                "RTN","ORW U",60,0)
  3636                 .S ORTAB= $P(ORTAB,U )
  3637                "RTN","ORW U",61,0)
  3638                 .I ORTAB= "" Q
  3639                "RTN","ORW U",62,0)
  3640                 .S ORTAB= $$UP^XLFST R(ORTAB)
  3641                "RTN","ORW U",63,0)
  3642                 .S ORDATE OK=1                                ; Defau lt.
  3643                "RTN","ORW U",64,0)
  3644                 .I ((OREF F="")!(ORE FF>ORDT))  S ORDATEOK =0 ; Eff.  date NG.
  3645                "RTN","ORW U",65,0)
  3646                 .I ORDATE OK  D
  3647                "RTN","ORW U",66,0)
  3648                 ..I OREXP ="" Q                               ; No ex p. date.
  3649                "RTN","ORW U",67,0)
  3650                 ..I (OREX P<ORDT) S  ORDATEOK=0               ; Exp.  date NG.
  3651                "RTN","ORW U",68,0)
  3652                 ..I (OREX P=ORDT) S  ORDATEOK=0               ; Exp.  date NG.
  3653                "RTN","ORW U",69,0)
  3654                 .;
  3655                "RTN","ORW U",70,0)
  3656                 .; Set TR UE if OK:
  3657                "RTN","ORW U",71,0)
  3658                 .I ((ORTA B="COR")&( ORDATEOK))  S CORTABS =1
  3659                "RTN","ORW U",72,0)
  3660                 .I ((ORTA B="RPT")&( ORDATEOK))  S RPTTAB= 1
  3661                "RTN","ORW U",73,0)
  3662                 ;
  3663                "RTN","ORW U",74,0)
  3664                 ; When do ne, set al l valid ta bs for acc ess:
  3665                "RTN","ORW U",75,0)
  3666                 S $P(REC, U,22)=CORT ABS                   ; "Core" t abs.
  3667                "RTN","ORW U",76,0)
  3668                 S $P(REC, U,23)=RPTT AB                    ; "Reports " tab.
  3669                "RTN","ORW U",77,0)
  3670                 ;
  3671                "RTN","ORW U",78,0)
  3672                 S $P(REC, U,24)=$P($ $SITE^VASI TE,U,3)
  3673                "RTN","ORW U",79,0)
  3674                 S $P(REC, U,25)=$$GE T^XPAR("US R^TEA","PX RM GEC STA TUS CHECK" ,1,"I")
  3675                "RTN","ORW U",80,0)
  3676                 S $P(REC, U,26)=$$PR OD^XUPROD
  3677                "RTN","ORW U",81,0)
  3678                 Q
  3679                "RTN","ORW U",82,0)
  3680                 ;
  3681                "RTN","ORW U",83,0)
  3682                HASKEY(VAL ,KEY) ; re turns TRUE  if the us er possess es the sec urity key
  3683                "RTN","ORW U",84,0)
  3684                 S VAL=''$ D(^XUSEC(K EY,DUZ))
  3685                "RTN","ORW U",85,0)
  3686                 Q
  3687                "RTN","ORW U",86,0)
  3688                HASOPTN(VA L,OPTION)  ; returns  TRUE if th e user has  access to  a menu op tion
  3689                "RTN","ORW U",87,0)
  3690                 S VAL=+$$ ACCESS^XQC HK(DUZ,OPT ION)
  3691                "RTN","ORW U",88,0)
  3692                 I VAL'>0  S VAL=0
  3693                "RTN","ORW U",89,0)
  3694                 E  S VAL= 1
  3695                "RTN","ORW U",90,0)
  3696                 Q
  3697                "RTN","ORW U",91,0)
  3698                NPHASKEY(V AL,NP,KEY)  ; returns  TRUE if t he person  has the se curity key
  3699                "RTN","ORW U",92,0)
  3700                 S VAL=''$ D(^XUSEC(K EY,NP))
  3701                "RTN","ORW U",93,0)
  3702                 Q
  3703                "RTN","ORW U",94,0)
  3704                ORDROLE()  ; returns  the role a  person ta kes in ord ering
  3705                "RTN","ORW U",95,0)
  3706                 ; VAL: 0= nokey, 1=c lerk, 2=nu rse, 3=phy sician, 4= student, 5 =bad keys
  3707                "RTN","ORW U",96,0)
  3708                 ;I '$G(OR WCLVER) Q  0  ; versi on of clie nt is to o ld for ord ering
  3709                "RTN","ORW U",97,0)
  3710                 I ($D(^XU SEC("OREMA S",DUZ))+$ D(^XUSEC(" ORELSE",DU Z))+$D(^XU SEC("ORES" ,DUZ)))>1  Q 5
  3711                "RTN","ORW U",98,0)
  3712                 I $D(^XUS EC("OREMAS ",DUZ)) Q  1                             ;  clerk
  3713                "RTN","ORW U",99,0)
  3714                 I $D(^XUS EC("ORELSE ",DUZ)) Q  2                             ;  nurse
  3715                "RTN","ORW U",100,0)
  3716                 I $D(^XUS EC("ORES", DUZ)),$D(^ XUSEC("PRO VIDER",DUZ )) Q 3  ;  doctor
  3717                "RTN","ORW U",101,0)
  3718                 I $D(^XUS EC("PROVID ER",DUZ))  Q 4                           ;  student
  3719                "RTN","ORW U",102,0)
  3720                 Q 0
  3721                "RTN","ORW U",103,0)
  3722                VALIDSIG(E SOK,X) ; r eturns TRU E if valid  electroni c signatur e
  3723                "RTN","ORW U",104,0)
  3724                 S X=$$DEC RYP^XUSRB1 (X),ESOK=0                     ;  network e ncrypted
  3725                "RTN","ORW U",105,0)
  3726                 D HASH^XU SHSHP
  3727                "RTN","ORW U",106,0)
  3728                 I X=$P($G (^VA(200,+ DUZ,20)),U ,4) S ESOK =1
  3729                "RTN","ORW U",107,0)
  3730                 Q
  3731                "RTN","ORW U",108,0)
  3732                TOOLMENU(O RLST) ; re turns a li st of item s for the  Tools menu
  3733                "RTN","ORW U",109,0)
  3734                 N ANENT
  3735                "RTN","ORW U",110,0)
  3736                 S ANENT=" ALL^"_$S($ G(^VA(200, DUZ,5)):"^ SRV.`"_+$G (^(5)),1:" ")
  3737                "RTN","ORW U",111,0)
  3738                 D GETLST^ XPAR(.ORLS T,ANENT,"O RWT TOOLS  MENU","N")
  3739                "RTN","ORW U",112,0)
  3740                 Q
  3741                "RTN","ORW U",113,0)
  3742                ACTLOC(LOC ) ; Functi on: return s TRUE if  active hos pital loca tion
  3743                "RTN","ORW U",114,0)
  3744                 ; IA# 100 40.
  3745                "RTN","ORW U",115,0)
  3746                 N D0,X I  +$G(^SC(LO C,"OOS"))  Q 0                 ;  screen ou t OOS entr y
  3747                "RTN","ORW U",116,0)
  3748                 S D0=+$G( ^SC(LOC,42 )) I D0 D  WIN^DGPMDD CF Q 'X  ;  chk out o f svc ward s
  3749                "RTN","ORW U",117,0)
  3750                 S X=$G(^S C(LOC,"I") ) I +X=0 Q  1                  ;  no inacti vate date
  3751                "RTN","ORW U",118,0)
  3752                 I DT>$P(X ,U)&($P(X, U,2)=""!(D T<$P(X,U,2 ))) Q 0  ;  chk react ivate date
  3753                "RTN","ORW U",119,0)
  3754                 Q 1                                                 ;  must stil l be activ e
  3755                "RTN","ORW U",120,0)
  3756                 ;
  3757                "RTN","ORW U",121,0)
  3758                CLINLOC(Y, FROM,DIR)  ; Return a  set of cl inics from  HOSPITAL  LOCATION
  3759                "RTN","ORW U",122,0)
  3760                 ; .Y=retu rned list,  FROM=text  to $O fro m, DIR=$O  direction,
  3761                "RTN","ORW U",123,0)
  3762                 N I,IEN,C NT S I=0,C NT=44
  3763                "RTN","ORW U",124,0)
  3764                 F  Q:I'<C NT  S FROM =$O(^SC("B ",FROM),DI R) Q:FROM= ""  D  ; I A# 10040.
  3765                "RTN","ORW U",125,0)
  3766                 . S IEN=" " F  S IEN =$O(^SC("B ",FROM,IEN ),DIR) Q:' IEN  D
  3767                "RTN","ORW U",126,0)
  3768                 . . I ($P ($G(^SC(IE N,0)),U,3) '="C")!('$ $ACTLOC(IE N)) Q
  3769                "RTN","ORW U",127,0)
  3770                 . . S I=I +1,Y(I)=IE N_"^"_FROM
  3771                "RTN","ORW U",128,0)
  3772                 Q
  3773                "RTN","ORW U",129,0)
  3774                INPLOC(Y,F ROM,DIR) ; Return a s et of ward s from HOS PITAL LOCA TION
  3775                "RTN","ORW U",130,0)
  3776                 ; .Y=retu rned list,  FROM=text  to $O fro m, DIR=$O  direction,
  3777                "RTN","ORW U",131,0)
  3778                 N I,IEN,C NT S I=0,C NT=44
  3779                "RTN","ORW U",132,0)
  3780                 F  Q:I'<C NT  S FROM =$O(^SC("B ",FROM),DI R) Q:FROM= ""  D  ; I A# 10040.
  3781                "RTN","ORW U",133,0)
  3782                 . S IEN=" " F  S IEN =$O(^SC("B ",FROM,IEN ),DIR) Q:' IEN  D
  3783                "RTN","ORW U",134,0)
  3784                 . . I ($P ($G(^SC(IE N,0)),U,3) '="W") Q
  3785                "RTN","ORW U",135,0)
  3786                 . . I '$$ ACTLOC(IEN ) Q
  3787                "RTN","ORW U",136,0)
  3788                 . . S I=I +1,Y(I)=IE N_"^"_FROM
  3789                "RTN","ORW U",137,0)
  3790                 Q
  3791                "RTN","ORW U",138,0)
  3792                HOSPLOC(Y, FROM,DIR)  ; Return a  set of lo cations fr om HOSPITA L LOCATION
  3793                "RTN","ORW U",139,0)
  3794                 ; .Y=retu rned list,  FROM=text  to $O fro m, DIR=$O  direction,
  3795                "RTN","ORW U",140,0)
  3796                 N I,IEN,C NT S I=0,C NT=44
  3797                "RTN","ORW U",141,0)
  3798                 I $D(^VA( 200,DUZ,"D ELOC")) D  NEWLOC^ORC LOC(.Y,ORF ROM,DIR) Q
  3799                "RTN","ORW U",142,0)
  3800                 F  Q:I'<C NT  S FROM =$O(^SC("B ",FROM),DI R) Q:FROM= ""  D  ; I A# 10040.
  3801                "RTN","ORW U",143,0)
  3802                 . S IEN=" " F  S IEN =$O(^SC("B ",FROM,IEN ),DIR) Q:' IEN  D
  3803                "RTN","ORW U",144,0)
  3804                 . . Q:("C W"'[$P($G( ^SC(IEN,0) ),U,3)!('$ $ACTLOC(IE N)))
  3805                "RTN","ORW U",145,0)
  3806                 . . S I=I +1,Y(I)=IE N_"^"_FROM
  3807                "RTN","ORW U",146,0)
  3808                 Q
  3809                "RTN","ORW U",147,0)
  3810                NEWPERS(OR Y,ORFROM,O RDIR,ORKEY ,ORDATE,OR VIZ,ORALL)  ; Return  a set of n ames from  the NEW PE RSON file.
  3811                "RTN","ORW U",148,0)
  3812                 ; SLC/PKS : Code mov ed to ORWU 1 on 12/3/ 2002.
  3813                "RTN","ORW U",149,0)
  3814                 D NP1^ORW U1
  3815                "RTN","ORW U",150,0)
  3816                 Q
  3817                "RTN","ORW U",151,0)
  3818                GBLREF(VAL ,FN) ; ret urn global  reference  for file  number
  3819                "RTN","ORW U",152,0)
  3820                 S VAL=""  Q:'FN
  3821                "RTN","ORW U",153,0)
  3822                 S VAL=$$R OOT^DILFD( +FN)
  3823                "RTN","ORW U",154,0)
  3824                 ; I $E($R E(VAL))=", " S VAL=$E (VAL,1,$L( VAL)-1)_") "
  3825                "RTN","ORW U",155,0)
  3826                 ; I $E($R E(VAL))="( " S VAL=$P (VAL,"(",1 )
  3827                "RTN","ORW U",156,0)
  3828                 Q
  3829                "RTN","ORW U",157,0)
  3830                GENERIC(Y, FROM,DIR,R EF) ; Retu rn a set o f entries  from xref  in REF
  3831                "RTN","ORW U",158,0)
  3832                 ; .Y=retu rned list,  FROM=text  to $O fro m, DIR=$O  direction,
  3833                "RTN","ORW U",159,0)
  3834                 N I,IEN,C NT S I=0,C NT=44
  3835                "RTN","ORW U",160,0)
  3836                 F  Q:I'<C NT  S FROM =$O(@REF@( FROM),DIR)  Q:FROM=""   D
  3837                "RTN","ORW U",161,0)
  3838                 . S IEN=" " F  S IEN =$O(@REF@( FROM,IEN), DIR) Q:'IE N  D
  3839                "RTN","ORW U",162,0)
  3840                 . . S I=I +1,Y(I)=IE N_"^"_FROM
  3841                "RTN","ORW U",163,0)
  3842                 Q
  3843                "RTN","ORW U",164,0)
  3844                EXTNAME(VA L,IEN,FN)  ; return e xternal fo rm of poin ter
  3845                "RTN","ORW U",165,0)
  3846                 ; IEN=int ernal numb er, FN=fil e number
  3847                "RTN","ORW U",166,0)
  3848                 N REF S R EF=$G(^DIC (FN,0,"GL" )),VAL=""
  3849                "RTN","ORW U",167,0)
  3850                 I $L(REF) ,+IEN S VA L=$P($G(@( REF_IEN_", 0)")),U)
  3851                "RTN","ORW U",168,0)
  3852                 Q
  3853                "RTN","ORW U",169,0)
  3854                PARAM(VAL, APARAM) ;  return a p arameter v alue for a  user
  3855                "RTN","ORW U",170,0)
  3856                 ; call as sumes curr ent user,  default en tities, si ngle insta nce
  3857                "RTN","ORW U",171,0)
  3858                 S VAL=$$G ET^XPAR("A LL",APARAM ,1,"I")
  3859                "RTN","ORW U",172,0)
  3860                 Q
  3861                "RTN","ORW U",173,0)
  3862                PARAMS(ORL IST,APARAM ) ; return  a list of  parameter  values
  3863                "RTN","ORW U",174,0)
  3864                 ; call as sumes curr ent user,  default en tities, mu ltiple ins tances
  3865                "RTN","ORW U",175,0)
  3866                 D GETLST^ XPAR(.ORLI ST,"ALL",A PARAM,"Q")
  3867                "RTN","ORW U",176,0)
  3868                 Q
  3869                "RTN","ORW U",177,0)
  3870                DEVICE(Y,F ROM,DIR) ;  Return a  subset of  entries fr om the Dev ice file
  3871                "RTN","ORW U",178,0)
  3872                 ; .LST(n) =IEN;Name^ DisplayNam e^Location ^RMar^PLen
  3873                "RTN","ORW U",179,0)
  3874                 ; FROM=te xt to $O f rom, DIR=$ O directio n
  3875                "RTN","ORW U",180,0)
  3876                 N I,IEN,C NT,SHOW,X  S I=0,CNT= 20
  3877                "RTN","ORW U",181,0)
  3878                 I FROM["< " S FROM=$ RE($P($RE( FROM),"<   ",2))
  3879                "RTN","ORW U",182,0)
  3880                 F  Q:I'<C NT  S FROM =$O(^%ZIS( 1,"B",FROM ),DIR) Q:F ROM=""  D
  3881                "RTN","ORW U",183,0)
  3882                 . S IEN=0  F  S IEN= $O(^%ZIS(1 ,"B",FROM, IEN)) Q:'I EN  D
  3883                "RTN","ORW U",184,0)
  3884                 .. N X0,X 1,X90,X91, X95,XTYPE, XSTYPE,XTI ME,ORA,ORP X,POP,ORPC NT
  3885                "RTN","ORW U",185,0)
  3886                 .. Q:'$D( ^%ZIS(1,IE N,0))  S X 0=^(0),X1= $G(^(1)),X 90=$G(^(90 )),X91=$G( ^(91)),X95 =$G(^(95)) ,XSTYPE=$G (^("SUBTYP E")),XTIME =$G(^("TIM E")),XTYPE =$G(^("TYP E"))
  3887                "RTN","ORW U",186,0)
  3888                 .. I $E($ G(^%ZIS(2, +XSTYPE,0) ))'="P" Q   ;Printers  only
  3889                "RTN","ORW U",187,0)
  3890                 .. S X=$P (XTYPE,"^" ) I X'="TR M",X'="HG" ,X'="HFS", X'="CHAN"  Q  ;Device  Types
  3891                "RTN","ORW U",188,0)
  3892                 .. S X=X0  I ($P(X,U ,2)="0")!( $P(X,U,12) =2) Q  ;Qu euing allo wed
  3893                "RTN","ORW U",189,0)
  3894                 .. S X=+X 90 I X,(X' >DT) Q  ;O ut of Serv ice
  3895                "RTN","ORW U",190,0)
  3896                 .. I XTIM E]"" S ORA =$P(XTIME, "^"),ORPX= $P($H,",", 2),ORPCNT= ORPX\60#60 +(ORPX\360 0*100),ORP X=$P(ORA," -",2) I OR PX'<ORA&(O RPCNT'>ORP X&(ORPCNT' <ORA))!(OR PX<ORA&(OR PCNT'<ORA! (ORPCNT'>O RPX))) Q   ;Prohibite d Times
  3897                "RTN","ORW U",191,0)
  3898                 .. S POP= 0
  3899                "RTN","ORW U",192,0)
  3900                 .. I X95] "" S ORPX= $G(DUZ(0))  I ORPX'=" @" S POP=1  F ORA=1:1 :$L(ORPX)  I X95[$E(O RPX,ORA) S  POP=0 Q
  3901                "RTN","ORW U",193,0)
  3902                 .. Q:POP   ;Security  check
  3903                "RTN","ORW U",194,0)
  3904                 .. S SHOW =$P(X0,U)  I SHOW'=FR OM S SHOW= FROM_"  <" _SHOW_">"
  3905                "RTN","ORW U",195,0)
  3906                 .. S I=I+ 1,Y(I)=IEN _";"_$P(X0 ,U)_U_SHOW _U_$P(X1,U )_U_$P(X91 ,U)_U_$P(X 91,U,3)
  3907                "RTN","ORW U",196,0)
  3908                 Q
  3909                "RTN","ORW U",197,0)
  3910                URGENCY(Y)  ; -- retr ieve set v alues from  dd for di scharge su mmary urge ncy
  3911                "RTN","ORW U",198,0)
  3912                 N ORDD,I, X
  3913                "RTN","ORW U",199,0)
  3914                 D FIELD^D ID(8925,.0 9,"","POIN TER","ORDD ")
  3915                "RTN","ORW U",200,0)
  3916                 F I=1:1 S  X=$P(ORDD ("POINTER" ),";",I) Q :X=""   S  Y(I)=$TR(X ,":","^")
  3917                "RTN","ORW U",201,0)
  3918                 Q
  3919                "RTN","ORW U",202,0)
  3920                PATCH(VAL, X) ; Retur n 1 if pat ch X is in stalled
  3921                "RTN","ORW U",203,0)
  3922                 S VAL=$$P ATCH^XPDUT L(X)
  3923                "RTN","ORW U",204,0)
  3924                 Q
  3925                "RTN","ORW U",205,0)
  3926                VERSION(VA L,X) ;Retu rn version  of packag e or names pace
  3927                "RTN","ORW U",206,0)
  3928                 S VAL=$$V ERSION^XPD UTL(X)
  3929                "RTN","ORW U",207,0)
  3930                 Q
  3931                "RTN","ORW U",208,0)
  3932                VERSRV(VAL ,X,CLVER)  ; Return s erver vers ion of opt ion name
  3933                "RTN","ORW U",209,0)
  3934                 S ORWCLVE R=$G(CLVER )  ; leave  in partit ion for se ssion
  3935                "RTN","ORW U",210,0)
  3936                 N BADVAL, ORLST
  3937                "RTN","ORW U",211,0)
  3938                 D FIND^DI C(19,"",1, "X",X,1,,, ,"ORLST")
  3939                "RTN","ORW U",212,0)
  3940                 I 'ORLST( "DILIST",0 ) S VAL="0 .0.0.0" Q
  3941                "RTN","ORW U",213,0)
  3942                 S VAL=ORL ST("DILIST ","ID",1,1 )
  3943                "RTN","ORW U",214,0)
  3944                 S VAL=$P( VAL,"versi on ",2)
  3945                "RTN","ORW U",215,0)
  3946                 S BADVAL= 0
  3947                "RTN","ORW U",216,0)
  3948                 I $P(VAL, ".",1)=""  S BADVAL=1
  3949                "RTN","ORW U",217,0)
  3950                 I $P(VAL, ".",2)=""  S BADVAL=1
  3951                "RTN","ORW U",218,0)
  3952                 I $P(VAL, ".",3)=""  S BADVAL=1
  3953                "RTN","ORW U",219,0)
  3954                 I $P(VAL, ".",4)=""  S BADVAL=1
  3955                "RTN","ORW U",220,0)
  3956                 I ((BADVA L)!('VAL)! (VAL=""))  S VAL="0.0 .0.0"
  3957                "RTN","ORW U",221,0)
  3958                 Q
  3959                "RTN","ORW U",222,0)
  3960                OVERDL(VAL ) ;Return  parameter  value of O RPARAM OVE R DATELINE
  3961                "RTN","ORW U",223,0)
  3962                 S VAL=$$G ET^XPAR("A LL","ORPAR AM OVER DA TELINE")
  3963                "RTN","ORW U",224,0)
  3964                 Q
  3965                "RTN","ORW U",225,0)
  3966                MOBAPP(VAL ,ORAPP) ;s et ^TMP($J ,"OR MOB A PP")
  3967                "RTN","ORW U",226,0)
  3968                 S ^TMP($J ,"OR MOB A PP")=ORAPP
  3969                "RTN","ORW U",227,0)
  3970                 S VAL=1
  3971                "RTN","ORW U",228,0)
  3972                 Q
  3973                "RTN","ORW U1")
  3974                0^8^B53568 040^B51918 555
  3975                "RTN","ORW U1",1,0)
  3976                ORWU1 ;SLC /GRE - Gen eral Utili ties for W indows Cal ls [2/25/0 4 11:10am]  ; 15 Sep  2016  9:39  AM
  3977                "RTN","ORW U1",2,0)
  3978                 ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**1 49,187,195 ,215,394,4 31**;Dec 1 7, 1997;Bu ild 30
  3979                "RTN","ORW U1",3,0)
  3980                 ;
  3981                "RTN","ORW U1",4,0)
  3982                 Q
  3983                "RTN","ORW U1",5,0)
  3984                 ;
  3985                "RTN","ORW U1",6,0)
  3986                NP1 ; Retu rn a set o f names fr om the NEW  PERSON fi le.
  3987                "RTN","ORW U1",7,0)
  3988                 ; (PKS/8/ 5/2003: No w called b y NEWPERS^ ORWU; inte rnal mods  made.)
  3989                "RTN","ORW U1",8,0)
  3990                 ; (Keep G ETCOS^ORWT PN up to d ate with m atching lo gic/code,  too.)
  3991                "RTN","ORW U1",9,0)
  3992                 ;
  3993                "RTN","ORW U1",10,0)
  3994                 ; PARAMS  from NEWPE RS^ORWU ca ll:
  3995                "RTN","ORW U1",11,0)
  3996                 ;  .ORY=r eturned li st.
  3997                "RTN","ORW U1",12,0)
  3998                 ;  ORDATE =Checks fo r an activ e person c lass on th is date (o ptional).
  3999                "RTN","ORW U1",13,0)
  4000                 ;  ORDIR= Direction  to move th rough the  x-ref with  $O.  
  4001                "RTN","ORW U1",14,0)
  4002                 ;  ORFROM =Starting  name for t his set.
  4003                "RTN","ORW U1",15,0)
  4004                 ;  ORKEY= Screen use rs by secu rity key ( optional).
  4005                "RTN","ORW U1",16,0)
  4006                 ;  ORVIZ= If true, i ncludes RD V users; o therwise n ot (option al).
  4007                "RTN","ORW U1",17,0)
  4008                 ;  
  4009                "RTN","ORW U1",18,0)
  4010                 N ORDD,OR DIV,ORDUP, ORGOOD,ORI ,ORIEN1,OR IEN2,ORLAS T,ORMAX,OR MRK,ORMULT I,ORPREV,O RSRV,ORTTL
  4011                "RTN","ORW U1",19,0)
  4012                 ;
  4013                "RTN","ORW U1",20,0)
  4014                 S ORI=0,O RMAX=44,(O RLAST,ORPR EV)="",ORK EY=$G(ORKE Y),ORDATE= $G(ORDATE)
  4015                "RTN","ORW U1",21,0)
  4016                 S ORMULTI =$$ALL^VAS ITE ; IA#  10112.  Do  once at b eginning o f call.
  4017                "RTN","ORW U1",22,0)
  4018                 ;
  4019                "RTN","ORW U1",23,0)
  4020                 ; NP3 tag  includes  visitors,  uses full  "B" x-ref.
  4021                "RTN","ORW U1",24,0)
  4022                 I +$G(ORV IZ)=1 D NP 3(0) Q  ;  Use alt. v ersion, sk ip rest.
  4023                "RTN","ORW U1",25,0)
  4024                 ; User re quested AL L users, b oth active  and inact ive.  Same  call, but  skip $$PR OVIDER^XUS ER screen
  4025                "RTN","ORW U1",26,0)
  4026                 I +$G(ORA LL)=1 D NP 3(0) Q
  4027                "RTN","ORW U1",27,0)
  4028                 ;
  4029                "RTN","ORW U1",28,0)
  4030                 F  Q:ORI' <ORMAX  S  ORFROM=$O( ^VA(200,"A USER",ORFR OM),ORDIR)  Q:ORFROM= ""  D
  4031                "RTN","ORW U1",29,0)
  4032                 .S ORIEN1 =""
  4033                "RTN","ORW U1",30,0)
  4034                 .F  S ORI EN1=$O(^VA (200,"AUSE R",ORFROM, ORIEN1),OR DIR) Q:'OR IEN1  D
  4035                "RTN","ORW U1",31,0)
  4036                 ..;
  4037                "RTN","ORW U1",32,0)
  4038                 ..I $L(OR KEY),'$D(^ XUSEC(ORKE Y,+ORIEN1) ) Q        ; Check fo r key?
  4039                "RTN","ORW U1",33,0)
  4040                 ..I ORDAT E>0,$$GET^ XUA4A72(OR IEN1,ORDAT E)<1 Q     ; Check da te?
  4041                "RTN","ORW U1",34,0)
  4042                 ..S ORI=O RI+1,ORY(O RI)=ORIEN1 _"^"_$$NAM EFMT^XLFNA ME(ORFROM, "F","DcMPC ")
  4043                "RTN","ORW U1",35,0)
  4044                 ..S ORDUP =0                               ; Init fla g, check d upe.
  4045                "RTN","ORW U1",36,0)
  4046                 ..I ($P(O RPREV_" ", " ")=$P(OR FROM_" ","  ")) S ORD UP=1
  4047                "RTN","ORW U1",37,0)
  4048                 ..;
  4049                "RTN","ORW U1",38,0)
  4050                 ..; Appen d Title if  not dupli cated:
  4051                "RTN","ORW U1",39,0)
  4052                 ..I 'ORDU P D
  4053                "RTN","ORW U1",40,0)
  4054                 ...S ORIE N2=ORIEN1
  4055                "RTN","ORW U1",41,0)
  4056                 ...D NP4( 0)                               ; Get Titl e. 
  4057                "RTN","ORW U1",42,0)
  4058                 ...I ORTT L="" Q
  4059                "RTN","ORW U1",43,0)
  4060                 ...S ORY( ORI)=ORY(O RI)_U_"- " _ORTTL
  4061                "RTN","ORW U1",44,0)
  4062                 ..;
  4063                "RTN","ORW U1",45,0)
  4064                 ..; Get d ata in cas e of dupes :
  4065                "RTN","ORW U1",46,0)
  4066                 ..I ORDUP  D
  4067                "RTN","ORW U1",47,0)
  4068                 ...S ORIE N2=ORLAST                        ; Prev IEN  for NP2 c all.
  4069                "RTN","ORW U1",48,0)
  4070                 ...;
  4071                "RTN","ORW U1",49,0)
  4072                 ...; Rese t, use pre vious arra y element,  call for  extended d ata:
  4073                "RTN","ORW U1",50,0)
  4074                 ...S ORI= ORI-1,ORY( ORI)=$P(OR Y(ORI),U)_ U_$P(ORY(O RI),U,2)   D NP2
  4075                "RTN","ORW U1",51,0)
  4076                 ...;
  4077                "RTN","ORW U1",52,0)
  4078                 ...; Then  return to  current u ser for se cond exten ded data c all:
  4079                "RTN","ORW U1",53,0)
  4080                 ...S ORIE N2=ORIEN1, ORI=ORI+1   D NP2
  4081                "RTN","ORW U1",54,0)
  4082                 ..S ORLAS T=ORIEN1,O RPREV=ORFR OM         ; Reassign  vars for  next pass.
  4083                "RTN","ORW U1",55,0)
  4084                 ;
  4085                "RTN","ORW U1",56,0)
  4086                 Q
  4087                "RTN","ORW U1",57,0)
  4088                 ;
  4089                "RTN","ORW U1",58,0)
  4090                NP2 ; Retr ieve subse t of data  for dupes  in NP1.
  4091                "RTN","ORW U1",59,0)
  4092                 ; (Assume s certain  vars alrea dy set/new 'd in call ing code.)
  4093                "RTN","ORW U1",60,0)
  4094                 ;
  4095                "RTN","ORW U1",61,0)
  4096                 ; Variabl es used:
  4097                "RTN","ORW U1",62,0)
  4098                 ;   ORZ     = Memory  array sto rage varia ble.
  4099                "RTN","ORW U1",63,0)
  4100                 ;   ORZER R = Error  storage fo r LIST^DIC  call.
  4101                "RTN","ORW U1",64,0)
  4102                 ;
  4103                "RTN","ORW U1",65,0)
  4104                 N ORZ,ORZ ERR                              ; Initiali ze variabl es.
  4105                "RTN","ORW U1",66,0)
  4106                 S ORDIV=" "                                ; Reset ea ch time.
  4107                "RTN","ORW U1",67,0)
  4108                 D NP4(1)                                   ; Get Titl e, Service /Section.
  4109                "RTN","ORW U1",68,0)
  4110                 ;
  4111                "RTN","ORW U1",69,0)
  4112                 ; For mul ti-divisio nal site,  get Divisi on if dete rminable:
  4113                "RTN","ORW U1",70,0)
  4114                 I ORMULTI  D
  4115                "RTN","ORW U1",71,0)
  4116                 .D LIST^D IC(200.02, ","_ORIEN2 _",","@;.0 1;1","QP", "","",""," ","","","O RZ","ORZER R")
  4117                "RTN","ORW U1",72,0)
  4118                 .S (ORDD, ORGOOD)=0                        ; Initiali ze variabl es.
  4119                "RTN","ORW U1",73,0)
  4120                 .I $P(ORZ ("DILIST", 0),U)=0 Q             ; Division  not liste d.
  4121                "RTN","ORW U1",74,0)
  4122                 .I $P(ORZ ("DILIST", 0),U)=1 D   Q         ; Only one , so use i t.
  4123                "RTN","ORW U1",75,0)
  4124                 ..S ORDD= $O(ORZ("DI LIST",ORDD ))         ; Get the  node's ent ry.
  4125                "RTN","ORW U1",76,0)
  4126                 ..S ORDIV =$P(ORZ("D ILIST",ORD D,0),U,2)  ; Get actu al name va lue. p394
  4127                "RTN","ORW U1",77,0)
  4128                 .;
  4129                "RTN","ORW U1",78,0)
  4130                 .; More t han one Di vision ent ry, so:
  4131                "RTN","ORW U1",79,0)
  4132                 .F  S ORD D=$O(ORZ(" DILIST",OR DD)) Q:+OR DD=0!'($L( ORDD))  D   Q:ORGOOD
  4133                "RTN","ORW U1",80,0)
  4134                 ..;
  4135                "RTN","ORW U1",81,0)
  4136                 ..; See i f current  entry bein g processe d is "Defa ult" (done  if so):
  4137                "RTN","ORW U1",82,0)
  4138                 ..I $P(OR Z("DILIST" ,ORDD,0),U ,3)["Y" S  ORDIV=$P(O RZ("DILIST ",ORDD,0), U,2),ORGOO D=1  Q                         ;  Division  text.
  4139                "RTN","ORW U1",83,0)
  4140                 ;
  4141                "RTN","ORW U1",84,0)
  4142                 ; Append  new pieces  to array  string:
  4143                "RTN","ORW U1",85,0)
  4144                 S ORMRK=" "
  4145                "RTN","ORW U1",86,0)
  4146                 I (ORTTL= "")&(ORSRV ="")&(ORDI V="")  Q   ; Nothing  to append.
  4147                "RTN","ORW U1",87,0)
  4148                 S ORY(ORI )=ORY(ORI) _U_"- "               ; At least  something  exists.
  4149                "RTN","ORW U1",88,0)
  4150                 I (ORTTL' ="") S ORY (ORI)=ORY( ORI)_ORTTL ,ORMRK=",  "       ;  Title.
  4151                "RTN","ORW U1",89,0)
  4152                 I (ORSRV' ="") S ORY (ORI)=ORY( ORI)_ORMRK _ORSRV,ORM RK=", " ;  Service.
  4153                "RTN","ORW U1",90,0)
  4154                 I (ORDIV' ="") S ORY (ORI)=ORY( ORI)_ORMRK _ORDIV             ;  Division.
  4155                "RTN","ORW U1",91,0)
  4156                 ;
  4157                "RTN","ORW U1",92,0)
  4158                 Q
  4159                "RTN","ORW U1",93,0)
  4160                 ;
  4161                "RTN","ORW U1",94,0)
  4162                NP3(COSFLA G) ; Retri eve diff.  data when  all users  are involv ed, using  "B" x-ref.
  4163                "RTN","ORW U1",95,0)
  4164                 ;
  4165                "RTN","ORW U1",96,0)
  4166                 ; COSFLAG =If TRUE,  called by  ORWTPN.
  4167                "RTN","ORW U1",97,0)
  4168                 ; (Assume s certain  vars alrea dy set/new 'd in call ing code.)
  4169                "RTN","ORW U1",98,0)
  4170                 ;
  4171                "RTN","ORW U1",99,0)
  4172                 N ORNODE, COSQUIT
  4173                "RTN","ORW U1",100,0)
  4174                 S COSQUIT =0 ; Flag  used in se ction for  COSFLAG.
  4175                "RTN","ORW U1",101,0)
  4176                 ;
  4177                "RTN","ORW U1",102,0)
  4178                 F  Q:ORI' <ORMAX  S  ORFROM=$O( ^VA(200,"B ",ORFROM), ORDIR) Q:O RFROM=""   D
  4179                "RTN","ORW U1",103,0)
  4180                 .S ORIEN1 =""
  4181                "RTN","ORW U1",104,0)
  4182                 .F  S ORI EN1=$O(^VA (200,"B",O RFROM,ORIE N1),ORDIR)  Q:'ORIEN1   D
  4183                "RTN","ORW U1",105,0)
  4184                 ..;
  4185                "RTN","ORW U1",106,0)
  4186                 ..; Scree n default  cosigner i f appropri ate (ORUSE R set in O RWTPN):
  4187                "RTN","ORW U1",107,0)
  4188                 ..I COSFL AG D
  4189                "RTN","ORW U1",108,0)
  4190                 ...S COSQ UIT=0
  4191                "RTN","ORW U1",109,0)
  4192                 ...I '$$S CRDFCS^TIU LA3(ORUSER ,ORIEN1) S  COSFLAG=1  Q
  4193                "RTN","ORW U1",110,0)
  4194                 ...S ORNO DE=$P($G(^ VA(200,ORI EN1,0)),U)
  4195                "RTN","ORW U1",111,0)
  4196                 ...I '$L( ORNODE) S  COSFLAG=1  Q
  4197                "RTN","ORW U1",112,0)
  4198                 ..I COSQU IT Q
  4199                "RTN","ORW U1",113,0)
  4200                 ..;
  4201                "RTN","ORW U1",114,0)
  4202                 ..I +$G(O RALL)=0,'$ $PROVIDER^ XUSER(ORIE N1,1) Q    ; Terminat ed?   Skip  if ALL re quested
  4203                "RTN","ORW U1",115,0)
  4204                 ..I ORDAT E>0,$$GET^ XUA4A72(OR IEN1,ORDAT E)<1 Q     ; Check da te?
  4205                "RTN","ORW U1",116,0)
  4206                 ..I $L(OR KEY),'$D(^ XUSEC(ORKE Y,+ORIEN1) ) Q        ; Check fo r key?
  4207                "RTN","ORW U1",117,0)
  4208                 ..S ORI=O RI+1,ORY(O RI)=ORIEN1 _"^"_$$NAM EFMT^XLFNA ME(ORFROM, "F","DcMPC ")
  4209                "RTN","ORW U1",118,0)
  4210                 ..S ORDUP =0                             ;  Init flag , check du plication.
  4211                "RTN","ORW U1",119,0)
  4212                 ..I ($P(O RPREV_" ", " ")=$P(OR FROM_" ","  ")) S ORD UP=1
  4213                "RTN","ORW U1",120,0)
  4214                 ..;
  4215                "RTN","ORW U1",121,0)
  4216                 ..; Appen d Title if  not dupli cated:
  4217                "RTN","ORW U1",122,0)
  4218                 ..I 'ORDU P D
  4219                "RTN","ORW U1",123,0)
  4220                 ...S ORIE N2=ORIEN1
  4221                "RTN","ORW U1",124,0)
  4222                 ...D NP4( 0)                             ;  Get Title
  4223                "RTN","ORW U1",125,0)
  4224                 ...I ORTT L="" Q
  4225                "RTN","ORW U1",126,0)
  4226                 ...S ORY( ORI)=ORY(O RI)_U_"- " _ORTTL
  4227                "RTN","ORW U1",127,0)
  4228                 ..;
  4229                "RTN","ORW U1",128,0)
  4230                 ..; Get d ata in cas e of dupes :
  4231                "RTN","ORW U1",129,0)
  4232                 ..I ORDUP  D
  4233                "RTN","ORW U1",130,0)
  4234                 ...S ORIE N2=ORLAST                     ;  Set to pre v. IEN for  NP2.
  4235                "RTN","ORW U1",131,0)
  4236                 ...;
  4237                "RTN","ORW U1",132,0)
  4238                 ...; Rese t, use pre vious arra y element,  call for  extended d ata:
  4239                "RTN","ORW U1",133,0)
  4240                 ...S ORI= ORI-1,ORY( ORI)=$P(OR Y(ORI),U)_ U_$P(ORY(O RI),U,2)   D NP2
  4241                "RTN","ORW U1",134,0)
  4242                 ...;
  4243                "RTN","ORW U1",135,0)
  4244                 ...; Now  return to  current us er for sec ond extend ed data ca ll:
  4245                "RTN","ORW U1",136,0)
  4246                 ...S ORIE N2=ORIEN1, ORI=ORI+1   D NP2
  4247                "RTN","ORW U1",137,0)
  4248                 ..S ORLAS T=ORIEN1,O RPREV=ORFR OM       ;  Reassign  vars for n ext pass.
  4249                "RTN","ORW U1",138,0)
  4250                 ;
  4251                "RTN","ORW U1",139,0)
  4252                 Q
  4253                "RTN","ORW U1",140,0)
  4254                 ;
  4255                "RTN","ORW U1",141,0)
  4256                NP4(ORSS)  ; Retrieve  Title or  Title and  Service/Se ction.
  4257                "RTN","ORW U1",142,0)
  4258                 ; (Assume s certain  vars alrea dy set/new 'd in call ing code.)
  4259                "RTN","ORW U1",143,0)
  4260                 ;
  4261                "RTN","ORW U1",144,0)
  4262                 ; Passed  variable O RSS: If tr ue, get Se rvice/Sect ion also.
  4263                "RTN","ORW U1",145,0)
  4264                 ;
  4265                "RTN","ORW U1",146,0)
  4266                 S (ORTTL, ORSRV)=""                               ; I nit each t ime.
  4267                "RTN","ORW U1",147,0)
  4268                 ; DBIA# 4 329:
  4269                "RTN","ORW U1",148,0)
  4270                 S ORTTL=$ P($G(^VA(2 00,ORIEN2, 0)),U,9)          ; G et Title p ointer.
  4271                "RTN","ORW U1",149,0)
  4272                 I ORTTL<1  S ORTTL=" "                            ; R eset var i f none.
  4273                "RTN","ORW U1",150,0)
  4274                 ; DBIA# 1 234:
  4275                "RTN","ORW U1",151,0)
  4276                 I ORTTL>0  S ORTTL=$ G(^DIC(3.1 ,ORTTL,0))        ; A ctual Titl e value.
  4277                "RTN","ORW U1",152,0)
  4278                 S ORSS=$G (ORSS)
  4279                "RTN","ORW U1",153,0)
  4280                 I ORSS D                                          ; G et Service /Section?
  4281                "RTN","ORW U1",154,0)
  4282                 .; DBIA#  4329:
  4283                "RTN","ORW U1",155,0)
  4284                 .S ORSRV= $P($G(^VA( 200,ORIEN2 ,5)),U,1)         ; G et S/S poi nter.
  4285                "RTN","ORW U1",156,0)
  4286                 .I ORSRV< 1 S ORSRV= ""                           ; R eset var i f none.
  4287                "RTN","ORW U1",157,0)
  4288                 .; DBIA#  4330:
  4289                "RTN","ORW U1",158,0)
  4290                 .I ORSRV> 0 S ORSRV= $P($G(^DIC (49,ORSRV, 0)),U) ; A ctual S/S  value.
  4291                "RTN","ORW U1",159,0)
  4292                 ;
  4293                "RTN","ORW U1",160,0)
  4294                 Q
  4295                "RTN","ORW U1",161,0)
  4296                 ;
  4297                "RTN","ORW U1",162,0)
  4298                NAMECVT(Y, IEN) ; Ret urns text  name(mixed -case) der ived from  IEN xref.
  4299                "RTN","ORW U1",163,0)
  4300                 ; GRE/200 2
  4301                "RTN","ORW U1",164,0)
  4302                 ; PKS-12/ 20/2002 Ta g not pres ently used .
  4303                "RTN","ORW U1",165,0)
  4304                 ; Y=Retur ned value,  IEN=Inter nal number
  4305                "RTN","ORW U1",166,0)
  4306                 N ORNAME
  4307                "RTN","ORW U1",167,0)
  4308                 S IEN=IEN _","
  4309                "RTN","ORW U1",168,0)
  4310                 S ORNAME= $$GET1^DIQ (200,IEN,2 0.2)
  4311                "RTN","ORW U1",169,0)
  4312                 S Y=$$NAM EFMT^XLFNA ME(.ORNAME ,"F","DcMP C")
  4313                "RTN","ORW U1",170,0)
  4314                 Q
  4315                "RTN","ORW U1",171,0)
  4316                 ;
  4317                "RTN","ORW U1",172,0)
  4318                DEFDIV(Y)  ; Return u ser's defa ult divisi on, if spe cified.
  4319                "RTN","ORW U1",173,0)
  4320                 ;
  4321                "RTN","ORW U1",174,0)
  4322                 ; Variabl es used:
  4323                "RTN","ORW U1",175,0)
  4324                 ;   ORDD    = Defaul t division .
  4325                "RTN","ORW U1",176,0)
  4326                 ;   ORDIV   = Divisi on holder  variable.
  4327                "RTN","ORW U1",177,0)
  4328                 ;   ORGOO D = Flag f or success ful defaul t division  found.
  4329                "RTN","ORW U1",178,0)
  4330                 ;   ORIEN   = IEN of  user.
  4331                "RTN","ORW U1",179,0)
  4332                 ;   ORZ     = Memory  array sto rage varia ble.
  4333                "RTN","ORW U1",180,0)
  4334                 ;   ORZER R = Error  storage fo r LIST^DIC  call.
  4335                "RTN","ORW U1",181,0)
  4336                 ;   Y       = Return ed value.
  4337                "RTN","ORW U1",182,0)
  4338                 ;
  4339                "RTN","ORW U1",183,0)
  4340                 N ORDD,OR DIV,ORGOOD ,ORIEN,ORZ ,ORZERR
  4341                "RTN","ORW U1",184,0)
  4342                 ;
  4343                "RTN","ORW U1",185,0)
  4344                 S ORIEN=D UZ,ORDIV=" "
  4345                "RTN","ORW U1",186,0)
  4346                 S Y=0,(OR DD,ORGOOD) =0              ; Ini tialize va riables.
  4347                "RTN","ORW U1",187,0)
  4348                 ;
  4349                "RTN","ORW U1",188,0)
  4350                 ; Get lis t of divis ions from  NEW PERSON  file mult iple:
  4351                "RTN","ORW U1",189,0)
  4352                 D LIST^DI C(200.02," ,"_ORIEN_" ,","@;.01; 1","QP","" ,"","","", "","","ORZ ","ORZERR" )
  4353                "RTN","ORW U1",190,0)
  4354                 I $P(ORZ( "DILIST",0 ),U)=0 Q        ; No  Divisions  listed.
  4355                "RTN","ORW U1",191,0)
  4356                 ;
  4357                "RTN","ORW U1",192,0)
  4358                 ; Iterate  through l ist:
  4359                "RTN","ORW U1",193,0)
  4360                 F  S ORDD =$O(ORZ("D ILIST",ORD D)) Q:+ORD D=0!'($L(O RDD))  D   Q:ORGOOD
  4361                "RTN","ORW U1",194,0)
  4362                 .;
  4363                "RTN","ORW U1",195,0)
  4364                 .; See if  current e ntry being  processed  is "Defau lt" (done  if so):
  4365                "RTN","ORW U1",196,0)
  4366                 .I $P(ORZ ("DILIST", ORDD,0),U, 3)["Y" S O RDIV=$P(OR Z("DILIST" ,ORDD,0),U ,2),ORGOOD =1                        ; Divi sion text.
  4367                "RTN","ORW U1",197,0)
  4368                 .;
  4369                "RTN","ORW U1",198,0)
  4370                 I (ORDIV= "") Q                      ; Pun t if no de fault divi sion.
  4371                "RTN","ORW U1",199,0)
  4372                 I $$UP^XL FSTR(ORDIV )="SALT LA KE CITY OI FO" S Y=1
  4373                "RTN","ORW U1",200,0)
  4374                 ;
  4375                "RTN","ORW U1",201,0)
  4376                 Q
  4377                "RTN","ORW U1",202,0)
  4378                 ;
  4379                "RTN","ORW U1",203,0)
  4380                NEWLOC(Y,O RFROM,DIR)  ; Return  "CZ" locat ions from  HOSPITAL L OCATION fi le.
  4381                "RTN","ORW U1",204,0)
  4382                 ; C=Clini cs, Z=Othe r, screene d by $$ACT LOC^ORWU.
  4383                "RTN","ORW U1",205,0)
  4384                 ; .Y=retu rned list,  ORFROM=te xt to $O f rom, DIR=$ O directio n.
  4385                "RTN","ORW U1",206,0)
  4386                 ;;------- ---------- ---------- ---------- ---------- ---------- ------
  4387                "RTN","ORW U1",207,0)
  4388                 I $D(^VA( 200,DUZ,"D ELOC")) D  NEWLOC^ORC LOC(.Y,ORF ROM,DIR) Q
  4389                "RTN","ORW U1",208,0)
  4390                 N I,IEN,C NT S I=0,C NT=44
  4391                "RTN","ORW U1",209,0)
  4392                 F  Q:I'<C NT  S ORFR OM=$O(^SC( "B",ORFROM ),DIR) Q:O RFROM=""   D  ; IA# 1 0040.
  4393                "RTN","ORW U1",210,0)
  4394                 . S IEN=" " F  S IEN =$O(^SC("B ",ORFROM,I EN),DIR) Q :'IEN  D
  4395                "RTN","ORW U1",211,0)
  4396                 . . Q:("C "'[$P($G(^ SC(IEN,0)) ,U,3)!('$$ ACTLOC^ORW U(IEN)))
  4397                "RTN","ORW U1",212,0)
  4398                 . . S I=I +1,Y(I)=IE N_"^"_ORFR OM
  4399                "RTN","ORW U1",213,0)
  4400                 Q
  4401                "RTN","ORW U1",214,0)
  4402                 ;
  4403                "SEC","^DI C",100.007 ,100.007,0 ,"AUDIT")
  4404                @
  4405                "SEC","^DI C",100.007 ,100.007,0 ,"DD")
  4406                @
  4407                "SEC","^DI C",100.007 ,100.007,0 ,"DEL")
  4408                @
  4409                "SEC","^DI C",100.007 ,100.007,0 ,"LAYGO")
  4410                @
  4411                "SEC","^DI C",100.007 ,100.007,0 ,"RD")
  4412                @
  4413                "SEC","^DI C",100.007 ,100.007,0 ,"WR")
  4414                @
  4415                "SEC","^DI C",100.007 1,100.0071 ,0,"AUDIT" )
  4416                @
  4417                "SEC","^DI C",100.007 1,100.0071 ,0,"DD")
  4418                @
  4419                "SEC","^DI C",100.007 1,100.0071 ,0,"DEL")
  4420                @
  4421                "SEC","^DI C",100.007 1,100.0071 ,0,"LAYGO" )
  4422                @
  4423                "SEC","^DI C",100.007 1,100.0071 ,0,"RD")
  4424                @
  4425                "SEC","^DI C",100.007 1,100.0071 ,0,"WR")
  4426                @
  4427                "SEC","^DI C",100.007 2,100.0072 ,0,"AUDIT" )
  4428                @
  4429                "SEC","^DI C",100.007 2,100.0072 ,0,"DD")
  4430                @
  4431                "SEC","^DI C",100.007 2,100.0072 ,0,"DEL")
  4432                @
  4433                "SEC","^DI C",100.007 2,100.0072 ,0,"LAYGO" )
  4434                @
  4435                "SEC","^DI C",100.007 2,100.0072 ,0,"RD")
  4436                @
  4437                "SEC","^DI C",100.007 2,100.0072 ,0,"WR")
  4438                @
  4439                "SEC","^DI C",100.007 3,100.0073 ,0,"AUDIT" )
  4440                @
  4441                "SEC","^DI C",100.007 3,100.0073 ,0,"DD")
  4442                @
  4443                "SEC","^DI C",100.007 3,100.0073 ,0,"DEL")
  4444                @
  4445                "SEC","^DI C",100.007 3,100.0073 ,0,"LAYGO" )
  4446                @
  4447                "SEC","^DI C",100.007 3,100.0073 ,0,"RD")
  4448                @
  4449                "SEC","^DI C",100.007 3,100.0073 ,0,"WR")
  4450                @
  4451                "SEC","^DI C",100.007 4,100.0074 ,0,"AUDIT" )
  4452                @
  4453                "SEC","^DI C",100.007 4,100.0074 ,0,"DD")
  4454                @
  4455                "SEC","^DI C",100.007 4,100.0074 ,0,"DEL")
  4456                @
  4457                "SEC","^DI C",100.007 4,100.0074 ,0,"LAYGO" )
  4458                @
  4459                "SEC","^DI C",100.007 4,100.0074 ,0,"RD")
  4460                @
  4461                "SEC","^DI C",100.007 4,100.0074 ,0,"WR")
  4462                @
  4463                "UP",200,2 00.08,-1)
  4464                200^DELOC
  4465                "UP",200,2 00.08,0)
  4466                200.08
  4467                "VER")
  4468                8.0^22.0
  4469                "^DD",100. 007,100.00 7,0)
  4470                FIELD^^11^ 5
  4471                "^DD",100. 007,100.00 7,0,"DT")
  4472                3161020
  4473                "^DD",100. 007,100.00 7,0,"IX"," B",100.007 ,.01)
  4474                 
  4475                "^DD",100. 007,100.00 7,0,"NM"," ORPU POPUP  XECUTEABL E CODE")
  4476                 
  4477                "^DD",100. 007,100.00 7,.01,0)
  4478                NAME^RFJ30 a^^0;1^K:$ L(X)>30!($ L(X)<3)!'( X'?1P.E) X
  4479                "^DD",100. 007,100.00 7,.01,.1)
  4480                Popup flag  name
  4481                "^DD",100. 007,100.00 7,.01,1,0)
  4482                ^.1
  4483                "^DD",100. 007,100.00 7,.01,1,1, 0)
  4484                100.007^B
  4485                "^DD",100. 007,100.00 7,.01,1,1, 1)
  4486                S ^OR(100. 007,"B",$E (X,1,30),D A)=""
  4487                "^DD",100. 007,100.00 7,.01,1,1, 2)
  4488                K ^OR(100. 007,"B",$E (X,1,30),D A)
  4489                "^DD",100. 007,100.00 7,.01,3)
  4490                ENTER A NA ME 3-30 CH ARACTERS,  NOT NUMERI C OR START ING WITH P UNCTUATION
  4491                "^DD",100. 007,100.00 7,.01,21,0 )
  4492                ^.001^3^3^ 3161020^^
  4493                "^DD",100. 007,100.00 7,.01,21,1 ,0)
  4494                This is th e popup fl ag which i s to be ed ited.  Edi ting of th is flag 
  4495                "^DD",100. 007,100.00 7,.01,21,2 ,0)
  4496                includes s etting it  Active or  not. The X ecutable c ode which  determines  if
  4497                "^DD",100. 007,100.00 7,.01,21,3 ,0)
  4498                the flag i s valid fo r the pati ent being  accessed c an also be  edited.
  4499                "^DD",100. 007,100.00 7,.01,23,0 )
  4500                ^.001^5^5^ 3161020^^
  4501                "^DD",100. 007,100.00 7,.01,23,1 ,0)
  4502                Flag to be  edited fo r CPRS pop  up box me ssages.  T his edit i ncludes 
  4503                "^DD",100. 007,100.00 7,.01,23,2 ,0)
  4504                turning of f the flag  for the V istA insta nce, and t he Xecutab le code wh ich 
  4505                "^DD",100. 007,100.00 7,.01,23,3 ,0)
  4506                validates  the flag f or the pat ient being  accessed.   This Xec utable cod
  4507                "^DD",100. 007,100.00 7,.01,23,4 ,0)
  4508                can only b e generate d by IT pe rsonnel.   Before a f lag can be  edited he re,
  4509                "^DD",100. 007,100.00 7,.01,23,5 ,0)
  4510                it must ex ist in 100 .0072 (POP UP FLAG).
  4511                "^DD",100. 007,100.00 7,.01,"AUD IT")
  4512                e
  4513                "^DD",100. 007,100.00 7,.01,"DT" )
  4514                3161020
  4515                "^DD",100. 007,100.00 7,1,0)
  4516                ACTIVE^Sa^ 1:YES;0:NO ;^0;2^Q
  4517                "^DD",100. 007,100.00 7,1,.1)
  4518                Boolean to  determine  if FLAG i s to be ev aluated.
  4519                "^DD",100. 007,100.00 7,1,3)
  4520                Enter Yes  to enable  evaluation  of this f lag for ea ch patient , or enter  No to not  allow thi s flag to  be conside red.
  4521                "^DD",100. 007,100.00 7,1,21,0)
  4522                ^^2^2^3161 010^
  4523                "^DD",100. 007,100.00 7,1,21,1,0 )
  4524                A toggle t o determin e whether  or not thi s code is  active and  should be  
  4525                "^DD",100. 007,100.00 7,1,21,2,0 )
  4526                executed b y the pop  up driver.
  4527                "^DD",100. 007,100.00 7,1,23,0)
  4528                ^^2^2^3161 009^
  4529                "^DD",100. 007,100.00 7,1,23,1,0 )
  4530                Boolean Y/ N for dete rmination  of evaluat ion of FLA G for incl usion in C PRS 
  4531                "^DD",100. 007,100.00 7,1,23,2,0 )
  4532                pop up.
  4533                "^DD",100. 007,100.00 7,1,"AUDIT ")
  4534                e
  4535                "^DD",100. 007,100.00 7,1,"DT")
  4536                3161012
  4537                "^DD",100. 007,100.00 7,2,0)
  4538                DESCRIPTIO N^100.0070 1^^1;0
  4539                "^DD",100. 007,100.00 7,2,21,0)
  4540                ^^2^2^3161 020^
  4541                "^DD",100. 007,100.00 7,2,21,1,0 )
  4542                Descriptio n of what  the Xecuta ble code n ame repres ents or in sight as t
  4543                "^DD",100. 007,100.00 7,2,21,2,0 )
  4544                what the T EXT repres ents.
  4545                "^DD",100. 007,100.00 7,10,0)
  4546                XECUTABLE  CODE^100.0 0702^^2;0
  4547                "^DD",100. 007,100.00 7,10,21,0)
  4548                ^^2^2^3161 010^
  4549                "^DD",100. 007,100.00 7,10,21,1, 0)
  4550                Code which  is execut ed to dete rmine if c urrent pat ient is to  have FLAG  
  4551                "^DD",100. 007,100.00 7,10,21,2, 0)
  4552                evaluated  for inclus ion in CPR S pop up.
  4553                "^DD",100. 007,100.00 7,10,23,0)
  4554                ^^1^1^3161 010^
  4555                "^DD",100. 007,100.00 7,10,23,1, 0)
  4556                Xecute cod e that is  performed  for inclus ion in CPR S pop up.
  4557                "^DD",100. 007,100.00 7,11,0)
  4558                TEXT^100.0 0703^^3;0
  4559                "^DD",100. 007,100.00 7,11,21,0)
  4560                ^^1^1^3161 012^
  4561                "^DD",100. 007,100.00 7,11,21,1, 0)
  4562                Text to be  displayed  in CPRS p op up.
  4563                "^DD",100. 007,100.00 7,11,23,0)
  4564                ^^2^2^3161 009^
  4565                "^DD",100. 007,100.00 7,11,23,1, 0)
  4566                Text loade d into arr ay returne d to CPRS  which is t hen displa yed in CPR
  4567                "^DD",100. 007,100.00 7,11,23,2, 0)
  4568                pop up box  during pa tient load .
  4569                "^DD",100. 007,100.00 701,0)
  4570                DESCRIPTIO N SUB-FIEL D^^.01^1
  4571                "^DD",100. 007,100.00 701,0,"NM" ,"DESCRIPT ION")
  4572                 
  4573                "^DD",100. 007,100.00 701,0,"UP" )
  4574                100.007
  4575                "^DD",100. 007,100.00 701,.01,0)
  4576                DESCRIPTIO N^Wx^^0;1^ Q
  4577                "^DD",100. 007,100.00 701,.01,"D T")
  4578                3140224
  4579                "^DD",100. 007,100.00 702,0)
  4580                XECUTABLE  CODE SUB-F IELD^^.01^ 1
  4581                "^DD",100. 007,100.00 702,0,"DT" )
  4582                3161009
  4583                "^DD",100. 007,100.00 702,0,"NM" ,"XECUTABL E CODE")
  4584                 
  4585                "^DD",100. 007,100.00 702,0,"UP" )
  4586                100.007
  4587                "^DD",100. 007,100.00 702,.01,0)
  4588                XECUTABLE  CODE^Wx^^0 ;1^Q
  4589                "^DD",100. 007,100.00 702,.01,.1 )
  4590                Validation  code for  FLAG for i nclusion i n CPRS pop  up
  4591                "^DD",100. 007,100.00 702,.01,"D T")
  4592                3161009
  4593                "^DD",100. 007,100.00 703,0)
  4594                TEXT SUB-F IELD^^.01^ 1
  4595                "^DD",100. 007,100.00 703,0,"NM" ,"TEXT")
  4596                 
  4597                "^DD",100. 007,100.00 703,0,"UP" )
  4598                100.007
  4599                "^DD",100. 007,100.00 703,.01,0)
  4600                TEXT^Wx^^0 ;1^Q
  4601                "^DD",100. 007,100.00 703,.01,"D T")
  4602                3140224
  4603                "^DD",100. 0071,100.0 071,0)
  4604                FIELD^^1^2
  4605                "^DD",100. 0071,100.0 071,0,"DT" )
  4606                3161020
  4607                "^DD",100. 0071,100.0 071,0,"IX" ,"B",100.0 071,.01)
  4608                 
  4609                "^DD",100. 0071,100.0 071,0,"NM" ,"ORPU POP UP PATIENT  FLAG")
  4610                 
  4611                "^DD",100. 0071,100.0 071,.01,0)
  4612                PATIENT^RP 2'X^DPT(^0 ;1^S DINUM =X
  4613                "^DD",100. 0071,100.0 071,.01,.1 )
  4614                Name of pa tient for  which flag  is being  attached
  4615                "^DD",100. 0071,100.0 071,.01,1, 0)
  4616                ^.1
  4617                "^DD",100. 0071,100.0 071,.01,1, 1,0)
  4618                100.0071^B
  4619                "^DD",100. 0071,100.0 071,.01,1, 1,1)
  4620                S ^OR(100. 0071,"B",$ E(X,1,30), DA)=""
  4621                "^DD",100. 0071,100.0 071,.01,1, 1,2)
  4622                K ^OR(100. 0071,"B",$ E(X,1,30), DA)
  4623                "^DD",100. 0071,100.0 071,.01,3)
  4624                Enter Pati ent Name t o attach F LAG to.
  4625                "^DD",100. 0071,100.0 071,.01,21 ,0)
  4626                ^^1^1^3161 009^^
  4627                "^DD",100. 0071,100.0 071,.01,21 ,1,0)
  4628                Name of pa tient for  which a po p up flag  is to be d isplayed i n CPRS pop  up.
  4629                "^DD",100. 0071,100.0 071,.01,23 ,0)
  4630                ^^2^2^3161 009^^
  4631                "^DD",100. 0071,100.0 071,.01,23 ,1,0)
  4632                Name of pa tient for  which text  for pop u p flag wil l be inclu ded in arr ay 
  4633                "^DD",100. 0071,100.0 071,.01,23 ,2,0)
  4634                returned t o CPRS and  displayed  at patien t load/ref resh.
  4635                "^DD",100. 0071,100.0 071,.01,"D T")
  4636                3161013
  4637                "^DD",100. 0071,100.0 071,1,0)
  4638                FLAG^100.0 0711P^^1;0
  4639                "^DD",100. 0071,100.0 071,1,21,0 )
  4640                ^.001^1^1^ 3161020^^^ ^
  4641                "^DD",100. 0071,100.0 071,1,21,1 ,0)
  4642                Flag(s) as signed to  patient to  be includ ed in disp lay in CRP S pop up.
  4643                "^DD",100. 0071,100.0 071,1,23,0 )
  4644                ^.001^2^2^ 3161020^^
  4645                "^DD",100. 0071,100.0 071,1,23,1 ,0)
  4646                Flag, for  whose text  which wil l be inclu ded in arr ay returne d to CPRS  and 
  4647                "^DD",100. 0071,100.0 071,1,23,2 ,0)
  4648                displayed  in pop up  message du ring patie nt load/re fresh.
  4649                "^DD",100. 0071,100.0 0711,0)
  4650                FLAG SUB-F IELD^^1^2
  4651                "^DD",100. 0071,100.0 0711,0,"DT ")
  4652                3161020
  4653                "^DD",100. 0071,100.0 0711,0,"IX ","B",100. 00711,.01)
  4654                 
  4655                "^DD",100. 0071,100.0 0711,0,"NM ","FLAG")
  4656                 
  4657                "^DD",100. 0071,100.0 0711,0,"UP ")
  4658                100.0071
  4659                "^DD",100. 0071,100.0 0711,.01,0 )
  4660                FLAG^MP100 .0072'^OR( 100.0072,^ 0;1^Q
  4661                "^DD",100. 0071,100.0 0711,.01,. 1)
  4662                FLAG FLAG  whose text  will be d isplayed i n CPRS pop  up box
  4663                "^DD",100. 0071,100.0 0711,.01,1 ,0)
  4664                ^.1
  4665                "^DD",100. 0071,100.0 0711,.01,1 ,1,0)
  4666                100.00711^ B
  4667                "^DD",100. 0071,100.0 0711,.01,1 ,1,1)
  4668                S ^OR(100. 0071,DA(1) ,1,"B",$E( X,1,30),DA )=""
  4669                "^DD",100. 0071,100.0 0711,.01,1 ,1,2)
  4670                K ^OR(100. 0071,DA(1) ,1,"B",$E( X,1,30),DA )
  4671                "^DD",100. 0071,100.0 0711,.01,3 )
  4672                Enter a va lid FLAG t o be assig ned to thi s patient.  The text  for this f lag will b e displaye d with thi s patient  in CPRS.
  4673                "^DD",100. 0071,100.0 0711,.01,2 1,0)
  4674                ^.001^1^1^ 3161020^^
  4675                "^DD",100. 0071,100.0 0711,.01,2 1,1,0)
  4676                This flag  will be as signed to  this patie nt
  4677                "^DD",100. 0071,100.0 0711,.01,2 3,0)
  4678                ^^2^2^3161 020^
  4679                "^DD",100. 0071,100.0 0711,.01,2 3,1,0)
  4680                One of mul tiple flag s which ma y be assig ned indivi dually to  a patient  to 
  4681                "^DD",100. 0071,100.0 0711,.01,2 3,2,0)
  4682                be display ed when CP RS loads/r efreshes t his patien t.
  4683                "^DD",100. 0071,100.0 0711,.01," DT")
  4684                3161020
  4685                "^DD",100. 0071,100.0 0711,1,0)
  4686                COMMENTS^1 00.00712^^ 1;0
  4687                "^DD",100. 0071,100.0 0711,1,21, 0)
  4688                ^^2^2^3161 020^
  4689                "^DD",100. 0071,100.0 0711,1,21, 1,0)
  4690                Free text  which may  explain wh y this FLA G is being  associate d with thi
  4691                "^DD",100. 0071,100.0 0711,1,21, 2,0)
  4692                patient.
  4693                "^DD",100. 0071,100.0 0712,0)
  4694                COMMENTS S UB-FIELD^^ .01^1
  4695                "^DD",100. 0071,100.0 0712,0,"NM ","COMMENT S")
  4696                 
  4697                "^DD",100. 0071,100.0 0712,0,"UP ")
  4698                100.00711
  4699                "^DD",100. 0071,100.0 0712,.01,0 )
  4700                COMMENTS^W x^^0;1
  4701                "^DD",100. 0071,100.0 0712,.01," DT")
  4702                3140228
  4703                "^DD",100. 0072,100.0 072,0)
  4704                FIELD^^2^2
  4705                "^DD",100. 0072,100.0 072,0,"DT" )
  4706                3161026
  4707                "^DD",100. 0072,100.0 072,0,"IX" ,"B",100.0 072,.01)
  4708                 
  4709                "^DD",100. 0072,100.0 072,0,"NM" ,"ORPU POP UP FLAG")
  4710                 
  4711                "^DD",100. 0072,100.0 072,0,"PT" ,100.00711 ,.01)
  4712                 
  4713                "^DD",100. 0072,100.0 072,.01,0)
  4714                NAME^RF^^0 ;1^K:$L(X) >10!($L(X) <3)!'(X'?1 P.E) X
  4715                "^DD",100. 0072,100.0 072,.01,.1 )
  4716                Pop up fla g name to  be used in  pop up lo gic
  4717                "^DD",100. 0072,100.0 072,.01,1, 0)
  4718                ^.1
  4719                "^DD",100. 0072,100.0 072,.01,1, 1,0)
  4720                100.0072^B
  4721                "^DD",100. 0072,100.0 072,.01,1, 1,1)
  4722                S ^OR(100. 0072,"B",$ E(X,1,30), DA)=""
  4723                "^DD",100. 0072,100.0 072,.01,1, 1,2)
  4724                K ^OR(100. 0072,"B",$ E(X,1,30), DA)
  4725                "^DD",100. 0072,100.0 072,.01,3)
  4726                Enter the  name of th e Pop Up f lag being  created.
  4727                "^DD",100. 0072,100.0 072,.01,21 ,0)
  4728                ^.001^1^1^ 3161026^^
  4729                "^DD",100. 0072,100.0 072,.01,21 ,1,0)
  4730                Name of po p up flag  to be used  in CPRS p op up mess age.
  4731                "^DD",100. 0072,100.0 072,.01,23 ,0)
  4732                ^.001^2^2^ 3161026^^
  4733                "^DD",100. 0072,100.0 072,.01,23 ,1,0)
  4734                For a flag  to be use d in the p op up mess age for CP RS, it mus t first be  
  4735                "^DD",100. 0072,100.0 072,.01,23 ,2,0)
  4736                defined he re.  This  is the ini tial set u p file for  any pop u p flag use d.
  4737                "^DD",100. 0072,100.0 072,.01,"D T")
  4738                3161026
  4739                "^DD",100. 0072,100.0 072,2,0)
  4740                DESCRIPTIO N^F^^1;1^K :$L(X)>250 !($L(X)<3)  X
  4741                "^DD",100. 0072,100.0 072,2,.1)
  4742                Pop up fla g descript ion
  4743                "^DD",100. 0072,100.0 072,2,3)
  4744                Enter a de scription  for this F LAG 3-250  characters  in length .
  4745                "^DD",100. 0072,100.0 072,2,21,0 )
  4746                ^^1^1^3161 009^
  4747                "^DD",100. 0072,100.0 072,2,21,1 ,0)
  4748                Descriptio n of the p op up flag  that is b eing creat ed.
  4749                "^DD",100. 0072,100.0 072,2,23,0 )
  4750                ^^1^1^3161 009^
  4751                "^DD",100. 0072,100.0 072,2,23,1 ,0)
  4752                Descriptio n of new p op up flag  that is b eing creat ed.
  4753                "^DD",100. 0072,100.0 072,2,"DT" )
  4754                3161026
  4755                "^DD",100. 0073,100.0 073,0)
  4756                FIELD^^1^2
  4757                "^DD",100. 0073,100.0 073,0,"DT" )
  4758                3161026
  4759                "^DD",100. 0073,100.0 073,0,"IX" ,"B",100.0 073,.01)
  4760                 
  4761                "^DD",100. 0073,100.0 073,0,"NM" ,"ORPU POP UP LOCAL N OTICE")
  4762                 
  4763                "^DD",100. 0073,100.0 073,.01,0)
  4764                PATIENT^RP 2'X^DPT(^0 ;1^S DINUM =X
  4765                "^DD",100. 0073,100.0 073,.01,.1 )
  4766                Patient to  receive l ocal notic e
  4767                "^DD",100. 0073,100.0 073,.01,1, 0)
  4768                ^.1
  4769                "^DD",100. 0073,100.0 073,.01,1, 1,0)
  4770                100.0073^B
  4771                "^DD",100. 0073,100.0 073,.01,1, 1,1)
  4772                S ^OR(100. 0073,"B",$ E(X,1,30), DA)=""
  4773                "^DD",100. 0073,100.0 073,.01,1, 1,2)
  4774                K ^OR(100. 0073,"B",$ E(X,1,30), DA)
  4775                "^DD",100. 0073,100.0 073,.01,3)
  4776                ENTER THE  NAME OF TH E PATIENT  FOR WHICH  THE LOCAL  NOTICE IS  TO BE DISP LAYED IN C PRS.
  4777                "^DD",100. 0073,100.0 073,.01,21 ,0)
  4778                ^^1^1^3161 009^
  4779                "^DD",100. 0073,100.0 073,.01,21 ,1,0)
  4780                Name of pa tient for  which a lo cal flag i s to be di splayed in  CPRS pop  up.
  4781                "^DD",100. 0073,100.0 073,.01,23 ,0)
  4782                ^^2^2^3161 009^
  4783                "^DD",100. 0073,100.0 073,.01,23 ,1,0)
  4784                Name of pa tient for  which text  for speci fic local  notice wil l be inclu ded 
  4785                "^DD",100. 0073,100.0 073,.01,23 ,2,0)
  4786                in array r eturned to  CPRS and  displayed  at patient  load/refr esh.
  4787                "^DD",100. 0073,100.0 073,.01,"D T")
  4788                3161026
  4789                "^DD",100. 0073,100.0 073,1,0)
  4790                NOTICE TEX T^F^^0;2^K :$L(X)>75! ($L(X)<2)  X
  4791                "^DD",100. 0073,100.0 073,1,.1)
  4792                Local noti ce text be ing assign ed.
  4793                "^DD",100. 0073,100.0 073,1,3)
  4794                ENTER THE  LOCAL NOTI CE TO BE D ISPLAYED I N CPRS, 2- 75 CHARACT ERS IN LEN GTH.
  4795                "^DD",100. 0073,100.0 073,1,21,0 )
  4796                ^^1^1^3161 009^
  4797                "^DD",100. 0073,100.0 073,1,21,1 ,0)
  4798                Text that  is to be d isplayed f or this pa tient in C PRS pop up  message.
  4799                "^DD",100. 0073,100.0 073,1,23,0 )
  4800                ^^2^2^3161 009^
  4801                "^DD",100. 0073,100.0 073,1,23,1 ,0)
  4802                Specific t ext repres enting loc al notice  that is in cluded in  array 
  4803                "^DD",100. 0073,100.0 073,1,23,2 ,0)
  4804                returned t o CPRS for  pop up me ssage.
  4805                "^DD",100. 0073,100.0 073,1,"DT" )
  4806                3161026
  4807                "^DD",100. 0074,100.0 074,0)
  4808                FIELD^^.01 ^1
  4809                "^DD",100. 0074,100.0 074,0,"DT" )
  4810                3161026
  4811                "^DD",100. 0074,100.0 074,0,"IX" ,"B",100.0 074,.01)
  4812                 
  4813                "^DD",100. 0074,100.0 074,0,"NM" ,"ORPU POP UP VESTING ")
  4814                 
  4815                "^DD",100. 0074,100.0 074,.01,0)
  4816                NAME^RV^^0 ;1^
  4817                "^DD",100. 0074,100.0 074,.01,.1 )
  4818                Vesting id entifier
  4819                "^DD",100. 0074,100.0 074,.01,1, 0)
  4820                ^.1
  4821                "^DD",100. 0074,100.0 074,.01,1, 1,0)
  4822                100.0074^B
  4823                "^DD",100. 0074,100.0 074,.01,1, 1,1)
  4824                S ^OR(100. 0074,"B",$ E(X,1,30), DA)=""
  4825                "^DD",100. 0074,100.0 074,.01,1, 1,2)
  4826                K ^OR(100. 0074,"B",$ E(X,1,30), DA)
  4827                "^DD",100. 0074,100.0 074,.01,3)
  4828                ENTER THE  ROLE OR CP T CODE 3-3 0 CHARACTE RS, NOT NU MERIC OR S TARTING WI TH PUNCTUA TION.
  4829                "^DD",100. 0074,100.0 074,.01,21 ,0)
  4830                ^^2^2^3161 009^
  4831                "^DD",100. 0074,100.0 074,.01,21 ,1,0)
  4832                Name of ro le or CPT  code to ev aluated fo r vesting  logic of t his patien
  4833                "^DD",100. 0074,100.0 074,.01,21 ,2,0)
  4834                and subseq uently inc luded in C PRS pop up  message.
  4835                "^DD",100. 0074,100.0 074,.01,23 ,0)
  4836                ^^3^3^3161 009^
  4837                "^DD",100. 0074,100.0 074,.01,23 ,1,0)
  4838                Role or CP T code whi ch will be  evaluated  for VESTI NG status,  and will 
  4839                "^DD",100. 0074,100.0 074,.01,23 ,2,0)
  4840                trigger lo gic for te xt to be i ncluded in  array ret urned to C PRS for po
  4841                "^DD",100. 0074,100.0 074,.01,23 ,3,0)
  4842                up.
  4843                "^DD",100. 0074,100.0 074,.01,"D T")
  4844                3161026
  4845                "^DD",100. 0074,100.0 074,.01,"V ",0)
  4846                ^.12P^2^2
  4847                "^DD",100. 0074,100.0 074,.01,"V ",1,0)
  4848                81^CPT COD E^1^CPT^n^
  4849                "^DD",100. 0074,100.0 074,.01,"V ",2,0)
  4850                8932.1^PER SON CLASS^ 2^PC^n^
  4851                "^DD",200, 200,9500,0 )
  4852                DEFAULT EN COUNTER LO CATION^200 .08P^^DELO C;0
  4853                "^DD",200, 200,9500,2 1,0)
  4854                ^^8^8^3160 920^
  4855                "^DD",200, 200,9500,2 1,1,0)
  4856                This sub-f ile will p rovide a l ist of def ault encou nter locat ions (poin ters
  4857                "^DD",200, 200,9500,2 1,2,0)
  4858                to the HOS PITAL LOCA TION (#44)  file) to  allow a li st of freq uently use
  4859                "^DD",200, 200,9500,2 1,3,0)
  4860                clinics an d wards to  be presen ted at the  top of th e list whe n selectin
  4861                "^DD",200, 200,9500,2 1,4,0)
  4862                the encoun ter locati on to be u sed when d efining a  visit.  Th is list, a long
  4863                "^DD",200, 200,9500,2 1,5,0)
  4864                with the l ists in TI U for Day- Of-week cl inics, wil l provide  easier loo kup 
  4865                "^DD",200, 200,9500,2 1,6,0)
  4866                and select ion for th e provider  to pick o n the Enco unter Defi nition scr een 
  4867                "^DD",200, 200,9500,2 1,7,0)
  4868                in CPRS.   Locations  are extrac ted and pu t in alpha betical or der for ea sy 
  4869                "^DD",200, 200,9500,2 1,8,0)
  4870                display.
  4871                "^DD",200, 200,9500,2 3,0)
  4872                ^^3^3^3160 920^
  4873                "^DD",200, 200,9500,2 3,1,0)
  4874                List of De fault Enco unter Loca tions for  selection  while defi ning an 
  4875                "^DD",200, 200,9500,2 3,2,0)
  4876                encountter  inside CP RS.  The l ist is alp habetized  by concate nating a 
  4877                "^DD",200, 200,9500,2 3,3,0)
  4878                space to t he beginni ng of the  Location's  name - pr oviding a  natural so rt.
  4879                "^DD",200, 200.08,0)
  4880                DEFAULT EN COUNTER LO CATION SUB -FIELD^^.0 1^1
  4881                "^DD",200, 200.08,0," NM","DEFAU LT ENCOUNT ER LOCATIO N")
  4882                 
  4883                "^DD",200, 200.08,.01 ,0)
  4884                DEFAULT EN COUNTER LO CATION^MP4 4^SC(^0;1^ Q
  4885                "^DD",200, 200.08,.01 ,1,0)
  4886                ^.1
  4887                "^DD",200, 200.08,.01 ,1,1,0)
  4888                200.08^B
  4889                "^DD",200, 200.08,.01 ,1,1,1)
  4890                S ^VA(200, DA(1),"DEL OC","B",$E (X,1,30),D A)=""
  4891                "^DD",200, 200.08,.01 ,1,1,2)
  4892                K ^VA(200, DA(1),"DEL OC","B",$E (X,1,30),D A)
  4893                "^DD",200, 200.08,.01 ,3)
  4894                Enter Hosp ital Locat ion to def ault for C PRS Encoun ter prompt .
  4895                "^DD",200, 200.08,.01 ,21,0)
  4896                ^^2^2^3160 823^
  4897                "^DD",200, 200.08,.01 ,21,1,0)
  4898                This field  will allo w the user  to enter  default Ho spital Loc ations to 
  4899                "^DD",200, 200.08,.01 ,21,2,0)
  4900                be entered  for the E ncounter d ialog box  in CPRS.
  4901                "^DD",200, 200.08,.01 ,"DT")
  4902                3160823
  4903                "^DIC",100 .007,100.0 07,0)
  4904                ORPU POPUP  XECUTEABL E CODE^100 .007
  4905                "^DIC",100 .007,100.0 07,0,"GL")
  4906                ^OR(100.00 7,
  4907                "^DIC",100 .007,100.0 07,"%",0)
  4908                ^1.005^^
  4909                "^DIC",100 .007,100.0 07,"%D",0)
  4910                ^^7^7^3161 012^
  4911                "^DIC",100 .007,100.0 07,"%D",1, 0)
  4912                This file  contains t he flags u sed in the  CPRS pop  up functio nality.  
  4913                "^DIC",100 .007,100.0 07,"%D",2, 0)
  4914                Filed with  those fla gs is thei r executab le code wh ich evalua tes the st atus
  4915                "^DIC",100 .007,100.0 07,"%D",3, 0)
  4916                of that re spective f lag in reg ards to th e patient  being acce ssed.  If  the 
  4917                "^DIC",100 .007,100.0 07,"%D",4, 0)
  4918                code Xecut ed determi nes a vali d conditio n, the tex t for that  flag is 
  4919                "^DIC",100 .007,100.0 07,"%D",5, 0)
  4920                populated  into a loc al array.   That arra y is then  passed bac k to CPRS  to 
  4921                "^DIC",100 .007,100.0 07,"%D",6, 0)
  4922                be display ed to the  user in a  pop up box .  That po p up box i s displaye d
  4923                "^DIC",100 .007,100.0 07,"%D",7, 0)
  4924                when a pat ient is lo aded or re freshed.
  4925                "^DIC",100 .007,"B"," ORPU POPUP  XECUTEABL E CODE",10 0.007)
  4926                 
  4927                "^DIC",100 .0071,100. 0071,0)
  4928                ORPU POPUP  PATIENT F LAG^100.00 71
  4929                "^DIC",100 .0071,100. 0071,0,"GL ")
  4930                ^OR(100.00 71,
  4931                "^DIC",100 .0071,100. 0071,"%",0 )
  4932                ^1.005^^
  4933                "^DIC",100 .0071,100. 0071,"%D", 0)
  4934                ^1.001^2^2 ^3161010^^
  4935                "^DIC",100 .0071,100. 0071,"%D", 1,0)
  4936                Flag conta ining pati ent name a nd associa ted flag t o be displ ayed in CP RS 
  4937                "^DIC",100 .0071,100. 0071,"%D", 2,0)
  4938                pop up mes sage durin g patient  load/refre sh.
  4939                "^DIC",100 .0071,"B", "ORPU POPU P PATIENT  FLAG",100. 0071)
  4940                 
  4941                "^DIC",100 .0072,100. 0072,0)
  4942                ORPU POPUP  FLAG^100. 0072
  4943                "^DIC",100 .0072,100. 0072,0,"GL ")
  4944                ^OR(100.00 72,
  4945                "^DIC",100 .0072,100. 0072,"%",0 )
  4946                ^1.005^^
  4947                "^DIC",100 .0072,100. 0072,"%D", 0)
  4948                ^^2^2^3161 020^
  4949                "^DIC",100 .0072,100. 0072,"%D", 1,0)
  4950                File for f lags which  are used  in CPRS po p up messa ge during  patient 
  4951                "^DIC",100 .0072,100. 0072,"%D", 2,0)
  4952                load/refre sh.  All f lags used  must be in  this file .
  4953                "^DIC",100 .0072,"B", "ORPU POPU P FLAG",10 0.0072)
  4954                 
  4955                "^DIC",100 .0073,100. 0073,0)
  4956                ORPU POPUP  LOCAL NOT ICE^100.00 73
  4957                "^DIC",100 .0073,100. 0073,0,"GL ")
  4958                ^OR(100.00 73,
  4959                "^DIC",100 .0073,100. 0073,"%",0 )
  4960                ^1.005^^
  4961                "^DIC",100 .0073,100. 0073,"%D", 0)
  4962                ^^2^2^3161 009^
  4963                "^DIC",100 .0073,100. 0073,"%D", 1,0)
  4964                File conta ining text , for loca l notice o f a patien t, which i s displaye
  4965                "^DIC",100 .0073,100. 0073,"%D", 2,0)
  4966                in CPRS po p up messa ge.
  4967                "^DIC",100 .0073,"B", "ORPU POPU P LOCAL NO TICE",100. 0073)
  4968                 
  4969                "^DIC",100 .0074,100. 0074,0)
  4970                ORPU POPUP  VESTING^1 00.0074
  4971                "^DIC",100 .0074,100. 0074,0,"GL ")
  4972                ^OR(100.00 74,
  4973                "^DIC",100 .0074,100. 0074,"%",0 )
  4974                ^1.005^^
  4975                "^DIC",100 .0074,100. 0074,"%D", 0)
  4976                ^^3^3^3161 009^
  4977                "^DIC",100 .0074,100. 0074,"%D", 1,0)
  4978                File conta ining role s and CPT  codes for  which vest ing logic  is checked  
  4979                "^DIC",100 .0074,100. 0074,"%D", 2,0)
  4980                against re sulting in  text disp layed in C PRS pop up  message i ndicating 
  4981                "^DIC",100 .0074,100. 0074,"%D", 3,0)
  4982                patient is  not veste d.
  4983                "^DIC",100 .0074,"B", "ORPU POPU P VESTING" ,100.0074)
  4984                 
  4985                "BLD",9881 ,6)
  4986                8^
  4987                **END**
  4988                **END**
  4989               
  4990