Changeset 1592 for smart


Ignore:
Timestamp:
Oct 30, 2012, 1:54:46 PM (12 years ago)
Author:
Sam Habiel
Message:

Updated License on all files

Location:
smart/trunk/kids
Files:
1 deleted
1 edited

Legend:

Unmodified
Added
Removed
  • smart/trunk/kids/VISTA_SMART_CONTAINER_1T5.KID

    r1571 r1592  
    1 KIDS Distribution saved on Oct 13, 2012@13:00:56
    2 fix for lab units not found and analysis routines
     1KIDS Distribution saved on Oct 30, 2012@11:06:18
     2VISTA SMART CONTAINER V1.0
    33**KIDS**:VISTA SMART CONTAINER 1.0^
    44
    55**INSTALL NAME**
    66VISTA SMART CONTAINER 1.0
    7 "BLD",8180,0)
    8 VISTA SMART CONTAINER 1.0^VISTA SMART CONTAINER^0^3121013^n
    9 "BLD",8180,1,0)
    10 ^^1^1^3120926^
    11 "BLD",8180,1,1,0)
     7"BLD",7885,0)
     8VISTA SMART CONTAINER 1.0^VISTA SMART CONTAINER^0^3121030^n
     9"BLD",7885,1,0)
     10^^5^5^3121030^
     11"BLD",7885,1,1,0)
     12Licensed under the AGPL v3.
     13"BLD",7885,1,2,0)
     14 
     15"BLD",7885,1,3,0)
     16http://www.gnu.org/licenses/agpl-3.0.html
     17"BLD",7885,1,4,0)
     18 
     19"BLD",7885,1,5,0)
    1220Version 1.0
    13 "BLD",8180,4,0)
     21"BLD",7885,4,0)
    1422^9.64PA^^
    15 "BLD",8180,6.3)
    16 5
    17 "BLD",8180,"ABPKG")
     23"BLD",7885,6.3)
     246
     25"BLD",7885,"ABPKG")
    1826n
    19 "BLD",8180,"KRN",0)
     27"BLD",7885,"KRN",0)
    2028^9.67PA^779.2^20
    21 "BLD",8180,"KRN",.4,0)
     29"BLD",7885,"KRN",.4,0)
    2230.4
    23 "BLD",8180,"KRN",.401,0)
     31"BLD",7885,"KRN",.401,0)
    2432.401
    25 "BLD",8180,"KRN",.402,0)
     33"BLD",7885,"KRN",.402,0)
    2634.402
    27 "BLD",8180,"KRN",.403,0)
     35"BLD",7885,"KRN",.403,0)
    2836.403
    29 "BLD",8180,"KRN",.5,0)
     37"BLD",7885,"KRN",.5,0)
    3038.5
    31 "BLD",8180,"KRN",.84,0)
     39"BLD",7885,"KRN",.84,0)
    3240.84
    33 "BLD",8180,"KRN",3.6,0)
     41"BLD",7885,"KRN",3.6,0)
    34423.6
    35 "BLD",8180,"KRN",3.8,0)
     43"BLD",7885,"KRN",3.8,0)
    36443.8
    37 "BLD",8180,"KRN",9.2,0)
     45"BLD",7885,"KRN",9.2,0)
    38469.2
    39 "BLD",8180,"KRN",9.8,0)
     47"BLD",7885,"KRN",9.8,0)
    40489.8
    41 "BLD",8180,"KRN",9.8,"NM",0)
     49"BLD",7885,"KRN",9.8,"NM",0)
    4250^9.68A^13^13
    43 "BLD",8180,"KRN",9.8,"NM",1,0)
    44 C0SDEM^^0^B59022362
    45 "BLD",8180,"KRN",9.8,"NM",2,0)
    46 C0SDOM^^0^B87367162
    47 "BLD",8180,"KRN",9.8,"NM",3,0)
    48 C0SLAB^^0^B79856252
    49 "BLD",8180,"KRN",9.8,"NM",4,0)
    50 C0SMART^^0^B2907401
    51 "BLD",8180,"KRN",9.8,"NM",5,0)
    52 C0SMED^^0^B40719083
    53 "BLD",8180,"KRN",9.8,"NM",6,0)
    54 C0SMXMLB^^0^B12189644
    55 "BLD",8180,"KRN",9.8,"NM",7,0)
    56 C0SNHIN^^0^B88600644
    57 "BLD",8180,"KRN",9.8,"NM",8,0)
     51"BLD",7885,"KRN",9.8,"NM",1,0)
     52C0SDEM^^0^B58572381
     53"BLD",7885,"KRN",9.8,"NM",2,0)
     54C0SDOM^^0^B86029417
     55"BLD",7885,"KRN",9.8,"NM",3,0)
     56C0SLAB^^0^B79123674
     57"BLD",7885,"KRN",9.8,"NM",4,0)
     58C0SMART^^0^B2814519
     59"BLD",7885,"KRN",9.8,"NM",5,0)
     60C0SMED^^0^B40022947
     61"BLD",7885,"KRN",9.8,"NM",6,0)
     62C0SMXMLB^^0^B12331075
     63"BLD",7885,"KRN",9.8,"NM",7,0)
     64C0SNHIN^^0^B87708170
     65"BLD",7885,"KRN",9.8,"NM",8,0)
    5866C0SNHINV^^0^B15736572
    59 "BLD",8180,"KRN",9.8,"NM",9,0)
    60 C0SPROB^^0^B49669400
    61 "BLD",8180,"KRN",9.8,"NM",10,0)
    62 C0SPROB2^^0^B67594874
    63 "BLD",8180,"KRN",9.8,"NM",11,0)
    64 C0STBL^^0^B23989761
    65 "BLD",8180,"KRN",9.8,"NM",12,0)
    66 C0SUTIL^^0^B1005502
    67 "BLD",8180,"KRN",9.8,"NM",13,0)
    68 C0SXPATH^^0^B521283143
    69 "BLD",8180,"KRN",9.8,"NM","B","C0SDEM",1)
     67"BLD",7885,"KRN",9.8,"NM",9,0)
     68C0SPROB^^0^B49349956
     69"BLD",7885,"KRN",9.8,"NM",10,0)
     70C0SPROB2^^0^B67175408
     71"BLD",7885,"KRN",9.8,"NM",11,0)
     72C0STBL^^0^B23538791
     73"BLD",7885,"KRN",9.8,"NM",12,0)
     74C0SUTIL^^0^B968662
     75"BLD",7885,"KRN",9.8,"NM",13,0)
     76C0SXPATH^^0^B518728149
     77"BLD",7885,"KRN",9.8,"NM","B","C0SDEM",1)
    7078
    71 "BLD",8180,"KRN",9.8,"NM","B","C0SDOM",2)
     79"BLD",7885,"KRN",9.8,"NM","B","C0SDOM",2)
    7280
    73 "BLD",8180,"KRN",9.8,"NM","B","C0SLAB",3)
     81"BLD",7885,"KRN",9.8,"NM","B","C0SLAB",3)
    7482
    75 "BLD",8180,"KRN",9.8,"NM","B","C0SMART",4)
     83"BLD",7885,"KRN",9.8,"NM","B","C0SMART",4)
    7684
    77 "BLD",8180,"KRN",9.8,"NM","B","C0SMED",5)
     85"BLD",7885,"KRN",9.8,"NM","B","C0SMED",5)
    7886
    79 "BLD",8180,"KRN",9.8,"NM","B","C0SMXMLB",6)
     87"BLD",7885,"KRN",9.8,"NM","B","C0SMXMLB",6)
    8088
    81 "BLD",8180,"KRN",9.8,"NM","B","C0SNHIN",7)
     89"BLD",7885,"KRN",9.8,"NM","B","C0SNHIN",7)
    8290
    83 "BLD",8180,"KRN",9.8,"NM","B","C0SNHINV",8)
     91"BLD",7885,"KRN",9.8,"NM","B","C0SNHINV",8)
    8492
    85 "BLD",8180,"KRN",9.8,"NM","B","C0SPROB",9)
     93"BLD",7885,"KRN",9.8,"NM","B","C0SPROB",9)
    8694
    87 "BLD",8180,"KRN",9.8,"NM","B","C0SPROB2",10)
     95"BLD",7885,"KRN",9.8,"NM","B","C0SPROB2",10)
    8896
    89 "BLD",8180,"KRN",9.8,"NM","B","C0STBL",11)
     97"BLD",7885,"KRN",9.8,"NM","B","C0STBL",11)
    9098
    91 "BLD",8180,"KRN",9.8,"NM","B","C0SUTIL",12)
     99"BLD",7885,"KRN",9.8,"NM","B","C0SUTIL",12)
    92100
    93 "BLD",8180,"KRN",9.8,"NM","B","C0SXPATH",13)
     101"BLD",7885,"KRN",9.8,"NM","B","C0SXPATH",13)
    94102
    95 "BLD",8180,"KRN",19,0)
     103"BLD",7885,"KRN",19,0)
    9610419
    97 "BLD",8180,"KRN",19.1,0)
     105"BLD",7885,"KRN",19.1,0)
    9810619.1
    99 "BLD",8180,"KRN",101,0)
     107"BLD",7885,"KRN",101,0)
    100108101
    101 "BLD",8180,"KRN",409.61,0)
     109"BLD",7885,"KRN",409.61,0)
    102110409.61
    103 "BLD",8180,"KRN",771,0)
     111"BLD",7885,"KRN",771,0)
    104112771
    105 "BLD",8180,"KRN",779.2,0)
     113"BLD",7885,"KRN",779.2,0)
    106114779.2
    107 "BLD",8180,"KRN",870,0)
     115"BLD",7885,"KRN",870,0)
    108116870
    109 "BLD",8180,"KRN",8989.51,0)
     117"BLD",7885,"KRN",8989.51,0)
    1101188989.51
    111 "BLD",8180,"KRN",8989.52,0)
     119"BLD",7885,"KRN",8989.52,0)
    1121208989.52
    113 "BLD",8180,"KRN",8994,0)
     121"BLD",7885,"KRN",8994,0)
    1141228994
    115 "BLD",8180,"KRN","B",.4,.4)
     123"BLD",7885,"KRN","B",.4,.4)
    116124
    117 "BLD",8180,"KRN","B",.401,.401)
     125"BLD",7885,"KRN","B",.401,.401)
    118126
    119 "BLD",8180,"KRN","B",.402,.402)
     127"BLD",7885,"KRN","B",.402,.402)
    120128
    121 "BLD",8180,"KRN","B",.403,.403)
     129"BLD",7885,"KRN","B",.403,.403)
    122130
    123 "BLD",8180,"KRN","B",.5,.5)
     131"BLD",7885,"KRN","B",.5,.5)
    124132
    125 "BLD",8180,"KRN","B",.84,.84)
     133"BLD",7885,"KRN","B",.84,.84)
    126134
    127 "BLD",8180,"KRN","B",3.6,3.6)
     135"BLD",7885,"KRN","B",3.6,3.6)
    128136
    129 "BLD",8180,"KRN","B",3.8,3.8)
     137"BLD",7885,"KRN","B",3.8,3.8)
    130138
    131 "BLD",8180,"KRN","B",9.2,9.2)
     139"BLD",7885,"KRN","B",9.2,9.2)
    132140
    133 "BLD",8180,"KRN","B",9.8,9.8)
     141"BLD",7885,"KRN","B",9.8,9.8)
    134142
    135 "BLD",8180,"KRN","B",19,19)
     143"BLD",7885,"KRN","B",19,19)
    136144
    137 "BLD",8180,"KRN","B",19.1,19.1)
     145"BLD",7885,"KRN","B",19.1,19.1)
    138146
    139 "BLD",8180,"KRN","B",101,101)
     147"BLD",7885,"KRN","B",101,101)
    140148
    141 "BLD",8180,"KRN","B",409.61,409.61)
     149"BLD",7885,"KRN","B",409.61,409.61)
    142150
    143 "BLD",8180,"KRN","B",771,771)
     151"BLD",7885,"KRN","B",771,771)
    144152
    145 "BLD",8180,"KRN","B",779.2,779.2)
     153"BLD",7885,"KRN","B",779.2,779.2)
    146154
    147 "BLD",8180,"KRN","B",870,870)
     155"BLD",7885,"KRN","B",870,870)
    148156
    149 "BLD",8180,"KRN","B",8989.51,8989.51)
     157"BLD",7885,"KRN","B",8989.51,8989.51)
    150158
    151 "BLD",8180,"KRN","B",8989.52,8989.52)
     159"BLD",7885,"KRN","B",8989.52,8989.52)
    152160
    153 "BLD",8180,"KRN","B",8994,8994)
     161"BLD",7885,"KRN","B",8994,8994)
    154162
    155 "BLD",8180,"QUES",0)
     163"BLD",7885,"QUES",0)
    156164^9.62^^
    157 "BLD",8180,"REQB",0)
     165"BLD",7885,"REQB",0)
    158166^9.611^^
    159167"MBREQ")
    1601680
    161 "PKG",216,-1)
     169"PKG",211,-1)
    1621701^1
    163 "PKG",216,0)
     171"PKG",211,0)
    164172VISTA SMART CONTAINER^C0S^RDF Server for Harvard's Smart Data Model
    165 "PKG",216,20,0)
     173"PKG",211,20,0)
    166174^9.402P^^
    167 "PKG",216,22,0)
     175"PKG",211,22,0)
    168176^9.49I^1^1
    169 "PKG",216,22,1,0)
    170 1.0^3121013^3121011^77
    171 "PKG",216,22,1,1,0)
    172 ^^1^1^3121013
    173 "PKG",216,22,1,1,1,0)
     177"PKG",211,22,1,0)
     1781.0^3121030^3121030^8
     179"PKG",211,22,1,1,0)
     180^^5^5^3121030
     181"PKG",211,22,1,1,1,0)
     182Licensed under the AGPL v3.
     183"PKG",211,22,1,1,2,0)
     184 
     185"PKG",211,22,1,1,3,0)
     186http://www.gnu.org/licenses/agpl-3.0.html
     187"PKG",211,22,1,1,4,0)
     188 
     189"PKG",211,22,1,1,5,0)
    174190Version 1.0
    175 "PKG",216,"DEV")
     191"PKG",211,"DEV")
    176192GPL/WV
    177 "PKG",216,"VERSION")
     193"PKG",211,"VERSION")
    1781941.0
    179195"QUES","XPF1",0)
     
    25026613
    251267"RTN","C0SDEM")
    252 0^1^B59022362
     2680^1^B58572381
    253269"RTN","C0SDEM",1,0)
    254 C0SDEM   ; GPL - Smart Demographics Processing ;2/22/12  17:05
     270C0SDEM   ; GPL - Smart Demographics Processing ; 10/30/12 10:59am
    255271"RTN","C0SDEM",2,0)
    256  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     272 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    257273"RTN","C0SDEM",3,0)
    258  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     274 ;Copyright 2012 George Lilly. 
    259275"RTN","C0SDEM",4,0)
    260  ;General Public License See attached copy of the License.
     276 ;
    261277"RTN","C0SDEM",5,0)
    262  ;
     278 ; This program is free software: you can redistribute it and/or modify
    263279"RTN","C0SDEM",6,0)
    264  ;This program is free software; you can redistribute it and/or modify
     280 ; it under the terms of the GNU Affero General Public License as
    265281"RTN","C0SDEM",7,0)
    266  ;it under the terms of the GNU General Public License as published by
     282 ; published by the Free Software Foundation, either version 3 of the
    267283"RTN","C0SDEM",8,0)
    268  ;the Free Software Foundation; either version 2 of the License, or
     284 ; License, or (at your option) any later version.
    269285"RTN","C0SDEM",9,0)
    270  ;(at your option) any later version.
     286 ;
    271287"RTN","C0SDEM",10,0)
    272  ;
     288 ; This program is distributed in the hope that it will be useful,
    273289"RTN","C0SDEM",11,0)
    274  ;This program is distributed in the hope that it will be useful,
     290 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    275291"RTN","C0SDEM",12,0)
    276  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     292 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    277293"RTN","C0SDEM",13,0)
    278  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     294 ; GNU Affero General Public License for more details.
    279295"RTN","C0SDEM",14,0)
    280  ;GNU General Public License for more details.
     296 ;
    281297"RTN","C0SDEM",15,0)
    282  ;
     298 ; You should have received a copy of the GNU Affero General Public License
    283299"RTN","C0SDEM",16,0)
    284  ;You should have received a copy of the GNU General Public License along
     300 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    285301"RTN","C0SDEM",17,0)
    286  ;with this program; if not, write to the Free Software Foundation, Inc.,
     302 ;
    287303"RTN","C0SDEM",18,0)
    288  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     304 Q
    289305"RTN","C0SDEM",19,0)
    290306 ;
    291307"RTN","C0SDEM",20,0)
    292  Q
     308 ;<?xml version="1.0" encoding="utf-8"?>
    293309"RTN","C0SDEM",21,0)
    294  ;
     310 ;<rdf:RDF
    295311"RTN","C0SDEM",22,0)
    296  ;<?xml version="1.0" encoding="utf-8"?>
     312 ;  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
    297313"RTN","C0SDEM",23,0)
     314 ;  xmlns:sp="http://smartplatforms.org/terms#"
     315"RTN","C0SDEM",24,0)
     316 ;  xmlns:dcterms="http://purl.org/dc/terms/"
     317"RTN","C0SDEM",25,0)
     318 ;  xmlns:v="http://www.w3.org/2006/vcard/ns#"
     319"RTN","C0SDEM",26,0)
     320 ;  xmlns:foaf="http://xmlns.com/foaf/0.1/">
     321"RTN","C0SDEM",27,0)
     322 ;   <sp:Demographics>
     323"RTN","C0SDEM",28,0)
     324 ;
     325"RTN","C0SDEM",29,0)
     326 ;     <v:n>
     327"RTN","C0SDEM",30,0)
     328 ;        <v:Name>
     329"RTN","C0SDEM",31,0)
     330 ;            <v:given-name>Bob</v:given-name>
     331"RTN","C0SDEM",32,0)
     332 ;            <v:additional-name>J</v:additional-name>
     333"RTN","C0SDEM",33,0)
     334 ;            <v:family-name>Odenkirk</v:family-name>
     335"RTN","C0SDEM",34,0)
     336 ;        </v:Name>
     337"RTN","C0SDEM",35,0)
     338 ;     </v:n>
     339"RTN","C0SDEM",36,0)
     340 ;
     341"RTN","C0SDEM",37,0)
     342 ;     <v:adr>
     343"RTN","C0SDEM",38,0)
     344 ;        <v:Address>
     345"RTN","C0SDEM",39,0)
     346 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
     347"RTN","C0SDEM",40,0)
     348 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
     349"RTN","C0SDEM",41,0)
     350 ;
     351"RTN","C0SDEM",42,0)
     352 ;          <v:street-address>15 Main St</v:street-address>
     353"RTN","C0SDEM",43,0)
     354 ;          <v:extended-address>Apt 2</v:extended-address>
     355"RTN","C0SDEM",44,0)
     356 ;          <v:locality>Wonderland</v:locality>
     357"RTN","C0SDEM",45,0)
     358 ;          <v:region>OZ</v:region>
     359"RTN","C0SDEM",46,0)
     360 ;          <v:postal-code>54321</v:postal-code>
     361"RTN","C0SDEM",47,0)
     362 ;          <v:country>USA</v:country>
     363"RTN","C0SDEM",48,0)
     364 ;        </v:Address>
     365"RTN","C0SDEM",49,0)
     366 ;     </v:adr>
     367"RTN","C0SDEM",50,0)
     368 ;
     369"RTN","C0SDEM",51,0)
     370 ;     <v:tel>
     371"RTN","C0SDEM",52,0)
     372 ;        <v:Tel>
     373"RTN","C0SDEM",53,0)
     374 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
     375"RTN","C0SDEM",54,0)
     376 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
     377"RTN","C0SDEM",55,0)
     378 ;          <rdf:value>800-555-1212</rdf:value>
     379"RTN","C0SDEM",56,0)
     380 ;        </v:Tel>
     381"RTN","C0SDEM",57,0)
     382 ;     </v:tel>
     383"RTN","C0SDEM",58,0)
     384 ;
     385"RTN","C0SDEM",59,0)
     386 ;     <v:tel>
     387"RTN","C0SDEM",60,0)
     388 ;        <v:Tel>
     389"RTN","C0SDEM",61,0)
     390 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" />
     391"RTN","C0SDEM",62,0)
     392 ;          <rdf:value>800-555-1515</rdf:value>
     393"RTN","C0SDEM",63,0)
     394 ;        </v:Tel>
     395"RTN","C0SDEM",64,0)
     396 ;     </v:tel>
     397"RTN","C0SDEM",65,0)
     398 ;
     399"RTN","C0SDEM",66,0)
     400 ;     <foaf:gender>male</foaf:gender>
     401"RTN","C0SDEM",67,0)
     402 ;     <v:bday>1959-12-25</v:bday>
     403"RTN","C0SDEM",68,0)
     404 ;     <v:email>bob.odenkirk@example.com</v:email>
     405"RTN","C0SDEM",69,0)
     406 ;
     407"RTN","C0SDEM",70,0)
     408 ;     <sp:medicalRecordNumber>
     409"RTN","C0SDEM",71,0)
     410 ;       <sp:Code>
     411"RTN","C0SDEM",72,0)
     412 ;        <dcterms:title>My Hospital Record 2304575</dcterms:title>
     413"RTN","C0SDEM",73,0)
     414 ;        <dcterms:identifier>2304575</dcterms:identifier>
     415"RTN","C0SDEM",74,0)
     416 ;        <sp:system>My Hospital Record</sp:system>
     417"RTN","C0SDEM",75,0)
     418 ;       </sp:Code>
     419"RTN","C0SDEM",76,0)
     420 ;     </sp:medicalRecordNumber>
     421"RTN","C0SDEM",77,0)
     422 ;
     423"RTN","C0SDEM",78,0)
     424 ;   </sp:Demographics>
     425"RTN","C0SDEM",79,0)
     426 ;</rdf:RDF><?xml version="1.0" encoding="utf-8"?>
     427"RTN","C0SDEM",80,0)
    298428 ;<rdf:RDF
    299 "RTN","C0SDEM",24,0)
     429"RTN","C0SDEM",81,0)
    300430 ;  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
    301 "RTN","C0SDEM",25,0)
     431"RTN","C0SDEM",82,0)
    302432 ;  xmlns:sp="http://smartplatforms.org/terms#"
    303 "RTN","C0SDEM",26,0)
     433"RTN","C0SDEM",83,0)
    304434 ;  xmlns:dcterms="http://purl.org/dc/terms/"
    305 "RTN","C0SDEM",27,0)
     435"RTN","C0SDEM",84,0)
    306436 ;  xmlns:v="http://www.w3.org/2006/vcard/ns#"
    307 "RTN","C0SDEM",28,0)
     437"RTN","C0SDEM",85,0)
    308438 ;  xmlns:foaf="http://xmlns.com/foaf/0.1/">
    309 "RTN","C0SDEM",29,0)
     439"RTN","C0SDEM",86,0)
    310440 ;   <sp:Demographics>
    311 "RTN","C0SDEM",30,0)
    312  ;
    313 "RTN","C0SDEM",31,0)
     441"RTN","C0SDEM",87,0)
     442 ;
     443"RTN","C0SDEM",88,0)
    314444 ;     <v:n>
    315 "RTN","C0SDEM",32,0)
     445"RTN","C0SDEM",89,0)
    316446 ;        <v:Name>
    317 "RTN","C0SDEM",33,0)
     447"RTN","C0SDEM",90,0)
    318448 ;            <v:given-name>Bob</v:given-name>
    319 "RTN","C0SDEM",34,0)
     449"RTN","C0SDEM",91,0)
    320450 ;            <v:additional-name>J</v:additional-name>
    321 "RTN","C0SDEM",35,0)
     451"RTN","C0SDEM",92,0)
    322452 ;            <v:family-name>Odenkirk</v:family-name>
    323 "RTN","C0SDEM",36,0)
     453"RTN","C0SDEM",93,0)
    324454 ;        </v:Name>
    325 "RTN","C0SDEM",37,0)
     455"RTN","C0SDEM",94,0)
    326456 ;     </v:n>
    327 "RTN","C0SDEM",38,0)
    328  ;
    329 "RTN","C0SDEM",39,0)
     457"RTN","C0SDEM",95,0)
     458 ;
     459"RTN","C0SDEM",96,0)
    330460 ;     <v:adr>
    331 "RTN","C0SDEM",40,0)
     461"RTN","C0SDEM",97,0)
    332462 ;        <v:Address>
    333 "RTN","C0SDEM",41,0)
     463"RTN","C0SDEM",98,0)
    334464 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
    335 "RTN","C0SDEM",42,0)
     465"RTN","C0SDEM",99,0)
    336466 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
    337 "RTN","C0SDEM",43,0)
    338  ;
    339 "RTN","C0SDEM",44,0)
     467"RTN","C0SDEM",100,0)
     468 ;
     469"RTN","C0SDEM",101,0)
    340470 ;          <v:street-address>15 Main St</v:street-address>
    341 "RTN","C0SDEM",45,0)
     471"RTN","C0SDEM",102,0)
    342472 ;          <v:extended-address>Apt 2</v:extended-address>
    343 "RTN","C0SDEM",46,0)
     473"RTN","C0SDEM",103,0)
    344474 ;          <v:locality>Wonderland</v:locality>
    345 "RTN","C0SDEM",47,0)
     475"RTN","C0SDEM",104,0)
    346476 ;          <v:region>OZ</v:region>
    347 "RTN","C0SDEM",48,0)
     477"RTN","C0SDEM",105,0)
    348478 ;          <v:postal-code>54321</v:postal-code>
    349 "RTN","C0SDEM",49,0)
     479"RTN","C0SDEM",106,0)
    350480 ;          <v:country>USA</v:country>
    351 "RTN","C0SDEM",50,0)
     481"RTN","C0SDEM",107,0)
    352482 ;        </v:Address>
    353 "RTN","C0SDEM",51,0)
     483"RTN","C0SDEM",108,0)
    354484 ;     </v:adr>
    355 "RTN","C0SDEM",52,0)
    356  ;
    357 "RTN","C0SDEM",53,0)
     485"RTN","C0SDEM",109,0)
     486 ;
     487"RTN","C0SDEM",110,0)
    358488 ;     <v:tel>
    359 "RTN","C0SDEM",54,0)
     489"RTN","C0SDEM",111,0)
    360490 ;        <v:Tel>
    361 "RTN","C0SDEM",55,0)
     491"RTN","C0SDEM",112,0)
    362492 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
    363 "RTN","C0SDEM",56,0)
     493"RTN","C0SDEM",113,0)
    364494 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
    365 "RTN","C0SDEM",57,0)
     495"RTN","C0SDEM",114,0)
    366496 ;          <rdf:value>800-555-1212</rdf:value>
    367 "RTN","C0SDEM",58,0)
     497"RTN","C0SDEM",115,0)
    368498 ;        </v:Tel>
    369 "RTN","C0SDEM",59,0)
     499"RTN","C0SDEM",116,0)
    370500 ;     </v:tel>
    371 "RTN","C0SDEM",60,0)
    372  ;
    373 "RTN","C0SDEM",61,0)
     501"RTN","C0SDEM",117,0)
     502 ;
     503"RTN","C0SDEM",118,0)
    374504 ;     <v:tel>
    375 "RTN","C0SDEM",62,0)
     505"RTN","C0SDEM",119,0)
    376506 ;        <v:Tel>
    377 "RTN","C0SDEM",63,0)
     507"RTN","C0SDEM",120,0)
    378508 ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" />
    379 "RTN","C0SDEM",64,0)
     509"RTN","C0SDEM",121,0)
    380510 ;          <rdf:value>800-555-1515</rdf:value>
    381 "RTN","C0SDEM",65,0)
     511"RTN","C0SDEM",122,0)
    382512 ;        </v:Tel>
    383 "RTN","C0SDEM",66,0)
     513"RTN","C0SDEM",123,0)
    384514 ;     </v:tel>
    385 "RTN","C0SDEM",67,0)
    386  ;
    387 "RTN","C0SDEM",68,0)
     515"RTN","C0SDEM",124,0)
     516 ;
     517"RTN","C0SDEM",125,0)
    388518 ;     <foaf:gender>male</foaf:gender>
    389 "RTN","C0SDEM",69,0)
     519"RTN","C0SDEM",126,0)
    390520 ;     <v:bday>1959-12-25</v:bday>
    391 "RTN","C0SDEM",70,0)
     521"RTN","C0SDEM",127,0)
    392522 ;     <v:email>bob.odenkirk@example.com</v:email>
    393 "RTN","C0SDEM",71,0)
    394  ;
    395 "RTN","C0SDEM",72,0)
     523"RTN","C0SDEM",128,0)
     524 ;
     525"RTN","C0SDEM",129,0)
    396526 ;     <sp:medicalRecordNumber>
    397 "RTN","C0SDEM",73,0)
     527"RTN","C0SDEM",130,0)
    398528 ;       <sp:Code>
    399 "RTN","C0SDEM",74,0)
     529"RTN","C0SDEM",131,0)
    400530 ;        <dcterms:title>My Hospital Record 2304575</dcterms:title>
    401 "RTN","C0SDEM",75,0)
     531"RTN","C0SDEM",132,0)
    402532 ;        <dcterms:identifier>2304575</dcterms:identifier>
    403 "RTN","C0SDEM",76,0)
     533"RTN","C0SDEM",133,0)
    404534 ;        <sp:system>My Hospital Record</sp:system>
    405 "RTN","C0SDEM",77,0)
     535"RTN","C0SDEM",134,0)
    406536 ;       </sp:Code>
    407 "RTN","C0SDEM",78,0)
     537"RTN","C0SDEM",135,0)
    408538 ;     </sp:medicalRecordNumber>
    409 "RTN","C0SDEM",79,0)
    410  ;
    411 "RTN","C0SDEM",80,0)
     539"RTN","C0SDEM",136,0)
     540 ;
     541"RTN","C0SDEM",137,0)
    412542 ;   </sp:Demographics>
    413 "RTN","C0SDEM",81,0)
    414  ;</rdf:RDF><?xml version="1.0" encoding="utf-8"?>
    415 "RTN","C0SDEM",82,0)
    416  ;<rdf:RDF
    417 "RTN","C0SDEM",83,0)
    418  ;  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
    419 "RTN","C0SDEM",84,0)
    420  ;  xmlns:sp="http://smartplatforms.org/terms#"
    421 "RTN","C0SDEM",85,0)
    422  ;  xmlns:dcterms="http://purl.org/dc/terms/"
    423 "RTN","C0SDEM",86,0)
    424  ;  xmlns:v="http://www.w3.org/2006/vcard/ns#"
    425 "RTN","C0SDEM",87,0)
    426  ;  xmlns:foaf="http://xmlns.com/foaf/0.1/">
    427 "RTN","C0SDEM",88,0)
    428  ;   <sp:Demographics>
    429 "RTN","C0SDEM",89,0)
    430  ;
    431 "RTN","C0SDEM",90,0)
    432  ;     <v:n>
    433 "RTN","C0SDEM",91,0)
    434  ;        <v:Name>
    435 "RTN","C0SDEM",92,0)
    436  ;            <v:given-name>Bob</v:given-name>
    437 "RTN","C0SDEM",93,0)
    438  ;            <v:additional-name>J</v:additional-name>
    439 "RTN","C0SDEM",94,0)
    440  ;            <v:family-name>Odenkirk</v:family-name>
    441 "RTN","C0SDEM",95,0)
    442  ;        </v:Name>
    443 "RTN","C0SDEM",96,0)
    444  ;     </v:n>
    445 "RTN","C0SDEM",97,0)
    446  ;
    447 "RTN","C0SDEM",98,0)
    448  ;     <v:adr>
    449 "RTN","C0SDEM",99,0)
    450  ;        <v:Address>
    451 "RTN","C0SDEM",100,0)
    452  ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
    453 "RTN","C0SDEM",101,0)
    454  ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
    455 "RTN","C0SDEM",102,0)
    456  ;
    457 "RTN","C0SDEM",103,0)
    458  ;          <v:street-address>15 Main St</v:street-address>
    459 "RTN","C0SDEM",104,0)
    460  ;          <v:extended-address>Apt 2</v:extended-address>
    461 "RTN","C0SDEM",105,0)
    462  ;          <v:locality>Wonderland</v:locality>
    463 "RTN","C0SDEM",106,0)
    464  ;          <v:region>OZ</v:region>
    465 "RTN","C0SDEM",107,0)
    466  ;          <v:postal-code>54321</v:postal-code>
    467 "RTN","C0SDEM",108,0)
    468  ;          <v:country>USA</v:country>
    469 "RTN","C0SDEM",109,0)
    470  ;        </v:Address>
    471 "RTN","C0SDEM",110,0)
    472  ;     </v:adr>
    473 "RTN","C0SDEM",111,0)
    474  ;
    475 "RTN","C0SDEM",112,0)
    476  ;     <v:tel>
    477 "RTN","C0SDEM",113,0)
    478  ;        <v:Tel>
    479 "RTN","C0SDEM",114,0)
    480  ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Home" />
    481 "RTN","C0SDEM",115,0)
    482  ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Pref" />
    483 "RTN","C0SDEM",116,0)
    484  ;          <rdf:value>800-555-1212</rdf:value>
    485 "RTN","C0SDEM",117,0)
    486  ;        </v:Tel>
    487 "RTN","C0SDEM",118,0)
    488  ;     </v:tel>
    489 "RTN","C0SDEM",119,0)
    490  ;
    491 "RTN","C0SDEM",120,0)
    492  ;     <v:tel>
    493 "RTN","C0SDEM",121,0)
    494  ;        <v:Tel>
    495 "RTN","C0SDEM",122,0)
    496  ;          <rdf:type rdf:resource="http://www.w3.org/2006/vcard/ns#Cell" />
    497 "RTN","C0SDEM",123,0)
    498  ;          <rdf:value>800-555-1515</rdf:value>
    499 "RTN","C0SDEM",124,0)
    500  ;        </v:Tel>
    501 "RTN","C0SDEM",125,0)
    502  ;     </v:tel>
    503 "RTN","C0SDEM",126,0)
    504  ;
    505 "RTN","C0SDEM",127,0)
    506  ;     <foaf:gender>male</foaf:gender>
    507 "RTN","C0SDEM",128,0)
    508  ;     <v:bday>1959-12-25</v:bday>
    509 "RTN","C0SDEM",129,0)
    510  ;     <v:email>bob.odenkirk@example.com</v:email>
    511 "RTN","C0SDEM",130,0)
    512  ;
    513 "RTN","C0SDEM",131,0)
    514  ;     <sp:medicalRecordNumber>
    515 "RTN","C0SDEM",132,0)
    516  ;       <sp:Code>
    517 "RTN","C0SDEM",133,0)
    518  ;        <dcterms:title>My Hospital Record 2304575</dcterms:title>
    519 "RTN","C0SDEM",134,0)
    520  ;        <dcterms:identifier>2304575</dcterms:identifier>
    521 "RTN","C0SDEM",135,0)
    522  ;        <sp:system>My Hospital Record</sp:system>
    523 "RTN","C0SDEM",136,0)
    524  ;       </sp:Code>
    525 "RTN","C0SDEM",137,0)
    526  ;     </sp:medicalRecordNumber>
    527543"RTN","C0SDEM",138,0)
    528  ;
     544 ;</rdf:RDF>
    529545"RTN","C0SDEM",139,0)
    530  ;   </sp:Demographics>
     546 ;G(1)="nodeID:25591^rdf:type^v:Home"
    531547"RTN","C0SDEM",140,0)
    532  ;</rdf:RDF>
     548 ;G(2)="nodeID:25591^rdf:type^v:Pref"
    533549"RTN","C0SDEM",141,0)
    534  ;G(1)="nodeID:25591^rdf:type^v:Home"
     550 ;G(3)="nodeID:25591^rdf:type^v:Tel"
    535551"RTN","C0SDEM",142,0)
    536  ;G(2)="nodeID:25591^rdf:type^v:Pref"
     552 ;G(4)="nodeID:25591^rdf:value^800-369-6403"
    537553"RTN","C0SDEM",143,0)
    538  ;G(3)="nodeID:25591^rdf:type^v:Tel"
     554 ;G(5)="nodeID:25611^rdf:type^v:Name"
    539555"RTN","C0SDEM",144,0)
    540  ;G(4)="nodeID:25591^rdf:value^800-369-6403"
     556 ;G(6)="nodeID:25611^v:additional-name^N"
    541557"RTN","C0SDEM",145,0)
    542  ;G(5)="nodeID:25611^rdf:type^v:Name"
     558 ;G(7)="nodeID:25611^v:family-name^Brooks"
    543559"RTN","C0SDEM",146,0)
    544  ;G(6)="nodeID:25611^v:additional-name^N"
     560 ;G(8)="nodeID:25611^v:given-name^Brian"
    545561"RTN","C0SDEM",147,0)
    546  ;G(7)="nodeID:25611^v:family-name^Brooks"
     562 ;G(9)="nodeID:25622^dcterms:identifier^981968"
    547563"RTN","C0SDEM",148,0)
    548  ;G(8)="nodeID:25611^v:given-name^Brian"
     564 ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968"
    549565"RTN","C0SDEM",149,0)
    550  ;G(9)="nodeID:25622^dcterms:identifier^981968"
     566 ;G(11)="nodeID:25622^rdf:type^sp:Code"
    551567"RTN","C0SDEM",150,0)
    552  ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968"
     568 ;G(12)="nodeID:25622^sp:system^My Hospital Record"
    553569"RTN","C0SDEM",151,0)
    554  ;G(11)="nodeID:25622^rdf:type^sp:Code"
     570 ;G(13)="nodeID:25623^rdf:type^v:Address"
    555571"RTN","C0SDEM",152,0)
    556  ;G(12)="nodeID:25622^sp:system^My Hospital Record"
     572 ;G(14)="nodeID:25623^rdf:type^v:Home"
    557573"RTN","C0SDEM",153,0)
    558  ;G(13)="nodeID:25623^rdf:type^v:Address"
     574 ;G(15)="nodeID:25623^rdf:type^v:Pref"
    559575"RTN","C0SDEM",154,0)
    560  ;G(14)="nodeID:25623^rdf:type^v:Home"
     576 ;G(16)="nodeID:25623^v:locality^Bixby"
    561577"RTN","C0SDEM",155,0)
    562  ;G(15)="nodeID:25623^rdf:type^v:Pref"
     578 ;G(17)="nodeID:25623^v:postal-code^74008"
    563579"RTN","C0SDEM",156,0)
    564  ;G(16)="nodeID:25623^v:locality^Bixby"
     580 ;G(18)="nodeID:25623^v:region^OK"
    565581"RTN","C0SDEM",157,0)
    566  ;G(17)="nodeID:25623^v:postal-code^74008"
     582 ;G(19)="nodeID:25623^v:street-address^82 Lake St"
    567583"RTN","C0SDEM",158,0)
    568  ;G(18)="nodeID:25623^v:region^OK"
     584 ;G(20)="smart:981968/demographics^foaf:gender^male"
    569585"RTN","C0SDEM",159,0)
    570  ;G(19)="nodeID:25623^v:street-address^82 Lake St"
     586 ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics"
    571587"RTN","C0SDEM",160,0)
    572  ;G(20)="smart:981968/demographics^foaf:gender^male"
     588 ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968"
    573589"RTN","C0SDEM",161,0)
    574  ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics"
     590 ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622"
    575591"RTN","C0SDEM",162,0)
    576  ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968"
     592 ;G(24)="smart:981968/demographics^v:adr^nodeID:25623"
    577593"RTN","C0SDEM",163,0)
    578  ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622"
     594 ;G(25)="smart:981968/demographics^v:bday^1956-03-23"
    579595"RTN","C0SDEM",164,0)
    580  ;G(24)="smart:981968/demographics^v:adr^nodeID:25623"
     596 ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com"
    581597"RTN","C0SDEM",165,0)
    582  ;G(25)="smart:981968/demographics^v:bday^1956-03-23"
     598 ;G(27)="smart:981968/demographics^v:n^nodeID:25611"
    583599"RTN","C0SDEM",166,0)
    584  ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com"
     600 ;G(28)="smart:981968/demographics^v:tel^nodeID:25591"
    585601"RTN","C0SDEM",167,0)
    586  ;G(27)="smart:981968/demographics^v:n^nodeID:25611"
     602 Q
    587603"RTN","C0SDEM",168,0)
    588  ;G(28)="smart:981968/demographics^v:tel^nodeID:25591"
     604 ;
    589605"RTN","C0SDEM",169,0)
    590  Q
     606PATIENT(GRTN,C0SARY) ; GRTN, passed by reference,
    591607"RTN","C0SDEM",170,0)
    592  ;
     608 ; is the return name of the graph created. "" if none
    593609"RTN","C0SDEM",171,0)
    594 PATIENT(GRTN,C0SARY) ; GRTN, passed by reference,
     610 ; C0SARY is passed in by reference and is the NHIN array of patient
    595611"RTN","C0SDEM",172,0)
    596  ; is the return name of the graph created. "" if none
     612 ;
    597613"RTN","C0SDEM",173,0)
    598  ; C0SARY is passed in by reference and is the NHIN array of patient
     614 I $O(C0SARY("patient",""))="" D  Q  ;
    599615"RTN","C0SDEM",174,0)
    600  ;
     616 . I $D(DEBUG) W !,"No Patient array"
    601617"RTN","C0SDEM",175,0)
    602  I $O(C0SARY("patient",""))="" D  Q  ;
     618 . S GRTN=""
    603619"RTN","C0SDEM",176,0)
    604  . I $D(DEBUG) W !,"No Patient array"
     620 S GRTN="" ; default to no patient
    605621"RTN","C0SDEM",177,0)
    606  . S GRTN=""
     622 N C0SGRF
    607623"RTN","C0SDEM",178,0)
    608  S GRTN="" ; default to no patient
     624 S C0SGRF="vistaSmart:"_ZPATID_"/patient"
    609625"RTN","C0SDEM",179,0)
    610  N C0SGRF
     626 S ZPAT=C0SGRF ; subject is the same as the graph name
    611627"RTN","C0SDEM",180,0)
    612  S C0SGRF="vistaSmart:"_ZPATID_"/patient"
     628 I $D(DEBUG) W !,"Processing ",C0SGRF
    613629"RTN","C0SDEM",181,0)
    614  S ZPAT=C0SGRF ; subject is the same as the graph name
     630 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
    615631"RTN","C0SDEM",182,0)
    616  I $D(DEBUG) W !,"Processing ",C0SGRF
     632 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
    617633"RTN","C0SDEM",183,0)
    618  D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
     634 N FARY S FARY="C0XFARY"
    619635"RTN","C0SDEM",184,0)
    620  D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
     636 D USEFARY^C0XF2N(FARY)
    621637"RTN","C0SDEM",185,0)
    622  N FARY S FARY="C0XFARY"
     638 D VOCINIT^C0XUTIL
    623639"RTN","C0SDEM",186,0)
    624  D USEFARY^C0XF2N(FARY)
     640 ;
    625641"RTN","C0SDEM",187,0)
    626  D VOCINIT^C0XUTIL
     642 N ZPN,ZR
    627643"RTN","C0SDEM",188,0)
    628  ;
     644 D STARTADD^C0XF2N
    629645"RTN","C0SDEM",189,0)
    630  N ZPN,ZR
     646 ;
    631647"RTN","C0SDEM",190,0)
    632  D STARTADD^C0XF2N
     648 ; First do the base demographic graph
    633649"RTN","C0SDEM",191,0)
    634650 ;
    635651"RTN","C0SDEM",192,0)
    636  ; First do the base demographic graph
     652 S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient
    637653"RTN","C0SDEM",193,0)
    638  ;
     654 N SEX S SEX=$G(@ZPN@("gender@value"))
    639655"RTN","C0SDEM",194,0)
    640  S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient
     656 I SEX="M" S SEX="male"
    641657"RTN","C0SDEM",195,0)
    642  N SEX S SEX=$G(@ZPN@("gender@value"))
     658 I SEX="F" S SEX="female"
    643659"RTN","C0SDEM",196,0)
    644  I SEX="M" S SEX="male"
     660 S ZR("foaf:gender")=SEX
    645661"RTN","C0SDEM",197,0)
    646  I SEX="F" S SEX="female"
     662 S ZR("rdf:type")="sp:Demographics"
    647663"RTN","C0SDEM",198,0)
    648  S ZR("foaf:gender")=SEX
     664 S ZR("sp:belongsTo")=ZPAT
    649665"RTN","C0SDEM",199,0)
    650  S ZR("rdf:type")="sp:Demographics"
     666 N PATIENT
    651667"RTN","C0SDEM",200,0)
    652  S ZR("sp:belongsTo")=ZPAT
     668 S PATIENT=$P(ZPAT,"#",2)
    653669"RTN","C0SDEM",201,0)
    654  N PATIENT
     670 I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT
    655671"RTN","C0SDEM",202,0)
    656  S PATIENT=$P(ZPAT,"#",2)
     672 N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph
    657673"RTN","C0SDEM",203,0)
    658  I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT
     674 S ZR("sp:medicalRecordNumber")=NMREC
    659675"RTN","C0SDEM",204,0)
    660  N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph
     676 N NVADR S NVADR=$$ANONS^C0XF2N ; for address
    661677"RTN","C0SDEM",205,0)
    662  S ZR("sp:medicalRecordNumber")=NMREC
     678 S ZR("v:adr")=NVADR
    663679"RTN","C0SDEM",206,0)
    664  N NVADR S NVADR=$$ANONS^C0XF2N ; for address
     680 N NNAME S NNAME=$$ANONS^C0XF2N ; for name
    665681"RTN","C0SDEM",207,0)
    666  S ZR("v:adr")=NVADR
     682 S ZR("v:n")=NNAME
    667683"RTN","C0SDEM",208,0)
    668  N NNAME S NNAME=$$ANONS^C0XF2N ; for name
     684 N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone
    669685"RTN","C0SDEM",209,0)
    670  S ZR("v:n")=NNAME
     686 I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists
    671687"RTN","C0SDEM",210,0)
    672  N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone
     688 N BDATE
    673689"RTN","C0SDEM",211,0)
    674  I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists
     690 S ZX=""
    675691"RTN","C0SDEM",212,0)
    676  N BDATE
     692 S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format
    677693"RTN","C0SDEM",213,0)
    678  S ZX=""
     694 S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date
    679695"RTN","C0SDEM",214,0)
    680  S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format
     696 S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens
    681697"RTN","C0SDEM",215,0)
    682  S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date
     698 I BDATE="" S BDATE="UNKNOWN"
    683699"RTN","C0SDEM",216,0)
    684  S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens
     700 N Z2,Z3
    685701"RTN","C0SDEM",217,0)
    686  I BDATE="" S BDATE="UNKNOWN"
     702 S Z2=$P(BDATE,"-",2)
    687703"RTN","C0SDEM",218,0)
    688  N Z2,Z3
     704 S Z3=$P(BDATE,"-",3)
    689705"RTN","C0SDEM",219,0)
    690  S Z2=$P(BDATE,"-",2)
     706 I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2
    691707"RTN","C0SDEM",220,0)
    692  S Z3=$P(BDATE,"-",3)
     708 I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3
    693709"RTN","C0SDEM",221,0)
    694  I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2
     710 S ZR("v:bday")=BDATE
    695711"RTN","C0SDEM",222,0)
    696  I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3
     712 I $D(C0SVISTA) D  ;
    697713"RTN","C0SDEM",223,0)
    698  S ZR("v:bday")=BDATE
     714 . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN
    699715"RTN","C0SDEM",224,0)
    700  I $D(C0SVISTA) D  ;
     716 . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN
    701717"RTN","C0SDEM",225,0)
    702  . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN
     718 D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph
    703719"RTN","C0SDEM",226,0)
    704  . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN
     720 K ZR
    705721"RTN","C0SDEM",227,0)
    706  D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph
     722 ;
    707723"RTN","C0SDEM",228,0)
     724 ; create address sub-graph
     725"RTN","C0SDEM",229,0)
     726 ;
     727"RTN","C0SDEM",230,0)
     728 S ZR("rdf:type")="v:Address"
     729"RTN","C0SDEM",231,0)
     730 S ZR("rdf:type")="v:Home"
     731"RTN","C0SDEM",232,0)
     732 S ZR("v:locality")=$G(@ZPN@("address@city"))
     733"RTN","C0SDEM",233,0)
     734 S ZR("v:postal-code")=$G(@ZPN@("address@postalCode"))
     735"RTN","C0SDEM",234,0)
     736 S ZR("v:region")=$G(@ZPN@("address@stateProvince"))
     737"RTN","C0SDEM",235,0)
     738 S ZR("v:street-address")=$G(@ZPN@("address@streetLine1"))
     739"RTN","C0SDEM",236,0)
     740 D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address
     741"RTN","C0SDEM",237,0)
    708742 K ZR
    709 "RTN","C0SDEM",229,0)
    710  ;
    711 "RTN","C0SDEM",230,0)
    712  ; create address sub-graph
    713 "RTN","C0SDEM",231,0)
    714  ;
    715 "RTN","C0SDEM",232,0)
    716  S ZR("rdf:type")="v:Address"
    717 "RTN","C0SDEM",233,0)
    718  S ZR("rdf:type")="v:Home"
    719 "RTN","C0SDEM",234,0)
    720  S ZR("v:locality")=$G(@ZPN@("address@city"))
    721 "RTN","C0SDEM",235,0)
    722  S ZR("v:postal-code")=$G(@ZPN@("address@postalCode"))
    723 "RTN","C0SDEM",236,0)
    724  S ZR("v:region")=$G(@ZPN@("address@stateProvince"))
    725 "RTN","C0SDEM",237,0)
    726  S ZR("v:street-address")=$G(@ZPN@("address@streetLine1"))
    727743"RTN","C0SDEM",238,0)
    728  D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address
     744 ;
    729745"RTN","C0SDEM",239,0)
     746 ; create medical record subgraph
     747"RTN","C0SDEM",240,0)
     748 ;
     749"RTN","C0SDEM",241,0)
     750 S ZR("dcterms:identifier")=$G(@ZPN@("id@value"))
     751"RTN","C0SDEM",242,0)
     752 S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier")
     753"RTN","C0SDEM",243,0)
     754 S ZR("rdf:type")="sp:Code"
     755"RTN","C0SDEM",244,0)
     756 S ZR("sp:system")="VistA Patient Record"
     757"RTN","C0SDEM",245,0)
     758 D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph
     759"RTN","C0SDEM",246,0)
    730760 K ZR
    731 "RTN","C0SDEM",240,0)
    732  ;
    733 "RTN","C0SDEM",241,0)
    734  ; create medical record subgraph
    735 "RTN","C0SDEM",242,0)
    736  ;
    737 "RTN","C0SDEM",243,0)
    738  S ZR("dcterms:identifier")=$G(@ZPN@("id@value"))
    739 "RTN","C0SDEM",244,0)
    740  S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier")
    741 "RTN","C0SDEM",245,0)
    742  S ZR("rdf:type")="sp:Code"
    743 "RTN","C0SDEM",246,0)
    744  S ZR("sp:system")="VistA Patient Record"
    745761"RTN","C0SDEM",247,0)
    746  D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph
     762 ;
    747763"RTN","C0SDEM",248,0)
     764 ; create name subgraph
     765"RTN","C0SDEM",249,0)
     766 ;
     767"RTN","C0SDEM",250,0)
     768 N ZNF,ZNL,ZNM,ZNAM
     769"RTN","C0SDEM",251,0)
     770 S ZR("rdf:type")="v:Name"
     771"RTN","C0SDEM",252,0)
     772 S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names
     773"RTN","C0SDEM",253,0)
     774 S ZNF=$P(ZX," ",1) ; first name is first piece
     775"RTN","C0SDEM",254,0)
     776 S ZNM=$P(ZX," ",2) ; middle names are the rest
     777"RTN","C0SDEM",255,0)
     778 S ZR("v:additional-name")=ZNM
     779"RTN","C0SDEM",256,0)
     780 S ZR("v:family-name")=$G(@ZPN@("familyName@value"))
     781"RTN","C0SDEM",257,0)
     782 S ZR("v:given-name")=ZNF
     783"RTN","C0SDEM",258,0)
     784 D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph
     785"RTN","C0SDEM",259,0)
    748786 K ZR
    749 "RTN","C0SDEM",249,0)
    750  ;
    751 "RTN","C0SDEM",250,0)
    752  ; create name subgraph
    753 "RTN","C0SDEM",251,0)
    754  ;
    755 "RTN","C0SDEM",252,0)
    756  N ZNF,ZNL,ZNM,ZNAM
    757 "RTN","C0SDEM",253,0)
    758  S ZR("rdf:type")="v:Name"
    759 "RTN","C0SDEM",254,0)
    760  S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names
    761 "RTN","C0SDEM",255,0)
    762  S ZNF=$P(ZX," ",1) ; first name is first piece
    763 "RTN","C0SDEM",256,0)
    764  S ZNM=$P(ZX," ",2) ; middle names are the rest
    765 "RTN","C0SDEM",257,0)
    766  S ZR("v:additional-name")=ZNM
    767 "RTN","C0SDEM",258,0)
    768  S ZR("v:family-name")=$G(@ZPN@("familyName@value"))
    769 "RTN","C0SDEM",259,0)
    770  S ZR("v:given-name")=ZNF
    771787"RTN","C0SDEM",260,0)
    772  D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph
     788 ;
    773789"RTN","C0SDEM",261,0)
     790 ; create telephone subgraph
     791"RTN","C0SDEM",262,0)
     792 ;
     793"RTN","C0SDEM",263,0)
     794 D  ;
     795"RTN","C0SDEM",264,0)
     796 . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value"))
     797"RTN","C0SDEM",265,0)
     798 . I ZR("rdf:value")="" Q  ; telephone number missing, no subgraph
     799"RTN","C0SDEM",266,0)
     800 . S ZR("rdf:type")="v:Tel"
     801"RTN","C0SDEM",267,0)
     802 . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR)
     803"RTN","C0SDEM",268,0)
    774804 K ZR
    775 "RTN","C0SDEM",262,0)
    776  ;
    777 "RTN","C0SDEM",263,0)
    778  ; create telephone subgraph
    779 "RTN","C0SDEM",264,0)
    780  ;
    781 "RTN","C0SDEM",265,0)
    782  D  ;
    783 "RTN","C0SDEM",266,0)
    784  . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value"))
    785 "RTN","C0SDEM",267,0)
    786  . I ZR("rdf:value")="" Q  ; telephone number missing, no subgraph
    787 "RTN","C0SDEM",268,0)
    788  . S ZR("rdf:type")="v:Tel"
    789805"RTN","C0SDEM",269,0)
    790  . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR)
     806 ;
    791807"RTN","C0SDEM",270,0)
    792  K ZR
     808 ; load the demographics graph and all sub graphs to the triple store
    793809"RTN","C0SDEM",271,0)
    794810 ;
    795811"RTN","C0SDEM",272,0)
    796  ; load the demographics graph and all sub graphs to the triple store
     812 D BULKLOAD^C0XF2N(.C0XFDA)
    797813"RTN","C0SDEM",273,0)
    798  ;
     814 S GRTN=C0SGRF
    799815"RTN","C0SDEM",274,0)
    800  D BULKLOAD^C0XF2N(.C0XFDA)
     816 Q
    801817"RTN","C0SDEM",275,0)
    802  S GRTN=C0SGRF
     818 ;
    803819"RTN","C0SDEM",276,0)
    804  Q
     820AGES ; LIST ALL PATIENTS AND THEIR AGES
    805821"RTN","C0SDEM",277,0)
    806  ;
     822 N ZI S ZI=0
    807823"RTN","C0SDEM",278,0)
    808 AGES ; LIST ALL PATIENTS AND THEIR AGES
     824 F  S ZI=$O(^DPT(ZI)) Q:+ZI=0  D  ; FOR EVERY PATIENT
    809825"RTN","C0SDEM",279,0)
    810  N ZI S ZI=0
     826 . N ZDOB
    811827"RTN","C0SDEM",280,0)
    812  F  S ZI=$O(^DPT(ZI)) Q:+ZI=0  D  ; FOR EVERY PATIENT
     828 . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB
    813829"RTN","C0SDEM",281,0)
    814  . N ZDOB
     830 . N ZNAME
    815831"RTN","C0SDEM",282,0)
    816  . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB
     832 . S ZNAME=$P(^DPT(ZI,0),U)
    817833"RTN","C0SDEM",283,0)
    818  . N ZNAME
     834 . N ZSEX
    819835"RTN","C0SDEM",284,0)
    820  . S ZNAME=$P(^DPT(ZI,0),U)
     836 . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX")
    821837"RTN","C0SDEM",285,0)
    822  . N ZSEX
     838 . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX
    823839"RTN","C0SDEM",286,0)
    824  . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX")
     840 Q
    825841"RTN","C0SDEM",287,0)
    826  . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX
    827 "RTN","C0SDEM",288,0)
    828  Q
    829 "RTN","C0SDEM",289,0)
    830842 ;
    831843"RTN","C0SDOM")
    832 0^2^B87367162
     8440^2^B86029417
    833845"RTN","C0SDOM",1,0)
    834846C0SDOM   ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11  17:05
    835847"RTN","C0SDOM",2,0)
    836  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     848 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    837849"RTN","C0SDOM",3,0)
    838  ;Copyright 2011,2012 George Lilly.  Licensed under the terms of the GNU
     850 ;Copyright 2011,2012 George Lilly. 
    839851"RTN","C0SDOM",4,0)
    840  ;General Public License See attached copy of the License.
     852 ;
    841853"RTN","C0SDOM",5,0)
    842  ;
     854 ; This program is free software: you can redistribute it and/or modify
    843855"RTN","C0SDOM",6,0)
    844  ;This program is free software; you can redistribute it and/or modify
     856 ; it under the terms of the GNU Affero General Public License as
    845857"RTN","C0SDOM",7,0)
    846  ;it under the terms of the GNU General Public License as published by
     858 ; published by the Free Software Foundation, either version 3 of the
    847859"RTN","C0SDOM",8,0)
    848  ;the Free Software Foundation; either version 2 of the License, or
     860 ; License, or (at your option) any later version.
    849861"RTN","C0SDOM",9,0)
    850  ;(at your option) any later version.
     862 ;
    851863"RTN","C0SDOM",10,0)
    852  ;
     864 ; This program is distributed in the hope that it will be useful,
    853865"RTN","C0SDOM",11,0)
    854  
     866 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    855867"RTN","C0SDOM",12,0)
    856  ;This program is distributed in the hope that it will be useful,
     868 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    857869"RTN","C0SDOM",13,0)
    858  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     870 ; GNU Affero General Public License for more details.
    859871"RTN","C0SDOM",14,0)
    860  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     872 ;
    861873"RTN","C0SDOM",15,0)
    862  ;GNU General Public License for more details.
     874 ; You should have received a copy of the GNU Affero General Public License
    863875"RTN","C0SDOM",16,0)
    864  ;
     876 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    865877"RTN","C0SDOM",17,0)
    866  ;You should have received a copy of the GNU General Public License along
     878 ;
    867879"RTN","C0SDOM",18,0)
    868  ;with this program; if not, write to the Free Software Foundation, Inc.,
     880 Q
    869881"RTN","C0SDOM",19,0)
    870  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     882 ;
    871883"RTN","C0SDOM",20,0)
    872  ;
     884DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
    873885"RTN","C0SDOM",21,0)
    874  Q
     886 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    875887"RTN","C0SDOM",22,0)
    876  ;
     888 ; THE XPATH ARRAY XPARY, PASSED BY NAME
    877889"RTN","C0SDOM",23,0)
    878 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
     890 ; ZOID IS THE STARTING OID
    879891"RTN","C0SDOM",24,0)
    880  ; THE XPATH INDEX ZXIDX, PASSED BY NAME
     892 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
    881893"RTN","C0SDOM",25,0)
    882  ; THE XPATH ARRAY XPARY, PASSED BY NAME
     894 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
    883895"RTN","C0SDOM",26,0)
    884  ; ZOID IS THE STARTING OID
     896 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
    885897"RTN","C0SDOM",27,0)
    886  ; ZPATH IS THE STARTING XPATH, USUALLY "/"
     898 I $G(ZREDUX)="" S ZREDUX=""
    887899"RTN","C0SDOM",28,0)
    888  ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
     900 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
    889901"RTN","C0SDOM",29,0)
    890  ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
     902 N NEWNUM S NEWNUM=""
    891903"RTN","C0SDOM",30,0)
    892  I $G(ZREDUX)="" S ZREDUX=""
     904 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
    893905"RTN","C0SDOM",31,0)
    894  N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
     906 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
    895907"RTN","C0SDOM",32,0)
    896  N NEWNUM S NEWNUM=""
     908 I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
    897909"RTN","C0SDOM",33,0)
    898  I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
     910 . N GT S GT=$P(NEWPATH,ZREDUX,2)
    899911"RTN","C0SDOM",34,0)
    900  S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
     912 . I GT'="" S NEWPATH=GT
    901913"RTN","C0SDOM",35,0)
    902  I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
     914 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
    903915"RTN","C0SDOM",36,0)
    904  . N GT S GT=$P(NEWPATH,ZREDUX,2)
     916 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
    905917"RTN","C0SDOM",37,0)
    906  . I GT'="" S NEWPATH=GT
     918 I $D(GA) D  ; PROCESS THE ATTRIBUTES
    907919"RTN","C0SDOM",38,0)
    908  S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
     920 . N ZI S ZI=""
    909921"RTN","C0SDOM",39,0)
    910  N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
     922 . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
    911923"RTN","C0SDOM",40,0)
    912  I $D(GA) D  ; PROCESS THE ATTRIBUTES
     924 . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
    913925"RTN","C0SDOM",41,0)
    914  . N ZI S ZI=""
     926 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
    915927"RTN","C0SDOM",42,0)
    916  . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
     928 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
    917929"RTN","C0SDOM",43,0)
    918  . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
     930 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
    919931"RTN","C0SDOM",44,0)
    920  . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
     932 I $D(GD(2)) D  ;
    921933"RTN","C0SDOM",45,0)
    922  . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
     934 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
    923935"RTN","C0SDOM",46,0)
    924  N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
     936 E  I $D(GD(1)) D  ;
    925937"RTN","C0SDOM",47,0)
    926  I $D(GD(2)) D  ;
     938 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
    927939"RTN","C0SDOM",48,0)
    928  . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
     940 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
    929941"RTN","C0SDOM",49,0)
    930  E  I $D(GD(1)) D  ;
     942 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
    931943"RTN","C0SDOM",50,0)
    932  . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
     944 I ZFRST'=0 D  ; THERE IS A CHILD
    933945"RTN","C0SDOM",51,0)
    934  . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
     946 . N ZNUM
    935947"RTN","C0SDOM",52,0)
    936  N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
     948 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
    937949"RTN","C0SDOM",53,0)
    938  I ZFRST'=0 D  ; THERE IS A CHILD
     950 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
    939951"RTN","C0SDOM",54,0)
    940  . N ZNUM
     952 N GNXT S GNXT=$$NXTSIB(ZOID)
    941953"RTN","C0SDOM",55,0)
    942  . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
     954 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
    943955"RTN","C0SDOM",56,0)
    944  . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
     956 I GNXT'=0 D  ;
    945957"RTN","C0SDOM",57,0)
    946  N GNXT S GNXT=$$NXTSIB(ZOID)
     958 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
    947959"RTN","C0SDOM",58,0)
    948  I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
     960 . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
    949961"RTN","C0SDOM",59,0)
    950  I GNXT'=0 D ;
     962 . . N ZNUM S ZNUM=1 ;
    951963"RTN","C0SDOM",60,0)
    952  . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
     964 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
    953965"RTN","C0SDOM",61,0)
    954  . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
     966 . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
    955967"RTN","C0SDOM",62,0)
    956  . . N ZNUM S ZNUM=1 ;
     968 Q
    957969"RTN","C0SDOM",63,0)
    958  . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
     970 ;
    959971"RTN","C0SDOM",64,0)
    960  . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
     972ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
    961973"RTN","C0SDOM",65,0)
    962  Q
     974 ;
    963975"RTN","C0SDOM",66,0)
    964  ;
     976 ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
    965977"RTN","C0SDOM",67,0)
    966 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
     978 ;
    967979"RTN","C0SDOM",68,0)
    968  ;
     980 N ZZI,ZZJ,ZZN
    969981"RTN","C0SDOM",69,0)
    970  ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
     982 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
    971983"RTN","C0SDOM",70,0)
    972  ;
     984 I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
    973985"RTN","C0SDOM",71,0)
    974  N ZZI,ZZJ,ZZN
     986 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
    975987"RTN","C0SDOM",72,0)
    976  S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
     988 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
    977989"RTN","C0SDOM",73,0)
    978  I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
     990 I ZZI'["]" D  ; A SINGLETON
    979991"RTN","C0SDOM",74,0)
    980  S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
     992 . S ZZN=1
    981993"RTN","C0SDOM",75,0)
    982  S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
     994 E  D  ; THERE IS AN [x] OCCURANCE
    983995"RTN","C0SDOM",76,0)
    984  I ZZI'["]" D  ; A SINGLETON
     996 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
    985997"RTN","C0SDOM",77,0)
    986  . S ZZN=1
     998 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
    987999"RTN","C0SDOM",78,0)
    988  E  D  ; THERE IS AN [x] OCCURANCE
     1000 I ZZJ'="" D  ; TIME TO ADD THE VALUE
    9891001"RTN","C0SDOM",79,0)
    990  . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
     1002 . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
    9911003"RTN","C0SDOM",80,0)
    992  . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
     1004 Q
    9931005"RTN","C0SDOM",81,0)
    994  I ZZJ'="" D  ; TIME TO ADD THE VALUE
     1006 ;
    9951007"RTN","C0SDOM",82,0)
    996  . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
     1008PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    9971009"RTN","C0SDOM",83,0)
    998  Q
     1010 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    9991011"RTN","C0SDOM",84,0)
    1000  ;
     1012 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    10011013"RTN","C0SDOM",85,0)
    1002 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
     1014 ;Q $$EN^MXMLDOM(INXML)
    10031015"RTN","C0SDOM",86,0)
    1004  ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
     1016 Q $$EN^MXMLDOM(INXML,"W")
    10051017"RTN","C0SDOM",87,0)
    1006  ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
     1018 ;
    10071019"RTN","C0SDOM",88,0)
    1008  ;Q $$EN^MXMLDOM(INXML)
     1020ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    10091021"RTN","C0SDOM",89,0)
    1010  Q $$EN^MXMLDOM(INXML,"W")
     1022 N ZN
    10111023"RTN","C0SDOM",90,0)
    1012  ;
     1024 ;I $$TAG(ZOID)["entry" B
    10131025"RTN","C0SDOM",91,0)
    1014 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
     1026 S ZN=$$NXTSIB(ZOID)
    10151027"RTN","C0SDOM",92,0)
    1016  N ZN
     1028 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
    10171029"RTN","C0SDOM",93,0)
    1018  ;I $$TAG(ZOID)["entry" B
     1030 Q 0
    10191031"RTN","C0SDOM",94,0)
    1020  S ZN=$$NXTSIB(ZOID)
     1032 ;
    10211033"RTN","C0SDOM",95,0)
    1022  I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
     1034FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    10231035"RTN","C0SDOM",96,0)
    1024  Q 0
     1036 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
    10251037"RTN","C0SDOM",97,0)
    10261038 ;
    10271039"RTN","C0SDOM",98,0)
    1028 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
     1040PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
    10291041"RTN","C0SDOM",99,0)
    1030  Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
     1042 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
    10311043"RTN","C0SDOM",100,0)
    10321044 ;
    10331045"RTN","C0SDOM",101,0)
    1034 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
     1046ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
    10351047"RTN","C0SDOM",102,0)
    1036  Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
     1048 S HANDLE=C0SDOCID
    10371049"RTN","C0SDOM",103,0)
    1038  ;
     1050 K @RTN
    10391051"RTN","C0SDOM",104,0)
    1040 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
     1052 D GETTXT^MXMLDOM("A")
    10411053"RTN","C0SDOM",105,0)
    1042  S HANDLE=C0SDOCID
     1054 Q
    10431055"RTN","C0SDOM",106,0)
    1044  K @RTN
     1056 ;
    10451057"RTN","C0SDOM",107,0)
    1046  D GETTXT^MXMLDOM("A")
     1058TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
    10471059"RTN","C0SDOM",108,0)
    1048  Q
     1060 ;I ZOID=149 B ;GPLTEST
    10491061"RTN","C0SDOM",109,0)
    1050  ;
     1062 N X,Y
    10511063"RTN","C0SDOM",110,0)
    1052 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
     1064 S Y=""
    10531065"RTN","C0SDOM",111,0)
    1054  ;I ZOID=149 B ;GPLTEST
     1066 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
    10551067"RTN","C0SDOM",112,0)
    1056  N X,Y
     1068 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
    10571069"RTN","C0SDOM",113,0)
    1058  S Y=""
     1070 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
    10591071"RTN","C0SDOM",114,0)
    1060  S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
     1072 Q Y
    10611073"RTN","C0SDOM",115,0)
    1062  I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
     1074 ;
    10631075"RTN","C0SDOM",116,0)
    1064  I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
     1076NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
    10651077"RTN","C0SDOM",117,0)
    1066  Q Y
     1078 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
    10671079"RTN","C0SDOM",118,0)
    10681080 ;
    10691081"RTN","C0SDOM",119,0)
    1070 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
     1082DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
    10711083"RTN","C0SDOM",120,0)
    1072  Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
     1084 ;N ZT,ZN S ZT=""
    10731085"RTN","C0SDOM",121,0)
    1074  ;
     1086 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
    10751087"RTN","C0SDOM",122,0)
    1076 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
     1088 ;Q $G(@C0SDOM@(ZOID,"T",1))
    10771089"RTN","C0SDOM",123,0)
    1078  ;N ZT,ZN S ZT=""
     1090 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
    10791091"RTN","C0SDOM",124,0)
    1080  ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
     1092 Q
    10811093"RTN","C0SDOM",125,0)
    1082  ;Q $G(@C0SDOM@(ZOID,"T",1))
     1094 ;
    10831095"RTN","C0SDOM",126,0)
    1084  S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
     1096OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    10851097"RTN","C0SDOM",127,0)
    1086  Q
     1098 ;
    10871099"RTN","C0SDOM",128,0)
    1088  ;
     1100 S C0SDOCID=INID
    10891101"RTN","C0SDOM",129,0)
    1090 OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
     1102 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
    10911103"RTN","C0SDOM",130,0)
    1092  ;
     1104 D START^C0SMXMLB($$TAG(1),,"G",NO1ST)
    10931105"RTN","C0SDOM",131,0)
    1094  S C0SDOCID=INID
     1106 D NDOUT($$FIRST(1))
    10951107"RTN","C0SDOM",132,0)
    1096  I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
     1108 D END^C0SMXMLB ;END THE DOCUMENT
    10971109"RTN","C0SDOM",133,0)
    1098  D START^C0SMXMLB($$TAG(1),,"G",NO1ST)
     1110 M @ZRTN=^TMP("MXMLBLD",$J)
    10991111"RTN","C0SDOM",134,0)
    1100  D NDOUT($$FIRST(1))
     1112 K ^TMP("MXMLBLD",$J)
    11011113"RTN","C0SDOM",135,0)
    1102  D END^C0SMXMLB ;END THE DOCUMENT
     1114 Q
    11031115"RTN","C0SDOM",136,0)
    1104  M @ZRTN=^TMP("MXMLBLD",$J)
     1116 ;
    11051117"RTN","C0SDOM",137,0)
    1106  K ^TMP("MXMLBLD",$J)
     1118NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
    11071119"RTN","C0SDOM",138,0)
    1108  Q
     1120 N ZI S ZI=$$FIRST(ZOID)
    11091121"RTN","C0SDOM",139,0)
    1110  ;
     1122 I ZI'=0 D  ; THERE IS A CHILD
    11111123"RTN","C0SDOM",140,0)
    1112 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
     1124 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
    11131125"RTN","C0SDOM",141,0)
    1114  N ZI S ZI=$$FIRST(ZOID)
     1126 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
    11151127"RTN","C0SDOM",142,0)
    1116  I ZI'=0 D  ; THERE IS A CHILD
     1128 E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
    11171129"RTN","C0SDOM",143,0)
    1118  . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
     1130 . ;W "DOING",ZOID,!
    11191131"RTN","C0SDOM",144,0)
    1120  . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
     1132 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
    11211133"RTN","C0SDOM",145,0)
    1122  E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
     1134 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
    11231135"RTN","C0SDOM",146,0)
    1124  . ;W "DOING",ZOID,!
     1136 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
    11251137"RTN","C0SDOM",147,0)
    1126  . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
     1138 I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
    11271139"RTN","C0SDOM",148,0)
    1128  . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
     1140 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
    11291141"RTN","C0SDOM",149,0)
    1130  . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
     1142 Q
    11311143"RTN","C0SDOM",150,0)
    1132  I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
     1144 ;
    11331145"RTN","C0SDOM",151,0)
    1134  . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
     1146WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
    11351147"RTN","C0SDOM",152,0)
    1136  Q
     1148 ;
    11371149"RTN","C0SDOM",153,0)
    1138  ;
     1150 N GN,GN2
    11391151"RTN","C0SDOM",154,0)
    1140 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
     1152 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
    11411153"RTN","C0SDOM",155,0)
    1142  ;
     1154 S GN2=$NA(@GN@(1))
    11431155"RTN","C0SDOM",156,0)
    1144  N GN,GN2
     1156 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
    11451157"RTN","C0SDOM",157,0)
    1146  D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
     1158 Q
    11471159"RTN","C0SDOM",158,0)
    1148  S GN2=$NA(@GN@(1))
     1160 ;
    11491161"RTN","C0SDOM",159,0)
    1150  W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
     1162NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY
    11511163"RTN","C0SDOM",160,0)
    1152  Q
     1164 ; ZGOUT AND ZGIN ARE PASSED BY NAME
    11531165"RTN","C0SDOM",161,0)
    1154  ;
     1166 N C0SDOCID
    11551167"RTN","C0SDOM",162,0)
    1156 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY
     1168 W !,ZGOUT," ",ZGIN
    11571169"RTN","C0SDOM",163,0)
    1158  ; ZGOUT AND ZGIN ARE PASSED BY NAME
     1170 S C0SDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
    11591171"RTN","C0SDOM",164,0)
    1160  N C0SDOCID
     1172 D OUTXML(ZGOUT,C0SDOCID)
    11611173"RTN","C0SDOM",165,0)
    1162  W !,ZGOUT," ",ZGIN
     1174 Q
    11631175"RTN","C0SDOM",166,0)
    1164  S C0SDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
     1176 ;
    11651177"RTN","C0SDOM",167,0)
    1166  D OUTXML(ZGOUT,C0SDOCID)
     1178 ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
    11671179"RTN","C0SDOM",168,0)
    1168  Q
     1180 ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
    11691181"RTN","C0SDOM",169,0)
    11701182 ;
    11711183"RTN","C0SDOM",170,0)
    1172  ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
     1184 ;GNARY("med",1,"doses.dose@dose")=10
    11731185"RTN","C0SDOM",171,0)
    1174  ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
     1186 ;GNARY("med",1,"doses.dose@noun")="TABLET"
    11751187"RTN","C0SDOM",172,0)
    1176  ;
     1188 ;GNARY("med",1,"doses.dose@route")="PO"
    11771189"RTN","C0SDOM",173,0)
    1178  ;GNARY("med",1,"doses.dose@dose")=10
     1190 ;GNARY("med",1,"doses.dose@schedule")="QD"
    11791191"RTN","C0SDOM",174,0)
    1180  ;GNARY("med",1,"doses.dose@noun")="TABLET"
     1192 ;GNARY("med",1,"doses.dose@units")="MG"
    11811193"RTN","C0SDOM",175,0)
    1182  ;GNARY("med",1,"doses.dose@route")="PO"
     1194 ;GNARY("med",1,"doses.dose@unitsPerDose")=1
    11831195"RTN","C0SDOM",176,0)
    1184  ;GNARY("med",1,"doses.dose@schedule")="QD"
     1196 ;GNARY("med",1,"facility@code")=100
    11851197"RTN","C0SDOM",177,0)
    1186  ;GNARY("med",1,"doses.dose@units")="MG"
     1198 ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"
    11871199"RTN","C0SDOM",178,0)
    1188  ;GNARY("med",1,"doses.dose@unitsPerDose")=1
     1200 ;GNARY("med",1,"form@value")="TAB"
    11891201"RTN","C0SDOM",179,0)
    1190  ;GNARY("med",1,"facility@code")=100
     1202 ;GNARY("med",1,"id@value")="1N;O"
    11911203"RTN","C0SDOM",180,0)
    1192  ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"
     1204 ;GNARY("med",1,"location@code")=5
    11931205"RTN","C0SDOM",181,0)
    1194  ;GNARY("med",1,"form@value")="TAB"
     1206 ;GNARY("med",1,"location@name")="3 WEST"
    11951207"RTN","C0SDOM",182,0)
    1196  ;GNARY("med",1,"id@value")="1N;O"
     1208 ;GNARY("med",1,"name@value")="LISINOPRIL TAB"
    11971209"RTN","C0SDOM",183,0)
    1198  ;GNARY("med",1,"location@code")=5
     1210 ;GNARY("med",1,"orderID@value")=294
    11991211"RTN","C0SDOM",184,0)
    1200  ;GNARY("med",1,"location@name")="3 WEST"
     1212 ;GNARY("med",1,"ordered@value")=3110531.001233
    12011213"RTN","C0SDOM",185,0)
    1202  ;GNARY("med",1,"name@value")="LISINOPRIL TAB"
     1214 ;GNARY("med",1,"orderingProvider@code")=63
    12031215"RTN","C0SDOM",186,0)
    1204  ;GNARY("med",1,"orderID@value")=294
     1216 ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"
    12051217"RTN","C0SDOM",187,0)
    1206  ;GNARY("med",1,"ordered@value")=3110531.001233
     1218 ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"
    12071219"RTN","C0SDOM",188,0)
    1208  ;GNARY("med",1,"orderingProvider@code")=63
     1220 ;GNARY("med",1,"products.product.vaGeneric@code")=1990
    12091221"RTN","C0SDOM",189,0)
    1210  ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"
     1222 ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"
    12111223"RTN","C0SDOM",190,0)
    1212  ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"
     1224 ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380
    12131225"RTN","C0SDOM",191,0)
    1214  ;GNARY("med",1,"products.product.vaGeneric@code")=1990
     1226 ;GNARY("med",1,"products.product.vaProduct@code")=8118
    12151227"RTN","C0SDOM",192,0)
    1216  ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"
     1228 ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"
    12171229"RTN","C0SDOM",193,0)
    1218  ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380
     1230 ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593
    12191231"RTN","C0SDOM",194,0)
    1220  ;GNARY("med",1,"products.product.vaProduct@code")=8118
     1232 ;GNARY("med",1,"products.product@code")=6174
    12211233"RTN","C0SDOM",195,0)
    1222  ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"
     1234 ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"
    12231235"RTN","C0SDOM",196,0)
    1224  ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593
     1236 ;GNARY("med",1,"products.product@role")="D"
    12251237"RTN","C0SDOM",197,0)
    1226  ;GNARY("med",1,"products.product@code")=6174
     1238 ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"
    12271239"RTN","C0SDOM",198,0)
    1228  ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"
     1240 ;GNARY("med",1,"sig@xml:space")="preserve"
    12291241"RTN","C0SDOM",199,0)
    1230  ;GNARY("med",1,"products.product@role")="D"
     1242 ;GNARY("med",1,"status@value")="active"
    12311243"RTN","C0SDOM",200,0)
    1232  ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"
     1244 ;GNARY("med",1,"type@value")="OTC"
    12331245"RTN","C0SDOM",201,0)
    1234  ;GNARY("med",1,"sig@xml:space")="preserve"
     1246 ;GNARY("med",1,"vaType@value")="N"
    12351247"RTN","C0SDOM",202,0)
    1236  ;GNARY("med",1,"status@value")="active"
     1248 ;
    12371249"RTN","C0SDOM",203,0)
    1238  ;GNARY("med",1,"type@value")="OTC"
     1250 ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM
    12391251"RTN","C0SDOM",204,0)
    1240  ;GNARY("med",1,"vaType@value")="N"
     1252 ; it returns 0 or 1 based on success.
    12411253"RTN","C0SDOM",205,0)
    12421254 ;
    12431255"RTN","C0SDOM",206,0)
    1244  ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM
     1256 ; INARY is passed by name and has the format shown above
    12451257"RTN","C0SDOM",207,0)
    1246  ; it returns 0 or 1 based on success.
     1258 ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will
    12471259"RTN","C0SDOM",208,0)
    1248  ;
     1260 ; be supported eventually - initial implementation is for MXML
    12491261"RTN","C0SDOM",209,0)
    1250  ; INARY is passed by name and has the format shown above
     1262 ;
    12511263"RTN","C0SDOM",210,0)
    1252  ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will
     1264 ; PARENT is the node id or tag of the parent under which the DOM will
    12531265"RTN","C0SDOM",211,0)
    1254  ; be supported eventually - initial implementation is for MXML
     1266 ; be populated. If it is numeric, it is a node. If it is a string, the DOM
    12551267"RTN","C0SDOM",212,0)
    1256  ;
     1268 ; will be searched to find the tag. If not found and there is no root,
    12571269"RTN","C0SDOM",213,0)
    1258  ; PARENT is the node id or tag of the parent under which the DOM will
     1270 ; it will be inserted as the root. If not found and there is a root, it
    12591271"RTN","C0SDOM",214,0)
    1260  ; be populated. If it is numeric, it is a node. If it is a string, the DOM
     1272 ; will be inserted under the root.
    12611273"RTN","C0SDOM",215,0)
    1262  ; will be searched to find the tag. If not found and there is no root,
     1274 ;
    12631275"RTN","C0SDOM",216,0)
    1264  ; it will be inserted as the root. If not found and there is a root, it
     1276 ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")
    12651277"RTN","C0SDOM",217,0)
    1266  ; will be inserted under the root.
     1278 ; because "results" is the root tag. Use OUTXML to render the xml from
    12671279"RTN","C0SDOM",218,0)
    1268  ;
     1280 ; the DOM.
    12691281"RTN","C0SDOM",219,0)
    1270  ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")
     1282 ;
    12711283"RTN","C0SDOM",220,0)
    1272  ; because "results" is the root tag. Use OUTXML to render the xml from
     1284DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
    12731285"RTN","C0SDOM",221,0)
    1274  ; the DOM.
     1286 ;
    12751287"RTN","C0SDOM",222,0)
    1276  ;
     1288 N ZPARNODE
    12771289"RTN","C0SDOM",223,0)
    1278 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
     1290 S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
    12791291"RTN","C0SDOM",224,0)
    1280  ;
     1292 I '$D(INARY) Q 0 ; NO ARRAY PASSED
    12811293"RTN","C0SDOM",225,0)
    1282  N ZPARNODE
     1294 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
    12831295"RTN","C0SDOM",226,0)
    1284  S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
     1296 ;I PARENT="" S PARENT="root"
    12851297"RTN","C0SDOM",227,0)
    1286  I '$D(INARY) Q 0 ; NO ARRAY PASSED
     1298 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
    12871299"RTN","C0SDOM",228,0)
    1288  I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
     1300 E  I $L($G(PARENT))>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
    12891301"RTN","C0SDOM",229,0)
    1290  ;I PARENT="" S PARENT="root"
     1302 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
    12911303"RTN","C0SDOM",230,0)
    1292  I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
     1304 . S ZPARNODE=1 ;
    12931305"RTN","C0SDOM",231,0)
    1294  E  I $L($G(PARENT))>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
     1306 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
    12951307"RTN","C0SDOM",232,0)
    1296  . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
     1308 N ZEXARY
    12971309"RTN","C0SDOM",233,0)
    1298  . S ZPARNODE=1 ;
     1310 D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
    12991311"RTN","C0SDOM",234,0)
    1300  ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
     1312 D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
    13011313"RTN","C0SDOM",235,0)
    1302  N ZEXARY
     1314 I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
    13031315"RTN","C0SDOM",236,0)
    1304  D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
     1316 Q HANDLE ; SUCCESS
    13051317"RTN","C0SDOM",237,0)
    1306  D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
     1318 ;
    13071319"RTN","C0SDOM",238,0)
    1308  I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
     1320MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
    13091321"RTN","C0SDOM",239,0)
    1310  Q HANDLE ; SUCCESS
     1322 N ZI S ZI=""
    13111323"RTN","C0SDOM",240,0)
    1312  ;
     1324 N ZTAG
    13131325"RTN","C0SDOM",241,0)
    1314 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
     1326 F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH SECTION
    13151327"RTN","C0SDOM",242,0)
    1316  N ZI S ZI=""
     1328 . N ZELEADD S ZELEADD=0
    13171329"RTN","C0SDOM",243,0)
    1318  N ZTAG
     1330 . I ZI["@" D  ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
    13191331"RTN","C0SDOM",244,0)
    1320  F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH SECTION
     1332 . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
    13211333"RTN","C0SDOM",245,0)
    1322  . N ZELEADD S ZELEADD=0
     1334 . . K ZATT ; CLEAR OUT LAST ONE
    13231335"RTN","C0SDOM",246,0)
    1324  . I ZI["@" D  ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
     1336 . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
    13251337"RTN","C0SDOM",247,0)
    1326  . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
     1338 . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
    13271339"RTN","C0SDOM",248,0)
    1328  . . K ZATT ; CLEAR OUT LAST ONE
     1340 . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
    13291341"RTN","C0SDOM",249,0)
    1330  . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
     1342 . I $O(@ZARY@(ZI,""))="" D  ;END NODE
    13311343"RTN","C0SDOM",250,0)
    1332  . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
     1344 . . S ZTAG=ZI ; USE ZI FOR THE TAG
    13331345"RTN","C0SDOM",251,0)
    1334  . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
     1346 . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
    13351347"RTN","C0SDOM",252,0)
    1336  . I $O(@ZARY@(ZI,""))="" D  ;END NODE
     1348 . . S ZELEADD=1 ; ADDED AN ELEMENT
    13371349"RTN","C0SDOM",253,0)
    1338  . . S ZTAG=ZI ; USE ZI FOR THE TAG
     1350 . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
    13391351"RTN","C0SDOM",254,0)
    1340  . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
     1352 . I ZELEADD D  Q  ; NO MORE TO DO ON THIS LEVEL
    13411353"RTN","C0SDOM",255,0)
    1342  . . S ZELEADD=1 ; ADDED AN ELEMENT
     1354 . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
    13431355"RTN","C0SDOM",256,0)
    1344  . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
     1356 . N NEWARY ; INDENTED ARRAY
    13451357"RTN","C0SDOM",257,0)
    1346  . I ZELEADD D  Q  ; NO MORE TO DO ON THIS LEVEL
     1358 . N ZN S ZN=0
    13471359"RTN","C0SDOM",258,0)
    1348  . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
     1360 . F  S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN=""  D  ; FOR EACH MULTIPLE
    13491361"RTN","C0SDOM",259,0)
    1350  . N NEWARY ; INDENTED ARRAY
     1362 . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
    13511363"RTN","C0SDOM",260,0)
    1352  . N ZN S ZN=0
     1364 . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
    13531365"RTN","C0SDOM",261,0)
    1354  . F  S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN=""  D  ; FOR EACH MULTIPLE
     1366 . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
    13551367"RTN","C0SDOM",262,0)
    1356  . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
     1368 . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
    13571369"RTN","C0SDOM",263,0)
    1358  . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
     1370 Q
    13591371"RTN","C0SDOM",264,0)
    1360  . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
     1372 ;
    13611373"RTN","C0SDOM",265,0)
    1362  . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
     1374EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
    13631375"RTN","C0SDOM",266,0)
    1364  Q
     1376 ; CONSISTENT FORMAT
    13651377"RTN","C0SDOM",267,0)
    1366  ;
     1378 ; GNARY("patient",1,"facilities[2].facility@code")="050"
    13671379"RTN","C0SDOM",268,0)
    1368 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
     1380 ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"
    13691381"RTN","C0SDOM",269,0)
    1370  ; CONSISTENT FORMAT
     1382 ; for easier processing (this is fileman format genius)
    13711383"RTN","C0SDOM",270,0)
    1372  ; GNARY("patient",1,"facilities[2].facility@code")="050"
     1384 ; basically removes the dot notation from the strings
    13731385"RTN","C0SDOM",271,0)
    1374  ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"
     1386 ;
    13751387"RTN","C0SDOM",272,0)
    1376  ; for easier processing (this is fileman format genius)
     1388 N ZZI
    13771389"RTN","C0SDOM",273,0)
    1378  ; basically removes the dot notation from the strings
     1390 S ZZI=""
    13791391"RTN","C0SDOM",274,0)
    1380  ;
     1392 F  S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI=""  D  ;
    13811393"RTN","C0SDOM",275,0)
    1382  N ZZI
     1394 . N ZZN S ZZN=0
    13831395"RTN","C0SDOM",276,0)
    1384  S ZZI=""
     1396 . F  S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN=""  D  ;
    13851397"RTN","C0SDOM",277,0)
    1386  F  S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI=""  D  ;
     1398 . . N ZZS S ZZS=""
    13871399"RTN","C0SDOM",278,0)
    1388  . N ZZN S ZZN=0
     1400 . . N GA ;PUSH STACK
    13891401"RTN","C0SDOM",279,0)
    1390  . F  S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN=""  D  ;
     1402 . . F  S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS=""  D  ;
    13911403"RTN","C0SDOM",280,0)
    1392  . . N ZZS S ZZS=""
     1404 . . . K GA ; NEW STACK
    13931405"RTN","C0SDOM",281,0)
    1394  . . N GA ;PUSH STACK
     1406 . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
    13951407"RTN","C0SDOM",282,0)
    1396  . . F  S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS=""  D  ;
     1408 . . . N ZZV ; PLACE TO STASH THE VALUE
    13971409"RTN","C0SDOM",283,0)
    1398  . . . K GA ; NEW STACK
     1410 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
    13991411"RTN","C0SDOM",284,0)
    1400  . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
     1412 . . . W !,"VALUE:",ZZV
    14011413"RTN","C0SDOM",285,0)
    1402  . . . N ZZV ; PLACE TO STASH THE VALUE
     1414 . . . N GK ; COUNTER
    14031415"RTN","C0SDOM",286,0)
    1404  . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
     1416 . . . F GK=1:1:$L(ZZS,".") D  ; FOR EACH INTERMEDIATE NODE
    14051417"RTN","C0SDOM",287,0)
    1406  . . . W !,"VALUE:",ZZV
     1418 . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
    14071419"RTN","C0SDOM",288,0)
    1408  . . . N GK ; COUNTER
     1420 . . . . N GM S GM=$P(ZZS,".",GK) ; TAG
    14091421"RTN","C0SDOM",289,0)
    1410  . . . F GK=1:1:$L(ZZS,".") D  ; FOR EACH INTERMEDIATE NODE
     1422 . . . . I GM["[" D  ; IT'S A MULTIPLE
    14111423"RTN","C0SDOM",290,0)
    1412  . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
     1424 . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER
    14131425"RTN","C0SDOM",291,0)
    1414  . . . . N GM S GM=$P(ZZS,".",GK) ; TAG
     1426 . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG
    14151427"RTN","C0SDOM",292,0)
    1416  . . . . I GM["[" D  ; IT'S A MULTIPLE
     1428 . . . . I GM["@" D  ; IT'S GOT ATTRIBUTES
    14171429"RTN","C0SDOM",293,0)
    1418  . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER
     1430 . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME
    14191431"RTN","C0SDOM",294,0)
    1420  . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG
     1432 . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG
    14211433"RTN","C0SDOM",295,0)
    1422  . . . . I GM["@" D  ; IT'S GOT ATTRIBUTES
     1434 . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2)
    14231435"RTN","C0SDOM",296,0)
    1424  . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME
     1436 . . . . E  D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ;
    14251437"RTN","C0SDOM",297,0)
    1426  . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG
     1438 . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"
    14271439"RTN","C0SDOM",298,0)
    1428  . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2)
     1440 . . . N GZI S GZI="" ; STRING FOR THE INDEX
    14291441"RTN","C0SDOM",299,0)
    1430  . . . . E  D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ;
     1442 . . . F GK=1:1:GA(0) D  ; TIME TO REVERSE POP THE TAGS
    14311443"RTN","C0SDOM",300,0)
    1432  . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"
     1444 . . . . S GM=$P(GA(GK),"^",1) ; THE TAG
    14331445"RTN","C0SDOM",301,0)
    1434  . . . N GZI S GZI="" ; STRING FOR THE INDEX
     1446 . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY
    14351447"RTN","C0SDOM",302,0)
    1436  . . . F GK=1:1:GA(0) D  ; TIME TO REVERSE POP THE TAGS
     1448 . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE
    14371449"RTN","C0SDOM",303,0)
    1438  . . . . S GM=$P(GA(GK),"^",1) ; THE TAG
     1450 . . . . E  S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST
    14391451"RTN","C0SDOM",304,0)
    1440  . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY
     1452 . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME
    14411453"RTN","C0SDOM",305,0)
    1442  . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE
     1454 . . . W !,GZI
    14431455"RTN","C0SDOM",306,0)
    1444  . . . . E  S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST
     1456 . . . S @GZI2=ZZV ; REMEMBER THE VALUE?
    14451457"RTN","C0SDOM",307,0)
    1446  . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME
     1458 Q
    14471459"RTN","C0SDOM",308,0)
    1448  . . . W !,GZI
     1460 ;
    14491461"RTN","C0SDOM",309,0)
    1450  . . . S @GZI2=ZZV ; REMEMBER THE VALUE?
     1462NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
    14511463"RTN","C0SDOM",310,0)
    1452  Q
     1464 N CBK,SUCCESS,LEVEL,NODE,HANDLE
    14531465"RTN","C0SDOM",311,0)
    1454  ;
     1466 K ^TMP("MXMLERR",$J)
    14551467"RTN","C0SDOM",312,0)
    1456 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
     1468 L +^TMP("MXMLDOM",$J):5
    14571469"RTN","C0SDOM",313,0)
    1458  N CBK,SUCCESS,LEVEL,NODE,HANDLE
     1470 E  Q 0
    14591471"RTN","C0SDOM",314,0)
    1460  K ^TMP("MXMLERR",$J)
     1472 S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
    14611473"RTN","C0SDOM",315,0)
    1462  L +^TMP("MXMLDOM",$J):5
     1474 L -^TMP("MXMLDOM",$J)
    14631475"RTN","C0SDOM",316,0)
    1464  E  Q 0
     1476 Q HANDLE
    14651477"RTN","C0SDOM",317,0)
    1466  S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
    1467 "RTN","C0SDOM",318,0)
    1468  L -^TMP("MXMLDOM",$J)
    1469 "RTN","C0SDOM",319,0)
    1470  Q HANDLE
    1471 "RTN","C0SDOM",320,0)
    14721478 ;
    14731479"RTN","C0SLAB")
    1474 0^3^B79856252
     14800^3^B79123674
    14751481"RTN","C0SLAB",1,0)
    14761482C0SLAB   ; GPL - Smart Lab Processing ;4/15/12  17:05
    14771483"RTN","C0SLAB",2,0)
    1478  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     1484 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    14791485"RTN","C0SLAB",3,0)
    1480  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     1486 ;Copyright 2012 George Lilly. 
    14811487"RTN","C0SLAB",4,0)
    1482  ;General Public License See attached copy of the License.
     1488 ;
    14831489"RTN","C0SLAB",5,0)
    1484  ;
     1490 ; This program is free software: you can redistribute it and/or modify
    14851491"RTN","C0SLAB",6,0)
    1486  ;This program is free software; you can redistribute it and/or modify
     1492 ; it under the terms of the GNU Affero General Public License as
    14871493"RTN","C0SLAB",7,0)
    1488  ;it under the terms of the GNU General Public License as published by
     1494 ; published by the Free Software Foundation, either version 3 of the
    14891495"RTN","C0SLAB",8,0)
    1490  ;the Free Software Foundation; either version 2 of the License, or
     1496 ; License, or (at your option) any later version.
    14911497"RTN","C0SLAB",9,0)
    1492  ;(at your option) any later version.
     1498 ;
    14931499"RTN","C0SLAB",10,0)
    1494  ;
     1500 ; This program is distributed in the hope that it will be useful,
    14951501"RTN","C0SLAB",11,0)
    1496  ;This program is distributed in the hope that it will be useful,
     1502 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    14971503"RTN","C0SLAB",12,0)
    1498  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     1504 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    14991505"RTN","C0SLAB",13,0)
    1500  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     1506 ; GNU Affero General Public License for more details.
    15011507"RTN","C0SLAB",14,0)
    1502  ;GNU General Public License for more details.
     1508 ;
    15031509"RTN","C0SLAB",15,0)
    1504  ;
     1510 ; You should have received a copy of the GNU Affero General Public License
    15051511"RTN","C0SLAB",16,0)
    1506  ;You should have received a copy of the GNU General Public License along
     1512 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    15071513"RTN","C0SLAB",17,0)
    1508  ;with this program; if not, write to the Free Software Foundation, Inc.,
     1514 ;
    15091515"RTN","C0SLAB",18,0)
    1510  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     1516 Q
    15111517"RTN","C0SLAB",19,0)
    15121518 ;
    15131519"RTN","C0SLAB",20,0)
    1514  Q
     1520 ; sample VistA NHIN lab result
    15151521"RTN","C0SLAB",21,0)
    15161522 ;
    15171523"RTN","C0SLAB",22,0)
    1518  ; sample VistA NHIN lab result
     1524 ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16
    15191525"RTN","C0SLAB",23,0)
    1520  ;
     1526 ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00"
    15211527"RTN","C0SLAB",24,0)
    1522  ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16
     1528 ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve"
    15231529"RTN","C0SLAB",25,0)
    1524  ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00"
     1530 ;^TMP("C0STBL",32,"lab",8,"facility@code")=100
    15251531"RTN","C0SLAB",26,0)
    1526  ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve"
     1532 ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION"
    15271533"RTN","C0SLAB",27,0)
    1528  ;^TMP("C0STBL",32,"lab",8,"facility@code")=100
     1534 ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47"
    15291535"RTN","C0SLAB",28,0)
    1530  ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION"
     1536 ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101"
    15311537"RTN","C0SLAB",29,0)
    1532  ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47"
     1538 ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003"
    15331539"RTN","C0SLAB",30,0)
    1534  ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101"
     1540 ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H"
    15351541"RTN","C0SLAB",31,0)
    1536  ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003"
     1542 ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336
    15371543"RTN","C0SLAB",32,0)
    1538  ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H"
     1544 ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU"
    15391545"RTN","C0SLAB",33,0)
    1540  ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336
     1546 ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0"
    15411547"RTN","C0SLAB",34,0)
    1542  ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU"
     1548 ;^TMP("C0STBL",32,"lab",8,"low@value")="69 "
    15431549"RTN","C0SLAB",35,0)
    1544  ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0"
     1550 ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807
    15451551"RTN","C0SLAB",36,0)
    1546  ;^TMP("C0STBL",32,"lab",8,"low@value")="69 "
     1552 ;^TMP("C0STBL",32,"lab",8,"result@value")=178
    15471553"RTN","C0SLAB",37,0)
    1548  ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807
     1554 ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006
    15491555"RTN","C0SLAB",38,0)
    1550  ;^TMP("C0STBL",32,"lab",8,"result@value")=178
     1556 ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM"
    15511557"RTN","C0SLAB",39,0)
    1552  ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006
     1558 ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500"
    15531559"RTN","C0SLAB",40,0)
    1554  ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM"
     1560 ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM"
    15551561"RTN","C0SLAB",41,0)
    1556  ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500"
     1562 ;^TMP("C0STBL",32,"lab",8,"status@value")="completed"
    15571563"RTN","C0SLAB",42,0)
    1558  ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM"
     1564 ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE"
    15591565"RTN","C0SLAB",43,0)
    1560  ;^TMP("C0STBL",32,"lab",8,"status@value")="completed"
     1566 ;^TMP("C0STBL",32,"lab",8,"type@value")="CH"
    15611567"RTN","C0SLAB",44,0)
    1562  ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE"
     1568 ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL"
    15631569"RTN","C0SLAB",45,0)
    1564  ;^TMP("C0STBL",32,"lab",8,"type@value")="CH"
     1570 ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342
    15651571"RTN","C0SLAB",46,0)
    1566  ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL"
     1572 ;
    15671573"RTN","C0SLAB",47,0)
    1568  ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342
     1574 ; sample Smart lab result triples
    15691575"RTN","C0SLAB",48,0)
    15701576 ;
    15711577"RTN","C0SLAB",49,0)
    1572  ; sample Smart lab result triples
     1578 ;G("loinc:29571-7","dcterms:identifier")="29571-7"
    15731579"RTN","C0SLAB",50,0)
    1574  ;
     1580 ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql"
    15751581"RTN","C0SLAB",51,0)
    1576  ;G("loinc:29571-7","dcterms:identifier")="29571-7"
     1582 ;G("loinc:29571-7","rdf:type")="sp:Code"
    15771583"RTN","C0SLAB",52,0)
    1578  ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql"
     1584 ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/"
    15791585"RTN","C0SLAB",53,0)
    1580  ;G("loinc:29571-7","rdf:type")="sp:Code"
     1586 ;G("loinc:38478-4","dcterms:identifier")="38478-4"
    15811587"RTN","C0SLAB",54,0)
    1582  ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/"
     1588 ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql"
    15831589"RTN","C0SLAB",55,0)
    1584  ;G("loinc:38478-4","dcterms:identifier")="38478-4"
     1590 ;G("loinc:38478-4","rdf:type")="sp:Code"
    15851591"RTN","C0SLAB",56,0)
    1586  ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql"
     1592 ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/"
    15871593"RTN","C0SLAB",57,0)
    1588  ;G("loinc:38478-4","rdf:type")="sp:Code"
     1594 ;G("qqWZZIew993","rdf:type")="sp:Attribution"
    15891595"RTN","C0SLAB",58,0)
    1590  ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/"
     1596 ;G("qqWZZIew993","sp:startDate")="2007-04-21"
    15911597"RTN","C0SLAB",59,0)
    1592  ;G("qqWZZIew993","rdf:type")="sp:Attribution"
     1598 ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult"
    15931599"RTN","C0SLAB",60,0)
    1594  ;G("qqWZZIew993","sp:startDate")="2007-04-21"
     1600 ;G("qqWZZIew994","sp:value")="Normal"
    15951601"RTN","C0SLAB",61,0)
    1596  ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult"
     1602 ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql"
    15971603"RTN","C0SLAB",62,0)
    1598  ;G("qqWZZIew994","sp:value")="Normal"
     1604 ;G("qqWZZIew995","rdf:type")="sp:CodedValue"
    15991605"RTN","C0SLAB",63,0)
    1600  ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql"
     1606 ;G("qqWZZIew995","sp:code")="loinc:38478-4"
    16011607"RTN","C0SLAB",64,0)
    1602  ;G("qqWZZIew995","rdf:type")="sp:CodedValue"
     1608 ;G("qqWZZIew997","rdf:type")="sp:Attribution"
    16031609"RTN","C0SLAB",65,0)
    1604  ;G("qqWZZIew995","sp:code")="loinc:38478-4"
     1610 ;G("qqWZZIew997","sp:startDate")="2007-09-08"
    16051611"RTN","C0SLAB",66,0)
    1606  ;G("qqWZZIew997","rdf:type")="sp:Attribution"
     1612 ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult"
    16071613"RTN","C0SLAB",67,0)
    1608  ;G("qqWZZIew997","sp:startDate")="2007-09-08"
     1614 ;G("qqWZZIew998","sp:value")="Normal"
    16091615"RTN","C0SLAB",68,0)
    1610  ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult"
     1616 ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql"
    16111617"RTN","C0SLAB",69,0)
    1612  ;G("qqWZZIew998","sp:value")="Normal"
     1618 ;G("qqWZZIew999","rdf:type")="sp:CodedValue"
    16131619"RTN","C0SLAB",70,0)
    1614  ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql"
     1620 ;G("qqWZZIew999","sp:code")="loinc:29571-7"
    16151621"RTN","C0SLAB",71,0)
    1616  ;G("qqWZZIew999","rdf:type")="sp:CodedValue"
     1622 ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult"
    16171623"RTN","C0SLAB",72,0)
    1618  ;G("qqWZZIew999","sp:code")="loinc:29571-7"
     1624 ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345"
    16191625"RTN","C0SLAB",73,0)
    1620  ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult"
     1626 ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995"
    16211627"RTN","C0SLAB",74,0)
    1622  ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345"
     1628 ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994"
    16231629"RTN","C0SLAB",75,0)
    1624  ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995"
     1630 ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993"
    16251631"RTN","C0SLAB",76,0)
    1626  ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994"
     1632 ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult"
    16271633"RTN","C0SLAB",77,0)
    1628  ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993"
     1634 ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345"
    16291635"RTN","C0SLAB",78,0)
    1630  ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult"
     1636 ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999"
    16311637"RTN","C0SLAB",79,0)
    1632  ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345"
     1638 ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998"
    16331639"RTN","C0SLAB",80,0)
    1634  ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999"
     1640 ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997"
    16351641"RTN","C0SLAB",81,0)
    1636  ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998"
     1642 ;
    16371643"RTN","C0SLAB",82,0)
    1638  ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997"
     1644 ;
    16391645"RTN","C0SLAB",83,0)
    1640  ;
     1646 ;  another Smart example, this one with sp:quantitativeResult
    16411647"RTN","C0SLAB",84,0)
    16421648 ;
    16431649"RTN","C0SLAB",85,0)
    1644  ;  another Smart example, this one with sp:quantitativeResult
     1650 ;G("loinc:786-4","dcterms:identifier")="786-4"
    16451651"RTN","C0SLAB",86,0)
    1646  ;
     1652 ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc"
    16471653"RTN","C0SLAB",87,0)
    1648  ;G("loinc:786-4","dcterms:identifier")="786-4"
     1654 ;G("loinc:786-4","rdf:type")="sp:Code"
    16491655"RTN","C0SLAB",88,0)
    1650  ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc"
     1656 ;G("loinc:786-4","sp:system")="http://loinc.org/codes/"
    16511657"RTN","C0SLAB",89,0)
    1652  ;G("loinc:786-4","rdf:type")="sp:Code"
     1658 ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit"
    16531659"RTN","C0SLAB",90,0)
    1654  ;G("loinc:786-4","sp:system")="http://loinc.org/codes/"
     1660 ;G("nodeID:4439","sp:unit")="g/dL"
    16551661"RTN","C0SLAB",91,0)
    1656  ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit"
     1662 ;G("nodeID:4439","sp:value")=36.6
    16571663"RTN","C0SLAB",92,0)
    1658  ;G("nodeID:4439","sp:unit")="g/dL"
     1664 ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit"
    16591665"RTN","C0SLAB",93,0)
    1660  ;G("nodeID:4439","sp:value")=36.6
     1666 ;G("nodeID:4613","sp:unit")="g/dL"
    16611667"RTN","C0SLAB",94,0)
    1662  ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit"
     1668 ;G("nodeID:4613","sp:value")=32
    16631669"RTN","C0SLAB",95,0)
    1664  ;G("nodeID:4613","sp:unit")="g/dL"
     1670 ;G("nodeID:4672","rdf:type")="sp:Attribution"
    16651671"RTN","C0SLAB",96,0)
    1666  ;G("nodeID:4613","sp:value")=32
     1672 ;G("nodeID:4672","sp:startDate")="2005-03-10"
    16671673"RTN","C0SLAB",97,0)
    1668  ;G("nodeID:4672","rdf:type")="sp:Attribution"
     1674 ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit"
    16691675"RTN","C0SLAB",98,0)
    1670  ;G("nodeID:4672","sp:startDate")="2005-03-10"
     1676 ;G("nodeID:4866","sp:unit")="g/dL"
    16711677"RTN","C0SLAB",99,0)
    1672  ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit"
     1678 ;G("nodeID:4866","sp:value")=36
    16731679"RTN","C0SLAB",100,0)
    1674  ;G("nodeID:4866","sp:unit")="g/dL"
     1680 ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc"
    16751681"RTN","C0SLAB",101,0)
    1676  ;G("nodeID:4866","sp:value")=36
     1682 ;G("nodeID:4871","rdf:type")="sp:CodedValue"
    16771683"RTN","C0SLAB",102,0)
    1678  ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc"
     1684 ;G("nodeID:4871","sp:code")="loinc:786-4"
    16791685"RTN","C0SLAB",103,0)
    1680  ;G("nodeID:4871","rdf:type")="sp:CodedValue"
     1686 ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult"
    16811687"RTN","C0SLAB",104,0)
    1682  ;G("nodeID:4871","sp:code")="loinc:786-4"
     1688 ;G("nodeID:5221","sp:normalRange")="nodeID:5282"
    16831689"RTN","C0SLAB",105,0)
    1684  ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult"
     1690 ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439"
    16851691"RTN","C0SLAB",106,0)
    1686  ;G("nodeID:5221","sp:normalRange")="nodeID:5282"
     1692 ;G("nodeID:5282","rdf:type")="sp:ValueRange"
    16871693"RTN","C0SLAB",107,0)
    1688  ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439"
     1694 ;G("nodeID:5282","sp:maximum")="nodeID:4866"
    16891695"RTN","C0SLAB",108,0)
    1690  ;G("nodeID:5282","rdf:type")="sp:ValueRange"
     1696 ;G("nodeID:5282","sp:minimum")="nodeID:4613"
    16911697"RTN","C0SLAB",109,0)
    1692  ;G("nodeID:5282","sp:maximum")="nodeID:4866"
     1698 ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult"
    16931699"RTN","C0SLAB",110,0)
    1694  ;G("nodeID:5282","sp:minimum")="nodeID:4613"
     1700 ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505"
    16951701"RTN","C0SLAB",111,0)
    1696  ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult"
     1702 ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871"
    16971703"RTN","C0SLAB",112,0)
    1698  ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505"
     1704 ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221"
    16991705"RTN","C0SLAB",113,0)
    1700  ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871"
     1706 ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672"
    17011707"RTN","C0SLAB",114,0)
    1702  ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221"
     1708 ;
    17031709"RTN","C0SLAB",115,0)
    1704  ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672"
     1710LAB(GRTN,C0SARY) ; GRTN, passed by reference,
    17051711"RTN","C0SLAB",116,0)
    1706  ;
     1712 ; is the return name of the graph created. "" if none
    17071713"RTN","C0SLAB",117,0)
    1708 LAB(GRTN,C0SARY) ; GRTN, passed by reference,
     1714 ; C0SARY is passed in by reference and is the NHIN array of lab
    17091715"RTN","C0SLAB",118,0)
    1710  ; is the return name of the graph created. "" if none
     1716 ;
    17111717"RTN","C0SLAB",119,0)
    1712  ; C0SARY is passed in by reference and is the NHIN array of lab
     1718 I $O(C0SARY("lab",""))="" D  Q  ;
    17131719"RTN","C0SLAB",120,0)
    1714  ;
     1720 . I $D(DEBUG) W !,"No Labs"
    17151721"RTN","C0SLAB",121,0)
    1716  I $O(C0SARY("lab",""))="" D  Q  ;
     1722 S GRTN="" ; default to no labs
    17171723"RTN","C0SLAB",122,0)
    1718  . I $D(DEBUG) W !,"No Labs"
     1724 N C0SGRF
    17191725"RTN","C0SLAB",123,0)
    1720  S GRTN="" ; default to no labs
     1726 S C0SGRF="vistaSmart:"_ZPATID_"/lab_results"
    17211727"RTN","C0SLAB",124,0)
    1722  N C0SGRF
     1728 I $D(DEBUG) W !,"Processing ",C0SGRF
    17231729"RTN","C0SLAB",125,0)
    1724  S C0SGRF="vistaSmart:"_ZPATID_"/lab_results"
     1730 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
    17251731"RTN","C0SLAB",126,0)
    1726  I $D(DEBUG) W !,"Processing ",C0SGRF
     1732 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
    17271733"RTN","C0SLAB",127,0)
    1728  D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
     1734 N FARY S FARY="C0XFARY"
    17291735"RTN","C0SLAB",128,0)
    1730  D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
     1736 D USEFARY^C0XF2N(FARY)
    17311737"RTN","C0SLAB",129,0)
    1732  N FARY S FARY="C0XFARY"
     1738 D VOCINIT^C0XUTIL
    17331739"RTN","C0SLAB",130,0)
    1734  D USEFARY^C0XF2N(FARY)
     1740 ;
    17351741"RTN","C0SLAB",131,0)
    1736  D VOCINIT^C0XUTIL
     1742 D STARTADD^C0XF2N ; initialize to create triples
    17371743"RTN","C0SLAB",132,0)
    17381744 ;
    17391745"RTN","C0SLAB",133,0)
    1740  D STARTADD^C0XF2N ; initialize to create triples
     1746 N ZI S ZI=""
    17411747"RTN","C0SLAB",134,0)
    1742  ;
     1748 F  S ZI=$O(C0SARY("lab",ZI)) Q:ZI=""  D  ;
    17431749"RTN","C0SLAB",135,0)
    1744  N ZI S ZI=""
     1750 . N LRN,ZR ; ZR is the local array for building the new triples
    17451751"RTN","C0SLAB",136,0)
    1746  F  S ZI=$O(C0SARY("lab",ZI)) Q:ZI=""  D  ;
     1752 . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result
    17471753"RTN","C0SLAB",137,0)
    1748  . N LRN,ZR ; ZR is the local array for building the new triples
     1754 . ;
    17491755"RTN","C0SLAB",138,0)
    1750  . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result
     1756 . N RSLTID ; unique Id for this lab result
    17511757"RTN","C0SLAB",139,0)
     1758 . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
     1759"RTN","C0SLAB",140,0)
    17521760 . ;
    1753 "RTN","C0SLAB",140,0)
    1754  . N RSLTID ; unique Id for this lab result
    17551761"RTN","C0SLAB",141,0)
    1756  . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
     1762 . ; i don't like this because the same labs result gets a
    17571763"RTN","C0SLAB",142,0)
     1764 . ; different ID every time it's reported. Can't trace it back to VistA
     1765"RTN","C0SLAB",143,0)
     1766 . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003"
     1767"RTN","C0SLAB",144,0)
     1768 . ; .. either that or store an OID with the lab result - but that
     1769"RTN","C0SLAB",145,0)
     1770 . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012
     1771"RTN","C0SLAB",146,0)
    17581772 . ;
    1759 "RTN","C0SLAB",143,0)
    1760  . ; i don't like this because the same labs result gets a
    1761 "RTN","C0SLAB",144,0)
    1762  . ; different ID every time it's reported. Can't trace it back to VistA
    1763 "RTN","C0SLAB",145,0)
    1764  . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003"
    1765 "RTN","C0SLAB",146,0)
    1766  . ; .. either that or store an OID with the lab result - but that
    17671773"RTN","C0SLAB",147,0)
    1768  . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012
     1774 . N LOINC S LOINC=$G(@LRN@("loinc@value"))
    17691775"RTN","C0SLAB",148,0)
     1776 . I LOINC="" D  Q  ;
     1777"RTN","C0SLAB",149,0)
     1778 . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING"
     1779"RTN","C0SLAB",150,0)
     1780 . N LABTST S LABTST=$G(@LRN@("test@value"))
     1781"RTN","C0SLAB",151,0)
     1782 . I $D(DEBUG) D  ;
     1783"RTN","C0SLAB",152,0)
     1784 . . W !,"Processing Lab Result ",RSLTID
     1785"RTN","C0SLAB",153,0)
     1786 . . W !,"test: ",LABTST
     1787"RTN","C0SLAB",154,0)
     1788 . . W !,"loinc: ",LOINC
     1789"RTN","C0SLAB",155,0)
    17701790 . ;
    1771 "RTN","C0SLAB",149,0)
    1772  . N LOINC S LOINC=$G(@LRN@("loinc@value"))
    1773 "RTN","C0SLAB",150,0)
    1774  . I LOINC="" D  Q  ;
    1775 "RTN","C0SLAB",151,0)
    1776  . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING"
    1777 "RTN","C0SLAB",152,0)
    1778  . N LABTST S LABTST=$G(@LRN@("test@value"))
    1779 "RTN","C0SLAB",153,0)
    1780  . I $D(DEBUG) D  ;
    1781 "RTN","C0SLAB",154,0)
    1782  . . W !,"Processing Lab Result ",RSLTID
    1783 "RTN","C0SLAB",155,0)
    1784  . . W !,"test: ",LABTST
    17851791"RTN","C0SLAB",156,0)
    1786  . . W !,"loinc: ",LOINC
     1792 . ; first do the base result graph
    17871793"RTN","C0SLAB",157,0)
    17881794 . ;
    17891795"RTN","C0SLAB",158,0)
    1790  . ; first do the base result graph
     1796 . S ZR("rdf:type")="sp:LabResult"
    17911797"RTN","C0SLAB",159,0)
     1798 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results
     1799"RTN","C0SLAB",160,0)
     1800 . ; ie /vista/smart/99912345/lab_results
     1801"RTN","C0SLAB",161,0)
    17921802 . ;
    1793 "RTN","C0SLAB",160,0)
    1794  . S ZR("rdf:type")="sp:LabResult"
    1795 "RTN","C0SLAB",161,0)
    1796  . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results
    17971803"RTN","C0SLAB",162,0)
    1798  . ; ie /vista/smart/99912345/lab_results
     1804 . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name
    17991805"RTN","C0SLAB",163,0)
     1806 . S ZR("sp:labName")=LABNAME
     1807"RTN","C0SLAB",164,0)
    18001808 . ;
    1801 "RTN","C0SLAB",164,0)
    1802  . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name
    18031809"RTN","C0SLAB",165,0)
    1804  . S ZR("sp:labName")=LABNAME
     1810 . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result
    18051811"RTN","C0SLAB",166,0)
     1812 . S ZR("sp:narrativeResult")=NARRSLT
     1813"RTN","C0SLAB",167,0)
    18061814 . ;
    1807 "RTN","C0SLAB",167,0)
    1808  . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result
    18091815"RTN","C0SLAB",168,0)
    1810  . S ZR("sp:narrativeResult")=NARRSLT
     1816 . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result
    18111817"RTN","C0SLAB",169,0)
     1818 . S ZR("sp:quantitativeResult")=QNTRSLT
     1819"RTN","C0SLAB",170,0)
    18121820 . ;
    1813 "RTN","C0SLAB",170,0)
    1814  . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result
    18151821"RTN","C0SLAB",171,0)
    1816  . S ZR("sp:quantitativeResult")=QNTRSLT
     1822 . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected
    18171823"RTN","C0SLAB",172,0)
     1824 . S ZR("sp:specimenCollected")=SPECCOLL
     1825"RTN","C0SLAB",173,0)
    18181826 . ;
    1819 "RTN","C0SLAB",173,0)
    1820  . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected
    18211827"RTN","C0SLAB",174,0)
    1822  . S ZR("sp:specimenCollected")=SPECCOLL
     1828 . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples
    18231829"RTN","C0SLAB",175,0)
     1830 . K ZR ; clean up
     1831"RTN","C0SLAB",176,0)
    18241832 . ;
    1825 "RTN","C0SLAB",176,0)
    1826  . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples
    18271833"RTN","C0SLAB",177,0)
    1828  . K ZR ; clean up
     1834 . ; create the narrative result graph
    18291835"RTN","C0SLAB",178,0)
    18301836 . ;
    18311837"RTN","C0SLAB",179,0)
    1832  . ; create the narrative result graph
     1838 . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D  ; H OR L
    18331839"RTN","C0SLAB",180,0)
     1840 . I IVAL'=""
     1841"RTN","C0SLAB",181,0)
     1842 . . S ZR("rdf:type")="sp:NarrativeResult"
     1843"RTN","C0SLAB",182,0)
     1844 . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L
     1845"RTN","C0SLAB",183,0)
     1846 . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal"
     1847"RTN","C0SLAB",184,0)
     1848 . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal"
     1849"RTN","C0SLAB",185,0)
     1850 . . I ZR("sp:value")="HH" S ZR("sp:value")="critical"
     1851"RTN","C0SLAB",186,0)
     1852 . . I ZR("sp:value")="LL" S ZR("sp:value")="critical"
     1853"RTN","C0SLAB",187,0)
     1854 . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR)
     1855"RTN","C0SLAB",188,0)
     1856 . . K ZR
     1857"RTN","C0SLAB",189,0)
    18341858 . ;
    1835 "RTN","C0SLAB",181,0)
    1836  . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D  ; H OR L
    1837 "RTN","C0SLAB",182,0)
    1838  . I IVAL'=""
    1839 "RTN","C0SLAB",183,0)
    1840  . . S ZR("rdf:type")="sp:NarrativeResult"
    1841 "RTN","C0SLAB",184,0)
    1842  . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L
    1843 "RTN","C0SLAB",185,0)
    1844  . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal"
    1845 "RTN","C0SLAB",186,0)
    1846  . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal"
    1847 "RTN","C0SLAB",187,0)
    1848  . . I ZR("sp:value")="HH" S ZR("sp:value")="critical"
    1849 "RTN","C0SLAB",188,0)
    1850  . . I ZR("sp:value")="LL" S ZR("sp:value")="critical"
    1851 "RTN","C0SLAB",189,0)
    1852  . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR)
    18531859"RTN","C0SLAB",190,0)
    1854  . . K ZR
     1860 . ; create the quantitative result graph
    18551861"RTN","C0SLAB",191,0)
     1862 . ;
     1863"RTN","C0SLAB",192,0)
     1864 . S ZR("rdf:type")="sp:QuantitativeResult"
     1865"RTN","C0SLAB",193,0)
     1866 . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph
     1867"RTN","C0SLAB",194,0)
     1868 . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph
     1869"RTN","C0SLAB",195,0)
     1870 . N HASNORMAL S HASNORMAL=0
     1871"RTN","C0SLAB",196,0)
     1872 . I $G(@LRN@("high@value"))'="" S HASNORMAL=1
     1873"RTN","C0SLAB",197,0)
     1874 . I HASNORMAL S ZR("sp:normalRange")=NORMNM
     1875"RTN","C0SLAB",198,0)
     1876 . S ZR("sp:valueAndUnit")=VUNM
     1877"RTN","C0SLAB",199,0)
     1878 . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR)
     1879"RTN","C0SLAB",200,0)
     1880 . K ZR
     1881"RTN","C0SLAB",201,0)
    18561882 . ;
    1857 "RTN","C0SLAB",192,0)
    1858  . ; create the quantitative result graph
    1859 "RTN","C0SLAB",193,0)
    1860  . ;
    1861 "RTN","C0SLAB",194,0)
    1862  . S ZR("rdf:type")="sp:QuantitativeResult"
    1863 "RTN","C0SLAB",195,0)
    1864  . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph
    1865 "RTN","C0SLAB",196,0)
    1866  . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph
    1867 "RTN","C0SLAB",197,0)
    1868  . N HASNORMAL S HASNORMAL=0
    1869 "RTN","C0SLAB",198,0)
    1870  . I $G(@LRN@("high@value"))'="" S HASNORMAL=1
    1871 "RTN","C0SLAB",199,0)
    1872  . I HASNORMAL S ZR("sp:normalRange")=NORMNM
    1873 "RTN","C0SLAB",200,0)
    1874  . S ZR("sp:valueAndUnit")=VUNM
    1875 "RTN","C0SLAB",201,0)
    1876  . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR)
    18771883"RTN","C0SLAB",202,0)
    1878  . K ZR
     1884 . ; create the normal range graph
    18791885"RTN","C0SLAB",203,0)
    18801886 . ;
    18811887"RTN","C0SLAB",204,0)
    1882  . ; create the normal range graph
     1888 . I HASNORMAL D  ;
    18831889"RTN","C0SLAB",205,0)
     1890 . . S ZR("rdf:type")="sp:ValueRange"
     1891"RTN","C0SLAB",206,0)
     1892 . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph
     1893"RTN","C0SLAB",207,0)
     1894 . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph
     1895"RTN","C0SLAB",208,0)
     1896 . . S ZR("sp:maximum")=MAXNM
     1897"RTN","C0SLAB",209,0)
     1898 . . S ZR("sp:minimum")=MINNM
     1899"RTN","C0SLAB",210,0)
     1900 . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR)
     1901"RTN","C0SLAB",211,0)
     1902 . . K ZR
     1903"RTN","C0SLAB",212,0)
     1904 . . ;
     1905"RTN","C0SLAB",213,0)
     1906 . . ; create the maximum graph
     1907"RTN","C0SLAB",214,0)
     1908 . . ;
     1909"RTN","C0SLAB",215,0)
     1910 . . S ZR("rdf:type")="sp:ValueAndUnit"
     1911"RTN","C0SLAB",216,0)
     1912 . . S ZR("sp:unit")=$G(@LRN@("units@value"))
     1913"RTN","C0SLAB",217,0)
     1914 . . S ZR("sp:value")=$G(@LRN@("high@value"))
     1915"RTN","C0SLAB",218,0)
     1916 . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR)
     1917"RTN","C0SLAB",219,0)
     1918 . . K ZR
     1919"RTN","C0SLAB",220,0)
     1920 . . ;
     1921"RTN","C0SLAB",221,0)
     1922 . . ; create the minimum graph
     1923"RTN","C0SLAB",222,0)
     1924 . . ;
     1925"RTN","C0SLAB",223,0)
     1926 . . S ZR("rdf:type")="sp:ValueAndUnit"
     1927"RTN","C0SLAB",224,0)
     1928 . . S ZR("sp:unit")=$G(@LRN@("units@value"))
     1929"RTN","C0SLAB",225,0)
     1930 . . S ZR("sp:value")=$G(@LRN@("low@value"))
     1931"RTN","C0SLAB",226,0)
     1932 . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR)
     1933"RTN","C0SLAB",227,0)
     1934 . . K ZR
     1935"RTN","C0SLAB",228,0)
    18841936 . ;
    1885 "RTN","C0SLAB",206,0)
    1886  . I HASNORMAL D  ;
    1887 "RTN","C0SLAB",207,0)
    1888  . . S ZR("rdf:type")="sp:ValueRange"
    1889 "RTN","C0SLAB",208,0)
    1890  . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph
    1891 "RTN","C0SLAB",209,0)
    1892  . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph
    1893 "RTN","C0SLAB",210,0)
    1894  . . S ZR("sp:maximum")=MAXNM
    1895 "RTN","C0SLAB",211,0)
    1896  . . S ZR("sp:minimum")=MINNM
    1897 "RTN","C0SLAB",212,0)
    1898  . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR)
    1899 "RTN","C0SLAB",213,0)
    1900  . . K ZR
    1901 "RTN","C0SLAB",214,0)
    1902  . . ;
    1903 "RTN","C0SLAB",215,0)
    1904  . . ; create the maximum graph
    1905 "RTN","C0SLAB",216,0)
    1906  . . ;
    1907 "RTN","C0SLAB",217,0)
    1908  . . S ZR("rdf:type")="sp:ValueAndUnit"
    1909 "RTN","C0SLAB",218,0)
    1910  . . S ZR("sp:unit")=$G(@LRN@("units@value"))
    1911 "RTN","C0SLAB",219,0)
    1912  . . S ZR("sp:value")=$G(@LRN@("high@value"))
    1913 "RTN","C0SLAB",220,0)
    1914  . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR)
    1915 "RTN","C0SLAB",221,0)
    1916  . . K ZR
    1917 "RTN","C0SLAB",222,0)
    1918  . . ;
    1919 "RTN","C0SLAB",223,0)
    1920  . . ; create the minimum graph
    1921 "RTN","C0SLAB",224,0)
    1922  . . ;
    1923 "RTN","C0SLAB",225,0)
    1924  . . S ZR("rdf:type")="sp:ValueAndUnit"
    1925 "RTN","C0SLAB",226,0)
    1926  . . S ZR("sp:unit")=$G(@LRN@("units@value"))
    1927 "RTN","C0SLAB",227,0)
    1928  . . S ZR("sp:value")=$G(@LRN@("low@value"))
    1929 "RTN","C0SLAB",228,0)
    1930  . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR)
    19311937"RTN","C0SLAB",229,0)
    1932  . . K ZR
     1938 . ; create the value and unit graph
    19331939"RTN","C0SLAB",230,0)
    19341940 . ;
    19351941"RTN","C0SLAB",231,0)
    1936  . ; create the value and unit graph
     1942 . S ZR("rdf:type")="sp:ValueAndUnit"
    19371943"RTN","C0SLAB",232,0)
     1944 . S ZR("sp:unit")=$G(@LRN@("units@value"))
     1945"RTN","C0SLAB",233,0)
     1946 . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ; was $G(@LRN@("test@value")) gpl
     1947"RTN","C0SLAB",234,0)
     1948 . S ZR("sp:value")=$G(@LRN@("result@value"))
     1949"RTN","C0SLAB",235,0)
     1950 . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR)
     1951"RTN","C0SLAB",236,0)
     1952 . K ZR
     1953"RTN","C0SLAB",237,0)
    19381954 . ;
    1939 "RTN","C0SLAB",233,0)
    1940  . S ZR("rdf:type")="sp:ValueAndUnit"
    1941 "RTN","C0SLAB",234,0)
    1942  . S ZR("sp:unit")=$G(@LRN@("units@value"))
    1943 "RTN","C0SLAB",235,0)
    1944  . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ; was $G(@LRN@("test@value")) gpl
    1945 "RTN","C0SLAB",236,0)
    1946  . S ZR("sp:value")=$G(@LRN@("result@value"))
    1947 "RTN","C0SLAB",237,0)
    1948  . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR)
    19491955"RTN","C0SLAB",238,0)
     1956 . ; create specimen collected graph
     1957"RTN","C0SLAB",239,0)
     1958 . ;
     1959"RTN","C0SLAB",240,0)
     1960 . S ZR("rdf:type")="sp:Attribution"
     1961"RTN","C0SLAB",241,0)
     1962 . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value")))
     1963"RTN","C0SLAB",242,0)
     1964 . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR)
     1965"RTN","C0SLAB",243,0)
    19501966 . K ZR
    1951 "RTN","C0SLAB",239,0)
     1967"RTN","C0SLAB",244,0)
    19521968 . ;
    1953 "RTN","C0SLAB",240,0)
    1954  . ; create specimen collected graph
    1955 "RTN","C0SLAB",241,0)
    1956  . ;
    1957 "RTN","C0SLAB",242,0)
    1958  . S ZR("rdf:type")="sp:Attribution"
    1959 "RTN","C0SLAB",243,0)
    1960  . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value")))
    1961 "RTN","C0SLAB",244,0)
    1962  . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR)
    19631969"RTN","C0SLAB",245,0)
    1964  . K ZR
     1970 . ; create lab name graph - this contains the test name and code
    19651971"RTN","C0SLAB",246,0)
    19661972 . ;
    19671973"RTN","C0SLAB",247,0)
    1968  . ; create lab name graph - this contains the test name and code
     1974 . I LOINC'="" D  ;
    19691975"RTN","C0SLAB",248,0)
     1976 . . S ZR("rdf:type")="sp:CodedValue"
     1977"RTN","C0SLAB",249,0)
     1978 . . S ZR("dcterms:title")=LABTST
     1979"RTN","C0SLAB",250,0)
     1980 . . N LOINCNM S LOINCNM="loinc:"_LOINC
     1981"RTN","C0SLAB",251,0)
     1982 . . S ZR("sp:code")="loinc:"_LOINC
     1983"RTN","C0SLAB",252,0)
     1984 . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR)
     1985"RTN","C0SLAB",253,0)
     1986 . . K ZR
     1987"RTN","C0SLAB",254,0)
     1988 . . S ZR("dcterms:identifier")=LOINC
     1989"RTN","C0SLAB",255,0)
     1990 . . S ZR("dcterms:title")=LABTST
     1991"RTN","C0SLAB",256,0)
     1992 . . S ZR("rdf:type")="sp:Code"
     1993"RTN","C0SLAB",257,0)
     1994 . . S ZR("sp:system")="http://loinc.org/codes/"
     1995"RTN","C0SLAB",258,0)
     1996 . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR)
     1997"RTN","C0SLAB",259,0)
     1998 . . K ZR
     1999"RTN","C0SLAB",260,0)
    19702000 . ;
    1971 "RTN","C0SLAB",249,0)
    1972  . I LOINC'="" D  ;
    1973 "RTN","C0SLAB",250,0)
    1974  . . S ZR("rdf:type")="sp:CodedValue"
    1975 "RTN","C0SLAB",251,0)
    1976  . . S ZR("dcterms:title")=LABTST
    1977 "RTN","C0SLAB",252,0)
    1978  . . N LOINCNM S LOINCNM="loinc:"_LOINC
    1979 "RTN","C0SLAB",253,0)
    1980  . . S ZR("sp:code")="loinc:"_LOINC
    1981 "RTN","C0SLAB",254,0)
    1982  . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR)
    1983 "RTN","C0SLAB",255,0)
    1984  . . K ZR
    1985 "RTN","C0SLAB",256,0)
    1986  . . S ZR("dcterms:identifier")=LOINC
    1987 "RTN","C0SLAB",257,0)
    1988  . . S ZR("dcterms:title")=LABTST
    1989 "RTN","C0SLAB",258,0)
    1990  . . S ZR("rdf:type")="sp:Code"
    1991 "RTN","C0SLAB",259,0)
    1992  . . S ZR("sp:system")="http://loinc.org/codes/"
    1993 "RTN","C0SLAB",260,0)
    1994  . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR)
    19952001"RTN","C0SLAB",261,0)
    1996  . . K ZR
     2002 . ; that's all for now folks (there is more to do like reference ranges
    19972003"RTN","C0SLAB",262,0)
     2004 . ; and result values)
     2005"RTN","C0SLAB",263,0)
    19982006 . ;
    1999 "RTN","C0SLAB",263,0)
    2000  . ; that's all for now folks (there is more to do like reference ranges
    20012007"RTN","C0SLAB",264,0)
    2002  . ; and result values)
     2008 D BULKLOAD^C0XF2N(.C0XFDA)
    20032009"RTN","C0SLAB",265,0)
    2004  . ;
     2010 S GRTN=C0SGRF
    20052011"RTN","C0SLAB",266,0)
    2006  D BULKLOAD^C0XF2N(.C0XFDA)
     2012 Q
    20072013"RTN","C0SLAB",267,0)
    2008  S GRTN=C0SGRF
     2014 ;
    20092015"RTN","C0SLAB",268,0)
    2010  Q
     2016SAMPLE ; import sample lab tests to the triplestore
    20112017"RTN","C0SLAB",269,0)
    2012  ;
     2018 N GN
    20132019"RTN","C0SLAB",270,0)
    2014 SAMPLE ; import sample lab tests to the triplestore
     2020 S GN=$NA(^rdf("lab_results"))
    20152021"RTN","C0SLAB",271,0)
    2016  N GN
     2022 D INSRDF^C0XF2N(GN,"/smart/lab/samples")
    20172023"RTN","C0SLAB",272,0)
    2018  S GN=$NA(^rdf("lab_results"))
     2024 Q
    20192025"RTN","C0SLAB",273,0)
    2020  D INSRDF^C0XF2N(GN,"/smart/lab/samples")
    2021 "RTN","C0SLAB",274,0)
    2022  Q
    2023 "RTN","C0SLAB",275,0)
    20242026 ;
    20252027"RTN","C0SMART")
    2026 0^4^B2907401
     20280^4^B2814519
    20272029"RTN","C0SMART",1,0)
    20282030C0SMART   ; GPL - Smart Container Entry Points;2/22/12  17:05
    20292031"RTN","C0SMART",2,0)
    2030  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     2032 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    20312033"RTN","C0SMART",3,0)
    2032  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     2034 ;Copyright 2012 George Lilly. 
    20332035"RTN","C0SMART",4,0)
    2034  ;General Public License See attached copy of the License.
     2036 ;
    20352037"RTN","C0SMART",5,0)
    2036  ;
     2038 ; This program is free software: you can redistribute it and/or modify
    20372039"RTN","C0SMART",6,0)
    2038  ;This program is free software; you can redistribute it and/or modify
     2040 ; it under the terms of the GNU Affero General Public License as
    20392041"RTN","C0SMART",7,0)
    2040  ;it under the terms of the GNU General Public License as published by
     2042 ; published by the Free Software Foundation, either version 3 of the
    20412043"RTN","C0SMART",8,0)
    2042  ;the Free Software Foundation; either version 2 of the License, or
     2044 ; License, or (at your option) any later version.
    20432045"RTN","C0SMART",9,0)
    2044  ;(at your option) any later version.
     2046 ;
    20452047"RTN","C0SMART",10,0)
    2046  ;
     2048 ; This program is distributed in the hope that it will be useful,
    20472049"RTN","C0SMART",11,0)
    2048  ;This program is distributed in the hope that it will be useful,
     2050 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    20492051"RTN","C0SMART",12,0)
    2050  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     2052 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    20512053"RTN","C0SMART",13,0)
    2052  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     2054 ; GNU Affero General Public License for more details.
    20532055"RTN","C0SMART",14,0)
    2054  ;GNU General Public License for more details.
     2056 ;
    20552057"RTN","C0SMART",15,0)
    2056  ;
     2058 ; You should have received a copy of the GNU Affero General Public License
    20572059"RTN","C0SMART",16,0)
    2058  ;You should have received a copy of the GNU General Public License along
     2060 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    20592061"RTN","C0SMART",17,0)
    2060  ;with this program; if not, write to the Free Software Foundation, Inc.,
     2062 ;
    20612063"RTN","C0SMART",18,0)
    2062  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     2064 Q
    20632065"RTN","C0SMART",19,0)
    2064  ;
     2066EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP
    20652067"RTN","C0SMART",20,0)
    2066  Q
     2068 ;  for patient ZPATID; ZFORM defaults to rdf
    20672069"RTN","C0SMART",21,0)
    2068 EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP
     2070 ; ZRTN is passed by reference
    20692071"RTN","C0SMART",22,0)
    2070  ;  for patient ZPATID; ZFORM defaults to rdf
     2072 ; For now, ZPATID is the DFN
    20712073"RTN","C0SMART",23,0)
    2072  ; ZRTN is passed by reference
     2074 ;
    20732075"RTN","C0SMART",24,0)
    2074  ; For now, ZPATID is the DFN
     2076 I '$D(ZFORM) S ZFORM="rdf"
    20752077"RTN","C0SMART",25,0)
    2076  ;
     2078 K ZRTN ; CLEAN RETURN
    20772079"RTN","C0SMART",26,0)
    2078  I '$D(ZFORM) S ZFORM="rdf"
     2080 N C0SARY
    20792081"RTN","C0SMART",27,0)
    2080  K ZRTN ; CLEAN RETURN
     2082 I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient")
    20812083"RTN","C0SMART",28,0)
    2082  N C0SARY
     2084 E  D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP)
    20832085"RTN","C0SMART",29,0)
    2084  I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient")
     2086 I $G(C0SARY("patient",1,"id@value"))'=ZPATID D  Q  ;
    20852087"RTN","C0SMART",30,0)
    2086  E  D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP)
     2088 . W !,"Error Retreiving Patient Record"
    20872089"RTN","C0SMART",31,0)
    2088  I $G(C0SARY("patient",1,"id@value"))'=ZPATID D  Q  ;
     2090 ;
    20892091"RTN","C0SMART",32,0)
    2090  . W !,"Error Retreiving Patient Record"
     2092 K C0XFDA
    20912093"RTN","C0SMART",33,0)
    20922094 ;
    20932095"RTN","C0SMART",34,0)
    2094  K C0XFDA
     2096 N C0SGR ; graph
    20952097"RTN","C0SMART",35,0)
    20962098 ;
    20972099"RTN","C0SMART",36,0)
    2098  N C0SGR ; graph
     2100 ; processing table
    20992101"RTN","C0SMART",37,0)
    21002102 ;
    21012103"RTN","C0SMART",38,0)
    2102  ; processing table
     2104 N C0SCTRL
    21032105"RTN","C0SMART",39,0)
    2104  ;
     2106 S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)"
    21052107"RTN","C0SMART",40,0)
    2106  N C0SCTRL
     2108 S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)"
    21072109"RTN","C0SMART",41,0)
    2108  S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)"
     2110 S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)"
    21092111"RTN","C0SMART",42,0)
    2110  S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)"
     2112 S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)"
    21112113"RTN","C0SMART",43,0)
    2112  S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)"
     2114 ;
    21132115"RTN","C0SMART",44,0)
    2114  S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)"
     2116 I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q  ;
    21152117"RTN","C0SMART",45,0)
    2116  ;
     2118 N ZX
    21172119"RTN","C0SMART",46,0)
    2118  I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q  ;
     2120 S ZX=C0SCTRL(ZTYP)
    21192121"RTN","C0SMART",47,0)
    2120  N ZX
     2122 X ZX ;
    21212123"RTN","C0SMART",48,0)
    2122  S ZX=C0SCTRL(ZTYP)
     2124 ;
    21232125"RTN","C0SMART",49,0)
    2124  X ZX ;
     2126 I '$D(C0SGR) Q  ;
    21252127"RTN","C0SMART",50,0)
    21262128 ;
    21272129"RTN","C0SMART",51,0)
    2128  I '$D(C0SGR) Q  ;
     2130 D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM)
    21292131"RTN","C0SMART",52,0)
    21302132 ;
    21312133"RTN","C0SMART",53,0)
    2132  D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM)
     2134 Q
    21332135"RTN","C0SMART",54,0)
    21342136 ;
    2135 "RTN","C0SMART",55,0)
    2136  Q
    2137 "RTN","C0SMART",56,0)
    2138  ;
    21392137"RTN","C0SMED")
    2140 0^5^B40719083
     21380^5^B40022947
    21412139"RTN","C0SMED",1,0)
    21422140C0SMED   ; GPL - Smart Meds Processing ;2/22/12  17:05
    21432141"RTN","C0SMED",2,0)
    2144  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     2142 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    21452143"RTN","C0SMED",3,0)
    2146  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     2144 ;Copyright 2012 George Lilly. 
    21472145"RTN","C0SMED",4,0)
    2148  ;General Public License See attached copy of the License.
     2146 ;
    21492147"RTN","C0SMED",5,0)
    2150  ;
     2148 ; This program is free software: you can redistribute it and/or modify
    21512149"RTN","C0SMED",6,0)
    2152  ;This program is free software; you can redistribute it and/or modify
     2150 ; it under the terms of the GNU Affero General Public License as
    21532151"RTN","C0SMED",7,0)
    2154  ;it under the terms of the GNU General Public License as published by
     2152 ; published by the Free Software Foundation, either version 3 of the
    21552153"RTN","C0SMED",8,0)
    2156  ;the Free Software Foundation; either version 2 of the License, or
     2154 ; License, or (at your option) any later version.
    21572155"RTN","C0SMED",9,0)
    2158  ;(at your option) any later version.
     2156 ;
    21592157"RTN","C0SMED",10,0)
    2160  ;
     2158 ; This program is distributed in the hope that it will be useful,
    21612159"RTN","C0SMED",11,0)
    2162  ;This program is distributed in the hope that it will be useful,
     2160 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    21632161"RTN","C0SMED",12,0)
    2164  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     2162 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    21652163"RTN","C0SMED",13,0)
    2166  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     2164 ; GNU Affero General Public License for more details.
    21672165"RTN","C0SMED",14,0)
    2168  ;GNU General Public License for more details.
     2166 ;
    21692167"RTN","C0SMED",15,0)
    2170  ;
     2168 ; You should have received a copy of the GNU Affero General Public License
    21712169"RTN","C0SMED",16,0)
    2172  ;You should have received a copy of the GNU General Public License along
     2170 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    21732171"RTN","C0SMED",17,0)
    2174  ;with this program; if not, write to the Free Software Foundation, Inc.,
     2172 ;
    21752173"RTN","C0SMED",18,0)
    2176  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     2174 Q
    21772175"RTN","C0SMED",19,0)
    21782176 ;
    21792177"RTN","C0SMED",20,0)
    2180  Q
     2178MED(GRTN,C0SARY) ; GRTN, passed by reference,
    21812179"RTN","C0SMED",21,0)
    2182  ;
     2180 ; is the return name of the graph created. "" if none
    21832181"RTN","C0SMED",22,0)
    2184 MED(GRTN,C0SARY) ; GRTN, passed by reference,
     2182 ; C0SARY is passed in by reference and is the NHIN array of meds
    21852183"RTN","C0SMED",23,0)
    2186  ; is the return name of the graph created. "" if none
     2184 ;
    21872185"RTN","C0SMED",24,0)
    2188  ; C0SARY is passed in by reference and is the NHIN array of meds
     2186 I $O(C0SARY("med",""))="" D  Q  ;
    21892187"RTN","C0SMED",25,0)
    2190  ;
     2188 . I $D(DEBUG) W !,"No Meds"
    21912189"RTN","C0SMED",26,0)
    2192  I $O(C0SARY("med",""))="" D  Q  ;
     2190 S GRTN="" ; default to no meds
    21932191"RTN","C0SMED",27,0)
    2194  . I $D(DEBUG) W !,"No Meds"
     2192 N C0SGRF
    21952193"RTN","C0SMED",28,0)
    2196  S GRTN="" ; default to no meds
     2194 S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP
    21972195"RTN","C0SMED",29,0)
    2198  N C0SGRF
     2196 I $D(DEBUG) W !,"Processing ",C0SGRF
    21992197"RTN","C0SMED",30,0)
    2200  S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP
     2198 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
    22012199"RTN","C0SMED",31,0)
    2202  I $D(DEBUG) W !,"Processing ",C0SGRF
     2200 N MEDTRP ; MEDS TRIPLES
    22032201"RTN","C0SMED",32,0)
    2204  D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
     2202 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
    22052203"RTN","C0SMED",33,0)
    2206  N MEDTRP ; MEDS TRIPLES
     2204 N FARY S FARY="C0XFARY"
    22072205"RTN","C0SMED",34,0)
    2208  D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
     2206 D USEFARY^C0XF2N(FARY)
    22092207"RTN","C0SMED",35,0)
    2210  N FARY S FARY="C0XFARY"
     2208 D VOCINIT^C0XUTIL
    22112209"RTN","C0SMED",36,0)
    2212  D USEFARY^C0XF2N(FARY)
     2210 ;
    22132211"RTN","C0SMED",37,0)
    2214  D VOCINIT^C0XUTIL
     2212 N DUPCHK S DUPCHK="" ; check for no duplicates
    22152213"RTN","C0SMED",38,0)
    2216  ;
     2214 N ZI S ZI=""
    22172215"RTN","C0SMED",39,0)
    2218  N DUPCHK S DUPCHK="" ; check for no duplicates
     2216 F  S ZI=$O(C0SARY("med",ZI)) Q:ZI=""  D  ;
    22192217"RTN","C0SMED",40,0)
    2220  N ZI S ZI=""
     2218 . N SDATE,SDTMP
    22212219"RTN","C0SMED",41,0)
    2222  F  S ZI=$O(C0SARY("med",ZI)) Q:ZI=""  D  ;
     2220 . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D  Q  ;
    22232221"RTN","C0SMED",42,0)
    2224  . N SDATE,SDTMP
     2222 . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
    22252223"RTN","C0SMED",43,0)
    2226  . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D  Q  ;
     2224 . I $G(COSARY("med",ZI,"vaType@value"))="I" D  Q  ;
    22272225"RTN","C0SMED",44,0)
    2228  . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
     2226 . . I $D(DEBUG) W !,"Inpatient Med, skipping"
    22292227"RTN","C0SMED",45,0)
    2230  . I $G(COSARY("med",ZI,"vaType@value"))="I" D  Q  ;
     2228 . I $G(COSARY("med",ZI,"vaType@value"))="V" D  Q  ;
    22312229"RTN","C0SMED",46,0)
    2232  . . I $D(DEBUG) W !,"Inpatient Med, skipping"
     2230 . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
    22332231"RTN","C0SMED",47,0)
    2234  . I $G(COSARY("med",ZI,"vaType@value"))="V" D  Q  ;
     2232 . ;
    22352233"RTN","C0SMED",48,0)
    2236  . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
     2234 . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))
    22372235"RTN","C0SMED",49,0)
    2238  . ;
     2236 . I SDTMP="" D  ;
    22392237"RTN","C0SMED",50,0)
    2240  . S SDTMP=$G(C0SARY("med",ZI,"ordered@value"))
     2238 . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))
    22412239"RTN","C0SMED",51,0)
    2242  . I SDTMP="" D  ;
     2240 . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date
    22432241"RTN","C0SMED",52,0)
    2244  . . S SDTMP=$G(C0SARY("med",ZI,"start@value"))
     2242 . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens
    22452243"RTN","C0SMED",53,0)
    2246  . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date
     2244 . I SDATE="" S SDATE="UNKNOWN"
    22472245"RTN","C0SMED",54,0)
    2248  . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens
     2246 . N DNAME,VUID,DCODE,RXNORM,SIG
    22492247"RTN","C0SMED",55,0)
    2250  . I SDATE="" S SDATE="UNKNOWN"
     2248 . S DNAME=$G(C0SARY("med",ZI,"name@value"))
    22512249"RTN","C0SMED",56,0)
    2252  . N DNAME,VUID,DCODE,RXNORM,SIG
     2250 . I DNAME="" D  ;
    22532251"RTN","C0SMED",57,0)
    2254  . S DNAME=$G(C0SARY("med",ZI,"name@value"))
     2252 . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))
    22552253"RTN","C0SMED",58,0)
    2256  . I DNAME="" D  ;
     2254 . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))
    22572255"RTN","C0SMED",59,0)
    2258  . . S DNAME=$G(C0SARY("med",ZI,"products.product@name"))
     2256 . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))
    22592257"RTN","C0SMED",60,0)
    2260  . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid"))
     2258 . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))
    22612259"RTN","C0SMED",61,0)
    2262  . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code"))
     2260 . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code
    22632261"RTN","C0SMED",62,0)
    2264  . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value"))
     2262 . I $P(RXNORM,"^",2)="RXNORM" D  ;
    22652263"RTN","C0SMED",63,0)
    2266  . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code
     2264 . . S RXVER=$P(RXNORM,"^",3)
    22672265"RTN","C0SMED",64,0)
    2268  . I $P(RXNORM,"^",2)="RXNORM" D  ;
     2266 . . S RXNORM=$P(RXNORM,"^",1)
    22692267"RTN","C0SMED",65,0)
    2270  . . S RXVER=$P(RXNORM,"^",3)
     2268 . E  D  Q  ;
    22712269"RTN","C0SMED",66,0)
    2272  . . S RXNORM=$P(RXNORM,"^",1)
     2270 . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"
    22732271"RTN","C0SMED",67,0)
    2274  . E  D  Q  ;
     2272 . . I $D(DEBUG) W !,RXNORM
    22752273"RTN","C0SMED",68,0)
    2276  . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE"
     2274 . I DNAME="" D  Q  ;
    22772275"RTN","C0SMED",69,0)
    2278  . . I $D(DEBUG) W !,RXNORM
     2276 . . I $D(DEBUG) W !,"Error No Drug Name"
    22792277"RTN","C0SMED",70,0)
    2280  . I DNAME="" D  Q  ;
     2278 . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)
    22812279"RTN","C0SMED",71,0)
    2282  . . I $D(DEBUG) W !,"Error No Drug Name"
     2280 . I +$D(DUPCHK(MEDGRF)) D  Q  ; NO DUPS ALLOWED
    22832281"RTN","C0SMED",72,0)
    2284  . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP)
     2282 . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF
    22852283"RTN","C0SMED",73,0)
    2286  . I +$D(DUPCHK(MEDGRF)) D  Q  ; NO DUPS ALLOWED
     2284 . S DUPCHK(MEDGRF)=""
    22872285"RTN","C0SMED",74,0)
    2288  . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF
     2286 . I $D(DEBUG) D  ;
    22892287"RTN","C0SMED",75,0)
    2290  . S DUPCHK(MEDGRF)=""
     2288 . . W !,"Processing Medication ",MEDGRF
    22912289"RTN","C0SMED",76,0)
    2292  . I $D(DEBUG) D  ;
     2290 . . W !,DNAME
    22932291"RTN","C0SMED",77,0)
    2294  . . W !,"Processing Medication ",MEDGRF
     2292 . . W !,RXNORM
    22952293"RTN","C0SMED",78,0)
    2296  . . W !,DNAME
     2294 . S SIG=$G(C0SARY("med",ZI,"sig"))
    22972295"RTN","C0SMED",79,0)
    2298  . . W !,RXNORM
     2296 . I SIG["|" D  ;
    22992297"RTN","C0SMED",80,0)
    2300  . S SIG=$G(C0SARY("med",ZI,"sig"))
     2298 . . N SIGTMP
    23012299"RTN","C0SMED",81,0)
    2302  . I SIG["|" D  ;
     2300 . . S SIGTMP=SIG
    23032301"RTN","C0SMED",82,0)
    2304  . . N SIGTMP
     2302 . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig
    23052303"RTN","C0SMED",83,0)
    2306  . . S SIGTMP=SIG
     2304 . . I DNAME["FREE TXT" D  ; eRx free text drug, get drug name from sig
    23072305"RTN","C0SMED",84,0)
    2308  . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig
     2306 . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig
    23092307"RTN","C0SMED",85,0)
    2310  . . I DNAME["FREE TXT" D  ; eRx free text drug, get drug name from sig
     2308 . K C0XFARY
    23112309"RTN","C0SMED",86,0)
    2312  . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig
     2310 . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)
    23132311"RTN","C0SMED",87,0)
    2314  . K C0XFARY
     2312 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY)
    23152313"RTN","C0SMED",88,0)
    2316  . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY)
     2314 . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject
    23172315"RTN","C0SMED",89,0)
    2318  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY)
     2316 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)
    23192317"RTN","C0SMED",90,0)
    2320  . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject
     2318 . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)
    23212319"RTN","C0SMED",91,0)
    2322  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY)
     2320 . N NQTY,NQTY2,NFREQ,NFREQ2
    23232321"RTN","C0SMED",92,0)
    2324  . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY)
     2322 . S NQTY=$$ANONS^C0XF2N ; anonomous subject
    23252323"RTN","C0SMED",93,0)
    2326  . N NQTY,NQTY2,NFREQ,NFREQ2
     2324 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY)
    23272325"RTN","C0SMED",94,0)
    2328  . S NQTY=$$ANONS^C0XF2N ; anonomous subject
     2326 . S NQTY2=$$ANONS^C0XF2N ; anonomous subject
    23292327"RTN","C0SMED",95,0)
    2330  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY)
     2328 . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)
    23312329"RTN","C0SMED",96,0)
    2332  . S NQTY2=$$ANONS^C0XF2N ; anonomous subject
     2330 . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))
    23332331"RTN","C0SMED",97,0)
    2334  . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY)
     2332 . I DOSE="" S DOSE="UNKNOWN"
    23352333"RTN","C0SMED",98,0)
    2336  . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose"))
     2334 . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))
    23372335"RTN","C0SMED",99,0)
    2338  . I DOSE="" S DOSE="UNKNOWN"
     2336 . I UNIT="" S UNIT="UNKNOWN"
    23392337"RTN","C0SMED",100,0)
    2340  . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units"))
     2338 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)
    23412339"RTN","C0SMED",101,0)
    2342  . I UNIT="" S UNIT="UNKNOWN"
     2340 . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)
    23432341"RTN","C0SMED",102,0)
    2344  . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY)
     2342 . S NFREQ=$$ANONS^C0XF2N ; anonomous subject
    23452343"RTN","C0SMED",103,0)
    2346  . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY)
     2344 . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject
    23472345"RTN","C0SMED",104,0)
    2348  . S NFREQ=$$ANONS^C0XF2N ; anonomous subject
     2346 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)
    23492347"RTN","C0SMED",105,0)
    2350  . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject
     2348 . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)
    23512349"RTN","C0SMED",106,0)
    2352  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY)
     2350 . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))
    23532351"RTN","C0SMED",107,0)
    2354  . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY)
     2352 . I SCHED="" S SCHED="UNKNOWN"
    23552353"RTN","C0SMED",108,0)
    2356  . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule"))
     2354 . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))
    23572355"RTN","C0SMED",109,0)
    2358  . I SCHED="" S SCHED="UNKNOWN"
     2356 . I SCHUNIT="" S SCHUNIT="UNKNOWN"
    23592357"RTN","C0SMED",110,0)
    2360  . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route"))
     2358 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY)
    23612359"RTN","C0SMED",111,0)
    2362  . I SCHUNIT="" S SCHUNIT="UNKNOWN"
     2360 . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY)
    23632361"RTN","C0SMED",112,0)
    2364  . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY)
     2362 . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY)
    23652363"RTN","C0SMED",113,0)
    2366  . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY)
     2364 . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)
    23672365"RTN","C0SMED",114,0)
    2368  . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY)
     2366 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY)
    23692367"RTN","C0SMED",115,0)
    2370  . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY)
     2368 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY)
    23712369"RTN","C0SMED",116,0)
    2372  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY)
     2370 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)
    23732371"RTN","C0SMED",117,0)
    2374  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY)
     2372 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)
    23752373"RTN","C0SMED",118,0)
    2376  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY)
     2374 . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY)
    23772375"RTN","C0SMED",119,0)
    2378  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY)
     2376 . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)
    23792377"RTN","C0SMED",120,0)
    2380  . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY)
     2378 . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)
    23812379"RTN","C0SMED",121,0)
    2382  . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY)
     2380 . D BULKLOAD^C0XF2N(.C0XFDA)
    23832381"RTN","C0SMED",122,0)
    2384  . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY)
     2382 . K C0XFDA
    23852383"RTN","C0SMED",123,0)
    2386  . D BULKLOAD^C0XF2N(.C0XFDA)
     2384 S GRTN=C0SGRF
    23872385"RTN","C0SMED",124,0)
    2388  . K C0XFDA
     2386 q
    23892387"RTN","C0SMED",125,0)
    2390  S GRTN=C0SGRF
     2388 ;
    23912389"RTN","C0SMED",126,0)
    2392  q
     2390RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
    23932391"RTN","C0SMED",127,0)
    23942392 ;
    23952393"RTN","C0SMED",128,0)
    2396 RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
     2394RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
    23972395"RTN","C0SMED",129,0)
    2398  ;
     2396 ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
    23992397"RTN","C0SMED",130,0)
    2400 RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
     2398 N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
    24012399"RTN","C0SMED",131,0)
    2402  ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
     2400 I $G(ZVUID)="" Q ""
    24032401"RTN","C0SMED",132,0)
    2404  N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
     2402 I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
    24052403"RTN","C0SMED",133,0)
    2406  I $G(ZVUID)="" Q ""
     2404 N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
    24072405"RTN","C0SMED",134,0)
    2408  I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
     2406 S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
    24092407"RTN","C0SMED",135,0)
    2410  N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
     2408 N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
    24112409"RTN","C0SMED",136,0)
    2412  S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
     2410 S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
    24132411"RTN","C0SMED",137,0)
    2414  N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
     2412 I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
    24152413"RTN","C0SMED",138,0)
    2416  S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED
     2414 Q ZRSLT
    24172415"RTN","C0SMED",139,0)
    2418  I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
     2416 ;
    24192417"RTN","C0SMED",140,0)
    2420  Q ZRSLT
     2418NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
    24212419"RTN","C0SMED",141,0)
    2422  ;
     2420 ; CONFORM TO NIST REQUIREMENTS
    24232421"RTN","C0SMED",142,0)
    2424 NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO
     2422 ;INPATIENT CERTIFICATION
    24252423"RTN","C0SMED",143,0)
    2426  ; CONFORM TO NIST REQUIREMENTS
     2424 I ZRXN=309362 S ZRXN=213169
    24272425"RTN","C0SMED",144,0)
    2428  ;INPATIENT CERTIFICATION
     2426 I ZRXN=855318 S ZRXN=855320
    24292427"RTN","C0SMED",145,0)
    2430  I ZRXN=309362 S ZRXN=213169
     2428 I ZRXN=197361 S ZRXN=212549
    24312429"RTN","C0SMED",146,0)
    2432  I ZRXN=855318 S ZRXN=855320
     2430 ;OUTPATIENT CERTIFICATION
    24332431"RTN","C0SMED",147,0)
    2434  I ZRXN=197361 S ZRXN=212549
     2432 I ZRXN=310534 S ZRXN=205875
    24352433"RTN","C0SMED",148,0)
    2436  ;OUTPATIENT CERTIFICATION
     2434 I ZRXN=617312 S ZRXN=617314
    24372435"RTN","C0SMED",149,0)
    2438  I ZRXN=310534 S ZRXN=205875
     2436 I ZRXN=310429 S ZRXN=200801
    24392437"RTN","C0SMED",150,0)
    2440  I ZRXN=617312 S ZRXN=617314
     2438 I ZRXN=628953 S ZRXN=628958
    24412439"RTN","C0SMED",151,0)
    2442  I ZRXN=310429 S ZRXN=200801
     2440 I ZRXN=745679 S ZRXN=630208
    24432441"RTN","C0SMED",152,0)
    2444  I ZRXN=628953 S ZRXN=628958
     2442 I ZRXN=311564 S ZRXN=979334
    24452443"RTN","C0SMED",153,0)
    2446  I ZRXN=745679 S ZRXN=630208
     2444 I ZRXN=836343 S ZRXN=836370
    24472445"RTN","C0SMED",154,0)
    2448  I ZRXN=311564 S ZRXN=979334
     2446 Q ZRXN
    24492447"RTN","C0SMED",155,0)
    2450  I ZRXN=836343 S ZRXN=836370
    2451 "RTN","C0SMED",156,0)
    2452  Q ZRXN
    2453 "RTN","C0SMED",157,0)
    24542448 ;
    24552449"RTN","C0SMXMLB")
    2456 0^6^B12189644
     24500^6^B12331075
    24572451"RTN","C0SMXMLB",1,0)
    24582452MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09  16:55 - Smart Container Ver.
    24592453"RTN","C0SMXMLB",2,0)
    2460  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     2454 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    24612455"RTN","C0SMXMLB",3,0)
     2456 ; Public Domain
     2457"RTN","C0SMXMLB",4,0)
    24622458 QUIT
    2463 "RTN","C0SMXMLB",4,0)
    2464  ;
    24652459"RTN","C0SMXMLB",5,0)
     2460 ;
     2461"RTN","C0SMXMLB",6,0)
    24662462 ;DOC - The top level tag
    2467 "RTN","C0SMXMLB",6,0)
     2463"RTN","C0SMXMLB",7,0)
    24682464 ;DOCTYPE - Want to include a DOCTYPE node
    2469 "RTN","C0SMXMLB",7,0)
     2465"RTN","C0SMXMLB",8,0)
    24702466 ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
    2471 "RTN","C0SMXMLB",8,0)
     2467"RTN","C0SMXMLB",9,0)
    24722468START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
    2473 "RTN","C0SMXMLB",9,0)
     2469"RTN","C0SMXMLB",10,0)
    24742470 K ^TMP("MXMLBLD",$J)
    2475 "RTN","C0SMXMLB",10,0)
     2471"RTN","C0SMXMLB",11,0)
    24762472 S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
    2477 "RTN","C0SMXMLB",11,0)
     2473"RTN","C0SMXMLB",12,0)
    24782474 I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
    2479 "RTN","C0SMXMLB",12,0)
     2475"RTN","C0SMXMLB",13,0)
    24802476 I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
    2481 "RTN","C0SMXMLB",13,0)
     2477"RTN","C0SMXMLB",14,0)
    24822478 D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
    2483 "RTN","C0SMXMLB",14,0)
    2484  Q
    24852479"RTN","C0SMXMLB",15,0)
    2486  ;
     2480 Q
    24872481"RTN","C0SMXMLB",16,0)
     2482 ;
     2483"RTN","C0SMXMLB",17,0)
    24882484END ;Call this once to close out the document
    2489 "RTN","C0SMXMLB",17,0)
     2485"RTN","C0SMXMLB",18,0)
    24902486 D OUTPUT("</"_$G(^TMP("MXMLBLD",$J,"DOC"))_">")
    2491 "RTN","C0SMXMLB",18,0)
     2487"RTN","C0SMXMLB",19,0)
    24922488 I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J)
    2493 "RTN","C0SMXMLB",19,0)
     2489"RTN","C0SMXMLB",20,0)
    24942490 K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK")
    2495 "RTN","C0SMXMLB",20,0)
    2496  Q
    24972491"RTN","C0SMXMLB",21,0)
    2498  ;
     2492 Q
    24992493"RTN","C0SMXMLB",22,0)
     2494 ;
     2495"RTN","C0SMXMLB",23,0)
    25002496ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item
    2501 "RTN","C0SMXMLB",23,0)
     2497"RTN","C0SMXMLB",24,0)
    25022498 N I,X
    2503 "RTN","C0SMXMLB",24,0)
     2499"RTN","C0SMXMLB",25,0)
    25042500 S ATT=$G(ATT)
    2505 "RTN","C0SMXMLB",25,0)
     2501"RTN","C0SMXMLB",26,0)
    25062502 I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q
    2507 "RTN","C0SMXMLB",26,0)
     2503"RTN","C0SMXMLB",27,0)
    25082504 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"</"_TAG_">")
    2509 "RTN","C0SMXMLB",27,0)
    2510  Q
    25112505"RTN","C0SMXMLB",28,0)
     2506 Q
     2507"RTN","C0SMXMLB",29,0)
    25122508 ;DOITEM is a callback to output the lower level.
    2513 "RTN","C0SMXMLB",29,0)
     2509"RTN","C0SMXMLB",30,0)
    25142510MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule
    2515 "RTN","C0SMXMLB",30,0)
     2511"RTN","C0SMXMLB",31,0)
    25162512 N I,X,S
    2517 "RTN","C0SMXMLB",31,0)
     2513"RTN","C0SMXMLB",32,0)
    25182514 S ATT=$G(ATT)
    2519 "RTN","C0SMXMLB",32,0)
     2515"RTN","C0SMXMLB",33,0)
    25202516 D PUSH($G(INDENT),TAG,.ATT)
    2521 "RTN","C0SMXMLB",33,0)
     2517"RTN","C0SMXMLB",34,0)
    25222518 D @DOITEM
    2523 "RTN","C0SMXMLB",34,0)
     2519"RTN","C0SMXMLB",35,0)
    25242520 D POP
    2525 "RTN","C0SMXMLB",35,0)
    2526  Q
    25272521"RTN","C0SMXMLB",36,0)
    2528  ;
     2522 Q
    25292523"RTN","C0SMXMLB",37,0)
     2524 ;
     2525"RTN","C0SMXMLB",38,0)
    25302526ATT(ATT) ;Output a string of attributes
    2531 "RTN","C0SMXMLB",38,0)
     2527"RTN","C0SMXMLB",39,0)
    25322528 I $D(ATT)<9 Q ""
    2533 "RTN","C0SMXMLB",39,0)
     2529"RTN","C0SMXMLB",40,0)
    25342530 N I,S,V
    2535 "RTN","C0SMXMLB",40,0)
     2531"RTN","C0SMXMLB",41,0)
    25362532 S S="",I=""
    2537 "RTN","C0SMXMLB",41,0)
     2533"RTN","C0SMXMLB",42,0)
    25382534 F  S I=$O(ATT(I)) Q:I=""  S S=S_" "_I_"="_$$Q(ATT(I))
    2539 "RTN","C0SMXMLB",42,0)
     2535"RTN","C0SMXMLB",43,0)
    25402536 Q S
    2541 "RTN","C0SMXMLB",43,0)
    2542  ;
    25432537"RTN","C0SMXMLB",44,0)
     2538 ;
     2539"RTN","C0SMXMLB",45,0)
    25442540Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11
    2545 "RTN","C0SMXMLB",45,0)
     2541"RTN","C0SMXMLB",46,0)
    25462542 ;I X'[$C(34) Q $C(34)_X_$C(34)
    2547 "RTN","C0SMXMLB",46,0)
     2543"RTN","C0SMXMLB",47,0)
    25482544 I X'[$C(39) Q $C(39)_X_$C(39)
    2549 "RTN","C0SMXMLB",47,0)
     2545"RTN","C0SMXMLB",48,0)
    25502546 ;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
    2551 "RTN","C0SMXMLB",48,0)
     2547"RTN","C0SMXMLB",49,0)
    25522548 N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
    2553 "RTN","C0SMXMLB",49,0)
     2549"RTN","C0SMXMLB",50,0)
    25542550 F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
    2555 "RTN","C0SMXMLB",50,0)
     2551"RTN","C0SMXMLB",51,0)
    25562552 S Y=Y_$P(X,Q,$L(X,Q))
    2557 "RTN","C0SMXMLB",51,0)
     2553"RTN","C0SMXMLB",52,0)
    25582554 ;Q $C(34)_Y_$C(34)
    2559 "RTN","C0SMXMLB",52,0)
     2555"RTN","C0SMXMLB",53,0)
    25602556 Q $C(39)_Y_$C(39)
    2561 "RTN","C0SMXMLB",53,0)
    2562  ;
    25632557"RTN","C0SMXMLB",54,0)
     2558 ;
     2559"RTN","C0SMXMLB",55,0)
    25642560XMLHDR() ; -- provides current XML standard header
    2565 "RTN","C0SMXMLB",55,0)
     2561"RTN","C0SMXMLB",56,0)
    25662562 Q "<?xml version=""1.0"" encoding=""utf-8"" ?>"
    2567 "RTN","C0SMXMLB",56,0)
    2568  ;
    25692563"RTN","C0SMXMLB",57,0)
     2564 ;
     2565"RTN","C0SMXMLB",58,0)
    25702566OUTPUT(S) ;Output
    2571 "RTN","C0SMXMLB",58,0)
     2567"RTN","C0SMXMLB",59,0)
    25722568 N C S C=$G(^TMP("MXMLBLD",$J,"CNT"))
    2573 "RTN","C0SMXMLB",59,0)
     2569"RTN","C0SMXMLB",60,0)
    25742570 I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q
    2575 "RTN","C0SMXMLB",60,0)
     2571"RTN","C0SMXMLB",61,0)
    25762572 W S,!
    2577 "RTN","C0SMXMLB",61,0)
    2578  Q
    25792573"RTN","C0SMXMLB",62,0)
    2580  ;
     2574 Q
    25812575"RTN","C0SMXMLB",63,0)
     2576 ;
     2577"RTN","C0SMXMLB",64,0)
    25822578CHARCHK(STR) ; -- replace xml character limits with entities
    2583 "RTN","C0SMXMLB",64,0)
     2579"RTN","C0SMXMLB",65,0)
    25842580 N A,I,X,Y,Z,NEWSTR
    2585 "RTN","C0SMXMLB",65,0)
     2581"RTN","C0SMXMLB",66,0)
    25862582 S (Y,Z)=""
    2587 "RTN","C0SMXMLB",66,0)
     2583"RTN","C0SMXMLB",67,0)
    25882584 ;IF STR["&" SET NEWSTR=STR DO  SET STR=Y_Z
    2589 "RTN","C0SMXMLB",67,0)
     2585"RTN","C0SMXMLB",68,0)
    25902586 ;. FOR X=1:1  SET Y=Y_$PIECE(NEWSTR,"&",X)_"&amp;",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
    2591 "RTN","C0SMXMLB",68,0)
     2587"RTN","C0SMXMLB",69,0)
    25922588 I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&amp;"_$P(STR,"&",I+1,999)
    2593 "RTN","C0SMXMLB",69,0)
     2589"RTN","C0SMXMLB",70,0)
    25942590 I STR["<" F  S STR=$PIECE(STR,"<",1)_"&lt;"_$PIECE(STR,"<",2,99) Q:STR'["<"
    2595 "RTN","C0SMXMLB",70,0)
     2591"RTN","C0SMXMLB",71,0)
    25962592 I STR[">" F  S STR=$PIECE(STR,">",1)_"&gt;"_$PIECE(STR,">",2,99) Q:STR'[">"
    2597 "RTN","C0SMXMLB",71,0)
     2593"RTN","C0SMXMLB",72,0)
    25982594 I STR["'" F  S STR=$PIECE(STR,"'",1)_"&apos;"_$PIECE(STR,"'",2,99) Q:STR'["'"
    2599 "RTN","C0SMXMLB",72,0)
     2595"RTN","C0SMXMLB",73,0)
    26002596 I STR["""" F  S STR=$PIECE(STR,"""",1)_"&quot;"_$PIECE(STR,"""",2,99) Q:STR'[""""
    2601 "RTN","C0SMXMLB",73,0)
    2602  ;
    26032597"RTN","C0SMXMLB",74,0)
     2598 ;
     2599"RTN","C0SMXMLB",75,0)
    26042600 S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
    2605 "RTN","C0SMXMLB",75,0)
     2601"RTN","C0SMXMLB",76,0)
    26062602 QUIT STR
    2607 "RTN","C0SMXMLB",76,0)
    2608  ;
    26092603"RTN","C0SMXMLB",77,0)
     2604 ;
     2605"RTN","C0SMXMLB",78,0)
    26102606COMMENT(VAL) ;Add Comments
    2611 "RTN","C0SMXMLB",78,0)
     2607"RTN","C0SMXMLB",79,0)
    26122608 N I,L
    2613 "RTN","C0SMXMLB",79,0)
     2609"RTN","C0SMXMLB",80,0)
    26142610 ;I $D($G(VAL))=1 D OUTPUT("<!-- "_ATT_" -->") Q
    2615 "RTN","C0SMXMLB",80,0)
     2611"RTN","C0SMXMLB",81,0)
    26162612 I $D(VAL) D OUTPUT("<!-- "_ATT_" -->") Q  ;CHANGED BY GPL FOR GTM
    2617 "RTN","C0SMXMLB",81,0)
     2613"RTN","C0SMXMLB",82,0)
    26182614 S I="",L="<!--"
    2619 "RTN","C0SMXMLB",82,0)
     2615"RTN","C0SMXMLB",83,0)
    26202616 F  S I=$O(ATT(I)) Q:I=""  D OUTPUT(L_ATT(I)) S L=""
    2621 "RTN","C0SMXMLB",83,0)
     2617"RTN","C0SMXMLB",84,0)
    26222618 D OUTPUT("-->")
    2623 "RTN","C0SMXMLB",84,0)
    2624  Q
    26252619"RTN","C0SMXMLB",85,0)
    2626  ;
     2620 Q
    26272621"RTN","C0SMXMLB",86,0)
     2622 ;
     2623"RTN","C0SMXMLB",87,0)
    26282624PUSH(INDENT,TAG,ATT) ;Write a TAG and save.
    2629 "RTN","C0SMXMLB",87,0)
     2625"RTN","C0SMXMLB",88,0)
    26302626 N CNT
    2631 "RTN","C0SMXMLB",88,0)
     2627"RTN","C0SMXMLB",89,0)
    26322628 S ATT=$G(ATT)
    2633 "RTN","C0SMXMLB",89,0)
     2629"RTN","C0SMXMLB",90,0)
    26342630 D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">")
    2635 "RTN","C0SMXMLB",90,0)
     2631"RTN","C0SMXMLB",91,0)
    26362632 S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG
    2637 "RTN","C0SMXMLB",91,0)
    2638  Q
    26392633"RTN","C0SMXMLB",92,0)
    2640  ;
     2634 Q
    26412635"RTN","C0SMXMLB",93,0)
     2636 ;
     2637"RTN","C0SMXMLB",94,0)
    26422638POP ;Write last pushed tag and pop
    2643 "RTN","C0SMXMLB",94,0)
     2639"RTN","C0SMXMLB",95,0)
    26442640 N CNT,TAG,INDENT,X
    2645 "RTN","C0SMXMLB",95,0)
     2641"RTN","C0SMXMLB",96,0)
    26462642 S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1
    2647 "RTN","C0SMXMLB",96,0)
     2643"RTN","C0SMXMLB",97,0)
    26482644 S INDENT=+X,TAG=$P(X,"^",2)
    2649 "RTN","C0SMXMLB",97,0)
     2645"RTN","C0SMXMLB",98,0)
    26502646 D OUTPUT($$BLS(INDENT)_"</"_TAG_">")
    2651 "RTN","C0SMXMLB",98,0)
    2652  Q
    26532647"RTN","C0SMXMLB",99,0)
    2654  ;
     2648 Q
    26552649"RTN","C0SMXMLB",100,0)
     2650 ;
     2651"RTN","C0SMXMLB",101,0)
    26562652BLS(I) ;Return INDENT string
    2657 "RTN","C0SMXMLB",101,0)
     2653"RTN","C0SMXMLB",102,0)
    26582654 N S
    2659 "RTN","C0SMXMLB",102,0)
     2655"RTN","C0SMXMLB",103,0)
    26602656 S S="",I=$G(I) S:I>0 $P(S," ",I)=" "
    2661 "RTN","C0SMXMLB",103,0)
     2657"RTN","C0SMXMLB",104,0)
    26622658 Q S
    2663 "RTN","C0SMXMLB",104,0)
    2664  ;
    26652659"RTN","C0SMXMLB",105,0)
     2660 ;
     2661"RTN","C0SMXMLB",106,0)
    26662662INDENT() ;Renturn indent level
    2667 "RTN","C0SMXMLB",106,0)
     2663"RTN","C0SMXMLB",107,0)
    26682664 Q +$G(^TMP("MXMLBLD",$J,"STK"))
    26692665"RTN","C0SNHIN")
    2670 0^7^B88600644
     26660^7^B87708170
    26712667"RTN","C0SNHIN",1,0)
    26722668C0SNHIN   ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11  17:05
    26732669"RTN","C0SNHIN",2,0)
    2674  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     2670 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    26752671"RTN","C0SNHIN",3,0)
    2676  ;Copyright 2011-2012 George Lilly.  Licensed under the terms of the GNU
     2672 ;Copyright 2011-2012 George Lilly. 
    26772673"RTN","C0SNHIN",4,0)
    2678  ;General Public License See attached copy of the License.
     2674 ;
    26792675"RTN","C0SNHIN",5,0)
    2680  ;
     2676 ; This program is free software: you can redistribute it and/or modify
    26812677"RTN","C0SNHIN",6,0)
    2682  ;This program is free software; you can redistribute it and/or modify
     2678 ; it under the terms of the GNU Affero General Public License as
    26832679"RTN","C0SNHIN",7,0)
    2684  ;it under the terms of the GNU General Public License as published by
     2680 ; published by the Free Software Foundation, either version 3 of the
    26852681"RTN","C0SNHIN",8,0)
    2686  ;the Free Software Foundation; either version 2 of the License, or
     2682 ; License, or (at your option) any later version.
    26872683"RTN","C0SNHIN",9,0)
    2688  ;(at your option) any later version.
     2684 ;
    26892685"RTN","C0SNHIN",10,0)
    2690  ;
     2686 ; This program is distributed in the hope that it will be useful,
    26912687"RTN","C0SNHIN",11,0)
    2692  ;This program is distributed in the hope that it will be useful,
     2688 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    26932689"RTN","C0SNHIN",12,0)
    2694  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     2690 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    26952691"RTN","C0SNHIN",13,0)
    2696  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     2692 ; GNU Affero General Public License for more details.
    26972693"RTN","C0SNHIN",14,0)
    2698  ;GNU General Public License for more details.
     2694 ;
    26992695"RTN","C0SNHIN",15,0)
    2700  ;
     2696 ; You should have received a copy of the GNU Affero General Public License
    27012697"RTN","C0SNHIN",16,0)
    2702  ;You should have received a copy of the GNU General Public License along
     2698 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    27032699"RTN","C0SNHIN",17,0)
    2704  ;with this program; if not, write to the Free Software Foundation, Inc.,
     2700 ;
    27052701"RTN","C0SNHIN",18,0)
    2706  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     2702 Q
    27072703"RTN","C0SNHIN",19,0)
    2708  ;
     2704EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
    27092705"RTN","C0SNHIN",20,0)
    2710  Q
     2706 ;
    27112707"RTN","C0SNHIN",21,0)
    2712 EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
     2708 K GARY,GNARY,GIDX,C0SDOCID
    27132709"RTN","C0SNHIN",22,0)
    2714  ;
     2710 K ZRTN
    27152711"RTN","C0SNHIN",23,0)
    2716  K GARY,GNARY,GIDX,C0SDOCID
     2712 N GN
    27172713"RTN","C0SNHIN",24,0)
    2718  K ZRTN
     2714 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
    27192715"RTN","C0SNHIN",25,0)
     2716 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
     2717"RTN","C0SNHIN",26,0)
     2718 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
     2719"RTN","C0SNHIN",27,0)
     2720 D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
     2721"RTN","C0SNHIN",28,0)
     2722 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
     2723"RTN","C0SNHIN",29,0)
     2724 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
     2725"RTN","C0SNHIN",30,0)
     2726 D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
     2727"RTN","C0SNHIN",31,0)
     2728 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
     2729"RTN","C0SNHIN",32,0)
     2730 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
     2731"RTN","C0SNHIN",33,0)
     2732 Q
     2733"RTN","C0SNHIN",34,0)
     2734 ;
     2735"RTN","C0SNHIN",35,0)
     2736PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
     2737"RTN","C0SNHIN",36,0)
     2738 ;
     2739"RTN","C0SNHIN",37,0)
     2740 N ZG
     2741"RTN","C0SNHIN",38,0)
     2742 S ZG=$NA(^TMP("PQRIXML",$J))
     2743"RTN","C0SNHIN",39,0)
     2744 K @ZG
     2745"RTN","C0SNHIN",40,0)
     2746 D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML
     2747"RTN","C0SNHIN",41,0)
     2748 N C0SDOCID
     2749"RTN","C0SNHIN",42,0)
     2750 S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML
     2751"RTN","C0SNHIN",43,0)
     2752 D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
     2753"RTN","C0SNHIN",44,0)
     2754 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
     2755"RTN","C0SNHIN",45,0)
     2756 Q
     2757"RTN","C0SNHIN",46,0)
     2758 ;
     2759"RTN","C0SNHIN",47,0)
     2760PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
     2761"RTN","C0SNHIN",48,0)
     2762 ;
     2763"RTN","C0SNHIN",49,0)
     2764 ;N GG
     2765"RTN","C0SNHIN",50,0)
     2766 D GETXML^C0SMXP("GG","PQRI ONE MEASURE")
     2767"RTN","C0SNHIN",51,0)
     2768 D PROCESS(ZRTN,"GG","root",1)
     2769"RTN","C0SNHIN",52,0)
     2770 Q
     2771"RTN","C0SNHIN",53,0)
     2772 ;
     2773"RTN","C0SNHIN",54,0)
     2774PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
     2775"RTN","C0SNHIN",55,0)
     2776 ; ZRTN IS PASSED BY REFERENCE
     2777"RTN","C0SNHIN",56,0)
     2778 ; ZXML IS PASSED BY NAME
     2779"RTN","C0SNHIN",57,0)
     2780 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
     2781"RTN","C0SNHIN",58,0)
     2782 ;
     2783"RTN","C0SNHIN",59,0)
    27202784 N GN
    2721 "RTN","C0SNHIN",26,0)
    2722  K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
    2723 "RTN","C0SNHIN",27,0)
    2724  K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
    2725 "RTN","C0SNHIN",28,0)
    2726  K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
    2727 "RTN","C0SNHIN",29,0)
    2728  D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
    2729 "RTN","C0SNHIN",30,0)
    2730  S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
    2731 "RTN","C0SNHIN",31,0)
     2785"RTN","C0SNHIN",60,0)
     2786 S GN=$NA(^TMP("C0SPROCESS",$J))
     2787"RTN","C0SNHIN",61,0)
     2788 K @GN
     2789"RTN","C0SNHIN",62,0)
     2790 M @GN=@ZXML
     2791"RTN","C0SNHIN",63,0)
    27322792 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
    2733 "RTN","C0SNHIN",32,0)
    2734  D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
    2735 "RTN","C0SNHIN",33,0)
     2793"RTN","C0SNHIN",64,0)
     2794 K @GN
     2795"RTN","C0SNHIN",65,0)
     2796 D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
     2797"RTN","C0SNHIN",66,0)
    27362798 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
    2737 "RTN","C0SNHIN",34,0)
    2738  ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
    2739 "RTN","C0SNHIN",35,0)
    2740  Q
    2741 "RTN","C0SNHIN",36,0)
    2742  ;
    2743 "RTN","C0SNHIN",37,0)
    2744 PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
    2745 "RTN","C0SNHIN",38,0)
    2746  ;
    2747 "RTN","C0SNHIN",39,0)
    2748  N ZG
    2749 "RTN","C0SNHIN",40,0)
    2750  S ZG=$NA(^TMP("PQRIXML",$J))
    2751 "RTN","C0SNHIN",41,0)
    2752  K @ZG
    2753 "RTN","C0SNHIN",42,0)
    2754  D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML
    2755 "RTN","C0SNHIN",43,0)
    2756  N C0SDOCID
    2757 "RTN","C0SNHIN",44,0)
    2758  S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML
    2759 "RTN","C0SNHIN",45,0)
    2760  D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
    2761 "RTN","C0SNHIN",46,0)
    2762  I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
    2763 "RTN","C0SNHIN",47,0)
    2764  Q
    2765 "RTN","C0SNHIN",48,0)
    2766  ;
    2767 "RTN","C0SNHIN",49,0)
    2768 PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
    2769 "RTN","C0SNHIN",50,0)
    2770  ;
    2771 "RTN","C0SNHIN",51,0)
    2772  ;N GG
    2773 "RTN","C0SNHIN",52,0)
    2774  D GETXML^C0SMXP("GG","PQRI ONE MEASURE")
    2775 "RTN","C0SNHIN",53,0)
    2776  D PROCESS(ZRTN,"GG","root",1)
    2777 "RTN","C0SNHIN",54,0)
    2778  Q
    2779 "RTN","C0SNHIN",55,0)
    2780  ;
    2781 "RTN","C0SNHIN",56,0)
    2782 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
    2783 "RTN","C0SNHIN",57,0)
    2784  ; ZRTN IS PASSED BY REFERENCE
    2785 "RTN","C0SNHIN",58,0)
    2786  ; ZXML IS PASSED BY NAME
    2787 "RTN","C0SNHIN",59,0)
    2788  ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
    2789 "RTN","C0SNHIN",60,0)
    2790  ;
    2791 "RTN","C0SNHIN",61,0)
    2792  N GN
    2793 "RTN","C0SNHIN",62,0)
    2794  S GN=$NA(^TMP("C0SPROCESS",$J))
    2795 "RTN","C0SNHIN",63,0)
    2796  K @GN
    2797 "RTN","C0SNHIN",64,0)
    2798  M @GN=@ZXML
    2799 "RTN","C0SNHIN",65,0)
    2800  S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
    2801 "RTN","C0SNHIN",66,0)
    2802  K @GN
    28032799"RTN","C0SNHIN",67,0)
    2804  D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
     2800 Q
    28052801"RTN","C0SNHIN",68,0)
    2806  I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
     2802 ;
    28072803"RTN","C0SNHIN",69,0)
    2808  Q
     2804LOADSMRT ;
    28092805"RTN","C0SNHIN",70,0)
    28102806 ;
    28112807"RTN","C0SNHIN",71,0)
    2812 LOADSMRT ;
     2808 K ^GPL("SMART")
    28132809"RTN","C0SNHIN",72,0)
    2814  ;
     2810 S GN=$NA(^GPL("SMART",1))
    28152811"RTN","C0SNHIN",73,0)
    2816  K ^GPL("SMART")
     2812 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
    28172813"RTN","C0SNHIN",74,0)
    2818  S GN=$NA(^GPL("SMART",1))
     2814 Q
    28192815"RTN","C0SNHIN",75,0)
    2820  I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
     2816 ;
    28212817"RTN","C0SNHIN",76,0)
    2822  Q
     2818SMART ; TRY IT WITH SMART
    28232819"RTN","C0SNHIN",77,0)
    28242820 ;
    28252821"RTN","C0SNHIN",78,0)
    2826 SMART ; TRY IT WITH SMART
     2822 S GN=$NA(^GPL("SMART"))
    28272823"RTN","C0SNHIN",79,0)
    2828  ;
     2824 ;K ^TMP("MXMLDOM",$J)
    28292825"RTN","C0SNHIN",80,0)
    2830  S GN=$NA(^GPL("SMART"))
     2826 K ^TMP("MXMLERR",$J)
    28312827"RTN","C0SNHIN",81,0)
     2828 S C0SDOCID=$$PARSE(GN,"SMART")
     2829"RTN","C0SNHIN",82,0)
     2830 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
     2831"RTN","C0SNHIN",83,0)
     2832 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
     2833"RTN","C0SNHIN",84,0)
     2834 Q
     2835"RTN","C0SNHIN",85,0)
     2836 ;
     2837"RTN","C0SNHIN",86,0)
     2838CCR ; TRY IT WITH A CCR
     2839"RTN","C0SNHIN",87,0)
     2840 ;
     2841"RTN","C0SNHIN",88,0)
     2842 S GN=$NA(^GPL("CCR"))
     2843"RTN","C0SNHIN",89,0)
    28322844 ;K ^TMP("MXMLDOM",$J)
    2833 "RTN","C0SNHIN",82,0)
     2845"RTN","C0SNHIN",90,0)
    28342846 K ^TMP("MXMLERR",$J)
    2835 "RTN","C0SNHIN",83,0)
    2836  S C0SDOCID=$$PARSE(GN,"SMART")
    2837 "RTN","C0SNHIN",84,0)
    2838  D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
    2839 "RTN","C0SNHIN",85,0)
     2847"RTN","C0SNHIN",91,0)
     2848 S C0SDOCID=$$PARSE(GN,"CCR")
     2849"RTN","C0SNHIN",92,0)
     2850 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
     2851"RTN","C0SNHIN",93,0)
    28402852 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
    2841 "RTN","C0SNHIN",86,0)
    2842  Q
    2843 "RTN","C0SNHIN",87,0)
    2844  ;
    2845 "RTN","C0SNHIN",88,0)
    2846 CCR ; TRY IT WITH A CCR
    2847 "RTN","C0SNHIN",89,0)
    2848  ;
    2849 "RTN","C0SNHIN",90,0)
    2850  S GN=$NA(^GPL("CCR"))
    2851 "RTN","C0SNHIN",91,0)
     2853"RTN","C0SNHIN",94,0)
     2854 Q
     2855"RTN","C0SNHIN",95,0)
     2856 ;
     2857"RTN","C0SNHIN",96,0)
     2858MED ; TRY IT WITH A CCR MED SECTION
     2859"RTN","C0SNHIN",97,0)
     2860 ;
     2861"RTN","C0SNHIN",98,0)
     2862 S GN=$NA(^GPL("MED"))
     2863"RTN","C0SNHIN",99,0)
     2864 K ^TMP("MXMLDOM",$J)
     2865"RTN","C0SNHIN",100,0)
     2866 K ^TMP("MXMLERR",$J)
     2867"RTN","C0SNHIN",101,0)
     2868 S C0SDOCID=$$PARSE(GN,"MED")
     2869"RTN","C0SNHIN",102,0)
     2870 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
     2871"RTN","C0SNHIN",103,0)
     2872 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
     2873"RTN","C0SNHIN",104,0)
     2874 Q
     2875"RTN","C0SNHIN",105,0)
     2876 ;
     2877"RTN","C0SNHIN",106,0)
     2878CCD ; TRY IT WITH A CCD
     2879"RTN","C0SNHIN",107,0)
     2880 ;
     2881"RTN","C0SNHIN",108,0)
     2882 S GN=$NA(^GPL("CCD"))
     2883"RTN","C0SNHIN",109,0)
    28522884 ;K ^TMP("MXMLDOM",$J)
    2853 "RTN","C0SNHIN",92,0)
     2885"RTN","C0SNHIN",110,0)
    28542886 K ^TMP("MXMLERR",$J)
    2855 "RTN","C0SNHIN",93,0)
    2856  S C0SDOCID=$$PARSE(GN,"CCR")
    2857 "RTN","C0SNHIN",94,0)
    2858  D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
    2859 "RTN","C0SNHIN",95,0)
     2887"RTN","C0SNHIN",111,0)
     2888 S C0SDOCID=$$PARSE(GN,"CCD")
     2889"RTN","C0SNHIN",112,0)
     2890 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
     2891"RTN","C0SNHIN",113,0)
    28602892 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
    2861 "RTN","C0SNHIN",96,0)
    2862  Q
    2863 "RTN","C0SNHIN",97,0)
    2864  ;
    2865 "RTN","C0SNHIN",98,0)
    2866 MED ; TRY IT WITH A CCR MED SECTION
    2867 "RTN","C0SNHIN",99,0)
    2868  ;
    2869 "RTN","C0SNHIN",100,0)
    2870  S GN=$NA(^GPL("MED"))
    2871 "RTN","C0SNHIN",101,0)
    2872  K ^TMP("MXMLDOM",$J)
    2873 "RTN","C0SNHIN",102,0)
    2874  K ^TMP("MXMLERR",$J)
    2875 "RTN","C0SNHIN",103,0)
    2876  S C0SDOCID=$$PARSE(GN,"MED")
    2877 "RTN","C0SNHIN",104,0)
    2878  D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
    2879 "RTN","C0SNHIN",105,0)
    2880  ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
    2881 "RTN","C0SNHIN",106,0)
    2882  Q
    2883 "RTN","C0SNHIN",107,0)
    2884  ;
    2885 "RTN","C0SNHIN",108,0)
    2886 CCD ; TRY IT WITH A CCD
    2887 "RTN","C0SNHIN",109,0)
    2888  ;
    2889 "RTN","C0SNHIN",110,0)
    2890  S GN=$NA(^GPL("CCD"))
    2891 "RTN","C0SNHIN",111,0)
    2892  ;K ^TMP("MXMLDOM",$J)
    2893 "RTN","C0SNHIN",112,0)
    2894  K ^TMP("MXMLERR",$J)
    2895 "RTN","C0SNHIN",113,0)
    2896  S C0SDOCID=$$PARSE(GN,"CCD")
    28972893"RTN","C0SNHIN",114,0)
    2898  D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
     2894 Q
    28992895"RTN","C0SNHIN",115,0)
    2900  ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
     2896 ;
    29012897"RTN","C0SNHIN",116,0)
    2902  Q
     2898TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
    29032899"RTN","C0SNHIN",117,0)
    2904  ;
     2900 ; PARSED WITH MXML
    29052901"RTN","C0SNHIN",118,0)
    2906 TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
     2902 ; RUN THROUGH XPATH
    29072903"RTN","C0SNHIN",119,0)
     2904 K GARY,GIDX,C0SDOCID
     2905"RTN","C0SNHIN",120,0)
     2906 S GN=$NA(^GPL("NHIN"))
     2907"RTN","C0SNHIN",121,0)
     2908 ;S GN=$NA(^GPL("DOMI"))
     2909"RTN","C0SNHIN",122,0)
     2910 S C0SDOCID=$$PARSE(GN,"GPLTEST")
     2911"RTN","C0SNHIN",123,0)
     2912 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
     2913"RTN","C0SNHIN",124,0)
     2914 K ^GPL("GNARY")
     2915"RTN","C0SNHIN",125,0)
     2916 M ^GPL("GNARY")=GNARY
     2917"RTN","C0SNHIN",126,0)
     2918 Q
     2919"RTN","C0SNHIN",127,0)
     2920 ;
     2921"RTN","C0SNHIN",128,0)
     2922TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
     2923"RTN","C0SNHIN",129,0)
     2924 ;
     2925"RTN","C0SNHIN",130,0)
     2926 S GN=$NA(^GPL("GNARY"))
     2927"RTN","C0SNHIN",131,0)
     2928 S C0SDOCID=$$DOMI^C0SDOM(GN,,"results")
     2929"RTN","C0SNHIN",132,0)
     2930 D OUTXML^C0SDOM("G",C0SDOCID)
     2931"RTN","C0SNHIN",133,0)
     2932 K ^GPL("DOMI")
     2933"RTN","C0SNHIN",134,0)
     2934 M ^GPL("DOMI")=G
     2935"RTN","C0SNHIN",135,0)
     2936 Q
     2937"RTN","C0SNHIN",136,0)
     2938 ;
     2939"RTN","C0SNHIN",137,0)
     2940TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
     2941"RTN","C0SNHIN",138,0)
    29082942 ; PARSED WITH MXML
    2909 "RTN","C0SNHIN",120,0)
     2943"RTN","C0SNHIN",139,0)
    29102944 ; RUN THROUGH XPATH
    2911 "RTN","C0SNHIN",121,0)
     2945"RTN","C0SNHIN",140,0)
    29122946 K GARY,GIDX,C0SDOCID
    2913 "RTN","C0SNHIN",122,0)
    2914  S GN=$NA(^GPL("NHIN"))
    2915 "RTN","C0SNHIN",123,0)
    2916  ;S GN=$NA(^GPL("DOMI"))
    2917 "RTN","C0SNHIN",124,0)
     2947"RTN","C0SNHIN",141,0)
     2948 ;S GN=$NA(^GPL("NHIN"))
     2949"RTN","C0SNHIN",142,0)
     2950 S GN=$NA(^GPL("DOMI"))
     2951"RTN","C0SNHIN",143,0)
    29182952 S C0SDOCID=$$PARSE(GN,"GPLTEST")
    2919 "RTN","C0SNHIN",125,0)
     2953"RTN","C0SNHIN",144,0)
    29202954 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
    2921 "RTN","C0SNHIN",126,0)
    2922  K ^GPL("GNARY")
    2923 "RTN","C0SNHIN",127,0)
    2924  M ^GPL("GNARY")=GNARY
    2925 "RTN","C0SNHIN",128,0)
    2926  Q
    2927 "RTN","C0SNHIN",129,0)
    2928  ;
    2929 "RTN","C0SNHIN",130,0)
    2930 TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
    2931 "RTN","C0SNHIN",131,0)
    2932  ;
    2933 "RTN","C0SNHIN",132,0)
    2934  S GN=$NA(^GPL("GNARY"))
    2935 "RTN","C0SNHIN",133,0)
    2936  S C0SDOCID=$$DOMI^C0SDOM(GN,,"results")
    2937 "RTN","C0SNHIN",134,0)
    2938  D OUTXML^C0SDOM("G",C0SDOCID)
    2939 "RTN","C0SNHIN",135,0)
    2940  K ^GPL("DOMI")
    2941 "RTN","C0SNHIN",136,0)
    2942  M ^GPL("DOMI")=G
    2943 "RTN","C0SNHIN",137,0)
    2944  Q
    2945 "RTN","C0SNHIN",138,0)
    2946  ;
    2947 "RTN","C0SNHIN",139,0)
    2948 TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
    2949 "RTN","C0SNHIN",140,0)
    2950  ; PARSED WITH MXML
    2951 "RTN","C0SNHIN",141,0)
    2952  ; RUN THROUGH XPATH
    2953 "RTN","C0SNHIN",142,0)
    2954  K GARY,GIDX,C0SDOCID
    2955 "RTN","C0SNHIN",143,0)
    2956  ;S GN=$NA(^GPL("NHIN"))
    2957 "RTN","C0SNHIN",144,0)
    2958  S GN=$NA(^GPL("DOMI"))
    29592955"RTN","C0SNHIN",145,0)
    2960  S C0SDOCID=$$PARSE(GN,"GPLTEST")
     2956 Q
    29612957"RTN","C0SNHIN",146,0)
    2962  D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
     2958 ;
    29632959"RTN","C0SNHIN",147,0)
    2964  Q
     2960DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
    29652961"RTN","C0SNHIN",148,0)
    2966  ;
     2962 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    29672963"RTN","C0SNHIN",149,0)
    2968 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
     2964 ; THE XPATH ARRAY XPARY, PASSED BY NAME
    29692965"RTN","C0SNHIN",150,0)
    2970  ; THE XPATH INDEX ZXIDX, PASSED BY NAME
     2966 ; ZOID IS THE STARTING OID
    29712967"RTN","C0SNHIN",151,0)
    2972  ; THE XPATH ARRAY XPARY, PASSED BY NAME
     2968 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
    29732969"RTN","C0SNHIN",152,0)
    2974  ; ZOID IS THE STARTING OID
     2970 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
    29752971"RTN","C0SNHIN",153,0)
    2976  ; ZPATH IS THE STARTING XPATH, USUALLY "/"
     2972 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
    29772973"RTN","C0SNHIN",154,0)
    2978  ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
     2974 I $G(ZREDUX)="" S ZREDUX=""
    29792975"RTN","C0SNHIN",155,0)
    2980  ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
     2976 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
    29812977"RTN","C0SNHIN",156,0)
    2982  I $G(ZREDUX)="" S ZREDUX=""
     2978 N NEWNUM S NEWNUM=""
    29832979"RTN","C0SNHIN",157,0)
    2984  N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
     2980 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
    29852981"RTN","C0SNHIN",158,0)
    2986  N NEWNUM S NEWNUM=""
     2982 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
    29872983"RTN","C0SNHIN",159,0)
    2988  I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
     2984 I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
    29892985"RTN","C0SNHIN",160,0)
    2990  S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
     2986 . N GT S GT=$P(NEWPATH,ZREDUX,2)
    29912987"RTN","C0SNHIN",161,0)
    2992  I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
     2988 . I GT'="" S NEWPATH=GT
    29932989"RTN","C0SNHIN",162,0)
    2994  . N GT S GT=$P(NEWPATH,ZREDUX,2)
     2990 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
    29952991"RTN","C0SNHIN",163,0)
    2996  . I GT'="" S NEWPATH=GT
     2992 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
    29972993"RTN","C0SNHIN",164,0)
    2998  S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
     2994 I $D(GA) D  ; PROCESS THE ATTRIBUTES
    29992995"RTN","C0SNHIN",165,0)
    3000  N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
     2996 . N ZI S ZI=""
    30012997"RTN","C0SNHIN",166,0)
    3002  I $D(GA) D  ; PROCESS THE ATTRIBUTES
     2998 . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
    30032999"RTN","C0SNHIN",167,0)
    3004  . N ZI S ZI=""
     3000 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
    30053001"RTN","C0SNHIN",168,0)
    3006  . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
     3002 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
    30073003"RTN","C0SNHIN",169,0)
    3008  . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
     3004 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
    30093005"RTN","C0SNHIN",170,0)
    3010  . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
     3006 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
    30113007"RTN","C0SNHIN",171,0)
    3012  . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
     3008 I $D(GD(2)) D  ;
    30133009"RTN","C0SNHIN",172,0)
    3014  N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
     3010 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
    30153011"RTN","C0SNHIN",173,0)
    3016  I $D(GD(2)) D  ;
     3012 E  I $D(GD(1)) D  ;
    30173013"RTN","C0SNHIN",174,0)
    3018  . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
     3014 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
    30193015"RTN","C0SNHIN",175,0)
    3020  E  I $D(GD(1)) D  ;
     3016 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
    30213017"RTN","C0SNHIN",176,0)
    3022  . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
     3018 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
    30233019"RTN","C0SNHIN",177,0)
    3024  . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
     3020 I ZFRST'=0 D  ; THERE IS A CHILD
    30253021"RTN","C0SNHIN",178,0)
    3026  N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
     3022 . N ZNUM
    30273023"RTN","C0SNHIN",179,0)
    3028  I ZFRST'=0 D  ; THERE IS A CHILD
     3024 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
    30293025"RTN","C0SNHIN",180,0)
    3030  . N ZNUM
     3026 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
    30313027"RTN","C0SNHIN",181,0)
    3032  . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
     3028 N GNXT S GNXT=$$NXTSIB(ZOID)
    30333029"RTN","C0SNHIN",182,0)
    3034  . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
     3030 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
    30353031"RTN","C0SNHIN",183,0)
    3036  N GNXT S GNXT=$$NXTSIB(ZOID)
     3032 I GNXT'=0 D  ;
    30373033"RTN","C0SNHIN",184,0)
    3038  I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
     3034 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
    30393035"RTN","C0SNHIN",185,0)
    3040  I GNXT'=0 D  ;
     3036 . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
    30413037"RTN","C0SNHIN",186,0)
    3042  . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
     3038 . . N ZNUM S ZNUM=1 ;
    30433039"RTN","C0SNHIN",187,0)
    3044  . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
     3040 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
    30453041"RTN","C0SNHIN",188,0)
    3046  . . N ZNUM S ZNUM=1 ;
     3042 . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
    30473043"RTN","C0SNHIN",189,0)
    3048  . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
     3044 Q
    30493045"RTN","C0SNHIN",190,0)
    3050  . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
     3046 ;
    30513047"RTN","C0SNHIN",191,0)
    3052  Q
     3048ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
    30533049"RTN","C0SNHIN",192,0)
    30543050 ;
    30553051"RTN","C0SNHIN",193,0)
    3056 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
     3052 N ZZI,ZZJ,ZZN
    30573053"RTN","C0SNHIN",194,0)
    3058  ;
     3054 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
    30593055"RTN","C0SNHIN",195,0)
    3060  N ZZI,ZZJ,ZZN
     3056 I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
    30613057"RTN","C0SNHIN",196,0)
    3062  S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
     3058 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
    30633059"RTN","C0SNHIN",197,0)
    3064  I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
     3060 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
    30653061"RTN","C0SNHIN",198,0)
    3066  S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
     3062 I ZZI'["]" D  ; A SINGLETON
    30673063"RTN","C0SNHIN",199,0)
    3068  S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
     3064 . S ZZN=1
    30693065"RTN","C0SNHIN",200,0)
    3070  I ZZI'["]" D  ; A SINGLETON
     3066 E  D  ; THERE IS AN [x] OCCURANCE
    30713067"RTN","C0SNHIN",201,0)
    3072  . S ZZN=1
     3068 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
    30733069"RTN","C0SNHIN",202,0)
    3074  E  D  ; THERE IS AN [x] OCCURANCE
     3070 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
    30753071"RTN","C0SNHIN",203,0)
    3076  . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
     3072 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
    30773073"RTN","C0SNHIN",204,0)
    3078  . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
     3074 Q
    30793075"RTN","C0SNHIN",205,0)
    3080  I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
     3076 ;
    30813077"RTN","C0SNHIN",206,0)
    3082  Q
     3078PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    30833079"RTN","C0SNHIN",207,0)
    3084  ;
     3080 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    30853081"RTN","C0SNHIN",208,0)
    3086 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
     3082 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    30873083"RTN","C0SNHIN",209,0)
    3088  ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
     3084 ;Q $$EN^MXMLDOM(INXML)
    30893085"RTN","C0SNHIN",210,0)
    3090  ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
     3086 Q $$EN^MXMLDOM(INXML,"W")
    30913087"RTN","C0SNHIN",211,0)
    3092  ;Q $$EN^MXMLDOM(INXML)
     3088 ;
    30933089"RTN","C0SNHIN",212,0)
    3094  Q $$EN^MXMLDOM(INXML,"W")
     3090ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    30953091"RTN","C0SNHIN",213,0)
    3096  ;
     3092 N ZN
    30973093"RTN","C0SNHIN",214,0)
    3098 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
     3094 ;I $$TAG(ZOID)["entry" B
    30993095"RTN","C0SNHIN",215,0)
    3100  N ZN
     3096 S ZN=$$NXTSIB(ZOID)
    31013097"RTN","C0SNHIN",216,0)
    3102  ;I $$TAG(ZOID)["entry" B
     3098 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
    31033099"RTN","C0SNHIN",217,0)
    3104  S ZN=$$NXTSIB(ZOID)
     3100 Q 0
    31053101"RTN","C0SNHIN",218,0)
    3106  I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
     3102 ;
    31073103"RTN","C0SNHIN",219,0)
    3108  Q 0
     3104FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    31093105"RTN","C0SNHIN",220,0)
    3110  ;
     3106 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
    31113107"RTN","C0SNHIN",221,0)
    3112 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
     3108 ;
    31133109"RTN","C0SNHIN",222,0)
    3114  Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
     3110PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
    31153111"RTN","C0SNHIN",223,0)
    3116  ;
     3112 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
    31173113"RTN","C0SNHIN",224,0)
    3118 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
     3114 ;
    31193115"RTN","C0SNHIN",225,0)
    3120  Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
     3116ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
    31213117"RTN","C0SNHIN",226,0)
    3122  ;
     3118 S HANDLE=C0SDOCID
    31233119"RTN","C0SNHIN",227,0)
    3124 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
     3120 K @RTN
    31253121"RTN","C0SNHIN",228,0)
    3126  S HANDLE=C0SDOCID
     3122 D GETTXT^MXMLDOM("A")
    31273123"RTN","C0SNHIN",229,0)
    3128  K @RTN
     3124 Q
    31293125"RTN","C0SNHIN",230,0)
    3130  D GETTXT^MXMLDOM("A")
     3126 ;
    31313127"RTN","C0SNHIN",231,0)
    3132  Q
     3128TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
    31333129"RTN","C0SNHIN",232,0)
    3134  ;
     3130 ;I ZOID=149 B ;GPLTEST
    31353131"RTN","C0SNHIN",233,0)
    3136 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
     3132 N X,Y
    31373133"RTN","C0SNHIN",234,0)
    3138  ;I ZOID=149 B ;GPLTEST
     3134 S Y=""
    31393135"RTN","C0SNHIN",235,0)
    3140  N X,Y
     3136 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
    31413137"RTN","C0SNHIN",236,0)
    3142  S Y=""
     3138 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
    31433139"RTN","C0SNHIN",237,0)
    3144  S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
     3140 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
    31453141"RTN","C0SNHIN",238,0)
    3146  I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
     3142 Q Y
    31473143"RTN","C0SNHIN",239,0)
    3148  I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
     3144 ;
    31493145"RTN","C0SNHIN",240,0)
    3150  Q Y
     3146NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
    31513147"RTN","C0SNHIN",241,0)
    3152  ;
     3148 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
    31533149"RTN","C0SNHIN",242,0)
    3154 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
     3150 ;
    31553151"RTN","C0SNHIN",243,0)
    3156  Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
     3152DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
    31573153"RTN","C0SNHIN",244,0)
    3158  ;
     3154 ;N ZT,ZN S ZT=""
    31593155"RTN","C0SNHIN",245,0)
    3160 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
     3156 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
    31613157"RTN","C0SNHIN",246,0)
    3162  ;N ZT,ZN S ZT=""
     3158 ;Q $G(@C0SDOM@(ZOID,"T",1))
    31633159"RTN","C0SNHIN",247,0)
    3164  ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
     3160 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
    31653161"RTN","C0SNHIN",248,0)
    3166  ;Q $G(@C0SDOM@(ZOID,"T",1))
     3162 Q
    31673163"RTN","C0SNHIN",249,0)
    3168  S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
     3164 ;
    31693165"RTN","C0SNHIN",250,0)
    3170  Q
     3166OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    31713167"RTN","C0SNHIN",251,0)
    31723168 ;
    31733169"RTN","C0SNHIN",252,0)
    3174 OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
     3170 S C0SDOCID=INID
    31753171"RTN","C0SNHIN",253,0)
    3176  ;
     3172 D START^C0SMXMLB($$TAG(1),,"G")
    31773173"RTN","C0SNHIN",254,0)
    3178  S C0SDOCID=INID
     3174 D NDOUT($$FIRST(1))
    31793175"RTN","C0SNHIN",255,0)
    3180  D START^C0SMXMLB($$TAG(1),,"G")
     3176 D END^C0SMXMLB ;END THE DOCUMENT
    31813177"RTN","C0SNHIN",256,0)
    3182  D NDOUT($$FIRST(1))
     3178 M @ZRTN=^TMP("MXMLBLD",$J)
    31833179"RTN","C0SNHIN",257,0)
    3184  D END^C0SMXMLB ;END THE DOCUMENT
     3180 K ^TMP("MXMLBLD",$J)
    31853181"RTN","C0SNHIN",258,0)
    3186  M @ZRTN=^TMP("MXMLBLD",$J)
     3182 Q
    31873183"RTN","C0SNHIN",259,0)
    3188  K ^TMP("MXMLBLD",$J)
     3184 ;
    31893185"RTN","C0SNHIN",260,0)
    3190  Q
     3186NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
    31913187"RTN","C0SNHIN",261,0)
    3192  ;
     3188 N ZI S ZI=$$FIRST(ZOID)
    31933189"RTN","C0SNHIN",262,0)
    3194 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
     3190 I ZI'=0 D  ; THERE IS A CHILD
    31953191"RTN","C0SNHIN",263,0)
    3196  N ZI S ZI=$$FIRST(ZOID)
     3192 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
    31973193"RTN","C0SNHIN",264,0)
    3198  I ZI'=0 D  ; THERE IS A CHILD
     3194 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
    31993195"RTN","C0SNHIN",265,0)
    3200  . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
     3196 E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
    32013197"RTN","C0SNHIN",266,0)
    3202  . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
     3198 . ;W "DOING",ZOID,!
    32033199"RTN","C0SNHIN",267,0)
    3204  E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
     3200 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
    32053201"RTN","C0SNHIN",268,0)
    3206  . ;W "DOING",ZOID,!
     3202 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
    32073203"RTN","C0SNHIN",269,0)
    3208  . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
     3204 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
    32093205"RTN","C0SNHIN",270,0)
    3210  . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
     3206 I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
    32113207"RTN","C0SNHIN",271,0)
    3212  . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
     3208 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
    32133209"RTN","C0SNHIN",272,0)
    3214  I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
     3210 Q
    32153211"RTN","C0SNHIN",273,0)
    3216  . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
     3212 ;
    32173213"RTN","C0SNHIN",274,0)
    3218  Q
     3214WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
    32193215"RTN","C0SNHIN",275,0)
    32203216 ;
    32213217"RTN","C0SNHIN",276,0)
    3222 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
     3218 N GN,GN2
    32233219"RTN","C0SNHIN",277,0)
    3224  ;
     3220 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
    32253221"RTN","C0SNHIN",278,0)
    3226  N GN,GN2
     3222 S GN2=$NA(@GN@(1))
    32273223"RTN","C0SNHIN",279,0)
    3228  D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
     3224 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
    32293225"RTN","C0SNHIN",280,0)
    3230  S GN2=$NA(@GN@(1))
     3226 Q
    32313227"RTN","C0SNHIN",281,0)
    3232  W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
     3228 ;
    32333229"RTN","C0SNHIN",282,0)
    3234  Q
     3230TESTNARY ; TEST MAKING A NHIN ARRAY
    32353231"RTN","C0SNHIN",283,0)
    3236  ;
     3232 N ZI S ZI=""
    32373233"RTN","C0SNHIN",284,0)
    3238 TESTNARY ; TEST MAKING A NHIN ARRAY
     3234 N ZH ; DOM HANDLE
    32393235"RTN","C0SNHIN",285,0)
    3240  N ZI S ZI=""
     3236 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
    32413237"RTN","C0SNHIN",286,0)
    3242  N ZH ; DOM HANDLE
     3238 S ZH=C0SDOCID ; SET THE HANDLE
    32433239"RTN","C0SNHIN",287,0)
    3244  D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
     3240 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
    32453241"RTN","C0SNHIN",288,0)
    3246  S ZH=C0SDOCID ; SET THE HANDLE
     3242 F  S ZI=$O(@ZD@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
    32473243"RTN","C0SNHIN",289,0)
    3248  N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
     3244 . N ZATT
    32493245"RTN","C0SNHIN",290,0)
    3250  F  S ZI=$O(@ZD@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
     3246 . D MNARY(.ZATT,ZH,ZI)
    32513247"RTN","C0SNHIN",291,0)
    3252  . N ZATT
     3248 . N ZPRE,ZN
    32533249"RTN","C0SNHIN",292,0)
    3254  . D MNARY(.ZATT,ZH,ZI)
     3250 . S ZPRE=$$PRE(ZI)
    32553251"RTN","C0SNHIN",293,0)
    3256  . N ZPRE,ZN
     3252 . S ZN=$P(ZPRE,",",2)
    32573253"RTN","C0SNHIN",294,0)
    3258  . S ZPRE=$$PRE(ZI)
     3254 . S ZPRE=$P(ZPRE,",",1)
    32593255"RTN","C0SNHIN",295,0)
    3260  . S ZN=$P(ZPRE,",",2)
     3256 . ;I $D(ZATT) ZWR ZATT
    32613257"RTN","C0SNHIN",296,0)
    3262  . S ZPRE=$P(ZPRE,",",1)
     3258 . N ZJ S ZJ=""
    32633259"RTN","C0SNHIN",297,0)
    3264  . ;I $D(ZATT) ZWR ZATT
     3260 . F  S ZJ=$O(ZATT(ZJ)) Q:ZJ=""  D  ; FOR EACH ATTRIBUTE
    32653261"RTN","C0SNHIN",298,0)
    3266  . N ZJ S ZJ=""
     3262 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
    32673263"RTN","C0SNHIN",299,0)
    3268  . F  S ZJ=$O(ZATT(ZJ)) Q:ZJ=""  D  ; FOR EACH ATTRIBUTE
     3264 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
    32693265"RTN","C0SNHIN",300,0)
    3270  . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
     3266 Q
    32713267"RTN","C0SNHIN",301,0)
    3272  . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
     3268 ;
    32733269"RTN","C0SNHIN",302,0)
    3274  Q
     3270PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
    32753271"RTN","C0SNHIN",303,0)
    32763272 ;
    32773273"RTN","C0SNHIN",304,0)
    3278 PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
     3274 N GI,GI2,GPT,GJ,GN
    32793275"RTN","C0SNHIN",305,0)
    3280  ;
     3276 S GI=$$PARENT(ZNODE) ; PARENT NODE
    32813277"RTN","C0SNHIN",306,0)
    3282  N GI,GI2,GPT,GJ,GN
     3278 I GI=0 Q ""  ; NO PARENT
    32833279"RTN","C0SNHIN",307,0)
    3284  S GI=$$PARENT(ZNODE) ; PARENT NODE
     3280 S GPT=$$TAG(GI) ; TAG OF PARENT
    32853281"RTN","C0SNHIN",308,0)
    3286  I GI=0 Q ""  ; NO PARENT
     3282 S GI2=$$PARENT(GI) ; PARENT OF PARENT
    32873283"RTN","C0SNHIN",309,0)
    3288  S GPT=$$TAG(GI) ; TAG OF PARENT
     3284 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
    32893285"RTN","C0SNHIN",310,0)
    3290  S GI2=$$PARENT(GI) ; PARENT OF PARENT
     3286 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
    32913287"RTN","C0SNHIN",311,0)
    3292  I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
     3288 I GJ=ZNODE Q:$$TAG(GI)_",1"
    32933289"RTN","C0SNHIN",312,0)
    3294  S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
     3290 F GN=2:1 Q:GJ=ZNODE  D  ;
    32953291"RTN","C0SNHIN",313,0)
    3296  I GJ=ZNODE Q:$$TAG(GI)_",1"
     3292 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
    32973293"RTN","C0SNHIN",314,0)
    3298  F GN=2:1 Q:GJ=ZNODE  D  ;
     3294 Q GPT_","_GN
    32993295"RTN","C0SNHIN",315,0)
    3300  . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
     3296 ;
    33013297"RTN","C0SNHIN",316,0)
    3302  Q GPT_","_GN
     3298MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
    33033299"RTN","C0SNHIN",317,0)
    3304  ;
     3300 ; RETURNED IN ZRTN, PASSED BY REFERENCE
    33053301"RTN","C0SNHIN",318,0)
    3306 MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
     3302 ; ZHANDLE IS THE DOM DOCUMENT ID
    33073303"RTN","C0SNHIN",319,0)
    3308  ; RETURNED IN ZRTN, PASSED BY REFERENCE
     3304 ; ZOID IS THE DOM NODE
    33093305"RTN","C0SNHIN",320,0)
    3310  ; ZHANDLE IS THE DOM DOCUMENT ID
     3306 D ATT("ZRTN",ZOID)
    33113307"RTN","C0SNHIN",321,0)
    3312  ; ZOID IS THE DOM NODE
     3308 Q
    33133309"RTN","C0SNHIN",322,0)
    3314  D ATT("ZRTN",ZOID)
    3315 "RTN","C0SNHIN",323,0)
    3316  Q
    3317 "RTN","C0SNHIN",324,0)
    33183310 ;
    33193311"RTN","C0SNHINV")
     
    33223314C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version
    33233315"RTN","C0SNHINV",2,0)
    3324  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     3316 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    33253317"RTN","C0SNHINV",3,0)
    33263318 ;
     
    35563548 Q $$GET1^DIQ(FILE,IEN_",",99.99)
    35573549"RTN","C0SPROB")
    3558 0^9^B49669400
     35500^9^B49349956
    35593551"RTN","C0SPROB",1,0)
    35603552C0SPROB   ; GPL - Smart Problem Processing ;5/01/12  17:05
    35613553"RTN","C0SPROB",2,0)
    3562  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     3554 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    35633555"RTN","C0SPROB",3,0)
    3564  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     3556 ;Copyright 2012 George Lilly. 
    35653557"RTN","C0SPROB",4,0)
    3566  ;General Public License See attached copy of the License.
     3558 ;
    35673559"RTN","C0SPROB",5,0)
    3568  ;
     3560 ; This program is free software: you can redistribute it and/or modify
    35693561"RTN","C0SPROB",6,0)
    3570  ;This program is free software; you can redistribute it and/or modify
     3562 ; it under the terms of the GNU Affero General Public License as
    35713563"RTN","C0SPROB",7,0)
    3572  ;it under the terms of the GNU General Public License as published by
     3564 ; published by the Free Software Foundation, either version 3 of the
    35733565"RTN","C0SPROB",8,0)
    3574  ;the Free Software Foundation; either version 2 of the License, or
     3566 ; License, or (at your option) any later version.
    35753567"RTN","C0SPROB",9,0)
    3576  ;(at your option) any later version.
     3568 ;
    35773569"RTN","C0SPROB",10,0)
    3578  ;
     3570 ; This program is distributed in the hope that it will be useful,
    35793571"RTN","C0SPROB",11,0)
    3580  ;This program is distributed in the hope that it will be useful,
     3572 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    35813573"RTN","C0SPROB",12,0)
    3582  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     3574 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    35833575"RTN","C0SPROB",13,0)
    3584  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     3576 ; GNU Affero General Public License for more details.
    35853577"RTN","C0SPROB",14,0)
    3586  ;GNU General Public License for more details.
     3578 ;
    35873579"RTN","C0SPROB",15,0)
    3588  ;
     3580 ; You should have received a copy of the GNU Affero General Public License
    35893581"RTN","C0SPROB",16,0)
    3590  ;You should have received a copy of the GNU General Public License along
     3582 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    35913583"RTN","C0SPROB",17,0)
    3592  ;with this program; if not, write to the Free Software Foundation, Inc.,
     3584 ;
    35933585"RTN","C0SPROB",18,0)
    3594  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     3586 Q
    35953587"RTN","C0SPROB",19,0)
    35963588 ;
    35973589"RTN","C0SPROB",20,0)
    3598  Q
     3590 ; sample VistA NHIN problem list
    35993591"RTN","C0SPROB",21,0)
    36003592 ;
    36013593"RTN","C0SPROB",22,0)
    3602  ; sample VistA NHIN problem list
     3594 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C"
    36033595"RTN","C0SPROB",23,0)
    3604  ;
     3596 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531
    36053597"RTN","C0SPROB",24,0)
    3606  ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C"
     3598 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100
    36073599"RTN","C0SPROB",25,0)
    3608  ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531
     3600 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION"
    36093601"RTN","C0SPROB",26,0)
    3610  ;^TMP("C0STBL",91,"problem",1,"facility@code")=100
     3602 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9
    36113603"RTN","C0SPROB",27,0)
    3612  ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION"
     3604 ;^TMP("C0STBL",91,"problem",1,"id@value")=100
    36133605"RTN","C0SPROB",28,0)
    3614  ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9
     3606 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE"
    36153607"RTN","C0SPROB",29,0)
    3616  ;^TMP("C0STBL",91,"problem",1,"id@value")=100
     3608 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease"
    36173609"RTN","C0SPROB",30,0)
    3618  ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE"
     3610 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201
    36193611"RTN","C0SPROB",31,0)
    3620  ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease"
     3612 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63
    36213613"RTN","C0SPROB",32,0)
    3622  ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201
     3614 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL"
    36233615"RTN","C0SPROB",33,0)
    3624  ;^TMP("C0STBL",91,"problem",1,"provider@code")=63
     3616 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0
    36253617"RTN","C0SPROB",34,0)
    3626  ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL"
     3618 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0
    36273619"RTN","C0SPROB",35,0)
    3628  ;^TMP("C0STBL",91,"problem",1,"removed@value")=0
     3620 ;^TMP("C0STBL",91,"problem",1,"status@value")="A"
    36293621"RTN","C0SPROB",36,0)
    3630  ;^TMP("C0STBL",91,"problem",1,"sc@value")=0
     3622 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0
    36313623"RTN","C0SPROB",37,0)
    3632  ;^TMP("C0STBL",91,"problem",1,"status@value")="A"
     3624 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531
    36333625"RTN","C0SPROB",38,0)
    3634  ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0
     3626 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C"
    36353627"RTN","C0SPROB",39,0)
    3636  ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531
     3628 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602
    36373629"RTN","C0SPROB",40,0)
    3638  ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C"
     3630 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100
    36393631"RTN","C0SPROB",41,0)
    3640  ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602
     3632 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION"
    36413633"RTN","C0SPROB",42,0)
    3642  ;^TMP("C0STBL",91,"problem",2,"facility@code")=100
     3634 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2
    36433635"RTN","C0SPROB",43,0)
    3644  ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION"
     3636 ;^TMP("C0STBL",91,"problem",2,"id@value")=108
    36453637"RTN","C0SPROB",44,0)
    3646  ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2
     3638 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse"
    36473639"RTN","C0SPROB",45,0)
    3648  ;^TMP("C0STBL",91,"problem",2,"id@value")=108
     3640 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102
    36493641"RTN","C0SPROB",46,0)
    3650  ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse"
     3642 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63
    36513643"RTN","C0SPROB",47,0)
    3652  ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102
     3644 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL"
    36533645"RTN","C0SPROB",48,0)
    3654  ;^TMP("C0STBL",91,"problem",2,"provider@code")=63
     3646 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0
    36553647"RTN","C0SPROB",49,0)
    3656  ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL"
     3648 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0
    36573649"RTN","C0SPROB",50,0)
    3658  ;^TMP("C0STBL",91,"problem",2,"removed@value")=0
     3650 ;^TMP("C0STBL",91,"problem",2,"status@value")="A"
    36593651"RTN","C0SPROB",51,0)
    3660  ;^TMP("C0STBL",91,"problem",2,"sc@value")=0
     3652 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0
    36613653"RTN","C0SPROB",52,0)
    3662  ;^TMP("C0STBL",91,"problem",2,"status@value")="A"
     3654 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602
    36633655"RTN","C0SPROB",53,0)
    3664  ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0
     3656 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C"
    36653657"RTN","C0SPROB",54,0)
    3666  ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602
     3658 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602
    36673659"RTN","C0SPROB",55,0)
    3668  ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C"
     3660 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100
    36693661"RTN","C0SPROB",56,0)
    3670  ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602
     3662 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION"
    36713663"RTN","C0SPROB",57,0)
    3672  ;^TMP("C0STBL",91,"problem",3,"facility@code")=100
     3664 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91
    36733665"RTN","C0SPROB",58,0)
    3674  ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION"
     3666 ;^TMP("C0STBL",91,"problem",3,"id@value")=109
    36753667"RTN","C0SPROB",59,0)
    3676  ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91
     3668 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"
    36773669"RTN","C0SPROB",60,0)
    3678  ;^TMP("C0STBL",91,"problem",3,"id@value")=109
     3670 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101
    36793671"RTN","C0SPROB",61,0)
    3680  ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"
     3672 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63
    36813673"RTN","C0SPROB",62,0)
    3682  ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101
     3674 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL"
    36833675"RTN","C0SPROB",63,0)
    3684  ;^TMP("C0STBL",91,"problem",3,"provider@code")=63
     3676 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0
    36853677"RTN","C0SPROB",64,0)
    3686  ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL"
     3678 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0
    36873679"RTN","C0SPROB",65,0)
    3688  ;^TMP("C0STBL",91,"problem",3,"removed@value")=0
     3680 ;^TMP("C0STBL",91,"problem",3,"status@value")="A"
    36893681"RTN","C0SPROB",66,0)
    3690  ;^TMP("C0STBL",91,"problem",3,"sc@value")=0
     3682 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0
    36913683"RTN","C0SPROB",67,0)
    3692  ;^TMP("C0STBL",91,"problem",3,"status@value")="A"
     3684 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602
    36933685"RTN","C0SPROB",68,0)
    3694  ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0
     3686 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603
    36953687"RTN","C0SPROB",69,0)
    3696  ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602
     3688 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100
    36973689"RTN","C0SPROB",70,0)
    3698  ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603
     3690 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION"
    36993691"RTN","C0SPROB",71,0)
    3700  ;^TMP("C0STBL",91,"problem",4,"facility@code")=100
     3692 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66"
    37013693"RTN","C0SPROB",72,0)
    3702  ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION"
     3694 ;^TMP("C0STBL",91,"problem",4,"id@value")=115
    37033695"RTN","C0SPROB",73,0)
    3704  ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66"
     3696 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE"
    37053697"RTN","C0SPROB",74,0)
    3706  ;^TMP("C0STBL",91,"problem",4,"id@value")=115
     3698 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66"
    37073699"RTN","C0SPROB",75,0)
    3708  ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE"
     3700 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63
    37093701"RTN","C0SPROB",76,0)
    3710  ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66"
     3702 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL"
    37113703"RTN","C0SPROB",77,0)
    3712  ;^TMP("C0STBL",91,"problem",4,"provider@code")=63
     3704 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0
    37133705"RTN","C0SPROB",78,0)
    3714  ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL"
     3706 ;^TMP("C0STBL",91,"problem",4,"status@value")="A"
    37153707"RTN","C0SPROB",79,0)
    3716  ;^TMP("C0STBL",91,"problem",4,"removed@value")=0
     3708 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0
    37173709"RTN","C0SPROB",80,0)
    3718  ;^TMP("C0STBL",91,"problem",4,"status@value")="A"
     3710 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603
    37193711"RTN","C0SPROB",81,0)
    3720  ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0
     3712 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603
    37213713"RTN","C0SPROB",82,0)
    3722  ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603
     3714 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100
    37233715"RTN","C0SPROB",83,0)
    3724  ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603
     3716 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION"
    37253717"RTN","C0SPROB",84,0)
    3726  ;^TMP("C0STBL",91,"problem",5,"facility@code")=100
     3718 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21
    37273719"RTN","C0SPROB",85,0)
    3728  ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION"
     3720 ;^TMP("C0STBL",91,"problem",5,"id@value")=116
    37293721"RTN","C0SPROB",86,0)
    3730  ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21
     3722 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE"
    37313723"RTN","C0SPROB",87,0)
    3732  ;^TMP("C0STBL",91,"problem",5,"id@value")=116
     3724 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21
    37333725"RTN","C0SPROB",88,0)
    3734  ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE"
     3726 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63
    37353727"RTN","C0SPROB",89,0)
    3736  ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21
     3728 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL"
    37373729"RTN","C0SPROB",90,0)
    3738  ;^TMP("C0STBL",91,"problem",5,"provider@code")=63
     3730 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0
    37393731"RTN","C0SPROB",91,0)
    3740  ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL"
     3732 ;^TMP("C0STBL",91,"problem",5,"status@value")="A"
    37413733"RTN","C0SPROB",92,0)
    3742  ;^TMP("C0STBL",91,"problem",5,"removed@value")=0
     3734 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0
    37433735"RTN","C0SPROB",93,0)
    3744  ;^TMP("C0STBL",91,"problem",5,"status@value")="A"
     3736 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603
    37453737"RTN","C0SPROB",94,0)
    3746  ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0
     3738 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603
    37473739"RTN","C0SPROB",95,0)
    3748  ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603
     3740 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100
    37493741"RTN","C0SPROB",96,0)
    3750  ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603
     3742 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION"
    37513743"RTN","C0SPROB",97,0)
    3752  ;^TMP("C0STBL",91,"problem",6,"facility@code")=100
     3744 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51
    37533745"RTN","C0SPROB",98,0)
    3754  ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION"
     3746 ;^TMP("C0STBL",91,"problem",6,"id@value")=117
    37553747"RTN","C0SPROB",99,0)
    3756  ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51
     3748 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE"
    37573749"RTN","C0SPROB",100,0)
    3758  ;^TMP("C0STBL",91,"problem",6,"id@value")=117
     3750 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51
    37593751"RTN","C0SPROB",101,0)
    3760  ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE"
     3752 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63
    37613753"RTN","C0SPROB",102,0)
    3762  ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51
     3754 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL"
    37633755"RTN","C0SPROB",103,0)
    3764  ;^TMP("C0STBL",91,"problem",6,"provider@code")=63
     3756 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0
    37653757"RTN","C0SPROB",104,0)
    3766  ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL"
     3758 ;^TMP("C0STBL",91,"problem",6,"status@value")="A"
    37673759"RTN","C0SPROB",105,0)
    3768  ;^TMP("C0STBL",91,"problem",6,"removed@value")=0
     3760 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0
    37693761"RTN","C0SPROB",106,0)
    3770  ;^TMP("C0STBL",91,"problem",6,"status@value")="A"
     3762 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603
    37713763"RTN","C0SPROB",107,0)
    3772  ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0
     3764 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603
    37733765"RTN","C0SPROB",108,0)
    3774  ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603
     3766 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100
    37753767"RTN","C0SPROB",109,0)
    3776  ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603
     3768 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION"
    37773769"RTN","C0SPROB",110,0)
    3778  ;^TMP("C0STBL",91,"problem",7,"facility@code")=100
     3770 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09
    37793771"RTN","C0SPROB",111,0)
    3780  ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION"
     3772 ;^TMP("C0STBL",91,"problem",7,"id@value")=118
    37813773"RTN","C0SPROB",112,0)
    3782  ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09
     3774 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE"
    37833775"RTN","C0SPROB",113,0)
    3784  ;^TMP("C0STBL",91,"problem",7,"id@value")=118
     3776 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09
    37853777"RTN","C0SPROB",114,0)
    3786  ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE"
     3778 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63
    37873779"RTN","C0SPROB",115,0)
    3788  ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09
     3780 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL"
    37893781"RTN","C0SPROB",116,0)
    3790  ;^TMP("C0STBL",91,"problem",7,"provider@code")=63
     3782 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0
    37913783"RTN","C0SPROB",117,0)
    3792  ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL"
     3784 ;^TMP("C0STBL",91,"problem",7,"status@value")="A"
    37933785"RTN","C0SPROB",118,0)
    3794  ;^TMP("C0STBL",91,"problem",7,"removed@value")=0
     3786 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0
    37953787"RTN","C0SPROB",119,0)
    3796  ;^TMP("C0STBL",91,"problem",7,"status@value")="A"
     3788 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603
    37973789"RTN","C0SPROB",120,0)
    3798  ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0
     3790 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603
    37993791"RTN","C0SPROB",121,0)
    3800  ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603
     3792 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100
    38013793"RTN","C0SPROB",122,0)
    3802  ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603
     3794 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION"
    38033795"RTN","C0SPROB",123,0)
    3804  ;^TMP("C0STBL",91,"problem",8,"facility@code")=100
     3796 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00"
    38053797"RTN","C0SPROB",124,0)
    3806  ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION"
     3798 ;^TMP("C0STBL",91,"problem",8,"id@value")=119
    38073799"RTN","C0SPROB",125,0)
    3808  ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00"
     3800 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE"
    38093801"RTN","C0SPROB",126,0)
    3810  ;^TMP("C0STBL",91,"problem",8,"id@value")=119
     3802 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"
    38113803"RTN","C0SPROB",127,0)
    3812  ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE"
     3804 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63
    38133805"RTN","C0SPROB",128,0)
    3814  ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"
     3806 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL"
    38153807"RTN","C0SPROB",129,0)
    3816  ;^TMP("C0STBL",91,"problem",8,"provider@code")=63
     3808 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0
    38173809"RTN","C0SPROB",130,0)
    3818  ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL"
     3810 ;^TMP("C0STBL",91,"problem",8,"status@value")="A"
    38193811"RTN","C0SPROB",131,0)
    3820  ;^TMP("C0STBL",91,"problem",8,"removed@value")=0
     3812 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0
    38213813"RTN","C0SPROB",132,0)
    3822  ;^TMP("C0STBL",91,"problem",8,"status@value")="A"
     3814 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603
    38233815"RTN","C0SPROB",133,0)
    3824  ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0
     3816 ;
    38253817"RTN","C0SPROB",134,0)
    3826  ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603
     3818 ; sample Smart lab result triples
    38273819"RTN","C0SPROB",135,0)
    38283820 ;
    38293821"RTN","C0SPROB",136,0)
    3830  ; sample Smart lab result triples
     3822 ;G("node16rk1fgdvx10882","code")="snomed:40930008"
    38313823"RTN","C0SPROB",137,0)
    3832  ;
     3824 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism"
    38333825"RTN","C0SPROB",138,0)
    3834  ;G("node16rk1fgdvx10882","code")="snomed:40930008"
     3826 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue"
    38353827"RTN","C0SPROB",139,0)
    3836  ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism"
     3828 ;G("node16rk1fgdvx11051","code")="snomed:188155002"
    38373829"RTN","C0SPROB",140,0)
    3838  ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue"
     3830 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
    38393831"RTN","C0SPROB",141,0)
    3840  ;G("node16rk1fgdvx11051","code")="snomed:188155002"
     3832 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue"
    38413833"RTN","C0SPROB",142,0)
    3842  ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
     3834 ;G("node16rk1fgdvx11073","code")="snomed:353295004"
    38433835"RTN","C0SPROB",143,0)
    3844  ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue"
     3836 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter"
    38453837"RTN","C0SPROB",144,0)
    3846  ;G("node16rk1fgdvx11073","code")="snomed:353295004"
     3838 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue"
    38473839"RTN","C0SPROB",145,0)
    3848  ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter"
     3840 ;G("node16rk1fgdvx11089","code")="snomed:54302000"
    38493841"RTN","C0SPROB",146,0)
    3850  ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue"
     3842 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast"
    38513843"RTN","C0SPROB",147,0)
    3852  ;G("node16rk1fgdvx11089","code")="snomed:54302000"
     3844 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue"
    38533845"RTN","C0SPROB",148,0)
    3854  ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast"
     3846 ;G("node16rk1fgdvx11351","code")="snomed:38341003"
    38553847"RTN","C0SPROB",149,0)
    3856  ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue"
     3848 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension"
    38573849"RTN","C0SPROB",150,0)
    3858  ;G("node16rk1fgdvx11351","code")="snomed:38341003"
     3850 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue"
    38593851"RTN","C0SPROB",151,0)
    3860  ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension"
     3852 ;G("node16rk1fgdvx11390","code")="snomed:44054006"
    38613853"RTN","C0SPROB",152,0)
    3862  ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue"
     3854 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2"
    38633855"RTN","C0SPROB",153,0)
    3864  ;G("node16rk1fgdvx11390","code")="snomed:44054006"
     3856 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue"
    38653857"RTN","C0SPROB",154,0)
    3866  ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2"
     3858 ;G("node16rk1fgdvx11558","code")="snomed:195967001"
    38673859"RTN","C0SPROB",155,0)
    3868  ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue"
     3860 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma"
    38693861"RTN","C0SPROB",156,0)
    3870  ;G("node16rk1fgdvx11558","code")="snomed:195967001"
     3862 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue"
    38713863"RTN","C0SPROB",157,0)
    3872  ;G("node16rk1fgdvx11558","dcterms:title")="Asthma"
     3864 ;G("node16rk1fgdvx11578","code")="snomed:254837009"
    38733865"RTN","C0SPROB",158,0)
    3874  ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue"
     3866 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast"
    38753867"RTN","C0SPROB",159,0)
    3876  ;G("node16rk1fgdvx11578","code")="snomed:254837009"
     3868 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue"
    38773869"RTN","C0SPROB",160,0)
    3878  ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast"
     3870 ;G("node16rk1fgdvx11687","code")="snomed:8517006"
    38793871"RTN","C0SPROB",161,0)
    3880  ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue"
     3872 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use"
    38813873"RTN","C0SPROB",162,0)
    3882  ;G("node16rk1fgdvx11687","code")="snomed:8517006"
     3874 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue"
    38833875"RTN","C0SPROB",163,0)
    3884  ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use"
     3876 ;G("node16rk1fgdvx11716","code")="snomed:55822004"
    38853877"RTN","C0SPROB",164,0)
    3886  ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue"
     3878 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"
    38873879"RTN","C0SPROB",165,0)
    3888  ;G("node16rk1fgdvx11716","code")="snomed:55822004"
     3880 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue"
    38893881"RTN","C0SPROB",166,0)
    3890  ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"
     3882 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780"
    38913883"RTN","C0SPROB",167,0)
    3892  ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue"
     3884 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089"
    38933885"RTN","C0SPROB",168,0)
    3894  ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780"
     3886 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem"
    38953887"RTN","C0SPROB",169,0)
    3896  ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089"
     3888 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02"
    38973889"RTN","C0SPROB",170,0)
    3898  ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem"
     3890 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780"
    38993891"RTN","C0SPROB",171,0)
    3900  ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02"
     3892 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051"
    39013893"RTN","C0SPROB",172,0)
    3902  ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780"
     3894 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem"
    39033895"RTN","C0SPROB",173,0)
    3904  ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051"
     3896 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20"
    39053897"RTN","C0SPROB",174,0)
    3906  ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem"
     3898 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780"
    39073899"RTN","C0SPROB",175,0)
    3908  ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20"
     3900 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578"
    39093901"RTN","C0SPROB",176,0)
    3910  ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780"
     3902 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem"
    39113903"RTN","C0SPROB",177,0)
    3912  ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578"
     3904 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22"
    39133905"RTN","C0SPROB",178,0)
    3914  ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem"
     3906 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780"
    39153907"RTN","C0SPROB",179,0)
    3916  ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22"
     3908 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558"
    39173909"RTN","C0SPROB",180,0)
    3918  ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780"
     3910 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem"
    39193911"RTN","C0SPROB",181,0)
    3920  ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558"
     3912 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22"
    39213913"RTN","C0SPROB",182,0)
    3922  ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem"
     3914 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780"
    39233915"RTN","C0SPROB",183,0)
    3924  ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22"
     3916 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073"
    39253917"RTN","C0SPROB",184,0)
    3926  ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780"
     3918 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem"
    39273919"RTN","C0SPROB",185,0)
    3928  ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073"
     3920 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21"
    39293921"RTN","C0SPROB",186,0)
    3930  ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem"
     3922 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780"
    39313923"RTN","C0SPROB",187,0)
    3932  ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21"
     3924 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390"
    39333925"RTN","C0SPROB",188,0)
    3934  ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780"
     3926 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem"
    39353927"RTN","C0SPROB",189,0)
    3936  ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390"
     3928 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07"
    39373929"RTN","C0SPROB",190,0)
    3938  ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem"
     3930 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780"
    39393931"RTN","C0SPROB",191,0)
    3940  ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07"
     3932 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687"
    39413933"RTN","C0SPROB",192,0)
    3942  ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780"
     3934 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem"
    39433935"RTN","C0SPROB",193,0)
    3944  ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687"
     3936 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20"
    39453937"RTN","C0SPROB",194,0)
    3946  ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem"
     3938 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780"
    39473939"RTN","C0SPROB",195,0)
    3948  ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20"
     3940 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716"
    39493941"RTN","C0SPROB",196,0)
    3950  ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780"
     3942 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem"
    39513943"RTN","C0SPROB",197,0)
    3952  ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716"
     3944 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08"
    39533945"RTN","C0SPROB",198,0)
    3954  ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem"
     3946 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780"
    39553947"RTN","C0SPROB",199,0)
    3956  ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08"
     3948 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882"
    39573949"RTN","C0SPROB",200,0)
    3958  ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780"
     3950 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem"
    39593951"RTN","C0SPROB",201,0)
    3960  ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882"
     3952 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27"
    39613953"RTN","C0SPROB",202,0)
    3962  ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem"
     3954 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780"
    39633955"RTN","C0SPROB",203,0)
    3964  ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27"
     3956 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351"
    39653957"RTN","C0SPROB",204,0)
    3966  ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780"
     3958 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"
    39673959"RTN","C0SPROB",205,0)
    3968  ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351"
     3960 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22"
    39693961"RTN","C0SPROB",206,0)
    3970  ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"
     3962 ;G("snomed:188155002","dcterms:identifier")=188155002
    39713963"RTN","C0SPROB",207,0)
    3972  ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22"
     3964 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
    39733965"RTN","C0SPROB",208,0)
    3974  ;G("snomed:188155002","dcterms:identifier")=188155002
     3966 ;G("snomed:188155002","rdf:type")="sp:Code"
    39753967"RTN","C0SPROB",209,0)
    3976  ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
     3968 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    39773969"RTN","C0SPROB",210,0)
    3978  ;G("snomed:188155002","rdf:type")="sp:Code"
     3970 ;G("snomed:195967001","dcterms:identifier")=195967001
    39793971"RTN","C0SPROB",211,0)
    3980  ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     3972 ;G("snomed:195967001","dcterms:title")="Asthma"
    39813973"RTN","C0SPROB",212,0)
    3982  ;G("snomed:195967001","dcterms:identifier")=195967001
     3974 ;G("snomed:195967001","rdf:type")="sp:Code"
    39833975"RTN","C0SPROB",213,0)
    3984  ;G("snomed:195967001","dcterms:title")="Asthma"
     3976 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    39853977"RTN","C0SPROB",214,0)
    3986  ;G("snomed:195967001","rdf:type")="sp:Code"
     3978 ;G("snomed:254837009","dcterms:identifier")=254837009
    39873979"RTN","C0SPROB",215,0)
    3988  ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     3980 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast"
    39893981"RTN","C0SPROB",216,0)
    3990  ;G("snomed:254837009","dcterms:identifier")=254837009
     3982 ;G("snomed:254837009","rdf:type")="sp:Code"
    39913983"RTN","C0SPROB",217,0)
    3992  ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast"
     3984 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    39933985"RTN","C0SPROB",218,0)
    3994  ;G("snomed:254837009","rdf:type")="sp:Code"
     3986 ;G("snomed:353295004","dcterms:identifier")=353295004
    39953987"RTN","C0SPROB",219,0)
    3996  ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     3988 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter"
    39973989"RTN","C0SPROB",220,0)
    3998  ;G("snomed:353295004","dcterms:identifier")=353295004
     3990 ;G("snomed:353295004","rdf:type")="sp:Code"
    39993991"RTN","C0SPROB",221,0)
    4000  ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter"
     3992 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    40013993"RTN","C0SPROB",222,0)
    4002  ;G("snomed:353295004","rdf:type")="sp:Code"
     3994 ;G("snomed:38341003","dcterms:identifier")=38341003
    40033995"RTN","C0SPROB",223,0)
    4004  ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     3996 ;G("snomed:38341003","dcterms:title")="Essential hypertension"
    40053997"RTN","C0SPROB",224,0)
    4006  ;G("snomed:38341003","dcterms:identifier")=38341003
     3998 ;G("snomed:38341003","rdf:type")="sp:Code"
    40073999"RTN","C0SPROB",225,0)
    4008  ;G("snomed:38341003","dcterms:title")="Essential hypertension"
     4000 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    40094001"RTN","C0SPROB",226,0)
    4010  ;G("snomed:38341003","rdf:type")="sp:Code"
     4002 ;G("snomed:40930008","dcterms:identifier")=40930008
    40114003"RTN","C0SPROB",227,0)
    4012  ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4004 ;G("snomed:40930008","dcterms:title")="Hypothyroidism"
    40134005"RTN","C0SPROB",228,0)
    4014  ;G("snomed:40930008","dcterms:identifier")=40930008
     4006 ;G("snomed:40930008","rdf:type")="sp:Code"
    40154007"RTN","C0SPROB",229,0)
    4016  ;G("snomed:40930008","dcterms:title")="Hypothyroidism"
     4008 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    40174009"RTN","C0SPROB",230,0)
    4018  ;G("snomed:40930008","rdf:type")="sp:Code"
     4010 ;G("snomed:44054006","dcterms:identifier")=44054006
    40194011"RTN","C0SPROB",231,0)
    4020  ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4012 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2"
    40214013"RTN","C0SPROB",232,0)
    4022  ;G("snomed:44054006","dcterms:identifier")=44054006
     4014 ;G("snomed:44054006","rdf:type")="sp:Code"
    40234015"RTN","C0SPROB",233,0)
    4024  ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2"
     4016 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    40254017"RTN","C0SPROB",234,0)
    4026  ;G("snomed:44054006","rdf:type")="sp:Code"
     4018 ;G("snomed:54302000","dcterms:identifier")=54302000
    40274019"RTN","C0SPROB",235,0)
    4028  ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4020 ;G("snomed:54302000","dcterms:title")="Disorder of breast"
    40294021"RTN","C0SPROB",236,0)
    4030  ;G("snomed:54302000","dcterms:identifier")=54302000
     4022 ;G("snomed:54302000","rdf:type")="sp:Code"
    40314023"RTN","C0SPROB",237,0)
    4032  ;G("snomed:54302000","dcterms:title")="Disorder of breast"
     4024 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    40334025"RTN","C0SPROB",238,0)
    4034  ;G("snomed:54302000","rdf:type")="sp:Code"
     4026 ;G("snomed:55822004","dcterms:identifier")=55822004
    40354027"RTN","C0SPROB",239,0)
    4036  ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4028 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia"
    40374029"RTN","C0SPROB",240,0)
    4038  ;G("snomed:55822004","dcterms:identifier")=55822004
     4030 ;G("snomed:55822004","rdf:type")="sp:Code"
    40394031"RTN","C0SPROB",241,0)
    4040  ;G("snomed:55822004","dcterms:title")="Hyperlipidemia"
     4032 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    40414033"RTN","C0SPROB",242,0)
    4042  ;G("snomed:55822004","rdf:type")="sp:Code"
     4034 ;G("snomed:8517006","dcterms:identifier")=8517006
    40434035"RTN","C0SPROB",243,0)
    4044  ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4036 ;G("snomed:8517006","dcterms:title")="History of tobacco use"
    40454037"RTN","C0SPROB",244,0)
    4046  ;G("snomed:8517006","dcterms:identifier")=8517006
     4038 ;G("snomed:8517006","rdf:type")="sp:Code"
    40474039"RTN","C0SPROB",245,0)
    4048  ;G("snomed:8517006","dcterms:title")="History of tobacco use"
     4040 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"
    40494041"RTN","C0SPROB",246,0)
    4050  ;G("snomed:8517006","rdf:type")="sp:Code"
     4042 
    40514043"RTN","C0SPROB",247,0)
    4052  ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"
     4044 ;
    40534045"RTN","C0SPROB",248,0)
    4054  
     4046PROB(GRTN,C0SARY) ; GRTN, passed by reference,
    40554047"RTN","C0SPROB",249,0)
    4056  ;
     4048 ; is the return name of the graph created. "" if none
    40574049"RTN","C0SPROB",250,0)
    4058 PROB(GRTN,C0SARY) ; GRTN, passed by reference,
     4050 ; C0SARY is passed in by reference and is the NHIN array of problems
    40594051"RTN","C0SPROB",251,0)
    4060  ; is the return name of the graph created. "" if none
     4052 ;
    40614053"RTN","C0SPROB",252,0)
    4062  ; C0SARY is passed in by reference and is the NHIN array of problems
     4054 I $O(C0SARY("problem",""))="" D  Q  ;
    40634055"RTN","C0SPROB",253,0)
    4064  ;
     4056 . I $D(DEBUG) W !,"No Problems"
    40654057"RTN","C0SPROB",254,0)
    4066  I $O(C0SARY("problem",""))="" D  Q  ;
     4058 S GRTN="" ; default to no problems
    40674059"RTN","C0SPROB",255,0)
    4068  . I $D(DEBUG) W !,"No Problems"
     4060 N C0SGRF
    40694061"RTN","C0SPROB",256,0)
    4070  S GRTN="" ; default to no problems
     4062 S C0SGRF="vistaSmart:"_ZPATID_"/problems"
    40714063"RTN","C0SPROB",257,0)
    4072  N C0SGRF
     4064 I $D(DEBUG) W !,"Processing ",C0SGRF
    40734065"RTN","C0SPROB",258,0)
    4074  S C0SGRF="vistaSmart:"_ZPATID_"/problems"
     4066 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
    40754067"RTN","C0SPROB",259,0)
    4076  I $D(DEBUG) W !,"Processing ",C0SGRF
     4068 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
    40774069"RTN","C0SPROB",260,0)
    4078  D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
     4070 N FARY S FARY="C0XFARY"
    40794071"RTN","C0SPROB",261,0)
    4080  D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
     4072 D USEFARY^C0XF2N(FARY)
    40814073"RTN","C0SPROB",262,0)
    4082  N FARY S FARY="C0XFARY"
     4074 D VOCINIT^C0XUTIL
    40834075"RTN","C0SPROB",263,0)
    4084  D USEFARY^C0XF2N(FARY)
     4076 ;
    40854077"RTN","C0SPROB",264,0)
    4086  D VOCINIT^C0XUTIL
     4078 D STARTADD^C0XF2N ; initialize to create triples
    40874079"RTN","C0SPROB",265,0)
    40884080 ;
    40894081"RTN","C0SPROB",266,0)
    4090  D STARTADD^C0XF2N ; initialize to create triples
     4082 N ZI S ZI=""
    40914083"RTN","C0SPROB",267,0)
    4092  ;
     4084 F  S ZI=$O(C0SARY("problem",ZI)) Q:ZI=""  D  ;
    40934085"RTN","C0SPROB",268,0)
    4094  N ZI S ZI=""
     4086 . N LRN,ZR ; ZR is the local array for building the new triples
    40954087"RTN","C0SPROB",269,0)
    4096  F  S ZI=$O(C0SARY("problem",ZI)) Q:ZI=""  D  ;
     4088 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result
    40974089"RTN","C0SPROB",270,0)
    4098  . N LRN,ZR ; ZR is the local array for building the new triples
     4090 . ;
    40994091"RTN","C0SPROB",271,0)
    4100  . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result
     4092 . N PROBID ; unique Id for this problem
    41014093"RTN","C0SPROB",272,0)
     4094 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
     4095"RTN","C0SPROB",273,0)
    41024096 . ;
    4103 "RTN","C0SPROB",273,0)
    4104  . N PROBID ; unique Id for this problem
    41054097"RTN","C0SPROB",274,0)
    4106  . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
     4098 . ; i don't like this because the same problems gets a
    41074099"RTN","C0SPROB",275,0)
     4100 . ; different ID every time it's reported. Can't trace it back to VistA
     4101"RTN","C0SPROB",276,0)
     4102 . ; I'd rather be using id@value ie "id@value")="118"
     4103"RTN","C0SPROB",277,0)
    41084104 . ;
    4109 "RTN","C0SPROB",276,0)
    4110  . ; i don't like this because the same problems gets a
    4111 "RTN","C0SPROB",277,0)
    4112  . ; different ID every time it's reported. Can't trace it back to VistA
    41134105"RTN","C0SPROB",278,0)
    4114  . ; I'd rather be using id@value ie "id@value")="118"
     4106 . N SNOMED S SNOMED=$G(@LRN@("icd@value"))
    41154107"RTN","C0SPROB",279,0)
     4108 . N SNOGRF S SNOGRF="snomed:"_SNOMED
     4109"RTN","C0SPROB",280,0)
     4110 . N SNOTIT S SNOTIT=$G(@LRN@("name@value"))
     4111"RTN","C0SPROB",281,0)
     4112 . I $D(DEBUG) D  ;
     4113"RTN","C0SPROB",282,0)
     4114 . . W !,"Processing Problem List ",PROBID
     4115"RTN","C0SPROB",283,0)
     4116 . . W !,"problem: ",SNOTIT
     4117"RTN","C0SPROB",284,0)
     4118 . . W !,"code: ",SNOMED
     4119"RTN","C0SPROB",285,0)
    41164120 . ;
    4117 "RTN","C0SPROB",280,0)
    4118  . N SNOMED S SNOMED=$G(@LRN@("icd@value"))
    4119 "RTN","C0SPROB",281,0)
    4120  . N SNOGRF S SNOGRF="snomed:"_SNOMED
    4121 "RTN","C0SPROB",282,0)
    4122  . N SNOTIT S SNOTIT=$G(@LRN@("name@value"))
    4123 "RTN","C0SPROB",283,0)
    4124  . I $D(DEBUG) D  ;
    4125 "RTN","C0SPROB",284,0)
    4126  . . W !,"Processing Problem List ",PROBID
    4127 "RTN","C0SPROB",285,0)
    4128  . . W !,"problem: ",SNOTIT
    41294121"RTN","C0SPROB",286,0)
    4130  . . W !,"code: ",SNOMED
     4122 . ; first do the base result graph
    41314123"RTN","C0SPROB",287,0)
    41324124 . ;
    41334125"RTN","C0SPROB",288,0)
    4134  . ; first do the base result graph
     4126 . S ZR("rdf:type")="sp:Problem"
    41354127"RTN","C0SPROB",289,0)
     4128 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems
     4129"RTN","C0SPROB",290,0)
     4130 . ; ie /vista/smart/99912345/problems
     4131"RTN","C0SPROB",291,0)
    41364132 . ;
    4137 "RTN","C0SPROB",290,0)
    4138  . S ZR("rdf:type")="sp:Problem"
    4139 "RTN","C0SPROB",291,0)
    4140  . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems
    41414133"RTN","C0SPROB",292,0)
    4142  . ; ie /vista/smart/99912345/problems
     4134 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name
    41434135"RTN","C0SPROB",293,0)
     4136 . S ZR("sp:problemName")=PROBNAME
     4137"RTN","C0SPROB",294,0)
    41444138 . ;
    4145 "RTN","C0SPROB",294,0)
    4146  . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name
    41474139"RTN","C0SPROB",295,0)
    4148  . S ZR("sp:problemName")=PROBNAME
     4140 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))
    41494141"RTN","C0SPROB",296,0)
     4142 . S ZR("sp:startDate")=STARTDT
     4143"RTN","C0SPROB",297,0)
    41504144 . ;
    4151 "RTN","C0SPROB",297,0)
    4152  . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))
    41534145"RTN","C0SPROB",298,0)
    4154  . S ZR("sp:startDate")=STARTDT
     4146 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples
    41554147"RTN","C0SPROB",299,0)
     4148 . K ZR ; clean up
     4149"RTN","C0SPROB",300,0)
    41564150 . ;
    4157 "RTN","C0SPROB",300,0)
    4158  . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples
    41594151"RTN","C0SPROB",301,0)
    4160  . K ZR ; clean up
     4152 . ; create the problemName graph
    41614153"RTN","C0SPROB",302,0)
    41624154 . ;
    41634155"RTN","C0SPROB",303,0)
    4164  . ; create the problemName graph
     4156 . S ZR("rdf:type")="sp:CodedValue"
    41654157"RTN","C0SPROB",304,0)
     4158 . S ZR("sp:code")="snomed:"_SNOMED
     4159"RTN","C0SPROB",305,0)
     4160 . S ZR("dcterms:title")=$G(@LRN@("name@value"))
     4161"RTN","C0SPROB",306,0)
     4162 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR)
     4163"RTN","C0SPROB",307,0)
     4164 . K ZR
     4165"RTN","C0SPROB",308,0)
    41664166 . ;
    4167 "RTN","C0SPROB",305,0)
    4168  . S ZR("rdf:type")="sp:CodedValue"
    4169 "RTN","C0SPROB",306,0)
    4170  . S ZR("sp:code")="snomed:"_SNOMED
    4171 "RTN","C0SPROB",307,0)
    4172  . S ZR("dcterms:title")=$G(@LRN@("name@value"))
    4173 "RTN","C0SPROB",308,0)
    4174  . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR)
    41754167"RTN","C0SPROB",309,0)
     4168 . ; create snomed graph
     4169"RTN","C0SPROB",310,0)
     4170 . ;
     4171"RTN","C0SPROB",311,0)
     4172 . S ZR("rdf:type")="sp:Code"
     4173"RTN","C0SPROB",312,0)
     4174 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4175"RTN","C0SPROB",313,0)
     4176 . S ZR("dcterms:identifier")=SNOMED
     4177"RTN","C0SPROB",314,0)
     4178 . S ZR("dcterms:title")=SNOTIT
     4179"RTN","C0SPROB",315,0)
     4180 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)
     4181"RTN","C0SPROB",316,0)
    41764182 . K ZR
    4177 "RTN","C0SPROB",310,0)
     4183"RTN","C0SPROB",317,0)
    41784184 . ;
    4179 "RTN","C0SPROB",311,0)
    4180  . ; create snomed graph
    4181 "RTN","C0SPROB",312,0)
    4182  . ;
    4183 "RTN","C0SPROB",313,0)
    4184  . S ZR("rdf:type")="sp:Code"
    4185 "RTN","C0SPROB",314,0)
    4186  . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    4187 "RTN","C0SPROB",315,0)
    4188  . S ZR("dcterms:identifier")=SNOMED
    4189 "RTN","C0SPROB",316,0)
    4190  . S ZR("dcterms:title")=SNOTIT
    4191 "RTN","C0SPROB",317,0)
    4192  . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)
    41934185"RTN","C0SPROB",318,0)
    4194  . K ZR
     4186 D BULKLOAD^C0XF2N(.C0XFDA)
    41954187"RTN","C0SPROB",319,0)
    4196  . ;
     4188 S GRTN=C0SGRF
    41974189"RTN","C0SPROB",320,0)
    4198  D BULKLOAD^C0XF2N(.C0XFDA)
     4190 Q
    41994191"RTN","C0SPROB",321,0)
    4200  S GRTN=C0SGRF
    4201 "RTN","C0SPROB",322,0)
    4202  Q
    4203 "RTN","C0SPROB",323,0)
    42044192 ;
    42054193"RTN","C0SPROB2")
    4206 0^10^B67594874
     41940^10^B67175408
    42074195"RTN","C0SPROB2",1,0)
    42084196C0SPROB   ; GPL - Smart Problem Processing ;5/01/12  17:05
    42094197"RTN","C0SPROB2",2,0)
    4210  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     4198 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    42114199"RTN","C0SPROB2",3,0)
    4212  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     4200 ;Copyright 2012 George Lilly. 
    42134201"RTN","C0SPROB2",4,0)
    4214  ;General Public License See attached copy of the License.
     4202 ;
    42154203"RTN","C0SPROB2",5,0)
    4216  ;
     4204 ; This program is free software: you can redistribute it and/or modify
    42174205"RTN","C0SPROB2",6,0)
    4218  ;This program is free software; you can redistribute it and/or modify
     4206 ; it under the terms of the GNU Affero General Public License as
    42194207"RTN","C0SPROB2",7,0)
    4220  ;it under the terms of the GNU General Public License as published by
     4208 ; published by the Free Software Foundation, either version 3 of the
    42214209"RTN","C0SPROB2",8,0)
    4222  ;the Free Software Foundation; either version 2 of the License, or
     4210 ; License, or (at your option) any later version.
    42234211"RTN","C0SPROB2",9,0)
    4224  ;(at your option) any later version.
     4212 ;
    42254213"RTN","C0SPROB2",10,0)
    4226  ;
     4214 ; This program is distributed in the hope that it will be useful,
    42274215"RTN","C0SPROB2",11,0)
    4228  ;This program is distributed in the hope that it will be useful,
     4216 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    42294217"RTN","C0SPROB2",12,0)
    4230  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     4218 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    42314219"RTN","C0SPROB2",13,0)
    4232  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     4220 ; GNU Affero General Public License for more details.
    42334221"RTN","C0SPROB2",14,0)
    4234  ;GNU General Public License for more details.
     4222 ;
    42354223"RTN","C0SPROB2",15,0)
    4236  ;
     4224 ; You should have received a copy of the GNU Affero General Public License
    42374225"RTN","C0SPROB2",16,0)
    4238  ;You should have received a copy of the GNU General Public License along
     4226 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    42394227"RTN","C0SPROB2",17,0)
    4240  ;with this program; if not, write to the Free Software Foundation, Inc.,
     4228 ;
    42414229"RTN","C0SPROB2",18,0)
    4242  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     4230 Q
    42434231"RTN","C0SPROB2",19,0)
    42444232 ;
    42454233"RTN","C0SPROB2",20,0)
    4246  Q
     4234 ; sample VistA NHIN problem list
    42474235"RTN","C0SPROB2",21,0)
    42484236 ;
    42494237"RTN","C0SPROB2",22,0)
    4250  ; sample VistA NHIN problem list
     4238 ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C"
    42514239"RTN","C0SPROB2",23,0)
    4252  ;
     4240 ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531
    42534241"RTN","C0SPROB2",24,0)
    4254  ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C"
     4242 ;^TMP("C0STBL",91,"problem",1,"facility@code")=100
    42554243"RTN","C0SPROB2",25,0)
    4256  ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531
     4244 ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION"
    42574245"RTN","C0SPROB2",26,0)
    4258  ;^TMP("C0STBL",91,"problem",1,"facility@code")=100
     4246 ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9
    42594247"RTN","C0SPROB2",27,0)
    4260  ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION"
     4248 ;^TMP("C0STBL",91,"problem",1,"id@value")=100
    42614249"RTN","C0SPROB2",28,0)
    4262  ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9
     4250 ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE"
    42634251"RTN","C0SPROB2",29,0)
    4264  ;^TMP("C0STBL",91,"problem",1,"id@value")=100
     4252 ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease"
    42654253"RTN","C0SPROB2",30,0)
    4266  ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE"
     4254 ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201
    42674255"RTN","C0SPROB2",31,0)
    4268  ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease"
     4256 ;^TMP("C0STBL",91,"problem",1,"provider@code")=63
    42694257"RTN","C0SPROB2",32,0)
    4270  ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201
     4258 ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL"
    42714259"RTN","C0SPROB2",33,0)
    4272  ;^TMP("C0STBL",91,"problem",1,"provider@code")=63
     4260 ;^TMP("C0STBL",91,"problem",1,"removed@value")=0
    42734261"RTN","C0SPROB2",34,0)
    4274  ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL"
     4262 ;^TMP("C0STBL",91,"problem",1,"sc@value")=0
    42754263"RTN","C0SPROB2",35,0)
    4276  ;^TMP("C0STBL",91,"problem",1,"removed@value")=0
     4264 ;^TMP("C0STBL",91,"problem",1,"status@value")="A"
    42774265"RTN","C0SPROB2",36,0)
    4278  ;^TMP("C0STBL",91,"problem",1,"sc@value")=0
     4266 ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0
    42794267"RTN","C0SPROB2",37,0)
    4280  ;^TMP("C0STBL",91,"problem",1,"status@value")="A"
     4268 ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531
    42814269"RTN","C0SPROB2",38,0)
    4282  ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0
     4270 ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C"
    42834271"RTN","C0SPROB2",39,0)
    4284  ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531
     4272 ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602
    42854273"RTN","C0SPROB2",40,0)
    4286  ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C"
     4274 ;^TMP("C0STBL",91,"problem",2,"facility@code")=100
    42874275"RTN","C0SPROB2",41,0)
    4288  ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602
     4276 ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION"
    42894277"RTN","C0SPROB2",42,0)
    4290  ;^TMP("C0STBL",91,"problem",2,"facility@code")=100
     4278 ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2
    42914279"RTN","C0SPROB2",43,0)
    4292  ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION"
     4280 ;^TMP("C0STBL",91,"problem",2,"id@value")=108
    42934281"RTN","C0SPROB2",44,0)
    4294  ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2
     4282 ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse"
    42954283"RTN","C0SPROB2",45,0)
    4296  ;^TMP("C0STBL",91,"problem",2,"id@value")=108
     4284 ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102
    42974285"RTN","C0SPROB2",46,0)
    4298  ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse"
     4286 ;^TMP("C0STBL",91,"problem",2,"provider@code")=63
    42994287"RTN","C0SPROB2",47,0)
    4300  ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102
     4288 ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL"
    43014289"RTN","C0SPROB2",48,0)
    4302  ;^TMP("C0STBL",91,"problem",2,"provider@code")=63
     4290 ;^TMP("C0STBL",91,"problem",2,"removed@value")=0
    43034291"RTN","C0SPROB2",49,0)
    4304  ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL"
     4292 ;^TMP("C0STBL",91,"problem",2,"sc@value")=0
    43054293"RTN","C0SPROB2",50,0)
    4306  ;^TMP("C0STBL",91,"problem",2,"removed@value")=0
     4294 ;^TMP("C0STBL",91,"problem",2,"status@value")="A"
    43074295"RTN","C0SPROB2",51,0)
    4308  ;^TMP("C0STBL",91,"problem",2,"sc@value")=0
     4296 ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0
    43094297"RTN","C0SPROB2",52,0)
    4310  ;^TMP("C0STBL",91,"problem",2,"status@value")="A"
     4298 ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602
    43114299"RTN","C0SPROB2",53,0)
    4312  ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0
     4300 ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C"
    43134301"RTN","C0SPROB2",54,0)
    4314  ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602
     4302 ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602
    43154303"RTN","C0SPROB2",55,0)
    4316  ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C"
     4304 ;^TMP("C0STBL",91,"problem",3,"facility@code")=100
    43174305"RTN","C0SPROB2",56,0)
    4318  ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602
     4306 ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION"
    43194307"RTN","C0SPROB2",57,0)
    4320  ;^TMP("C0STBL",91,"problem",3,"facility@code")=100
     4308 ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91
    43214309"RTN","C0SPROB2",58,0)
    4322  ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION"
     4310 ;^TMP("C0STBL",91,"problem",3,"id@value")=109
    43234311"RTN","C0SPROB2",59,0)
    4324  ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91
     4312 ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"
    43254313"RTN","C0SPROB2",60,0)
    4326  ;^TMP("C0STBL",91,"problem",3,"id@value")=109
     4314 ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101
    43274315"RTN","C0SPROB2",61,0)
    4328  ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio"
     4316 ;^TMP("C0STBL",91,"problem",3,"provider@code")=63
    43294317"RTN","C0SPROB2",62,0)
    4330  ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101
     4318 ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL"
    43314319"RTN","C0SPROB2",63,0)
    4332  ;^TMP("C0STBL",91,"problem",3,"provider@code")=63
     4320 ;^TMP("C0STBL",91,"problem",3,"removed@value")=0
    43334321"RTN","C0SPROB2",64,0)
    4334  ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL"
     4322 ;^TMP("C0STBL",91,"problem",3,"sc@value")=0
    43354323"RTN","C0SPROB2",65,0)
    4336  ;^TMP("C0STBL",91,"problem",3,"removed@value")=0
     4324 ;^TMP("C0STBL",91,"problem",3,"status@value")="A"
    43374325"RTN","C0SPROB2",66,0)
    4338  ;^TMP("C0STBL",91,"problem",3,"sc@value")=0
     4326 ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0
    43394327"RTN","C0SPROB2",67,0)
    4340  ;^TMP("C0STBL",91,"problem",3,"status@value")="A"
     4328 ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602
    43414329"RTN","C0SPROB2",68,0)
    4342  ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0
     4330 ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603
    43434331"RTN","C0SPROB2",69,0)
    4344  ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602
     4332 ;^TMP("C0STBL",91,"problem",4,"facility@code")=100
    43454333"RTN","C0SPROB2",70,0)
    4346  ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603
     4334 ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION"
    43474335"RTN","C0SPROB2",71,0)
    4348  ;^TMP("C0STBL",91,"problem",4,"facility@code")=100
     4336 ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66"
    43494337"RTN","C0SPROB2",72,0)
    4350  ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION"
     4338 ;^TMP("C0STBL",91,"problem",4,"id@value")=115
    43514339"RTN","C0SPROB2",73,0)
    4352  ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66"
     4340 ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE"
    43534341"RTN","C0SPROB2",74,0)
    4354  ;^TMP("C0STBL",91,"problem",4,"id@value")=115
     4342 ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66"
    43554343"RTN","C0SPROB2",75,0)
    4356  ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE"
     4344 ;^TMP("C0STBL",91,"problem",4,"provider@code")=63
    43574345"RTN","C0SPROB2",76,0)
    4358  ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66"
     4346 ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL"
    43594347"RTN","C0SPROB2",77,0)
    4360  ;^TMP("C0STBL",91,"problem",4,"provider@code")=63
     4348 ;^TMP("C0STBL",91,"problem",4,"removed@value")=0
    43614349"RTN","C0SPROB2",78,0)
    4362  ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL"
     4350 ;^TMP("C0STBL",91,"problem",4,"status@value")="A"
    43634351"RTN","C0SPROB2",79,0)
    4364  ;^TMP("C0STBL",91,"problem",4,"removed@value")=0
     4352 ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0
    43654353"RTN","C0SPROB2",80,0)
    4366  ;^TMP("C0STBL",91,"problem",4,"status@value")="A"
     4354 ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603
    43674355"RTN","C0SPROB2",81,0)
    4368  ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0
     4356 ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603
    43694357"RTN","C0SPROB2",82,0)
    4370  ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603
     4358 ;^TMP("C0STBL",91,"problem",5,"facility@code")=100
    43714359"RTN","C0SPROB2",83,0)
    4372  ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603
     4360 ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION"
    43734361"RTN","C0SPROB2",84,0)
    4374  ;^TMP("C0STBL",91,"problem",5,"facility@code")=100
     4362 ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21
    43754363"RTN","C0SPROB2",85,0)
    4376  ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION"
     4364 ;^TMP("C0STBL",91,"problem",5,"id@value")=116
    43774365"RTN","C0SPROB2",86,0)
    4378  ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21
     4366 ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE"
    43794367"RTN","C0SPROB2",87,0)
    4380  ;^TMP("C0STBL",91,"problem",5,"id@value")=116
     4368 ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21
    43814369"RTN","C0SPROB2",88,0)
    4382  ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE"
     4370 ;^TMP("C0STBL",91,"problem",5,"provider@code")=63
    43834371"RTN","C0SPROB2",89,0)
    4384  ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21
     4372 ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL"
    43854373"RTN","C0SPROB2",90,0)
    4386  ;^TMP("C0STBL",91,"problem",5,"provider@code")=63
     4374 ;^TMP("C0STBL",91,"problem",5,"removed@value")=0
    43874375"RTN","C0SPROB2",91,0)
    4388  ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL"
     4376 ;^TMP("C0STBL",91,"problem",5,"status@value")="A"
    43894377"RTN","C0SPROB2",92,0)
    4390  ;^TMP("C0STBL",91,"problem",5,"removed@value")=0
     4378 ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0
    43914379"RTN","C0SPROB2",93,0)
    4392  ;^TMP("C0STBL",91,"problem",5,"status@value")="A"
     4380 ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603
    43934381"RTN","C0SPROB2",94,0)
    4394  ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0
     4382 ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603
    43954383"RTN","C0SPROB2",95,0)
    4396  ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603
     4384 ;^TMP("C0STBL",91,"problem",6,"facility@code")=100
    43974385"RTN","C0SPROB2",96,0)
    4398  ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603
     4386 ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION"
    43994387"RTN","C0SPROB2",97,0)
    4400  ;^TMP("C0STBL",91,"problem",6,"facility@code")=100
     4388 ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51
    44014389"RTN","C0SPROB2",98,0)
    4402  ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION"
     4390 ;^TMP("C0STBL",91,"problem",6,"id@value")=117
    44034391"RTN","C0SPROB2",99,0)
    4404  ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51
     4392 ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE"
    44054393"RTN","C0SPROB2",100,0)
    4406  ;^TMP("C0STBL",91,"problem",6,"id@value")=117
     4394 ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51
    44074395"RTN","C0SPROB2",101,0)
    4408  ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE"
     4396 ;^TMP("C0STBL",91,"problem",6,"provider@code")=63
    44094397"RTN","C0SPROB2",102,0)
    4410  ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51
     4398 ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL"
    44114399"RTN","C0SPROB2",103,0)
    4412  ;^TMP("C0STBL",91,"problem",6,"provider@code")=63
     4400 ;^TMP("C0STBL",91,"problem",6,"removed@value")=0
    44134401"RTN","C0SPROB2",104,0)
    4414  ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL"
     4402 ;^TMP("C0STBL",91,"problem",6,"status@value")="A"
    44154403"RTN","C0SPROB2",105,0)
    4416  ;^TMP("C0STBL",91,"problem",6,"removed@value")=0
     4404 ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0
    44174405"RTN","C0SPROB2",106,0)
    4418  ;^TMP("C0STBL",91,"problem",6,"status@value")="A"
     4406 ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603
    44194407"RTN","C0SPROB2",107,0)
    4420  ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0
     4408 ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603
    44214409"RTN","C0SPROB2",108,0)
    4422  ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603
     4410 ;^TMP("C0STBL",91,"problem",7,"facility@code")=100
    44234411"RTN","C0SPROB2",109,0)
    4424  ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603
     4412 ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION"
    44254413"RTN","C0SPROB2",110,0)
    4426  ;^TMP("C0STBL",91,"problem",7,"facility@code")=100
     4414 ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09
    44274415"RTN","C0SPROB2",111,0)
    4428  ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION"
     4416 ;^TMP("C0STBL",91,"problem",7,"id@value")=118
    44294417"RTN","C0SPROB2",112,0)
    4430  ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09
     4418 ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE"
    44314419"RTN","C0SPROB2",113,0)
    4432  ;^TMP("C0STBL",91,"problem",7,"id@value")=118
     4420 ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09
    44334421"RTN","C0SPROB2",114,0)
    4434  ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE"
     4422 ;^TMP("C0STBL",91,"problem",7,"provider@code")=63
    44354423"RTN","C0SPROB2",115,0)
    4436  ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09
     4424 ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL"
    44374425"RTN","C0SPROB2",116,0)
    4438  ;^TMP("C0STBL",91,"problem",7,"provider@code")=63
     4426 ;^TMP("C0STBL",91,"problem",7,"removed@value")=0
    44394427"RTN","C0SPROB2",117,0)
    4440  ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL"
     4428 ;^TMP("C0STBL",91,"problem",7,"status@value")="A"
    44414429"RTN","C0SPROB2",118,0)
    4442  ;^TMP("C0STBL",91,"problem",7,"removed@value")=0
     4430 ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0
    44434431"RTN","C0SPROB2",119,0)
    4444  ;^TMP("C0STBL",91,"problem",7,"status@value")="A"
     4432 ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603
    44454433"RTN","C0SPROB2",120,0)
    4446  ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0
     4434 ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603
    44474435"RTN","C0SPROB2",121,0)
    4448  ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603
     4436 ;^TMP("C0STBL",91,"problem",8,"facility@code")=100
    44494437"RTN","C0SPROB2",122,0)
    4450  ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603
     4438 ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION"
    44514439"RTN","C0SPROB2",123,0)
    4452  ;^TMP("C0STBL",91,"problem",8,"facility@code")=100
     4440 ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00"
    44534441"RTN","C0SPROB2",124,0)
    4454  ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION"
     4442 ;^TMP("C0STBL",91,"problem",8,"id@value")=119
    44554443"RTN","C0SPROB2",125,0)
    4456  ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00"
     4444 ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE"
    44574445"RTN","C0SPROB2",126,0)
    4458  ;^TMP("C0STBL",91,"problem",8,"id@value")=119
     4446 ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"
    44594447"RTN","C0SPROB2",127,0)
    4460  ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE"
     4448 ;^TMP("C0STBL",91,"problem",8,"provider@code")=63
    44614449"RTN","C0SPROB2",128,0)
    4462  ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type,"
     4450 ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL"
    44634451"RTN","C0SPROB2",129,0)
    4464  ;^TMP("C0STBL",91,"problem",8,"provider@code")=63
     4452 ;^TMP("C0STBL",91,"problem",8,"removed@value")=0
    44654453"RTN","C0SPROB2",130,0)
    4466  ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL"
     4454 ;^TMP("C0STBL",91,"problem",8,"status@value")="A"
    44674455"RTN","C0SPROB2",131,0)
    4468  ;^TMP("C0STBL",91,"problem",8,"removed@value")=0
     4456 ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0
    44694457"RTN","C0SPROB2",132,0)
    4470  ;^TMP("C0STBL",91,"problem",8,"status@value")="A"
     4458 ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603
    44714459"RTN","C0SPROB2",133,0)
    4472  ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0
     4460 ;
    44734461"RTN","C0SPROB2",134,0)
    4474  ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603
     4462 ; sample Smart lab result triples
    44754463"RTN","C0SPROB2",135,0)
    44764464 ;
    44774465"RTN","C0SPROB2",136,0)
    4478  ; sample Smart lab result triples
     4466 ;G("node16rk1fgdvx10882","code")="snomed:40930008"
    44794467"RTN","C0SPROB2",137,0)
    4480  ;
     4468 ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism"
    44814469"RTN","C0SPROB2",138,0)
    4482  ;G("node16rk1fgdvx10882","code")="snomed:40930008"
     4470 ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue"
    44834471"RTN","C0SPROB2",139,0)
    4484  ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism"
     4472 ;G("node16rk1fgdvx11051","code")="snomed:188155002"
    44854473"RTN","C0SPROB2",140,0)
    4486  ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue"
     4474 ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
    44874475"RTN","C0SPROB2",141,0)
    4488  ;G("node16rk1fgdvx11051","code")="snomed:188155002"
     4476 ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue"
    44894477"RTN","C0SPROB2",142,0)
    4490  ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
     4478 ;G("node16rk1fgdvx11073","code")="snomed:353295004"
    44914479"RTN","C0SPROB2",143,0)
    4492  ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue"
     4480 ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter"
    44934481"RTN","C0SPROB2",144,0)
    4494  ;G("node16rk1fgdvx11073","code")="snomed:353295004"
     4482 ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue"
    44954483"RTN","C0SPROB2",145,0)
    4496  ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter"
     4484 ;G("node16rk1fgdvx11089","code")="snomed:54302000"
    44974485"RTN","C0SPROB2",146,0)
    4498  ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue"
     4486 ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast"
    44994487"RTN","C0SPROB2",147,0)
    4500  ;G("node16rk1fgdvx11089","code")="snomed:54302000"
     4488 ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue"
    45014489"RTN","C0SPROB2",148,0)
    4502  ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast"
     4490 ;G("node16rk1fgdvx11351","code")="snomed:38341003"
    45034491"RTN","C0SPROB2",149,0)
    4504  ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue"
     4492 ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension"
    45054493"RTN","C0SPROB2",150,0)
    4506  ;G("node16rk1fgdvx11351","code")="snomed:38341003"
     4494 ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue"
    45074495"RTN","C0SPROB2",151,0)
    4508  ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension"
     4496 ;G("node16rk1fgdvx11390","code")="snomed:44054006"
    45094497"RTN","C0SPROB2",152,0)
    4510  ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue"
     4498 ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2"
    45114499"RTN","C0SPROB2",153,0)
    4512  ;G("node16rk1fgdvx11390","code")="snomed:44054006"
     4500 ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue"
    45134501"RTN","C0SPROB2",154,0)
    4514  ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2"
     4502 ;G("node16rk1fgdvx11558","code")="snomed:195967001"
    45154503"RTN","C0SPROB2",155,0)
    4516  ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue"
     4504 ;G("node16rk1fgdvx11558","dcterms:title")="Asthma"
    45174505"RTN","C0SPROB2",156,0)
    4518  ;G("node16rk1fgdvx11558","code")="snomed:195967001"
     4506 ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue"
    45194507"RTN","C0SPROB2",157,0)
    4520  ;G("node16rk1fgdvx11558","dcterms:title")="Asthma"
     4508 ;G("node16rk1fgdvx11578","code")="snomed:254837009"
    45214509"RTN","C0SPROB2",158,0)
    4522  ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue"
     4510 ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast"
    45234511"RTN","C0SPROB2",159,0)
    4524  ;G("node16rk1fgdvx11578","code")="snomed:254837009"
     4512 ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue"
    45254513"RTN","C0SPROB2",160,0)
    4526  ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast"
     4514 ;G("node16rk1fgdvx11687","code")="snomed:8517006"
    45274515"RTN","C0SPROB2",161,0)
    4528  ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue"
     4516 ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use"
    45294517"RTN","C0SPROB2",162,0)
    4530  ;G("node16rk1fgdvx11687","code")="snomed:8517006"
     4518 ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue"
    45314519"RTN","C0SPROB2",163,0)
    4532  ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use"
     4520 ;G("node16rk1fgdvx11716","code")="snomed:55822004"
    45334521"RTN","C0SPROB2",164,0)
    4534  ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue"
     4522 ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"
    45354523"RTN","C0SPROB2",165,0)
    4536  ;G("node16rk1fgdvx11716","code")="snomed:55822004"
     4524 ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue"
    45374525"RTN","C0SPROB2",166,0)
    4538  ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia"
     4526 ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780"
    45394527"RTN","C0SPROB2",167,0)
    4540  ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue"
     4528 ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089"
    45414529"RTN","C0SPROB2",168,0)
    4542  ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780"
     4530 ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem"
    45434531"RTN","C0SPROB2",169,0)
    4544  ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089"
     4532 ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02"
    45454533"RTN","C0SPROB2",170,0)
    4546  ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem"
     4534 ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780"
    45474535"RTN","C0SPROB2",171,0)
    4548  ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02"
     4536 ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051"
    45494537"RTN","C0SPROB2",172,0)
    4550  ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780"
     4538 ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem"
    45514539"RTN","C0SPROB2",173,0)
    4552  ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051"
     4540 ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20"
    45534541"RTN","C0SPROB2",174,0)
    4554  ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem"
     4542 ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780"
    45554543"RTN","C0SPROB2",175,0)
    4556  ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20"
     4544 ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578"
    45574545"RTN","C0SPROB2",176,0)
    4558  ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780"
     4546 ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem"
    45594547"RTN","C0SPROB2",177,0)
    4560  ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578"
     4548 ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22"
    45614549"RTN","C0SPROB2",178,0)
    4562  ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem"
     4550 ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780"
    45634551"RTN","C0SPROB2",179,0)
    4564  ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22"
     4552 ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558"
    45654553"RTN","C0SPROB2",180,0)
    4566  ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780"
     4554 ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem"
    45674555"RTN","C0SPROB2",181,0)
    4568  ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558"
     4556 ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22"
    45694557"RTN","C0SPROB2",182,0)
    4570  ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem"
     4558 ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780"
    45714559"RTN","C0SPROB2",183,0)
    4572  ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22"
     4560 ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073"
    45734561"RTN","C0SPROB2",184,0)
    4574  ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780"
     4562 ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem"
    45754563"RTN","C0SPROB2",185,0)
    4576  ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073"
     4564 ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21"
    45774565"RTN","C0SPROB2",186,0)
    4578  ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem"
     4566 ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780"
    45794567"RTN","C0SPROB2",187,0)
    4580  ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21"
     4568 ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390"
    45814569"RTN","C0SPROB2",188,0)
    4582  ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780"
     4570 ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem"
    45834571"RTN","C0SPROB2",189,0)
    4584  ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390"
     4572 ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07"
    45854573"RTN","C0SPROB2",190,0)
    4586  ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem"
     4574 ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780"
    45874575"RTN","C0SPROB2",191,0)
    4588  ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07"
     4576 ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687"
    45894577"RTN","C0SPROB2",192,0)
    4590  ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780"
     4578 ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem"
    45914579"RTN","C0SPROB2",193,0)
    4592  ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687"
     4580 ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20"
    45934581"RTN","C0SPROB2",194,0)
    4594  ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem"
     4582 ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780"
    45954583"RTN","C0SPROB2",195,0)
    4596  ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20"
     4584 ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716"
    45974585"RTN","C0SPROB2",196,0)
    4598  ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780"
     4586 ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem"
    45994587"RTN","C0SPROB2",197,0)
    4600  ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716"
     4588 ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08"
    46014589"RTN","C0SPROB2",198,0)
    4602  ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem"
     4590 ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780"
    46034591"RTN","C0SPROB2",199,0)
    4604  ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08"
     4592 ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882"
    46054593"RTN","C0SPROB2",200,0)
    4606  ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780"
     4594 ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem"
    46074595"RTN","C0SPROB2",201,0)
    4608  ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882"
     4596 ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27"
    46094597"RTN","C0SPROB2",202,0)
    4610  ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem"
     4598 ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780"
    46114599"RTN","C0SPROB2",203,0)
    4612  ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27"
     4600 ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351"
    46134601"RTN","C0SPROB2",204,0)
    4614  ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780"
     4602 ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"
    46154603"RTN","C0SPROB2",205,0)
    4616  ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351"
     4604 ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22"
    46174605"RTN","C0SPROB2",206,0)
    4618  ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem"
     4606 ;G("snomed:188155002","dcterms:identifier")=188155002
    46194607"RTN","C0SPROB2",207,0)
    4620  ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22"
     4608 ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
    46214609"RTN","C0SPROB2",208,0)
    4622  ;G("snomed:188155002","dcterms:identifier")=188155002
     4610 ;G("snomed:188155002","rdf:type")="sp:Code"
    46234611"RTN","C0SPROB2",209,0)
    4624  ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast"
     4612 ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46254613"RTN","C0SPROB2",210,0)
    4626  ;G("snomed:188155002","rdf:type")="sp:Code"
     4614 ;G("snomed:195967001","dcterms:identifier")=195967001
    46274615"RTN","C0SPROB2",211,0)
    4628  ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4616 ;G("snomed:195967001","dcterms:title")="Asthma"
    46294617"RTN","C0SPROB2",212,0)
    4630  ;G("snomed:195967001","dcterms:identifier")=195967001
     4618 ;G("snomed:195967001","rdf:type")="sp:Code"
    46314619"RTN","C0SPROB2",213,0)
    4632  ;G("snomed:195967001","dcterms:title")="Asthma"
     4620 ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46334621"RTN","C0SPROB2",214,0)
    4634  ;G("snomed:195967001","rdf:type")="sp:Code"
     4622 ;G("snomed:254837009","dcterms:identifier")=254837009
    46354623"RTN","C0SPROB2",215,0)
    4636  ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4624 ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast"
    46374625"RTN","C0SPROB2",216,0)
    4638  ;G("snomed:254837009","dcterms:identifier")=254837009
     4626 ;G("snomed:254837009","rdf:type")="sp:Code"
    46394627"RTN","C0SPROB2",217,0)
    4640  ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast"
     4628 ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46414629"RTN","C0SPROB2",218,0)
    4642  ;G("snomed:254837009","rdf:type")="sp:Code"
     4630 ;G("snomed:353295004","dcterms:identifier")=353295004
    46434631"RTN","C0SPROB2",219,0)
    4644  ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4632 ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter"
    46454633"RTN","C0SPROB2",220,0)
    4646  ;G("snomed:353295004","dcterms:identifier")=353295004
     4634 ;G("snomed:353295004","rdf:type")="sp:Code"
    46474635"RTN","C0SPROB2",221,0)
    4648  ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter"
     4636 ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46494637"RTN","C0SPROB2",222,0)
    4650  ;G("snomed:353295004","rdf:type")="sp:Code"
     4638 ;G("snomed:38341003","dcterms:identifier")=38341003
    46514639"RTN","C0SPROB2",223,0)
    4652  ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4640 ;G("snomed:38341003","dcterms:title")="Essential hypertension"
    46534641"RTN","C0SPROB2",224,0)
    4654  ;G("snomed:38341003","dcterms:identifier")=38341003
     4642 ;G("snomed:38341003","rdf:type")="sp:Code"
    46554643"RTN","C0SPROB2",225,0)
    4656  ;G("snomed:38341003","dcterms:title")="Essential hypertension"
     4644 ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46574645"RTN","C0SPROB2",226,0)
    4658  ;G("snomed:38341003","rdf:type")="sp:Code"
     4646 ;G("snomed:40930008","dcterms:identifier")=40930008
    46594647"RTN","C0SPROB2",227,0)
    4660  ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4648 ;G("snomed:40930008","dcterms:title")="Hypothyroidism"
    46614649"RTN","C0SPROB2",228,0)
    4662  ;G("snomed:40930008","dcterms:identifier")=40930008
     4650 ;G("snomed:40930008","rdf:type")="sp:Code"
    46634651"RTN","C0SPROB2",229,0)
    4664  ;G("snomed:40930008","dcterms:title")="Hypothyroidism"
     4652 ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46654653"RTN","C0SPROB2",230,0)
    4666  ;G("snomed:40930008","rdf:type")="sp:Code"
     4654 ;G("snomed:44054006","dcterms:identifier")=44054006
    46674655"RTN","C0SPROB2",231,0)
    4668  ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4656 ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2"
    46694657"RTN","C0SPROB2",232,0)
    4670  ;G("snomed:44054006","dcterms:identifier")=44054006
     4658 ;G("snomed:44054006","rdf:type")="sp:Code"
    46714659"RTN","C0SPROB2",233,0)
    4672  ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2"
     4660 ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46734661"RTN","C0SPROB2",234,0)
    4674  ;G("snomed:44054006","rdf:type")="sp:Code"
     4662 ;G("snomed:54302000","dcterms:identifier")=54302000
    46754663"RTN","C0SPROB2",235,0)
    4676  ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4664 ;G("snomed:54302000","dcterms:title")="Disorder of breast"
    46774665"RTN","C0SPROB2",236,0)
    4678  ;G("snomed:54302000","dcterms:identifier")=54302000
     4666 ;G("snomed:54302000","rdf:type")="sp:Code"
    46794667"RTN","C0SPROB2",237,0)
    4680  ;G("snomed:54302000","dcterms:title")="Disorder of breast"
     4668 ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46814669"RTN","C0SPROB2",238,0)
    4682  ;G("snomed:54302000","rdf:type")="sp:Code"
     4670 ;G("snomed:55822004","dcterms:identifier")=55822004
    46834671"RTN","C0SPROB2",239,0)
    4684  ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4672 ;G("snomed:55822004","dcterms:title")="Hyperlipidemia"
    46854673"RTN","C0SPROB2",240,0)
    4686  ;G("snomed:55822004","dcterms:identifier")=55822004
     4674 ;G("snomed:55822004","rdf:type")="sp:Code"
    46874675"RTN","C0SPROB2",241,0)
    4688  ;G("snomed:55822004","dcterms:title")="Hyperlipidemia"
     4676 ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    46894677"RTN","C0SPROB2",242,0)
    4690  ;G("snomed:55822004","rdf:type")="sp:Code"
     4678 ;G("snomed:8517006","dcterms:identifier")=8517006
    46914679"RTN","C0SPROB2",243,0)
    4692  ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4680 ;G("snomed:8517006","dcterms:title")="History of tobacco use"
    46934681"RTN","C0SPROB2",244,0)
    4694  ;G("snomed:8517006","dcterms:identifier")=8517006
     4682 ;G("snomed:8517006","rdf:type")="sp:Code"
    46954683"RTN","C0SPROB2",245,0)
    4696  ;G("snomed:8517006","dcterms:title")="History of tobacco use"
     4684 ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"
    46974685"RTN","C0SPROB2",246,0)
    4698  ;G("snomed:8517006","rdf:type")="sp:Code"
     4686 
    46994687"RTN","C0SPROB2",247,0)
    4700  ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/"
     4688 ;
    47014689"RTN","C0SPROB2",248,0)
    4702  
     4690PROB(GRTN,C0SARY) ; GRTN, passed by reference,
    47034691"RTN","C0SPROB2",249,0)
    4704  ;
     4692 ; is the return name of the graph created. "" if none
    47054693"RTN","C0SPROB2",250,0)
    4706 PROB(GRTN,C0SARY) ; GRTN, passed by reference,
     4694 ; C0SARY is passed in by reference and is the NHIN array of problems
    47074695"RTN","C0SPROB2",251,0)
    4708  ; is the return name of the graph created. "" if none
     4696 ;
    47094697"RTN","C0SPROB2",252,0)
    4710  ; C0SARY is passed in by reference and is the NHIN array of problems
     4698 I $O(C0SARY("problem",""))="" D  Q  ;
    47114699"RTN","C0SPROB2",253,0)
    4712  ;
     4700 . I $D(DEBUG) W !,"No Problems"
    47134701"RTN","C0SPROB2",254,0)
    4714  I $O(C0SARY("problem",""))="" D  Q  ;
     4702 S GRTN="" ; default to no problems
    47154703"RTN","C0SPROB2",255,0)
    4716  . I $D(DEBUG) W !,"No Problems"
     4704 N C0SGRF
    47174705"RTN","C0SPROB2",256,0)
    4718  S GRTN="" ; default to no problems
     4706 S C0SGRF="vistaSmart:"_ZPATID_"/problems"
    47194707"RTN","C0SPROB2",257,0)
    4720  N C0SGRF
     4708 I $D(DEBUG) W !,"Processing ",C0SGRF
    47214709"RTN","C0SPROB2",258,0)
    4722  S C0SGRF="vistaSmart:"_ZPATID_"/problems"
     4710 D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
    47234711"RTN","C0SPROB2",259,0)
    4724  I $D(DEBUG) W !,"Processing ",C0SGRF
     4712 D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
    47254713"RTN","C0SPROB2",260,0)
    4726  D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph
     4714 N FARY S FARY="C0XFARY"
    47274715"RTN","C0SPROB2",261,0)
    4728  D INITFARY^C0XF2N("C0XFARY") ; which triple store to use
     4716 D USEFARY^C0XF2N(FARY)
    47294717"RTN","C0SPROB2",262,0)
    4730  N FARY S FARY="C0XFARY"
     4718 D VOCINIT^C0XUTIL
    47314719"RTN","C0SPROB2",263,0)
    4732  D USEFARY^C0XF2N(FARY)
     4720 ;
    47334721"RTN","C0SPROB2",264,0)
    4734  D VOCINIT^C0XUTIL
     4722 D STARTADD^C0XF2N ; initialize to create triples
    47354723"RTN","C0SPROB2",265,0)
    47364724 ;
    47374725"RTN","C0SPROB2",266,0)
    4738  D STARTADD^C0XF2N ; initialize to create triples
     4726 N ZI S ZI=""
    47394727"RTN","C0SPROB2",267,0)
    4740  ;
     4728 F  S ZI=$O(C0SARY("problem",ZI)) Q:ZI=""  D  ;
    47414729"RTN","C0SPROB2",268,0)
    4742  N ZI S ZI=""
     4730 . N LRN,ZR ; ZR is the local array for building the new triples
    47434731"RTN","C0SPROB2",269,0)
    4744  F  S ZI=$O(C0SARY("problem",ZI)) Q:ZI=""  D  ;
     4732 . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result
    47454733"RTN","C0SPROB2",270,0)
    4746  . N LRN,ZR ; ZR is the local array for building the new triples
     4734 . ;
    47474735"RTN","C0SPROB2",271,0)
    4748  . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result
     4736 . N PROBID ; unique Id for this problem
    47494737"RTN","C0SPROB2",272,0)
     4738 . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
     4739"RTN","C0SPROB2",273,0)
    47504740 . ;
    4751 "RTN","C0SPROB2",273,0)
    4752  . N PROBID ; unique Id for this problem
    47534741"RTN","C0SPROB2",274,0)
    4754  . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number
     4742 . ; i don't like this because the same problems gets a
    47554743"RTN","C0SPROB2",275,0)
     4744 . ; different ID every time it's reported. Can't trace it back to VistA
     4745"RTN","C0SPROB2",276,0)
     4746 . ; I'd rather be using id@value ie "id@value")="118"
     4747"RTN","C0SPROB2",277,0)
    47564748 . ;
    4757 "RTN","C0SPROB2",276,0)
    4758  . ; i don't like this because the same problems gets a
    4759 "RTN","C0SPROB2",277,0)
    4760  . ; different ID every time it's reported. Can't trace it back to VistA
    47614749"RTN","C0SPROB2",278,0)
    4762  . ; I'd rather be using id@value ie "id@value")="118"
     4750 . N SNOMED,ICD S ICD=$G(@LRN@("icd@value"))
    47634751"RTN","C0SPROB2",279,0)
     4752 . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map
     4753"RTN","C0SPROB2",280,0)
     4754 . N SNOGRF ; graph for SNOMED code
     4755"RTN","C0SPROB2",281,0)
     4756 . I SNOMED="" D  ;
     4757"RTN","C0SPROB2",282,0)
     4758 . . S SNOMED=ICD ; if not found, return the ICD code
     4759"RTN","C0SPROB2",283,0)
     4760 . . S SNOGRF="icd9:"_SNOMED
     4761"RTN","C0SPROB2",284,0)
     4762 . E  S SNOGRF="snomed:"_SNOMED
     4763"RTN","C0SPROB2",285,0)
     4764 . N SNOTIT S SNOTIT=$G(@LRN@("name@value"))
     4765"RTN","C0SPROB2",286,0)
     4766 . I $D(DEBUG) D  ;
     4767"RTN","C0SPROB2",287,0)
     4768 . . W !,"Processing Problem List ",PROBID
     4769"RTN","C0SPROB2",288,0)
     4770 . . W !,"problem: ",SNOTIT
     4771"RTN","C0SPROB2",289,0)
     4772 . . W !,"code: ",SNOMED
     4773"RTN","C0SPROB2",290,0)
    47644774 . ;
    4765 "RTN","C0SPROB2",280,0)
    4766  . N SNOMED,ICD S ICD=$G(@LRN@("icd@value"))
    4767 "RTN","C0SPROB2",281,0)
    4768  . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map
    4769 "RTN","C0SPROB2",282,0)
    4770  . N SNOGRF ; graph for SNOMED code
    4771 "RTN","C0SPROB2",283,0)
    4772  . I SNOMED="" D  ;
    4773 "RTN","C0SPROB2",284,0)
    4774  . . S SNOMED=ICD ; if not found, return the ICD code
    4775 "RTN","C0SPROB2",285,0)
    4776  . . S SNOGRF="icd9:"_SNOMED
    4777 "RTN","C0SPROB2",286,0)
    4778  . E  S SNOGRF="snomed:"_SNOMED
    4779 "RTN","C0SPROB2",287,0)
    4780  . N SNOTIT S SNOTIT=$G(@LRN@("name@value"))
    4781 "RTN","C0SPROB2",288,0)
    4782  . I $D(DEBUG) D  ;
    4783 "RTN","C0SPROB2",289,0)
    4784  . . W !,"Processing Problem List ",PROBID
    4785 "RTN","C0SPROB2",290,0)
    4786  . . W !,"problem: ",SNOTIT
    47874775"RTN","C0SPROB2",291,0)
    4788  . . W !,"code: ",SNOMED
     4776 . ; first do the base result graph
    47894777"RTN","C0SPROB2",292,0)
    47904778 . ;
    47914779"RTN","C0SPROB2",293,0)
    4792  . ; first do the base result graph
     4780 . S ZR("rdf:type")="sp:Problem"
    47934781"RTN","C0SPROB2",294,0)
     4782 . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems
     4783"RTN","C0SPROB2",295,0)
     4784 . ; ie /vista/smart/99912345/problems
     4785"RTN","C0SPROB2",296,0)
    47944786 . ;
    4795 "RTN","C0SPROB2",295,0)
    4796  . S ZR("rdf:type")="sp:Problem"
    4797 "RTN","C0SPROB2",296,0)
    4798  . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems
    47994787"RTN","C0SPROB2",297,0)
    4800  . ; ie /vista/smart/99912345/problems
     4788 . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name
    48014789"RTN","C0SPROB2",298,0)
     4790 . S ZR("sp:problemName")=PROBNAME
     4791"RTN","C0SPROB2",299,0)
    48024792 . ;
    4803 "RTN","C0SPROB2",299,0)
    4804  . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name
    48054793"RTN","C0SPROB2",300,0)
    4806  . S ZR("sp:problemName")=PROBNAME
     4794 . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))
    48074795"RTN","C0SPROB2",301,0)
     4796 . S ZR("sp:startDate")=STARTDT
     4797"RTN","C0SPROB2",302,0)
    48084798 . ;
    4809 "RTN","C0SPROB2",302,0)
    4810  . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value")))
    48114799"RTN","C0SPROB2",303,0)
    4812  . S ZR("sp:startDate")=STARTDT
     4800 . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples
    48134801"RTN","C0SPROB2",304,0)
     4802 . K ZR ; clean up
     4803"RTN","C0SPROB2",305,0)
    48144804 . ;
    4815 "RTN","C0SPROB2",305,0)
    4816  . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples
    48174805"RTN","C0SPROB2",306,0)
    4818  . K ZR ; clean up
     4806 . ; create the problemName graph
    48194807"RTN","C0SPROB2",307,0)
    48204808 . ;
    48214809"RTN","C0SPROB2",308,0)
    4822  . ; create the problemName graph
     4810 . S ZR("rdf:type")="sp:CodedValue"
    48234811"RTN","C0SPROB2",309,0)
     4812 . ;S ZR("sp:code")="snomed:"_SNOMED
     4813"RTN","C0SPROB2",310,0)
     4814 . S ZR("sp:code")=SNOGRF
     4815"RTN","C0SPROB2",311,0)
     4816 . S ZR("dcterms:title")=$G(@LRN@("name@value"))
     4817"RTN","C0SPROB2",312,0)
     4818 . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR)
     4819"RTN","C0SPROB2",313,0)
     4820 . K ZR
     4821"RTN","C0SPROB2",314,0)
    48244822 . ;
    4825 "RTN","C0SPROB2",310,0)
    4826  . S ZR("rdf:type")="sp:CodedValue"
    4827 "RTN","C0SPROB2",311,0)
    4828  . ;S ZR("sp:code")="snomed:"_SNOMED
    4829 "RTN","C0SPROB2",312,0)
    4830  . S ZR("sp:code")=SNOGRF
    4831 "RTN","C0SPROB2",313,0)
    4832  . S ZR("dcterms:title")=$G(@LRN@("name@value"))
    4833 "RTN","C0SPROB2",314,0)
    4834  . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR)
    48354823"RTN","C0SPROB2",315,0)
     4824 . ; create snomed graph
     4825"RTN","C0SPROB2",316,0)
     4826 . ;
     4827"RTN","C0SPROB2",317,0)
     4828 . S ZR("rdf:type")="sp:Code"
     4829"RTN","C0SPROB2",318,0)
     4830 . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT"
     4831"RTN","C0SPROB2",319,0)
     4832 . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9"
     4833"RTN","C0SPROB2",320,0)
     4834 . S ZR("dcterms:identifier")=SNOMED
     4835"RTN","C0SPROB2",321,0)
     4836 . S ZR("dcterms:title")=SNOTIT
     4837"RTN","C0SPROB2",322,0)
     4838 . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)
     4839"RTN","C0SPROB2",323,0)
    48364840 . K ZR
    4837 "RTN","C0SPROB2",316,0)
     4841"RTN","C0SPROB2",324,0)
    48384842 . ;
    4839 "RTN","C0SPROB2",317,0)
    4840  . ; create snomed graph
    4841 "RTN","C0SPROB2",318,0)
    4842  . ;
    4843 "RTN","C0SPROB2",319,0)
    4844  . S ZR("rdf:type")="sp:Code"
    4845 "RTN","C0SPROB2",320,0)
    4846  . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT"
    4847 "RTN","C0SPROB2",321,0)
    4848  . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9"
    4849 "RTN","C0SPROB2",322,0)
    4850  . S ZR("dcterms:identifier")=SNOMED
    4851 "RTN","C0SPROB2",323,0)
    4852  . S ZR("dcterms:title")=SNOTIT
    4853 "RTN","C0SPROB2",324,0)
    4854  . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR)
    48554843"RTN","C0SPROB2",325,0)
    4856  . K ZR
     4844 D BULKLOAD^C0XF2N(.C0XFDA)
    48574845"RTN","C0SPROB2",326,0)
    4858  . ;
     4846 S GRTN=C0SGRF
    48594847"RTN","C0SPROB2",327,0)
    4860  D BULKLOAD^C0XF2N(.C0XFDA)
     4848 Q
    48614849"RTN","C0SPROB2",328,0)
    4862  S GRTN=C0SGRF
     4850 ;
    48634851"RTN","C0SPROB2",329,0)
    4864  Q
     4852SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code
    48654853"RTN","C0SPROB2",330,0)
    4866  ;
     4854 ; requires the mapping table installed in the triplestore
    48674855"RTN","C0SPROB2",331,0)
    4868 SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code
     4856 ;
    48694857"RTN","C0SPROB2",332,0)
    4870  ; requires the mapping table installed in the triplestore
     4858 N ZSN,ZARY,ZSUB,ZSUBS
    48714859"RTN","C0SPROB2",333,0)
    4872  ;
     4860 I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots
    48734861"RTN","C0SPROB2",334,0)
    4874  N ZSN,ZARY,ZSUB,ZSUBS
     4862 D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code
    48754863"RTN","C0SPROB2",335,0)
    4876  I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots
     4864 S ZSUB=$O(ZSUBS("")) ; pick the first one
    48774865"RTN","C0SPROB2",336,0)
    4878  D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code
     4866 I ZSUB="" Q ""
    48794867"RTN","C0SPROB2",337,0)
    4880  S ZSUB=$O(ZSUBS("")) ; pick the first one
     4868 D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode")
    48814869"RTN","C0SPROB2",338,0)
    4882  I ZSUB="" Q ""
     4870 S ZSN=$O(ZARY(""))
    48834871"RTN","C0SPROB2",339,0)
    4884  D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode")
     4872 I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label")
    48854873"RTN","C0SPROB2",340,0)
    4886  S ZSN=$O(ZARY(""))
     4874 Q ZSN
    48874875"RTN","C0SPROB2",341,0)
    4888  I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label")
    4889 "RTN","C0SPROB2",342,0)
    4890  Q ZSN
    4891 "RTN","C0SPROB2",343,0)
    48924876 ;
    48934877"RTN","C0STBL")
    4894 0^11^B23989761
     48780^11^B23538791
    48954879"RTN","C0STBL",1,0)
    48964880C0STBL   ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12  17:05
    48974881"RTN","C0STBL",2,0)
    4898  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     4882 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    48994883"RTN","C0STBL",3,0)
    4900  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     4884 ;Copyright 2012 George Lilly. 
    49014885"RTN","C0STBL",4,0)
    4902  ;General Public License See attached copy of the License.
     4886 ;
    49034887"RTN","C0STBL",5,0)
    4904  ;
     4888 ; This program is free software: you can redistribute it and/or modify
    49054889"RTN","C0STBL",6,0)
    4906  ;This program is free software; you can redistribute it and/or modify
     4890 ; it under the terms of the GNU Affero General Public License as
    49074891"RTN","C0STBL",7,0)
    4908  ;it under the terms of the GNU General Public License as published by
     4892 ; published by the Free Software Foundation, either version 3 of the
    49094893"RTN","C0STBL",8,0)
    4910  ;the Free Software Foundation; either version 2 of the License, or
     4894 ; License, or (at your option) any later version.
    49114895"RTN","C0STBL",9,0)
    4912  ;(at your option) any later version.
     4896 ;
    49134897"RTN","C0STBL",10,0)
    4914  ;
     4898 ; This program is distributed in the hope that it will be useful,
    49154899"RTN","C0STBL",11,0)
    4916  ;This program is distributed in the hope that it will be useful,
     4900 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    49174901"RTN","C0STBL",12,0)
    4918  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     4902 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    49194903"RTN","C0STBL",13,0)
    4920  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     4904 ; GNU Affero General Public License for more details.
    49214905"RTN","C0STBL",14,0)
    4922  ;GNU General Public License for more details.
     4906 ;
    49234907"RTN","C0STBL",15,0)
    4924  ;
     4908 ; You should have received a copy of the GNU Affero General Public License
    49254909"RTN","C0STBL",16,0)
    4926  ;You should have received a copy of the GNU General Public License along
     4910 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    49274911"RTN","C0STBL",17,0)
    4928  ;with this program; if not, write to the Free Software Foundation, Inc.,
     4912 ;
    49294913"RTN","C0STBL",18,0)
    4930  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     4914 Q
    49314915"RTN","C0STBL",19,0)
    4932  ;
     4916EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN
    49334917"RTN","C0STBL",20,0)
    4934  Q
     4918 I '$D(BEGDFN) S BDGDFN=""
    49354919"RTN","C0STBL",21,0)
    4936 EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN
     4920 I '$D(DFNCNT) S DFNCNT=150
    49374921"RTN","C0STBL",22,0)
    4938  I '$D(BEGDFN) S BDGDFN=""
     4922 I '$D(ZPART) S ZPART=""
    49394923"RTN","C0STBL",23,0)
    4940  I '$D(DFNCNT) S DFNCNT=150
     4924 N ZTBL S ZTBL=$NA(^TMP("C0STBL"))
    49414925"RTN","C0STBL",24,0)
    4942  I '$D(ZPART) S ZPART=""
     4926 N ZI,ZCNT,ZG
    49434927"RTN","C0STBL",25,0)
    4944  N ZTBL S ZTBL=$NA(^TMP("C0STBL"))
     4928 S ZI=$O(^DPT(BEGDFN),-1)
    49454929"RTN","C0STBL",26,0)
    4946  N ZI,ZCNT,ZG
     4930 S ZCNT=1
    49474931"RTN","C0STBL",27,0)
    4948  S ZI=$O(^DPT(BEGDFN),-1)
     4932 F  S ZI=$O(^DPT(ZI)) Q:((+ZI=0)!(ZCNT>DFNCNT))  D  ;
    49494933"RTN","C0STBL",28,0)
    4950  S ZCNT=1
     4934 . S ZCNT=ZCNT+1
    49514935"RTN","C0STBL",29,0)
    4952  F  S ZI=$O(^DPT(ZI)) Q:((+ZI=0)!(ZCNT>DFNCNT))  D  ;
     4936 . W ZI," "
    49534937"RTN","C0STBL",30,0)
    4954  . S ZCNT=ZCNT+1
     4938 . K ZG
    49554939"RTN","C0STBL",31,0)
    4956  . W ZI," "
     4940 . D EN^C0SNHIN(.ZG,ZI,ZPART)
    49574941"RTN","C0STBL",32,0)
    4958  . K ZG
     4942 . M @ZTBL@(ZI)=ZG
    49594943"RTN","C0STBL",33,0)
    4960  . D EN^C0SNHIN(.ZG,ZI,ZPART)
     4944 . K G
    49614945"RTN","C0STBL",34,0)
    4962  . M @ZTBL@(ZI)=ZG
     4946 . N GDIR S GDIR="/home/vista/p/"
    49634947"RTN","C0STBL",35,0)
     4948 . D EN^C0SMART(.G,ZI,"med")
     4949"RTN","C0STBL",36,0)
     4950 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-med.rdf",GDIR)
     4951"RTN","C0STBL",37,0)
     4952 . k G
     4953"RTN","C0STBL",38,0)
     4954 . D EN^C0SMART(.G,ZI,"patient")
     4955"RTN","C0STBL",39,0)
     4956 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-patient.rdf",GDIR)
     4957"RTN","C0STBL",40,0)
    49644958 . K G
    4965 "RTN","C0STBL",36,0)
    4966  . N GDIR S GDIR="/home/vista/p/"
    4967 "RTN","C0STBL",37,0)
    4968  . D EN^C0SMART(.G,ZI,"med")
    4969 "RTN","C0STBL",38,0)
    4970  . I $D(G) W !,$$output^C0XGET1("G",ZI_"-med.rdf",GDIR)
    4971 "RTN","C0STBL",39,0)
    4972  . k G
    4973 "RTN","C0STBL",40,0)
    4974  . D EN^C0SMART(.G,ZI,"patient")
    49754959"RTN","C0STBL",41,0)
    4976  . I $D(G) W !,$$output^C0XGET1("G",ZI_"-patient.rdf",GDIR)
     4960 . D EN^C0SMART(.G,ZI,"lab")
    49774961"RTN","C0STBL",42,0)
     4962 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-lab.rdf",GDIR)
     4963"RTN","C0STBL",43,0)
    49784964 . K G
    4979 "RTN","C0STBL",43,0)
    4980  . D EN^C0SMART(.G,ZI,"lab")
    49814965"RTN","C0STBL",44,0)
    4982  . I $D(G) W !,$$output^C0XGET1("G",ZI_"-lab.rdf",GDIR)
     4966 . D EN^C0SMART(.G,ZI,"problem")
    49834967"RTN","C0STBL",45,0)
    4984  . K G
     4968 . I $D(G) W !,$$output^C0XGET1("G",ZI_"-problem.rdf",GDIR)
    49854969"RTN","C0STBL",46,0)
    4986  . D EN^C0SMART(.G,ZI,"problem")
     4970 Q
    49874971"RTN","C0STBL",47,0)
    4988  . I $D(G) W !,$$output^C0XGET1("G",ZI_"-problem.rdf",GDIR)
     4972 ;
    49894973"RTN","C0STBL",48,0)
    4990  Q
     4974LOADHACK ;
    49914975"RTN","C0STBL",49,0)
    4992  ;
     4976 N ZI
    49934977"RTN","C0STBL",50,0)
    4994 LOADHACK ;
     4978 F ZI=2:1:374 D ;
    49954979"RTN","C0STBL",51,0)
    4996  N ZI
     4980 . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/")
    49974981"RTN","C0STBL",52,0)
    4998  F ZI=2:1:374 D  ;
     4982 Q
    49994983"RTN","C0STBL",53,0)
    5000  . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/")
     4984 ;
    50014985"RTN","C0STBL",54,0)
    5002  Q
     4986LABCNT ; COUNT LAB TESTS AND LOINC CODES
    50034987"RTN","C0STBL",55,0)
    5004  ;
     4988 K LABCNT,GLOINC,PATCNT
    50054989"RTN","C0STBL",56,0)
    5006 LABCNT ; COUNT LAB TESTS AND LOINC CODES
     4990 S (LABCNT,GLOINC,PATCNT)=0
    50074991"RTN","C0STBL",57,0)
    5008  K LABCNT,GLOINC,PATCNT
     4992 N ZI S ZI=""
    50094993"RTN","C0STBL",58,0)
    5010  S (LABCNT,GLOINC,PATCNT)=0
     4994 N GN S GN=$NA(^TMP("C0STBL"))
    50114995"RTN","C0STBL",59,0)
     4996 F  S ZI=$O(@GN@(ZI)) Q:ZI=""  D  ;
     4997"RTN","C0STBL",60,0)
     4998 . S PATCNT=PATCNT+1
     4999"RTN","C0STBL",61,0)
     5000 . I '$D(@GN@(ZI,"lab")) Q  ;
     5001"RTN","C0STBL",62,0)
     5002 . N ZJ S ZJ=""
     5003"RTN","C0STBL",63,0)
     5004 . F  S ZJ=$O(@GN@(ZI,"lab",ZJ)) Q:ZJ=""  D  ;
     5005"RTN","C0STBL",64,0)
     5006 . . S LABCNT=LABCNT+1
     5007"RTN","C0STBL",65,0)
     5008 . . S X=$G(@GN@(ZI,"lab",ZJ,"loinc@value"))
     5009"RTN","C0STBL",66,0)
     5010 . . I X'="" S GLOINC=GLOINC+1
     5011"RTN","C0STBL",67,0)
     5012 W !,"Total number of patients: ",PATCNT
     5013"RTN","C0STBL",68,0)
     5014 W !,"Total number of lab results: ",LABCNT
     5015"RTN","C0STBL",69,0)
     5016 W !,"Total number of lab results with loinc codes: ",GLOINC
     5017"RTN","C0STBL",70,0)
     5018 W !,"Percentage of lab tests with loinc codes: ",$P((GLOINC/LABCNT)*100,".")_"%"
     5019"RTN","C0STBL",71,0)
     5020 Q
     5021"RTN","C0STBL",72,0)
     5022 ;
     5023"RTN","C0STBL",73,0)
     5024PROBCNT ; COUNT PROBLEMS AND SNOMED CODES
     5025"RTN","C0STBL",74,0)
     5026 K PROBCNT,GSNO,PATCNT
     5027"RTN","C0STBL",75,0)
     5028 S (PROBCNT,GSNO,PATCNT)=0
     5029"RTN","C0STBL",76,0)
    50125030 N ZI S ZI=""
    5013 "RTN","C0STBL",60,0)
     5031"RTN","C0STBL",77,0)
    50145032 N GN S GN=$NA(^TMP("C0STBL"))
    5015 "RTN","C0STBL",61,0)
     5033"RTN","C0STBL",78,0)
    50165034 F  S ZI=$O(@GN@(ZI)) Q:ZI=""  D  ;
    5017 "RTN","C0STBL",62,0)
     5035"RTN","C0STBL",79,0)
    50185036 . S PATCNT=PATCNT+1
    5019 "RTN","C0STBL",63,0)
    5020  . I '$D(@GN@(ZI,"lab")) Q  ;
    5021 "RTN","C0STBL",64,0)
     5037"RTN","C0STBL",80,0)
     5038 . I '$D(@GN@(ZI,"problem")) Q  ;
     5039"RTN","C0STBL",81,0)
    50225040 . N ZJ S ZJ=""
    5023 "RTN","C0STBL",65,0)
    5024  . F  S ZJ=$O(@GN@(ZI,"lab",ZJ)) Q:ZJ=""  D  ;
    5025 "RTN","C0STBL",66,0)
    5026  . . S LABCNT=LABCNT+1
    5027 "RTN","C0STBL",67,0)
    5028  . . S X=$G(@GN@(ZI,"lab",ZJ,"loinc@value"))
    5029 "RTN","C0STBL",68,0)
    5030  . . I X'="" S GLOINC=GLOINC+1
    5031 "RTN","C0STBL",69,0)
     5041"RTN","C0STBL",82,0)
     5042 . F  S ZJ=$O(@GN@(ZI,"problem",ZJ)) Q:ZJ=""  D  ;
     5043"RTN","C0STBL",83,0)
     5044 . . S PROBCNT=PROBCNT+1
     5045"RTN","C0STBL",84,0)
     5046 . . S X=$G(@GN@(ZI,"problem",ZJ,"icd@value"))
     5047"RTN","C0STBL",85,0)
     5048 . . S Y=$$SNOMED^C0SPROB2(X)
     5049"RTN","C0STBL",86,0)
     5050 . . I Y'="" S GSNO=GSNO+1
     5051"RTN","C0STBL",87,0)
    50325052 W !,"Total number of patients: ",PATCNT
    5033 "RTN","C0STBL",70,0)
    5034  W !,"Total number of lab results: ",LABCNT
    5035 "RTN","C0STBL",71,0)
    5036  W !,"Total number of lab results with loinc codes: ",GLOINC
    5037 "RTN","C0STBL",72,0)
    5038  W !,"Percentage of lab tests with loinc codes: ",$P((GLOINC/LABCNT)*100,".")_"%"
    5039 "RTN","C0STBL",73,0)
    5040  Q
    5041 "RTN","C0STBL",74,0)
    5042  ;
    5043 "RTN","C0STBL",75,0)
    5044 PROBCNT ; COUNT PROBLEMS AND SNOMED CODES
    5045 "RTN","C0STBL",76,0)
    5046  K PROBCNT,GSNO,PATCNT
    5047 "RTN","C0STBL",77,0)
    5048  S (PROBCNT,GSNO,PATCNT)=0
    5049 "RTN","C0STBL",78,0)
     5053"RTN","C0STBL",88,0)
     5054 W !,"Total number of problems: ",PROBCNT
     5055"RTN","C0STBL",89,0)
     5056 W !,"Total number of problems with snomed codes: ",GSNO
     5057"RTN","C0STBL",90,0)
     5058 W !,"Percentage of problems with SNOMED codes: ",$P((GSNO/PROBCNT)*100,".")_"%"
     5059"RTN","C0STBL",91,0)
     5060 Q
     5061"RTN","C0STBL",92,0)
     5062 ;
     5063"RTN","C0STBL",93,0)
     5064MEDCNT ; COUNT INPATIENT VS OUTPATIENT MEDICATIONS
     5065"RTN","C0STBL",94,0)
     5066 K MEDCNT,OMED,PATCNT,DOSE,UNITS,FORM,SCHED,ROUTE
     5067"RTN","C0STBL",95,0)
     5068 S (MEDCNT,OMED,GSNO,PATCNT)=0
     5069"RTN","C0STBL",96,0)
    50505070 N ZI S ZI=""
    5051 "RTN","C0STBL",79,0)
     5071"RTN","C0STBL",97,0)
    50525072 N GN S GN=$NA(^TMP("C0STBL"))
    5053 "RTN","C0STBL",80,0)
     5073"RTN","C0STBL",98,0)
    50545074 F  S ZI=$O(@GN@(ZI)) Q:ZI=""  D  ;
    5055 "RTN","C0STBL",81,0)
     5075"RTN","C0STBL",99,0)
    50565076 . S PATCNT=PATCNT+1
    5057 "RTN","C0STBL",82,0)
    5058  . I '$D(@GN@(ZI,"problem")) Q  ;
    5059 "RTN","C0STBL",83,0)
     5077"RTN","C0STBL",100,0)
     5078 . I '$D(@GN@(ZI,"med")) Q  ;
     5079"RTN","C0STBL",101,0)
    50605080 . N ZJ S ZJ=""
    5061 "RTN","C0STBL",84,0)
    5062  . F  S ZJ=$O(@GN@(ZI,"problem",ZJ)) Q:ZJ=""  D  ;
    5063 "RTN","C0STBL",85,0)
    5064  . . S PROBCNT=PROBCNT+1
    5065 "RTN","C0STBL",86,0)
    5066  . . S X=$G(@GN@(ZI,"problem",ZJ,"icd@value"))
    5067 "RTN","C0STBL",87,0)
    5068  . . S Y=$$SNOMED^C0SPROB2(X)
    5069 "RTN","C0STBL",88,0)
    5070  . . I Y'="" S GSNO=GSNO+1
    5071 "RTN","C0STBL",89,0)
     5081"RTN","C0STBL",102,0)
     5082 . F  S ZJ=$O(@GN@(ZI,"med",ZJ)) Q:ZJ=""  D  ;
     5083"RTN","C0STBL",103,0)
     5084 . . S MEDCNT=MEDCNT+1
     5085"RTN","C0STBL",104,0)
     5086 . . I $G(@GN@(ZI,"med",ZJ,"vaStatus@value"))="EXPIRED" D  Q  ;
     5087"RTN","C0STBL",105,0)
     5088 . . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
     5089"RTN","C0STBL",106,0)
     5090 . . I $G(@GN@(ZI,"med",ZJ,"vaType@value"))="I" D  Q  ;
     5091"RTN","C0STBL",107,0)
     5092 . . . I $D(DEBUG) W !,"Inpatient Med, skipping"
     5093"RTN","C0STBL",108,0)
     5094 . . I $G(@GN@(ZI,"med",ZI,"vaType@value"))="V" D  Q  ;
     5095"RTN","C0STBL",109,0)
     5096 . . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
     5097"RTN","C0STBL",110,0)
     5098 . . S OMED=OMED+1
     5099"RTN","C0STBL",111,0)
     5100 . . S X=$G(@GN@(ZI,"med",ZJ,"form@value"))
     5101"RTN","C0STBL",112,0)
     5102 . . S FORM(X)=$G(FORM(X))+1
     5103"RTN","C0STBL",113,0)
     5104 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@dose"))
     5105"RTN","C0STBL",114,0)
     5106 . . I X="" S X="UNKNOWN"
     5107"RTN","C0STBL",115,0)
     5108 . . S DOSE(X)=$G(DOSE(X))+1
     5109"RTN","C0STBL",116,0)
     5110 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@units"))
     5111"RTN","C0STBL",117,0)
     5112 . . I X="" S X="UNKNOWN"
     5113"RTN","C0STBL",118,0)
     5114 . . S UNITS(X)=$G(UNITS(X))+1
     5115"RTN","C0STBL",119,0)
     5116 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@schedule"))
     5117"RTN","C0STBL",120,0)
     5118 . . I X="" S X="UNKNOWN"
     5119"RTN","C0STBL",121,0)
     5120 . . S SCHED(X)=$G(SCHED(X))+1
     5121"RTN","C0STBL",122,0)
     5122 . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dosc@route"))
     5123"RTN","C0STBL",123,0)
     5124 . . I X="" S X="UNKNOWN"
     5125"RTN","C0STBL",124,0)
     5126 . . S ROUTE(X)=$G(ROUTE(X))+1
     5127"RTN","C0STBL",125,0)
    50725128 W !,"Total number of patients: ",PATCNT
    5073 "RTN","C0STBL",90,0)
    5074  W !,"Total number of problems: ",PROBCNT
    5075 "RTN","C0STBL",91,0)
    5076  W !,"Total number of problems with snomed codes: ",GSNO
    5077 "RTN","C0STBL",92,0)
    5078  W !,"Percentage of problems with SNOMED codes: ",$P((GSNO/PROBCNT)*100,".")_"%"
    5079 "RTN","C0STBL",93,0)
    5080  Q
    5081 "RTN","C0STBL",94,0)
    5082  ;
    5083 "RTN","C0STBL",95,0)
    5084 MEDCNT ; COUNT INPATIENT VS OUTPATIENT MEDICATIONS
    5085 "RTN","C0STBL",96,0)
    5086  K MEDCNT,OMED,PATCNT,DOSE,UNITS,FORM,SCHED,ROUTE
    5087 "RTN","C0STBL",97,0)
    5088  S (MEDCNT,OMED,GSNO,PATCNT)=0
    5089 "RTN","C0STBL",98,0)
    5090  N ZI S ZI=""
    5091 "RTN","C0STBL",99,0)
    5092  N GN S GN=$NA(^TMP("C0STBL"))
    5093 "RTN","C0STBL",100,0)
    5094  F  S ZI=$O(@GN@(ZI)) Q:ZI=""  D  ;
    5095 "RTN","C0STBL",101,0)
    5096  . S PATCNT=PATCNT+1
    5097 "RTN","C0STBL",102,0)
    5098  . I '$D(@GN@(ZI,"med")) Q  ;
    5099 "RTN","C0STBL",103,0)
    5100  . N ZJ S ZJ=""
    5101 "RTN","C0STBL",104,0)
    5102  . F  S ZJ=$O(@GN@(ZI,"med",ZJ)) Q:ZJ=""  D  ;
    5103 "RTN","C0STBL",105,0)
    5104  . . S MEDCNT=MEDCNT+1
    5105 "RTN","C0STBL",106,0)
    5106  . . I $G(@GN@(ZI,"med",ZJ,"vaStatus@value"))="EXPIRED" D  Q  ;
    5107 "RTN","C0STBL",107,0)
    5108  . . . I $D(DEBUG) W !,"Expired Mediation, Skipping"
    5109 "RTN","C0STBL",108,0)
    5110  . . I $G(@GN@(ZI,"med",ZJ,"vaType@value"))="I" D  Q  ;
    5111 "RTN","C0STBL",109,0)
    5112  . . . I $D(DEBUG) W !,"Inpatient Med, skipping"
    5113 "RTN","C0STBL",110,0)
    5114  . . I $G(@GN@(ZI,"med",ZI,"vaType@value"))="V" D  Q  ;
    5115 "RTN","C0STBL",111,0)
    5116  . . . I $D(DEBUG) W !,"IV Inpatient Med, skipping"
    5117 "RTN","C0STBL",112,0)
    5118  . . S OMED=OMED+1
    5119 "RTN","C0STBL",113,0)
    5120  . . S X=$G(@GN@(ZI,"med",ZJ,"form@value"))
    5121 "RTN","C0STBL",114,0)
    5122  . . S FORM(X)=$G(FORM(X))+1
    5123 "RTN","C0STBL",115,0)
    5124  . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@dose"))
    5125 "RTN","C0STBL",116,0)
    5126  . . I X="" S X="UNKNOWN"
    5127 "RTN","C0STBL",117,0)
    5128  . . S DOSE(X)=$G(DOSE(X))+1
    5129 "RTN","C0STBL",118,0)
    5130  . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@units"))
    5131 "RTN","C0STBL",119,0)
    5132  . . I X="" S X="UNKNOWN"
    5133 "RTN","C0STBL",120,0)
    5134  . . S UNITS(X)=$G(UNITS(X))+1
    5135 "RTN","C0STBL",121,0)
    5136  . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@schedule"))
    5137 "RTN","C0STBL",122,0)
    5138  . . I X="" S X="UNKNOWN"
    5139 "RTN","C0STBL",123,0)
    5140  . . S SCHED(X)=$G(SCHED(X))+1
    5141 "RTN","C0STBL",124,0)
    5142  . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dosc@route"))
    5143 "RTN","C0STBL",125,0)
    5144  . . I X="" S X="UNKNOWN"
    51455129"RTN","C0STBL",126,0)
    5146  . . S ROUTE(X)=$G(ROUTE(X))+1
     5130 W !,"Total number of medications: ",MEDCNT
    51475131"RTN","C0STBL",127,0)
    5148  W !,"Total number of patients: ",PATCNT
     5132 W !,"Total number of outpatient medications: ",OMED
    51495133"RTN","C0STBL",128,0)
    5150  W !,"Total number of medications: ",MEDCNT
     5134 W !,"Percentage of outpatient medications: ",$P((OMED/MEDCNT)*100,".")_"%",!
    51515135"RTN","C0STBL",129,0)
    5152  W !,"Total number of outpatient medications: ",OMED
     5136 ZWR FORM
    51535137"RTN","C0STBL",130,0)
    5154  W !,"Percentage of outpatient medications: ",$P((OMED/MEDCNT)*100,".")_"%",!
     5138 ZWR DOSE
    51555139"RTN","C0STBL",131,0)
    5156  ZWR FORM
     5140 ZWR UNITS
    51575141"RTN","C0STBL",132,0)
    5158  ZWR DOSE
     5142 ZWR SCHED
    51595143"RTN","C0STBL",133,0)
    5160  ZWR UNITS
     5144 ZWR ROUTE
    51615145"RTN","C0STBL",134,0)
    5162  ZWR SCHED
     5146 Q
    51635147"RTN","C0STBL",135,0)
    5164  ZWR ROUTE
    5165 "RTN","C0STBL",136,0)
    5166  Q
    5167 "RTN","C0STBL",137,0)
    51685148 ;
    51695149"RTN","C0SUTIL")
    5170 0^12^B1005502
     51500^12^B968662
    51715151"RTN","C0SUTIL",1,0)
    51725152C0SUTIL   ; GPL - Smart Processing Utilities ;2/22/12  17:05
    51735153"RTN","C0SUTIL",2,0)
    5174  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     5154 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    51755155"RTN","C0SUTIL",3,0)
    5176  ;Copyright 2012 George Lilly.  Licensed under the terms of the GNU
     5156 ;Copyright 2012 George Lilly. 
    51775157"RTN","C0SUTIL",4,0)
    5178  ;General Public License See attached copy of the License.
     5158 ;
    51795159"RTN","C0SUTIL",5,0)
    5180  ;
     5160 ; This program is free software: you can redistribute it and/or modify
    51815161"RTN","C0SUTIL",6,0)
    5182  ;This program is free software; you can redistribute it and/or modify
     5162 ; it under the terms of the GNU Affero General Public License as
    51835163"RTN","C0SUTIL",7,0)
    5184  ;it under the terms of the GNU General Public License as published by
     5164 ; published by the Free Software Foundation, either version 3 of the
    51855165"RTN","C0SUTIL",8,0)
    5186  ;the Free Software Foundation; either version 2 of the License, or
     5166 ; License, or (at your option) any later version.
    51875167"RTN","C0SUTIL",9,0)
    5188  ;(at your option) any later version.
     5168 ;
    51895169"RTN","C0SUTIL",10,0)
    5190  ;
     5170 ; This program is distributed in the hope that it will be useful,
    51915171"RTN","C0SUTIL",11,0)
    5192  ;This program is distributed in the hope that it will be useful,
     5172 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    51935173"RTN","C0SUTIL",12,0)
    5194  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     5174 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    51955175"RTN","C0SUTIL",13,0)
    5196  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     5176 ; GNU Affero General Public License for more details.
    51975177"RTN","C0SUTIL",14,0)
    5198  ;GNU General Public License for more details.
     5178 ;
    51995179"RTN","C0SUTIL",15,0)
    5200  ;
     5180 ; You should have received a copy of the GNU Affero General Public License
    52015181"RTN","C0SUTIL",16,0)
    5202  ;You should have received a copy of the GNU General Public License along
     5182 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    52035183"RTN","C0SUTIL",17,0)
    5204  ;with this program; if not, write to the Free Software Foundation, Inc.,
     5184 ;
    52055185"RTN","C0SUTIL",18,0)
    5206  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     5186 Q
    52075187"RTN","C0SUTIL",19,0)
    52085188 ;
    52095189"RTN","C0SUTIL",20,0)
    5210  Q
     5190SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd
    52115191"RTN","C0SUTIL",21,0)
    5212  ;
     5192 ; ZDATE is a fileman format date
    52135193"RTN","C0SUTIL",22,0)
    5214 SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd
     5194 N TMPDT
    52155195"RTN","C0SUTIL",23,0)
    5216  ; ZDATE is a fileman format date
     5196 S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date
    52175197"RTN","C0SUTIL",24,0)
    5218  N TMPDT
     5198 S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens
    52195199"RTN","C0SUTIL",25,0)
    5220  S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date
     5200 I TMPDT="" S TMPDT="UNKNOWN"
    52215201"RTN","C0SUTIL",26,0)
    5222  S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens
     5202 N Z2,Z3
    52235203"RTN","C0SUTIL",27,0)
    5224  I TMPDT="" S TMPDT="UNKNOWN"
     5204 S Z2=$P(TMPDT,"-",2)
    52255205"RTN","C0SUTIL",28,0)
    5226  N Z2,Z3
     5206 S Z3=$P(TMPDT,"-",3)
    52275207"RTN","C0SUTIL",29,0)
    5228  S Z2=$P(TMPDT,"-",2)
     5208 I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2
    52295209"RTN","C0SUTIL",30,0)
    5230  S Z3=$P(TMPDT,"-",3)
     5210 I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3
    52315211"RTN","C0SUTIL",31,0)
    5232  I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2
     5212 Q TMPDT
    52335213"RTN","C0SUTIL",32,0)
    5234  I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3
    5235 "RTN","C0SUTIL",33,0)
    5236  Q TMPDT
    5237 "RTN","C0SUTIL",34,0)
    52385214 ;
    52395215"RTN","C0SXPATH")
    5240 0^13^B521283143
     52160^13^B518728149
    52415217"RTN","C0SXPATH",1,0)
    52425218C0SXPATH   ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am
    52435219"RTN","C0SXPATH",2,0)
    5244  ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5
     5220 ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 6
    52455221"RTN","C0SXPATH",3,0)
    5246  ;Copyright 2008-2012 George Lilly.  Licensed under the terms of the GNU
     5222 ;Copyright 2008-2012 George Lilly. 
    52475223"RTN","C0SXPATH",4,0)
    5248  ;General Public License See attached copy of the License.
     5224 ;
    52495225"RTN","C0SXPATH",5,0)
    5250  ;
     5226 ; This program is free software: you can redistribute it and/or modify
    52515227"RTN","C0SXPATH",6,0)
    5252  ;This program is free software; you can redistribute it and/or modify
     5228 ; it under the terms of the GNU Affero General Public License as
    52535229"RTN","C0SXPATH",7,0)
    5254  ;it under the terms of the GNU General Public License as published by
     5230 ; published by the Free Software Foundation, either version 3 of the
    52555231"RTN","C0SXPATH",8,0)
    5256  ;the Free Software Foundation; either version 2 of the License, or
     5232 ; License, or (at your option) any later version.
    52575233"RTN","C0SXPATH",9,0)
    5258  ;(at your option) any later version.
     5234 ;
    52595235"RTN","C0SXPATH",10,0)
    5260  ;
     5236 ; This program is distributed in the hope that it will be useful,
    52615237"RTN","C0SXPATH",11,0)
    5262  ;This program is distributed in the hope that it will be useful,
     5238 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    52635239"RTN","C0SXPATH",12,0)
    5264  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     5240 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    52655241"RTN","C0SXPATH",13,0)
    5266  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     5242 ; GNU Affero General Public License for more details.
    52675243"RTN","C0SXPATH",14,0)
    5268  ;GNU General Public License for more details.
     5244 ;
    52695245"RTN","C0SXPATH",15,0)
    5270  ;
     5246 ; You should have received a copy of the GNU Affero General Public License
    52715247"RTN","C0SXPATH",16,0)
    5272  ;You should have received a copy of the GNU General Public License along
     5248 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    52735249"RTN","C0SXPATH",17,0)
    5274  ;with this program; if not, write to the Free Software Foundation, Inc.,
     5250 ;
    52755251"RTN","C0SXPATH",18,0)
    5276  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     5252 W "This is an XML XPATH utility library",!
    52775253"RTN","C0SXPATH",19,0)
    5278  ;
     5254 W !
    52795255"RTN","C0SXPATH",20,0)
    5280  W "This is an XML XPATH utility library",!
     5256 Q
    52815257"RTN","C0SXPATH",21,0)
    5282  W !
     5258 ;
    52835259"RTN","C0SXPATH",22,0)
    5284  Q
     5260OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
    52855261"RTN","C0SXPATH",23,0)
    52865262 ;
    52875263"RTN","C0SXPATH",24,0)
    5288 OUTPUT(OUTARY,OUTNAME,OUTDIR)   ; WRITE AN ARRAY TO A FILE
     5264 N Y
    52895265"RTN","C0SXPATH",25,0)
    5290  ;
     5266 S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
    52915267"RTN","C0SXPATH",26,0)
    5292  N Y
     5268 I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
    52935269"RTN","C0SXPATH",27,0)
    5294  S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME)
     5270 I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
    52955271"RTN","C0SXPATH",28,0)
    5296  I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR
     5272 Q
    52975273"RTN","C0SXPATH",29,0)
    5298  I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR
     5274 ;
    52995275"RTN","C0SXPATH",30,0)
    5300  Q
     5276PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
    53015277"RTN","C0SXPATH",31,0)
    5302  ;
     5278 ;  VAL IS A STRING AND STK IS PASSED BY NAME
    53035279"RTN","C0SXPATH",32,0)
    5304 PUSH(STK,VAL)   ; pushs VAL onto STK and updates STK(0)
     5280 ;
    53055281"RTN","C0SXPATH",33,0)
    5306  ;  VAL IS A STRING AND STK IS PASSED BY NAME
     5282 I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
    53075283"RTN","C0SXPATH",34,0)
    5308  ;
     5284 S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
    53095285"RTN","C0SXPATH",35,0)
    5310  I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE
     5286 S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
    53115287"RTN","C0SXPATH",36,0)
    5312  S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH
     5288 Q
    53135289"RTN","C0SXPATH",37,0)
    5314  S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY
     5290 ;
    53155291"RTN","C0SXPATH",38,0)
    5316  Q
     5292POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
    53175293"RTN","C0SXPATH",39,0)
    5318  ;
     5294 ; VAL AND STK ARE PASSED BY REFERENCE
    53195295"RTN","C0SXPATH",40,0)
    5320 POP(STK,VAL)    ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL
     5296 ;
    53215297"RTN","C0SXPATH",41,0)
    5322  ; VAL AND STK ARE PASSED BY REFERENCE
     5298 I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
    53235299"RTN","C0SXPATH",42,0)
    5324  ;
     5300 . S VAL=""
    53255301"RTN","C0SXPATH",43,0)
    5326  I @STK@(0)<1 D  ; IF ARRAY IS EMPTY
     5302 . S @STK@(0)=0
    53275303"RTN","C0SXPATH",44,0)
    5328  . S VAL=""
     5304 I @STK@(0)>0  D  ;
    53295305"RTN","C0SXPATH",45,0)
    5330  . S @STK@(0)=0
     5306 . S VAL=@STK@(@STK@(0))
    53315307"RTN","C0SXPATH",46,0)
    5332  I @STK@(0)>0  D  ;
     5308 . K @STK@(@STK@(0))
    53335309"RTN","C0SXPATH",47,0)
    5334  . S VAL=@STK@(@STK@(0))
     5310 . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
    53355311"RTN","C0SXPATH",48,0)
    5336  . K @STK@(@STK@(0))
     5312 Q
    53375313"RTN","C0SXPATH",49,0)
    5338  . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY
     5314 ;
    53395315"RTN","C0SXPATH",50,0)
    5340  Q
     5316PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
    53415317"RTN","C0SXPATH",51,0)
    53425318 ;
    53435319"RTN","C0SXPATH",52,0)
    5344 PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME
     5320 N ZGI
    53455321"RTN","C0SXPATH",53,0)
    5346  ;
     5322 F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
    53475323"RTN","C0SXPATH",54,0)
    5348  N ZGI
     5324 . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
    53495325"RTN","C0SXPATH",55,0)
    5350  F ZGI=1:1:@ASRC@(0) D  ; FOR ALL OF THE SOURCE ARRAY
     5326 Q
    53515327"RTN","C0SXPATH",56,0)
    5352  . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT
     5328 ;
    53535329"RTN","C0SXPATH",57,0)
    5354  Q
     5330MKMDX(STK,RTN,INREDUX)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
    53555331"RTN","C0SXPATH",58,0)
    5356  ;
     5332 ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
    53575333"RTN","C0SXPATH",59,0)
    5358 MKMDX(STK,RTN,INREDUX)  ; MAKES A MUMPS INDEX FROM THE ARRAY STK
     5334 ; REDUX IS A STRING TO REMOVE FROM THE RESULT
    53595335"RTN","C0SXPATH",60,0)
    5360  ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS
     5336 S RTN=""
    53615337"RTN","C0SXPATH",61,0)
    5362  ; REDUX IS A STRING TO REMOVE FROM THE RESULT
     5338 N I
    53635339"RTN","C0SXPATH",62,0)
    5364  S RTN=""
     5340 ; W "STK= ",STK,!
    53655341"RTN","C0SXPATH",63,0)
     5342 I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
     5343"RTN","C0SXPATH",64,0)
     5344 . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
     5345"RTN","C0SXPATH",65,0)
     5346 . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
     5347"RTN","C0SXPATH",66,0)
     5348 . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
     5349"RTN","C0SXPATH",67,0)
     5350 I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)
     5351"RTN","C0SXPATH",68,0)
     5352 Q
     5353"RTN","C0SXPATH",69,0)
     5354 ;
     5355"RTN","C0SXPATH",70,0)
     5356XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
     5357"RTN","C0SXPATH",71,0)
     5358 ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
     5359"RTN","C0SXPATH",72,0)
     5360 ; ISTR IS PASSED BY VALUE
     5361"RTN","C0SXPATH",73,0)
     5362 N CUR,TMP
     5363"RTN","C0SXPATH",74,0)
     5364 I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
     5365"RTN","C0SXPATH",75,0)
     5366 . S TMP=$P(ISTR,"<",2)
     5367"RTN","C0SXPATH",76,0)
     5368 I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
     5369"RTN","C0SXPATH",77,0)
     5370 . S TMP=$P(TMP,"/",2)
     5371"RTN","C0SXPATH",78,0)
     5372 S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
     5373"RTN","C0SXPATH",79,0)
     5374 ; W "CUR= ",CUR,!
     5375"RTN","C0SXPATH",80,0)
     5376 I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
     5377"RTN","C0SXPATH",81,0)
     5378 . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
     5379"RTN","C0SXPATH",82,0)
     5380 ; W "CUR2= ",CUR,!
     5381"RTN","C0SXPATH",83,0)
     5382 Q CUR
     5383"RTN","C0SXPATH",84,0)
     5384 ;
     5385"RTN","C0SXPATH",85,0)
     5386XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML
     5387"RTN","C0SXPATH",86,0)
     5388 ; <NAME>VALUE</NAME> WILL RETURN VALUE
     5389"RTN","C0SXPATH",87,0)
     5390 N G
     5391"RTN","C0SXPATH",88,0)
     5392 S G=$P(ISTR,">",2) ;STRIP OFF <NAME>
     5393"RTN","C0SXPATH",89,0)
     5394 Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE
     5395"RTN","C0SXPATH",90,0)
     5396 ;
     5397"RTN","C0SXPATH",91,0)
     5398VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV
     5399"RTN","C0SXPATH",92,0)
     5400 ; VDX: @INVDX@(XPATH)=VALUE
     5401"RTN","C0SXPATH",93,0)
     5402 ; VDV: @OUTVDV@(X1X2X3X4)=VALUE
     5403"RTN","C0SXPATH",94,0)
     5404 ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE
     5405"RTN","C0SXPATH",95,0)
     5406 ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS
     5407"RTN","C0SXPATH",96,0)
     5408 ; @VDV@("XPATH",X1X2X3X4)="XPATH"
     5409"RTN","C0SXPATH",97,0)
     5410 N ZA,ZI,ZW
     5411"RTN","C0SXPATH",98,0)
     5412 S ZI=""
     5413"RTN","C0SXPATH",99,0)
     5414 F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
     5415"RTN","C0SXPATH",100,0)
     5416 . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME
     5417"RTN","C0SXPATH",101,0)
     5418 . W ZW,!
     5419"RTN","C0SXPATH",102,0)
     5420 . S @OUTVDV@(ZW)=@INVDX@(ZI)
     5421"RTN","C0SXPATH",103,0)
     5422 . S @OUTVDV@("XPATH",ZW)=ZI
     5423"RTN","C0SXPATH",104,0)
     5424 Q
     5425"RTN","C0SXPATH",105,0)
     5426 ;
     5427"RTN","C0SXPATH",106,0)
     5428VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG
     5429"RTN","C0SXPATH",107,0)
     5430 ; VDX: @VDX@(XPATH)=VALUE
     5431"RTN","C0SXPATH",108,0)
     5432 ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE
     5433"RTN","C0SXPATH",109,0)
     5434 ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX
     5435"RTN","C0SXPATH",110,0)
     5436 N ZA,ZI,ZW
     5437"RTN","C0SXPATH",111,0)
     5438 S ZI=""
     5439"RTN","C0SXPATH",112,0)
     5440 F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
     5441"RTN","C0SXPATH",113,0)
     5442 . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //
     5443"RTN","C0SXPATH",114,0)
     5444 . S ZW2=$P(ZW,"/",1)
     5445"RTN","C0SXPATH",115,0)
     5446 . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
     5447"RTN","C0SXPATH",116,0)
     5448 . ;ZWR ZA
     5449"RTN","C0SXPATH",117,0)
     5450 . S ZW2=ZA(1)
     5451"RTN","C0SXPATH",118,0)
     5452 . F ZK=2:1:ZA(0) D  ;
     5453"RTN","C0SXPATH",119,0)
     5454 . . S ZW2=ZW2_""","""_ZA(ZK)
     5455"RTN","C0SXPATH",120,0)
     5456 . K ZA
     5457"RTN","C0SXPATH",121,0)
     5458 . S ZW2=""""_ZW2_""""
     5459"RTN","C0SXPATH",122,0)
     5460 . W ZW2,!
     5461"RTN","C0SXPATH",123,0)
     5462 . S ZN=OUTXPG_"("_ZW2_")"
     5463"RTN","C0SXPATH",124,0)
     5464 . S @ZN=@INVDX@(ZI)
     5465"RTN","C0SXPATH",125,0)
     5466 Q
     5467"RTN","C0SXPATH",126,0)
     5468 ;
     5469"RTN","C0SXPATH",127,0)
     5470XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY
     5471"RTN","C0SXPATH",128,0)
     5472 ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE
     5473"RTN","C0SXPATH",129,0)
     5474 ;
     5475"RTN","C0SXPATH",130,0)
     5476 ;N G1
     5477"RTN","C0SXPATH",131,0)
     5478 D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
     5479"RTN","C0SXPATH",132,0)
     5480 D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
     5481"RTN","C0SXPATH",133,0)
     5482 Q
     5483"RTN","C0SXPATH",134,0)
     5484 ;
     5485"RTN","C0SXPATH",135,0)
     5486DO
     5487"RTN","C0SXPATH",136,0)
     5488 D XPG2XML("^GPL2B","^GPL2A")
     5489"RTN","C0SXPATH",137,0)
     5490 Q
     5491"RTN","C0SXPATH",138,0)
     5492 ;
     5493"RTN","C0SXPATH",139,0)
     5494T1 ; TEST OUT THESE ROUTINES
     5495"RTN","C0SXPATH",140,0)
     5496 D XML2XPG("G2","^GPL")
     5497"RTN","C0SXPATH",141,0)
     5498 D XPG2XML("G3","G2")
     5499"RTN","C0SXPATH",142,0)
     5500 K ^GPLOUT
     5501"RTN","C0SXPATH",143,0)
     5502 M ^GPLOUT=G3
     5503"RTN","C0SXPATH",144,0)
     5504 W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")
     5505"RTN","C0SXPATH",145,0)
     5506 Q
     5507"RTN","C0SXPATH",146,0)
     5508 ;
     5509"RTN","C0SXPATH",147,0)
     5510XPG2XML(OUTXML,INXPG) ;
     5511"RTN","C0SXPATH",148,0)
     5512 N C0CN,FWD,ZA,G,GA,ZQ
     5513"RTN","C0SXPATH",149,0)
     5514 S ZQ=0 ; QUIT FLAG
     5515"RTN","C0SXPATH",150,0)
     5516 F  Q:ZQ=1  D  ; LOOP THROUGH EVERYTHING
     5517"RTN","C0SXPATH",151,0)
     5518 . I '$D(C0CN) D  ; FIRST TIME THROUGH
     5519"RTN","C0SXPATH",152,0)
     5520 . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
     5521"RTN","C0SXPATH",153,0)
     5522 . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
     5523"RTN","C0SXPATH",154,0)
     5524 . . S G=$Q(@INXPG) ; THIS ONE
     5525"RTN","C0SXPATH",155,0)
     5526 . . S GN=$Q(@G) ; NEXT ONE
     5527"RTN","C0SXPATH",156,0)
     5528 . . S C0CN=1 ; SUBSCRIPT COUNT
     5529"RTN","C0SXPATH",157,0)
     5530 . . S ZQ=0 ; QUIT FLAG
     5531"RTN","C0SXPATH",158,0)
     5532 . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
     5533"RTN","C0SXPATH",159,0)
     5534 . . I $QS(G,1)="ContinuityOfCareRecord" D  ;
     5535"RTN","C0SXPATH",160,0)
     5536 . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
     5537"RTN","C0SXPATH",161,0)
     5538 . I FWD D  ; GOING FORWARDS
     5539"RTN","C0SXPATH",162,0)
     5540 . . I C0CN<$QL(G) D  ; NOT A DATA NODE
     5541"RTN","C0SXPATH",163,0)
     5542 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
     5543"RTN","C0SXPATH",164,0)
     5544 . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
     5545"RTN","C0SXPATH",165,0)
     5546 . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D  ;
     5547"RTN","C0SXPATH",166,0)
     5548 . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"
     5549"RTN","C0SXPATH",167,0)
     5550 . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
     5551"RTN","C0SXPATH",168,0)
     5552 . . E  D  ; AT THE DATA NODE
     5553"RTN","C0SXPATH",169,0)
     5554 . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
     5555"RTN","C0SXPATH",170,0)
     5556 . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE
     5557"RTN","C0SXPATH",171,0)
     5558 . . . S FWD=0 ; GO BACKWARDS
     5559"RTN","C0SXPATH",172,0)
     5560 . I 'FWD D  ;GOING BACKWARDS
     5561"RTN","C0SXPATH",173,0)
     5562 . . S GN=$Q(@G) ;NEXT XPATH
     5563"RTN","C0SXPATH",174,0)
     5564 . . ;W "NEXT!",GN,!
     5565"RTN","C0SXPATH",175,0)
     5566 . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
     5567"RTN","C0SXPATH",176,0)
     5568 . . I GN'="" D  ;
     5569"RTN","C0SXPATH",177,0)
     5570 . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D  ; NEED TO CLOSE OFF ELEMENT
     5571"RTN","C0SXPATH",178,0)
     5572 . . . . D ZXC($QS(G,C0CN)) ;
     5573"RTN","C0SXPATH",179,0)
     5574 . . . E  I GN'="" D  ; MORE ELEMENTS AT THIS LEVEL
     5575"RTN","C0SXPATH",180,0)
     5576 . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
     5577"RTN","C0SXPATH",181,0)
     5578 . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
     5579"RTN","C0SXPATH",182,0)
     5580 . . . . S FWD=1 ; GOING FORWARD NOW
     5581"RTN","C0SXPATH",183,0)
     5582 . I (GN="")&(C0CN=1) D  Q  ; WHEN WE ARE ALL DONE
     5583"RTN","C0SXPATH",184,0)
     5584 . . D ZXC($QS(G,C0CN)) ; LAST ONE
     5585"RTN","C0SXPATH",185,0)
     5586 . . S ZQ=1 ; QUIT NOW
     5587"RTN","C0SXPATH",186,0)
     5588 Q
     5589"RTN","C0SXPATH",187,0)
     5590 ;
     5591"RTN","C0SXPATH",188,0)
     5592ZXO(WHAT)
     5593"RTN","C0SXPATH",189,0)
     5594 D PUSH("GA",WHAT)
     5595"RTN","C0SXPATH",190,0)
     5596 D PUSH(OUTXML,"<"_WHAT_">")
     5597"RTN","C0SXPATH",191,0)
     5598 Q
     5599"RTN","C0SXPATH",192,0)
     5600 ;
     5601"RTN","C0SXPATH",193,0)
     5602ZXC(WHAT)
     5603"RTN","C0SXPATH",194,0)
     5604 D POP("GA",.TMP)
     5605"RTN","C0SXPATH",195,0)
     5606 D PUSH(OUTXML,"</"_WHAT_">")
     5607"RTN","C0SXPATH",196,0)
     5608 Q
     5609"RTN","C0SXPATH",197,0)
     5610 ;
     5611"RTN","C0SXPATH",198,0)
     5612ZXVAL(WHAT,VAL)
     5613"RTN","C0SXPATH",199,0)
     5614 D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
     5615"RTN","C0SXPATH",200,0)
     5616 Q
     5617"RTN","C0SXPATH",201,0)
     5618 ;
     5619"RTN","C0SXPATH",202,0)
     5620INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce
     5621"RTN","C0SXPATH",203,0)
     5622 ; an XPATH index; REDUX is a string to be removed from each xpath
     5623"RTN","C0SXPATH",204,0)
     5624 ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME
     5625"RTN","C0SXPATH",205,0)
     5626 ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE
     5627"RTN","C0SXPATH",206,0)
     5628 ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG
     5629"RTN","C0SXPATH",207,0)
     5630 ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
     5631"RTN","C0SXPATH",208,0)
     5632 ; @VDX@("XPATH")=VALUE
     5633"RTN","C0SXPATH",209,0)
     5634 ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
     5635"RTN","C0SXPATH",210,0)
     5636 ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
     5637"RTN","C0SXPATH",211,0)
     5638 ; XML SECTION
     5639"RTN","C0SXPATH",212,0)
     5640 ; IZXML IS PASSED BY NAME
     5641"RTN","C0SXPATH",213,0)
     5642 ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
     5643"RTN","C0SXPATH",214,0)
     5644 N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
     5645"RTN","C0SXPATH",215,0)
     5646 N C0CSTK ; LEAVE OUT FOR DEBUGGING
     5647"RTN","C0SXPATH",216,0)
     5648 I '$D(REDUX) S REDUX=""
     5649"RTN","C0SXPATH",217,0)
     5650 I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
     5651"RTN","C0SXPATH",218,0)
     5652 N ZXML
     5653"RTN","C0SXPATH",219,0)
     5654 I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
     5655"RTN","C0SXPATH",220,0)
     5656 E  S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
     5657"RTN","C0SXPATH",221,0)
     5658 I '$D(@IZXML@(0)) D  ; IF COUNT NOT IN NODE 0 COUNT THEM
     5659"RTN","C0SXPATH",222,0)
     5660 . S I="",LCNT=0
     5661"RTN","C0SXPATH",223,0)
     5662 . F  S I=$O(@IZXML@(I)) Q:I=""  S LCNT=LCNT+1
     5663"RTN","C0SXPATH",224,0)
     5664 E  S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
     5665"RTN","C0SXPATH",225,0)
     5666 I LCNT=0  D  Q  ; NO XML PASSED
     5667"RTN","C0SXPATH",226,0)
     5668 . W "ERROR IN XML FILE",!
     5669"RTN","C0SXPATH",227,0)
     5670 S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
     5671"RTN","C0SXPATH",228,0)
     5672 I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
     5673"RTN","C0SXPATH",229,0)
     5674 S C0CSTK(0)=0 ; INITIALIZE STACK
     5675"RTN","C0SXPATH",230,0)
     5676 K LKASD ; KILL LOOKASIDE ARRAY
     5677"RTN","C0SXPATH",231,0)
     5678 D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
     5679"RTN","C0SXPATH",232,0)
     5680 F I=1:1:LCNT  D  ; PROCESS THE ENTIRE ARRAY
     5681"RTN","C0SXPATH",233,0)
     5682 . S LINE=@IZXML@(I)
     5683"RTN","C0SXPATH",234,0)
     5684 . I $D(TEMPLATE) D  ;IF TEMPLATE IS REQUESTED
     5685"RTN","C0SXPATH",235,0)
     5686 . . S @TEMPLATE@(I)=$$CLEAN(LINE)
     5687"RTN","C0SXPATH",236,0)
     5688 . ;W LINE,!
     5689"RTN","C0SXPATH",237,0)
     5690 . S FOUND=0  ; INTIALIZED FOUND FLAG
     5691"RTN","C0SXPATH",238,0)
     5692 . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
     5693"RTN","C0SXPATH",239,0)
     5694 . I FOUND'=1  D
     5695"RTN","C0SXPATH",240,0)
     5696 . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
     5697"RTN","C0SXPATH",241,0)
     5698 . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
     5699"RTN","C0SXPATH",242,0)
     5700 . . . ; ON THE SAME LINE
     5701"RTN","C0SXPATH",243,0)
     5702 . . . ; W "FOUND ",LINE,!
     5703"RTN","C0SXPATH",244,0)
     5704 . . . S FOUND=1  ; SET FOUND FLAG
     5705"RTN","C0SXPATH",245,0)
     5706 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
     5707"RTN","C0SXPATH",246,0)
     5708 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
     5709"RTN","C0SXPATH",247,0)
     5710 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
     5711"RTN","C0SXPATH",248,0)
     5712 . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX
     5713"RTN","C0SXPATH",249,0)
     5714 . . . ; W "MDX=",MDX,!
     5715"RTN","C0SXPATH",250,0)
     5716 . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
     5717"RTN","C0SXPATH",251,0)
     5718 . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2
     5719"RTN","C0SXPATH",252,0)
     5720 . . . . ;E  S ZDUP(MDX)=ZDUP(MDX)+1
     5721"RTN","C0SXPATH",253,0)
     5722 . . . . ;W "DUP:",MDX,!
     5723"RTN","C0SXPATH",254,0)
     5724 . . . . ;I '$D(CURVAL) S CURVAL=""
     5725"RTN","C0SXPATH",255,0)
     5726 . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL
     5727"RTN","C0SXPATH",256,0)
     5728 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
     5729"RTN","C0SXPATH",257,0)
     5730 . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
     5731"RTN","C0SXPATH",258,0)
     5732 . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
     5733"RTN","C0SXPATH",259,0)
     5734 . . . . S CURVAL=$$XVAL(LINE) ; VALUE
     5735"RTN","C0SXPATH",260,0)
     5736 . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE
     5737"RTN","C0SXPATH",261,0)
     5738 . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED
     5739"RTN","C0SXPATH",262,0)
     5740 . . . . I $D(TEMPLATE) D  ; IF TEMPLATE IS REQUESTED
     5741"RTN","C0SXPATH",263,0)
     5742 . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS
     5743"RTN","C0SXPATH",264,0)
     5744 . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2)
     5745"RTN","C0SXPATH",265,0)
     5746 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
     5747"RTN","C0SXPATH",266,0)
     5748 . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
     5749"RTN","C0SXPATH",267,0)
     5750 . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
     5751"RTN","C0SXPATH",268,0)
     5752 . . . ; W "FOUND ",LINE,!
     5753"RTN","C0SXPATH",269,0)
     5754 . . . S FOUND=1  ; SET FOUND FLAG
     5755"RTN","C0SXPATH",270,0)
     5756 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
     5757"RTN","C0SXPATH",271,0)
     5758 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
     5759"RTN","C0SXPATH",272,0)
     5760 . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
     5761"RTN","C0SXPATH",273,0)
     5762 . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
     5763"RTN","C0SXPATH",274,0)
     5764 . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE
     5765"RTN","C0SXPATH",275,0)
     5766 . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
     5767"RTN","C0SXPATH",276,0)
     5768 . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
     5769"RTN","C0SXPATH",277,0)
     5770 . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
     5771"RTN","C0SXPATH",278,0)
     5772 . . . . Q
     5773"RTN","C0SXPATH",279,0)
     5774 . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
     5775"RTN","C0SXPATH",280,0)
     5776 . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
     5777"RTN","C0SXPATH",281,0)
     5778 . . . ; W "FOUND ",LINE,!
     5779"RTN","C0SXPATH",282,0)
     5780 . . . S FOUND=1  ; SET FOUND FLAG
     5781"RTN","C0SXPATH",283,0)
     5782 . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
     5783"RTN","C0SXPATH",284,0)
     5784 . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
     5785"RTN","C0SXPATH",285,0)
     5786 . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
     5787"RTN","C0SXPATH",286,0)
     5788 . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
     5789"RTN","C0SXPATH",287,0)
     5790 . . . ; W "MDX=",MDX,!
     5791"RTN","C0SXPATH",288,0)
     5792 . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
     5793"RTN","C0SXPATH",289,0)
     5794 . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
     5795"RTN","C0SXPATH",290,0)
     5796 . . . . ;B
     5797"RTN","C0SXPATH",291,0)
     5798 . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
     5799"RTN","C0SXPATH",292,0)
     5800 . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
     5801"RTN","C0SXPATH",293,0)
     5802 S @ZXML@("INDEXED")=""
     5803"RTN","C0SXPATH",294,0)
     5804 S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
     5805"RTN","C0SXPATH",295,0)
     5806 I NOINX K @ZXML ; DELETE UNWANTED INDEX
     5807"RTN","C0SXPATH",296,0)
     5808 Q
     5809"RTN","C0SXPATH",297,0)
     5810 ;
     5811"RTN","C0SXPATH",298,0)
     5812MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES
     5813"RTN","C0SXPATH",299,0)
     5814 ;
     5815"RTN","C0SXPATH",300,0)
     5816 N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2
     5817"RTN","C0SXPATH",301,0)
     5818 F ZI=1:1:LCNT-1  D  ; PROCESS THE ENTIRE ARRAY
     5819"RTN","C0SXPATH",302,0)
     5820 . S ZLINE=@IZXML@(ZI)
     5821"RTN","C0SXPATH",303,0)
     5822 . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1)
     5823"RTN","C0SXPATH",304,0)
     5824 . I ZLINE?.E1"</"1.E  D  ; NEXT LINE CONTAINS END OF A SECTION
     5825"RTN","C0SXPATH",305,0)
     5826 . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME
     5827"RTN","C0SXPATH",306,0)
     5828 . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>")  D  ; BEGINNING OF A SECTION
     5829"RTN","C0SXPATH",307,0)
     5830 . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME
     5831"RTN","C0SXPATH",308,0)
     5832 . . . I CUR=CUR2 D  ; IF THIS IS A MULTIPLE
     5833"RTN","C0SXPATH",309,0)
     5834 . . . . S OUTBUF(CUR,ZI+1)=""
     5835"RTN","C0SXPATH",310,0)
     5836 ;ZWR OUTBUF
     5837"RTN","C0SXPATH",311,0)
     5838 S ZI=""
     5839"RTN","C0SXPATH",312,0)
     5840 F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; FOR EACH KIND OF MULTIPLE
     5841"RTN","C0SXPATH",313,0)
     5842 . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
     5843"RTN","C0SXPATH",314,0)
     5844 . F  S ZN=$O(@IZXML@(ZN),-1) Q:ZN=""  I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q  ;
     5845"RTN","C0SXPATH",315,0)
     5846 . S OUTBUF(ZI,ZN)=""
     5847"RTN","C0SXPATH",316,0)
     5848 S ZA=1,ZI="",ZN=""
     5849"RTN","C0SXPATH",317,0)
     5850 F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; ADDING THE COUNT FOR THE MULIPLES [x]
     5851"RTN","C0SXPATH",318,0)
     5852 . S ZN="",ZA=1
     5853"RTN","C0SXPATH",319,0)
     5854 . F  S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN=""  D  ;
     5855"RTN","C0SXPATH",320,0)
     5856 . . S OUTBUF(ZI,ZN)="["_ZA_"]"
     5857"RTN","C0SXPATH",321,0)
     5858 . . S ZA=ZA+1
     5859"RTN","C0SXPATH",322,0)
     5860 Q
     5861"RTN","C0SXPATH",323,0)
     5862 ;
     5863"RTN","C0SXPATH",324,0)
     5864CLEAN(STR,TR) ; extrinsic function; returns string
     5865"RTN","C0SXPATH",325,0)
     5866 ;; Removes all non printable characters from a string.
     5867"RTN","C0SXPATH",326,0)
     5868 ;; STR by Value
     5869"RTN","C0SXPATH",327,0)
     5870 ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
     5871"RTN","C0SXPATH",328,0)
     5872 N TR,I
     5873"RTN","C0SXPATH",329,0)
     5874 I '$D(TR) D  ;
     5875"RTN","C0SXPATH",330,0)
     5876 . F I=0:1:31 S TR=$G(TR)_$C(I)
     5877"RTN","C0SXPATH",331,0)
     5878 . S TR=TR_$C(127)
     5879"RTN","C0SXPATH",332,0)
     5880 QUIT $TR(STR,TR)
     5881"RTN","C0SXPATH",333,0)
     5882 ;
     5883"RTN","C0SXPATH",334,0)
     5884QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
     5885"RTN","C0SXPATH",335,0)
     5886 ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
     5887"RTN","C0SXPATH",336,0)
     5888 ; IARY AND OARY ARE PASSED BY NAME
     5889"RTN","C0SXPATH",337,0)
     5890 I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
     5891"RTN","C0SXPATH",338,0)
     5892 . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
     5893"RTN","C0SXPATH",339,0)
     5894 N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
     5895"RTN","C0SXPATH",340,0)
     5896 N TMP,I,J,QXPATH
     5897"RTN","C0SXPATH",341,0)
     5898 S FIRST=1
     5899"RTN","C0SXPATH",342,0)
     5900 I '$D(@IARY@(0)) D  ; LINE COUNT NOT IN ZERO NODE
     5901"RTN","C0SXPATH",343,0)
     5902 . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK
     5903"RTN","C0SXPATH",344,0)
     5904 S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
     5905"RTN","C0SXPATH",345,0)
     5906 I XPATH'="//" D  ; NOT A ROOT QUERY
     5907"RTN","C0SXPATH",346,0)
     5908 . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
     5909"RTN","C0SXPATH",347,0)
     5910 . S FIRST=$P(TMP,"^",1)
     5911"RTN","C0SXPATH",348,0)
     5912 . S LAST=$P(TMP,"^",2)
     5913"RTN","C0SXPATH",349,0)
     5914 K @OARY
     5915"RTN","C0SXPATH",350,0)
     5916 S @OARY@(0)=+LAST-FIRST+1
     5917"RTN","C0SXPATH",351,0)
     5918 S J=1
     5919"RTN","C0SXPATH",352,0)
     5920 FOR I=FIRST:1:LAST  D
     5921"RTN","C0SXPATH",353,0)
     5922 . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
     5923"RTN","C0SXPATH",354,0)
     5924 . S J=J+1
     5925"RTN","C0SXPATH",355,0)
     5926 ; ZWR OARY
     5927"RTN","C0SXPATH",356,0)
     5928 Q
     5929"RTN","C0SXPATH",357,0)
     5930 ;
     5931"RTN","C0SXPATH",358,0)
     5932XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
     5933"RTN","C0SXPATH",359,0)
     5934 ; INDEX WITH TWO PIECES START^FINISH
     5935"RTN","C0SXPATH",360,0)
     5936 ; IDX IS PASSED BY NAME
     5937"RTN","C0SXPATH",361,0)
     5938 Q $P(@IDX@(XPATH),"^",1)
     5939"RTN","C0SXPATH",362,0)
     5940 ;
     5941"RTN","C0SXPATH",363,0)
     5942XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
     5943"RTN","C0SXPATH",364,0)
     5944 ; INDEX WITH TWO PIECES START^FINISH
     5945"RTN","C0SXPATH",365,0)
     5946 ; IDX IS PASSED BY NAME
     5947"RTN","C0SXPATH",366,0)
     5948 Q $P(@IDX@(XPATH),"^",2)
     5949"RTN","C0SXPATH",367,0)
     5950 ;
     5951"RTN","C0SXPATH",368,0)
     5952START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
     5953"RTN","C0SXPATH",369,0)
     5954 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
     5955"RTN","C0SXPATH",370,0)
     5956 ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
     5957"RTN","C0SXPATH",371,0)
     5958 Q $P(ISTR,";",2)
     5959"RTN","C0SXPATH",372,0)
     5960 ;
     5961"RTN","C0SXPATH",373,0)
     5962FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
     5963"RTN","C0SXPATH",374,0)
     5964 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
     5965"RTN","C0SXPATH",375,0)
     5966 Q $P(ISTR,";",3)
     5967"RTN","C0SXPATH",376,0)
     5968 ;
     5969"RTN","C0SXPATH",377,0)
     5970ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
     5971"RTN","C0SXPATH",378,0)
     5972 ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
     5973"RTN","C0SXPATH",379,0)
     5974 Q $P(ISTR,";",1)
     5975"RTN","C0SXPATH",380,0)
     5976 ;
     5977"RTN","C0SXPATH",381,0)
     5978BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
     5979"RTN","C0SXPATH",382,0)
     5980 ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
     5981"RTN","C0SXPATH",383,0)
     5982 ; DEST IS CLEARED TO START
     5983"RTN","C0SXPATH",384,0)
     5984 ; USES PUSH TO DO THE COPY
     5985"RTN","C0SXPATH",385,0)
    53665986 N I
    5367 "RTN","C0SXPATH",64,0)
    5368  ; W "STK= ",STK,!
    5369 "RTN","C0SXPATH",65,0)
    5370  I @STK@(0)>0  D  ; IF THE ARRAY IS NOT EMPTY
    5371 "RTN","C0SXPATH",66,0)
    5372  . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON
    5373 "RTN","C0SXPATH",67,0)
    5374  . I @STK@(0)>1  D  ; SUBSEQUENT ELEMENTS NEED A SEMICOLON
    5375 "RTN","C0SXPATH",68,0)
    5376  . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I)
    5377 "RTN","C0SXPATH",69,0)
    5378  I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2)
    5379 "RTN","C0SXPATH",70,0)
    5380  Q
    5381 "RTN","C0SXPATH",71,0)
    5382  ;
    5383 "RTN","C0SXPATH",72,0)
    5384 XNAME(ISTR)     ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG
    5385 "RTN","C0SXPATH",73,0)
    5386  ;  </NAME> AND <NAME ID=XNAME> WILL RETURN NAME
    5387 "RTN","C0SXPATH",74,0)
    5388  ; ISTR IS PASSED BY VALUE
    5389 "RTN","C0SXPATH",75,0)
    5390  N CUR,TMP
    5391 "RTN","C0SXPATH",76,0)
    5392  I ISTR?.E1"<".E  D  ; STRIP OFF LEFT BRACKET
    5393 "RTN","C0SXPATH",77,0)
    5394  . S TMP=$P(ISTR,"<",2)
    5395 "RTN","C0SXPATH",78,0)
    5396  I TMP?1"/".E  D  ; ALSO STRIP OFF SLASH IF PRESENT IE </NAME>
    5397 "RTN","C0SXPATH",79,0)
    5398  . S TMP=$P(TMP,"/",2)
    5399 "RTN","C0SXPATH",80,0)
    5400  S CUR=$P(TMP,">",1) ; EXTRACT THE NAME
    5401 "RTN","C0SXPATH",81,0)
    5402  ; W "CUR= ",CUR,!
    5403 "RTN","C0SXPATH",82,0)
    5404  I CUR?.1"_"1.A1" ".E  D  ; CONTAINS A BLANK IE NAME ID=TEST>
    5405 "RTN","C0SXPATH",83,0)
    5406  . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER
    5407 "RTN","C0SXPATH",84,0)
    5408  ; W "CUR2= ",CUR,!
    5409 "RTN","C0SXPATH",85,0)
    5410  Q CUR
    5411 "RTN","C0SXPATH",86,0)
    5412  ;
    5413 "RTN","C0SXPATH",87,0)
    5414 XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML
    5415 "RTN","C0SXPATH",88,0)
    5416  ; <NAME>VALUE</NAME> WILL RETURN VALUE
    5417 "RTN","C0SXPATH",89,0)
    5418  N G
    5419 "RTN","C0SXPATH",90,0)
    5420  S G=$P(ISTR,">",2) ;STRIP OFF <NAME>
    5421 "RTN","C0SXPATH",91,0)
    5422  Q $P(G,"<",1) ; STRIP OFF </NAME> LEAVING VALUE
    5423 "RTN","C0SXPATH",92,0)
    5424  ;
    5425 "RTN","C0SXPATH",93,0)
    5426 VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV
    5427 "RTN","C0SXPATH",94,0)
    5428  ; VDX: @INVDX@(XPATH)=VALUE
    5429 "RTN","C0SXPATH",95,0)
    5430  ; VDV: @OUTVDV@(X1X2X3X4)=VALUE
    5431 "RTN","C0SXPATH",96,0)
    5432  ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE
    5433 "RTN","C0SXPATH",97,0)
    5434  ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS
    5435 "RTN","C0SXPATH",98,0)
    5436  ; @VDV@("XPATH",X1X2X3X4)="XPATH"
    5437 "RTN","C0SXPATH",99,0)
    5438  N ZA,ZI,ZW
    5439 "RTN","C0SXPATH",100,0)
    5440  S ZI=""
    5441 "RTN","C0SXPATH",101,0)
    5442  F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
    5443 "RTN","C0SXPATH",102,0)
    5444  . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME
    5445 "RTN","C0SXPATH",103,0)
    5446  . W ZW,!
    5447 "RTN","C0SXPATH",104,0)
    5448  . S @OUTVDV@(ZW)=@INVDX@(ZI)
    5449 "RTN","C0SXPATH",105,0)
    5450  . S @OUTVDV@("XPATH",ZW)=ZI
    5451 "RTN","C0SXPATH",106,0)
    5452  Q
    5453 "RTN","C0SXPATH",107,0)
    5454  ;
    5455 "RTN","C0SXPATH",108,0)
    5456 VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG
    5457 "RTN","C0SXPATH",109,0)
    5458  ; VDX: @VDX@(XPATH)=VALUE
    5459 "RTN","C0SXPATH",110,0)
    5460  ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE
    5461 "RTN","C0SXPATH",111,0)
    5462  ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX
    5463 "RTN","C0SXPATH",112,0)
    5464  N ZA,ZI,ZW
    5465 "RTN","C0SXPATH",113,0)
    5466  S ZI=""
    5467 "RTN","C0SXPATH",114,0)
    5468  F  S ZI=$O(@INVDX@(ZI)) Q:ZI=""  D  ;
    5469 "RTN","C0SXPATH",115,0)
    5470  . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL //
    5471 "RTN","C0SXPATH",116,0)
    5472  . S ZW2=$P(ZW,"/",1)
    5473 "RTN","C0SXPATH",117,0)
    5474  . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK))
    5475 "RTN","C0SXPATH",118,0)
    5476  . ;ZWR ZA
    5477 "RTN","C0SXPATH",119,0)
    5478  . S ZW2=ZA(1)
    5479 "RTN","C0SXPATH",120,0)
    5480  . F ZK=2:1:ZA(0) D  ;
    5481 "RTN","C0SXPATH",121,0)
    5482  . . S ZW2=ZW2_""","""_ZA(ZK)
    5483 "RTN","C0SXPATH",122,0)
    5484  . K ZA
    5485 "RTN","C0SXPATH",123,0)
    5486  . S ZW2=""""_ZW2_""""
    5487 "RTN","C0SXPATH",124,0)
    5488  . W ZW2,!
    5489 "RTN","C0SXPATH",125,0)
    5490  . S ZN=OUTXPG_"("_ZW2_")"
    5491 "RTN","C0SXPATH",126,0)
    5492  . S @ZN=@INVDX@(ZI)
    5493 "RTN","C0SXPATH",127,0)
    5494  Q
    5495 "RTN","C0SXPATH",128,0)
    5496  ;
    5497 "RTN","C0SXPATH",129,0)
    5498 XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY
    5499 "RTN","C0SXPATH",130,0)
    5500  ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE
    5501 "RTN","C0SXPATH",131,0)
    5502  ;
    5503 "RTN","C0SXPATH",132,0)
    5504  ;N G1
    5505 "RTN","C0SXPATH",133,0)
    5506  D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED
    5507 "RTN","C0SXPATH",134,0)
    5508  D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
    5509 "RTN","C0SXPATH",135,0)
    5510  Q
    5511 "RTN","C0SXPATH",136,0)
    5512  ;
    5513 "RTN","C0SXPATH",137,0)
    5514 DO
    5515 "RTN","C0SXPATH",138,0)
    5516  D XPG2XML("^GPL2B","^GPL2A")
    5517 "RTN","C0SXPATH",139,0)
    5518  Q
    5519 "RTN","C0SXPATH",140,0)
    5520  ;
    5521 "RTN","C0SXPATH",141,0)
    5522 T1 ; TEST OUT THESE ROUTINES
    5523 "RTN","C0SXPATH",142,0)
    5524  D XML2XPG("G2","^GPL")
    5525 "RTN","C0SXPATH",143,0)
    5526  D XPG2XML("G3","G2")
    5527 "RTN","C0SXPATH",144,0)
    5528  K ^GPLOUT
    5529 "RTN","C0SXPATH",145,0)
    5530  M ^GPLOUT=G3
    5531 "RTN","C0SXPATH",146,0)
    5532  W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p")
    5533 "RTN","C0SXPATH",147,0)
    5534  Q
    5535 "RTN","C0SXPATH",148,0)
    5536  ;
    5537 "RTN","C0SXPATH",149,0)
    5538 XPG2XML(OUTXML,INXPG) ;
    5539 "RTN","C0SXPATH",150,0)
    5540  N C0CN,FWD,ZA,G,GA,ZQ
    5541 "RTN","C0SXPATH",151,0)
    5542  S ZQ=0 ; QUIT FLAG
    5543 "RTN","C0SXPATH",152,0)
    5544  F  Q:ZQ=1  D  ; LOOP THROUGH EVERYTHING
    5545 "RTN","C0SXPATH",153,0)
    5546  . I '$D(C0CN) D  ; FIRST TIME THROUGH
    5547 "RTN","C0SXPATH",154,0)
    5548  . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR
    5549 "RTN","C0SXPATH",155,0)
    5550  . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS
    5551 "RTN","C0SXPATH",156,0)
    5552  . . S G=$Q(@INXPG) ; THIS ONE
    5553 "RTN","C0SXPATH",157,0)
    5554  . . S GN=$Q(@G) ; NEXT ONE
    5555 "RTN","C0SXPATH",158,0)
    5556  . . S C0CN=1 ; SUBSCRIPT COUNT
    5557 "RTN","C0SXPATH",159,0)
    5558  . . S ZQ=0 ; QUIT FLAG
    5559 "RTN","C0SXPATH",160,0)
    5560  . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML
    5561 "RTN","C0SXPATH",161,0)
    5562  . . I $QS(G,1)="ContinuityOfCareRecord" D  ;
    5563 "RTN","C0SXPATH",162,0)
    5564  . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK
    5565 "RTN","C0SXPATH",163,0)
    5566  . I FWD D  ; GOING FORWARDS
    5567 "RTN","C0SXPATH",164,0)
    5568  . . I C0CN<$QL(G) D  ; NOT A DATA NODE
    5569 "RTN","C0SXPATH",165,0)
    5570  . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
    5571 "RTN","C0SXPATH",166,0)
    5572  . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT
    5573 "RTN","C0SXPATH",167,0)
    5574  . . . I @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord>" D  ;
    5575 "RTN","C0SXPATH",168,0)
    5576  . . . . S @OUTXML@(@OUTXML@(0))="<ContinuityOfCareRecord xmlns=""urn:astm-org:CCR"">"
    5577 "RTN","C0SXPATH",169,0)
    5578  . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE
    5579 "RTN","C0SXPATH",170,0)
    5580  . . E  D  ; AT THE DATA NODE
    5581 "RTN","C0SXPATH",171,0)
    5582  . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT
    5583 "RTN","C0SXPATH",172,0)
    5584  . . . D ZXVAL(ZA,@G) ; OUTPUT <X>VAL</X> FOR DATA NODE
    5585 "RTN","C0SXPATH",173,0)
    5586  . . . S FWD=0 ; GO BACKWARDS
    5587 "RTN","C0SXPATH",174,0)
    5588  . I 'FWD D  ;GOING BACKWARDS
    5589 "RTN","C0SXPATH",175,0)
    5590  . . S GN=$Q(@G) ;NEXT XPATH
    5591 "RTN","C0SXPATH",176,0)
    5592  . . ;W "NEXT!",GN,!
    5593 "RTN","C0SXPATH",177,0)
    5594  . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT
    5595 "RTN","C0SXPATH",178,0)
    5596  . . I GN'="" D  ;
    5597 "RTN","C0SXPATH",179,0)
    5598  . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D  ; NEED TO CLOSE OFF ELEMENT
    5599 "RTN","C0SXPATH",180,0)
    5600  . . . . D ZXC($QS(G,C0CN)) ;
    5601 "RTN","C0SXPATH",181,0)
    5602  . . . E  I GN'="" D  ; MORE ELEMENTS AT THIS LEVEL
    5603 "RTN","C0SXPATH",182,0)
    5604  . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH
    5605 "RTN","C0SXPATH",183,0)
    5606  . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT
    5607 "RTN","C0SXPATH",184,0)
    5608  . . . . S FWD=1 ; GOING FORWARD NOW
    5609 "RTN","C0SXPATH",185,0)
    5610  . I (GN="")&(C0CN=1) D  Q  ; WHEN WE ARE ALL DONE
    5611 "RTN","C0SXPATH",186,0)
    5612  . . D ZXC($QS(G,C0CN)) ; LAST ONE
    5613 "RTN","C0SXPATH",187,0)
    5614  . . S ZQ=1 ; QUIT NOW
    5615 "RTN","C0SXPATH",188,0)
    5616  Q
    5617 "RTN","C0SXPATH",189,0)
    5618  ;
    5619 "RTN","C0SXPATH",190,0)
    5620 ZXO(WHAT)
    5621 "RTN","C0SXPATH",191,0)
    5622  D PUSH("GA",WHAT)
    5623 "RTN","C0SXPATH",192,0)
    5624  D PUSH(OUTXML,"<"_WHAT_">")
    5625 "RTN","C0SXPATH",193,0)
    5626  Q
    5627 "RTN","C0SXPATH",194,0)
    5628  ;
    5629 "RTN","C0SXPATH",195,0)
    5630 ZXC(WHAT)
    5631 "RTN","C0SXPATH",196,0)
    5632  D POP("GA",.TMP)
    5633 "RTN","C0SXPATH",197,0)
    5634  D PUSH(OUTXML,"</"_WHAT_">")
    5635 "RTN","C0SXPATH",198,0)
    5636  Q
    5637 "RTN","C0SXPATH",199,0)
    5638  ;
    5639 "RTN","C0SXPATH",200,0)
    5640 ZXVAL(WHAT,VAL)
    5641 "RTN","C0SXPATH",201,0)
    5642  D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
    5643 "RTN","C0SXPATH",202,0)
    5644  Q
    5645 "RTN","C0SXPATH",203,0)
    5646  ;
    5647 "RTN","C0SXPATH",204,0)
    5648 INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce
    5649 "RTN","C0SXPATH",205,0)
    5650  ; an XPATH index; REDUX is a string to be removed from each xpath
    5651 "RTN","C0SXPATH",206,0)
    5652  ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME
    5653 "RTN","C0SXPATH",207,0)
    5654  ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE
    5655 "RTN","C0SXPATH",208,0)
    5656  ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG
    5657 "RTN","C0SXPATH",209,0)
    5658  ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME
    5659 "RTN","C0SXPATH",210,0)
    5660  ; @VDX@("XPATH")=VALUE
    5661 "RTN","C0SXPATH",211,0)
    5662  ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE
    5663 "RTN","C0SXPATH",212,0)
    5664  ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE
    5665 "RTN","C0SXPATH",213,0)
    5666  ; XML SECTION
    5667 "RTN","C0SXPATH",214,0)
    5668  ; IZXML IS PASSED BY NAME
    5669 "RTN","C0SXPATH",215,0)
    5670  ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE
    5671 "RTN","C0SXPATH",216,0)
    5672  N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT
    5673 "RTN","C0SXPATH",217,0)
    5674  N C0CSTK ; LEAVE OUT FOR DEBUGGING
    5675 "RTN","C0SXPATH",218,0)
    5676  I '$D(REDUX) S REDUX=""
    5677 "RTN","C0SXPATH",219,0)
    5678  I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX
    5679 "RTN","C0SXPATH",220,0)
    5680  N ZXML
    5681 "RTN","C0SXPATH",221,0)
    5682  I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD
    5683 "RTN","C0SXPATH",222,0)
    5684  E  S ZXML=IZXML ; PLACE FOR INDEX TO KEEP
    5685 "RTN","C0SXPATH",223,0)
    5686  I '$D(@IZXML@(0)) D  ; IF COUNT NOT IN NODE 0 COUNT THEM
    5687 "RTN","C0SXPATH",224,0)
    5688  . S I="",LCNT=0
    5689 "RTN","C0SXPATH",225,0)
    5690  . F  S I=$O(@IZXML@(I)) Q:I=""  S LCNT=LCNT+1
    5691 "RTN","C0SXPATH",226,0)
    5692  E  S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY
    5693 "RTN","C0SXPATH",227,0)
    5694  I LCNT=0  D  Q  ; NO XML PASSED
    5695 "RTN","C0SXPATH",228,0)
    5696  . W "ERROR IN XML FILE",!
    5697 "RTN","C0SXPATH",229,0)
    5698  S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX
    5699 "RTN","C0SXPATH",230,0)
    5700  I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX
    5701 "RTN","C0SXPATH",231,0)
    5702  S C0CSTK(0)=0 ; INITIALIZE STACK
    5703 "RTN","C0SXPATH",232,0)
    5704  K LKASD ; KILL LOOKASIDE ARRAY
    5705 "RTN","C0SXPATH",233,0)
    5706  D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES
    5707 "RTN","C0SXPATH",234,0)
    5708  F I=1:1:LCNT  D  ; PROCESS THE ENTIRE ARRAY
    5709 "RTN","C0SXPATH",235,0)
    5710  . S LINE=@IZXML@(I)
    5711 "RTN","C0SXPATH",236,0)
    5712  . I $D(TEMPLATE) D  ;IF TEMPLATE IS REQUESTED
    5713 "RTN","C0SXPATH",237,0)
    5714  . . S @TEMPLATE@(I)=$$CLEAN(LINE)
    5715 "RTN","C0SXPATH",238,0)
    5716  . ;W LINE,!
    5717 "RTN","C0SXPATH",239,0)
    5718  . S FOUND=0  ; INTIALIZED FOUND FLAG
    5719 "RTN","C0SXPATH",240,0)
    5720  . I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
    5721 "RTN","C0SXPATH",241,0)
    5722  . I FOUND'=1  D
    5723 "RTN","C0SXPATH",242,0)
    5724  . . I (LINE?.E1"<"1.E1"</".E)!(LINE?.E1"<"1.E1"/>".E)  D
    5725 "RTN","C0SXPATH",243,0)
    5726  . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS
    5727 "RTN","C0SXPATH",244,0)
    5728  . . . ; ON THE SAME LINE
    5729 "RTN","C0SXPATH",245,0)
    5730  . . . ; W "FOUND ",LINE,!
    5731 "RTN","C0SXPATH",246,0)
    5732  . . . S FOUND=1  ; SET FOUND FLAG
    5733 "RTN","C0SXPATH",247,0)
    5734  . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
    5735 "RTN","C0SXPATH",248,0)
    5736  . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
    5737 "RTN","C0SXPATH",249,0)
    5738  . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
    5739 "RTN","C0SXPATH",250,0)
    5740  . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX
    5741 "RTN","C0SXPATH",251,0)
    5742  . . . ; W "MDX=",MDX,!
    5743 "RTN","C0SXPATH",252,0)
    5744  . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
    5745 "RTN","C0SXPATH",253,0)
    5746  . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2
    5747 "RTN","C0SXPATH",254,0)
    5748  . . . . ;E  S ZDUP(MDX)=ZDUP(MDX)+1
    5749 "RTN","C0SXPATH",255,0)
    5750  . . . . ;W "DUP:",MDX,!
    5751 "RTN","C0SXPATH",256,0)
    5752  . . . . ;I '$D(CURVAL) S CURVAL=""
    5753 "RTN","C0SXPATH",257,0)
    5754  . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL
    5755 "RTN","C0SXPATH",258,0)
    5756  . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
    5757 "RTN","C0SXPATH",259,0)
    5758  . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
    5759 "RTN","C0SXPATH",260,0)
    5760  . . . . S @ZXML@(MDX)=I_"^"_I  ; ADD INDEX ENTRY-FIRST AND LAST
    5761 "RTN","C0SXPATH",261,0)
    5762  . . . . S CURVAL=$$XVAL(LINE) ; VALUE
    5763 "RTN","C0SXPATH",262,0)
    5764  . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE
    5765 "RTN","C0SXPATH",263,0)
    5766  . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED
    5767 "RTN","C0SXPATH",264,0)
    5768  . . . . I $D(TEMPLATE) D  ; IF TEMPLATE IS REQUESTED
    5769 "RTN","C0SXPATH",265,0)
    5770  . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS
    5771 "RTN","C0SXPATH",266,0)
    5772  . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@</"_$P(LINE,"</",2)
    5773 "RTN","C0SXPATH",267,0)
    5774  . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
    5775 "RTN","C0SXPATH",268,0)
    5776  . I FOUND'=1  D  ; THE LINE DOESN'T CONTAIN THE START AND END
    5777 "RTN","C0SXPATH",269,0)
    5778  . . I LINE?.E1"</"1.E  D  ; LINE CONTAINS END OF A SECTION
    5779 "RTN","C0SXPATH",270,0)
    5780  . . . ; W "FOUND ",LINE,!
    5781 "RTN","C0SXPATH",271,0)
    5782  . . . S FOUND=1  ; SET FOUND FLAG
    5783 "RTN","C0SXPATH",272,0)
    5784  . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
    5785 "RTN","C0SXPATH",273,0)
    5786  . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
    5787 "RTN","C0SXPATH",274,0)
    5788  . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
    5789 "RTN","C0SXPATH",275,0)
    5790  . . . D POP("C0CSTK",.TMP) ; REMOVE FROM STACK
    5791 "RTN","C0SXPATH",276,0)
    5792  . . . S TMP=$P(TMP,"[",1) ; REMOVE [X] FROM MULTIPLE
    5793 "RTN","C0SXPATH",277,0)
    5794  . . . I TMP'=CUR  D  ; MALFORMED XML, END MUST MATCH START
    5795 "RTN","C0SXPATH",278,0)
    5796  . . . . W "MALFORMED XML ",CUR,"LINE "_I_LINE,!
    5797 "RTN","C0SXPATH",279,0)
    5798  . . . . D PARY("C0CSTK") ; PRINT OUT THE STACK FOR DEBUGING
    5799 "RTN","C0SXPATH",280,0)
    5800  . . . . Q
    5801 "RTN","C0SXPATH",281,0)
    5802  . I FOUND'=1  D  ; THE LINE MIGHT CONTAIN A SECTION BEGINNING
    5803 "RTN","C0SXPATH",282,0)
    5804  . . I (LINE?.E1"<"1.E)&(LINE'["?>")  D  ; BEGINNING OF A SECTION
    5805 "RTN","C0SXPATH",283,0)
    5806  . . . ; W "FOUND ",LINE,!
    5807 "RTN","C0SXPATH",284,0)
    5808  . . . S FOUND=1  ; SET FOUND FLAG
    5809 "RTN","C0SXPATH",285,0)
    5810  . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME
    5811 "RTN","C0SXPATH",286,0)
    5812  . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES
    5813 "RTN","C0SXPATH",287,0)
    5814  . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK
    5815 "RTN","C0SXPATH",288,0)
    5816  . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX
    5817 "RTN","C0SXPATH",289,0)
    5818  . . . ; W "MDX=",MDX,!
    5819 "RTN","C0SXPATH",290,0)
    5820  . . . I $D(@ZXML@(MDX))  D  ; IN THE INDEX, IS A MULTIPLE
    5821 "RTN","C0SXPATH",291,0)
    5822  . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER
    5823 "RTN","C0SXPATH",292,0)
    5824  . . . . ;B
    5825 "RTN","C0SXPATH",293,0)
    5826  . . . I '$D(@ZXML@(MDX))  D  ; NOT IN THE INDEX, NOT A MULTIPLE
    5827 "RTN","C0SXPATH",294,0)
    5828  . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX
    5829 "RTN","C0SXPATH",295,0)
    5830  S @ZXML@("INDEXED")=""
    5831 "RTN","C0SXPATH",296,0)
    5832  S @ZXML@("//")="1^"_LCNT ; ROOT XPATH
    5833 "RTN","C0SXPATH",297,0)
    5834  I NOINX K @ZXML ; DELETE UNWANTED INDEX
    5835 "RTN","C0SXPATH",298,0)
    5836  Q
    5837 "RTN","C0SXPATH",299,0)
    5838  ;
    5839 "RTN","C0SXPATH",300,0)
    5840 MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES
    5841 "RTN","C0SXPATH",301,0)
    5842  ;
    5843 "RTN","C0SXPATH",302,0)
    5844  N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2
    5845 "RTN","C0SXPATH",303,0)
    5846  F ZI=1:1:LCNT-1  D  ; PROCESS THE ENTIRE ARRAY
    5847 "RTN","C0SXPATH",304,0)
    5848  . S ZLINE=@IZXML@(ZI)
    5849 "RTN","C0SXPATH",305,0)
    5850  . I ZI<LCNT S ZLINE2=@IZXML@(ZI+1)
    5851 "RTN","C0SXPATH",306,0)
    5852  . I ZLINE?.E1"</"1.E  D  ; NEXT LINE CONTAINS END OF A SECTION
    5853 "RTN","C0SXPATH",307,0)
    5854  . . S CUR=$$XNAME(ZLINE) ; EXTRACT THE NAME
    5855 "RTN","C0SXPATH",308,0)
    5856  . . I (ZLINE2?.E1"<"1.E)&(ZLINE'["?>")  D  ; BEGINNING OF A SECTION
    5857 "RTN","C0SXPATH",309,0)
    5858  . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME
    5859 "RTN","C0SXPATH",310,0)
    5860  . . . I CUR=CUR2 D  ; IF THIS IS A MULTIPLE
    5861 "RTN","C0SXPATH",311,0)
    5862  . . . . S OUTBUF(CUR,ZI+1)=""
    5863 "RTN","C0SXPATH",312,0)
    5864  ;ZWR OUTBUF
    5865 "RTN","C0SXPATH",313,0)
    5866  S ZI=""
    5867 "RTN","C0SXPATH",314,0)
    5868  F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; FOR EACH KIND OF MULTIPLE
    5869 "RTN","C0SXPATH",315,0)
    5870  . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE
    5871 "RTN","C0SXPATH",316,0)
    5872  . F  S ZN=$O(@IZXML@(ZN),-1) Q:ZN=""  I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q  ;
    5873 "RTN","C0SXPATH",317,0)
    5874  . S OUTBUF(ZI,ZN)=""
    5875 "RTN","C0SXPATH",318,0)
    5876  S ZA=1,ZI="",ZN=""
    5877 "RTN","C0SXPATH",319,0)
    5878  F  S ZI=$O(OUTBUF(ZI)) Q:ZI=""  D  ; ADDING THE COUNT FOR THE MULIPLES [x]
    5879 "RTN","C0SXPATH",320,0)
    5880  . S ZN="",ZA=1
    5881 "RTN","C0SXPATH",321,0)
    5882  . F  S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN=""  D  ;
    5883 "RTN","C0SXPATH",322,0)
    5884  . . S OUTBUF(ZI,ZN)="["_ZA_"]"
    5885 "RTN","C0SXPATH",323,0)
    5886  . . S ZA=ZA+1
    5887 "RTN","C0SXPATH",324,0)
    5888  Q
    5889 "RTN","C0SXPATH",325,0)
    5890  ;
    5891 "RTN","C0SXPATH",326,0)
    5892 CLEAN(STR,TR) ; extrinsic function; returns string
    5893 "RTN","C0SXPATH",327,0)
    5894  ;; Removes all non printable characters from a string.
    5895 "RTN","C0SXPATH",328,0)
    5896  ;; STR by Value
    5897 "RTN","C0SXPATH",329,0)
    5898  ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE
    5899 "RTN","C0SXPATH",330,0)
    5900  N TR,I
    5901 "RTN","C0SXPATH",331,0)
    5902  I '$D(TR) D  ;
    5903 "RTN","C0SXPATH",332,0)
    5904  . F I=0:1:31 S TR=$G(TR)_$C(I)
    5905 "RTN","C0SXPATH",333,0)
    5906  . S TR=TR_$C(127)
    5907 "RTN","C0SXPATH",334,0)
    5908  QUIT $TR(STR,TR)
    5909 "RTN","C0SXPATH",335,0)
    5910  ;
    5911 "RTN","C0SXPATH",336,0)
    5912 QUERY(IARY,XPATH,OARY)  ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION
    5913 "RTN","C0SXPATH",337,0)
    5914  ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD"
    5915 "RTN","C0SXPATH",338,0)
    5916  ; IARY AND OARY ARE PASSED BY NAME
    5917 "RTN","C0SXPATH",339,0)
    5918  I '$D(@IARY@("INDEXED"))  D  ; INDEX IS NOT PRESENT IN IARY
    5919 "RTN","C0SXPATH",340,0)
    5920  . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML
    5921 "RTN","C0SXPATH",341,0)
    5922  N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN
    5923 "RTN","C0SXPATH",342,0)
    5924  N TMP,I,J,QXPATH
    5925 "RTN","C0SXPATH",343,0)
    5926  S FIRST=1
    5927 "RTN","C0SXPATH",344,0)
    5928  I '$D(@IARY@(0)) D  ; LINE COUNT NOT IN ZERO NODE
    5929 "RTN","C0SXPATH",345,0)
    5930  . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK
    5931 "RTN","C0SXPATH",346,0)
    5932  S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT
    5933 "RTN","C0SXPATH",347,0)
    5934  I XPATH'="//" D  ; NOT A ROOT QUERY
    5935 "RTN","C0SXPATH",348,0)
    5936  . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES
    5937 "RTN","C0SXPATH",349,0)
    5938  . S FIRST=$P(TMP,"^",1)
    5939 "RTN","C0SXPATH",350,0)
    5940  . S LAST=$P(TMP,"^",2)
    5941 "RTN","C0SXPATH",351,0)
    5942  K @OARY
    5943 "RTN","C0SXPATH",352,0)
    5944  S @OARY@(0)=+LAST-FIRST+1
    5945 "RTN","C0SXPATH",353,0)
    5946  S J=1
    5947 "RTN","C0SXPATH",354,0)
    5948  FOR I=FIRST:1:LAST  D
    5949 "RTN","C0SXPATH",355,0)
    5950  . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY
    5951 "RTN","C0SXPATH",356,0)
    5952  . S J=J+1
    5953 "RTN","C0SXPATH",357,0)
    5954  ; ZWR OARY
    5955 "RTN","C0SXPATH",358,0)
    5956  Q
    5957 "RTN","C0SXPATH",359,0)
    5958  ;
    5959 "RTN","C0SXPATH",360,0)
    5960 XF(IDX,XPATH)   ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH
    5961 "RTN","C0SXPATH",361,0)
    5962  ; INDEX WITH TWO PIECES START^FINISH
    5963 "RTN","C0SXPATH",362,0)
    5964  ; IDX IS PASSED BY NAME
    5965 "RTN","C0SXPATH",363,0)
    5966  Q $P(@IDX@(XPATH),"^",1)
    5967 "RTN","C0SXPATH",364,0)
    5968  ;
    5969 "RTN","C0SXPATH",365,0)
    5970 XL(IDX,XPATH)   ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH
    5971 "RTN","C0SXPATH",366,0)
    5972  ; INDEX WITH TWO PIECES START^FINISH
    5973 "RTN","C0SXPATH",367,0)
    5974  ; IDX IS PASSED BY NAME
    5975 "RTN","C0SXPATH",368,0)
    5976  Q $P(@IDX@(XPATH),"^",2)
    5977 "RTN","C0SXPATH",369,0)
    5978  ;
    5979 "RTN","C0SXPATH",370,0)
    5980 START(ISTR)     ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX
    5981 "RTN","C0SXPATH",371,0)
    5982  ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
    5983 "RTN","C0SXPATH",372,0)
    5984  ; COMPANION TO FINISH ; IDX IS PASSED BY NAME
    5985 "RTN","C0SXPATH",373,0)
    5986  Q $P(ISTR,";",2)
    5987 "RTN","C0SXPATH",374,0)
    5988  ;
    5989 "RTN","C0SXPATH",375,0)
    5990 FINISH(ISTR)    ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX
    5991 "RTN","C0SXPATH",376,0)
    5992  ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
    5993 "RTN","C0SXPATH",377,0)
    5994  Q $P(ISTR,";",3)
    5995 "RTN","C0SXPATH",378,0)
    5996  ;
    5997 "RTN","C0SXPATH",379,0)
    5998 ARRAY(ISTR)     ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX
    5999 "RTN","C0SXPATH",380,0)
    6000  ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH
    6001 "RTN","C0SXPATH",381,0)
    6002  Q $P(ISTR,";",1)
    6003 "RTN","C0SXPATH",382,0)
    6004  ;
    6005 "RTN","C0SXPATH",383,0)
    6006 BUILD(BLIST,BDEST)      ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST
    6007 "RTN","C0SXPATH",384,0)
    6008  ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST
    6009 "RTN","C0SXPATH",385,0)
    6010  ; DEST IS CLEARED TO START
    60115987"RTN","C0SXPATH",386,0)
    6012  ; USES PUSH TO DO THE COPY
     5988 K @BDEST
    60135989"RTN","C0SXPATH",387,0)
     5990 F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
     5991"RTN","C0SXPATH",388,0)
     5992 . N J,ATMP
     5993"RTN","C0SXPATH",389,0)
     5994 . S ATMP=$$ARRAY(@BLIST@(I))
     5995"RTN","C0SXPATH",390,0)
     5996 . I $G(DEBUG) W "ATMP=",ATMP,!
     5997"RTN","C0SXPATH",391,0)
     5998 . I $G(DEBUG) W @BLIST@(I),!
     5999"RTN","C0SXPATH",392,0)
     6000 . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
     6001"RTN","C0SXPATH",393,0)
     6002 . . ; FOR EACH LINE IN THIS INSTR
     6003"RTN","C0SXPATH",394,0)
     6004 . . I $G(DEBUG) W "BDEST= ",BDEST,!
     6005"RTN","C0SXPATH",395,0)
     6006 . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
     6007"RTN","C0SXPATH",396,0)
     6008 . . D PUSH(BDEST,@ATMP@(J))
     6009"RTN","C0SXPATH",397,0)
     6010 Q
     6011"RTN","C0SXPATH",398,0)
     6012 ;
     6013"RTN","C0SXPATH",399,0)
     6014QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
     6015"RTN","C0SXPATH",400,0)
     6016 ;
     6017"RTN","C0SXPATH",401,0)
     6018 I $G(DEBUG) W "QUEUEING ",BLST,!
     6019"RTN","C0SXPATH",402,0)
     6020 D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
     6021"RTN","C0SXPATH",403,0)
     6022 Q
     6023"RTN","C0SXPATH",404,0)
     6024 ;
     6025"RTN","C0SXPATH",405,0)
     6026CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
     6027"RTN","C0SXPATH",406,0)
     6028 ; KILLS CPDEST FIRST
     6029"RTN","C0SXPATH",407,0)
     6030 N CPINSTR
     6031"RTN","C0SXPATH",408,0)
     6032 I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
     6033"RTN","C0SXPATH",409,0)
     6034 I @CPSRC@(0)<1 D  ; BAD LENGTH
     6035"RTN","C0SXPATH",410,0)
     6036 . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
     6037"RTN","C0SXPATH",411,0)
     6038 . Q
     6039"RTN","C0SXPATH",412,0)
     6040 ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
     6041"RTN","C0SXPATH",413,0)
     6042 D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
     6043"RTN","C0SXPATH",414,0)
     6044 D BUILD("CPINSTR",CPDEST)
     6045"RTN","C0SXPATH",415,0)
     6046 Q
     6047"RTN","C0SXPATH",416,0)
     6048 ;
     6049"RTN","C0SXPATH",417,0)
     6050QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
     6051"RTN","C0SXPATH",418,0)
     6052 ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
     6053"RTN","C0SXPATH",419,0)
     6054 ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
     6055"RTN","C0SXPATH",420,0)
     6056 ; USED TO INSERT CHILDREN NODES
     6057"RTN","C0SXPATH",421,0)
     6058 I @QOXML@(0)<1 D  ; MALFORMED XML
     6059"RTN","C0SXPATH",422,0)
     6060 . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
     6061"RTN","C0SXPATH",423,0)
     6062 . Q
     6063"RTN","C0SXPATH",424,0)
     6064 I $G(DEBUG) W "DOING QOPEN",!
     6065"RTN","C0SXPATH",425,0)
     6066 N S1,E1,QOT,QOTMP
     6067"RTN","C0SXPATH",426,0)
     6068 S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
     6069"RTN","C0SXPATH",427,0)
     6070 I $D(QOXPATH) D  ; XPATH PROVIDED
     6071"RTN","C0SXPATH",428,0)
     6072 . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
     6073"RTN","C0SXPATH",429,0)
     6074 . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
     6075"RTN","C0SXPATH",430,0)
     6076 I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
     6077"RTN","C0SXPATH",431,0)
     6078 . S E1=@QOXML@(0)-1
     6079"RTN","C0SXPATH",432,0)
     6080 D QUEUE(QOBLIST,QOXML,S1,E1)
     6081"RTN","C0SXPATH",433,0)
     6082 ; S QOTMP=QOXML_"^"_S1_"^"_E1
     6083"RTN","C0SXPATH",434,0)
     6084 ; D PUSH(QOBLIST,QOTMP)
     6085"RTN","C0SXPATH",435,0)
     6086 Q
     6087"RTN","C0SXPATH",436,0)
     6088 ;
     6089"RTN","C0SXPATH",437,0)
     6090QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
     6091"RTN","C0SXPATH",438,0)
     6092 ; ADDS THE LIST LINE OF QCXML TO QCBLIST
     6093"RTN","C0SXPATH",439,0)
     6094 ; USED TO FINISH INSERTING CHILDERN NODES
     6095"RTN","C0SXPATH",440,0)
     6096 ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
     6097"RTN","C0SXPATH",441,0)
     6098 ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
     6099"RTN","C0SXPATH",442,0)
     6100 I @QCXML@(0)<1 D  ; MALFORMED XML
     6101"RTN","C0SXPATH",443,0)
     6102 . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
     6103"RTN","C0SXPATH",444,0)
     6104 I $G(DEBUG) W "GOING TO CLOSE",!
     6105"RTN","C0SXPATH",445,0)
     6106 N S1,E1,QCT,QCTMP
     6107"RTN","C0SXPATH",446,0)
     6108 S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
     6109"RTN","C0SXPATH",447,0)
     6110 I $D(QCXPATH) D  ; XPATH PROVIDED
     6111"RTN","C0SXPATH",448,0)
     6112 . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
     6113"RTN","C0SXPATH",449,0)
     6114 . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
     6115"RTN","C0SXPATH",450,0)
     6116 I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
     6117"RTN","C0SXPATH",451,0)
     6118 . S S1=@QCXML@(0)
     6119"RTN","C0SXPATH",452,0)
     6120 D QUEUE(QCBLIST,QCXML,S1,E1)
     6121"RTN","C0SXPATH",453,0)
     6122 ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
     6123"RTN","C0SXPATH",454,0)
     6124 Q
     6125"RTN","C0SXPATH",455,0)
     6126 ;
     6127"RTN","C0SXPATH",456,0)
     6128INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
     6129"RTN","C0SXPATH",457,0)
     6130 ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
     6131"RTN","C0SXPATH",458,0)
     6132 ; OMITTED, INSERTION WILL BE AT THE ROOT
     6133"RTN","C0SXPATH",459,0)
     6134 ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
     6135"RTN","C0SXPATH",460,0)
     6136 ; XML AT THE END OF THE XPATH POINT
     6137"RTN","C0SXPATH",461,0)
     6138 ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
     6139"RTN","C0SXPATH",462,0)
     6140 N INSBLD,INSTMP
     6141"RTN","C0SXPATH",463,0)
     6142 I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
     6143"RTN","C0SXPATH",464,0)
     6144 I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
     6145"RTN","C0SXPATH",465,0)
     6146 I '$D(@INSXML@(1)) D  ; INSERT INTO AN EMPTY ARRAY
     6147"RTN","C0SXPATH",466,0)
     6148 . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
     6149"RTN","C0SXPATH",467,0)
     6150 I $D(@INSXML@(1)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
     6151"RTN","C0SXPATH",468,0)
     6152 . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH
     6153"RTN","C0SXPATH",469,0)
     6154 . I $D(INSXPATH) D  ; XPATH PROVIDED
     6155"RTN","C0SXPATH",470,0)
     6156 . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
     6157"RTN","C0SXPATH",471,0)
     6158 . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
     6159"RTN","C0SXPATH",472,0)
     6160 . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
     6161"RTN","C0SXPATH",473,0)
     6162 . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
     6163"RTN","C0SXPATH",474,0)
     6164 . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML
     6165"RTN","C0SXPATH",475,0)
     6166 . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
     6167"RTN","C0SXPATH",476,0)
     6168 . I $D(INSXPATH) D  ; XPATH PROVIDED
     6169"RTN","C0SXPATH",477,0)
     6170 . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
     6171"RTN","C0SXPATH",478,0)
     6172 . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
     6173"RTN","C0SXPATH",479,0)
     6174 . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
     6175"RTN","C0SXPATH",480,0)
     6176 . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
     6177"RTN","C0SXPATH",481,0)
     6178 . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
     6179"RTN","C0SXPATH",482,0)
     6180 Q
     6181"RTN","C0SXPATH",483,0)
     6182 ;
     6183"RTN","C0SXPATH",484,0)
     6184INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
     6185"RTN","C0SXPATH",485,0)
     6186 ; INTO INNXML AT THE INNXPATH XPATH POINT
     6187"RTN","C0SXPATH",486,0)
     6188 ;
     6189"RTN","C0SXPATH",487,0)
     6190 N INNBLD,UXPATH
     6191"RTN","C0SXPATH",488,0)
     6192 N INNTBUF
     6193"RTN","C0SXPATH",489,0)
     6194 S INNTBUF=$NA(^TMP($J,"INNTBUF"))
     6195"RTN","C0SXPATH",490,0)
     6196 I '$D(INNXPATH) D  ; XPATH NOT PASSED
     6197"RTN","C0SXPATH",491,0)
     6198 . S UXPATH="//" ; USE ROOT XPATH
     6199"RTN","C0SXPATH",492,0)
     6200 I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
     6201"RTN","C0SXPATH",493,0)
     6202 I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
     6203"RTN","C0SXPATH",494,0)
     6204 . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
     6205"RTN","C0SXPATH",495,0)
     6206 . D BUILD("INNBLD",INNXML)
     6207"RTN","C0SXPATH",496,0)
     6208 I @INNXML@(0)>0  D  ; NOT EMPTY
     6209"RTN","C0SXPATH",497,0)
     6210 . D QOPEN("INNBLD",INNXML,UXPATH) ;
     6211"RTN","C0SXPATH",498,0)
     6212 . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
     6213"RTN","C0SXPATH",499,0)
     6214 . D QCLOSE("INNBLD",INNXML,UXPATH)
     6215"RTN","C0SXPATH",500,0)
     6216 . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
     6217"RTN","C0SXPATH",501,0)
     6218 . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
     6219"RTN","C0SXPATH",502,0)
     6220 Q
     6221"RTN","C0SXPATH",503,0)
     6222 ;
     6223"RTN","C0SXPATH",504,0)
     6224INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
     6225"RTN","C0SXPATH",505,0)
     6226 ; BUT XDEST AN XNEW ARE PASSED BY NAME
     6227"RTN","C0SXPATH",506,0)
     6228 N XBLD,XTMP
     6229"RTN","C0SXPATH",507,0)
     6230 D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
     6231"RTN","C0SXPATH",508,0)
     6232 D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
     6233"RTN","C0SXPATH",509,0)
     6234 D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
     6235"RTN","C0SXPATH",510,0)
     6236 D BUILD("XBLD","XTMP") ; BUILD THE RESULT
     6237"RTN","C0SXPATH",511,0)
     6238 D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
     6239"RTN","C0SXPATH",512,0)
     6240 I $G(DEBUG) D PARY("XDEST")
     6241"RTN","C0SXPATH",513,0)
     6242 Q
     6243"RTN","C0SXPATH",514,0)
     6244 ;
     6245"RTN","C0SXPATH",515,0)
     6246REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
     6247"RTN","C0SXPATH",516,0)
     6248 ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
     6249"RTN","C0SXPATH",517,0)
     6250 ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
     6251"RTN","C0SXPATH",518,0)
     6252 ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
     6253"RTN","C0SXPATH",519,0)
     6254 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
     6255"RTN","C0SXPATH",520,0)
     6256 S OLD=$NA(^TMP($J,"REPLACE_OLD"))
     6257"RTN","C0SXPATH",521,0)
     6258 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
     6259"RTN","C0SXPATH",522,0)
     6260 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
     6261"RTN","C0SXPATH",523,0)
     6262 S XFIRST=$P(XNODE,"^",1)
     6263"RTN","C0SXPATH",524,0)
     6264 S XLAST=$P(XNODE,"^",2)
     6265"RTN","C0SXPATH",525,0)
     6266 I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
     6267"RTN","C0SXPATH",526,0)
     6268 . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
     6269"RTN","C0SXPATH",527,0)
     6270 . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
     6271"RTN","C0SXPATH",528,0)
     6272 I RENEW'="" D  ; NEW XML IS NOT NULL
     6273"RTN","C0SXPATH",529,0)
     6274 . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
     6275"RTN","C0SXPATH",530,0)
     6276 . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
     6277"RTN","C0SXPATH",531,0)
     6278 . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
     6279"RTN","C0SXPATH",532,0)
     6280 I $G(DEBUG) W "REPLACE PREBUILD",!
     6281"RTN","C0SXPATH",533,0)
     6282 I $G(DEBUG) D PARY("REBLD")
     6283"RTN","C0SXPATH",534,0)
     6284 D BUILD("REBLD","RTMP")
     6285"RTN","C0SXPATH",535,0)
     6286 K @REXML ; KILL WHAT WAS THERE
     6287"RTN","C0SXPATH",536,0)
     6288 D CP("RTMP",REXML) ; COPY IN THE RESULT
     6289"RTN","C0SXPATH",537,0)
     6290 Q
     6291"RTN","C0SXPATH",538,0)
     6292 ;
     6293"RTN","C0SXPATH",539,0)
     6294DELETE(REXML,REXPATH)    ; DELETE THE XML AT THE XPATH POINT
     6295"RTN","C0SXPATH",540,0)
     6296 ; REXML IS PASSED BY NAME XPATH IS A VALUE
     6297"RTN","C0SXPATH",541,0)
     6298 N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
     6299"RTN","C0SXPATH",542,0)
     6300 S OLD=$NA(^TMP($J,"REPLACE_OLD"))
     6301"RTN","C0SXPATH",543,0)
     6302 D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
     6303"RTN","C0SXPATH",544,0)
     6304 S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
     6305"RTN","C0SXPATH",545,0)
     6306 S XFIRST=$P(XNODE,"^",1)
     6307"RTN","C0SXPATH",546,0)
     6308 S XLAST=$P(XNODE,"^",2)
     6309"RTN","C0SXPATH",547,0)
     6310 D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
     6311"RTN","C0SXPATH",548,0)
     6312 D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
     6313"RTN","C0SXPATH",549,0)
     6314 I $G(DEBUG) D PARY("REBLD")
     6315"RTN","C0SXPATH",550,0)
     6316 D BUILD("REBLD","RTMP")
     6317"RTN","C0SXPATH",551,0)
     6318 K @REXML ; KILL WHAT WAS THERE
     6319"RTN","C0SXPATH",552,0)
     6320 D CP("RTMP",REXML) ; COPY IN THE RESULT
     6321"RTN","C0SXPATH",553,0)
     6322 Q
     6323"RTN","C0SXPATH",554,0)
     6324 ;
     6325"RTN","C0SXPATH",555,0)
     6326MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
     6327"RTN","C0SXPATH",556,0)
     6328 ; W "Reporting on the missing",!
     6329"RTN","C0SXPATH",557,0)
     6330 ; W OARY
     6331"RTN","C0SXPATH",558,0)
     6332 I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
     6333"RTN","C0SXPATH",559,0)
    60146334 N I
    6015 "RTN","C0SXPATH",388,0)
    6016  K @BDEST
    6017 "RTN","C0SXPATH",389,0)
    6018  F I=1:1:@BLIST@(0) D  ; FOR EACH INSTRUCTION IN BLIST
    6019 "RTN","C0SXPATH",390,0)
    6020  . N J,ATMP
    6021 "RTN","C0SXPATH",391,0)
    6022  . S ATMP=$$ARRAY(@BLIST@(I))
    6023 "RTN","C0SXPATH",392,0)
    6024  . I $G(DEBUG) W "ATMP=",ATMP,!
    6025 "RTN","C0SXPATH",393,0)
    6026  . I $G(DEBUG) W @BLIST@(I),!
    6027 "RTN","C0SXPATH",394,0)
    6028  . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D  ;
    6029 "RTN","C0SXPATH",395,0)
    6030  . . ; FOR EACH LINE IN THIS INSTR
    6031 "RTN","C0SXPATH",396,0)
    6032  . . I $G(DEBUG) W "BDEST= ",BDEST,!
    6033 "RTN","C0SXPATH",397,0)
    6034  . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),!
    6035 "RTN","C0SXPATH",398,0)
    6036  . . D PUSH(BDEST,@ATMP@(J))
    6037 "RTN","C0SXPATH",399,0)
    6038  Q
    6039 "RTN","C0SXPATH",400,0)
    6040  ;
    6041 "RTN","C0SXPATH",401,0)
    6042 QUEUE(BLST,ARRAY,FIRST,LAST)    ; ADD AN ENTRY TO A BLIST
    6043 "RTN","C0SXPATH",402,0)
    6044  ;
    6045 "RTN","C0SXPATH",403,0)
    6046  I $G(DEBUG) W "QUEUEING ",BLST,!
    6047 "RTN","C0SXPATH",404,0)
    6048  D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST)
    6049 "RTN","C0SXPATH",405,0)
    6050  Q
    6051 "RTN","C0SXPATH",406,0)
    6052  ;
    6053 "RTN","C0SXPATH",407,0)
    6054 CP(CPSRC,CPDEST)        ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME
    6055 "RTN","C0SXPATH",408,0)
    6056  ; KILLS CPDEST FIRST
    6057 "RTN","C0SXPATH",409,0)
    6058  N CPINSTR
    6059 "RTN","C0SXPATH",410,0)
    6060  I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,!
    6061 "RTN","C0SXPATH",411,0)
    6062  I @CPSRC@(0)<1 D  ; BAD LENGTH
    6063 "RTN","C0SXPATH",412,0)
    6064  . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,!
    6065 "RTN","C0SXPATH",413,0)
    6066  . Q
    6067 "RTN","C0SXPATH",414,0)
    6068  ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT
    6069 "RTN","C0SXPATH",415,0)
    6070  D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY
    6071 "RTN","C0SXPATH",416,0)
    6072  D BUILD("CPINSTR",CPDEST)
    6073 "RTN","C0SXPATH",417,0)
    6074  Q
    6075 "RTN","C0SXPATH",418,0)
    6076  ;
    6077 "RTN","C0SXPATH",419,0)
    6078 QOPEN(QOBLIST,QOXML,QOXPATH)    ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST
    6079 "RTN","C0SXPATH",420,0)
    6080  ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD
    6081 "RTN","C0SXPATH",421,0)
    6082  ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT
    6083 "RTN","C0SXPATH",422,0)
    6084  ; USED TO INSERT CHILDREN NODES
    6085 "RTN","C0SXPATH",423,0)
    6086  I @QOXML@(0)<1 D  ; MALFORMED XML
    6087 "RTN","C0SXPATH",424,0)
    6088  . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,!
    6089 "RTN","C0SXPATH",425,0)
    6090  . Q
    6091 "RTN","C0SXPATH",426,0)
    6092  I $G(DEBUG) W "DOING QOPEN",!
    6093 "RTN","C0SXPATH",427,0)
    6094  N S1,E1,QOT,QOTMP
    6095 "RTN","C0SXPATH",428,0)
    6096  S S1=1 ; OPEN FROM THE BEGINNING OF THE XML
    6097 "RTN","C0SXPATH",429,0)
    6098  I $D(QOXPATH) D  ; XPATH PROVIDED
    6099 "RTN","C0SXPATH",430,0)
    6100  . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX
    6101 "RTN","C0SXPATH",431,0)
    6102  . S E1=$P(@QOXML@(QOXPATH),"^",2)-1
    6103 "RTN","C0SXPATH",432,0)
    6104  I '$D(QOXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
    6105 "RTN","C0SXPATH",433,0)
    6106  . S E1=@QOXML@(0)-1
    6107 "RTN","C0SXPATH",434,0)
    6108  D QUEUE(QOBLIST,QOXML,S1,E1)
    6109 "RTN","C0SXPATH",435,0)
    6110  ; S QOTMP=QOXML_"^"_S1_"^"_E1
    6111 "RTN","C0SXPATH",436,0)
    6112  ; D PUSH(QOBLIST,QOTMP)
    6113 "RTN","C0SXPATH",437,0)
    6114  Q
    6115 "RTN","C0SXPATH",438,0)
    6116  ;
    6117 "RTN","C0SXPATH",439,0)
    6118 QCLOSE(QCBLIST,QCXML,QCXPATH)   ; CLOSE XML AFTER A QOPEN
    6119 "RTN","C0SXPATH",440,0)
    6120  ; ADDS THE LIST LINE OF QCXML TO QCBLIST
    6121 "RTN","C0SXPATH",441,0)
    6122  ; USED TO FINISH INSERTING CHILDERN NODES
    6123 "RTN","C0SXPATH",442,0)
    6124  ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END
    6125 "RTN","C0SXPATH",443,0)
    6126  ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO
    6127 "RTN","C0SXPATH",444,0)
    6128  I @QCXML@(0)<1 D  ; MALFORMED XML
    6129 "RTN","C0SXPATH",445,0)
    6130  . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,!
    6131 "RTN","C0SXPATH",446,0)
    6132  I $G(DEBUG) W "GOING TO CLOSE",!
    6133 "RTN","C0SXPATH",447,0)
    6134  N S1,E1,QCT,QCTMP
    6135 "RTN","C0SXPATH",448,0)
    6136  S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML
    6137 "RTN","C0SXPATH",449,0)
    6138  I $D(QCXPATH) D  ; XPATH PROVIDED
    6139 "RTN","C0SXPATH",450,0)
    6140  . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX
    6141 "RTN","C0SXPATH",451,0)
    6142  . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML
    6143 "RTN","C0SXPATH",452,0)
    6144  I '$D(QCXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
    6145 "RTN","C0SXPATH",453,0)
    6146  . S S1=@QCXML@(0)
    6147 "RTN","C0SXPATH",454,0)
    6148  D QUEUE(QCBLIST,QCXML,S1,E1)
    6149 "RTN","C0SXPATH",455,0)
    6150  ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1)
    6151 "RTN","C0SXPATH",456,0)
    6152  Q
    6153 "RTN","C0SXPATH",457,0)
    6154  ;
    6155 "RTN","C0SXPATH",458,0)
    6156 INSERT(INSXML,INSNEW,INSXPATH)  ; INSERT INSNEW INTO INSXML AT THE
    6157 "RTN","C0SXPATH",459,0)
    6158  ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS
    6159 "RTN","C0SXPATH",460,0)
    6160  ; OMITTED, INSERTION WILL BE AT THE ROOT
    6161 "RTN","C0SXPATH",461,0)
    6162  ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW
    6163 "RTN","C0SXPATH",462,0)
    6164  ; XML AT THE END OF THE XPATH POINT
    6165 "RTN","C0SXPATH",463,0)
    6166  ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE
    6167 "RTN","C0SXPATH",464,0)
    6168  N INSBLD,INSTMP
    6169 "RTN","C0SXPATH",465,0)
    6170  I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,!
    6171 "RTN","C0SXPATH",466,0)
    6172  I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),!
    6173 "RTN","C0SXPATH",467,0)
    6174  I '$D(@INSXML@(1)) D  ; INSERT INTO AN EMPTY ARRAY
    6175 "RTN","C0SXPATH",468,0)
    6176  . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT
    6177 "RTN","C0SXPATH",469,0)
    6178  I $D(@INSXML@(1)) D  ; IF ORIGINAL ARRAY IS NOT EMPTY
    6179 "RTN","C0SXPATH",470,0)
    6180  . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH
    6181 "RTN","C0SXPATH",471,0)
    6182  . I $D(INSXPATH) D  ; XPATH PROVIDED
    6183 "RTN","C0SXPATH",472,0)
    6184  . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE
    6185 "RTN","C0SXPATH",473,0)
    6186  . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD")
    6187 "RTN","C0SXPATH",474,0)
    6188  . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, OPEN AT ROOT
    6189 "RTN","C0SXPATH",475,0)
    6190  . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH
    6191 "RTN","C0SXPATH",476,0)
    6192  . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML
    6193 "RTN","C0SXPATH",477,0)
    6194  . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML
    6195 "RTN","C0SXPATH",478,0)
    6196  . I $D(INSXPATH) D  ; XPATH PROVIDED
    6197 "RTN","C0SXPATH",479,0)
    6198  . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH
    6199 "RTN","C0SXPATH",480,0)
    6200  . I '$D(INSXPATH) D  ; NO XPATH PROVIDED, CLOSE AT ROOT
    6201 "RTN","C0SXPATH",481,0)
    6202  . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH
    6203 "RTN","C0SXPATH",482,0)
    6204  . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST
    6205 "RTN","C0SXPATH",483,0)
    6206  . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE
    6207 "RTN","C0SXPATH",484,0)
    6208  Q
    6209 "RTN","C0SXPATH",485,0)
    6210  ;
    6211 "RTN","C0SXPATH",486,0)
    6212 INSINNER(INNXML,INNNEW,INNXPATH)        ; INSERT THE INNER XML OF INNNEW
    6213 "RTN","C0SXPATH",487,0)
    6214  ; INTO INNXML AT THE INNXPATH XPATH POINT
    6215 "RTN","C0SXPATH",488,0)
    6216  ;
    6217 "RTN","C0SXPATH",489,0)
    6218  N INNBLD,UXPATH
    6219 "RTN","C0SXPATH",490,0)
    6220  N INNTBUF
    6221 "RTN","C0SXPATH",491,0)
    6222  S INNTBUF=$NA(^TMP($J,"INNTBUF"))
    6223 "RTN","C0SXPATH",492,0)
    6224  I '$D(INNXPATH) D  ; XPATH NOT PASSED
    6225 "RTN","C0SXPATH",493,0)
    6226  . S UXPATH="//" ; USE ROOT XPATH
    6227 "RTN","C0SXPATH",494,0)
    6228  I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED
    6229 "RTN","C0SXPATH",495,0)
    6230  I '$D(@INNXML@(0)) D  ; INNXML IS EMPTY
    6231 "RTN","C0SXPATH",496,0)
    6232  . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER
    6233 "RTN","C0SXPATH",497,0)
    6234  . D BUILD("INNBLD",INNXML)
    6235 "RTN","C0SXPATH",498,0)
    6236  I @INNXML@(0)>0  D  ; NOT EMPTY
    6237 "RTN","C0SXPATH",499,0)
    6238  . D QOPEN("INNBLD",INNXML,UXPATH) ;
    6239 "RTN","C0SXPATH",500,0)
    6240  . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML
    6241 "RTN","C0SXPATH",501,0)
    6242  . D QCLOSE("INNBLD",INNXML,UXPATH)
    6243 "RTN","C0SXPATH",502,0)
    6244  . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER
    6245 "RTN","C0SXPATH",503,0)
    6246  . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST
    6247 "RTN","C0SXPATH",504,0)
    6248  Q
    6249 "RTN","C0SXPATH",505,0)
    6250  ;
    6251 "RTN","C0SXPATH",506,0)
    6252 INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST
    6253 "RTN","C0SXPATH",507,0)
    6254  ; BUT XDEST AN XNEW ARE PASSED BY NAME
    6255 "RTN","C0SXPATH",508,0)
     6335"RTN","C0SXPATH",560,0)
     6336 S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
     6337"RTN","C0SXPATH",561,0)
     6338 F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
     6339"RTN","C0SXPATH",562,0)
     6340 . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
     6341"RTN","C0SXPATH",563,0)
     6342 . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
     6343"RTN","C0SXPATH",564,0)
     6344 . . Q
     6345"RTN","C0SXPATH",565,0)
     6346 Q
     6347"RTN","C0SXPATH",566,0)
     6348 ;
     6349"RTN","C0SXPATH",567,0)
     6350MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
     6351"RTN","C0SXPATH",568,0)
     6352 ; AND PUT THE RESULTS IN OXML
     6353"RTN","C0SXPATH",569,0)
     6354 N XCNT
     6355"RTN","C0SXPATH",570,0)
     6356 I '$D(DEBUG) S DEBUG=0
     6357"RTN","C0SXPATH",571,0)
     6358 I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
     6359"RTN","C0SXPATH",572,0)
     6360 I '$D(@IXML@(0)) D  ; INITIALIZE COUNT
     6361"RTN","C0SXPATH",573,0)
     6362 . S XCNT=$O(@IXML@(""),-1)
     6363"RTN","C0SXPATH",574,0)
     6364 E  S XCNT=@IXML@(0) ;COUNT
     6365"RTN","C0SXPATH",575,0)
     6366 I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
     6367"RTN","C0SXPATH",576,0)
     6368 N I,J,TNAM,TVAL,TSTR
     6369"RTN","C0SXPATH",577,0)
     6370 S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
     6371"RTN","C0SXPATH",578,0)
     6372 F I=1:1:XCNT  D   ; LOOP THROUGH WHOLE ARRAY
     6373"RTN","C0SXPATH",579,0)
     6374 . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
     6375"RTN","C0SXPATH",580,0)
     6376 . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
     6377"RTN","C0SXPATH",581,0)
     6378 . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
     6379"RTN","C0SXPATH",582,0)
     6380 . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
     6381"RTN","C0SXPATH",583,0)
     6382 . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
     6383"RTN","C0SXPATH",584,0)
     6384 . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
     6385"RTN","C0SXPATH",585,0)
     6386 . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
     6387"RTN","C0SXPATH",586,0)
     6388 . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
     6389"RTN","C0SXPATH",587,0)
     6390 . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
     6391"RTN","C0SXPATH",588,0)
     6392 . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
     6393"RTN","C0SXPATH",589,0)
     6394 . . . . E  D DOFLD ; PROCESS A FIELD
     6395"RTN","C0SXPATH",590,0)
     6396 . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
     6397"RTN","C0SXPATH",591,0)
     6398 . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
     6399"RTN","C0SXPATH",592,0)
     6400 . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
     6401"RTN","C0SXPATH",593,0)
     6402 . . I DEBUG W TSTR
     6403"RTN","C0SXPATH",594,0)
     6404 I DEBUG W "MAPPED",!
     6405"RTN","C0SXPATH",595,0)
     6406 Q
     6407"RTN","C0SXPATH",596,0)
     6408 ;
     6409"RTN","C0SXPATH",597,0)
     6410DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
     6411"RTN","C0SXPATH",598,0)
     6412 ;
     6413"RTN","C0SXPATH",599,0)
     6414 Q
     6415"RTN","C0SXPATH",600,0)
     6416 ;
     6417"RTN","C0SXPATH",601,0)
     6418TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
     6419"RTN","C0SXPATH",602,0)
     6420 ; THEXML IS PASSED BY NAME
     6421"RTN","C0SXPATH",603,0)
     6422 N I,J,TMPXML,DEL,FOUND,INTXT
     6423"RTN","C0SXPATH",604,0)
     6424 S FOUND=0
     6425"RTN","C0SXPATH",605,0)
     6426 S INTXT=0
     6427"RTN","C0SXPATH",606,0)
     6428 I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!
     6429"RTN","C0SXPATH",607,0)
     6430 F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
     6431"RTN","C0SXPATH",608,0)
     6432 . S J=@THEXML@(I)
     6433"RTN","C0SXPATH",609,0)
     6434 . I J["<text>" D
     6435"RTN","C0SXPATH",610,0)
     6436 . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
     6437"RTN","C0SXPATH",611,0)
     6438 . . I $G(DEBUG) W "IN HTML SECTION",!
     6439"RTN","C0SXPATH",612,0)
     6440 . N JM,JP,JPX ; JMINUS AND JPLUS
     6441"RTN","C0SXPATH",613,0)
     6442 . S JM=@THEXML@(I-1) ; LINE BEFORE
     6443"RTN","C0SXPATH",614,0)
     6444 . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
     6445"RTN","C0SXPATH",615,0)
     6446 . S JP=@THEXML@(I+1) ; LINE AFTER
     6447"RTN","C0SXPATH",616,0)
     6448 . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
     6449"RTN","C0SXPATH",617,0)
     6450 . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
     6451"RTN","C0SXPATH",618,0)
     6452 . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
     6453"RTN","C0SXPATH",619,0)
     6454 . . . I $G(DEBUG) W I,J,JP,!
     6455"RTN","C0SXPATH",620,0)
     6456 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
     6457"RTN","C0SXPATH",621,0)
     6458 . . . S DEL(I)="" ; SET LINE TO DELETE
     6459"RTN","C0SXPATH",622,0)
     6460 . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
     6461"RTN","C0SXPATH",623,0)
     6462 . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
     6463"RTN","C0SXPATH",624,0)
     6464 . . . I $G(DEBUG) W I,J,!
     6465"RTN","C0SXPATH",625,0)
     6466 . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
     6467"RTN","C0SXPATH",626,0)
     6468 . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
     6469"RTN","C0SXPATH",627,0)
     6470 . . . I JM=JPX D  ;
     6471"RTN","C0SXPATH",628,0)
     6472 . . . . I $G(DEBUG) W I,JM_J_JPX,!
     6473"RTN","C0SXPATH",629,0)
     6474 . . . . S DEL(I-1)=""
     6475"RTN","C0SXPATH",630,0)
     6476 . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
     6477"RTN","C0SXPATH",631,0)
     6478 ; . I J'["><" D PUSH("TMPXML",J)
     6479"RTN","C0SXPATH",632,0)
     6480 I FOUND D  ; NEED TO DELETE THINGS
     6481"RTN","C0SXPATH",633,0)
     6482 . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
     6483"RTN","C0SXPATH",634,0)
     6484 . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
     6485"RTN","C0SXPATH",635,0)
     6486 . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
     6487"RTN","C0SXPATH",636,0)
     6488 . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
     6489"RTN","C0SXPATH",637,0)
     6490 Q FOUND
     6491"RTN","C0SXPATH",638,0)
     6492 ;
     6493"RTN","C0SXPATH",639,0)
     6494UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
     6495"RTN","C0SXPATH",640,0)
     6496 ; XSEC IS A SECTION PASSED BY NAME
     6497"RTN","C0SXPATH",641,0)
    62566498 N XBLD,XTMP
    6257 "RTN","C0SXPATH",509,0)
    6258  D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT
    6259 "RTN","C0SXPATH",510,0)
    6260  D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST
    6261 "RTN","C0SXPATH",511,0)
    6262  D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION
    6263 "RTN","C0SXPATH",512,0)
     6499"RTN","C0SXPATH",642,0)
     6500 D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
     6501"RTN","C0SXPATH",643,0)
    62646502 D BUILD("XBLD","XTMP") ; BUILD THE RESULT
    6265 "RTN","C0SXPATH",513,0)
    6266  D CP("XTMP",XDEST) ; COPY TO THE DESTINATION
    6267 "RTN","C0SXPATH",514,0)
    6268  I $G(DEBUG) D PARY("XDEST")
    6269 "RTN","C0SXPATH",515,0)
    6270  Q
    6271 "RTN","C0SXPATH",516,0)
    6272  ;
    6273 "RTN","C0SXPATH",517,0)
    6274 REPLACE(REXML,RENEW,REXPATH)    ; REPLACE THE XML AT THE XPATH POINT
    6275 "RTN","C0SXPATH",518,0)
    6276  ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE
    6277 "RTN","C0SXPATH",519,0)
    6278  ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE
    6279 "RTN","C0SXPATH",520,0)
    6280  ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD")
    6281 "RTN","C0SXPATH",521,0)
    6282  N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
    6283 "RTN","C0SXPATH",522,0)
    6284  S OLD=$NA(^TMP($J,"REPLACE_OLD"))
    6285 "RTN","C0SXPATH",523,0)
    6286  D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
    6287 "RTN","C0SXPATH",524,0)
    6288  S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
    6289 "RTN","C0SXPATH",525,0)
    6290  S XFIRST=$P(XNODE,"^",1)
    6291 "RTN","C0SXPATH",526,0)
    6292  S XLAST=$P(XNODE,"^",2)
    6293 "RTN","C0SXPATH",527,0)
    6294  I RENEW="" D  ; WE ARE DELETING A SECTION, MUST SAVE THE TAG
    6295 "RTN","C0SXPATH",528,0)
    6296  . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE
    6297 "RTN","C0SXPATH",529,0)
    6298  . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST
    6299 "RTN","C0SXPATH",530,0)
    6300  I RENEW'="" D  ; NEW XML IS NOT NULL
    6301 "RTN","C0SXPATH",531,0)
    6302  . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
    6303 "RTN","C0SXPATH",532,0)
    6304  . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW
    6305 "RTN","C0SXPATH",533,0)
    6306  . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
    6307 "RTN","C0SXPATH",534,0)
    6308  I $G(DEBUG) W "REPLACE PREBUILD",!
    6309 "RTN","C0SXPATH",535,0)
    6310  I $G(DEBUG) D PARY("REBLD")
    6311 "RTN","C0SXPATH",536,0)
    6312  D BUILD("REBLD","RTMP")
    6313 "RTN","C0SXPATH",537,0)
    6314  K @REXML ; KILL WHAT WAS THERE
    6315 "RTN","C0SXPATH",538,0)
    6316  D CP("RTMP",REXML) ; COPY IN THE RESULT
    6317 "RTN","C0SXPATH",539,0)
    6318  Q
    6319 "RTN","C0SXPATH",540,0)
    6320  ;
    6321 "RTN","C0SXPATH",541,0)
    6322 DELETE(REXML,REXPATH)    ; DELETE THE XML AT THE XPATH POINT
    6323 "RTN","C0SXPATH",542,0)
    6324  ; REXML IS PASSED BY NAME XPATH IS A VALUE
    6325 "RTN","C0SXPATH",543,0)
    6326  N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP
    6327 "RTN","C0SXPATH",544,0)
    6328  S OLD=$NA(^TMP($J,"REPLACE_OLD"))
    6329 "RTN","C0SXPATH",545,0)
    6330  D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD
    6331 "RTN","C0SXPATH",546,0)
    6332  S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS
    6333 "RTN","C0SXPATH",547,0)
    6334  S XFIRST=$P(XNODE,"^",1)
    6335 "RTN","C0SXPATH",548,0)
    6336  S XLAST=$P(XNODE,"^",2)
    6337 "RTN","C0SXPATH",549,0)
    6338  D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE
    6339 "RTN","C0SXPATH",550,0)
    6340  D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST
    6341 "RTN","C0SXPATH",551,0)
    6342  I $G(DEBUG) D PARY("REBLD")
    6343 "RTN","C0SXPATH",552,0)
    6344  D BUILD("REBLD","RTMP")
    6345 "RTN","C0SXPATH",553,0)
    6346  K @REXML ; KILL WHAT WAS THERE
    6347 "RTN","C0SXPATH",554,0)
    6348  D CP("RTMP",REXML) ; COPY IN THE RESULT
    6349 "RTN","C0SXPATH",555,0)
    6350  Q
    6351 "RTN","C0SXPATH",556,0)
    6352  ;
    6353 "RTN","C0SXPATH",557,0)
    6354 MISSING(IXML,OARY)      ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY
    6355 "RTN","C0SXPATH",558,0)
    6356  ; W "Reporting on the missing",!
    6357 "RTN","C0SXPATH",559,0)
    6358  ; W OARY
    6359 "RTN","C0SXPATH",560,0)
    6360  I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q
    6361 "RTN","C0SXPATH",561,0)
     6503"RTN","C0SXPATH",644,0)
     6504 D CP("XTMP",XSEC) ; REPLACE PASSED XML
     6505"RTN","C0SXPATH",645,0)
     6506 Q
     6507"RTN","C0SXPATH",646,0)
     6508 ;
     6509"RTN","C0SXPATH",647,0)
     6510PARY(GLO,ZN)       ;PRINT AN ARRAY
     6511"RTN","C0SXPATH",648,0)
     6512 ; IF ZN=-1 NO LINE NUMBERS
     6513"RTN","C0SXPATH",649,0)
    63626514 N I
    6363 "RTN","C0SXPATH",562,0)
    6364  S @OARY@(0)=0 ; INITIALIZED MISSING COUNT
    6365 "RTN","C0SXPATH",563,0)
    6366  F I=1:1:@IXML@(0)  D   ; LOOP THROUGH WHOLE ARRAY
    6367 "RTN","C0SXPATH",564,0)
    6368  . I @IXML@(I)?.E1"@@".E D  ; MISSING VARIABLE HERE
    6369 "RTN","C0SXPATH",565,0)
    6370  . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY
    6371 "RTN","C0SXPATH",566,0)
    6372  . . Q
    6373 "RTN","C0SXPATH",567,0)
    6374  Q
    6375 "RTN","C0SXPATH",568,0)
    6376  ;
    6377 "RTN","C0SXPATH",569,0)
    6378 MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY
    6379 "RTN","C0SXPATH",570,0)
    6380  ; AND PUT THE RESULTS IN OXML
    6381 "RTN","C0SXPATH",571,0)
    6382  N XCNT
    6383 "RTN","C0SXPATH",572,0)
    6384  I '$D(DEBUG) S DEBUG=0
    6385 "RTN","C0SXPATH",573,0)
    6386  I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q
    6387 "RTN","C0SXPATH",574,0)
    6388  I '$D(@IXML@(0)) D  ; INITIALIZE COUNT
    6389 "RTN","C0SXPATH",575,0)
    6390  . S XCNT=$O(@IXML@(""),-1)
    6391 "RTN","C0SXPATH",576,0)
    6392  E  S XCNT=@IXML@(0) ;COUNT
    6393 "RTN","C0SXPATH",577,0)
    6394  I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q
    6395 "RTN","C0SXPATH",578,0)
    6396  N I,J,TNAM,TVAL,TSTR
    6397 "RTN","C0SXPATH",579,0)
    6398  S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT
    6399 "RTN","C0SXPATH",580,0)
    6400  F I=1:1:XCNT  D   ; LOOP THROUGH WHOLE ARRAY
    6401 "RTN","C0SXPATH",581,0)
    6402  . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT
    6403 "RTN","C0SXPATH",582,0)
    6404  . I @OXML@(I)?.E1"@@".E D  ; IS THERE A VARIABLE HERE?
    6405 "RTN","C0SXPATH",583,0)
    6406  . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS
    6407 "RTN","C0SXPATH",584,0)
    6408  . . F J=2:2:10  D  Q:$P(@IXML@(I),"@@",J+2)=""  ; QUIT IF NO MORE VARS
    6409 "RTN","C0SXPATH",585,0)
    6410  . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,!
    6411 "RTN","C0SXPATH",586,0)
    6412  . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME
    6413 "RTN","C0SXPATH",587,0)
    6414  . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED
    6415 "RTN","C0SXPATH",588,0)
    6416  . . . I $D(@INARY@(TNAM))  D  ; IS THE VARIABLE IN THE MAP?
    6417 "RTN","C0SXPATH",589,0)
    6418  . . . . I '$D(@INARY@(TNAM,"F")) D  ; NOT A SPECIAL FIELD
    6419 "RTN","C0SXPATH",590,0)
    6420  . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE
    6421 "RTN","C0SXPATH",591,0)
    6422  . . . . E  D DOFLD ; PROCESS A FIELD
    6423 "RTN","C0SXPATH",592,0)
    6424  . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE
    6425 "RTN","C0SXPATH",593,0)
    6426  . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER
    6427 "RTN","C0SXPATH",594,0)
    6428  . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES
    6429 "RTN","C0SXPATH",595,0)
    6430  . . I DEBUG W TSTR
    6431 "RTN","C0SXPATH",596,0)
    6432  I DEBUG W "MAPPED",!
    6433 "RTN","C0SXPATH",597,0)
    6434  Q
    6435 "RTN","C0SXPATH",598,0)
    6436  ;
    6437 "RTN","C0SXPATH",599,0)
    6438 DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE
    6439 "RTN","C0SXPATH",600,0)
    6440  ;
    6441 "RTN","C0SXPATH",601,0)
    6442  Q
    6443 "RTN","C0SXPATH",602,0)
    6444  ;
    6445 "RTN","C0SXPATH",603,0)
    6446 TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS
    6447 "RTN","C0SXPATH",604,0)
    6448  ; THEXML IS PASSED BY NAME
    6449 "RTN","C0SXPATH",605,0)
    6450  N I,J,TMPXML,DEL,FOUND,INTXT
    6451 "RTN","C0SXPATH",606,0)
    6452  S FOUND=0
    6453 "RTN","C0SXPATH",607,0)
    6454  S INTXT=0
    6455 "RTN","C0SXPATH",608,0)
    6456  I $G(DEBUG) W "DELETING EMPTY ELEMENTS",!
    6457 "RTN","C0SXPATH",609,0)
    6458  F I=1:1:(@THEXML@(0)-1) D  ; LOOP THROUGH ENTIRE ARRAY
    6459 "RTN","C0SXPATH",610,0)
    6460  . S J=@THEXML@(I)
    6461 "RTN","C0SXPATH",611,0)
    6462  . I J["<text>" D
    6463 "RTN","C0SXPATH",612,0)
    6464  . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM
    6465 "RTN","C0SXPATH",613,0)
    6466  . . I $G(DEBUG) W "IN HTML SECTION",!
    6467 "RTN","C0SXPATH",614,0)
    6468  . N JM,JP,JPX ; JMINUS AND JPLUS
    6469 "RTN","C0SXPATH",615,0)
    6470  . S JM=@THEXML@(I-1) ; LINE BEFORE
    6471 "RTN","C0SXPATH",616,0)
    6472  . I JM["</text>" S INTXT=0 ; LEFT HTML SECTION,START TRIM
    6473 "RTN","C0SXPATH",617,0)
    6474  . S JP=@THEXML@(I+1) ; LINE AFTER
    6475 "RTN","C0SXPATH",618,0)
    6476  . I INTXT=0 D  ; IF NOT IN AN HTML SECTION
    6477 "RTN","C0SXPATH",619,0)
    6478  . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH
    6479 "RTN","C0SXPATH",620,0)
    6480  . . I J=JPX D  ; AN EMPTY ELEMENT ON TWO LINES
    6481 "RTN","C0SXPATH",621,0)
    6482  . . . I $G(DEBUG) W I,J,JP,!
    6483 "RTN","C0SXPATH",622,0)
    6484  . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
    6485 "RTN","C0SXPATH",623,0)
    6486  . . . S DEL(I)="" ; SET LINE TO DELETE
    6487 "RTN","C0SXPATH",624,0)
    6488  . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE
    6489 "RTN","C0SXPATH",625,0)
    6490  . . I J["><" D  ; AN EMPTY ELEMENT ON ONE LINE
    6491 "RTN","C0SXPATH",626,0)
    6492  . . . I $G(DEBUG) W I,J,!
    6493 "RTN","C0SXPATH",627,0)
    6494  . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED
    6495 "RTN","C0SXPATH",628,0)
    6496  . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED
    6497 "RTN","C0SXPATH",629,0)
    6498  . . . I JM=JPX D  ;
    6499 "RTN","C0SXPATH",630,0)
    6500  . . . . I $G(DEBUG) W I,JM_J_JPX,!
    6501 "RTN","C0SXPATH",631,0)
    6502  . . . . S DEL(I-1)=""
    6503 "RTN","C0SXPATH",632,0)
    6504  . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL
    6505 "RTN","C0SXPATH",633,0)
    6506  ; . I J'["><" D PUSH("TMPXML",J)
    6507 "RTN","C0SXPATH",634,0)
    6508  I FOUND D  ; NEED TO DELETE THINGS
    6509 "RTN","C0SXPATH",635,0)
    6510  . F I=1:1:@THEXML@(0) D  ; COPY ARRAY LEAVING OUT DELELTED LINES
    6511 "RTN","C0SXPATH",636,0)
    6512  . . I '$D(DEL(I)) D  ; IF THE LINE IS NOT DELETED
    6513 "RTN","C0SXPATH",637,0)
    6514  . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY
    6515 "RTN","C0SXPATH",638,0)
    6516  . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY
    6517 "RTN","C0SXPATH",639,0)
    6518  Q FOUND
    6519 "RTN","C0SXPATH",640,0)
    6520  ;
    6521 "RTN","C0SXPATH",641,0)
    6522 UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML
    6523 "RTN","C0SXPATH",642,0)
    6524  ; XSEC IS A SECTION PASSED BY NAME
    6525 "RTN","C0SXPATH",643,0)
    6526  N XBLD,XTMP
    6527 "RTN","C0SXPATH",644,0)
    6528  D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML
    6529 "RTN","C0SXPATH",645,0)
    6530  D BUILD("XBLD","XTMP") ; BUILD THE RESULT
    6531 "RTN","C0SXPATH",646,0)
    6532  D CP("XTMP",XSEC) ; REPLACE PASSED XML
    6533 "RTN","C0SXPATH",647,0)
    6534  Q
    6535 "RTN","C0SXPATH",648,0)
    6536  ;
    6537 "RTN","C0SXPATH",649,0)
    6538 PARY(GLO,ZN)       ;PRINT AN ARRAY
    65396515"RTN","C0SXPATH",650,0)
    6540  ; IF ZN=-1 NO LINE NUMBERS
     6516 F I=1:1:@GLO@(0) D  ;
    65416517"RTN","C0SXPATH",651,0)
    6542  N I
     6518 . I $G(ZN)=-1 W @GLO@(I),!
    65436519"RTN","C0SXPATH",652,0)
    6544  F I=1:1:@GLO@(0) D  ;
     6520 . E  W I_" "_@GLO@(I),!
    65456521"RTN","C0SXPATH",653,0)
    6546  . I $G(ZN)=-1 W @GLO@(I),!
     6522 Q
    65476523"RTN","C0SXPATH",654,0)
    6548  . E  W I_" "_@GLO@(I),!
     6524 ;
    65496525"RTN","C0SXPATH",655,0)
    6550  Q
     6526H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
    65516527"RTN","C0SXPATH",656,0)
    6552  ;
     6528 ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
    65536529"RTN","C0SXPATH",657,0)
    6554 H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY
     6530 I '$D(IPRE) S IPRE=""
    65556531"RTN","C0SXPATH",658,0)
    6556  ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE
     6532 N H2I S H2I=""
    65576533"RTN","C0SXPATH",659,0)
    6558  I '$D(IPRE) S IPRE=""
     6534 ; W $O(@IHASH@(H2I)),!
    65596535"RTN","C0SXPATH",660,0)
    6560  N H2I S H2I=""
     6536 F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
    65616537"RTN","C0SXPATH",661,0)
    6562  ; W $O(@IHASH@(H2I)),!
     6538 . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
    65636539"RTN","C0SXPATH",662,0)
    6564  F  S H2I=$O(@IHASH@(H2I)) Q:H2I=""  D  ; FOR EACH ELEMENT OF THE HASH
     6540 . . ;W H2I_"^"_@IHASH@(H2I),!
    65656541"RTN","C0SXPATH",663,0)
    6566  . I $QS(H2I,$QL(H2I))="M" D  Q  ; SPECIAL CASE FOR MULTIPLES
     6542 . . N IH,IHI
    65676543"RTN","C0SXPATH",664,0)
    6568  . . ;W H2I_"^"_@IHASH@(H2I),!
     6544 . . S IH=$NA(@IHASH@(H2I)) ;
    65696545"RTN","C0SXPATH",665,0)
    6570  . . N IH,IHI
     6546 . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
    65716547"RTN","C0SXPATH",666,0)
    6572  . . S IH=$NA(@IHASH@(H2I)) ;
     6548 . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
    65736549"RTN","C0SXPATH",667,0)
    6574  . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR
     6550 . . S IHI="" ; INDEX INTO "M" MULTIPLES
    65756551"RTN","C0SXPATH",668,0)
    6576  . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE
     6552 . . F  S IHI=$O(@IH2@(IHI)) Q:IHI=""  D  ; FOR EACH SUB-MULTIPLE
    65776553"RTN","C0SXPATH",669,0)
    6578  . . S IHI="" ; INDEX INTO "M" MULTIPLES
     6554 . . . ; W @IH@(IHI)
    65796555"RTN","C0SXPATH",670,0)
    6580  . . F  S IHI=$O(@IH2@(IHI)) Q:IHI=""  D  ; FOR EACH SUB-MULTIPLE
     6556 . . . S IH3=$NA(@IH2@(IHI))
    65816557"RTN","C0SXPATH",671,0)
    6582  . . . ; W @IH@(IHI)
     6558 . . . ; W "HEY",IH3,!
    65836559"RTN","C0SXPATH",672,0)
    6584  . . . S IH3=$NA(@IH2@(IHI))
     6560 . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
    65856561"RTN","C0SXPATH",673,0)
    6586  . . . ; W "HEY",IH3,!
     6562 . . ; W IH,!
    65876563"RTN","C0SXPATH",674,0)
    6588  . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS
     6564 . . ; W "C0CZZ",!
    65896565"RTN","C0SXPATH",675,0)
    6590  . . ; W IH,!
     6566 . . ; W $NA(@IHASH@(H2I)),!
    65916567"RTN","C0SXPATH",676,0)
    6592  . . ; W "C0CZZ",!
     6568 . . Q  ;
    65936569"RTN","C0SXPATH",677,0)
    6594  . . ; W $NA(@IHASH@(H2I)),!
     6570 . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
    65956571"RTN","C0SXPATH",678,0)
    6596  . . Q  ;
     6572 . ; W @IARYRTN@(0),!
    65976573"RTN","C0SXPATH",679,0)
    6598  . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I))
     6574 Q
    65996575"RTN","C0SXPATH",680,0)
    6600  . ; W @IARYRTN@(0),!
     6576 ;
    66016577"RTN","C0SXPATH",681,0)
    6602  Q
     6578XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
    66036579"RTN","C0SXPATH",682,0)
    6604  ;
     6580 ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
    66056581"RTN","C0SXPATH",683,0)
    6606 XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES
     6582 ; XVRTN AND XVIXML ARE PASSED BY NAME
    66076583"RTN","C0SXPATH",684,0)
    6608  ; DEFINED IN INPUT XML XVIXML BY @@VAR@@
     6584 ;
    66096585"RTN","C0SXPATH",685,0)
    6610  ; XVRTN AND XVIXML ARE PASSED BY NAME
     6586 N XVI,XVTMP,XVT
    66116587"RTN","C0SXPATH",686,0)
    6612  ;
     6588 F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
    66136589"RTN","C0SXPATH",687,0)
    6614  N XVI,XVTMP,XVT
     6590 . S XVT=@XVIXML@(XVI)
    66156591"RTN","C0SXPATH",688,0)
    6616  F XVI=1:1:@XVIXML@(0) D  ; FOR ALL LINES OF THE XML
     6592 . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
    66176593"RTN","C0SXPATH",689,0)
    6618  . S XVT=@XVIXML@(XVI)
     6594 D H2ARY(XVRTN,"XVTMP")
    66196595"RTN","C0SXPATH",690,0)
    6620  . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI
     6596 Q
    66216597"RTN","C0SXPATH",691,0)
    6622  D H2ARY(XVRTN,"XVTMP")
     6598 ;
    66236599"RTN","C0SXPATH",692,0)
    6624  Q
     6600DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
    66256601"RTN","C0SXPATH",693,0)
    6626  ;
     6602 ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
    66276603"RTN","C0SXPATH",694,0)
    6628 DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE
     6604 ;
    66296605"RTN","C0SXPATH",695,0)
    6630  ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE
     6606 N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
    66316607"RTN","C0SXPATH",696,0)
    6632  ;
     6608 I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
    66336609"RTN","C0SXPATH",697,0)
    6634  N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED
     6610 . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
    66356611"RTN","C0SXPATH",698,0)
    6636  I DXIN="CCR" D  ; NEED TO GO GET CCR TEMPLATE
     6612 . S DXUSE="DTMP" ; DXUSE IS NAME
    66376613"RTN","C0SXPATH",699,0)
    6638  . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
     6614 E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
    66396615"RTN","C0SXPATH",700,0)
     6616 . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
     6617"RTN","C0SXPATH",701,0)
    66406618 . S DXUSE="DTMP" ; DXUSE IS NAME
    6641 "RTN","C0SXPATH",701,0)
    6642  E  I DXIN="CCD" D  ; NEED TO GO GET CCD TEMPLATE
    66436619"RTN","C0SXPATH",702,0)
    6644  . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP
     6620 E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
    66456621"RTN","C0SXPATH",703,0)
    6646  . S DXUSE="DTMP" ; DXUSE IS NAME
     6622 N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
    66476623"RTN","C0SXPATH",704,0)
    6648  E  S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE
     6624 D XVARS("DVARS",DXUSE) ; PULL OUT VARS
    66496625"RTN","C0SXPATH",705,0)
    6650  N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE
     6626 D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
    66516627"RTN","C0SXPATH",706,0)
    6652  D XVARS("DVARS",DXUSE) ; PULL OUT VARS
     6628 Q
    66536629"RTN","C0SXPATH",707,0)
    6654  D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM
     6630 ;
    66556631"RTN","C0SXPATH",708,0)
    6656  Q
     6632TEST     ; Run all the test cases
    66576633"RTN","C0SXPATH",709,0)
    6658  ;
     6634 D TESTALL^C0CUNIT("C0CXPAT0")
    66596635"RTN","C0SXPATH",710,0)
    6660 TEST     ; Run all the test cases
     6636 Q
    66616637"RTN","C0SXPATH",711,0)
    6662  D TESTALL^C0CUNIT("C0CXPAT0")
     6638 ;
    66636639"RTN","C0SXPATH",712,0)
    6664  Q
     6640ZTEST(WHICH)    ; RUN ONE SET OF TESTS
    66656641"RTN","C0SXPATH",713,0)
    6666  ;
     6642 N ZTMP
    66676643"RTN","C0SXPATH",714,0)
    6668 ZTEST(WHICH)    ; RUN ONE SET OF TESTS
     6644 S DEBUG=1
    66696645"RTN","C0SXPATH",715,0)
     6646 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
     6647"RTN","C0SXPATH",716,0)
     6648 D ZTEST^C0CUNIT(.ZTMP,WHICH)
     6649"RTN","C0SXPATH",717,0)
     6650 Q
     6651"RTN","C0SXPATH",718,0)
     6652 ;
     6653"RTN","C0SXPATH",719,0)
     6654TLIST   ; LIST THE TESTS
     6655"RTN","C0SXPATH",720,0)
    66706656 N ZTMP
    6671 "RTN","C0SXPATH",716,0)
    6672  S DEBUG=1
    6673 "RTN","C0SXPATH",717,0)
     6657"RTN","C0SXPATH",721,0)
    66746658 D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
    6675 "RTN","C0SXPATH",718,0)
    6676  D ZTEST^C0CUNIT(.ZTMP,WHICH)
    6677 "RTN","C0SXPATH",719,0)
    6678  Q
    6679 "RTN","C0SXPATH",720,0)
    6680  ;
    6681 "RTN","C0SXPATH",721,0)
    6682 TLIST   ; LIST THE TESTS
    66836659"RTN","C0SXPATH",722,0)
    6684  N ZTMP
     6660 D TLIST^C0CUNIT(.ZTMP)
    66856661"RTN","C0SXPATH",723,0)
    6686  D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
     6662 Q
    66876663"RTN","C0SXPATH",724,0)
    6688  D TLIST^C0CUNIT(.ZTMP)
    6689 "RTN","C0SXPATH",725,0)
    6690  Q
    6691 "RTN","C0SXPATH",726,0)
    66926664 ;
    66936665"VER")
Note: See TracChangeset for help on using the changeset viewer.