Index: /smart/trunk/kids/VISTA_SMART_CONTAINER_1T5.KID =================================================================== --- /smart/trunk/kids/VISTA_SMART_CONTAINER_1T5.KID (revision 1571) +++ /smart/trunk/kids/VISTA_SMART_CONTAINER_1T5.KID (revision 1571) @@ -0,0 +1,6696 @@ +KIDS Distribution saved on Oct 13, 2012@13:00:56 +fix for lab units not found and analysis routines +**KIDS**:VISTA SMART CONTAINER 1.0^ + +**INSTALL NAME** +VISTA SMART CONTAINER 1.0 +"BLD",8180,0) +VISTA SMART CONTAINER 1.0^VISTA SMART CONTAINER^0^3121013^n +"BLD",8180,1,0) +^^1^1^3120926^ +"BLD",8180,1,1,0) +Version 1.0 +"BLD",8180,4,0) +^9.64PA^^ +"BLD",8180,6.3) +5 +"BLD",8180,"ABPKG") +n +"BLD",8180,"KRN",0) +^9.67PA^779.2^20 +"BLD",8180,"KRN",.4,0) +.4 +"BLD",8180,"KRN",.401,0) +.401 +"BLD",8180,"KRN",.402,0) +.402 +"BLD",8180,"KRN",.403,0) +.403 +"BLD",8180,"KRN",.5,0) +.5 +"BLD",8180,"KRN",.84,0) +.84 +"BLD",8180,"KRN",3.6,0) +3.6 +"BLD",8180,"KRN",3.8,0) +3.8 +"BLD",8180,"KRN",9.2,0) +9.2 +"BLD",8180,"KRN",9.8,0) +9.8 +"BLD",8180,"KRN",9.8,"NM",0) +^9.68A^13^13 +"BLD",8180,"KRN",9.8,"NM",1,0) +C0SDEM^^0^B59022362 +"BLD",8180,"KRN",9.8,"NM",2,0) +C0SDOM^^0^B87367162 +"BLD",8180,"KRN",9.8,"NM",3,0) +C0SLAB^^0^B79856252 +"BLD",8180,"KRN",9.8,"NM",4,0) +C0SMART^^0^B2907401 +"BLD",8180,"KRN",9.8,"NM",5,0) +C0SMED^^0^B40719083 +"BLD",8180,"KRN",9.8,"NM",6,0) +C0SMXMLB^^0^B12189644 +"BLD",8180,"KRN",9.8,"NM",7,0) +C0SNHIN^^0^B88600644 +"BLD",8180,"KRN",9.8,"NM",8,0) +C0SNHINV^^0^B15736572 +"BLD",8180,"KRN",9.8,"NM",9,0) +C0SPROB^^0^B49669400 +"BLD",8180,"KRN",9.8,"NM",10,0) +C0SPROB2^^0^B67594874 +"BLD",8180,"KRN",9.8,"NM",11,0) +C0STBL^^0^B23989761 +"BLD",8180,"KRN",9.8,"NM",12,0) +C0SUTIL^^0^B1005502 +"BLD",8180,"KRN",9.8,"NM",13,0) +C0SXPATH^^0^B521283143 +"BLD",8180,"KRN",9.8,"NM","B","C0SDEM",1) + +"BLD",8180,"KRN",9.8,"NM","B","C0SDOM",2) + +"BLD",8180,"KRN",9.8,"NM","B","C0SLAB",3) + +"BLD",8180,"KRN",9.8,"NM","B","C0SMART",4) + +"BLD",8180,"KRN",9.8,"NM","B","C0SMED",5) + +"BLD",8180,"KRN",9.8,"NM","B","C0SMXMLB",6) + +"BLD",8180,"KRN",9.8,"NM","B","C0SNHIN",7) + +"BLD",8180,"KRN",9.8,"NM","B","C0SNHINV",8) + +"BLD",8180,"KRN",9.8,"NM","B","C0SPROB",9) + +"BLD",8180,"KRN",9.8,"NM","B","C0SPROB2",10) + +"BLD",8180,"KRN",9.8,"NM","B","C0STBL",11) + +"BLD",8180,"KRN",9.8,"NM","B","C0SUTIL",12) + +"BLD",8180,"KRN",9.8,"NM","B","C0SXPATH",13) + +"BLD",8180,"KRN",19,0) +19 +"BLD",8180,"KRN",19.1,0) +19.1 +"BLD",8180,"KRN",101,0) +101 +"BLD",8180,"KRN",409.61,0) +409.61 +"BLD",8180,"KRN",771,0) +771 +"BLD",8180,"KRN",779.2,0) +779.2 +"BLD",8180,"KRN",870,0) +870 +"BLD",8180,"KRN",8989.51,0) +8989.51 +"BLD",8180,"KRN",8989.52,0) +8989.52 +"BLD",8180,"KRN",8994,0) +8994 +"BLD",8180,"KRN","B",.4,.4) + +"BLD",8180,"KRN","B",.401,.401) + +"BLD",8180,"KRN","B",.402,.402) + +"BLD",8180,"KRN","B",.403,.403) + +"BLD",8180,"KRN","B",.5,.5) + +"BLD",8180,"KRN","B",.84,.84) + +"BLD",8180,"KRN","B",3.6,3.6) + +"BLD",8180,"KRN","B",3.8,3.8) + +"BLD",8180,"KRN","B",9.2,9.2) + +"BLD",8180,"KRN","B",9.8,9.8) + +"BLD",8180,"KRN","B",19,19) + +"BLD",8180,"KRN","B",19.1,19.1) + +"BLD",8180,"KRN","B",101,101) + +"BLD",8180,"KRN","B",409.61,409.61) + +"BLD",8180,"KRN","B",771,771) + +"BLD",8180,"KRN","B",779.2,779.2) + +"BLD",8180,"KRN","B",870,870) + +"BLD",8180,"KRN","B",8989.51,8989.51) + +"BLD",8180,"KRN","B",8989.52,8989.52) + +"BLD",8180,"KRN","B",8994,8994) + +"BLD",8180,"QUES",0) +^9.62^^ +"BLD",8180,"REQB",0) +^9.611^^ +"MBREQ") +0 +"PKG",216,-1) +1^1 +"PKG",216,0) +VISTA SMART CONTAINER^C0S^RDF Server for Harvard's Smart Data Model +"PKG",216,20,0) +^9.402P^^ +"PKG",216,22,0) +^9.49I^1^1 +"PKG",216,22,1,0) +1.0^3121013^3121011^77 +"PKG",216,22,1,1,0) +^^1^1^3121013 +"PKG",216,22,1,1,1,0) +Version 1.0 +"PKG",216,"DEV") +GPL/WV +"PKG",216,"VERSION") +1.0 +"QUES","XPF1",0) +Y +"QUES","XPF1","??") +^D REP^XPDH +"QUES","XPF1","A") +Shall I write over your |FLAG| File +"QUES","XPF1","B") +YES +"QUES","XPF1","M") +D XPF1^XPDIQ +"QUES","XPF2",0) +Y +"QUES","XPF2","??") +^D DTA^XPDH +"QUES","XPF2","A") +Want my data |FLAG| yours +"QUES","XPF2","B") +YES +"QUES","XPF2","M") +D XPF2^XPDIQ +"QUES","XPI1",0) +YO +"QUES","XPI1","??") +^D INHIBIT^XPDH +"QUES","XPI1","A") +Want KIDS to INHIBIT LOGONs during the install +"QUES","XPI1","B") +NO +"QUES","XPI1","M") +D XPI1^XPDIQ +"QUES","XPM1",0) +PO^VA(200,:EM +"QUES","XPM1","??") +^D MG^XPDH +"QUES","XPM1","A") +Enter the Coordinator for Mail Group '|FLAG|' +"QUES","XPM1","B") + +"QUES","XPM1","M") +D XPM1^XPDIQ +"QUES","XPO1",0) +Y +"QUES","XPO1","??") +^D MENU^XPDH +"QUES","XPO1","A") +Want KIDS to Rebuild Menu Trees Upon Completion of Install +"QUES","XPO1","B") +NO +"QUES","XPO1","M") +D XPO1^XPDIQ +"QUES","XPZ1",0) +Y +"QUES","XPZ1","??") +^D OPT^XPDH +"QUES","XPZ1","A") +Want to DISABLE Scheduled Options, Menu Options, and Protocols +"QUES","XPZ1","B") +NO +"QUES","XPZ1","M") +D XPZ1^XPDIQ +"QUES","XPZ2",0) +Y +"QUES","XPZ2","??") +^D RTN^XPDH +"QUES","XPZ2","A") +Want to MOVE routines to other CPUs +"QUES","XPZ2","B") +NO +"QUES","XPZ2","M") +D XPZ2^XPDIQ +"RTN") +13 +"RTN","C0SDEM") +0^1^B59022362 +"RTN","C0SDEM",1,0) +C0SDEM ; GPL - Smart Demographics Processing ;2/22/12 17:05 +"RTN","C0SDEM",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SDEM",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SDEM",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SDEM",5,0) + ; +"RTN","C0SDEM",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SDEM",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SDEM",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SDEM",9,0) + ;(at your option) any later version. +"RTN","C0SDEM",10,0) + ; +"RTN","C0SDEM",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SDEM",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SDEM",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SDEM",14,0) + ;GNU General Public License for more details. +"RTN","C0SDEM",15,0) + ; +"RTN","C0SDEM",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SDEM",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SDEM",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SDEM",19,0) + ; +"RTN","C0SDEM",20,0) + Q +"RTN","C0SDEM",21,0) + ; +"RTN","C0SDEM",22,0) + ; +"RTN","C0SDEM",23,0) + ; +"RTN","C0SDEM",29,0) + ; +"RTN","C0SDEM",30,0) + ; +"RTN","C0SDEM",31,0) + ; +"RTN","C0SDEM",32,0) + ; +"RTN","C0SDEM",33,0) + ; Bob +"RTN","C0SDEM",34,0) + ; J +"RTN","C0SDEM",35,0) + ; Odenkirk +"RTN","C0SDEM",36,0) + ; +"RTN","C0SDEM",37,0) + ; +"RTN","C0SDEM",38,0) + ; +"RTN","C0SDEM",39,0) + ; +"RTN","C0SDEM",40,0) + ; +"RTN","C0SDEM",41,0) + ; +"RTN","C0SDEM",42,0) + ; +"RTN","C0SDEM",43,0) + ; +"RTN","C0SDEM",44,0) + ; 15 Main St +"RTN","C0SDEM",45,0) + ; Apt 2 +"RTN","C0SDEM",46,0) + ; Wonderland +"RTN","C0SDEM",47,0) + ; OZ +"RTN","C0SDEM",48,0) + ; 54321 +"RTN","C0SDEM",49,0) + ; USA +"RTN","C0SDEM",50,0) + ; +"RTN","C0SDEM",51,0) + ; +"RTN","C0SDEM",52,0) + ; +"RTN","C0SDEM",53,0) + ; +"RTN","C0SDEM",54,0) + ; +"RTN","C0SDEM",55,0) + ; +"RTN","C0SDEM",56,0) + ; +"RTN","C0SDEM",57,0) + ; 800-555-1212 +"RTN","C0SDEM",58,0) + ; +"RTN","C0SDEM",59,0) + ; +"RTN","C0SDEM",60,0) + ; +"RTN","C0SDEM",61,0) + ; +"RTN","C0SDEM",62,0) + ; +"RTN","C0SDEM",63,0) + ; +"RTN","C0SDEM",64,0) + ; 800-555-1515 +"RTN","C0SDEM",65,0) + ; +"RTN","C0SDEM",66,0) + ; +"RTN","C0SDEM",67,0) + ; +"RTN","C0SDEM",68,0) + ; male +"RTN","C0SDEM",69,0) + ; 1959-12-25 +"RTN","C0SDEM",70,0) + ; bob.odenkirk@example.com +"RTN","C0SDEM",71,0) + ; +"RTN","C0SDEM",72,0) + ; +"RTN","C0SDEM",73,0) + ; +"RTN","C0SDEM",74,0) + ; My Hospital Record 2304575 +"RTN","C0SDEM",75,0) + ; 2304575 +"RTN","C0SDEM",76,0) + ; My Hospital Record +"RTN","C0SDEM",77,0) + ; +"RTN","C0SDEM",78,0) + ; +"RTN","C0SDEM",79,0) + ; +"RTN","C0SDEM",80,0) + ; +"RTN","C0SDEM",81,0) + ; +"RTN","C0SDEM",82,0) + ; +"RTN","C0SDEM",88,0) + ; +"RTN","C0SDEM",89,0) + ; +"RTN","C0SDEM",90,0) + ; +"RTN","C0SDEM",91,0) + ; +"RTN","C0SDEM",92,0) + ; Bob +"RTN","C0SDEM",93,0) + ; J +"RTN","C0SDEM",94,0) + ; Odenkirk +"RTN","C0SDEM",95,0) + ; +"RTN","C0SDEM",96,0) + ; +"RTN","C0SDEM",97,0) + ; +"RTN","C0SDEM",98,0) + ; +"RTN","C0SDEM",99,0) + ; +"RTN","C0SDEM",100,0) + ; +"RTN","C0SDEM",101,0) + ; +"RTN","C0SDEM",102,0) + ; +"RTN","C0SDEM",103,0) + ; 15 Main St +"RTN","C0SDEM",104,0) + ; Apt 2 +"RTN","C0SDEM",105,0) + ; Wonderland +"RTN","C0SDEM",106,0) + ; OZ +"RTN","C0SDEM",107,0) + ; 54321 +"RTN","C0SDEM",108,0) + ; USA +"RTN","C0SDEM",109,0) + ; +"RTN","C0SDEM",110,0) + ; +"RTN","C0SDEM",111,0) + ; +"RTN","C0SDEM",112,0) + ; +"RTN","C0SDEM",113,0) + ; +"RTN","C0SDEM",114,0) + ; +"RTN","C0SDEM",115,0) + ; +"RTN","C0SDEM",116,0) + ; 800-555-1212 +"RTN","C0SDEM",117,0) + ; +"RTN","C0SDEM",118,0) + ; +"RTN","C0SDEM",119,0) + ; +"RTN","C0SDEM",120,0) + ; +"RTN","C0SDEM",121,0) + ; +"RTN","C0SDEM",122,0) + ; +"RTN","C0SDEM",123,0) + ; 800-555-1515 +"RTN","C0SDEM",124,0) + ; +"RTN","C0SDEM",125,0) + ; +"RTN","C0SDEM",126,0) + ; +"RTN","C0SDEM",127,0) + ; male +"RTN","C0SDEM",128,0) + ; 1959-12-25 +"RTN","C0SDEM",129,0) + ; bob.odenkirk@example.com +"RTN","C0SDEM",130,0) + ; +"RTN","C0SDEM",131,0) + ; +"RTN","C0SDEM",132,0) + ; +"RTN","C0SDEM",133,0) + ; My Hospital Record 2304575 +"RTN","C0SDEM",134,0) + ; 2304575 +"RTN","C0SDEM",135,0) + ; My Hospital Record +"RTN","C0SDEM",136,0) + ; +"RTN","C0SDEM",137,0) + ; +"RTN","C0SDEM",138,0) + ; +"RTN","C0SDEM",139,0) + ; +"RTN","C0SDEM",140,0) + ; +"RTN","C0SDEM",141,0) + ;G(1)="nodeID:25591^rdf:type^v:Home" +"RTN","C0SDEM",142,0) + ;G(2)="nodeID:25591^rdf:type^v:Pref" +"RTN","C0SDEM",143,0) + ;G(3)="nodeID:25591^rdf:type^v:Tel" +"RTN","C0SDEM",144,0) + ;G(4)="nodeID:25591^rdf:value^800-369-6403" +"RTN","C0SDEM",145,0) + ;G(5)="nodeID:25611^rdf:type^v:Name" +"RTN","C0SDEM",146,0) + ;G(6)="nodeID:25611^v:additional-name^N" +"RTN","C0SDEM",147,0) + ;G(7)="nodeID:25611^v:family-name^Brooks" +"RTN","C0SDEM",148,0) + ;G(8)="nodeID:25611^v:given-name^Brian" +"RTN","C0SDEM",149,0) + ;G(9)="nodeID:25622^dcterms:identifier^981968" +"RTN","C0SDEM",150,0) + ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968" +"RTN","C0SDEM",151,0) + ;G(11)="nodeID:25622^rdf:type^sp:Code" +"RTN","C0SDEM",152,0) + ;G(12)="nodeID:25622^sp:system^My Hospital Record" +"RTN","C0SDEM",153,0) + ;G(13)="nodeID:25623^rdf:type^v:Address" +"RTN","C0SDEM",154,0) + ;G(14)="nodeID:25623^rdf:type^v:Home" +"RTN","C0SDEM",155,0) + ;G(15)="nodeID:25623^rdf:type^v:Pref" +"RTN","C0SDEM",156,0) + ;G(16)="nodeID:25623^v:locality^Bixby" +"RTN","C0SDEM",157,0) + ;G(17)="nodeID:25623^v:postal-code^74008" +"RTN","C0SDEM",158,0) + ;G(18)="nodeID:25623^v:region^OK" +"RTN","C0SDEM",159,0) + ;G(19)="nodeID:25623^v:street-address^82 Lake St" +"RTN","C0SDEM",160,0) + ;G(20)="smart:981968/demographics^foaf:gender^male" +"RTN","C0SDEM",161,0) + ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics" +"RTN","C0SDEM",162,0) + ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968" +"RTN","C0SDEM",163,0) + ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622" +"RTN","C0SDEM",164,0) + ;G(24)="smart:981968/demographics^v:adr^nodeID:25623" +"RTN","C0SDEM",165,0) + ;G(25)="smart:981968/demographics^v:bday^1956-03-23" +"RTN","C0SDEM",166,0) + ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com" +"RTN","C0SDEM",167,0) + ;G(27)="smart:981968/demographics^v:n^nodeID:25611" +"RTN","C0SDEM",168,0) + ;G(28)="smart:981968/demographics^v:tel^nodeID:25591" +"RTN","C0SDEM",169,0) + Q +"RTN","C0SDEM",170,0) + ; +"RTN","C0SDEM",171,0) +PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, +"RTN","C0SDEM",172,0) + ; is the return name of the graph created. "" if none +"RTN","C0SDEM",173,0) + ; C0SARY is passed in by reference and is the NHIN array of patient +"RTN","C0SDEM",174,0) + ; +"RTN","C0SDEM",175,0) + I $O(C0SARY("patient",""))="" D Q ; +"RTN","C0SDEM",176,0) + . I $D(DEBUG) W !,"No Patient array" +"RTN","C0SDEM",177,0) + . S GRTN="" +"RTN","C0SDEM",178,0) + S GRTN="" ; default to no patient +"RTN","C0SDEM",179,0) + N C0SGRF +"RTN","C0SDEM",180,0) + S C0SGRF="vistaSmart:"_ZPATID_"/patient" +"RTN","C0SDEM",181,0) + S ZPAT=C0SGRF ; subject is the same as the graph name +"RTN","C0SDEM",182,0) + I $D(DEBUG) W !,"Processing ",C0SGRF +"RTN","C0SDEM",183,0) + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph +"RTN","C0SDEM",184,0) + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use +"RTN","C0SDEM",185,0) + N FARY S FARY="C0XFARY" +"RTN","C0SDEM",186,0) + D USEFARY^C0XF2N(FARY) +"RTN","C0SDEM",187,0) + D VOCINIT^C0XUTIL +"RTN","C0SDEM",188,0) + ; +"RTN","C0SDEM",189,0) + N ZPN,ZR +"RTN","C0SDEM",190,0) + D STARTADD^C0XF2N +"RTN","C0SDEM",191,0) + ; +"RTN","C0SDEM",192,0) + ; First do the base demographic graph +"RTN","C0SDEM",193,0) + ; +"RTN","C0SDEM",194,0) + S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient +"RTN","C0SDEM",195,0) + N SEX S SEX=$G(@ZPN@("gender@value")) +"RTN","C0SDEM",196,0) + I SEX="M" S SEX="male" +"RTN","C0SDEM",197,0) + I SEX="F" S SEX="female" +"RTN","C0SDEM",198,0) + S ZR("foaf:gender")=SEX +"RTN","C0SDEM",199,0) + S ZR("rdf:type")="sp:Demographics" +"RTN","C0SDEM",200,0) + S ZR("sp:belongsTo")=ZPAT +"RTN","C0SDEM",201,0) + N PATIENT +"RTN","C0SDEM",202,0) + S PATIENT=$P(ZPAT,"#",2) +"RTN","C0SDEM",203,0) + I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT +"RTN","C0SDEM",204,0) + N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph +"RTN","C0SDEM",205,0) + S ZR("sp:medicalRecordNumber")=NMREC +"RTN","C0SDEM",206,0) + N NVADR S NVADR=$$ANONS^C0XF2N ; for address +"RTN","C0SDEM",207,0) + S ZR("v:adr")=NVADR +"RTN","C0SDEM",208,0) + N NNAME S NNAME=$$ANONS^C0XF2N ; for name +"RTN","C0SDEM",209,0) + S ZR("v:n")=NNAME +"RTN","C0SDEM",210,0) + N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone +"RTN","C0SDEM",211,0) + I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists +"RTN","C0SDEM",212,0) + N BDATE +"RTN","C0SDEM",213,0) + S ZX="" +"RTN","C0SDEM",214,0) + S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format +"RTN","C0SDEM",215,0) + S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date +"RTN","C0SDEM",216,0) + S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens +"RTN","C0SDEM",217,0) + I BDATE="" S BDATE="UNKNOWN" +"RTN","C0SDEM",218,0) + N Z2,Z3 +"RTN","C0SDEM",219,0) + S Z2=$P(BDATE,"-",2) +"RTN","C0SDEM",220,0) + S Z3=$P(BDATE,"-",3) +"RTN","C0SDEM",221,0) + I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2 +"RTN","C0SDEM",222,0) + I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3 +"RTN","C0SDEM",223,0) + S ZR("v:bday")=BDATE +"RTN","C0SDEM",224,0) + I $D(C0SVISTA) D ; +"RTN","C0SDEM",225,0) + . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN +"RTN","C0SDEM",226,0) + . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN +"RTN","C0SDEM",227,0) + D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph +"RTN","C0SDEM",228,0) + K ZR +"RTN","C0SDEM",229,0) + ; +"RTN","C0SDEM",230,0) + ; create address sub-graph +"RTN","C0SDEM",231,0) + ; +"RTN","C0SDEM",232,0) + S ZR("rdf:type")="v:Address" +"RTN","C0SDEM",233,0) + S ZR("rdf:type")="v:Home" +"RTN","C0SDEM",234,0) + S ZR("v:locality")=$G(@ZPN@("address@city")) +"RTN","C0SDEM",235,0) + S ZR("v:postal-code")=$G(@ZPN@("address@postalCode")) +"RTN","C0SDEM",236,0) + S ZR("v:region")=$G(@ZPN@("address@stateProvince")) +"RTN","C0SDEM",237,0) + S ZR("v:street-address")=$G(@ZPN@("address@streetLine1")) +"RTN","C0SDEM",238,0) + D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address +"RTN","C0SDEM",239,0) + K ZR +"RTN","C0SDEM",240,0) + ; +"RTN","C0SDEM",241,0) + ; create medical record subgraph +"RTN","C0SDEM",242,0) + ; +"RTN","C0SDEM",243,0) + S ZR("dcterms:identifier")=$G(@ZPN@("id@value")) +"RTN","C0SDEM",244,0) + S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier") +"RTN","C0SDEM",245,0) + S ZR("rdf:type")="sp:Code" +"RTN","C0SDEM",246,0) + S ZR("sp:system")="VistA Patient Record" +"RTN","C0SDEM",247,0) + D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph +"RTN","C0SDEM",248,0) + K ZR +"RTN","C0SDEM",249,0) + ; +"RTN","C0SDEM",250,0) + ; create name subgraph +"RTN","C0SDEM",251,0) + ; +"RTN","C0SDEM",252,0) + N ZNF,ZNL,ZNM,ZNAM +"RTN","C0SDEM",253,0) + S ZR("rdf:type")="v:Name" +"RTN","C0SDEM",254,0) + S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names +"RTN","C0SDEM",255,0) + S ZNF=$P(ZX," ",1) ; first name is first piece +"RTN","C0SDEM",256,0) + S ZNM=$P(ZX," ",2) ; middle names are the rest +"RTN","C0SDEM",257,0) + S ZR("v:additional-name")=ZNM +"RTN","C0SDEM",258,0) + S ZR("v:family-name")=$G(@ZPN@("familyName@value")) +"RTN","C0SDEM",259,0) + S ZR("v:given-name")=ZNF +"RTN","C0SDEM",260,0) + D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph +"RTN","C0SDEM",261,0) + K ZR +"RTN","C0SDEM",262,0) + ; +"RTN","C0SDEM",263,0) + ; create telephone subgraph +"RTN","C0SDEM",264,0) + ; +"RTN","C0SDEM",265,0) + D ; +"RTN","C0SDEM",266,0) + . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value")) +"RTN","C0SDEM",267,0) + . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph +"RTN","C0SDEM",268,0) + . S ZR("rdf:type")="v:Tel" +"RTN","C0SDEM",269,0) + . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR) +"RTN","C0SDEM",270,0) + K ZR +"RTN","C0SDEM",271,0) + ; +"RTN","C0SDEM",272,0) + ; load the demographics graph and all sub graphs to the triple store +"RTN","C0SDEM",273,0) + ; +"RTN","C0SDEM",274,0) + D BULKLOAD^C0XF2N(.C0XFDA) +"RTN","C0SDEM",275,0) + S GRTN=C0SGRF +"RTN","C0SDEM",276,0) + Q +"RTN","C0SDEM",277,0) + ; +"RTN","C0SDEM",278,0) +AGES ; LIST ALL PATIENTS AND THEIR AGES +"RTN","C0SDEM",279,0) + N ZI S ZI=0 +"RTN","C0SDEM",280,0) + F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT +"RTN","C0SDEM",281,0) + . N ZDOB +"RTN","C0SDEM",282,0) + . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB +"RTN","C0SDEM",283,0) + . N ZNAME +"RTN","C0SDEM",284,0) + . S ZNAME=$P(^DPT(ZI,0),U) +"RTN","C0SDEM",285,0) + . N ZSEX +"RTN","C0SDEM",286,0) + . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX") +"RTN","C0SDEM",287,0) + . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX +"RTN","C0SDEM",288,0) + Q +"RTN","C0SDEM",289,0) + ; +"RTN","C0SDOM") +0^2^B87367162 +"RTN","C0SDOM",1,0) +C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05 +"RTN","C0SDOM",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SDOM",3,0) + ;Copyright 2011,2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SDOM",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SDOM",5,0) + ; +"RTN","C0SDOM",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SDOM",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SDOM",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SDOM",9,0) + ;(at your option) any later version. +"RTN","C0SDOM",10,0) + ; +"RTN","C0SDOM",11,0) + +"RTN","C0SDOM",12,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SDOM",13,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SDOM",14,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SDOM",15,0) + ;GNU General Public License for more details. +"RTN","C0SDOM",16,0) + ; +"RTN","C0SDOM",17,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SDOM",18,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SDOM",19,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SDOM",20,0) + ; +"RTN","C0SDOM",21,0) + Q +"RTN","C0SDOM",22,0) + ; +"RTN","C0SDOM",23,0) +DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE +"RTN","C0SDOM",24,0) + ; THE XPATH INDEX ZXIDX, PASSED BY NAME +"RTN","C0SDOM",25,0) + ; THE XPATH ARRAY XPARY, PASSED BY NAME +"RTN","C0SDOM",26,0) + ; ZOID IS THE STARTING OID +"RTN","C0SDOM",27,0) + ; ZPATH IS THE STARTING XPATH, USUALLY "/" +"RTN","C0SDOM",28,0) + ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE +"RTN","C0SDOM",29,0) + ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT +"RTN","C0SDOM",30,0) + I $G(ZREDUX)="" S ZREDUX="" +"RTN","C0SDOM",31,0) + N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY +"RTN","C0SDOM",32,0) + N NEWNUM S NEWNUM="" +"RTN","C0SDOM",33,0) + I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" +"RTN","C0SDOM",34,0) + S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE +"RTN","C0SDOM",35,0) + I $G(ZREDUX)'="" D ; REDUX PROVIDED? +"RTN","C0SDOM",36,0) + . N GT S GT=$P(NEWPATH,ZREDUX,2) +"RTN","C0SDOM",37,0) + . I GT'="" S NEWPATH=GT +"RTN","C0SDOM",38,0) + S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX +"RTN","C0SDOM",39,0) + N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE +"RTN","C0SDOM",40,0) + I $D(GA) D ; PROCESS THE ATTRIBUTES +"RTN","C0SDOM",41,0) + . N ZI S ZI="" +"RTN","C0SDOM",42,0) + . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE +"RTN","C0SDOM",43,0) + . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE +"RTN","C0SDOM",44,0) + . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY +"RTN","C0SDOM",45,0) + . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE +"RTN","C0SDOM",46,0) + N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE +"RTN","C0SDOM",47,0) + I $D(GD(2)) D ; +"RTN","C0SDOM",48,0) + . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY +"RTN","C0SDOM",49,0) + E I $D(GD(1)) D ; +"RTN","C0SDOM",50,0) + . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY +"RTN","C0SDOM",51,0) + . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY +"RTN","C0SDOM",52,0) + N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD +"RTN","C0SDOM",53,0) + I ZFRST'=0 D ; THERE IS A CHILD +"RTN","C0SDOM",54,0) + . N ZNUM +"RTN","C0SDOM",55,0) + . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE +"RTN","C0SDOM",56,0) + . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD +"RTN","C0SDOM",57,0) + N GNXT S GNXT=$$NXTSIB(ZOID) +"RTN","C0SDOM",58,0) + I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES +"RTN","C0SDOM",59,0) + I GNXT'=0 D ; +"RTN","C0SDOM",60,0) + . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? +"RTN","C0SDOM",61,0) + . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES +"RTN","C0SDOM",62,0) + . . N ZNUM S ZNUM=1 ; +"RTN","C0SDOM",63,0) + . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB +"RTN","C0SDOM",64,0) + . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB +"RTN","C0SDOM",65,0) + Q +"RTN","C0SDOM",66,0) + ; +"RTN","C0SDOM",67,0) +ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY +"RTN","C0SDOM",68,0) + ; +"RTN","C0SDOM",69,0) + ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES +"RTN","C0SDOM",70,0) + ; +"RTN","C0SDOM",71,0) + N ZZI,ZZJ,ZZN +"RTN","C0SDOM",72,0) + S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY +"RTN","C0SDOM",73,0) + I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE +"RTN","C0SDOM",74,0) + S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY +"RTN","C0SDOM",75,0) + S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . +"RTN","C0SDOM",76,0) + I ZZI'["]" D ; A SINGLETON +"RTN","C0SDOM",77,0) + . S ZZN=1 +"RTN","C0SDOM",78,0) + E D ; THERE IS AN [x] OCCURANCE +"RTN","C0SDOM",79,0) + . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE +"RTN","C0SDOM",80,0) + . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] +"RTN","C0SDOM",81,0) + I ZZJ'="" D ; TIME TO ADD THE VALUE +"RTN","C0SDOM",82,0) + . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE +"RTN","C0SDOM",83,0) + Q +"RTN","C0SDOM",84,0) + ; +"RTN","C0SDOM",85,0) +PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME +"RTN","C0SDOM",86,0) + ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW +"RTN","C0SDOM",87,0) + ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML +"RTN","C0SDOM",88,0) + ;Q $$EN^MXMLDOM(INXML) +"RTN","C0SDOM",89,0) + Q $$EN^MXMLDOM(INXML,"W") +"RTN","C0SDOM",90,0) + ; +"RTN","C0SDOM",91,0) +ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE +"RTN","C0SDOM",92,0) + N ZN +"RTN","C0SDOM",93,0) + ;I $$TAG(ZOID)["entry" B +"RTN","C0SDOM",94,0) + S ZN=$$NXTSIB(ZOID) +"RTN","C0SDOM",95,0) + I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG +"RTN","C0SDOM",96,0) + Q 0 +"RTN","C0SDOM",97,0) + ; +"RTN","C0SDOM",98,0) +FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID +"RTN","C0SDOM",99,0) + Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SDOM",100,0) + ; +"RTN","C0SDOM",101,0) +PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID +"RTN","C0SDOM",102,0) + Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SDOM",103,0) + ; +"RTN","C0SDOM",104,0) +ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID +"RTN","C0SDOM",105,0) + S HANDLE=C0SDOCID +"RTN","C0SDOM",106,0) + K @RTN +"RTN","C0SDOM",107,0) + D GETTXT^MXMLDOM("A") +"RTN","C0SDOM",108,0) + Q +"RTN","C0SDOM",109,0) + ; +"RTN","C0SDOM",110,0) +TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE +"RTN","C0SDOM",111,0) + ;I ZOID=149 B ;GPLTEST +"RTN","C0SDOM",112,0) + N X,Y +"RTN","C0SDOM",113,0) + S Y="" +"RTN","C0SDOM",114,0) + S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE +"RTN","C0SDOM",115,0) + I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y +"RTN","C0SDOM",116,0) + I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SDOM",117,0) + Q Y +"RTN","C0SDOM",118,0) + ; +"RTN","C0SDOM",119,0) +NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING +"RTN","C0SDOM",120,0) + Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SDOM",121,0) + ; +"RTN","C0SDOM",122,0) +DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE +"RTN","C0SDOM",123,0) + ;N ZT,ZN S ZT="" +"RTN","C0SDOM",124,0) + ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) +"RTN","C0SDOM",125,0) + ;Q $G(@C0SDOM@(ZOID,"T",1)) +"RTN","C0SDOM",126,0) + S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) +"RTN","C0SDOM",127,0) + Q +"RTN","C0SDOM",128,0) + ; +"RTN","C0SDOM",129,0) +OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM +"RTN","C0SDOM",130,0) + ; +"RTN","C0SDOM",131,0) + S C0SDOCID=INID +"RTN","C0SDOM",132,0) + I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE 0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID +"RTN","C0SDOM",231,0) + E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL +"RTN","C0SDOM",232,0) + . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE +"RTN","C0SDOM",233,0) + . S ZPARNODE=1 ; +"RTN","C0SDOM",234,0) + ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET +"RTN","C0SDOM",235,0) + N ZEXARY +"RTN","C0SDOM",236,0) + D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY +"RTN","C0SDOM",237,0) + D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED +"RTN","C0SDOM",238,0) + I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE +"RTN","C0SDOM",239,0) + Q HANDLE ; SUCCESS +"RTN","C0SDOM",240,0) + ; +"RTN","C0SDOM",241,0) +MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES +"RTN","C0SDOM",242,0) + N ZI S ZI="" +"RTN","C0SDOM",243,0) + N ZTAG +"RTN","C0SDOM",244,0) + F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION +"RTN","C0SDOM",245,0) + . N ZELEADD S ZELEADD=0 +"RTN","C0SDOM",246,0) + . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES +"RTN","C0SDOM",247,0) + . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG +"RTN","C0SDOM",248,0) + . . K ZATT ; CLEAR OUT LAST ONE +"RTN","C0SDOM",249,0) + . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY +"RTN","C0SDOM",250,0) + . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE +"RTN","C0SDOM",251,0) + . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE +"RTN","C0SDOM",252,0) + . I $O(@ZARY@(ZI,""))="" D ;END NODE +"RTN","C0SDOM",253,0) + . . S ZTAG=ZI ; USE ZI FOR THE TAG +"RTN","C0SDOM",254,0) + . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE +"RTN","C0SDOM",255,0) + . . S ZELEADD=1 ; ADDED AN ELEMENT +"RTN","C0SDOM",256,0) + . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE +"RTN","C0SDOM",257,0) + . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL +"RTN","C0SDOM",258,0) + . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING +"RTN","C0SDOM",259,0) + . N NEWARY ; INDENTED ARRAY +"RTN","C0SDOM",260,0) + . N ZN S ZN=0 +"RTN","C0SDOM",261,0) + . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE +"RTN","C0SDOM",262,0) + . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG +"RTN","C0SDOM",263,0) + . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY +"RTN","C0SDOM",264,0) + . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY +"RTN","C0SDOM",265,0) + . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG +"RTN","C0SDOM",266,0) + Q +"RTN","C0SDOM",267,0) + ; +"RTN","C0SDOM",268,0) +EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED +"RTN","C0SDOM",269,0) + ; CONSISTENT FORMAT +"RTN","C0SDOM",270,0) + ; GNARY("patient",1,"facilities[2].facility@code")="050" +"RTN","C0SDOM",271,0) + ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" +"RTN","C0SDOM",272,0) + ; for easier processing (this is fileman format genius) +"RTN","C0SDOM",273,0) + ; basically removes the dot notation from the strings +"RTN","C0SDOM",274,0) + ; +"RTN","C0SDOM",275,0) + N ZZI +"RTN","C0SDOM",276,0) + S ZZI="" +"RTN","C0SDOM",277,0) + F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; +"RTN","C0SDOM",278,0) + . N ZZN S ZZN=0 +"RTN","C0SDOM",279,0) + . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; +"RTN","C0SDOM",280,0) + . . N ZZS S ZZS="" +"RTN","C0SDOM",281,0) + . . N GA ;PUSH STACK +"RTN","C0SDOM",282,0) + . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; +"RTN","C0SDOM",283,0) + . . . K GA ; NEW STACK +"RTN","C0SDOM",284,0) + . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT +"RTN","C0SDOM",285,0) + . . . N ZZV ; PLACE TO STASH THE VALUE +"RTN","C0SDOM",286,0) + . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE +"RTN","C0SDOM",287,0) + . . . W !,"VALUE:",ZZV +"RTN","C0SDOM",288,0) + . . . N GK ; COUNTER +"RTN","C0SDOM",289,0) + . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE +"RTN","C0SDOM",290,0) + . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] +"RTN","C0SDOM",291,0) + . . . . N GM S GM=$P(ZZS,".",GK) ; TAG +"RTN","C0SDOM",292,0) + . . . . I GM["[" D ; IT'S A MULTIPLE +"RTN","C0SDOM",293,0) + . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER +"RTN","C0SDOM",294,0) + . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG +"RTN","C0SDOM",295,0) + . . . . I GM["@" D ; IT'S GOT ATTRIBUTES +"RTN","C0SDOM",296,0) + . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME +"RTN","C0SDOM",297,0) + . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG +"RTN","C0SDOM",298,0) + . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2) +"RTN","C0SDOM",299,0) + . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ; +"RTN","C0SDOM",300,0) + . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" +"RTN","C0SDOM",301,0) + . . . N GZI S GZI="" ; STRING FOR THE INDEX +"RTN","C0SDOM",302,0) + . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS +"RTN","C0SDOM",303,0) + . . . . S GM=$P(GA(GK),"^",1) ; THE TAG +"RTN","C0SDOM",304,0) + . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY +"RTN","C0SDOM",305,0) + . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE +"RTN","C0SDOM",306,0) + . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST +"RTN","C0SDOM",307,0) + . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME +"RTN","C0SDOM",308,0) + . . . W !,GZI +"RTN","C0SDOM",309,0) + . . . S @GZI2=ZZV ; REMEMBER THE VALUE? +"RTN","C0SDOM",310,0) + Q +"RTN","C0SDOM",311,0) + ; +"RTN","C0SDOM",312,0) +NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE +"RTN","C0SDOM",313,0) + N CBK,SUCCESS,LEVEL,NODE,HANDLE +"RTN","C0SDOM",314,0) + K ^TMP("MXMLERR",$J) +"RTN","C0SDOM",315,0) + L +^TMP("MXMLDOM",$J):5 +"RTN","C0SDOM",316,0) + E Q 0 +"RTN","C0SDOM",317,0) + S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" +"RTN","C0SDOM",318,0) + L -^TMP("MXMLDOM",$J) +"RTN","C0SDOM",319,0) + Q HANDLE +"RTN","C0SDOM",320,0) + ; +"RTN","C0SLAB") +0^3^B79856252 +"RTN","C0SLAB",1,0) +C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 +"RTN","C0SLAB",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SLAB",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SLAB",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SLAB",5,0) + ; +"RTN","C0SLAB",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SLAB",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SLAB",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SLAB",9,0) + ;(at your option) any later version. +"RTN","C0SLAB",10,0) + ; +"RTN","C0SLAB",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SLAB",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SLAB",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SLAB",14,0) + ;GNU General Public License for more details. +"RTN","C0SLAB",15,0) + ; +"RTN","C0SLAB",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SLAB",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SLAB",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SLAB",19,0) + ; +"RTN","C0SLAB",20,0) + Q +"RTN","C0SLAB",21,0) + ; +"RTN","C0SLAB",22,0) + ; sample VistA NHIN lab result +"RTN","C0SLAB",23,0) + ; +"RTN","C0SLAB",24,0) + ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16 +"RTN","C0SLAB",25,0) + ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00" +"RTN","C0SLAB",26,0) + ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve" +"RTN","C0SLAB",27,0) + ;^TMP("C0STBL",32,"lab",8,"facility@code")=100 +"RTN","C0SLAB",28,0) + ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SLAB",29,0) + ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47" +"RTN","C0SLAB",30,0) + ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101" +"RTN","C0SLAB",31,0) + ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003" +"RTN","C0SLAB",32,0) + ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H" +"RTN","C0SLAB",33,0) + ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336 +"RTN","C0SLAB",34,0) + ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU" +"RTN","C0SLAB",35,0) + ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0" +"RTN","C0SLAB",36,0) + ;^TMP("C0STBL",32,"lab",8,"low@value")="69 " +"RTN","C0SLAB",37,0) + ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807 +"RTN","C0SLAB",38,0) + ;^TMP("C0STBL",32,"lab",8,"result@value")=178 +"RTN","C0SLAB",39,0) + ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006 +"RTN","C0SLAB",40,0) + ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM" +"RTN","C0SLAB",41,0) + ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500" +"RTN","C0SLAB",42,0) + ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM" +"RTN","C0SLAB",43,0) + ;^TMP("C0STBL",32,"lab",8,"status@value")="completed" +"RTN","C0SLAB",44,0) + ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE" +"RTN","C0SLAB",45,0) + ;^TMP("C0STBL",32,"lab",8,"type@value")="CH" +"RTN","C0SLAB",46,0) + ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL" +"RTN","C0SLAB",47,0) + ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342 +"RTN","C0SLAB",48,0) + ; +"RTN","C0SLAB",49,0) + ; sample Smart lab result triples +"RTN","C0SLAB",50,0) + ; +"RTN","C0SLAB",51,0) + ;G("loinc:29571-7","dcterms:identifier")="29571-7" +"RTN","C0SLAB",52,0) + ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql" +"RTN","C0SLAB",53,0) + ;G("loinc:29571-7","rdf:type")="sp:Code" +"RTN","C0SLAB",54,0) + ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/" +"RTN","C0SLAB",55,0) + ;G("loinc:38478-4","dcterms:identifier")="38478-4" +"RTN","C0SLAB",56,0) + ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql" +"RTN","C0SLAB",57,0) + ;G("loinc:38478-4","rdf:type")="sp:Code" +"RTN","C0SLAB",58,0) + ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/" +"RTN","C0SLAB",59,0) + ;G("qqWZZIew993","rdf:type")="sp:Attribution" +"RTN","C0SLAB",60,0) + ;G("qqWZZIew993","sp:startDate")="2007-04-21" +"RTN","C0SLAB",61,0) + ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult" +"RTN","C0SLAB",62,0) + ;G("qqWZZIew994","sp:value")="Normal" +"RTN","C0SLAB",63,0) + ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql" +"RTN","C0SLAB",64,0) + ;G("qqWZZIew995","rdf:type")="sp:CodedValue" +"RTN","C0SLAB",65,0) + ;G("qqWZZIew995","sp:code")="loinc:38478-4" +"RTN","C0SLAB",66,0) + ;G("qqWZZIew997","rdf:type")="sp:Attribution" +"RTN","C0SLAB",67,0) + ;G("qqWZZIew997","sp:startDate")="2007-09-08" +"RTN","C0SLAB",68,0) + ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult" +"RTN","C0SLAB",69,0) + ;G("qqWZZIew998","sp:value")="Normal" +"RTN","C0SLAB",70,0) + ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql" +"RTN","C0SLAB",71,0) + ;G("qqWZZIew999","rdf:type")="sp:CodedValue" +"RTN","C0SLAB",72,0) + ;G("qqWZZIew999","sp:code")="loinc:29571-7" +"RTN","C0SLAB",73,0) + ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult" +"RTN","C0SLAB",74,0) + ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345" +"RTN","C0SLAB",75,0) + ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995" +"RTN","C0SLAB",76,0) + ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994" +"RTN","C0SLAB",77,0) + ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993" +"RTN","C0SLAB",78,0) + ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult" +"RTN","C0SLAB",79,0) + ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345" +"RTN","C0SLAB",80,0) + ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999" +"RTN","C0SLAB",81,0) + ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998" +"RTN","C0SLAB",82,0) + ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997" +"RTN","C0SLAB",83,0) + ; +"RTN","C0SLAB",84,0) + ; +"RTN","C0SLAB",85,0) + ; another Smart example, this one with sp:quantitativeResult +"RTN","C0SLAB",86,0) + ; +"RTN","C0SLAB",87,0) + ;G("loinc:786-4","dcterms:identifier")="786-4" +"RTN","C0SLAB",88,0) + ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc" +"RTN","C0SLAB",89,0) + ;G("loinc:786-4","rdf:type")="sp:Code" +"RTN","C0SLAB",90,0) + ;G("loinc:786-4","sp:system")="http://loinc.org/codes/" +"RTN","C0SLAB",91,0) + ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit" +"RTN","C0SLAB",92,0) + ;G("nodeID:4439","sp:unit")="g/dL" +"RTN","C0SLAB",93,0) + ;G("nodeID:4439","sp:value")=36.6 +"RTN","C0SLAB",94,0) + ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit" +"RTN","C0SLAB",95,0) + ;G("nodeID:4613","sp:unit")="g/dL" +"RTN","C0SLAB",96,0) + ;G("nodeID:4613","sp:value")=32 +"RTN","C0SLAB",97,0) + ;G("nodeID:4672","rdf:type")="sp:Attribution" +"RTN","C0SLAB",98,0) + ;G("nodeID:4672","sp:startDate")="2005-03-10" +"RTN","C0SLAB",99,0) + ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit" +"RTN","C0SLAB",100,0) + ;G("nodeID:4866","sp:unit")="g/dL" +"RTN","C0SLAB",101,0) + ;G("nodeID:4866","sp:value")=36 +"RTN","C0SLAB",102,0) + ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc" +"RTN","C0SLAB",103,0) + ;G("nodeID:4871","rdf:type")="sp:CodedValue" +"RTN","C0SLAB",104,0) + ;G("nodeID:4871","sp:code")="loinc:786-4" +"RTN","C0SLAB",105,0) + ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult" +"RTN","C0SLAB",106,0) + ;G("nodeID:5221","sp:normalRange")="nodeID:5282" +"RTN","C0SLAB",107,0) + ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439" +"RTN","C0SLAB",108,0) + ;G("nodeID:5282","rdf:type")="sp:ValueRange" +"RTN","C0SLAB",109,0) + ;G("nodeID:5282","sp:maximum")="nodeID:4866" +"RTN","C0SLAB",110,0) + ;G("nodeID:5282","sp:minimum")="nodeID:4613" +"RTN","C0SLAB",111,0) + ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult" +"RTN","C0SLAB",112,0) + ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505" +"RTN","C0SLAB",113,0) + ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871" +"RTN","C0SLAB",114,0) + ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221" +"RTN","C0SLAB",115,0) + ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" +"RTN","C0SLAB",116,0) + ; +"RTN","C0SLAB",117,0) +LAB(GRTN,C0SARY) ; GRTN, passed by reference, +"RTN","C0SLAB",118,0) + ; is the return name of the graph created. "" if none +"RTN","C0SLAB",119,0) + ; C0SARY is passed in by reference and is the NHIN array of lab +"RTN","C0SLAB",120,0) + ; +"RTN","C0SLAB",121,0) + I $O(C0SARY("lab",""))="" D Q ; +"RTN","C0SLAB",122,0) + . I $D(DEBUG) W !,"No Labs" +"RTN","C0SLAB",123,0) + S GRTN="" ; default to no labs +"RTN","C0SLAB",124,0) + N C0SGRF +"RTN","C0SLAB",125,0) + S C0SGRF="vistaSmart:"_ZPATID_"/lab_results" +"RTN","C0SLAB",126,0) + I $D(DEBUG) W !,"Processing ",C0SGRF +"RTN","C0SLAB",127,0) + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph +"RTN","C0SLAB",128,0) + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use +"RTN","C0SLAB",129,0) + N FARY S FARY="C0XFARY" +"RTN","C0SLAB",130,0) + D USEFARY^C0XF2N(FARY) +"RTN","C0SLAB",131,0) + D VOCINIT^C0XUTIL +"RTN","C0SLAB",132,0) + ; +"RTN","C0SLAB",133,0) + D STARTADD^C0XF2N ; initialize to create triples +"RTN","C0SLAB",134,0) + ; +"RTN","C0SLAB",135,0) + N ZI S ZI="" +"RTN","C0SLAB",136,0) + F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ; +"RTN","C0SLAB",137,0) + . N LRN,ZR ; ZR is the local array for building the new triples +"RTN","C0SLAB",138,0) + . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result +"RTN","C0SLAB",139,0) + . ; +"RTN","C0SLAB",140,0) + . N RSLTID ; unique Id for this lab result +"RTN","C0SLAB",141,0) + . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number +"RTN","C0SLAB",142,0) + . ; +"RTN","C0SLAB",143,0) + . ; i don't like this because the same labs result gets a +"RTN","C0SLAB",144,0) + . ; different ID every time it's reported. Can't trace it back to VistA +"RTN","C0SLAB",145,0) + . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003" +"RTN","C0SLAB",146,0) + . ; .. either that or store an OID with the lab result - but that +"RTN","C0SLAB",147,0) + . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012 +"RTN","C0SLAB",148,0) + . ; +"RTN","C0SLAB",149,0) + . N LOINC S LOINC=$G(@LRN@("loinc@value")) +"RTN","C0SLAB",150,0) + . I LOINC="" D Q ; +"RTN","C0SLAB",151,0) + . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING" +"RTN","C0SLAB",152,0) + . N LABTST S LABTST=$G(@LRN@("test@value")) +"RTN","C0SLAB",153,0) + . I $D(DEBUG) D ; +"RTN","C0SLAB",154,0) + . . W !,"Processing Lab Result ",RSLTID +"RTN","C0SLAB",155,0) + . . W !,"test: ",LABTST +"RTN","C0SLAB",156,0) + . . W !,"loinc: ",LOINC +"RTN","C0SLAB",157,0) + . ; +"RTN","C0SLAB",158,0) + . ; first do the base result graph +"RTN","C0SLAB",159,0) + . ; +"RTN","C0SLAB",160,0) + . S ZR("rdf:type")="sp:LabResult" +"RTN","C0SLAB",161,0) + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results +"RTN","C0SLAB",162,0) + . ; ie /vista/smart/99912345/lab_results +"RTN","C0SLAB",163,0) + . ; +"RTN","C0SLAB",164,0) + . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name +"RTN","C0SLAB",165,0) + . S ZR("sp:labName")=LABNAME +"RTN","C0SLAB",166,0) + . ; +"RTN","C0SLAB",167,0) + . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result +"RTN","C0SLAB",168,0) + . S ZR("sp:narrativeResult")=NARRSLT +"RTN","C0SLAB",169,0) + . ; +"RTN","C0SLAB",170,0) + . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result +"RTN","C0SLAB",171,0) + . S ZR("sp:quantitativeResult")=QNTRSLT +"RTN","C0SLAB",172,0) + . ; +"RTN","C0SLAB",173,0) + . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected +"RTN","C0SLAB",174,0) + . S ZR("sp:specimenCollected")=SPECCOLL +"RTN","C0SLAB",175,0) + . ; +"RTN","C0SLAB",176,0) + . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples +"RTN","C0SLAB",177,0) + . K ZR ; clean up +"RTN","C0SLAB",178,0) + . ; +"RTN","C0SLAB",179,0) + . ; create the narrative result graph +"RTN","C0SLAB",180,0) + . ; +"RTN","C0SLAB",181,0) + . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L +"RTN","C0SLAB",182,0) + . I IVAL'="" +"RTN","C0SLAB",183,0) + . . S ZR("rdf:type")="sp:NarrativeResult" +"RTN","C0SLAB",184,0) + . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L +"RTN","C0SLAB",185,0) + . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal" +"RTN","C0SLAB",186,0) + . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal" +"RTN","C0SLAB",187,0) + . . I ZR("sp:value")="HH" S ZR("sp:value")="critical" +"RTN","C0SLAB",188,0) + . . I ZR("sp:value")="LL" S ZR("sp:value")="critical" +"RTN","C0SLAB",189,0) + . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR) +"RTN","C0SLAB",190,0) + . . K ZR +"RTN","C0SLAB",191,0) + . ; +"RTN","C0SLAB",192,0) + . ; create the quantitative result graph +"RTN","C0SLAB",193,0) + . ; +"RTN","C0SLAB",194,0) + . S ZR("rdf:type")="sp:QuantitativeResult" +"RTN","C0SLAB",195,0) + . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph +"RTN","C0SLAB",196,0) + . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph +"RTN","C0SLAB",197,0) + . N HASNORMAL S HASNORMAL=0 +"RTN","C0SLAB",198,0) + . I $G(@LRN@("high@value"))'="" S HASNORMAL=1 +"RTN","C0SLAB",199,0) + . I HASNORMAL S ZR("sp:normalRange")=NORMNM +"RTN","C0SLAB",200,0) + . S ZR("sp:valueAndUnit")=VUNM +"RTN","C0SLAB",201,0) + . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR) +"RTN","C0SLAB",202,0) + . K ZR +"RTN","C0SLAB",203,0) + . ; +"RTN","C0SLAB",204,0) + . ; create the normal range graph +"RTN","C0SLAB",205,0) + . ; +"RTN","C0SLAB",206,0) + . I HASNORMAL D ; +"RTN","C0SLAB",207,0) + . . S ZR("rdf:type")="sp:ValueRange" +"RTN","C0SLAB",208,0) + . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph +"RTN","C0SLAB",209,0) + . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph +"RTN","C0SLAB",210,0) + . . S ZR("sp:maximum")=MAXNM +"RTN","C0SLAB",211,0) + . . S ZR("sp:minimum")=MINNM +"RTN","C0SLAB",212,0) + . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR) +"RTN","C0SLAB",213,0) + . . K ZR +"RTN","C0SLAB",214,0) + . . ; +"RTN","C0SLAB",215,0) + . . ; create the maximum graph +"RTN","C0SLAB",216,0) + . . ; +"RTN","C0SLAB",217,0) + . . S ZR("rdf:type")="sp:ValueAndUnit" +"RTN","C0SLAB",218,0) + . . S ZR("sp:unit")=$G(@LRN@("units@value")) +"RTN","C0SLAB",219,0) + . . S ZR("sp:value")=$G(@LRN@("high@value")) +"RTN","C0SLAB",220,0) + . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR) +"RTN","C0SLAB",221,0) + . . K ZR +"RTN","C0SLAB",222,0) + . . ; +"RTN","C0SLAB",223,0) + . . ; create the minimum graph +"RTN","C0SLAB",224,0) + . . ; +"RTN","C0SLAB",225,0) + . . S ZR("rdf:type")="sp:ValueAndUnit" +"RTN","C0SLAB",226,0) + . . S ZR("sp:unit")=$G(@LRN@("units@value")) +"RTN","C0SLAB",227,0) + . . S ZR("sp:value")=$G(@LRN@("low@value")) +"RTN","C0SLAB",228,0) + . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR) +"RTN","C0SLAB",229,0) + . . K ZR +"RTN","C0SLAB",230,0) + . ; +"RTN","C0SLAB",231,0) + . ; create the value and unit graph +"RTN","C0SLAB",232,0) + . ; +"RTN","C0SLAB",233,0) + . S ZR("rdf:type")="sp:ValueAndUnit" +"RTN","C0SLAB",234,0) + . S ZR("sp:unit")=$G(@LRN@("units@value")) +"RTN","C0SLAB",235,0) + . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ; was $G(@LRN@("test@value")) gpl +"RTN","C0SLAB",236,0) + . S ZR("sp:value")=$G(@LRN@("result@value")) +"RTN","C0SLAB",237,0) + . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR) +"RTN","C0SLAB",238,0) + . K ZR +"RTN","C0SLAB",239,0) + . ; +"RTN","C0SLAB",240,0) + . ; create specimen collected graph +"RTN","C0SLAB",241,0) + . ; +"RTN","C0SLAB",242,0) + . S ZR("rdf:type")="sp:Attribution" +"RTN","C0SLAB",243,0) + . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value"))) +"RTN","C0SLAB",244,0) + . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR) +"RTN","C0SLAB",245,0) + . K ZR +"RTN","C0SLAB",246,0) + . ; +"RTN","C0SLAB",247,0) + . ; create lab name graph - this contains the test name and code +"RTN","C0SLAB",248,0) + . ; +"RTN","C0SLAB",249,0) + . I LOINC'="" D ; +"RTN","C0SLAB",250,0) + . . S ZR("rdf:type")="sp:CodedValue" +"RTN","C0SLAB",251,0) + . . S ZR("dcterms:title")=LABTST +"RTN","C0SLAB",252,0) + . . N LOINCNM S LOINCNM="loinc:"_LOINC +"RTN","C0SLAB",253,0) + . . S ZR("sp:code")="loinc:"_LOINC +"RTN","C0SLAB",254,0) + . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR) +"RTN","C0SLAB",255,0) + . . K ZR +"RTN","C0SLAB",256,0) + . . S ZR("dcterms:identifier")=LOINC +"RTN","C0SLAB",257,0) + . . S ZR("dcterms:title")=LABTST +"RTN","C0SLAB",258,0) + . . S ZR("rdf:type")="sp:Code" +"RTN","C0SLAB",259,0) + . . S ZR("sp:system")="http://loinc.org/codes/" +"RTN","C0SLAB",260,0) + . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR) +"RTN","C0SLAB",261,0) + . . K ZR +"RTN","C0SLAB",262,0) + . ; +"RTN","C0SLAB",263,0) + . ; that's all for now folks (there is more to do like reference ranges +"RTN","C0SLAB",264,0) + . ; and result values) +"RTN","C0SLAB",265,0) + . ; +"RTN","C0SLAB",266,0) + D BULKLOAD^C0XF2N(.C0XFDA) +"RTN","C0SLAB",267,0) + S GRTN=C0SGRF +"RTN","C0SLAB",268,0) + Q +"RTN","C0SLAB",269,0) + ; +"RTN","C0SLAB",270,0) +SAMPLE ; import sample lab tests to the triplestore +"RTN","C0SLAB",271,0) + N GN +"RTN","C0SLAB",272,0) + S GN=$NA(^rdf("lab_results")) +"RTN","C0SLAB",273,0) + D INSRDF^C0XF2N(GN,"/smart/lab/samples") +"RTN","C0SLAB",274,0) + Q +"RTN","C0SLAB",275,0) + ; +"RTN","C0SMART") +0^4^B2907401 +"RTN","C0SMART",1,0) +C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 +"RTN","C0SMART",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SMART",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SMART",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SMART",5,0) + ; +"RTN","C0SMART",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SMART",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SMART",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SMART",9,0) + ;(at your option) any later version. +"RTN","C0SMART",10,0) + ; +"RTN","C0SMART",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SMART",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SMART",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SMART",14,0) + ;GNU General Public License for more details. +"RTN","C0SMART",15,0) + ; +"RTN","C0SMART",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SMART",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SMART",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SMART",19,0) + ; +"RTN","C0SMART",20,0) + Q +"RTN","C0SMART",21,0) +EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP +"RTN","C0SMART",22,0) + ; for patient ZPATID; ZFORM defaults to rdf +"RTN","C0SMART",23,0) + ; ZRTN is passed by reference +"RTN","C0SMART",24,0) + ; For now, ZPATID is the DFN +"RTN","C0SMART",25,0) + ; +"RTN","C0SMART",26,0) + I '$D(ZFORM) S ZFORM="rdf" +"RTN","C0SMART",27,0) + K ZRTN ; CLEAN RETURN +"RTN","C0SMART",28,0) + N C0SARY +"RTN","C0SMART",29,0) + I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient") +"RTN","C0SMART",30,0) + E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP) +"RTN","C0SMART",31,0) + I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ; +"RTN","C0SMART",32,0) + . W !,"Error Retreiving Patient Record" +"RTN","C0SMART",33,0) + ; +"RTN","C0SMART",34,0) + K C0XFDA +"RTN","C0SMART",35,0) + ; +"RTN","C0SMART",36,0) + N C0SGR ; graph +"RTN","C0SMART",37,0) + ; +"RTN","C0SMART",38,0) + ; processing table +"RTN","C0SMART",39,0) + ; +"RTN","C0SMART",40,0) + N C0SCTRL +"RTN","C0SMART",41,0) + S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)" +"RTN","C0SMART",42,0) + S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)" +"RTN","C0SMART",43,0) + S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)" +"RTN","C0SMART",44,0) + S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)" +"RTN","C0SMART",45,0) + ; +"RTN","C0SMART",46,0) + I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ; +"RTN","C0SMART",47,0) + N ZX +"RTN","C0SMART",48,0) + S ZX=C0SCTRL(ZTYP) +"RTN","C0SMART",49,0) + X ZX ; +"RTN","C0SMART",50,0) + ; +"RTN","C0SMART",51,0) + I '$D(C0SGR) Q ; +"RTN","C0SMART",52,0) + ; +"RTN","C0SMART",53,0) + D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM) +"RTN","C0SMART",54,0) + ; +"RTN","C0SMART",55,0) + Q +"RTN","C0SMART",56,0) + ; +"RTN","C0SMED") +0^5^B40719083 +"RTN","C0SMED",1,0) +C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 +"RTN","C0SMED",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SMED",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SMED",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SMED",5,0) + ; +"RTN","C0SMED",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SMED",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SMED",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SMED",9,0) + ;(at your option) any later version. +"RTN","C0SMED",10,0) + ; +"RTN","C0SMED",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SMED",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SMED",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SMED",14,0) + ;GNU General Public License for more details. +"RTN","C0SMED",15,0) + ; +"RTN","C0SMED",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SMED",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SMED",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SMED",19,0) + ; +"RTN","C0SMED",20,0) + Q +"RTN","C0SMED",21,0) + ; +"RTN","C0SMED",22,0) +MED(GRTN,C0SARY) ; GRTN, passed by reference, +"RTN","C0SMED",23,0) + ; is the return name of the graph created. "" if none +"RTN","C0SMED",24,0) + ; C0SARY is passed in by reference and is the NHIN array of meds +"RTN","C0SMED",25,0) + ; +"RTN","C0SMED",26,0) + I $O(C0SARY("med",""))="" D Q ; +"RTN","C0SMED",27,0) + . I $D(DEBUG) W !,"No Meds" +"RTN","C0SMED",28,0) + S GRTN="" ; default to no meds +"RTN","C0SMED",29,0) + N C0SGRF +"RTN","C0SMED",30,0) + S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP +"RTN","C0SMED",31,0) + I $D(DEBUG) W !,"Processing ",C0SGRF +"RTN","C0SMED",32,0) + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph +"RTN","C0SMED",33,0) + N MEDTRP ; MEDS TRIPLES +"RTN","C0SMED",34,0) + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use +"RTN","C0SMED",35,0) + N FARY S FARY="C0XFARY" +"RTN","C0SMED",36,0) + D USEFARY^C0XF2N(FARY) +"RTN","C0SMED",37,0) + D VOCINIT^C0XUTIL +"RTN","C0SMED",38,0) + ; +"RTN","C0SMED",39,0) + N DUPCHK S DUPCHK="" ; check for no duplicates +"RTN","C0SMED",40,0) + N ZI S ZI="" +"RTN","C0SMED",41,0) + F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; +"RTN","C0SMED",42,0) + . N SDATE,SDTMP +"RTN","C0SMED",43,0) + . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; +"RTN","C0SMED",44,0) + . . I $D(DEBUG) W !,"Expired Mediation, Skipping" +"RTN","C0SMED",45,0) + . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; +"RTN","C0SMED",46,0) + . . I $D(DEBUG) W !,"Inpatient Med, skipping" +"RTN","C0SMED",47,0) + . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; +"RTN","C0SMED",48,0) + . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" +"RTN","C0SMED",49,0) + . ; +"RTN","C0SMED",50,0) + . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) +"RTN","C0SMED",51,0) + . I SDTMP="" D ; +"RTN","C0SMED",52,0) + . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) +"RTN","C0SMED",53,0) + . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date +"RTN","C0SMED",54,0) + . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens +"RTN","C0SMED",55,0) + . I SDATE="" S SDATE="UNKNOWN" +"RTN","C0SMED",56,0) + . N DNAME,VUID,DCODE,RXNORM,SIG +"RTN","C0SMED",57,0) + . S DNAME=$G(C0SARY("med",ZI,"name@value")) +"RTN","C0SMED",58,0) + . I DNAME="" D ; +"RTN","C0SMED",59,0) + . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) +"RTN","C0SMED",60,0) + . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) +"RTN","C0SMED",61,0) + . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) +"RTN","C0SMED",62,0) + . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) +"RTN","C0SMED",63,0) + . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code +"RTN","C0SMED",64,0) + . I $P(RXNORM,"^",2)="RXNORM" D ; +"RTN","C0SMED",65,0) + . . S RXVER=$P(RXNORM,"^",3) +"RTN","C0SMED",66,0) + . . S RXNORM=$P(RXNORM,"^",1) +"RTN","C0SMED",67,0) + . E D Q ; +"RTN","C0SMED",68,0) + . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" +"RTN","C0SMED",69,0) + . . I $D(DEBUG) W !,RXNORM +"RTN","C0SMED",70,0) + . I DNAME="" D Q ; +"RTN","C0SMED",71,0) + . . I $D(DEBUG) W !,"Error No Drug Name" +"RTN","C0SMED",72,0) + . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) +"RTN","C0SMED",73,0) + . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED +"RTN","C0SMED",74,0) + . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF +"RTN","C0SMED",75,0) + . S DUPCHK(MEDGRF)="" +"RTN","C0SMED",76,0) + . I $D(DEBUG) D ; +"RTN","C0SMED",77,0) + . . W !,"Processing Medication ",MEDGRF +"RTN","C0SMED",78,0) + . . W !,DNAME +"RTN","C0SMED",79,0) + . . W !,RXNORM +"RTN","C0SMED",80,0) + . S SIG=$G(C0SARY("med",ZI,"sig")) +"RTN","C0SMED",81,0) + . I SIG["|" D ; +"RTN","C0SMED",82,0) + . . N SIGTMP +"RTN","C0SMED",83,0) + . . S SIGTMP=SIG +"RTN","C0SMED",84,0) + . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig +"RTN","C0SMED",85,0) + . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig +"RTN","C0SMED",86,0) + . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig +"RTN","C0SMED",87,0) + . K C0XFARY +"RTN","C0SMED",88,0) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) +"RTN","C0SMED",89,0) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) +"RTN","C0SMED",90,0) + . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject +"RTN","C0SMED",91,0) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) +"RTN","C0SMED",92,0) + . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) +"RTN","C0SMED",93,0) + . N NQTY,NQTY2,NFREQ,NFREQ2 +"RTN","C0SMED",94,0) + . S NQTY=$$ANONS^C0XF2N ; anonomous subject +"RTN","C0SMED",95,0) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) +"RTN","C0SMED",96,0) + . S NQTY2=$$ANONS^C0XF2N ; anonomous subject +"RTN","C0SMED",97,0) + . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) +"RTN","C0SMED",98,0) + . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) +"RTN","C0SMED",99,0) + . I DOSE="" S DOSE="UNKNOWN" +"RTN","C0SMED",100,0) + . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) +"RTN","C0SMED",101,0) + . I UNIT="" S UNIT="UNKNOWN" +"RTN","C0SMED",102,0) + . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) +"RTN","C0SMED",103,0) + . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) +"RTN","C0SMED",104,0) + . S NFREQ=$$ANONS^C0XF2N ; anonomous subject +"RTN","C0SMED",105,0) + . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject +"RTN","C0SMED",106,0) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) +"RTN","C0SMED",107,0) + . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) +"RTN","C0SMED",108,0) + . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) +"RTN","C0SMED",109,0) + . I SCHED="" S SCHED="UNKNOWN" +"RTN","C0SMED",110,0) + . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) +"RTN","C0SMED",111,0) + . I SCHUNIT="" S SCHUNIT="UNKNOWN" +"RTN","C0SMED",112,0) + . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) +"RTN","C0SMED",113,0) + . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) +"RTN","C0SMED",114,0) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) +"RTN","C0SMED",115,0) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) +"RTN","C0SMED",116,0) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) +"RTN","C0SMED",117,0) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) +"RTN","C0SMED",118,0) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) +"RTN","C0SMED",119,0) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) +"RTN","C0SMED",120,0) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) +"RTN","C0SMED",121,0) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) +"RTN","C0SMED",122,0) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) +"RTN","C0SMED",123,0) + . D BULKLOAD^C0XF2N(.C0XFDA) +"RTN","C0SMED",124,0) + . K C0XFDA +"RTN","C0SMED",125,0) + S GRTN=C0SGRF +"RTN","C0SMED",126,0) + q +"RTN","C0SMED",127,0) + ; +"RTN","C0SMED",128,0) +RXNFN() Q 1130590011.001 ; RxNorm Concepts file number +"RTN","C0SMED",129,0) + ; +"RTN","C0SMED",130,0) +RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF +"RTN","C0SMED",131,0) + ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR +"RTN","C0SMED",132,0) + N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT +"RTN","C0SMED",133,0) + I $G(ZVUID)="" Q "" +"RTN","C0SMED",134,0) + I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED +"RTN","C0SMED",135,0) + N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") +"RTN","C0SMED",136,0) + S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES +"RTN","C0SMED",137,0) + N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) +"RTN","C0SMED",138,0) + S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED +"RTN","C0SMED",139,0) + I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" +"RTN","C0SMED",140,0) + Q ZRSLT +"RTN","C0SMED",141,0) + ; +"RTN","C0SMED",142,0) +NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO +"RTN","C0SMED",143,0) + ; CONFORM TO NIST REQUIREMENTS +"RTN","C0SMED",144,0) + ;INPATIENT CERTIFICATION +"RTN","C0SMED",145,0) + I ZRXN=309362 S ZRXN=213169 +"RTN","C0SMED",146,0) + I ZRXN=855318 S ZRXN=855320 +"RTN","C0SMED",147,0) + I ZRXN=197361 S ZRXN=212549 +"RTN","C0SMED",148,0) + ;OUTPATIENT CERTIFICATION +"RTN","C0SMED",149,0) + I ZRXN=310534 S ZRXN=205875 +"RTN","C0SMED",150,0) + I ZRXN=617312 S ZRXN=617314 +"RTN","C0SMED",151,0) + I ZRXN=310429 S ZRXN=200801 +"RTN","C0SMED",152,0) + I ZRXN=628953 S ZRXN=628958 +"RTN","C0SMED",153,0) + I ZRXN=745679 S ZRXN=630208 +"RTN","C0SMED",154,0) + I ZRXN=311564 S ZRXN=979334 +"RTN","C0SMED",155,0) + I ZRXN=836343 S ZRXN=836370 +"RTN","C0SMED",156,0) + Q ZRXN +"RTN","C0SMED",157,0) + ; +"RTN","C0SMXMLB") +0^6^B12189644 +"RTN","C0SMXMLB",1,0) +MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver. +"RTN","C0SMXMLB",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SMXMLB",3,0) + QUIT +"RTN","C0SMXMLB",4,0) + ; +"RTN","C0SMXMLB",5,0) + ;DOC - The top level tag +"RTN","C0SMXMLB",6,0) + ;DOCTYPE - Want to include a DOCTYPE node +"RTN","C0SMXMLB",7,0) + ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, +"RTN","C0SMXMLB",8,0) +START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. +"RTN","C0SMXMLB",9,0) + K ^TMP("MXMLBLD",$J) +"RTN","C0SMXMLB",10,0) + S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 +"RTN","C0SMXMLB",11,0) + I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 +"RTN","C0SMXMLB",12,0) + I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) +"RTN","C0SMXMLB",13,0) + D:$L($G(DOCTYPE)) OUTPUT("") D OUTPUT("<"_DOC_">") +"RTN","C0SMXMLB",14,0) + Q +"RTN","C0SMXMLB",15,0) + ; +"RTN","C0SMXMLB",16,0) +END ;Call this once to close out the document +"RTN","C0SMXMLB",17,0) + D OUTPUT("") +"RTN","C0SMXMLB",18,0) + I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) +"RTN","C0SMXMLB",19,0) + K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") +"RTN","C0SMXMLB",20,0) + Q +"RTN","C0SMXMLB",21,0) + ; +"RTN","C0SMXMLB",22,0) +ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item +"RTN","C0SMXMLB",23,0) + N I,X +"RTN","C0SMXMLB",24,0) + S ATT=$G(ATT) +"RTN","C0SMXMLB",25,0) + I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q +"RTN","C0SMXMLB",26,0) + D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"") +"RTN","C0SMXMLB",27,0) + Q +"RTN","C0SMXMLB",28,0) + ;DOITEM is a callback to output the lower level. +"RTN","C0SMXMLB",29,0) +MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule +"RTN","C0SMXMLB",30,0) + N I,X,S +"RTN","C0SMXMLB",31,0) + S ATT=$G(ATT) +"RTN","C0SMXMLB",32,0) + D PUSH($G(INDENT),TAG,.ATT) +"RTN","C0SMXMLB",33,0) + D @DOITEM +"RTN","C0SMXMLB",34,0) + D POP +"RTN","C0SMXMLB",35,0) + Q +"RTN","C0SMXMLB",36,0) + ; +"RTN","C0SMXMLB",37,0) +ATT(ATT) ;Output a string of attributes +"RTN","C0SMXMLB",38,0) + I $D(ATT)<9 Q "" +"RTN","C0SMXMLB",39,0) + N I,S,V +"RTN","C0SMXMLB",40,0) + S S="",I="" +"RTN","C0SMXMLB",41,0) + F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) +"RTN","C0SMXMLB",42,0) + Q S +"RTN","C0SMXMLB",43,0) + ; +"RTN","C0SMXMLB",44,0) +Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 +"RTN","C0SMXMLB",45,0) + ;I X'[$C(34) Q $C(34)_X_$C(34) +"RTN","C0SMXMLB",46,0) + I X'[$C(39) Q $C(39)_X_$C(39) +"RTN","C0SMXMLB",47,0) + ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" +"RTN","C0SMXMLB",48,0) + N Q,Y,I,Z S Q=$C(39),(Y,Z)="" +"RTN","C0SMXMLB",49,0) + F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q +"RTN","C0SMXMLB",50,0) + S Y=Y_$P(X,Q,$L(X,Q)) +"RTN","C0SMXMLB",51,0) + ;Q $C(34)_Y_$C(34) +"RTN","C0SMXMLB",52,0) + Q $C(39)_Y_$C(39) +"RTN","C0SMXMLB",53,0) + ; +"RTN","C0SMXMLB",54,0) +XMLHDR() ; -- provides current XML standard header +"RTN","C0SMXMLB",55,0) + Q "" +"RTN","C0SMXMLB",56,0) + ; +"RTN","C0SMXMLB",57,0) +OUTPUT(S) ;Output +"RTN","C0SMXMLB",58,0) + N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) +"RTN","C0SMXMLB",59,0) + I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q +"RTN","C0SMXMLB",60,0) + W S,! +"RTN","C0SMXMLB",61,0) + Q +"RTN","C0SMXMLB",62,0) + ; +"RTN","C0SMXMLB",63,0) +CHARCHK(STR) ; -- replace xml character limits with entities +"RTN","C0SMXMLB",64,0) + N A,I,X,Y,Z,NEWSTR +"RTN","C0SMXMLB",65,0) + S (Y,Z)="" +"RTN","C0SMXMLB",66,0) + ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z +"RTN","C0SMXMLB",67,0) + ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" +"RTN","C0SMXMLB",68,0) + I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) +"RTN","C0SMXMLB",69,0) + I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" +"RTN","C0SMXMLB",70,0) + I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" +"RTN","C0SMXMLB",71,0) + I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" +"RTN","C0SMXMLB",72,0) + I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" +"RTN","C0SMXMLB",73,0) + ; +"RTN","C0SMXMLB",74,0) + 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)) +"RTN","C0SMXMLB",75,0) + QUIT STR +"RTN","C0SMXMLB",76,0) + ; +"RTN","C0SMXMLB",77,0) +COMMENT(VAL) ;Add Comments +"RTN","C0SMXMLB",78,0) + N I,L +"RTN","C0SMXMLB",79,0) + ;I $D($G(VAL))=1 D OUTPUT("") Q +"RTN","C0SMXMLB",80,0) + I $D(VAL) D OUTPUT("") Q ;CHANGED BY GPL FOR GTM +"RTN","C0SMXMLB",81,0) + S I="",L="") +"RTN","C0SMXMLB",84,0) + Q +"RTN","C0SMXMLB",85,0) + ; +"RTN","C0SMXMLB",86,0) +PUSH(INDENT,TAG,ATT) ;Write a TAG and save. +"RTN","C0SMXMLB",87,0) + N CNT +"RTN","C0SMXMLB",88,0) + S ATT=$G(ATT) +"RTN","C0SMXMLB",89,0) + D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") +"RTN","C0SMXMLB",90,0) + S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG +"RTN","C0SMXMLB",91,0) + Q +"RTN","C0SMXMLB",92,0) + ; +"RTN","C0SMXMLB",93,0) +POP ;Write last pushed tag and pop +"RTN","C0SMXMLB",94,0) + N CNT,TAG,INDENT,X +"RTN","C0SMXMLB",95,0) + S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 +"RTN","C0SMXMLB",96,0) + S INDENT=+X,TAG=$P(X,"^",2) +"RTN","C0SMXMLB",97,0) + D OUTPUT($$BLS(INDENT)_"") +"RTN","C0SMXMLB",98,0) + Q +"RTN","C0SMXMLB",99,0) + ; +"RTN","C0SMXMLB",100,0) +BLS(I) ;Return INDENT string +"RTN","C0SMXMLB",101,0) + N S +"RTN","C0SMXMLB",102,0) + S S="",I=$G(I) S:I>0 $P(S," ",I)=" " +"RTN","C0SMXMLB",103,0) + Q S +"RTN","C0SMXMLB",104,0) + ; +"RTN","C0SMXMLB",105,0) +INDENT() ;Renturn indent level +"RTN","C0SMXMLB",106,0) + Q +$G(^TMP("MXMLBLD",$J,"STK")) +"RTN","C0SNHIN") +0^7^B88600644 +"RTN","C0SNHIN",1,0) +C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05 +"RTN","C0SNHIN",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SNHIN",3,0) + ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SNHIN",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SNHIN",5,0) + ; +"RTN","C0SNHIN",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SNHIN",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SNHIN",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SNHIN",9,0) + ;(at your option) any later version. +"RTN","C0SNHIN",10,0) + ; +"RTN","C0SNHIN",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SNHIN",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SNHIN",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SNHIN",14,0) + ;GNU General Public License for more details. +"RTN","C0SNHIN",15,0) + ; +"RTN","C0SNHIN",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SNHIN",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SNHIN",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SNHIN",19,0) + ; +"RTN","C0SNHIN",20,0) + Q +"RTN","C0SNHIN",21,0) +EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT +"RTN","C0SNHIN",22,0) + ; +"RTN","C0SNHIN",23,0) + K GARY,GNARY,GIDX,C0SDOCID +"RTN","C0SNHIN",24,0) + K ZRTN +"RTN","C0SNHIN",25,0) + N GN +"RTN","C0SNHIN",26,0) + K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL +"RTN","C0SNHIN",27,0) + K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM +"RTN","C0SNHIN",28,0) + K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS +"RTN","C0SNHIN",29,0) + D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML +"RTN","C0SNHIN",30,0) + S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL +"RTN","C0SNHIN",31,0) + S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML +"RTN","C0SNHIN",32,0) + D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS +"RTN","C0SNHIN",33,0) + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 +"RTN","C0SNHIN",34,0) + ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) +"RTN","C0SNHIN",35,0) + Q +"RTN","C0SNHIN",36,0) + ; +"RTN","C0SNHIN",37,0) +PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE +"RTN","C0SNHIN",38,0) + ; +"RTN","C0SNHIN",39,0) + N ZG +"RTN","C0SNHIN",40,0) + S ZG=$NA(^TMP("PQRIXML",$J)) +"RTN","C0SNHIN",41,0) + K @ZG +"RTN","C0SNHIN",42,0) + D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML +"RTN","C0SNHIN",43,0) + N C0SDOCID +"RTN","C0SNHIN",44,0) + S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML +"RTN","C0SNHIN",45,0) + D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS +"RTN","C0SNHIN",46,0) + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 +"RTN","C0SNHIN",47,0) + Q +"RTN","C0SNHIN",48,0) + ; +"RTN","C0SNHIN",49,0) +PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE +"RTN","C0SNHIN",50,0) + ; +"RTN","C0SNHIN",51,0) + ;N GG +"RTN","C0SNHIN",52,0) + D GETXML^C0SMXP("GG","PQRI ONE MEASURE") +"RTN","C0SNHIN",53,0) + D PROCESS(ZRTN,"GG","root",1) +"RTN","C0SNHIN",54,0) + Q +"RTN","C0SNHIN",55,0) + ; +"RTN","C0SNHIN",56,0) +PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML +"RTN","C0SNHIN",57,0) + ; ZRTN IS PASSED BY REFERENCE +"RTN","C0SNHIN",58,0) + ; ZXML IS PASSED BY NAME +"RTN","C0SNHIN",59,0) + ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED +"RTN","C0SNHIN",60,0) + ; +"RTN","C0SNHIN",61,0) + N GN +"RTN","C0SNHIN",62,0) + S GN=$NA(^TMP("C0SPROCESS",$J)) +"RTN","C0SNHIN",63,0) + K @GN +"RTN","C0SNHIN",64,0) + M @GN=@ZXML +"RTN","C0SNHIN",65,0) + S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML +"RTN","C0SNHIN",66,0) + K @GN +"RTN","C0SNHIN",67,0) + D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS +"RTN","C0SNHIN",68,0) + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 +"RTN","C0SNHIN",69,0) + Q +"RTN","C0SNHIN",70,0) + ; +"RTN","C0SNHIN",71,0) +LOADSMRT ; +"RTN","C0SNHIN",72,0) + ; +"RTN","C0SNHIN",73,0) + K ^GPL("SMART") +"RTN","C0SNHIN",74,0) + S GN=$NA(^GPL("SMART",1)) +"RTN","C0SNHIN",75,0) + I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" +"RTN","C0SNHIN",76,0) + Q +"RTN","C0SNHIN",77,0) + ; +"RTN","C0SNHIN",78,0) +SMART ; TRY IT WITH SMART +"RTN","C0SNHIN",79,0) + ; +"RTN","C0SNHIN",80,0) + S GN=$NA(^GPL("SMART")) +"RTN","C0SNHIN",81,0) + ;K ^TMP("MXMLDOM",$J) +"RTN","C0SNHIN",82,0) + K ^TMP("MXMLERR",$J) +"RTN","C0SNHIN",83,0) + S C0SDOCID=$$PARSE(GN,"SMART") +"RTN","C0SNHIN",84,0) + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") +"RTN","C0SNHIN",85,0) + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG +"RTN","C0SNHIN",86,0) + Q +"RTN","C0SNHIN",87,0) + ; +"RTN","C0SNHIN",88,0) +CCR ; TRY IT WITH A CCR +"RTN","C0SNHIN",89,0) + ; +"RTN","C0SNHIN",90,0) + S GN=$NA(^GPL("CCR")) +"RTN","C0SNHIN",91,0) + ;K ^TMP("MXMLDOM",$J) +"RTN","C0SNHIN",92,0) + K ^TMP("MXMLERR",$J) +"RTN","C0SNHIN",93,0) + S C0SDOCID=$$PARSE(GN,"CCR") +"RTN","C0SNHIN",94,0) + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") +"RTN","C0SNHIN",95,0) + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG +"RTN","C0SNHIN",96,0) + Q +"RTN","C0SNHIN",97,0) + ; +"RTN","C0SNHIN",98,0) +MED ; TRY IT WITH A CCR MED SECTION +"RTN","C0SNHIN",99,0) + ; +"RTN","C0SNHIN",100,0) + S GN=$NA(^GPL("MED")) +"RTN","C0SNHIN",101,0) + K ^TMP("MXMLDOM",$J) +"RTN","C0SNHIN",102,0) + K ^TMP("MXMLERR",$J) +"RTN","C0SNHIN",103,0) + S C0SDOCID=$$PARSE(GN,"MED") +"RTN","C0SNHIN",104,0) + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") +"RTN","C0SNHIN",105,0) + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG +"RTN","C0SNHIN",106,0) + Q +"RTN","C0SNHIN",107,0) + ; +"RTN","C0SNHIN",108,0) +CCD ; TRY IT WITH A CCD +"RTN","C0SNHIN",109,0) + ; +"RTN","C0SNHIN",110,0) + S GN=$NA(^GPL("CCD")) +"RTN","C0SNHIN",111,0) + ;K ^TMP("MXMLDOM",$J) +"RTN","C0SNHIN",112,0) + K ^TMP("MXMLERR",$J) +"RTN","C0SNHIN",113,0) + S C0SDOCID=$$PARSE(GN,"CCD") +"RTN","C0SNHIN",114,0) + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") +"RTN","C0SNHIN",115,0) + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG +"RTN","C0SNHIN",116,0) + Q +"RTN","C0SNHIN",117,0) + ; +"RTN","C0SNHIN",118,0) +TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") +"RTN","C0SNHIN",119,0) + ; PARSED WITH MXML +"RTN","C0SNHIN",120,0) + ; RUN THROUGH XPATH +"RTN","C0SNHIN",121,0) + K GARY,GIDX,C0SDOCID +"RTN","C0SNHIN",122,0) + S GN=$NA(^GPL("NHIN")) +"RTN","C0SNHIN",123,0) + ;S GN=$NA(^GPL("DOMI")) +"RTN","C0SNHIN",124,0) + S C0SDOCID=$$PARSE(GN,"GPLTEST") +"RTN","C0SNHIN",125,0) + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") +"RTN","C0SNHIN",126,0) + K ^GPL("GNARY") +"RTN","C0SNHIN",127,0) + M ^GPL("GNARY")=GNARY +"RTN","C0SNHIN",128,0) + Q +"RTN","C0SNHIN",129,0) + ; +"RTN","C0SNHIN",130,0) +TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") +"RTN","C0SNHIN",131,0) + ; +"RTN","C0SNHIN",132,0) + S GN=$NA(^GPL("GNARY")) +"RTN","C0SNHIN",133,0) + S C0SDOCID=$$DOMI^C0SDOM(GN,,"results") +"RTN","C0SNHIN",134,0) + D OUTXML^C0SDOM("G",C0SDOCID) +"RTN","C0SNHIN",135,0) + K ^GPL("DOMI") +"RTN","C0SNHIN",136,0) + M ^GPL("DOMI")=G +"RTN","C0SNHIN",137,0) + Q +"RTN","C0SNHIN",138,0) + ; +"RTN","C0SNHIN",139,0) +TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") +"RTN","C0SNHIN",140,0) + ; PARSED WITH MXML +"RTN","C0SNHIN",141,0) + ; RUN THROUGH XPATH +"RTN","C0SNHIN",142,0) + K GARY,GIDX,C0SDOCID +"RTN","C0SNHIN",143,0) + ;S GN=$NA(^GPL("NHIN")) +"RTN","C0SNHIN",144,0) + S GN=$NA(^GPL("DOMI")) +"RTN","C0SNHIN",145,0) + S C0SDOCID=$$PARSE(GN,"GPLTEST") +"RTN","C0SNHIN",146,0) + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") +"RTN","C0SNHIN",147,0) + Q +"RTN","C0SNHIN",148,0) + ; +"RTN","C0SNHIN",149,0) +DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE +"RTN","C0SNHIN",150,0) + ; THE XPATH INDEX ZXIDX, PASSED BY NAME +"RTN","C0SNHIN",151,0) + ; THE XPATH ARRAY XPARY, PASSED BY NAME +"RTN","C0SNHIN",152,0) + ; ZOID IS THE STARTING OID +"RTN","C0SNHIN",153,0) + ; ZPATH IS THE STARTING XPATH, USUALLY "/" +"RTN","C0SNHIN",154,0) + ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE +"RTN","C0SNHIN",155,0) + ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT +"RTN","C0SNHIN",156,0) + I $G(ZREDUX)="" S ZREDUX="" +"RTN","C0SNHIN",157,0) + N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY +"RTN","C0SNHIN",158,0) + N NEWNUM S NEWNUM="" +"RTN","C0SNHIN",159,0) + I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" +"RTN","C0SNHIN",160,0) + S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE +"RTN","C0SNHIN",161,0) + I $G(ZREDUX)'="" D ; REDUX PROVIDED? +"RTN","C0SNHIN",162,0) + . N GT S GT=$P(NEWPATH,ZREDUX,2) +"RTN","C0SNHIN",163,0) + . I GT'="" S NEWPATH=GT +"RTN","C0SNHIN",164,0) + S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX +"RTN","C0SNHIN",165,0) + N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE +"RTN","C0SNHIN",166,0) + I $D(GA) D ; PROCESS THE ATTRIBUTES +"RTN","C0SNHIN",167,0) + . N ZI S ZI="" +"RTN","C0SNHIN",168,0) + . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE +"RTN","C0SNHIN",169,0) + . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE +"RTN","C0SNHIN",170,0) + . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY +"RTN","C0SNHIN",171,0) + . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE +"RTN","C0SNHIN",172,0) + N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE +"RTN","C0SNHIN",173,0) + I $D(GD(2)) D ; +"RTN","C0SNHIN",174,0) + . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY +"RTN","C0SNHIN",175,0) + E I $D(GD(1)) D ; +"RTN","C0SNHIN",176,0) + . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY +"RTN","C0SNHIN",177,0) + . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY +"RTN","C0SNHIN",178,0) + N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD +"RTN","C0SNHIN",179,0) + I ZFRST'=0 D ; THERE IS A CHILD +"RTN","C0SNHIN",180,0) + . N ZNUM +"RTN","C0SNHIN",181,0) + . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE +"RTN","C0SNHIN",182,0) + . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD +"RTN","C0SNHIN",183,0) + N GNXT S GNXT=$$NXTSIB(ZOID) +"RTN","C0SNHIN",184,0) + I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES +"RTN","C0SNHIN",185,0) + I GNXT'=0 D ; +"RTN","C0SNHIN",186,0) + . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? +"RTN","C0SNHIN",187,0) + . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES +"RTN","C0SNHIN",188,0) + . . N ZNUM S ZNUM=1 ; +"RTN","C0SNHIN",189,0) + . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB +"RTN","C0SNHIN",190,0) + . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB +"RTN","C0SNHIN",191,0) + Q +"RTN","C0SNHIN",192,0) + ; +"RTN","C0SNHIN",193,0) +ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY +"RTN","C0SNHIN",194,0) + ; +"RTN","C0SNHIN",195,0) + N ZZI,ZZJ,ZZN +"RTN","C0SNHIN",196,0) + S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY +"RTN","C0SNHIN",197,0) + I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE +"RTN","C0SNHIN",198,0) + S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY +"RTN","C0SNHIN",199,0) + S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . +"RTN","C0SNHIN",200,0) + I ZZI'["]" D ; A SINGLETON +"RTN","C0SNHIN",201,0) + . S ZZN=1 +"RTN","C0SNHIN",202,0) + E D ; THERE IS AN [x] OCCURANCE +"RTN","C0SNHIN",203,0) + . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE +"RTN","C0SNHIN",204,0) + . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] +"RTN","C0SNHIN",205,0) + I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE +"RTN","C0SNHIN",206,0) + Q +"RTN","C0SNHIN",207,0) + ; +"RTN","C0SNHIN",208,0) +PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME +"RTN","C0SNHIN",209,0) + ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW +"RTN","C0SNHIN",210,0) + ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML +"RTN","C0SNHIN",211,0) + ;Q $$EN^MXMLDOM(INXML) +"RTN","C0SNHIN",212,0) + Q $$EN^MXMLDOM(INXML,"W") +"RTN","C0SNHIN",213,0) + ; +"RTN","C0SNHIN",214,0) +ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE +"RTN","C0SNHIN",215,0) + N ZN +"RTN","C0SNHIN",216,0) + ;I $$TAG(ZOID)["entry" B +"RTN","C0SNHIN",217,0) + S ZN=$$NXTSIB(ZOID) +"RTN","C0SNHIN",218,0) + I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG +"RTN","C0SNHIN",219,0) + Q 0 +"RTN","C0SNHIN",220,0) + ; +"RTN","C0SNHIN",221,0) +FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID +"RTN","C0SNHIN",222,0) + Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SNHIN",223,0) + ; +"RTN","C0SNHIN",224,0) +PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID +"RTN","C0SNHIN",225,0) + Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SNHIN",226,0) + ; +"RTN","C0SNHIN",227,0) +ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID +"RTN","C0SNHIN",228,0) + S HANDLE=C0SDOCID +"RTN","C0SNHIN",229,0) + K @RTN +"RTN","C0SNHIN",230,0) + D GETTXT^MXMLDOM("A") +"RTN","C0SNHIN",231,0) + Q +"RTN","C0SNHIN",232,0) + ; +"RTN","C0SNHIN",233,0) +TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE +"RTN","C0SNHIN",234,0) + ;I ZOID=149 B ;GPLTEST +"RTN","C0SNHIN",235,0) + N X,Y +"RTN","C0SNHIN",236,0) + S Y="" +"RTN","C0SNHIN",237,0) + S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE +"RTN","C0SNHIN",238,0) + I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y +"RTN","C0SNHIN",239,0) + I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SNHIN",240,0) + Q Y +"RTN","C0SNHIN",241,0) + ; +"RTN","C0SNHIN",242,0) +NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING +"RTN","C0SNHIN",243,0) + Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) +"RTN","C0SNHIN",244,0) + ; +"RTN","C0SNHIN",245,0) +DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE +"RTN","C0SNHIN",246,0) + ;N ZT,ZN S ZT="" +"RTN","C0SNHIN",247,0) + ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) +"RTN","C0SNHIN",248,0) + ;Q $G(@C0SDOM@(ZOID,"T",1)) +"RTN","C0SNHIN",249,0) + S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) +"RTN","C0SNHIN",250,0) + Q +"RTN","C0SNHIN",251,0) + ; +"RTN","C0SNHIN",252,0) +OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM +"RTN","C0SNHIN",253,0) + ; +"RTN","C0SNHIN",254,0) + S C0SDOCID=INID +"RTN","C0SNHIN",255,0) + D START^C0SMXMLB($$TAG(1),,"G") +"RTN","C0SNHIN",256,0) + D NDOUT($$FIRST(1)) +"RTN","C0SNHIN",257,0) + D END^C0SMXMLB ;END THE DOCUMENT +"RTN","C0SNHIN",258,0) + M @ZRTN=^TMP("MXMLBLD",$J) +"RTN","C0SNHIN",259,0) + K ^TMP("MXMLBLD",$J) +"RTN","C0SNHIN",260,0) + Q +"RTN","C0SNHIN",261,0) + ; +"RTN","C0SNHIN",262,0) +NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE +"RTN","C0SNHIN",263,0) + N ZI S ZI=$$FIRST(ZOID) +"RTN","C0SNHIN",264,0) + I ZI'=0 D ; THERE IS A CHILD +"RTN","C0SNHIN",265,0) + . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT +"RTN","C0SNHIN",266,0) + . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN +"RTN","C0SNHIN",267,0) + E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT +"RTN","C0SNHIN",268,0) + . ;W "DOING",ZOID,! +"RTN","C0SNHIN",269,0) + . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA +"RTN","C0SNHIN",270,0) + . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES +"RTN","C0SNHIN",271,0) + . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN +"RTN","C0SNHIN",272,0) + I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING +"RTN","C0SNHIN",273,0) + . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS +"RTN","C0SNHIN",274,0) + Q +"RTN","C0SNHIN",275,0) + ; +"RTN","C0SNHIN",276,0) +WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE +"RTN","C0SNHIN",277,0) + ; +"RTN","C0SNHIN",278,0) + N GN,GN2 +"RTN","C0SNHIN",279,0) + D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML +"RTN","C0SNHIN",280,0) + S GN2=$NA(@GN@(1)) +"RTN","C0SNHIN",281,0) + W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") +"RTN","C0SNHIN",282,0) + Q +"RTN","C0SNHIN",283,0) + ; +"RTN","C0SNHIN",284,0) +TESTNARY ; TEST MAKING A NHIN ARRAY +"RTN","C0SNHIN",285,0) + N ZI S ZI="" +"RTN","C0SNHIN",286,0) + N ZH ; DOM HANDLE +"RTN","C0SNHIN",287,0) + D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM +"RTN","C0SNHIN",288,0) + S ZH=C0SDOCID ; SET THE HANDLE +"RTN","C0SNHIN",289,0) + N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) +"RTN","C0SNHIN",290,0) + F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE +"RTN","C0SNHIN",291,0) + . N ZATT +"RTN","C0SNHIN",292,0) + . D MNARY(.ZATT,ZH,ZI) +"RTN","C0SNHIN",293,0) + . N ZPRE,ZN +"RTN","C0SNHIN",294,0) + . S ZPRE=$$PRE(ZI) +"RTN","C0SNHIN",295,0) + . S ZN=$P(ZPRE,",",2) +"RTN","C0SNHIN",296,0) + . S ZPRE=$P(ZPRE,",",1) +"RTN","C0SNHIN",297,0) + . ;I $D(ZATT) ZWR ZATT +"RTN","C0SNHIN",298,0) + . N ZJ S ZJ="" +"RTN","C0SNHIN",299,0) + . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE +"RTN","C0SNHIN",300,0) + . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! +"RTN","C0SNHIN",301,0) + . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) +"RTN","C0SNHIN",302,0) + Q +"RTN","C0SNHIN",303,0) + ; +"RTN","C0SNHIN",304,0) +PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE +"RTN","C0SNHIN",305,0) + ; +"RTN","C0SNHIN",306,0) + N GI,GI2,GPT,GJ,GN +"RTN","C0SNHIN",307,0) + S GI=$$PARENT(ZNODE) ; PARENT NODE +"RTN","C0SNHIN",308,0) + I GI=0 Q "" ; NO PARENT +"RTN","C0SNHIN",309,0) + S GPT=$$TAG(GI) ; TAG OF PARENT +"RTN","C0SNHIN",310,0) + S GI2=$$PARENT(GI) ; PARENT OF PARENT +"RTN","C0SNHIN",311,0) + I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT +"RTN","C0SNHIN",312,0) + S GJ=$$FIRST(GI) ; NODE OF FIRST SIB +"RTN","C0SNHIN",313,0) + I GJ=ZNODE Q:$$TAG(GI)_",1" +"RTN","C0SNHIN",314,0) + F GN=2:1 Q:GJ=ZNODE D ; +"RTN","C0SNHIN",315,0) + . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING +"RTN","C0SNHIN",316,0) + Q GPT_","_GN +"RTN","C0SNHIN",317,0) + ; +"RTN","C0SNHIN",318,0) +MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE +"RTN","C0SNHIN",319,0) + ; RETURNED IN ZRTN, PASSED BY REFERENCE +"RTN","C0SNHIN",320,0) + ; ZHANDLE IS THE DOM DOCUMENT ID +"RTN","C0SNHIN",321,0) + ; ZOID IS THE DOM NODE +"RTN","C0SNHIN",322,0) + D ATT("ZRTN",ZOID) +"RTN","C0SNHIN",323,0) + Q +"RTN","C0SNHIN",324,0) + ; +"RTN","C0SNHINV") +0^8^B15736572 +"RTN","C0SNHINV",1,0) +C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version +"RTN","C0SNHINV",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SNHINV",3,0) + ; +"RTN","C0SNHINV",4,0) + ; External References DBIA# +"RTN","C0SNHINV",5,0) + ; ------------------- ----- +"RTN","C0SNHINV",6,0) + ; ^DPT 10035 +"RTN","C0SNHINV",7,0) + ; ^SC 10040 +"RTN","C0SNHINV",8,0) + ; DIQ 2056 +"RTN","C0SNHINV",9,0) + ; MPIF001 2701 +"RTN","C0SNHINV",10,0) + ; VASITE 10112 +"RTN","C0SNHINV",11,0) + ; XLFDT 10103 +"RTN","C0SNHINV",12,0) + ; XLFSTR 10104 +"RTN","C0SNHINV",13,0) + ; XUAF4 2171 +"RTN","C0SNHINV",14,0) + ; +"RTN","C0SNHINV",15,0) +GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n) +"RTN","C0SNHINV",16,0) + ; RPC = NHIN GET VISTA DATA +"RTN","C0SNHINV",17,0) + N ICN,NHINI,NHINTOTL +"RTN","C0SNHINV",18,0) + S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN +"RTN","C0SNHINV",19,0) + ; +"RTN","C0SNHINV",20,0) + ; parse & validate input parameters +"RTN","C0SNHINV",21,0) + S ICN=+$P(DFN,";",2),DFN=+$G(DFN) +"RTN","C0SNHINV",22,0) + I 'DFN S DFN=+$$GETDFN^MPIF001(ICN) +"RTN","C0SNHINV",23,0) + I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ +"RTN","C0SNHINV",24,0) + S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL +"RTN","C0SNHINV",25,0) + S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999 +"RTN","C0SNHINV",26,0) + I START,STOP,STOP") +"RTN","C0SNHINV",33,0) + F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D +"RTN","C0SNHINV",34,0) + . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q +"RTN","C0SNHINV",35,0) + . D @(RTN_"(DFN,START,STOP,MAX,ID)") +"RTN","C0SNHINV",36,0) + D ADD("") +"RTN","C0SNHINV",37,0) + ; +"RTN","C0SNHINV",38,0) + I $G(NHINTOTL),$G(@NHIN@(1))="" S @NHIN@(1)="" +"RTN","C0SNHINV",39,0) + ; +"RTN","C0SNHINV",40,0) +GTQ ; end +"RTN","C0SNHINV",41,0) + Q +"RTN","C0SNHINV",42,0) + ; +"RTN","C0SNHINV",43,0) +RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X +"RTN","C0SNHINV",44,0) + S X=$$UP^XLFSTR(X),Y="NHINV" +"RTN","C0SNHINV",45,0) + I X="ACCESSION" S Y="NHINVLRA" +"RTN","C0SNHINV",46,0) + I X="ALLERGY" S Y="NHINVART" +"RTN","C0SNHINV",47,0) + I X="APPOINTMENT" S Y="NHINVAPT" +"RTN","C0SNHINV",48,0) + ; X="CONSULT" S Y="NHINVCON" +"RTN","C0SNHINV",49,0) + I X="DOCUMENT" S Y="NHINVTIU" +"RTN","C0SNHINV",50,0) + I X="IMMUNIZATION" S Y="NHINVIMM" +"RTN","C0SNHINV",51,0) + I X="LAB" S Y="NHINVLR" +"RTN","C0SNHINV",52,0) + I X="PANEL" S Y="NHINVLRO" +"RTN","C0SNHINV",53,0) + I X="MED" S Y="NHINVPS" +"RTN","C0SNHINV",54,0) + I X="RX" S Y="NHINVPSO" +"RTN","C0SNHINV",55,0) + ; X="ORDER" S Y="NHINVOR" +"RTN","C0SNHINV",56,0) + I X="PATIENT" S Y="NHINVPT" +"RTN","C0SNHINV",57,0) + I X="PROBLEM" S Y="NHINVPL" +"RTN","C0SNHINV",58,0) + I X="PROCEDURE" S Y="NHINVPRC" +"RTN","C0SNHINV",59,0) + I X="SURGERY" S Y="NHINVSR" +"RTN","C0SNHINV",60,0) + I X="VISIT" S Y="NHINVSIT" +"RTN","C0SNHINV",61,0) + I X="VITAL" S Y="NHINVIT" +"RTN","C0SNHINV",62,0) + I X="RADIOLOGY" S Y="NHINVRA" +"RTN","C0SNHINV",63,0) + I X="NEW" S Y="NHINVPR" +"RTN","C0SNHINV",64,0) + Q Y +"RTN","C0SNHINV",65,0) + ; +"RTN","C0SNHINV",66,0) +ALL() ; -- return string for all types of data +"RTN","C0SNHINV",67,0) + ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure" +"RTN","C0SNHINV",68,0) + Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure" +"RTN","C0SNHINV",69,0) + ; +"RTN","C0SNHINV",70,0) +ERR(X,VAL) ; -- return error message +"RTN","C0SNHINV",71,0) + N MSG S MSG="Error" +"RTN","C0SNHINV",72,0) + I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found" +"RTN","C0SNHINV",73,0) + I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized" +"RTN","C0SNHINV",74,0) + I X=99 S MSG="Unknown request" +"RTN","C0SNHINV",75,0) + ; +"RTN","C0SNHINV",76,0) + D ADD("") +"RTN","C0SNHINV",77,0) + D ADD(""_MSG_"") +"RTN","C0SNHINV",78,0) + D ADD("") +"RTN","C0SNHINV",79,0) + Q +"RTN","C0SNHINV",80,0) + ; +"RTN","C0SNHINV",81,0) +ESC(X) ; -- escape outgoing XML +"RTN","C0SNHINV",82,0) + ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache +"RTN","C0SNHINV",83,0) + ; +"RTN","C0SNHINV",84,0) + N I,Y,QOT S QOT="""" +"RTN","C0SNHINV",85,0) + S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I) +"RTN","C0SNHINV",86,0) + S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I) +"RTN","C0SNHINV",87,0) + S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I) +"RTN","C0SNHINV",88,0) + S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I) +"RTN","C0SNHINV",89,0) + S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I) +"RTN","C0SNHINV",90,0) + Q Y +"RTN","C0SNHINV",91,0) + ; +"RTN","C0SNHINV",92,0) +ADD(X) ; Add a line @NHIN@(n)=X +"RTN","C0SNHINV",93,0) + S NHINI=$G(NHINI)+1 +"RTN","C0SNHINV",94,0) + S @NHIN@(NHINI)=X +"RTN","C0SNHINV",95,0) + Q +"RTN","C0SNHINV",96,0) + ; +"RTN","C0SNHINV",97,0) +STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string +"RTN","C0SNHINV",98,0) + N I,X,Y S Y="" +"RTN","C0SNHINV",99,0) + S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0)) +"RTN","C0SNHINV",100,0) + S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I))) +"RTN","C0SNHINV",101,0) + F S I=$O(ARRAY(I)) Q:I<1 D +"RTN","C0SNHINV",102,0) + . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I)) +"RTN","C0SNHINV",103,0) + . I $E(X)=" " S Y=Y_$C(13,10)_X Q +"RTN","C0SNHINV",104,0) + . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X +"RTN","C0SNHINV",105,0) + Q Y +"RTN","C0SNHINV",106,0) + ; +"RTN","C0SNHINV",107,0) +FAC(X) ; -- return Institution file station# for location X +"RTN","C0SNHINV",108,0) + N HLOC,FAC,Y0,Y S Y="" +"RTN","C0SNHINV",109,0) + S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien +"RTN","C0SNHINV",110,0) + ; Get P:4 via Med Ctr Div, if not directly linked +"RTN","C0SNHINV",111,0) + I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I") +"RTN","C0SNHINV",112,0) + S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn# +"RTN","C0SNHINV",113,0) + S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name +"RTN","C0SNHINV",114,0) + I $L(Y),'Y S $P(Y,U)=FAC +"RTN","C0SNHINV",115,0) + Q Y +"RTN","C0SNHINV",116,0) + ; +"RTN","C0SNHINV",117,0) +VUID(IEN,FILE) ; -- Return VUID for item +"RTN","C0SNHINV",118,0) + Q $$GET1^DIQ(FILE,IEN_",",99.99) +"RTN","C0SPROB") +0^9^B49669400 +"RTN","C0SPROB",1,0) +C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 +"RTN","C0SPROB",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SPROB",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SPROB",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SPROB",5,0) + ; +"RTN","C0SPROB",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SPROB",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SPROB",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SPROB",9,0) + ;(at your option) any later version. +"RTN","C0SPROB",10,0) + ; +"RTN","C0SPROB",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SPROB",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SPROB",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SPROB",14,0) + ;GNU General Public License for more details. +"RTN","C0SPROB",15,0) + ; +"RTN","C0SPROB",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SPROB",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SPROB",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SPROB",19,0) + ; +"RTN","C0SPROB",20,0) + Q +"RTN","C0SPROB",21,0) + ; +"RTN","C0SPROB",22,0) + ; sample VistA NHIN problem list +"RTN","C0SPROB",23,0) + ; +"RTN","C0SPROB",24,0) + ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" +"RTN","C0SPROB",25,0) + ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 +"RTN","C0SPROB",26,0) + ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 +"RTN","C0SPROB",27,0) + ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",28,0) + ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 +"RTN","C0SPROB",29,0) + ;^TMP("C0STBL",91,"problem",1,"id@value")=100 +"RTN","C0SPROB",30,0) + ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" +"RTN","C0SPROB",31,0) + ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" +"RTN","C0SPROB",32,0) + ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 +"RTN","C0SPROB",33,0) + ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 +"RTN","C0SPROB",34,0) + ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",35,0) + ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 +"RTN","C0SPROB",36,0) + ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 +"RTN","C0SPROB",37,0) + ;^TMP("C0STBL",91,"problem",1,"status@value")="A" +"RTN","C0SPROB",38,0) + ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 +"RTN","C0SPROB",39,0) + ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 +"RTN","C0SPROB",40,0) + ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" +"RTN","C0SPROB",41,0) + ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 +"RTN","C0SPROB",42,0) + ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 +"RTN","C0SPROB",43,0) + ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",44,0) + ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 +"RTN","C0SPROB",45,0) + ;^TMP("C0STBL",91,"problem",2,"id@value")=108 +"RTN","C0SPROB",46,0) + ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" +"RTN","C0SPROB",47,0) + ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 +"RTN","C0SPROB",48,0) + ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 +"RTN","C0SPROB",49,0) + ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",50,0) + ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 +"RTN","C0SPROB",51,0) + ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 +"RTN","C0SPROB",52,0) + ;^TMP("C0STBL",91,"problem",2,"status@value")="A" +"RTN","C0SPROB",53,0) + ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 +"RTN","C0SPROB",54,0) + ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 +"RTN","C0SPROB",55,0) + ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" +"RTN","C0SPROB",56,0) + ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 +"RTN","C0SPROB",57,0) + ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 +"RTN","C0SPROB",58,0) + ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",59,0) + ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 +"RTN","C0SPROB",60,0) + ;^TMP("C0STBL",91,"problem",3,"id@value")=109 +"RTN","C0SPROB",61,0) + ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" +"RTN","C0SPROB",62,0) + ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 +"RTN","C0SPROB",63,0) + ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 +"RTN","C0SPROB",64,0) + ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",65,0) + ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 +"RTN","C0SPROB",66,0) + ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 +"RTN","C0SPROB",67,0) + ;^TMP("C0STBL",91,"problem",3,"status@value")="A" +"RTN","C0SPROB",68,0) + ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 +"RTN","C0SPROB",69,0) + ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 +"RTN","C0SPROB",70,0) + ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 +"RTN","C0SPROB",71,0) + ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 +"RTN","C0SPROB",72,0) + ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",73,0) + ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" +"RTN","C0SPROB",74,0) + ;^TMP("C0STBL",91,"problem",4,"id@value")=115 +"RTN","C0SPROB",75,0) + ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" +"RTN","C0SPROB",76,0) + ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" +"RTN","C0SPROB",77,0) + ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 +"RTN","C0SPROB",78,0) + ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",79,0) + ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 +"RTN","C0SPROB",80,0) + ;^TMP("C0STBL",91,"problem",4,"status@value")="A" +"RTN","C0SPROB",81,0) + ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 +"RTN","C0SPROB",82,0) + ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 +"RTN","C0SPROB",83,0) + ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 +"RTN","C0SPROB",84,0) + ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 +"RTN","C0SPROB",85,0) + ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",86,0) + ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 +"RTN","C0SPROB",87,0) + ;^TMP("C0STBL",91,"problem",5,"id@value")=116 +"RTN","C0SPROB",88,0) + ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" +"RTN","C0SPROB",89,0) + ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 +"RTN","C0SPROB",90,0) + ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 +"RTN","C0SPROB",91,0) + ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",92,0) + ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 +"RTN","C0SPROB",93,0) + ;^TMP("C0STBL",91,"problem",5,"status@value")="A" +"RTN","C0SPROB",94,0) + ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 +"RTN","C0SPROB",95,0) + ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 +"RTN","C0SPROB",96,0) + ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 +"RTN","C0SPROB",97,0) + ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 +"RTN","C0SPROB",98,0) + ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",99,0) + ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 +"RTN","C0SPROB",100,0) + ;^TMP("C0STBL",91,"problem",6,"id@value")=117 +"RTN","C0SPROB",101,0) + ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" +"RTN","C0SPROB",102,0) + ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 +"RTN","C0SPROB",103,0) + ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 +"RTN","C0SPROB",104,0) + ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",105,0) + ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 +"RTN","C0SPROB",106,0) + ;^TMP("C0STBL",91,"problem",6,"status@value")="A" +"RTN","C0SPROB",107,0) + ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 +"RTN","C0SPROB",108,0) + ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 +"RTN","C0SPROB",109,0) + ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 +"RTN","C0SPROB",110,0) + ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 +"RTN","C0SPROB",111,0) + ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",112,0) + ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 +"RTN","C0SPROB",113,0) + ;^TMP("C0STBL",91,"problem",7,"id@value")=118 +"RTN","C0SPROB",114,0) + ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" +"RTN","C0SPROB",115,0) + ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 +"RTN","C0SPROB",116,0) + ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 +"RTN","C0SPROB",117,0) + ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",118,0) + ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 +"RTN","C0SPROB",119,0) + ;^TMP("C0STBL",91,"problem",7,"status@value")="A" +"RTN","C0SPROB",120,0) + ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 +"RTN","C0SPROB",121,0) + ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 +"RTN","C0SPROB",122,0) + ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 +"RTN","C0SPROB",123,0) + ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 +"RTN","C0SPROB",124,0) + ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB",125,0) + ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" +"RTN","C0SPROB",126,0) + ;^TMP("C0STBL",91,"problem",8,"id@value")=119 +"RTN","C0SPROB",127,0) + ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" +"RTN","C0SPROB",128,0) + ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," +"RTN","C0SPROB",129,0) + ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 +"RTN","C0SPROB",130,0) + ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB",131,0) + ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 +"RTN","C0SPROB",132,0) + ;^TMP("C0STBL",91,"problem",8,"status@value")="A" +"RTN","C0SPROB",133,0) + ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 +"RTN","C0SPROB",134,0) + ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 +"RTN","C0SPROB",135,0) + ; +"RTN","C0SPROB",136,0) + ; sample Smart lab result triples +"RTN","C0SPROB",137,0) + ; +"RTN","C0SPROB",138,0) + ;G("node16rk1fgdvx10882","code")="snomed:40930008" +"RTN","C0SPROB",139,0) + ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" +"RTN","C0SPROB",140,0) + ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",141,0) + ;G("node16rk1fgdvx11051","code")="snomed:188155002" +"RTN","C0SPROB",142,0) + ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" +"RTN","C0SPROB",143,0) + ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",144,0) + ;G("node16rk1fgdvx11073","code")="snomed:353295004" +"RTN","C0SPROB",145,0) + ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" +"RTN","C0SPROB",146,0) + ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",147,0) + ;G("node16rk1fgdvx11089","code")="snomed:54302000" +"RTN","C0SPROB",148,0) + ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" +"RTN","C0SPROB",149,0) + ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",150,0) + ;G("node16rk1fgdvx11351","code")="snomed:38341003" +"RTN","C0SPROB",151,0) + ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" +"RTN","C0SPROB",152,0) + ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",153,0) + ;G("node16rk1fgdvx11390","code")="snomed:44054006" +"RTN","C0SPROB",154,0) + ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" +"RTN","C0SPROB",155,0) + ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",156,0) + ;G("node16rk1fgdvx11558","code")="snomed:195967001" +"RTN","C0SPROB",157,0) + ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" +"RTN","C0SPROB",158,0) + ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",159,0) + ;G("node16rk1fgdvx11578","code")="snomed:254837009" +"RTN","C0SPROB",160,0) + ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" +"RTN","C0SPROB",161,0) + ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",162,0) + ;G("node16rk1fgdvx11687","code")="snomed:8517006" +"RTN","C0SPROB",163,0) + ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" +"RTN","C0SPROB",164,0) + ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",165,0) + ;G("node16rk1fgdvx11716","code")="snomed:55822004" +"RTN","C0SPROB",166,0) + ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" +"RTN","C0SPROB",167,0) + ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" +"RTN","C0SPROB",168,0) + ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" +"RTN","C0SPROB",169,0) + ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" +"RTN","C0SPROB",170,0) + ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" +"RTN","C0SPROB",171,0) + ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" +"RTN","C0SPROB",172,0) + ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" +"RTN","C0SPROB",173,0) + ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" +"RTN","C0SPROB",174,0) + ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" +"RTN","C0SPROB",175,0) + ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" +"RTN","C0SPROB",176,0) + ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" +"RTN","C0SPROB",177,0) + ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" +"RTN","C0SPROB",178,0) + ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" +"RTN","C0SPROB",179,0) + ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" +"RTN","C0SPROB",180,0) + ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" +"RTN","C0SPROB",181,0) + ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" +"RTN","C0SPROB",182,0) + ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" +"RTN","C0SPROB",183,0) + ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" +"RTN","C0SPROB",184,0) + ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" +"RTN","C0SPROB",185,0) + ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" +"RTN","C0SPROB",186,0) + ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" +"RTN","C0SPROB",187,0) + ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" +"RTN","C0SPROB",188,0) + ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" +"RTN","C0SPROB",189,0) + ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" +"RTN","C0SPROB",190,0) + ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" +"RTN","C0SPROB",191,0) + ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" +"RTN","C0SPROB",192,0) + ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" +"RTN","C0SPROB",193,0) + ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" +"RTN","C0SPROB",194,0) + ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" +"RTN","C0SPROB",195,0) + ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" +"RTN","C0SPROB",196,0) + ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" +"RTN","C0SPROB",197,0) + ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" +"RTN","C0SPROB",198,0) + ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" +"RTN","C0SPROB",199,0) + ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" +"RTN","C0SPROB",200,0) + ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" +"RTN","C0SPROB",201,0) + ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" +"RTN","C0SPROB",202,0) + ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" +"RTN","C0SPROB",203,0) + ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" +"RTN","C0SPROB",204,0) + ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" +"RTN","C0SPROB",205,0) + ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" +"RTN","C0SPROB",206,0) + ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" +"RTN","C0SPROB",207,0) + ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" +"RTN","C0SPROB",208,0) + ;G("snomed:188155002","dcterms:identifier")=188155002 +"RTN","C0SPROB",209,0) + ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" +"RTN","C0SPROB",210,0) + ;G("snomed:188155002","rdf:type")="sp:Code" +"RTN","C0SPROB",211,0) + ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",212,0) + ;G("snomed:195967001","dcterms:identifier")=195967001 +"RTN","C0SPROB",213,0) + ;G("snomed:195967001","dcterms:title")="Asthma" +"RTN","C0SPROB",214,0) + ;G("snomed:195967001","rdf:type")="sp:Code" +"RTN","C0SPROB",215,0) + ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",216,0) + ;G("snomed:254837009","dcterms:identifier")=254837009 +"RTN","C0SPROB",217,0) + ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" +"RTN","C0SPROB",218,0) + ;G("snomed:254837009","rdf:type")="sp:Code" +"RTN","C0SPROB",219,0) + ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",220,0) + ;G("snomed:353295004","dcterms:identifier")=353295004 +"RTN","C0SPROB",221,0) + ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" +"RTN","C0SPROB",222,0) + ;G("snomed:353295004","rdf:type")="sp:Code" +"RTN","C0SPROB",223,0) + ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",224,0) + ;G("snomed:38341003","dcterms:identifier")=38341003 +"RTN","C0SPROB",225,0) + ;G("snomed:38341003","dcterms:title")="Essential hypertension" +"RTN","C0SPROB",226,0) + ;G("snomed:38341003","rdf:type")="sp:Code" +"RTN","C0SPROB",227,0) + ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",228,0) + ;G("snomed:40930008","dcterms:identifier")=40930008 +"RTN","C0SPROB",229,0) + ;G("snomed:40930008","dcterms:title")="Hypothyroidism" +"RTN","C0SPROB",230,0) + ;G("snomed:40930008","rdf:type")="sp:Code" +"RTN","C0SPROB",231,0) + ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",232,0) + ;G("snomed:44054006","dcterms:identifier")=44054006 +"RTN","C0SPROB",233,0) + ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" +"RTN","C0SPROB",234,0) + ;G("snomed:44054006","rdf:type")="sp:Code" +"RTN","C0SPROB",235,0) + ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",236,0) + ;G("snomed:54302000","dcterms:identifier")=54302000 +"RTN","C0SPROB",237,0) + ;G("snomed:54302000","dcterms:title")="Disorder of breast" +"RTN","C0SPROB",238,0) + ;G("snomed:54302000","rdf:type")="sp:Code" +"RTN","C0SPROB",239,0) + ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",240,0) + ;G("snomed:55822004","dcterms:identifier")=55822004 +"RTN","C0SPROB",241,0) + ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" +"RTN","C0SPROB",242,0) + ;G("snomed:55822004","rdf:type")="sp:Code" +"RTN","C0SPROB",243,0) + ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",244,0) + ;G("snomed:8517006","dcterms:identifier")=8517006 +"RTN","C0SPROB",245,0) + ;G("snomed:8517006","dcterms:title")="History of tobacco use" +"RTN","C0SPROB",246,0) + ;G("snomed:8517006","rdf:type")="sp:Code" +"RTN","C0SPROB",247,0) + ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" +"RTN","C0SPROB",248,0) + +"RTN","C0SPROB",249,0) + ; +"RTN","C0SPROB",250,0) +PROB(GRTN,C0SARY) ; GRTN, passed by reference, +"RTN","C0SPROB",251,0) + ; is the return name of the graph created. "" if none +"RTN","C0SPROB",252,0) + ; C0SARY is passed in by reference and is the NHIN array of problems +"RTN","C0SPROB",253,0) + ; +"RTN","C0SPROB",254,0) + I $O(C0SARY("problem",""))="" D Q ; +"RTN","C0SPROB",255,0) + . I $D(DEBUG) W !,"No Problems" +"RTN","C0SPROB",256,0) + S GRTN="" ; default to no problems +"RTN","C0SPROB",257,0) + N C0SGRF +"RTN","C0SPROB",258,0) + S C0SGRF="vistaSmart:"_ZPATID_"/problems" +"RTN","C0SPROB",259,0) + I $D(DEBUG) W !,"Processing ",C0SGRF +"RTN","C0SPROB",260,0) + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph +"RTN","C0SPROB",261,0) + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use +"RTN","C0SPROB",262,0) + N FARY S FARY="C0XFARY" +"RTN","C0SPROB",263,0) + D USEFARY^C0XF2N(FARY) +"RTN","C0SPROB",264,0) + D VOCINIT^C0XUTIL +"RTN","C0SPROB",265,0) + ; +"RTN","C0SPROB",266,0) + D STARTADD^C0XF2N ; initialize to create triples +"RTN","C0SPROB",267,0) + ; +"RTN","C0SPROB",268,0) + N ZI S ZI="" +"RTN","C0SPROB",269,0) + F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; +"RTN","C0SPROB",270,0) + . N LRN,ZR ; ZR is the local array for building the new triples +"RTN","C0SPROB",271,0) + . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result +"RTN","C0SPROB",272,0) + . ; +"RTN","C0SPROB",273,0) + . N PROBID ; unique Id for this problem +"RTN","C0SPROB",274,0) + . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number +"RTN","C0SPROB",275,0) + . ; +"RTN","C0SPROB",276,0) + . ; i don't like this because the same problems gets a +"RTN","C0SPROB",277,0) + . ; different ID every time it's reported. Can't trace it back to VistA +"RTN","C0SPROB",278,0) + . ; I'd rather be using id@value ie "id@value")="118" +"RTN","C0SPROB",279,0) + . ; +"RTN","C0SPROB",280,0) + . N SNOMED S SNOMED=$G(@LRN@("icd@value")) +"RTN","C0SPROB",281,0) + . N SNOGRF S SNOGRF="snomed:"_SNOMED +"RTN","C0SPROB",282,0) + . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) +"RTN","C0SPROB",283,0) + . I $D(DEBUG) D ; +"RTN","C0SPROB",284,0) + . . W !,"Processing Problem List ",PROBID +"RTN","C0SPROB",285,0) + . . W !,"problem: ",SNOTIT +"RTN","C0SPROB",286,0) + . . W !,"code: ",SNOMED +"RTN","C0SPROB",287,0) + . ; +"RTN","C0SPROB",288,0) + . ; first do the base result graph +"RTN","C0SPROB",289,0) + . ; +"RTN","C0SPROB",290,0) + . S ZR("rdf:type")="sp:Problem" +"RTN","C0SPROB",291,0) + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems +"RTN","C0SPROB",292,0) + . ; ie /vista/smart/99912345/problems +"RTN","C0SPROB",293,0) + . ; +"RTN","C0SPROB",294,0) + . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name +"RTN","C0SPROB",295,0) + . S ZR("sp:problemName")=PROBNAME +"RTN","C0SPROB",296,0) + . ; +"RTN","C0SPROB",297,0) + . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) +"RTN","C0SPROB",298,0) + . S ZR("sp:startDate")=STARTDT +"RTN","C0SPROB",299,0) + . ; +"RTN","C0SPROB",300,0) + . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples +"RTN","C0SPROB",301,0) + . K ZR ; clean up +"RTN","C0SPROB",302,0) + . ; +"RTN","C0SPROB",303,0) + . ; create the problemName graph +"RTN","C0SPROB",304,0) + . ; +"RTN","C0SPROB",305,0) + . S ZR("rdf:type")="sp:CodedValue" +"RTN","C0SPROB",306,0) + . S ZR("sp:code")="snomed:"_SNOMED +"RTN","C0SPROB",307,0) + . S ZR("dcterms:title")=$G(@LRN@("name@value")) +"RTN","C0SPROB",308,0) + . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) +"RTN","C0SPROB",309,0) + . K ZR +"RTN","C0SPROB",310,0) + . ; +"RTN","C0SPROB",311,0) + . ; create snomed graph +"RTN","C0SPROB",312,0) + . ; +"RTN","C0SPROB",313,0) + . S ZR("rdf:type")="sp:Code" +"RTN","C0SPROB",314,0) + . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB",315,0) + . S ZR("dcterms:identifier")=SNOMED +"RTN","C0SPROB",316,0) + . S ZR("dcterms:title")=SNOTIT +"RTN","C0SPROB",317,0) + . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) +"RTN","C0SPROB",318,0) + . K ZR +"RTN","C0SPROB",319,0) + . ; +"RTN","C0SPROB",320,0) + D BULKLOAD^C0XF2N(.C0XFDA) +"RTN","C0SPROB",321,0) + S GRTN=C0SGRF +"RTN","C0SPROB",322,0) + Q +"RTN","C0SPROB",323,0) + ; +"RTN","C0SPROB2") +0^10^B67594874 +"RTN","C0SPROB2",1,0) +C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 +"RTN","C0SPROB2",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SPROB2",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SPROB2",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SPROB2",5,0) + ; +"RTN","C0SPROB2",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SPROB2",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SPROB2",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SPROB2",9,0) + ;(at your option) any later version. +"RTN","C0SPROB2",10,0) + ; +"RTN","C0SPROB2",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SPROB2",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SPROB2",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SPROB2",14,0) + ;GNU General Public License for more details. +"RTN","C0SPROB2",15,0) + ; +"RTN","C0SPROB2",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SPROB2",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SPROB2",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SPROB2",19,0) + ; +"RTN","C0SPROB2",20,0) + Q +"RTN","C0SPROB2",21,0) + ; +"RTN","C0SPROB2",22,0) + ; sample VistA NHIN problem list +"RTN","C0SPROB2",23,0) + ; +"RTN","C0SPROB2",24,0) + ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" +"RTN","C0SPROB2",25,0) + ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 +"RTN","C0SPROB2",26,0) + ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 +"RTN","C0SPROB2",27,0) + ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",28,0) + ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 +"RTN","C0SPROB2",29,0) + ;^TMP("C0STBL",91,"problem",1,"id@value")=100 +"RTN","C0SPROB2",30,0) + ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" +"RTN","C0SPROB2",31,0) + ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" +"RTN","C0SPROB2",32,0) + ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 +"RTN","C0SPROB2",33,0) + ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 +"RTN","C0SPROB2",34,0) + ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",35,0) + ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 +"RTN","C0SPROB2",36,0) + ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 +"RTN","C0SPROB2",37,0) + ;^TMP("C0STBL",91,"problem",1,"status@value")="A" +"RTN","C0SPROB2",38,0) + ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 +"RTN","C0SPROB2",39,0) + ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 +"RTN","C0SPROB2",40,0) + ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" +"RTN","C0SPROB2",41,0) + ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 +"RTN","C0SPROB2",42,0) + ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 +"RTN","C0SPROB2",43,0) + ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",44,0) + ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 +"RTN","C0SPROB2",45,0) + ;^TMP("C0STBL",91,"problem",2,"id@value")=108 +"RTN","C0SPROB2",46,0) + ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" +"RTN","C0SPROB2",47,0) + ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 +"RTN","C0SPROB2",48,0) + ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 +"RTN","C0SPROB2",49,0) + ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",50,0) + ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 +"RTN","C0SPROB2",51,0) + ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 +"RTN","C0SPROB2",52,0) + ;^TMP("C0STBL",91,"problem",2,"status@value")="A" +"RTN","C0SPROB2",53,0) + ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 +"RTN","C0SPROB2",54,0) + ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 +"RTN","C0SPROB2",55,0) + ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" +"RTN","C0SPROB2",56,0) + ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 +"RTN","C0SPROB2",57,0) + ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 +"RTN","C0SPROB2",58,0) + ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",59,0) + ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 +"RTN","C0SPROB2",60,0) + ;^TMP("C0STBL",91,"problem",3,"id@value")=109 +"RTN","C0SPROB2",61,0) + ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" +"RTN","C0SPROB2",62,0) + ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 +"RTN","C0SPROB2",63,0) + ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 +"RTN","C0SPROB2",64,0) + ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",65,0) + ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 +"RTN","C0SPROB2",66,0) + ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 +"RTN","C0SPROB2",67,0) + ;^TMP("C0STBL",91,"problem",3,"status@value")="A" +"RTN","C0SPROB2",68,0) + ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 +"RTN","C0SPROB2",69,0) + ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 +"RTN","C0SPROB2",70,0) + ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 +"RTN","C0SPROB2",71,0) + ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 +"RTN","C0SPROB2",72,0) + ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",73,0) + ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" +"RTN","C0SPROB2",74,0) + ;^TMP("C0STBL",91,"problem",4,"id@value")=115 +"RTN","C0SPROB2",75,0) + ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" +"RTN","C0SPROB2",76,0) + ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" +"RTN","C0SPROB2",77,0) + ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 +"RTN","C0SPROB2",78,0) + ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",79,0) + ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 +"RTN","C0SPROB2",80,0) + ;^TMP("C0STBL",91,"problem",4,"status@value")="A" +"RTN","C0SPROB2",81,0) + ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 +"RTN","C0SPROB2",82,0) + ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 +"RTN","C0SPROB2",83,0) + ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 +"RTN","C0SPROB2",84,0) + ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 +"RTN","C0SPROB2",85,0) + ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",86,0) + ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 +"RTN","C0SPROB2",87,0) + ;^TMP("C0STBL",91,"problem",5,"id@value")=116 +"RTN","C0SPROB2",88,0) + ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" +"RTN","C0SPROB2",89,0) + ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 +"RTN","C0SPROB2",90,0) + ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 +"RTN","C0SPROB2",91,0) + ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",92,0) + ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 +"RTN","C0SPROB2",93,0) + ;^TMP("C0STBL",91,"problem",5,"status@value")="A" +"RTN","C0SPROB2",94,0) + ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 +"RTN","C0SPROB2",95,0) + ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 +"RTN","C0SPROB2",96,0) + ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 +"RTN","C0SPROB2",97,0) + ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 +"RTN","C0SPROB2",98,0) + ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",99,0) + ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 +"RTN","C0SPROB2",100,0) + ;^TMP("C0STBL",91,"problem",6,"id@value")=117 +"RTN","C0SPROB2",101,0) + ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" +"RTN","C0SPROB2",102,0) + ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 +"RTN","C0SPROB2",103,0) + ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 +"RTN","C0SPROB2",104,0) + ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",105,0) + ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 +"RTN","C0SPROB2",106,0) + ;^TMP("C0STBL",91,"problem",6,"status@value")="A" +"RTN","C0SPROB2",107,0) + ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 +"RTN","C0SPROB2",108,0) + ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 +"RTN","C0SPROB2",109,0) + ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 +"RTN","C0SPROB2",110,0) + ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 +"RTN","C0SPROB2",111,0) + ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",112,0) + ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 +"RTN","C0SPROB2",113,0) + ;^TMP("C0STBL",91,"problem",7,"id@value")=118 +"RTN","C0SPROB2",114,0) + ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" +"RTN","C0SPROB2",115,0) + ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 +"RTN","C0SPROB2",116,0) + ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 +"RTN","C0SPROB2",117,0) + ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",118,0) + ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 +"RTN","C0SPROB2",119,0) + ;^TMP("C0STBL",91,"problem",7,"status@value")="A" +"RTN","C0SPROB2",120,0) + ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 +"RTN","C0SPROB2",121,0) + ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 +"RTN","C0SPROB2",122,0) + ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 +"RTN","C0SPROB2",123,0) + ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 +"RTN","C0SPROB2",124,0) + ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" +"RTN","C0SPROB2",125,0) + ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" +"RTN","C0SPROB2",126,0) + ;^TMP("C0STBL",91,"problem",8,"id@value")=119 +"RTN","C0SPROB2",127,0) + ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" +"RTN","C0SPROB2",128,0) + ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," +"RTN","C0SPROB2",129,0) + ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 +"RTN","C0SPROB2",130,0) + ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" +"RTN","C0SPROB2",131,0) + ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 +"RTN","C0SPROB2",132,0) + ;^TMP("C0STBL",91,"problem",8,"status@value")="A" +"RTN","C0SPROB2",133,0) + ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 +"RTN","C0SPROB2",134,0) + ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 +"RTN","C0SPROB2",135,0) + ; +"RTN","C0SPROB2",136,0) + ; sample Smart lab result triples +"RTN","C0SPROB2",137,0) + ; +"RTN","C0SPROB2",138,0) + ;G("node16rk1fgdvx10882","code")="snomed:40930008" +"RTN","C0SPROB2",139,0) + ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" +"RTN","C0SPROB2",140,0) + ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",141,0) + ;G("node16rk1fgdvx11051","code")="snomed:188155002" +"RTN","C0SPROB2",142,0) + ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" +"RTN","C0SPROB2",143,0) + ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",144,0) + ;G("node16rk1fgdvx11073","code")="snomed:353295004" +"RTN","C0SPROB2",145,0) + ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" +"RTN","C0SPROB2",146,0) + ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",147,0) + ;G("node16rk1fgdvx11089","code")="snomed:54302000" +"RTN","C0SPROB2",148,0) + ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" +"RTN","C0SPROB2",149,0) + ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",150,0) + ;G("node16rk1fgdvx11351","code")="snomed:38341003" +"RTN","C0SPROB2",151,0) + ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" +"RTN","C0SPROB2",152,0) + ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",153,0) + ;G("node16rk1fgdvx11390","code")="snomed:44054006" +"RTN","C0SPROB2",154,0) + ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" +"RTN","C0SPROB2",155,0) + ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",156,0) + ;G("node16rk1fgdvx11558","code")="snomed:195967001" +"RTN","C0SPROB2",157,0) + ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" +"RTN","C0SPROB2",158,0) + ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",159,0) + ;G("node16rk1fgdvx11578","code")="snomed:254837009" +"RTN","C0SPROB2",160,0) + ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" +"RTN","C0SPROB2",161,0) + ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",162,0) + ;G("node16rk1fgdvx11687","code")="snomed:8517006" +"RTN","C0SPROB2",163,0) + ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" +"RTN","C0SPROB2",164,0) + ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",165,0) + ;G("node16rk1fgdvx11716","code")="snomed:55822004" +"RTN","C0SPROB2",166,0) + ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" +"RTN","C0SPROB2",167,0) + ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",168,0) + ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" +"RTN","C0SPROB2",169,0) + ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" +"RTN","C0SPROB2",170,0) + ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" +"RTN","C0SPROB2",171,0) + ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" +"RTN","C0SPROB2",172,0) + ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" +"RTN","C0SPROB2",173,0) + ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" +"RTN","C0SPROB2",174,0) + ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" +"RTN","C0SPROB2",175,0) + ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" +"RTN","C0SPROB2",176,0) + ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" +"RTN","C0SPROB2",177,0) + ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" +"RTN","C0SPROB2",178,0) + ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" +"RTN","C0SPROB2",179,0) + ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" +"RTN","C0SPROB2",180,0) + ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" +"RTN","C0SPROB2",181,0) + ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" +"RTN","C0SPROB2",182,0) + ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" +"RTN","C0SPROB2",183,0) + ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" +"RTN","C0SPROB2",184,0) + ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" +"RTN","C0SPROB2",185,0) + ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" +"RTN","C0SPROB2",186,0) + ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" +"RTN","C0SPROB2",187,0) + ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" +"RTN","C0SPROB2",188,0) + ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" +"RTN","C0SPROB2",189,0) + ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" +"RTN","C0SPROB2",190,0) + ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" +"RTN","C0SPROB2",191,0) + ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" +"RTN","C0SPROB2",192,0) + ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" +"RTN","C0SPROB2",193,0) + ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" +"RTN","C0SPROB2",194,0) + ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" +"RTN","C0SPROB2",195,0) + ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" +"RTN","C0SPROB2",196,0) + ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" +"RTN","C0SPROB2",197,0) + ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" +"RTN","C0SPROB2",198,0) + ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" +"RTN","C0SPROB2",199,0) + ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" +"RTN","C0SPROB2",200,0) + ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" +"RTN","C0SPROB2",201,0) + ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" +"RTN","C0SPROB2",202,0) + ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" +"RTN","C0SPROB2",203,0) + ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" +"RTN","C0SPROB2",204,0) + ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" +"RTN","C0SPROB2",205,0) + ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" +"RTN","C0SPROB2",206,0) + ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" +"RTN","C0SPROB2",207,0) + ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" +"RTN","C0SPROB2",208,0) + ;G("snomed:188155002","dcterms:identifier")=188155002 +"RTN","C0SPROB2",209,0) + ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" +"RTN","C0SPROB2",210,0) + ;G("snomed:188155002","rdf:type")="sp:Code" +"RTN","C0SPROB2",211,0) + ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",212,0) + ;G("snomed:195967001","dcterms:identifier")=195967001 +"RTN","C0SPROB2",213,0) + ;G("snomed:195967001","dcterms:title")="Asthma" +"RTN","C0SPROB2",214,0) + ;G("snomed:195967001","rdf:type")="sp:Code" +"RTN","C0SPROB2",215,0) + ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",216,0) + ;G("snomed:254837009","dcterms:identifier")=254837009 +"RTN","C0SPROB2",217,0) + ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" +"RTN","C0SPROB2",218,0) + ;G("snomed:254837009","rdf:type")="sp:Code" +"RTN","C0SPROB2",219,0) + ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",220,0) + ;G("snomed:353295004","dcterms:identifier")=353295004 +"RTN","C0SPROB2",221,0) + ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" +"RTN","C0SPROB2",222,0) + ;G("snomed:353295004","rdf:type")="sp:Code" +"RTN","C0SPROB2",223,0) + ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",224,0) + ;G("snomed:38341003","dcterms:identifier")=38341003 +"RTN","C0SPROB2",225,0) + ;G("snomed:38341003","dcterms:title")="Essential hypertension" +"RTN","C0SPROB2",226,0) + ;G("snomed:38341003","rdf:type")="sp:Code" +"RTN","C0SPROB2",227,0) + ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",228,0) + ;G("snomed:40930008","dcterms:identifier")=40930008 +"RTN","C0SPROB2",229,0) + ;G("snomed:40930008","dcterms:title")="Hypothyroidism" +"RTN","C0SPROB2",230,0) + ;G("snomed:40930008","rdf:type")="sp:Code" +"RTN","C0SPROB2",231,0) + ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",232,0) + ;G("snomed:44054006","dcterms:identifier")=44054006 +"RTN","C0SPROB2",233,0) + ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" +"RTN","C0SPROB2",234,0) + ;G("snomed:44054006","rdf:type")="sp:Code" +"RTN","C0SPROB2",235,0) + ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",236,0) + ;G("snomed:54302000","dcterms:identifier")=54302000 +"RTN","C0SPROB2",237,0) + ;G("snomed:54302000","dcterms:title")="Disorder of breast" +"RTN","C0SPROB2",238,0) + ;G("snomed:54302000","rdf:type")="sp:Code" +"RTN","C0SPROB2",239,0) + ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",240,0) + ;G("snomed:55822004","dcterms:identifier")=55822004 +"RTN","C0SPROB2",241,0) + ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" +"RTN","C0SPROB2",242,0) + ;G("snomed:55822004","rdf:type")="sp:Code" +"RTN","C0SPROB2",243,0) + ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",244,0) + ;G("snomed:8517006","dcterms:identifier")=8517006 +"RTN","C0SPROB2",245,0) + ;G("snomed:8517006","dcterms:title")="History of tobacco use" +"RTN","C0SPROB2",246,0) + ;G("snomed:8517006","rdf:type")="sp:Code" +"RTN","C0SPROB2",247,0) + ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" +"RTN","C0SPROB2",248,0) + +"RTN","C0SPROB2",249,0) + ; +"RTN","C0SPROB2",250,0) +PROB(GRTN,C0SARY) ; GRTN, passed by reference, +"RTN","C0SPROB2",251,0) + ; is the return name of the graph created. "" if none +"RTN","C0SPROB2",252,0) + ; C0SARY is passed in by reference and is the NHIN array of problems +"RTN","C0SPROB2",253,0) + ; +"RTN","C0SPROB2",254,0) + I $O(C0SARY("problem",""))="" D Q ; +"RTN","C0SPROB2",255,0) + . I $D(DEBUG) W !,"No Problems" +"RTN","C0SPROB2",256,0) + S GRTN="" ; default to no problems +"RTN","C0SPROB2",257,0) + N C0SGRF +"RTN","C0SPROB2",258,0) + S C0SGRF="vistaSmart:"_ZPATID_"/problems" +"RTN","C0SPROB2",259,0) + I $D(DEBUG) W !,"Processing ",C0SGRF +"RTN","C0SPROB2",260,0) + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph +"RTN","C0SPROB2",261,0) + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use +"RTN","C0SPROB2",262,0) + N FARY S FARY="C0XFARY" +"RTN","C0SPROB2",263,0) + D USEFARY^C0XF2N(FARY) +"RTN","C0SPROB2",264,0) + D VOCINIT^C0XUTIL +"RTN","C0SPROB2",265,0) + ; +"RTN","C0SPROB2",266,0) + D STARTADD^C0XF2N ; initialize to create triples +"RTN","C0SPROB2",267,0) + ; +"RTN","C0SPROB2",268,0) + N ZI S ZI="" +"RTN","C0SPROB2",269,0) + F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; +"RTN","C0SPROB2",270,0) + . N LRN,ZR ; ZR is the local array for building the new triples +"RTN","C0SPROB2",271,0) + . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result +"RTN","C0SPROB2",272,0) + . ; +"RTN","C0SPROB2",273,0) + . N PROBID ; unique Id for this problem +"RTN","C0SPROB2",274,0) + . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number +"RTN","C0SPROB2",275,0) + . ; +"RTN","C0SPROB2",276,0) + . ; i don't like this because the same problems gets a +"RTN","C0SPROB2",277,0) + . ; different ID every time it's reported. Can't trace it back to VistA +"RTN","C0SPROB2",278,0) + . ; I'd rather be using id@value ie "id@value")="118" +"RTN","C0SPROB2",279,0) + . ; +"RTN","C0SPROB2",280,0) + . N SNOMED,ICD S ICD=$G(@LRN@("icd@value")) +"RTN","C0SPROB2",281,0) + . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map +"RTN","C0SPROB2",282,0) + . N SNOGRF ; graph for SNOMED code +"RTN","C0SPROB2",283,0) + . I SNOMED="" D ; +"RTN","C0SPROB2",284,0) + . . S SNOMED=ICD ; if not found, return the ICD code +"RTN","C0SPROB2",285,0) + . . S SNOGRF="icd9:"_SNOMED +"RTN","C0SPROB2",286,0) + . E S SNOGRF="snomed:"_SNOMED +"RTN","C0SPROB2",287,0) + . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) +"RTN","C0SPROB2",288,0) + . I $D(DEBUG) D ; +"RTN","C0SPROB2",289,0) + . . W !,"Processing Problem List ",PROBID +"RTN","C0SPROB2",290,0) + . . W !,"problem: ",SNOTIT +"RTN","C0SPROB2",291,0) + . . W !,"code: ",SNOMED +"RTN","C0SPROB2",292,0) + . ; +"RTN","C0SPROB2",293,0) + . ; first do the base result graph +"RTN","C0SPROB2",294,0) + . ; +"RTN","C0SPROB2",295,0) + . S ZR("rdf:type")="sp:Problem" +"RTN","C0SPROB2",296,0) + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems +"RTN","C0SPROB2",297,0) + . ; ie /vista/smart/99912345/problems +"RTN","C0SPROB2",298,0) + . ; +"RTN","C0SPROB2",299,0) + . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name +"RTN","C0SPROB2",300,0) + . S ZR("sp:problemName")=PROBNAME +"RTN","C0SPROB2",301,0) + . ; +"RTN","C0SPROB2",302,0) + . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) +"RTN","C0SPROB2",303,0) + . S ZR("sp:startDate")=STARTDT +"RTN","C0SPROB2",304,0) + . ; +"RTN","C0SPROB2",305,0) + . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples +"RTN","C0SPROB2",306,0) + . K ZR ; clean up +"RTN","C0SPROB2",307,0) + . ; +"RTN","C0SPROB2",308,0) + . ; create the problemName graph +"RTN","C0SPROB2",309,0) + . ; +"RTN","C0SPROB2",310,0) + . S ZR("rdf:type")="sp:CodedValue" +"RTN","C0SPROB2",311,0) + . ;S ZR("sp:code")="snomed:"_SNOMED +"RTN","C0SPROB2",312,0) + . S ZR("sp:code")=SNOGRF +"RTN","C0SPROB2",313,0) + . S ZR("dcterms:title")=$G(@LRN@("name@value")) +"RTN","C0SPROB2",314,0) + . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) +"RTN","C0SPROB2",315,0) + . K ZR +"RTN","C0SPROB2",316,0) + . ; +"RTN","C0SPROB2",317,0) + . ; create snomed graph +"RTN","C0SPROB2",318,0) + . ; +"RTN","C0SPROB2",319,0) + . S ZR("rdf:type")="sp:Code" +"RTN","C0SPROB2",320,0) + . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" +"RTN","C0SPROB2",321,0) + . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9" +"RTN","C0SPROB2",322,0) + . S ZR("dcterms:identifier")=SNOMED +"RTN","C0SPROB2",323,0) + . S ZR("dcterms:title")=SNOTIT +"RTN","C0SPROB2",324,0) + . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) +"RTN","C0SPROB2",325,0) + . K ZR +"RTN","C0SPROB2",326,0) + . ; +"RTN","C0SPROB2",327,0) + D BULKLOAD^C0XF2N(.C0XFDA) +"RTN","C0SPROB2",328,0) + S GRTN=C0SGRF +"RTN","C0SPROB2",329,0) + Q +"RTN","C0SPROB2",330,0) + ; +"RTN","C0SPROB2",331,0) +SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code +"RTN","C0SPROB2",332,0) + ; requires the mapping table installed in the triplestore +"RTN","C0SPROB2",333,0) + ; +"RTN","C0SPROB2",334,0) + N ZSN,ZARY,ZSUB,ZSUBS +"RTN","C0SPROB2",335,0) + I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots +"RTN","C0SPROB2",336,0) + D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code +"RTN","C0SPROB2",337,0) + S ZSUB=$O(ZSUBS("")) ; pick the first one +"RTN","C0SPROB2",338,0) + I ZSUB="" Q "" +"RTN","C0SPROB2",339,0) + D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") +"RTN","C0SPROB2",340,0) + S ZSN=$O(ZARY("")) +"RTN","C0SPROB2",341,0) + I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") +"RTN","C0SPROB2",342,0) + Q ZSN +"RTN","C0SPROB2",343,0) + ; +"RTN","C0STBL") +0^11^B23989761 +"RTN","C0STBL",1,0) +C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 +"RTN","C0STBL",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0STBL",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0STBL",4,0) + ;General Public License See attached copy of the License. +"RTN","C0STBL",5,0) + ; +"RTN","C0STBL",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0STBL",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0STBL",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0STBL",9,0) + ;(at your option) any later version. +"RTN","C0STBL",10,0) + ; +"RTN","C0STBL",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0STBL",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0STBL",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0STBL",14,0) + ;GNU General Public License for more details. +"RTN","C0STBL",15,0) + ; +"RTN","C0STBL",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0STBL",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0STBL",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0STBL",19,0) + ; +"RTN","C0STBL",20,0) + Q +"RTN","C0STBL",21,0) +EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN +"RTN","C0STBL",22,0) + I '$D(BEGDFN) S BDGDFN="" +"RTN","C0STBL",23,0) + I '$D(DFNCNT) S DFNCNT=150 +"RTN","C0STBL",24,0) + I '$D(ZPART) S ZPART="" +"RTN","C0STBL",25,0) + N ZTBL S ZTBL=$NA(^TMP("C0STBL")) +"RTN","C0STBL",26,0) + N ZI,ZCNT,ZG +"RTN","C0STBL",27,0) + S ZI=$O(^DPT(BEGDFN),-1) +"RTN","C0STBL",28,0) + S ZCNT=1 +"RTN","C0STBL",29,0) + F S ZI=$O(^DPT(ZI)) Q:((+ZI=0)!(ZCNT>DFNCNT)) D ; +"RTN","C0STBL",30,0) + . S ZCNT=ZCNT+1 +"RTN","C0STBL",31,0) + . W ZI," " +"RTN","C0STBL",32,0) + . K ZG +"RTN","C0STBL",33,0) + . D EN^C0SNHIN(.ZG,ZI,ZPART) +"RTN","C0STBL",34,0) + . M @ZTBL@(ZI)=ZG +"RTN","C0STBL",35,0) + . K G +"RTN","C0STBL",36,0) + . N GDIR S GDIR="/home/vista/p/" +"RTN","C0STBL",37,0) + . D EN^C0SMART(.G,ZI,"med") +"RTN","C0STBL",38,0) + . I $D(G) W !,$$output^C0XGET1("G",ZI_"-med.rdf",GDIR) +"RTN","C0STBL",39,0) + . k G +"RTN","C0STBL",40,0) + . D EN^C0SMART(.G,ZI,"patient") +"RTN","C0STBL",41,0) + . I $D(G) W !,$$output^C0XGET1("G",ZI_"-patient.rdf",GDIR) +"RTN","C0STBL",42,0) + . K G +"RTN","C0STBL",43,0) + . D EN^C0SMART(.G,ZI,"lab") +"RTN","C0STBL",44,0) + . I $D(G) W !,$$output^C0XGET1("G",ZI_"-lab.rdf",GDIR) +"RTN","C0STBL",45,0) + . K G +"RTN","C0STBL",46,0) + . D EN^C0SMART(.G,ZI,"problem") +"RTN","C0STBL",47,0) + . I $D(G) W !,$$output^C0XGET1("G",ZI_"-problem.rdf",GDIR) +"RTN","C0STBL",48,0) + Q +"RTN","C0STBL",49,0) + ; +"RTN","C0STBL",50,0) +LOADHACK ; +"RTN","C0STBL",51,0) + N ZI +"RTN","C0STBL",52,0) + F ZI=2:1:374 D ; +"RTN","C0STBL",53,0) + . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/") +"RTN","C0STBL",54,0) + Q +"RTN","C0STBL",55,0) + ; +"RTN","C0STBL",56,0) +LABCNT ; COUNT LAB TESTS AND LOINC CODES +"RTN","C0STBL",57,0) + K LABCNT,GLOINC,PATCNT +"RTN","C0STBL",58,0) + S (LABCNT,GLOINC,PATCNT)=0 +"RTN","C0STBL",59,0) + N ZI S ZI="" +"RTN","C0STBL",60,0) + N GN S GN=$NA(^TMP("C0STBL")) +"RTN","C0STBL",61,0) + F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; +"RTN","C0STBL",62,0) + . S PATCNT=PATCNT+1 +"RTN","C0STBL",63,0) + . I '$D(@GN@(ZI,"lab")) Q ; +"RTN","C0STBL",64,0) + . N ZJ S ZJ="" +"RTN","C0STBL",65,0) + . F S ZJ=$O(@GN@(ZI,"lab",ZJ)) Q:ZJ="" D ; +"RTN","C0STBL",66,0) + . . S LABCNT=LABCNT+1 +"RTN","C0STBL",67,0) + . . S X=$G(@GN@(ZI,"lab",ZJ,"loinc@value")) +"RTN","C0STBL",68,0) + . . I X'="" S GLOINC=GLOINC+1 +"RTN","C0STBL",69,0) + W !,"Total number of patients: ",PATCNT +"RTN","C0STBL",70,0) + W !,"Total number of lab results: ",LABCNT +"RTN","C0STBL",71,0) + W !,"Total number of lab results with loinc codes: ",GLOINC +"RTN","C0STBL",72,0) + W !,"Percentage of lab tests with loinc codes: ",$P((GLOINC/LABCNT)*100,".")_"%" +"RTN","C0STBL",73,0) + Q +"RTN","C0STBL",74,0) + ; +"RTN","C0STBL",75,0) +PROBCNT ; COUNT PROBLEMS AND SNOMED CODES +"RTN","C0STBL",76,0) + K PROBCNT,GSNO,PATCNT +"RTN","C0STBL",77,0) + S (PROBCNT,GSNO,PATCNT)=0 +"RTN","C0STBL",78,0) + N ZI S ZI="" +"RTN","C0STBL",79,0) + N GN S GN=$NA(^TMP("C0STBL")) +"RTN","C0STBL",80,0) + F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; +"RTN","C0STBL",81,0) + . S PATCNT=PATCNT+1 +"RTN","C0STBL",82,0) + . I '$D(@GN@(ZI,"problem")) Q ; +"RTN","C0STBL",83,0) + . N ZJ S ZJ="" +"RTN","C0STBL",84,0) + . F S ZJ=$O(@GN@(ZI,"problem",ZJ)) Q:ZJ="" D ; +"RTN","C0STBL",85,0) + . . S PROBCNT=PROBCNT+1 +"RTN","C0STBL",86,0) + . . S X=$G(@GN@(ZI,"problem",ZJ,"icd@value")) +"RTN","C0STBL",87,0) + . . S Y=$$SNOMED^C0SPROB2(X) +"RTN","C0STBL",88,0) + . . I Y'="" S GSNO=GSNO+1 +"RTN","C0STBL",89,0) + W !,"Total number of patients: ",PATCNT +"RTN","C0STBL",90,0) + W !,"Total number of problems: ",PROBCNT +"RTN","C0STBL",91,0) + W !,"Total number of problems with snomed codes: ",GSNO +"RTN","C0STBL",92,0) + W !,"Percentage of problems with SNOMED codes: ",$P((GSNO/PROBCNT)*100,".")_"%" +"RTN","C0STBL",93,0) + Q +"RTN","C0STBL",94,0) + ; +"RTN","C0STBL",95,0) +MEDCNT ; COUNT INPATIENT VS OUTPATIENT MEDICATIONS +"RTN","C0STBL",96,0) + K MEDCNT,OMED,PATCNT,DOSE,UNITS,FORM,SCHED,ROUTE +"RTN","C0STBL",97,0) + S (MEDCNT,OMED,GSNO,PATCNT)=0 +"RTN","C0STBL",98,0) + N ZI S ZI="" +"RTN","C0STBL",99,0) + N GN S GN=$NA(^TMP("C0STBL")) +"RTN","C0STBL",100,0) + F S ZI=$O(@GN@(ZI)) Q:ZI="" D ; +"RTN","C0STBL",101,0) + . S PATCNT=PATCNT+1 +"RTN","C0STBL",102,0) + . I '$D(@GN@(ZI,"med")) Q ; +"RTN","C0STBL",103,0) + . N ZJ S ZJ="" +"RTN","C0STBL",104,0) + . F S ZJ=$O(@GN@(ZI,"med",ZJ)) Q:ZJ="" D ; +"RTN","C0STBL",105,0) + . . S MEDCNT=MEDCNT+1 +"RTN","C0STBL",106,0) + . . I $G(@GN@(ZI,"med",ZJ,"vaStatus@value"))="EXPIRED" D Q ; +"RTN","C0STBL",107,0) + . . . I $D(DEBUG) W !,"Expired Mediation, Skipping" +"RTN","C0STBL",108,0) + . . I $G(@GN@(ZI,"med",ZJ,"vaType@value"))="I" D Q ; +"RTN","C0STBL",109,0) + . . . I $D(DEBUG) W !,"Inpatient Med, skipping" +"RTN","C0STBL",110,0) + . . I $G(@GN@(ZI,"med",ZI,"vaType@value"))="V" D Q ; +"RTN","C0STBL",111,0) + . . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" +"RTN","C0STBL",112,0) + . . S OMED=OMED+1 +"RTN","C0STBL",113,0) + . . S X=$G(@GN@(ZI,"med",ZJ,"form@value")) +"RTN","C0STBL",114,0) + . . S FORM(X)=$G(FORM(X))+1 +"RTN","C0STBL",115,0) + . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@dose")) +"RTN","C0STBL",116,0) + . . I X="" S X="UNKNOWN" +"RTN","C0STBL",117,0) + . . S DOSE(X)=$G(DOSE(X))+1 +"RTN","C0STBL",118,0) + . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@units")) +"RTN","C0STBL",119,0) + . . I X="" S X="UNKNOWN" +"RTN","C0STBL",120,0) + . . S UNITS(X)=$G(UNITS(X))+1 +"RTN","C0STBL",121,0) + . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dose@schedule")) +"RTN","C0STBL",122,0) + . . I X="" S X="UNKNOWN" +"RTN","C0STBL",123,0) + . . S SCHED(X)=$G(SCHED(X))+1 +"RTN","C0STBL",124,0) + . . S X=$G(@GN@(ZI,"med",ZJ,"doses.dosc@route")) +"RTN","C0STBL",125,0) + . . I X="" S X="UNKNOWN" +"RTN","C0STBL",126,0) + . . S ROUTE(X)=$G(ROUTE(X))+1 +"RTN","C0STBL",127,0) + W !,"Total number of patients: ",PATCNT +"RTN","C0STBL",128,0) + W !,"Total number of medications: ",MEDCNT +"RTN","C0STBL",129,0) + W !,"Total number of outpatient medications: ",OMED +"RTN","C0STBL",130,0) + W !,"Percentage of outpatient medications: ",$P((OMED/MEDCNT)*100,".")_"%",! +"RTN","C0STBL",131,0) + ZWR FORM +"RTN","C0STBL",132,0) + ZWR DOSE +"RTN","C0STBL",133,0) + ZWR UNITS +"RTN","C0STBL",134,0) + ZWR SCHED +"RTN","C0STBL",135,0) + ZWR ROUTE +"RTN","C0STBL",136,0) + Q +"RTN","C0STBL",137,0) + ; +"RTN","C0SUTIL") +0^12^B1005502 +"RTN","C0SUTIL",1,0) +C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 +"RTN","C0SUTIL",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SUTIL",3,0) + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SUTIL",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SUTIL",5,0) + ; +"RTN","C0SUTIL",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SUTIL",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SUTIL",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SUTIL",9,0) + ;(at your option) any later version. +"RTN","C0SUTIL",10,0) + ; +"RTN","C0SUTIL",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SUTIL",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SUTIL",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SUTIL",14,0) + ;GNU General Public License for more details. +"RTN","C0SUTIL",15,0) + ; +"RTN","C0SUTIL",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SUTIL",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SUTIL",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SUTIL",19,0) + ; +"RTN","C0SUTIL",20,0) + Q +"RTN","C0SUTIL",21,0) + ; +"RTN","C0SUTIL",22,0) +SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd +"RTN","C0SUTIL",23,0) + ; ZDATE is a fileman format date +"RTN","C0SUTIL",24,0) + N TMPDT +"RTN","C0SUTIL",25,0) + S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date +"RTN","C0SUTIL",26,0) + S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens +"RTN","C0SUTIL",27,0) + I TMPDT="" S TMPDT="UNKNOWN" +"RTN","C0SUTIL",28,0) + N Z2,Z3 +"RTN","C0SUTIL",29,0) + S Z2=$P(TMPDT,"-",2) +"RTN","C0SUTIL",30,0) + S Z3=$P(TMPDT,"-",3) +"RTN","C0SUTIL",31,0) + I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2 +"RTN","C0SUTIL",32,0) + I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3 +"RTN","C0SUTIL",33,0) + Q TMPDT +"RTN","C0SUTIL",34,0) + ; +"RTN","C0SXPATH") +0^13^B521283143 +"RTN","C0SXPATH",1,0) +C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am +"RTN","C0SXPATH",2,0) + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 5 +"RTN","C0SXPATH",3,0) + ;Copyright 2008-2012 George Lilly. Licensed under the terms of the GNU +"RTN","C0SXPATH",4,0) + ;General Public License See attached copy of the License. +"RTN","C0SXPATH",5,0) + ; +"RTN","C0SXPATH",6,0) + ;This program is free software; you can redistribute it and/or modify +"RTN","C0SXPATH",7,0) + ;it under the terms of the GNU General Public License as published by +"RTN","C0SXPATH",8,0) + ;the Free Software Foundation; either version 2 of the License, or +"RTN","C0SXPATH",9,0) + ;(at your option) any later version. +"RTN","C0SXPATH",10,0) + ; +"RTN","C0SXPATH",11,0) + ;This program is distributed in the hope that it will be useful, +"RTN","C0SXPATH",12,0) + ;but WITHOUT ANY WARRANTY; without even the implied warranty of +"RTN","C0SXPATH",13,0) + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +"RTN","C0SXPATH",14,0) + ;GNU General Public License for more details. +"RTN","C0SXPATH",15,0) + ; +"RTN","C0SXPATH",16,0) + ;You should have received a copy of the GNU General Public License along +"RTN","C0SXPATH",17,0) + ;with this program; if not, write to the Free Software Foundation, Inc., +"RTN","C0SXPATH",18,0) + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +"RTN","C0SXPATH",19,0) + ; +"RTN","C0SXPATH",20,0) + W "This is an XML XPATH utility library",! +"RTN","C0SXPATH",21,0) + W ! +"RTN","C0SXPATH",22,0) + Q +"RTN","C0SXPATH",23,0) + ; +"RTN","C0SXPATH",24,0) +OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE +"RTN","C0SXPATH",25,0) + ; +"RTN","C0SXPATH",26,0) + N Y +"RTN","C0SXPATH",27,0) + S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) +"RTN","C0SXPATH",28,0) + I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR +"RTN","C0SXPATH",29,0) + I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR +"RTN","C0SXPATH",30,0) + Q +"RTN","C0SXPATH",31,0) + ; +"RTN","C0SXPATH",32,0) +PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) +"RTN","C0SXPATH",33,0) + ; VAL IS A STRING AND STK IS PASSED BY NAME +"RTN","C0SXPATH",34,0) + ; +"RTN","C0SXPATH",35,0) + I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE +"RTN","C0SXPATH",36,0) + S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH +"RTN","C0SXPATH",37,0) + S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY +"RTN","C0SXPATH",38,0) + Q +"RTN","C0SXPATH",39,0) + ; +"RTN","C0SXPATH",40,0) +POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL +"RTN","C0SXPATH",41,0) + ; VAL AND STK ARE PASSED BY REFERENCE +"RTN","C0SXPATH",42,0) + ; +"RTN","C0SXPATH",43,0) + I @STK@(0)<1 D ; IF ARRAY IS EMPTY +"RTN","C0SXPATH",44,0) + . S VAL="" +"RTN","C0SXPATH",45,0) + . S @STK@(0)=0 +"RTN","C0SXPATH",46,0) + I @STK@(0)>0 D ; +"RTN","C0SXPATH",47,0) + . S VAL=@STK@(@STK@(0)) +"RTN","C0SXPATH",48,0) + . K @STK@(@STK@(0)) +"RTN","C0SXPATH",49,0) + . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY +"RTN","C0SXPATH",50,0) + Q +"RTN","C0SXPATH",51,0) + ; +"RTN","C0SXPATH",52,0) +PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME +"RTN","C0SXPATH",53,0) + ; +"RTN","C0SXPATH",54,0) + N ZGI +"RTN","C0SXPATH",55,0) + F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY +"RTN","C0SXPATH",56,0) + . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT +"RTN","C0SXPATH",57,0) + Q +"RTN","C0SXPATH",58,0) + ; +"RTN","C0SXPATH",59,0) +MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK +"RTN","C0SXPATH",60,0) + ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS +"RTN","C0SXPATH",61,0) + ; REDUX IS A STRING TO REMOVE FROM THE RESULT +"RTN","C0SXPATH",62,0) + S RTN="" +"RTN","C0SXPATH",63,0) + N I +"RTN","C0SXPATH",64,0) + ; W "STK= ",STK,! +"RTN","C0SXPATH",65,0) + I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY +"RTN","C0SXPATH",66,0) + . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON +"RTN","C0SXPATH",67,0) + . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON +"RTN","C0SXPATH",68,0) + . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) +"RTN","C0SXPATH",69,0) + I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2) +"RTN","C0SXPATH",70,0) + Q +"RTN","C0SXPATH",71,0) + ; +"RTN","C0SXPATH",72,0) +XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG +"RTN","C0SXPATH",73,0) + ; AND WILL RETURN NAME +"RTN","C0SXPATH",74,0) + ; ISTR IS PASSED BY VALUE +"RTN","C0SXPATH",75,0) + N CUR,TMP +"RTN","C0SXPATH",76,0) + I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET +"RTN","C0SXPATH",77,0) + . S TMP=$P(ISTR,"<",2) +"RTN","C0SXPATH",78,0) + I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE +"RTN","C0SXPATH",79,0) + . S TMP=$P(TMP,"/",2) +"RTN","C0SXPATH",80,0) + S CUR=$P(TMP,">",1) ; EXTRACT THE NAME +"RTN","C0SXPATH",81,0) + ; W "CUR= ",CUR,! +"RTN","C0SXPATH",82,0) + I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> +"RTN","C0SXPATH",83,0) + . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER +"RTN","C0SXPATH",84,0) + ; W "CUR2= ",CUR,! +"RTN","C0SXPATH",85,0) + Q CUR +"RTN","C0SXPATH",86,0) + ; +"RTN","C0SXPATH",87,0) +XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML +"RTN","C0SXPATH",88,0) + ; VALUE WILL RETURN VALUE +"RTN","C0SXPATH",89,0) + N G +"RTN","C0SXPATH",90,0) + S G=$P(ISTR,">",2) ;STRIP OFF +"RTN","C0SXPATH",91,0) + Q $P(G,"<",1) ; STRIP OFF LEAVING VALUE +"RTN","C0SXPATH",92,0) + ; +"RTN","C0SXPATH",93,0) +VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV +"RTN","C0SXPATH",94,0) + ; VDX: @INVDX@(XPATH)=VALUE +"RTN","C0SXPATH",95,0) + ; VDV: @OUTVDV@(X1X2X3X4)=VALUE +"RTN","C0SXPATH",96,0) + ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE +"RTN","C0SXPATH",97,0) + ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS +"RTN","C0SXPATH",98,0) + ; @VDV@("XPATH",X1X2X3X4)="XPATH" +"RTN","C0SXPATH",99,0) + N ZA,ZI,ZW +"RTN","C0SXPATH",100,0) + S ZI="" +"RTN","C0SXPATH",101,0) + F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; +"RTN","C0SXPATH",102,0) + . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME +"RTN","C0SXPATH",103,0) + . W ZW,! +"RTN","C0SXPATH",104,0) + . S @OUTVDV@(ZW)=@INVDX@(ZI) +"RTN","C0SXPATH",105,0) + . S @OUTVDV@("XPATH",ZW)=ZI +"RTN","C0SXPATH",106,0) + Q +"RTN","C0SXPATH",107,0) + ; +"RTN","C0SXPATH",108,0) +VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG +"RTN","C0SXPATH",109,0) + ; VDX: @VDX@(XPATH)=VALUE +"RTN","C0SXPATH",110,0) + ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE +"RTN","C0SXPATH",111,0) + ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX +"RTN","C0SXPATH",112,0) + N ZA,ZI,ZW +"RTN","C0SXPATH",113,0) + S ZI="" +"RTN","C0SXPATH",114,0) + F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; +"RTN","C0SXPATH",115,0) + . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL // +"RTN","C0SXPATH",116,0) + . S ZW2=$P(ZW,"/",1) +"RTN","C0SXPATH",117,0) + . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK)) +"RTN","C0SXPATH",118,0) + . ;ZWR ZA +"RTN","C0SXPATH",119,0) + . S ZW2=ZA(1) +"RTN","C0SXPATH",120,0) + . F ZK=2:1:ZA(0) D ; +"RTN","C0SXPATH",121,0) + . . S ZW2=ZW2_""","""_ZA(ZK) +"RTN","C0SXPATH",122,0) + . K ZA +"RTN","C0SXPATH",123,0) + . S ZW2=""""_ZW2_"""" +"RTN","C0SXPATH",124,0) + . W ZW2,! +"RTN","C0SXPATH",125,0) + . S ZN=OUTXPG_"("_ZW2_")" +"RTN","C0SXPATH",126,0) + . S @ZN=@INVDX@(ZI) +"RTN","C0SXPATH",127,0) + Q +"RTN","C0SXPATH",128,0) + ; +"RTN","C0SXPATH",129,0) +XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY +"RTN","C0SXPATH",130,0) + ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE +"RTN","C0SXPATH",131,0) + ; +"RTN","C0SXPATH",132,0) + ;N G1 +"RTN","C0SXPATH",133,0) + D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED +"RTN","C0SXPATH",134,0) + D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM +"RTN","C0SXPATH",135,0) + Q +"RTN","C0SXPATH",136,0) + ; +"RTN","C0SXPATH",137,0) +DO +"RTN","C0SXPATH",138,0) + D XPG2XML("^GPL2B","^GPL2A") +"RTN","C0SXPATH",139,0) + Q +"RTN","C0SXPATH",140,0) + ; +"RTN","C0SXPATH",141,0) +T1 ; TEST OUT THESE ROUTINES +"RTN","C0SXPATH",142,0) + D XML2XPG("G2","^GPL") +"RTN","C0SXPATH",143,0) + D XPG2XML("G3","G2") +"RTN","C0SXPATH",144,0) + K ^GPLOUT +"RTN","C0SXPATH",145,0) + M ^GPLOUT=G3 +"RTN","C0SXPATH",146,0) + W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p") +"RTN","C0SXPATH",147,0) + Q +"RTN","C0SXPATH",148,0) + ; +"RTN","C0SXPATH",149,0) +XPG2XML(OUTXML,INXPG) ; +"RTN","C0SXPATH",150,0) + N C0CN,FWD,ZA,G,GA,ZQ +"RTN","C0SXPATH",151,0) + S ZQ=0 ; QUIT FLAG +"RTN","C0SXPATH",152,0) + F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING +"RTN","C0SXPATH",153,0) + . I '$D(C0CN) D ; FIRST TIME THROUGH +"RTN","C0SXPATH",154,0) + . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR +"RTN","C0SXPATH",155,0) + . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS +"RTN","C0SXPATH",156,0) + . . S G=$Q(@INXPG) ; THIS ONE +"RTN","C0SXPATH",157,0) + . . S GN=$Q(@G) ; NEXT ONE +"RTN","C0SXPATH",158,0) + . . S C0CN=1 ; SUBSCRIPT COUNT +"RTN","C0SXPATH",159,0) + . . S ZQ=0 ; QUIT FLAG +"RTN","C0SXPATH",160,0) + . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML +"RTN","C0SXPATH",161,0) + . . I $QS(G,1)="ContinuityOfCareRecord" D ; +"RTN","C0SXPATH",162,0) + . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK +"RTN","C0SXPATH",163,0) + . I FWD D ; GOING FORWARDS +"RTN","C0SXPATH",164,0) + . . I C0CN<$QL(G) D ; NOT A DATA NODE +"RTN","C0SXPATH",165,0) + . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT +"RTN","C0SXPATH",166,0) + . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT +"RTN","C0SXPATH",167,0) + . . . I @OUTXML@(@OUTXML@(0))="" D ; +"RTN","C0SXPATH",168,0) + . . . . S @OUTXML@(@OUTXML@(0))="" +"RTN","C0SXPATH",169,0) + . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE +"RTN","C0SXPATH",170,0) + . . E D ; AT THE DATA NODE +"RTN","C0SXPATH",171,0) + . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT +"RTN","C0SXPATH",172,0) + . . . D ZXVAL(ZA,@G) ; OUTPUT VAL FOR DATA NODE +"RTN","C0SXPATH",173,0) + . . . S FWD=0 ; GO BACKWARDS +"RTN","C0SXPATH",174,0) + . I 'FWD D ;GOING BACKWARDS +"RTN","C0SXPATH",175,0) + . . S GN=$Q(@G) ;NEXT XPATH +"RTN","C0SXPATH",176,0) + . . ;W "NEXT!",GN,! +"RTN","C0SXPATH",177,0) + . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT +"RTN","C0SXPATH",178,0) + . . I GN'="" D ; +"RTN","C0SXPATH",179,0) + . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT +"RTN","C0SXPATH",180,0) + . . . . D ZXC($QS(G,C0CN)) ; +"RTN","C0SXPATH",181,0) + . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL +"RTN","C0SXPATH",182,0) + . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH +"RTN","C0SXPATH",183,0) + . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT +"RTN","C0SXPATH",184,0) + . . . . S FWD=1 ; GOING FORWARD NOW +"RTN","C0SXPATH",185,0) + . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE +"RTN","C0SXPATH",186,0) + . . D ZXC($QS(G,C0CN)) ; LAST ONE +"RTN","C0SXPATH",187,0) + . . S ZQ=1 ; QUIT NOW +"RTN","C0SXPATH",188,0) + Q +"RTN","C0SXPATH",189,0) + ; +"RTN","C0SXPATH",190,0) +ZXO(WHAT) +"RTN","C0SXPATH",191,0) + D PUSH("GA",WHAT) +"RTN","C0SXPATH",192,0) + D PUSH(OUTXML,"<"_WHAT_">") +"RTN","C0SXPATH",193,0) + Q +"RTN","C0SXPATH",194,0) + ; +"RTN","C0SXPATH",195,0) +ZXC(WHAT) +"RTN","C0SXPATH",196,0) + D POP("GA",.TMP) +"RTN","C0SXPATH",197,0) + D PUSH(OUTXML,"") +"RTN","C0SXPATH",198,0) + Q +"RTN","C0SXPATH",199,0) + ; +"RTN","C0SXPATH",200,0) +ZXVAL(WHAT,VAL) +"RTN","C0SXPATH",201,0) + D PUSH(OUTXML,"<"_WHAT_">"_VAL_"") +"RTN","C0SXPATH",202,0) + Q +"RTN","C0SXPATH",203,0) + ; +"RTN","C0SXPATH",204,0) +INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce +"RTN","C0SXPATH",205,0) + ; an XPATH index; REDUX is a string to be removed from each xpath +"RTN","C0SXPATH",206,0) + ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME +"RTN","C0SXPATH",207,0) + ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE +"RTN","C0SXPATH",208,0) + ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG +"RTN","C0SXPATH",209,0) + ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME +"RTN","C0SXPATH",210,0) + ; @VDX@("XPATH")=VALUE +"RTN","C0SXPATH",211,0) + ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE +"RTN","C0SXPATH",212,0) + ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE +"RTN","C0SXPATH",213,0) + ; XML SECTION +"RTN","C0SXPATH",214,0) + ; IZXML IS PASSED BY NAME +"RTN","C0SXPATH",215,0) + ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE +"RTN","C0SXPATH",216,0) + N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT +"RTN","C0SXPATH",217,0) + N C0CSTK ; LEAVE OUT FOR DEBUGGING +"RTN","C0SXPATH",218,0) + I '$D(REDUX) S REDUX="" +"RTN","C0SXPATH",219,0) + I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX +"RTN","C0SXPATH",220,0) + N ZXML +"RTN","C0SXPATH",221,0) + I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD +"RTN","C0SXPATH",222,0) + E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP +"RTN","C0SXPATH",223,0) + I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM +"RTN","C0SXPATH",224,0) + . S I="",LCNT=0 +"RTN","C0SXPATH",225,0) + . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1 +"RTN","C0SXPATH",226,0) + E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY +"RTN","C0SXPATH",227,0) + I LCNT=0 D Q ; NO XML PASSED +"RTN","C0SXPATH",228,0) + . W "ERROR IN XML FILE",! +"RTN","C0SXPATH",229,0) + S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX +"RTN","C0SXPATH",230,0) + I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX +"RTN","C0SXPATH",231,0) + S C0CSTK(0)=0 ; INITIALIZE STACK +"RTN","C0SXPATH",232,0) + K LKASD ; KILL LOOKASIDE ARRAY +"RTN","C0SXPATH",233,0) + D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES +"RTN","C0SXPATH",234,0) + F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY +"RTN","C0SXPATH",235,0) + . S LINE=@IZXML@(I) +"RTN","C0SXPATH",236,0) + . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED +"RTN","C0SXPATH",237,0) + . . S @TEMPLATE@(I)=$$CLEAN(LINE) +"RTN","C0SXPATH",238,0) + . ;W LINE,! +"RTN","C0SXPATH",239,0) + . S FOUND=0 ; INTIALIZED FOUND FLAG +"RTN","C0SXPATH",240,0) + . I LINE?.E1"".E) D +"RTN","C0SXPATH",243,0) + . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS +"RTN","C0SXPATH",244,0) + . . . ; ON THE SAME LINE +"RTN","C0SXPATH",245,0) + . . . ; W "FOUND ",LINE,! +"RTN","C0SXPATH",246,0) + . . . S FOUND=1 ; SET FOUND FLAG +"RTN","C0SXPATH",247,0) + . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME +"RTN","C0SXPATH",248,0) + . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES +"RTN","C0SXPATH",249,0) + . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK +"RTN","C0SXPATH",250,0) + . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX +"RTN","C0SXPATH",251,0) + . . . ; W "MDX=",MDX,! +"RTN","C0SXPATH",252,0) + . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE +"RTN","C0SXPATH",253,0) + . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2 +"RTN","C0SXPATH",254,0) + . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1 +"RTN","C0SXPATH",255,0) + . . . . ;W "DUP:",MDX,! +"RTN","C0SXPATH",256,0) + . . . . ;I '$D(CURVAL) S CURVAL="" +"RTN","C0SXPATH",257,0) + . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL +"RTN","C0SXPATH",258,0) + . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER +"RTN","C0SXPATH",259,0) + . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE +"RTN","C0SXPATH",260,0) + . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST +"RTN","C0SXPATH",261,0) + . . . . S CURVAL=$$XVAL(LINE) ; VALUE +"RTN","C0SXPATH",262,0) + . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE +"RTN","C0SXPATH",263,0) + . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED +"RTN","C0SXPATH",264,0) + . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED +"RTN","C0SXPATH",265,0) + . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS +"RTN","C0SXPATH",266,0) + . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@") D ; BEGINNING OF A SECTION +"RTN","C0SXPATH",283,0) + . . . ; W "FOUND ",LINE,! +"RTN","C0SXPATH",284,0) + . . . S FOUND=1 ; SET FOUND FLAG +"RTN","C0SXPATH",285,0) + . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME +"RTN","C0SXPATH",286,0) + . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES +"RTN","C0SXPATH",287,0) + . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK +"RTN","C0SXPATH",288,0) + . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX +"RTN","C0SXPATH",289,0) + . . . ; W "MDX=",MDX,! +"RTN","C0SXPATH",290,0) + . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE +"RTN","C0SXPATH",291,0) + . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER +"RTN","C0SXPATH",292,0) + . . . . ;B +"RTN","C0SXPATH",293,0) + . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE +"RTN","C0SXPATH",294,0) + . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX +"RTN","C0SXPATH",295,0) + S @ZXML@("INDEXED")="" +"RTN","C0SXPATH",296,0) + S @ZXML@("//")="1^"_LCNT ; ROOT XPATH +"RTN","C0SXPATH",297,0) + I NOINX K @ZXML ; DELETE UNWANTED INDEX +"RTN","C0SXPATH",298,0) + Q +"RTN","C0SXPATH",299,0) + ; +"RTN","C0SXPATH",300,0) +MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES +"RTN","C0SXPATH",301,0) + ; +"RTN","C0SXPATH",302,0) + N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2 +"RTN","C0SXPATH",303,0) + F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY +"RTN","C0SXPATH",304,0) + . S ZLINE=@IZXML@(ZI) +"RTN","C0SXPATH",305,0) + . I ZI") D ; BEGINNING OF A SECTION +"RTN","C0SXPATH",309,0) + . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME +"RTN","C0SXPATH",310,0) + . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE +"RTN","C0SXPATH",311,0) + . . . . S OUTBUF(CUR,ZI+1)="" +"RTN","C0SXPATH",312,0) + ;ZWR OUTBUF +"RTN","C0SXPATH",313,0) + S ZI="" +"RTN","C0SXPATH",314,0) + F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE +"RTN","C0SXPATH",315,0) + . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE +"RTN","C0SXPATH",316,0) + . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ; +"RTN","C0SXPATH",317,0) + . S OUTBUF(ZI,ZN)="" +"RTN","C0SXPATH",318,0) + S ZA=1,ZI="",ZN="" +"RTN","C0SXPATH",319,0) + F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] +"RTN","C0SXPATH",320,0) + . S ZN="",ZA=1 +"RTN","C0SXPATH",321,0) + . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ; +"RTN","C0SXPATH",322,0) + . . S OUTBUF(ZI,ZN)="["_ZA_"]" +"RTN","C0SXPATH",323,0) + . . S ZA=ZA+1 +"RTN","C0SXPATH",324,0) + Q +"RTN","C0SXPATH",325,0) + ; +"RTN","C0SXPATH",326,0) +CLEAN(STR,TR) ; extrinsic function; returns string +"RTN","C0SXPATH",327,0) + ;; Removes all non printable characters from a string. +"RTN","C0SXPATH",328,0) + ;; STR by Value +"RTN","C0SXPATH",329,0) + ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE +"RTN","C0SXPATH",330,0) + N TR,I +"RTN","C0SXPATH",331,0) + I '$D(TR) D ; +"RTN","C0SXPATH",332,0) + . F I=0:1:31 S TR=$G(TR)_$C(I) +"RTN","C0SXPATH",333,0) + . S TR=TR_$C(127) +"RTN","C0SXPATH",334,0) + QUIT $TR(STR,TR) +"RTN","C0SXPATH",335,0) + ; +"RTN","C0SXPATH",336,0) +QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION +"RTN","C0SXPATH",337,0) + ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" +"RTN","C0SXPATH",338,0) + ; IARY AND OARY ARE PASSED BY NAME +"RTN","C0SXPATH",339,0) + I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY +"RTN","C0SXPATH",340,0) + . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML +"RTN","C0SXPATH",341,0) + N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN +"RTN","C0SXPATH",342,0) + N TMP,I,J,QXPATH +"RTN","C0SXPATH",343,0) + S FIRST=1 +"RTN","C0SXPATH",344,0) + I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE +"RTN","C0SXPATH",345,0) + . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK +"RTN","C0SXPATH",346,0) + S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT +"RTN","C0SXPATH",347,0) + I XPATH'="//" D ; NOT A ROOT QUERY +"RTN","C0SXPATH",348,0) + . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES +"RTN","C0SXPATH",349,0) + . S FIRST=$P(TMP,"^",1) +"RTN","C0SXPATH",350,0) + . S LAST=$P(TMP,"^",2) +"RTN","C0SXPATH",351,0) + K @OARY +"RTN","C0SXPATH",352,0) + S @OARY@(0)=+LAST-FIRST+1 +"RTN","C0SXPATH",353,0) + S J=1 +"RTN","C0SXPATH",354,0) + FOR I=FIRST:1:LAST D +"RTN","C0SXPATH",355,0) + . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY +"RTN","C0SXPATH",356,0) + . S J=J+1 +"RTN","C0SXPATH",357,0) + ; ZWR OARY +"RTN","C0SXPATH",358,0) + Q +"RTN","C0SXPATH",359,0) + ; +"RTN","C0SXPATH",360,0) +XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH +"RTN","C0SXPATH",361,0) + ; INDEX WITH TWO PIECES START^FINISH +"RTN","C0SXPATH",362,0) + ; IDX IS PASSED BY NAME +"RTN","C0SXPATH",363,0) + Q $P(@IDX@(XPATH),"^",1) +"RTN","C0SXPATH",364,0) + ; +"RTN","C0SXPATH",365,0) +XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH +"RTN","C0SXPATH",366,0) + ; INDEX WITH TWO PIECES START^FINISH +"RTN","C0SXPATH",367,0) + ; IDX IS PASSED BY NAME +"RTN","C0SXPATH",368,0) + Q $P(@IDX@(XPATH),"^",2) +"RTN","C0SXPATH",369,0) + ; +"RTN","C0SXPATH",370,0) +START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX +"RTN","C0SXPATH",371,0) + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH +"RTN","C0SXPATH",372,0) + ; COMPANION TO FINISH ; IDX IS PASSED BY NAME +"RTN","C0SXPATH",373,0) + Q $P(ISTR,";",2) +"RTN","C0SXPATH",374,0) + ; +"RTN","C0SXPATH",375,0) +FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX +"RTN","C0SXPATH",376,0) + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH +"RTN","C0SXPATH",377,0) + Q $P(ISTR,";",3) +"RTN","C0SXPATH",378,0) + ; +"RTN","C0SXPATH",379,0) +ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX +"RTN","C0SXPATH",380,0) + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH +"RTN","C0SXPATH",381,0) + Q $P(ISTR,";",1) +"RTN","C0SXPATH",382,0) + ; +"RTN","C0SXPATH",383,0) +BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST +"RTN","C0SXPATH",384,0) + ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST +"RTN","C0SXPATH",385,0) + ; DEST IS CLEARED TO START +"RTN","C0SXPATH",386,0) + ; USES PUSH TO DO THE COPY +"RTN","C0SXPATH",387,0) + N I +"RTN","C0SXPATH",388,0) + K @BDEST +"RTN","C0SXPATH",389,0) + F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST +"RTN","C0SXPATH",390,0) + . N J,ATMP +"RTN","C0SXPATH",391,0) + . S ATMP=$$ARRAY(@BLIST@(I)) +"RTN","C0SXPATH",392,0) + . I $G(DEBUG) W "ATMP=",ATMP,! +"RTN","C0SXPATH",393,0) + . I $G(DEBUG) W @BLIST@(I),! +"RTN","C0SXPATH",394,0) + . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; +"RTN","C0SXPATH",395,0) + . . ; FOR EACH LINE IN THIS INSTR +"RTN","C0SXPATH",396,0) + . . I $G(DEBUG) W "BDEST= ",BDEST,! +"RTN","C0SXPATH",397,0) + . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! +"RTN","C0SXPATH",398,0) + . . D PUSH(BDEST,@ATMP@(J)) +"RTN","C0SXPATH",399,0) + Q +"RTN","C0SXPATH",400,0) + ; +"RTN","C0SXPATH",401,0) +QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST +"RTN","C0SXPATH",402,0) + ; +"RTN","C0SXPATH",403,0) + I $G(DEBUG) W "QUEUEING ",BLST,! +"RTN","C0SXPATH",404,0) + D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) +"RTN","C0SXPATH",405,0) + Q +"RTN","C0SXPATH",406,0) + ; +"RTN","C0SXPATH",407,0) +CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME +"RTN","C0SXPATH",408,0) + ; KILLS CPDEST FIRST +"RTN","C0SXPATH",409,0) + N CPINSTR +"RTN","C0SXPATH",410,0) + I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! +"RTN","C0SXPATH",411,0) + I @CPSRC@(0)<1 D ; BAD LENGTH +"RTN","C0SXPATH",412,0) + . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! +"RTN","C0SXPATH",413,0) + . Q +"RTN","C0SXPATH",414,0) + ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT +"RTN","C0SXPATH",415,0) + D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY +"RTN","C0SXPATH",416,0) + D BUILD("CPINSTR",CPDEST) +"RTN","C0SXPATH",417,0) + Q +"RTN","C0SXPATH",418,0) + ; +"RTN","C0SXPATH",419,0) +QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST +"RTN","C0SXPATH",420,0) + ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD +"RTN","C0SXPATH",421,0) + ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT +"RTN","C0SXPATH",422,0) + ; USED TO INSERT CHILDREN NODES +"RTN","C0SXPATH",423,0) + I @QOXML@(0)<1 D ; MALFORMED XML +"RTN","C0SXPATH",424,0) + . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! +"RTN","C0SXPATH",425,0) + . Q +"RTN","C0SXPATH",426,0) + I $G(DEBUG) W "DOING QOPEN",! +"RTN","C0SXPATH",427,0) + N S1,E1,QOT,QOTMP +"RTN","C0SXPATH",428,0) + S S1=1 ; OPEN FROM THE BEGINNING OF THE XML +"RTN","C0SXPATH",429,0) + I $D(QOXPATH) D ; XPATH PROVIDED +"RTN","C0SXPATH",430,0) + . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX +"RTN","C0SXPATH",431,0) + . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 +"RTN","C0SXPATH",432,0) + I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT +"RTN","C0SXPATH",433,0) + . S E1=@QOXML@(0)-1 +"RTN","C0SXPATH",434,0) + D QUEUE(QOBLIST,QOXML,S1,E1) +"RTN","C0SXPATH",435,0) + ; S QOTMP=QOXML_"^"_S1_"^"_E1 +"RTN","C0SXPATH",436,0) + ; D PUSH(QOBLIST,QOTMP) +"RTN","C0SXPATH",437,0) + Q +"RTN","C0SXPATH",438,0) + ; +"RTN","C0SXPATH",439,0) +QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN +"RTN","C0SXPATH",440,0) + ; ADDS THE LIST LINE OF QCXML TO QCBLIST +"RTN","C0SXPATH",441,0) + ; USED TO FINISH INSERTING CHILDERN NODES +"RTN","C0SXPATH",442,0) + ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END +"RTN","C0SXPATH",443,0) + ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO +"RTN","C0SXPATH",444,0) + I @QCXML@(0)<1 D ; MALFORMED XML +"RTN","C0SXPATH",445,0) + . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! +"RTN","C0SXPATH",446,0) + I $G(DEBUG) W "GOING TO CLOSE",! +"RTN","C0SXPATH",447,0) + N S1,E1,QCT,QCTMP +"RTN","C0SXPATH",448,0) + S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML +"RTN","C0SXPATH",449,0) + I $D(QCXPATH) D ; XPATH PROVIDED +"RTN","C0SXPATH",450,0) + . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX +"RTN","C0SXPATH",451,0) + . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML +"RTN","C0SXPATH",452,0) + I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT +"RTN","C0SXPATH",453,0) + . S S1=@QCXML@(0) +"RTN","C0SXPATH",454,0) + D QUEUE(QCBLIST,QCXML,S1,E1) +"RTN","C0SXPATH",455,0) + ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) +"RTN","C0SXPATH",456,0) + Q +"RTN","C0SXPATH",457,0) + ; +"RTN","C0SXPATH",458,0) +INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE +"RTN","C0SXPATH",459,0) + ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS +"RTN","C0SXPATH",460,0) + ; OMITTED, INSERTION WILL BE AT THE ROOT +"RTN","C0SXPATH",461,0) + ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW +"RTN","C0SXPATH",462,0) + ; XML AT THE END OF THE XPATH POINT +"RTN","C0SXPATH",463,0) + ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE +"RTN","C0SXPATH",464,0) + N INSBLD,INSTMP +"RTN","C0SXPATH",465,0) + I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! +"RTN","C0SXPATH",466,0) + I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! +"RTN","C0SXPATH",467,0) + I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY +"RTN","C0SXPATH",468,0) + . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT +"RTN","C0SXPATH",469,0) + I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY +"RTN","C0SXPATH",470,0) + . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH +"RTN","C0SXPATH",471,0) + . I $D(INSXPATH) D ; XPATH PROVIDED +"RTN","C0SXPATH",472,0) + . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE +"RTN","C0SXPATH",473,0) + . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") +"RTN","C0SXPATH",474,0) + . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT +"RTN","C0SXPATH",475,0) + . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH +"RTN","C0SXPATH",476,0) + . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML +"RTN","C0SXPATH",477,0) + . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML +"RTN","C0SXPATH",478,0) + . I $D(INSXPATH) D ; XPATH PROVIDED +"RTN","C0SXPATH",479,0) + . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH +"RTN","C0SXPATH",480,0) + . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT +"RTN","C0SXPATH",481,0) + . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH +"RTN","C0SXPATH",482,0) + . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST +"RTN","C0SXPATH",483,0) + . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE +"RTN","C0SXPATH",484,0) + Q +"RTN","C0SXPATH",485,0) + ; +"RTN","C0SXPATH",486,0) +INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW +"RTN","C0SXPATH",487,0) + ; INTO INNXML AT THE INNXPATH XPATH POINT +"RTN","C0SXPATH",488,0) + ; +"RTN","C0SXPATH",489,0) + N INNBLD,UXPATH +"RTN","C0SXPATH",490,0) + N INNTBUF +"RTN","C0SXPATH",491,0) + S INNTBUF=$NA(^TMP($J,"INNTBUF")) +"RTN","C0SXPATH",492,0) + I '$D(INNXPATH) D ; XPATH NOT PASSED +"RTN","C0SXPATH",493,0) + . S UXPATH="//" ; USE ROOT XPATH +"RTN","C0SXPATH",494,0) + I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED +"RTN","C0SXPATH",495,0) + I '$D(@INNXML@(0)) D ; INNXML IS EMPTY +"RTN","C0SXPATH",496,0) + . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER +"RTN","C0SXPATH",497,0) + . D BUILD("INNBLD",INNXML) +"RTN","C0SXPATH",498,0) + I @INNXML@(0)>0 D ; NOT EMPTY +"RTN","C0SXPATH",499,0) + . D QOPEN("INNBLD",INNXML,UXPATH) ; +"RTN","C0SXPATH",500,0) + . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML +"RTN","C0SXPATH",501,0) + . D QCLOSE("INNBLD",INNXML,UXPATH) +"RTN","C0SXPATH",502,0) + . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER +"RTN","C0SXPATH",503,0) + . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST +"RTN","C0SXPATH",504,0) + Q +"RTN","C0SXPATH",505,0) + ; +"RTN","C0SXPATH",506,0) +INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST +"RTN","C0SXPATH",507,0) + ; BUT XDEST AN XNEW ARE PASSED BY NAME +"RTN","C0SXPATH",508,0) + N XBLD,XTMP +"RTN","C0SXPATH",509,0) + D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT +"RTN","C0SXPATH",510,0) + D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST +"RTN","C0SXPATH",511,0) + D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION +"RTN","C0SXPATH",512,0) + D BUILD("XBLD","XTMP") ; BUILD THE RESULT +"RTN","C0SXPATH",513,0) + D CP("XTMP",XDEST) ; COPY TO THE DESTINATION +"RTN","C0SXPATH",514,0) + I $G(DEBUG) D PARY("XDEST") +"RTN","C0SXPATH",515,0) + Q +"RTN","C0SXPATH",516,0) + ; +"RTN","C0SXPATH",517,0) +REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT +"RTN","C0SXPATH",518,0) + ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE +"RTN","C0SXPATH",519,0) + ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE +"RTN","C0SXPATH",520,0) + ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") +"RTN","C0SXPATH",521,0) + N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP +"RTN","C0SXPATH",522,0) + S OLD=$NA(^TMP($J,"REPLACE_OLD")) +"RTN","C0SXPATH",523,0) + D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD +"RTN","C0SXPATH",524,0) + S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS +"RTN","C0SXPATH",525,0) + S XFIRST=$P(XNODE,"^",1) +"RTN","C0SXPATH",526,0) + S XLAST=$P(XNODE,"^",2) +"RTN","C0SXPATH",527,0) + I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG +"RTN","C0SXPATH",528,0) + . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE +"RTN","C0SXPATH",529,0) + . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST +"RTN","C0SXPATH",530,0) + I RENEW'="" D ; NEW XML IS NOT NULL +"RTN","C0SXPATH",531,0) + . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE +"RTN","C0SXPATH",532,0) + . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW +"RTN","C0SXPATH",533,0) + . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST +"RTN","C0SXPATH",534,0) + I $G(DEBUG) W "REPLACE PREBUILD",! +"RTN","C0SXPATH",535,0) + I $G(DEBUG) D PARY("REBLD") +"RTN","C0SXPATH",536,0) + D BUILD("REBLD","RTMP") +"RTN","C0SXPATH",537,0) + K @REXML ; KILL WHAT WAS THERE +"RTN","C0SXPATH",538,0) + D CP("RTMP",REXML) ; COPY IN THE RESULT +"RTN","C0SXPATH",539,0) + Q +"RTN","C0SXPATH",540,0) + ; +"RTN","C0SXPATH",541,0) +DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT +"RTN","C0SXPATH",542,0) + ; REXML IS PASSED BY NAME XPATH IS A VALUE +"RTN","C0SXPATH",543,0) + N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP +"RTN","C0SXPATH",544,0) + S OLD=$NA(^TMP($J,"REPLACE_OLD")) +"RTN","C0SXPATH",545,0) + D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD +"RTN","C0SXPATH",546,0) + S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS +"RTN","C0SXPATH",547,0) + S XFIRST=$P(XNODE,"^",1) +"RTN","C0SXPATH",548,0) + S XLAST=$P(XNODE,"^",2) +"RTN","C0SXPATH",549,0) + D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE +"RTN","C0SXPATH",550,0) + D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST +"RTN","C0SXPATH",551,0) + I $G(DEBUG) D PARY("REBLD") +"RTN","C0SXPATH",552,0) + D BUILD("REBLD","RTMP") +"RTN","C0SXPATH",553,0) + K @REXML ; KILL WHAT WAS THERE +"RTN","C0SXPATH",554,0) + D CP("RTMP",REXML) ; COPY IN THE RESULT +"RTN","C0SXPATH",555,0) + Q +"RTN","C0SXPATH",556,0) + ; +"RTN","C0SXPATH",557,0) +MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY +"RTN","C0SXPATH",558,0) + ; W "Reporting on the missing",! +"RTN","C0SXPATH",559,0) + ; W OARY +"RTN","C0SXPATH",560,0) + I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q +"RTN","C0SXPATH",561,0) + N I +"RTN","C0SXPATH",562,0) + S @OARY@(0)=0 ; INITIALIZED MISSING COUNT +"RTN","C0SXPATH",563,0) + F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY +"RTN","C0SXPATH",564,0) + . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE +"RTN","C0SXPATH",565,0) + . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY +"RTN","C0SXPATH",566,0) + . . Q +"RTN","C0SXPATH",567,0) + Q +"RTN","C0SXPATH",568,0) + ; +"RTN","C0SXPATH",569,0) +MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY +"RTN","C0SXPATH",570,0) + ; AND PUT THE RESULTS IN OXML +"RTN","C0SXPATH",571,0) + N XCNT +"RTN","C0SXPATH",572,0) + I '$D(DEBUG) S DEBUG=0 +"RTN","C0SXPATH",573,0) + I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q +"RTN","C0SXPATH",574,0) + I '$D(@IXML@(0)) D ; INITIALIZE COUNT +"RTN","C0SXPATH",575,0) + . S XCNT=$O(@IXML@(""),-1) +"RTN","C0SXPATH",576,0) + E S XCNT=@IXML@(0) ;COUNT +"RTN","C0SXPATH",577,0) + I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q +"RTN","C0SXPATH",578,0) + N I,J,TNAM,TVAL,TSTR +"RTN","C0SXPATH",579,0) + S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT +"RTN","C0SXPATH",580,0) + F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY +"RTN","C0SXPATH",581,0) + . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT +"RTN","C0SXPATH",582,0) + . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? +"RTN","C0SXPATH",583,0) + . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS +"RTN","C0SXPATH",584,0) + . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS +"RTN","C0SXPATH",585,0) + . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! +"RTN","C0SXPATH",586,0) + . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME +"RTN","C0SXPATH",587,0) + . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED +"RTN","C0SXPATH",588,0) + . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? +"RTN","C0SXPATH",589,0) + . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD +"RTN","C0SXPATH",590,0) + . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE +"RTN","C0SXPATH",591,0) + . . . . E D DOFLD ; PROCESS A FIELD +"RTN","C0SXPATH",592,0) + . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE +"RTN","C0SXPATH",593,0) + . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER +"RTN","C0SXPATH",594,0) + . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES +"RTN","C0SXPATH",595,0) + . . I DEBUG W TSTR +"RTN","C0SXPATH",596,0) + I DEBUG W "MAPPED",! +"RTN","C0SXPATH",597,0) + Q +"RTN","C0SXPATH",598,0) + ; +"RTN","C0SXPATH",599,0) +DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE +"RTN","C0SXPATH",600,0) + ; +"RTN","C0SXPATH",601,0) + Q +"RTN","C0SXPATH",602,0) + ; +"RTN","C0SXPATH",603,0) +TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS +"RTN","C0SXPATH",604,0) + ; THEXML IS PASSED BY NAME +"RTN","C0SXPATH",605,0) + N I,J,TMPXML,DEL,FOUND,INTXT +"RTN","C0SXPATH",606,0) + S FOUND=0 +"RTN","C0SXPATH",607,0) + S INTXT=0 +"RTN","C0SXPATH",608,0) + I $G(DEBUG) W "DELETING EMPTY ELEMENTS",! +"RTN","C0SXPATH",609,0) + F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY +"RTN","C0SXPATH",610,0) + . S J=@THEXML@(I) +"RTN","C0SXPATH",611,0) + . I J["" D +"RTN","C0SXPATH",612,0) + . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM +"RTN","C0SXPATH",613,0) + . . I $G(DEBUG) W "IN HTML SECTION",! +"RTN","C0SXPATH",614,0) + . N JM,JP,JPX ; JMINUS AND JPLUS +"RTN","C0SXPATH",615,0) + . S JM=@THEXML@(I-1) ; LINE BEFORE +"RTN","C0SXPATH",616,0) + . I JM["" S INTXT=0 ; LEFT HTML SECTION,START TRIM +"RTN","C0SXPATH",617,0) + . S JP=@THEXML@(I+1) ; LINE AFTER +"RTN","C0SXPATH",618,0) + . I INTXT=0 D ; IF NOT IN AN HTML SECTION +"RTN","C0SXPATH",619,0) + . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH +"RTN","C0SXPATH",620,0) + . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES +"RTN","C0SXPATH",621,0) + . . . I $G(DEBUG) W I,J,JP,! +"RTN","C0SXPATH",622,0) + . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED +"RTN","C0SXPATH",623,0) + . . . S DEL(I)="" ; SET LINE TO DELETE +"RTN","C0SXPATH",624,0) + . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE +"RTN","C0SXPATH",625,0) + . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE +"RTN","C0SXPATH",626,0) + . . . I $G(DEBUG) W I,J,! +"RTN","C0SXPATH",627,0) + . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED +"RTN","C0SXPATH",628,0) + . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED +"RTN","C0SXPATH",629,0) + . . . I JM=JPX D ; +"RTN","C0SXPATH",630,0) + . . . . I $G(DEBUG) W I,JM_J_JPX,! +"RTN","C0SXPATH",631,0) + . . . . S DEL(I-1)="" +"RTN","C0SXPATH",632,0) + . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL +"RTN","C0SXPATH",633,0) + ; . I J'["><" D PUSH("TMPXML",J) +"RTN","C0SXPATH",634,0) + I FOUND D ; NEED TO DELETE THINGS +"RTN","C0SXPATH",635,0) + . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES +"RTN","C0SXPATH",636,0) + . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED +"RTN","C0SXPATH",637,0) + . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY +"RTN","C0SXPATH",638,0) + . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY +"RTN","C0SXPATH",639,0) + Q FOUND +"RTN","C0SXPATH",640,0) + ; +"RTN","C0SXPATH",641,0) +UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML +"RTN","C0SXPATH",642,0) + ; XSEC IS A SECTION PASSED BY NAME +"RTN","C0SXPATH",643,0) + N XBLD,XTMP +"RTN","C0SXPATH",644,0) + D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML +"RTN","C0SXPATH",645,0) + D BUILD("XBLD","XTMP") ; BUILD THE RESULT +"RTN","C0SXPATH",646,0) + D CP("XTMP",XSEC) ; REPLACE PASSED XML +"RTN","C0SXPATH",647,0) + Q +"RTN","C0SXPATH",648,0) + ; +"RTN","C0SXPATH",649,0) +PARY(GLO,ZN) ;PRINT AN ARRAY +"RTN","C0SXPATH",650,0) + ; IF ZN=-1 NO LINE NUMBERS +"RTN","C0SXPATH",651,0) + N I +"RTN","C0SXPATH",652,0) + F I=1:1:@GLO@(0) D ; +"RTN","C0SXPATH",653,0) + . I $G(ZN)=-1 W @GLO@(I),! +"RTN","C0SXPATH",654,0) + . E W I_" "_@GLO@(I),! +"RTN","C0SXPATH",655,0) + Q +"RTN","C0SXPATH",656,0) + ; +"RTN","C0SXPATH",657,0) +H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY +"RTN","C0SXPATH",658,0) + ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE +"RTN","C0SXPATH",659,0) + I '$D(IPRE) S IPRE="" +"RTN","C0SXPATH",660,0) + N H2I S H2I="" +"RTN","C0SXPATH",661,0) + ; W $O(@IHASH@(H2I)),! +"RTN","C0SXPATH",662,0) + F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH +"RTN","C0SXPATH",663,0) + . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES +"RTN","C0SXPATH",664,0) + . . ;W H2I_"^"_@IHASH@(H2I),! +"RTN","C0SXPATH",665,0) + . . N IH,IHI +"RTN","C0SXPATH",666,0) + . . S IH=$NA(@IHASH@(H2I)) ; +"RTN","C0SXPATH",667,0) + . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR +"RTN","C0SXPATH",668,0) + . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE +"RTN","C0SXPATH",669,0) + . . S IHI="" ; INDEX INTO "M" MULTIPLES +"RTN","C0SXPATH",670,0) + . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE +"RTN","C0SXPATH",671,0) + . . . ; W @IH@(IHI) +"RTN","C0SXPATH",672,0) + . . . S IH3=$NA(@IH2@(IHI)) +"RTN","C0SXPATH",673,0) + . . . ; W "HEY",IH3,! +"RTN","C0SXPATH",674,0) + . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS +"RTN","C0SXPATH",675,0) + . . ; W IH,! +"RTN","C0SXPATH",676,0) + . . ; W "C0CZZ",! +"RTN","C0SXPATH",677,0) + . . ; W $NA(@IHASH@(H2I)),! +"RTN","C0SXPATH",678,0) + . . Q ; +"RTN","C0SXPATH",679,0) + . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I)) +"RTN","C0SXPATH",680,0) + . ; W @IARYRTN@(0),! +"RTN","C0SXPATH",681,0) + Q +"RTN","C0SXPATH",682,0) + ; +"RTN","C0SXPATH",683,0) +XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES +"RTN","C0SXPATH",684,0) + ; DEFINED IN INPUT XML XVIXML BY @@VAR@@ +"RTN","C0SXPATH",685,0) + ; XVRTN AND XVIXML ARE PASSED BY NAME +"RTN","C0SXPATH",686,0) + ; +"RTN","C0SXPATH",687,0) + N XVI,XVTMP,XVT +"RTN","C0SXPATH",688,0) + F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML +"RTN","C0SXPATH",689,0) + . S XVT=@XVIXML@(XVI) +"RTN","C0SXPATH",690,0) + . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI +"RTN","C0SXPATH",691,0) + D H2ARY(XVRTN,"XVTMP") +"RTN","C0SXPATH",692,0) + Q +"RTN","C0SXPATH",693,0) + ; +"RTN","C0SXPATH",694,0) +DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE +"RTN","C0SXPATH",695,0) + ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE +"RTN","C0SXPATH",696,0) + ; +"RTN","C0SXPATH",697,0) + N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED +"RTN","C0SXPATH",698,0) + I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE +"RTN","C0SXPATH",699,0) + . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP +"RTN","C0SXPATH",700,0) + . S DXUSE="DTMP" ; DXUSE IS NAME +"RTN","C0SXPATH",701,0) + E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE +"RTN","C0SXPATH",702,0) + . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP +"RTN","C0SXPATH",703,0) + . S DXUSE="DTMP" ; DXUSE IS NAME +"RTN","C0SXPATH",704,0) + E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE +"RTN","C0SXPATH",705,0) + N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE +"RTN","C0SXPATH",706,0) + D XVARS("DVARS",DXUSE) ; PULL OUT VARS +"RTN","C0SXPATH",707,0) + D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM +"RTN","C0SXPATH",708,0) + Q +"RTN","C0SXPATH",709,0) + ; +"RTN","C0SXPATH",710,0) +TEST ; Run all the test cases +"RTN","C0SXPATH",711,0) + D TESTALL^C0CUNIT("C0CXPAT0") +"RTN","C0SXPATH",712,0) + Q +"RTN","C0SXPATH",713,0) + ; +"RTN","C0SXPATH",714,0) +ZTEST(WHICH) ; RUN ONE SET OF TESTS +"RTN","C0SXPATH",715,0) + N ZTMP +"RTN","C0SXPATH",716,0) + S DEBUG=1 +"RTN","C0SXPATH",717,0) + D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") +"RTN","C0SXPATH",718,0) + D ZTEST^C0CUNIT(.ZTMP,WHICH) +"RTN","C0SXPATH",719,0) + Q +"RTN","C0SXPATH",720,0) + ; +"RTN","C0SXPATH",721,0) +TLIST ; LIST THE TESTS +"RTN","C0SXPATH",722,0) + N ZTMP +"RTN","C0SXPATH",723,0) + D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") +"RTN","C0SXPATH",724,0) + D TLIST^C0CUNIT(.ZTMP) +"RTN","C0SXPATH",725,0) + Q +"RTN","C0SXPATH",726,0) + ; +"VER") +8.0^22.0 +**END** +**END** Index: /smart/trunk/p/C0SDEM.m =================================================================== --- /smart/trunk/p/C0SDEM.m (revision 1570) +++ /smart/trunk/p/C0SDEM.m (revision 1571) @@ -1,289 +1,289 @@ -C0SDEM ; GPL - Smart Demographics Processing ;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; - ; - ; - ; - ; - ; - ; Bob - ; J - ; Odenkirk - ; - ; - ; - ; - ; - ; - ; - ; - ; 15 Main St - ; Apt 2 - ; Wonderland - ; OZ - ; 54321 - ; USA - ; - ; - ; - ; - ; - ; - ; - ; 800-555-1212 - ; - ; - ; - ; - ; - ; - ; 800-555-1515 - ; - ; - ; - ; male - ; 1959-12-25 - ; bob.odenkirk@example.com - ; - ; - ; - ; My Hospital Record 2304575 - ; 2304575 - ; My Hospital Record - ; - ; - ; - ; - ; - ; - ; - ; - ; - ; - ; Bob - ; J - ; Odenkirk - ; - ; - ; - ; - ; - ; - ; - ; - ; 15 Main St - ; Apt 2 - ; Wonderland - ; OZ - ; 54321 - ; USA - ; - ; - ; - ; - ; - ; - ; - ; 800-555-1212 - ; - ; - ; - ; - ; - ; - ; 800-555-1515 - ; - ; - ; - ; male - ; 1959-12-25 - ; bob.odenkirk@example.com - ; - ; - ; - ; My Hospital Record 2304575 - ; 2304575 - ; My Hospital Record - ; - ; - ; - ; - ; - ;G(1)="nodeID:25591^rdf:type^v:Home" - ;G(2)="nodeID:25591^rdf:type^v:Pref" - ;G(3)="nodeID:25591^rdf:type^v:Tel" - ;G(4)="nodeID:25591^rdf:value^800-369-6403" - ;G(5)="nodeID:25611^rdf:type^v:Name" - ;G(6)="nodeID:25611^v:additional-name^N" - ;G(7)="nodeID:25611^v:family-name^Brooks" - ;G(8)="nodeID:25611^v:given-name^Brian" - ;G(9)="nodeID:25622^dcterms:identifier^981968" - ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968" - ;G(11)="nodeID:25622^rdf:type^sp:Code" - ;G(12)="nodeID:25622^sp:system^My Hospital Record" - ;G(13)="nodeID:25623^rdf:type^v:Address" - ;G(14)="nodeID:25623^rdf:type^v:Home" - ;G(15)="nodeID:25623^rdf:type^v:Pref" - ;G(16)="nodeID:25623^v:locality^Bixby" - ;G(17)="nodeID:25623^v:postal-code^74008" - ;G(18)="nodeID:25623^v:region^OK" - ;G(19)="nodeID:25623^v:street-address^82 Lake St" - ;G(20)="smart:981968/demographics^foaf:gender^male" - ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics" - ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968" - ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622" - ;G(24)="smart:981968/demographics^v:adr^nodeID:25623" - ;G(25)="smart:981968/demographics^v:bday^1956-03-23" - ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com" - ;G(27)="smart:981968/demographics^v:n^nodeID:25611" - ;G(28)="smart:981968/demographics^v:tel^nodeID:25591" - Q - ; -PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of patient - ; - I $O(C0SARY("patient",""))="" D Q ; - . I $D(DEBUG) W !,"No Patient array" - . S GRTN="" - S GRTN="" ; default to no patient - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/patient" - S ZPAT=C0SGRF ; subject is the same as the graph name - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - N ZPN,ZR - D STARTADD^C0XF2N - ; - ; First do the base demographic graph - ; - S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient - N SEX S SEX=$G(@ZPN@("gender@value")) - I SEX="M" S SEX="male" - I SEX="F" S SEX="female" - S ZR("foaf:gender")=SEX - S ZR("rdf:type")="sp:Demographics" - S ZR("sp:belongsTo")=ZPAT - N PATIENT - S PATIENT=$P(ZPAT,"#",2) - I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT - N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph - S ZR("sp:medicalRecordNumber")=NMREC - N NVADR S NVADR=$$ANONS^C0XF2N ; for address - S ZR("v:adr")=NVADR - N NNAME S NNAME=$$ANONS^C0XF2N ; for name - S ZR("v:n")=NNAME - N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone - I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists - N BDATE - S ZX="" - S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format - S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date - S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens - I BDATE="" S BDATE="UNKNOWN" - N Z2,Z3 - S Z2=$P(BDATE,"-",2) - S Z3=$P(BDATE,"-",3) - I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2 - I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3 - S ZR("v:bday")=BDATE - I $D(C0SVISTA) D ; - . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN - . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN - D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph - K ZR - ; - ; create address sub-graph - ; - S ZR("rdf:type")="v:Address" - S ZR("rdf:type")="v:Home" - S ZR("v:locality")=$G(@ZPN@("address@city")) - S ZR("v:postal-code")=$G(@ZPN@("address@postalCode")) - S ZR("v:region")=$G(@ZPN@("address@stateProvince")) - S ZR("v:street-address")=$G(@ZPN@("address@streetLine1")) - D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address - K ZR - ; - ; create medical record subgraph - ; - S ZR("dcterms:identifier")=$G(@ZPN@("id@value")) - S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier") - S ZR("rdf:type")="sp:Code" - S ZR("sp:system")="VistA Patient Record" - D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph - K ZR - ; - ; create name subgraph - ; - N ZNF,ZNL,ZNM,ZNAM - S ZR("rdf:type")="v:Name" - S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names - S ZNF=$P(ZX," ",1) ; first name is first piece - S ZNM=$P(ZX," ",2) ; middle names are the rest - S ZR("v:additional-name")=ZNM - S ZR("v:family-name")=$G(@ZPN@("familyName@value")) - S ZR("v:given-name")=ZNF - D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph - K ZR - ; - ; create telephone subgraph - ; - D ; - . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value")) - . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph - . S ZR("rdf:type")="v:Tel" - . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR) - K ZR - ; - ; load the demographics graph and all sub graphs to the triple store - ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; -AGES ; LIST ALL PATIENTS AND THEIR AGES - N ZI S ZI=0 - F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT - . N ZDOB - . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB - . N ZNAME - . S ZNAME=$P(^DPT(ZI,0),U) - . N ZSEX - . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX") - . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX - Q - ; +C0SDEM ; GPL - Smart Demographics Processing ;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; + ; + ; + ; + ; + ; + ; Bob + ; J + ; Odenkirk + ; + ; + ; + ; + ; + ; + ; + ; + ; 15 Main St + ; Apt 2 + ; Wonderland + ; OZ + ; 54321 + ; USA + ; + ; + ; + ; + ; + ; + ; + ; 800-555-1212 + ; + ; + ; + ; + ; + ; + ; 800-555-1515 + ; + ; + ; + ; male + ; 1959-12-25 + ; bob.odenkirk@example.com + ; + ; + ; + ; My Hospital Record 2304575 + ; 2304575 + ; My Hospital Record + ; + ; + ; + ; + ; + ; + ; + ; + ; + ; + ; Bob + ; J + ; Odenkirk + ; + ; + ; + ; + ; + ; + ; + ; + ; 15 Main St + ; Apt 2 + ; Wonderland + ; OZ + ; 54321 + ; USA + ; + ; + ; + ; + ; + ; + ; + ; 800-555-1212 + ; + ; + ; + ; + ; + ; + ; 800-555-1515 + ; + ; + ; + ; male + ; 1959-12-25 + ; bob.odenkirk@example.com + ; + ; + ; + ; My Hospital Record 2304575 + ; 2304575 + ; My Hospital Record + ; + ; + ; + ; + ; + ;G(1)="nodeID:25591^rdf:type^v:Home" + ;G(2)="nodeID:25591^rdf:type^v:Pref" + ;G(3)="nodeID:25591^rdf:type^v:Tel" + ;G(4)="nodeID:25591^rdf:value^800-369-6403" + ;G(5)="nodeID:25611^rdf:type^v:Name" + ;G(6)="nodeID:25611^v:additional-name^N" + ;G(7)="nodeID:25611^v:family-name^Brooks" + ;G(8)="nodeID:25611^v:given-name^Brian" + ;G(9)="nodeID:25622^dcterms:identifier^981968" + ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968" + ;G(11)="nodeID:25622^rdf:type^sp:Code" + ;G(12)="nodeID:25622^sp:system^My Hospital Record" + ;G(13)="nodeID:25623^rdf:type^v:Address" + ;G(14)="nodeID:25623^rdf:type^v:Home" + ;G(15)="nodeID:25623^rdf:type^v:Pref" + ;G(16)="nodeID:25623^v:locality^Bixby" + ;G(17)="nodeID:25623^v:postal-code^74008" + ;G(18)="nodeID:25623^v:region^OK" + ;G(19)="nodeID:25623^v:street-address^82 Lake St" + ;G(20)="smart:981968/demographics^foaf:gender^male" + ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics" + ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968" + ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622" + ;G(24)="smart:981968/demographics^v:adr^nodeID:25623" + ;G(25)="smart:981968/demographics^v:bday^1956-03-23" + ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com" + ;G(27)="smart:981968/demographics^v:n^nodeID:25611" + ;G(28)="smart:981968/demographics^v:tel^nodeID:25591" + Q + ; +PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of patient + ; + I $O(C0SARY("patient",""))="" D Q ; + . I $D(DEBUG) W !,"No Patient array" + . S GRTN="" + S GRTN="" ; default to no patient + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/patient" + S ZPAT=C0SGRF ; subject is the same as the graph name + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + N ZPN,ZR + D STARTADD^C0XF2N + ; + ; First do the base demographic graph + ; + S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient + N SEX S SEX=$G(@ZPN@("gender@value")) + I SEX="M" S SEX="male" + I SEX="F" S SEX="female" + S ZR("foaf:gender")=SEX + S ZR("rdf:type")="sp:Demographics" + S ZR("sp:belongsTo")=ZPAT + N PATIENT + S PATIENT=$P(ZPAT,"#",2) + I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT + N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph + S ZR("sp:medicalRecordNumber")=NMREC + N NVADR S NVADR=$$ANONS^C0XF2N ; for address + S ZR("v:adr")=NVADR + N NNAME S NNAME=$$ANONS^C0XF2N ; for name + S ZR("v:n")=NNAME + N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone + I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists + N BDATE + S ZX="" + S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format + S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date + S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens + I BDATE="" S BDATE="UNKNOWN" + N Z2,Z3 + S Z2=$P(BDATE,"-",2) + S Z3=$P(BDATE,"-",3) + I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2 + I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3 + S ZR("v:bday")=BDATE + I $D(C0SVISTA) D ; + . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN + . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN + D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph + K ZR + ; + ; create address sub-graph + ; + S ZR("rdf:type")="v:Address" + S ZR("rdf:type")="v:Home" + S ZR("v:locality")=$G(@ZPN@("address@city")) + S ZR("v:postal-code")=$G(@ZPN@("address@postalCode")) + S ZR("v:region")=$G(@ZPN@("address@stateProvince")) + S ZR("v:street-address")=$G(@ZPN@("address@streetLine1")) + D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address + K ZR + ; + ; create medical record subgraph + ; + S ZR("dcterms:identifier")=$G(@ZPN@("id@value")) + S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier") + S ZR("rdf:type")="sp:Code" + S ZR("sp:system")="VistA Patient Record" + D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph + K ZR + ; + ; create name subgraph + ; + N ZNF,ZNL,ZNM,ZNAM + S ZR("rdf:type")="v:Name" + S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names + S ZNF=$P(ZX," ",1) ; first name is first piece + S ZNM=$P(ZX," ",2) ; middle names are the rest + S ZR("v:additional-name")=ZNM + S ZR("v:family-name")=$G(@ZPN@("familyName@value")) + S ZR("v:given-name")=ZNF + D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph + K ZR + ; + ; create telephone subgraph + ; + D ; + . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value")) + . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph + . S ZR("rdf:type")="v:Tel" + . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR) + K ZR + ; + ; load the demographics graph and all sub graphs to the triple store + ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; +AGES ; LIST ALL PATIENTS AND THEIR AGES + N ZI S ZI=0 + F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT + . N ZDOB + . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB + . N ZNAME + . S ZNAME=$P(^DPT(ZI,0),U) + . N ZSEX + . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX") + . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX + Q + ; Index: /smart/trunk/p/C0SDOM.m =================================================================== --- /smart/trunk/p/C0SDOM.m (revision 1570) +++ /smart/trunk/p/C0SDOM.m (revision 1571) @@ -1,320 +1,320 @@ -C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2011,2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; -DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE - ; THE XPATH INDEX ZXIDX, PASSED BY NAME - ; THE XPATH ARRAY XPARY, PASSED BY NAME - ; ZOID IS THE STARTING OID - ; ZPATH IS THE STARTING XPATH, USUALLY "/" - ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE - ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT - I $G(ZREDUX)="" S ZREDUX="" - N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY - N NEWNUM S NEWNUM="" - I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" - S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE - I $G(ZREDUX)'="" D ; REDUX PROVIDED? - . N GT S GT=$P(NEWPATH,ZREDUX,2) - . I GT'="" S NEWPATH=GT - S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX - N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE - I $D(GA) D ; PROCESS THE ATTRIBUTES - . N ZI S ZI="" - . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE - . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE - . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY - . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE - N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE - I $D(GD(2)) D ; - . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY - E I $D(GD(1)) D ; - . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY - . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY - N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD - I ZFRST'=0 D ; THERE IS A CHILD - . N ZNUM - . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE - . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD - N GNXT S GNXT=$$NXTSIB(ZOID) - I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES - I GNXT'=0 D ; - . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? - . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES - . . N ZNUM S ZNUM=1 ; - . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB - . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB - Q - ; -ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY - ; - ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES - ; - N ZZI,ZZJ,ZZN - S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY - I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE - S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY - S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . - I ZZI'["]" D ; A SINGLETON - . S ZZN=1 - E D ; THERE IS AN [x] OCCURANCE - . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE - . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] - I ZZJ'="" D ; TIME TO ADD THE VALUE - . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE - Q - ; -PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME - ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW - ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML - ;Q $$EN^MXMLDOM(INXML) - Q $$EN^MXMLDOM(INXML,"W") - ; -ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE - N ZN - ;I $$TAG(ZOID)["entry" B - S ZN=$$NXTSIB(ZOID) - I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG - Q 0 - ; -FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID - Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) - ; -PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID - Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) - ; -ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID - S HANDLE=C0SDOCID - K @RTN - D GETTXT^MXMLDOM("A") - Q - ; -TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE - ;I ZOID=149 B ;GPLTEST - N X,Y - S Y="" - S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE - I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y - I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) - Q Y - ; -NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING - Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) - ; -DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE - ;N ZT,ZN S ZT="" - ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) - ;Q $G(@C0SDOM@(ZOID,"T",1)) - S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) - Q - ; -OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM - ; - S C0SDOCID=INID - I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE 0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID - E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL - . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE - . S ZPARNODE=1 ; - ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET - N ZEXARY - D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY - D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED - I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE - Q HANDLE ; SUCCESS - ; -MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES - N ZI S ZI="" - N ZTAG - F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION - . N ZELEADD S ZELEADD=0 - . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES - . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG - . . K ZATT ; CLEAR OUT LAST ONE - . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY - . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE - . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE - . I $O(@ZARY@(ZI,""))="" D ;END NODE - . . S ZTAG=ZI ; USE ZI FOR THE TAG - . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE - . . S ZELEADD=1 ; ADDED AN ELEMENT - . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE - . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL - . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING - . N NEWARY ; INDENTED ARRAY - . N ZN S ZN=0 - . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE - . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG - . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY - . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY - . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG - Q - ; -EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED - ; CONSISTENT FORMAT - ; GNARY("patient",1,"facilities[2].facility@code")="050" - ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" - ; for easier processing (this is fileman format genius) - ; basically removes the dot notation from the strings - ; - N ZZI - S ZZI="" - F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; - . N ZZN S ZZN=0 - . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; - . . N ZZS S ZZS="" - . . N GA ;PUSH STACK - . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; - . . . K GA ; NEW STACK - . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT - . . . N ZZV ; PLACE TO STASH THE VALUE - . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE - . . . W !,"VALUE:",ZZV - . . . N GK ; COUNTER - . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE - . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] - . . . . N GM S GM=$P(ZZS,".",GK) ; TAG - . . . . I GM["[" D ; IT'S A MULTIPLE - . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER - . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG - . . . . I GM["@" D ; IT'S GOT ATTRIBUTES - . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME - . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG - . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2) - . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ; - . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" - . . . N GZI S GZI="" ; STRING FOR THE INDEX - . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS - . . . . S GM=$P(GA(GK),"^",1) ; THE TAG - . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY - . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE - . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST - . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME - . . . W !,GZI - . . . S @GZI2=ZZV ; REMEMBER THE VALUE? - Q - ; -NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE - N CBK,SUCCESS,LEVEL,NODE,HANDLE - K ^TMP("MXMLERR",$J) - L +^TMP("MXMLDOM",$J):5 - E Q 0 - S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" - L -^TMP("MXMLDOM",$J) - Q HANDLE - ; +C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2011,2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; +DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE + ; THE XPATH INDEX ZXIDX, PASSED BY NAME + ; THE XPATH ARRAY XPARY, PASSED BY NAME + ; ZOID IS THE STARTING OID + ; ZPATH IS THE STARTING XPATH, USUALLY "/" + ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE + ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT + I $G(ZREDUX)="" S ZREDUX="" + N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY + N NEWNUM S NEWNUM="" + I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" + S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE + I $G(ZREDUX)'="" D ; REDUX PROVIDED? + . N GT S GT=$P(NEWPATH,ZREDUX,2) + . I GT'="" S NEWPATH=GT + S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX + N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE + I $D(GA) D ; PROCESS THE ATTRIBUTES + . N ZI S ZI="" + . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE + . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE + . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY + . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE + N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE + I $D(GD(2)) D ; + . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY + E I $D(GD(1)) D ; + . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY + . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY + N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD + I ZFRST'=0 D ; THERE IS A CHILD + . N ZNUM + . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE + . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD + N GNXT S GNXT=$$NXTSIB(ZOID) + I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES + I GNXT'=0 D ; + . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? + . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES + . . N ZNUM S ZNUM=1 ; + . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB + . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB + Q + ; +ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY + ; + ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES + ; + N ZZI,ZZJ,ZZN + S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY + I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE + S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY + S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . + I ZZI'["]" D ; A SINGLETON + . S ZZN=1 + E D ; THERE IS AN [x] OCCURANCE + . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE + . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] + I ZZJ'="" D ; TIME TO ADD THE VALUE + . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE + Q + ; +PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME + ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW + ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML + ;Q $$EN^MXMLDOM(INXML) + Q $$EN^MXMLDOM(INXML,"W") + ; +ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE + N ZN + ;I $$TAG(ZOID)["entry" B + S ZN=$$NXTSIB(ZOID) + I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG + Q 0 + ; +FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID + Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) + ; +PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID + Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) + ; +ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID + S HANDLE=C0SDOCID + K @RTN + D GETTXT^MXMLDOM("A") + Q + ; +TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE + ;I ZOID=149 B ;GPLTEST + N X,Y + S Y="" + S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE + I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y + I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) + Q Y + ; +NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING + Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) + ; +DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE + ;N ZT,ZN S ZT="" + ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) + ;Q $G(@C0SDOM@(ZOID,"T",1)) + S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) + Q + ; +OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM + ; + S C0SDOCID=INID + I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE 0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID + E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL + . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE + . S ZPARNODE=1 ; + ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET + N ZEXARY + D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY + D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED + I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE + Q HANDLE ; SUCCESS + ; +MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES + N ZI S ZI="" + N ZTAG + F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION + . N ZELEADD S ZELEADD=0 + . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES + . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG + . . K ZATT ; CLEAR OUT LAST ONE + . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY + . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE + . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE + . I $O(@ZARY@(ZI,""))="" D ;END NODE + . . S ZTAG=ZI ; USE ZI FOR THE TAG + . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE + . . S ZELEADD=1 ; ADDED AN ELEMENT + . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE + . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL + . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING + . N NEWARY ; INDENTED ARRAY + . N ZN S ZN=0 + . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE + . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG + . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY + . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY + . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG + Q + ; +EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED + ; CONSISTENT FORMAT + ; GNARY("patient",1,"facilities[2].facility@code")="050" + ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" + ; for easier processing (this is fileman format genius) + ; basically removes the dot notation from the strings + ; + N ZZI + S ZZI="" + F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; + . N ZZN S ZZN=0 + . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; + . . N ZZS S ZZS="" + . . N GA ;PUSH STACK + . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; + . . . K GA ; NEW STACK + . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT + . . . N ZZV ; PLACE TO STASH THE VALUE + . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE + . . . W !,"VALUE:",ZZV + . . . N GK ; COUNTER + . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE + . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] + . . . . N GM S GM=$P(ZZS,".",GK) ; TAG + . . . . I GM["[" D ; IT'S A MULTIPLE + . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER + . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG + . . . . I GM["@" D ; IT'S GOT ATTRIBUTES + . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME + . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG + . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2) + . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ; + . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" + . . . N GZI S GZI="" ; STRING FOR THE INDEX + . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS + . . . . S GM=$P(GA(GK),"^",1) ; THE TAG + . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY + . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE + . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST + . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME + . . . W !,GZI + . . . S @GZI2=ZZV ; REMEMBER THE VALUE? + Q + ; +NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE + N CBK,SUCCESS,LEVEL,NODE,HANDLE + K ^TMP("MXMLERR",$J) + L +^TMP("MXMLDOM",$J):5 + E Q 0 + S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" + L -^TMP("MXMLDOM",$J) + Q HANDLE + ; Index: /smart/trunk/p/C0SLAB.m =================================================================== --- /smart/trunk/p/C0SLAB.m (revision 1570) +++ /smart/trunk/p/C0SLAB.m (revision 1571) @@ -1,275 +1,275 @@ -C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; sample VistA NHIN lab result - ; - ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16 - ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00" - ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve" - ;^TMP("C0STBL",32,"lab",8,"facility@code")=100 - ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47" - ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101" - ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003" - ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H" - ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336 - ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU" - ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0" - ;^TMP("C0STBL",32,"lab",8,"low@value")="69 " - ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807 - ;^TMP("C0STBL",32,"lab",8,"result@value")=178 - ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006 - ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM" - ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500" - ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM" - ;^TMP("C0STBL",32,"lab",8,"status@value")="completed" - ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE" - ;^TMP("C0STBL",32,"lab",8,"type@value")="CH" - ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL" - ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342 - ; - ; sample Smart lab result triples - ; - ;G("loinc:29571-7","dcterms:identifier")="29571-7" - ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql" - ;G("loinc:29571-7","rdf:type")="sp:Code" - ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/" - ;G("loinc:38478-4","dcterms:identifier")="38478-4" - ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql" - ;G("loinc:38478-4","rdf:type")="sp:Code" - ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/" - ;G("qqWZZIew993","rdf:type")="sp:Attribution" - ;G("qqWZZIew993","sp:startDate")="2007-04-21" - ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult" - ;G("qqWZZIew994","sp:value")="Normal" - ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql" - ;G("qqWZZIew995","rdf:type")="sp:CodedValue" - ;G("qqWZZIew995","sp:code")="loinc:38478-4" - ;G("qqWZZIew997","rdf:type")="sp:Attribution" - ;G("qqWZZIew997","sp:startDate")="2007-09-08" - ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult" - ;G("qqWZZIew998","sp:value")="Normal" - ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql" - ;G("qqWZZIew999","rdf:type")="sp:CodedValue" - ;G("qqWZZIew999","sp:code")="loinc:29571-7" - ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult" - ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345" - ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995" - ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994" - ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993" - ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997" - ; - ; - ; another Smart example, this one with sp:quantitativeResult - ; - ;G("loinc:786-4","dcterms:identifier")="786-4" - ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc" - ;G("loinc:786-4","rdf:type")="sp:Code" - ;G("loinc:786-4","sp:system")="http://loinc.org/codes/" - ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit" - ;G("nodeID:4439","sp:unit")="g/dL" - ;G("nodeID:4439","sp:value")=36.6 - ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit" - ;G("nodeID:4613","sp:unit")="g/dL" - ;G("nodeID:4613","sp:value")=32 - ;G("nodeID:4672","rdf:type")="sp:Attribution" - ;G("nodeID:4672","sp:startDate")="2005-03-10" - ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit" - ;G("nodeID:4866","sp:unit")="g/dL" - ;G("nodeID:4866","sp:value")=36 - ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc" - ;G("nodeID:4871","rdf:type")="sp:CodedValue" - ;G("nodeID:4871","sp:code")="loinc:786-4" - ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult" - ;G("nodeID:5221","sp:normalRange")="nodeID:5282" - ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439" - ;G("nodeID:5282","rdf:type")="sp:ValueRange" - ;G("nodeID:5282","sp:maximum")="nodeID:4866" - ;G("nodeID:5282","sp:minimum")="nodeID:4613" - ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult" - ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505" - ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871" - ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221" - ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" - ; -LAB(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of lab - ; - I $O(C0SARY("lab",""))="" D Q ; - . I $D(DEBUG) W !,"No Labs" - S GRTN="" ; default to no labs - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/lab_results" - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - D STARTADD^C0XF2N ; initialize to create triples - ; - N ZI S ZI="" - F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ; - . N LRN,ZR ; ZR is the local array for building the new triples - . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result - . ; - . N RSLTID ; unique Id for this lab result - . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number - . ; - . ; i don't like this because the same labs result gets a - . ; different ID every time it's reported. Can't trace it back to VistA - . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003" - . ; .. either that or store an OID with the lab result - but that - . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012 - . ; - . N LOINC S LOINC=$G(@LRN@("loinc@value")) - . I LOINC="" D Q ; - . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING" - . N LABTST S LABTST=$G(@LRN@("test@value")) - . I $D(DEBUG) D ; - . . W !,"Processing Lab Result ",RSLTID - . . W !,"test: ",LABTST - . . W !,"loinc: ",LOINC - . ; - . ; first do the base result graph - . ; - . S ZR("rdf:type")="sp:LabResult" - . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results - . ; ie /vista/smart/99912345/lab_results - . ; - . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name - . S ZR("sp:labName")=LABNAME - . ; - . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result - . S ZR("sp:narrativeResult")=NARRSLT - . ; - . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result - . S ZR("sp:quantitativeResult")=QNTRSLT - . ; - . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected - . S ZR("sp:specimenCollected")=SPECCOLL - . ; - . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples - . K ZR ; clean up - . ; - . ; create the narrative result graph - . ; - . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L - . I IVAL'="" - . . S ZR("rdf:type")="sp:NarrativeResult" - . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L - . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal" - . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal" - . . I ZR("sp:value")="HH" S ZR("sp:value")="critical" - . . I ZR("sp:value")="LL" S ZR("sp:value")="critical" - . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR) - . . K ZR - . ; - . ; create the quantitative result graph - . ; - . S ZR("rdf:type")="sp:QuantitativeResult" - . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph - . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph - . N HASNORMAL S HASNORMAL=0 - . I $G(@LRN@("high@value"))'="" S HASNORMAL=1 - . I HASNORMAL S ZR("sp:normalRange")=NORMNM - . S ZR("sp:valueAndUnit")=VUNM - . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR) - . K ZR - . ; - . ; create the normal range graph - . ; - . I HASNORMAL D ; - . . S ZR("rdf:type")="sp:ValueRange" - . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph - . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph - . . S ZR("sp:maximum")=MAXNM - . . S ZR("sp:minimum")=MINNM - . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR) - . . K ZR - . . ; - . . ; create the maximum graph - . . ; - . . S ZR("rdf:type")="sp:ValueAndUnit" - . . S ZR("sp:unit")=$G(@LRN@("units@value")) - . . S ZR("sp:value")=$G(@LRN@("high@value")) - . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR) - . . K ZR - . . ; - . . ; create the minimum graph - . . ; - . . S ZR("rdf:type")="sp:ValueAndUnit" - . . S ZR("sp:unit")=$G(@LRN@("units@value")) - . . S ZR("sp:value")=$G(@LRN@("low@value")) - . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR) - . . K ZR - . ; - . ; create the value and unit graph - . ; - . S ZR("rdf:type")="sp:ValueAndUnit" - . S ZR("sp:unit")=$G(@LRN@("units@value")) - . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ;$G(@LRN@("test@value")) - . S ZR("sp:value")=$G(@LRN@("result@value")) - . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR) - . K ZR - . ; - . ; create specimen collected graph - . ; - . S ZR("rdf:type")="sp:Attribution" - . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value"))) - . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR) - . K ZR - . ; - . ; create lab name graph - this contains the test name and code - . ; - . I LOINC'="" D ; - . . S ZR("rdf:type")="sp:CodedValue" - . . S ZR("dcterms:title")=LABTST - . . N LOINCNM S LOINCNM="loinc:"_LOINC - . . S ZR("sp:code")="loinc:"_LOINC - . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR) - . . K ZR - . . S ZR("dcterms:identifier")=LOINC - . . S ZR("dcterms:title")=LABTST - . . S ZR("rdf:type")="sp:Code" - . . S ZR("sp:system")="http://loinc.org/codes/" - . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR) - . . K ZR - . ; - . ; that's all for now folks (there is more to do like reference ranges - . ; and result values) - . ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; -SAMPLE ; import sample lab tests to the triplestore - N GN - S GN=$NA(^rdf("lab_results")) - D INSRDF^C0XF2N(GN,"/smart/lab/samples") - Q - ; +C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; sample VistA NHIN lab result + ; + ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16 + ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00" + ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve" + ;^TMP("C0STBL",32,"lab",8,"facility@code")=100 + ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47" + ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101" + ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003" + ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H" + ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336 + ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU" + ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0" + ;^TMP("C0STBL",32,"lab",8,"low@value")="69 " + ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807 + ;^TMP("C0STBL",32,"lab",8,"result@value")=178 + ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006 + ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM" + ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500" + ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM" + ;^TMP("C0STBL",32,"lab",8,"status@value")="completed" + ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE" + ;^TMP("C0STBL",32,"lab",8,"type@value")="CH" + ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL" + ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342 + ; + ; sample Smart lab result triples + ; + ;G("loinc:29571-7","dcterms:identifier")="29571-7" + ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql" + ;G("loinc:29571-7","rdf:type")="sp:Code" + ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/" + ;G("loinc:38478-4","dcterms:identifier")="38478-4" + ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql" + ;G("loinc:38478-4","rdf:type")="sp:Code" + ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/" + ;G("qqWZZIew993","rdf:type")="sp:Attribution" + ;G("qqWZZIew993","sp:startDate")="2007-04-21" + ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult" + ;G("qqWZZIew994","sp:value")="Normal" + ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql" + ;G("qqWZZIew995","rdf:type")="sp:CodedValue" + ;G("qqWZZIew995","sp:code")="loinc:38478-4" + ;G("qqWZZIew997","rdf:type")="sp:Attribution" + ;G("qqWZZIew997","sp:startDate")="2007-09-08" + ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult" + ;G("qqWZZIew998","sp:value")="Normal" + ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql" + ;G("qqWZZIew999","rdf:type")="sp:CodedValue" + ;G("qqWZZIew999","sp:code")="loinc:29571-7" + ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult" + ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345" + ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995" + ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994" + ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993" + ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997" + ; + ; + ; another Smart example, this one with sp:quantitativeResult + ; + ;G("loinc:786-4","dcterms:identifier")="786-4" + ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc" + ;G("loinc:786-4","rdf:type")="sp:Code" + ;G("loinc:786-4","sp:system")="http://loinc.org/codes/" + ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit" + ;G("nodeID:4439","sp:unit")="g/dL" + ;G("nodeID:4439","sp:value")=36.6 + ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit" + ;G("nodeID:4613","sp:unit")="g/dL" + ;G("nodeID:4613","sp:value")=32 + ;G("nodeID:4672","rdf:type")="sp:Attribution" + ;G("nodeID:4672","sp:startDate")="2005-03-10" + ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit" + ;G("nodeID:4866","sp:unit")="g/dL" + ;G("nodeID:4866","sp:value")=36 + ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc" + ;G("nodeID:4871","rdf:type")="sp:CodedValue" + ;G("nodeID:4871","sp:code")="loinc:786-4" + ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult" + ;G("nodeID:5221","sp:normalRange")="nodeID:5282" + ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439" + ;G("nodeID:5282","rdf:type")="sp:ValueRange" + ;G("nodeID:5282","sp:maximum")="nodeID:4866" + ;G("nodeID:5282","sp:minimum")="nodeID:4613" + ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult" + ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505" + ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871" + ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221" + ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" + ; +LAB(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of lab + ; + I $O(C0SARY("lab",""))="" D Q ; + . I $D(DEBUG) W !,"No Labs" + S GRTN="" ; default to no labs + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/lab_results" + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + D STARTADD^C0XF2N ; initialize to create triples + ; + N ZI S ZI="" + F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ; + . N LRN,ZR ; ZR is the local array for building the new triples + . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result + . ; + . N RSLTID ; unique Id for this lab result + . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number + . ; + . ; i don't like this because the same labs result gets a + . ; different ID every time it's reported. Can't trace it back to VistA + . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003" + . ; .. either that or store an OID with the lab result - but that + . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012 + . ; + . N LOINC S LOINC=$G(@LRN@("loinc@value")) + . I LOINC="" D Q ; + . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING" + . N LABTST S LABTST=$G(@LRN@("test@value")) + . I $D(DEBUG) D ; + . . W !,"Processing Lab Result ",RSLTID + . . W !,"test: ",LABTST + . . W !,"loinc: ",LOINC + . ; + . ; first do the base result graph + . ; + . S ZR("rdf:type")="sp:LabResult" + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results + . ; ie /vista/smart/99912345/lab_results + . ; + . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name + . S ZR("sp:labName")=LABNAME + . ; + . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result + . S ZR("sp:narrativeResult")=NARRSLT + . ; + . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result + . S ZR("sp:quantitativeResult")=QNTRSLT + . ; + . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected + . S ZR("sp:specimenCollected")=SPECCOLL + . ; + . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples + . K ZR ; clean up + . ; + . ; create the narrative result graph + . ; + . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L + . I IVAL'="" + . . S ZR("rdf:type")="sp:NarrativeResult" + . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L + . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal" + . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal" + . . I ZR("sp:value")="HH" S ZR("sp:value")="critical" + . . I ZR("sp:value")="LL" S ZR("sp:value")="critical" + . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR) + . . K ZR + . ; + . ; create the quantitative result graph + . ; + . S ZR("rdf:type")="sp:QuantitativeResult" + . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph + . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph + . N HASNORMAL S HASNORMAL=0 + . I $G(@LRN@("high@value"))'="" S HASNORMAL=1 + . I HASNORMAL S ZR("sp:normalRange")=NORMNM + . S ZR("sp:valueAndUnit")=VUNM + . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR) + . K ZR + . ; + . ; create the normal range graph + . ; + . I HASNORMAL D ; + . . S ZR("rdf:type")="sp:ValueRange" + . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph + . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph + . . S ZR("sp:maximum")=MAXNM + . . S ZR("sp:minimum")=MINNM + . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR) + . . K ZR + . . ; + . . ; create the maximum graph + . . ; + . . S ZR("rdf:type")="sp:ValueAndUnit" + . . S ZR("sp:unit")=$G(@LRN@("units@value")) + . . S ZR("sp:value")=$G(@LRN@("high@value")) + . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR) + . . K ZR + . . ; + . . ; create the minimum graph + . . ; + . . S ZR("rdf:type")="sp:ValueAndUnit" + . . S ZR("sp:unit")=$G(@LRN@("units@value")) + . . S ZR("sp:value")=$G(@LRN@("low@value")) + . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR) + . . K ZR + . ; + . ; create the value and unit graph + . ; + . S ZR("rdf:type")="sp:ValueAndUnit" + . S ZR("sp:unit")=$G(@LRN@("units@value")) + . I ZR("sp:unit")="" S ZR("sp:unit")="{unknown}" ; was $G(@LRN@("test@value")) gpl + . S ZR("sp:value")=$G(@LRN@("result@value")) + . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR) + . K ZR + . ; + . ; create specimen collected graph + . ; + . S ZR("rdf:type")="sp:Attribution" + . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value"))) + . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR) + . K ZR + . ; + . ; create lab name graph - this contains the test name and code + . ; + . I LOINC'="" D ; + . . S ZR("rdf:type")="sp:CodedValue" + . . S ZR("dcterms:title")=LABTST + . . N LOINCNM S LOINCNM="loinc:"_LOINC + . . S ZR("sp:code")="loinc:"_LOINC + . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR) + . . K ZR + . . S ZR("dcterms:identifier")=LOINC + . . S ZR("dcterms:title")=LABTST + . . S ZR("rdf:type")="sp:Code" + . . S ZR("sp:system")="http://loinc.org/codes/" + . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR) + . . K ZR + . ; + . ; that's all for now folks (there is more to do like reference ranges + . ; and result values) + . ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; +SAMPLE ; import sample lab tests to the triplestore + N GN + S GN=$NA(^rdf("lab_results")) + D INSRDF^C0XF2N(GN,"/smart/lab/samples") + Q + ; Index: /smart/trunk/p/C0SMART.m =================================================================== --- /smart/trunk/p/C0SMART.m (revision 1570) +++ /smart/trunk/p/C0SMART.m (revision 1571) @@ -1,56 +1,56 @@ -C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q -EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP - ; for patient ZPATID; ZFORM defaults to rdf - ; ZRTN is passed by reference - ; For now, ZPATID is the DFN - ; - I '$D(ZFORM) S ZFORM="rdf" - K ZRTN ; CLEAN RETURN - N C0SARY - I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient") - E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP) - I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ; - . W !,"Error Retreiving Patient Record" - ; - K C0XFDA - ; - N C0SGR ; graph - ; - ; processing table - ; - N C0SCTRL - S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)" - S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)" - S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)" - S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)" - ; - I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ; - N ZX - S ZX=C0SCTRL(ZTYP) - X ZX ; - ; - I '$D(C0SGR) Q ; - ; - D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM) - ; - Q - ; +C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q +EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP + ; for patient ZPATID; ZFORM defaults to rdf + ; ZRTN is passed by reference + ; For now, ZPATID is the DFN + ; + I '$D(ZFORM) S ZFORM="rdf" + K ZRTN ; CLEAN RETURN + N C0SARY + I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient") + E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP) + I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ; + . W !,"Error Retreiving Patient Record" + ; + K C0XFDA + ; + N C0SGR ; graph + ; + ; processing table + ; + N C0SCTRL + S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)" + S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)" + S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)" + S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)" + ; + I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ; + N ZX + S ZX=C0SCTRL(ZTYP) + X ZX ; + ; + I '$D(C0SGR) Q ; + ; + D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM) + ; + Q + ; Index: /smart/trunk/p/C0SMED.m =================================================================== --- /smart/trunk/p/C0SMED.m (revision 1570) +++ /smart/trunk/p/C0SMED.m (revision 1571) @@ -1,157 +1,157 @@ -C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; -MED(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of meds - ; - I $O(C0SARY("med",""))="" D Q ; - . I $D(DEBUG) W !,"No Meds" - S GRTN="" ; default to no meds - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - N MEDTRP ; MEDS TRIPLES - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - N DUPCHK S DUPCHK="" ; check for no duplicates - N ZI S ZI="" - F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; - . N SDATE,SDTMP - . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; - . . I $D(DEBUG) W !,"Expired Mediation, Skipping" - . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; - . . I $D(DEBUG) W !,"Inpatient Med, skipping" - . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; - . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" - . ; - . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) - . I SDTMP="" D ; - . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) - . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date - . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens - . I SDATE="" S SDATE="UNKNOWN" - . N DNAME,VUID,DCODE,RXNORM,SIG - . S DNAME=$G(C0SARY("med",ZI,"name@value")) - . I DNAME="" D ; - . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) - . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) - . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) - . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) - . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code - . I $P(RXNORM,"^",2)="RXNORM" D ; - . . S RXVER=$P(RXNORM,"^",3) - . . S RXNORM=$P(RXNORM,"^",1) - . E D Q ; - . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" - . . I $D(DEBUG) W !,RXNORM - . I DNAME="" D Q ; - . . I $D(DEBUG) W !,"Error No Drug Name" - . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) - . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED - . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF - . S DUPCHK(MEDGRF)="" - . I $D(DEBUG) D ; - . . W !,"Processing Medication ",MEDGRF - . . W !,DNAME - . . W !,RXNORM - . S SIG=$G(C0SARY("med",ZI,"sig")) - . I SIG["|" D ; - . . N SIGTMP - . . S SIGTMP=SIG - . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig - . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig - . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig - . K C0XFARY - . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) - . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) - . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) - . N NQTY,NQTY2,NFREQ,NFREQ2 - . S NQTY=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) - . S NQTY2=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) - . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) - . I DOSE="" S DOSE="UNKNOWN" - . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) - . I UNIT="" S UNIT="UNKNOWN" - . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) - . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) - . S NFREQ=$$ANONS^C0XF2N ; anonomous subject - . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) - . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) - . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) - . I SCHED="" S SCHED="UNKNOWN" - . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) - . I SCHUNIT="" S SCHUNIT="UNKNOWN" - . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) - . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) - . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) - . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) - . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) - . D BULKLOAD^C0XF2N(.C0XFDA) - . K C0XFDA - S GRTN=C0SGRF - q - ; -RXNFN() Q 1130590011.001 ; RxNorm Concepts file number - ; -RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF - ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR - N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT - I $G(ZVUID)="" Q "" - I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED - N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") - S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES - N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) - S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED - I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" - Q ZRSLT - ; -NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO - ; CONFORM TO NIST REQUIREMENTS - ;INPATIENT CERTIFICATION - I ZRXN=309362 S ZRXN=213169 - I ZRXN=855318 S ZRXN=855320 - I ZRXN=197361 S ZRXN=212549 - ;OUTPATIENT CERTIFICATION - I ZRXN=310534 S ZRXN=205875 - I ZRXN=617312 S ZRXN=617314 - I ZRXN=310429 S ZRXN=200801 - I ZRXN=628953 S ZRXN=628958 - I ZRXN=745679 S ZRXN=630208 - I ZRXN=311564 S ZRXN=979334 - I ZRXN=836343 S ZRXN=836370 - Q ZRXN - ; +C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; +MED(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of meds + ; + I $O(C0SARY("med",""))="" D Q ; + . I $D(DEBUG) W !,"No Meds" + S GRTN="" ; default to no meds + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + N MEDTRP ; MEDS TRIPLES + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + N DUPCHK S DUPCHK="" ; check for no duplicates + N ZI S ZI="" + F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; + . N SDATE,SDTMP + . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; + . . I $D(DEBUG) W !,"Expired Mediation, Skipping" + . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; + . . I $D(DEBUG) W !,"Inpatient Med, skipping" + . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; + . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" + . ; + . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) + . I SDTMP="" D ; + . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) + . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date + . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens + . I SDATE="" S SDATE="UNKNOWN" + . N DNAME,VUID,DCODE,RXNORM,SIG + . S DNAME=$G(C0SARY("med",ZI,"name@value")) + . I DNAME="" D ; + . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) + . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) + . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) + . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) + . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code + . I $P(RXNORM,"^",2)="RXNORM" D ; + . . S RXVER=$P(RXNORM,"^",3) + . . S RXNORM=$P(RXNORM,"^",1) + . E D Q ; + . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" + . . I $D(DEBUG) W !,RXNORM + . I DNAME="" D Q ; + . . I $D(DEBUG) W !,"Error No Drug Name" + . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) + . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED + . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF + . S DUPCHK(MEDGRF)="" + . I $D(DEBUG) D ; + . . W !,"Processing Medication ",MEDGRF + . . W !,DNAME + . . W !,RXNORM + . S SIG=$G(C0SARY("med",ZI,"sig")) + . I SIG["|" D ; + . . N SIGTMP + . . S SIGTMP=SIG + . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig + . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig + . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig + . K C0XFARY + . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) + . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) + . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) + . N NQTY,NQTY2,NFREQ,NFREQ2 + . S NQTY=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) + . S NQTY2=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) + . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) + . I DOSE="" S DOSE="UNKNOWN" + . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) + . I UNIT="" S UNIT="UNKNOWN" + . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) + . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) + . S NFREQ=$$ANONS^C0XF2N ; anonomous subject + . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) + . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) + . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) + . I SCHED="" S SCHED="UNKNOWN" + . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) + . I SCHUNIT="" S SCHUNIT="UNKNOWN" + . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) + . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) + . D BULKLOAD^C0XF2N(.C0XFDA) + . K C0XFDA + S GRTN=C0SGRF + q + ; +RXNFN() Q 1130590011.001 ; RxNorm Concepts file number + ; +RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF + ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR + N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT + I $G(ZVUID)="" Q "" + I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED + N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") + S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES + N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) + S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED + I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" + Q ZRSLT + ; +NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO + ; CONFORM TO NIST REQUIREMENTS + ;INPATIENT CERTIFICATION + I ZRXN=309362 S ZRXN=213169 + I ZRXN=855318 S ZRXN=855320 + I ZRXN=197361 S ZRXN=212549 + ;OUTPATIENT CERTIFICATION + I ZRXN=310534 S ZRXN=205875 + I ZRXN=617312 S ZRXN=617314 + I ZRXN=310429 S ZRXN=200801 + I ZRXN=628953 S ZRXN=628958 + I ZRXN=745679 S ZRXN=630208 + I ZRXN=311564 S ZRXN=979334 + I ZRXN=836343 S ZRXN=836370 + Q ZRXN + ; Index: /smart/trunk/p/C0SMXMLB.m =================================================================== --- /smart/trunk/p/C0SMXMLB.m (revision 1570) +++ /smart/trunk/p/C0SMXMLB.m (revision 1571) @@ -1,106 +1,106 @@ -MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver. - ;;8.0;KERNEL;;;Build 2 - QUIT - ; - ;DOC - The top level tag - ;DOCTYPE - Want to include a DOCTYPE node - ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, -START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. - K ^TMP("MXMLBLD",$J) - S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 - I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 - I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) - D:$L($G(DOCTYPE)) OUTPUT("") D OUTPUT("<"_DOC_">") - Q - ; -END ;Call this once to close out the document - D OUTPUT("") - I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) - K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") - Q - ; -ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item - N I,X - S ATT=$G(ATT) - I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q - D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"") - Q - ;DOITEM is a callback to output the lower level. -MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule - N I,X,S - S ATT=$G(ATT) - D PUSH($G(INDENT),TAG,.ATT) - D @DOITEM - D POP - Q - ; -ATT(ATT) ;Output a string of attributes - I $D(ATT)<9 Q "" - N I,S,V - S S="",I="" - F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) - Q S - ; -Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 - ;I X'[$C(34) Q $C(34)_X_$C(34) - I X'[$C(39) Q $C(39)_X_$C(39) - ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" - N Q,Y,I,Z S Q=$C(39),(Y,Z)="" - F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q - S Y=Y_$P(X,Q,$L(X,Q)) - ;Q $C(34)_Y_$C(34) - Q $C(39)_Y_$C(39) - ; -XMLHDR() ; -- provides current XML standard header - Q "" - ; -OUTPUT(S) ;Output - N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) - I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q - W S,! - Q - ; -CHARCHK(STR) ; -- replace xml character limits with entities - N A,I,X,Y,Z,NEWSTR - S (Y,Z)="" - ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z - ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" - I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) - I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" - I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" - I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" - I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" - ; - 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)) - QUIT STR - ; -COMMENT(VAL) ;Add Comments - N I,L - ;I $D($G(VAL))=1 D OUTPUT("") Q - I $D(VAL) D OUTPUT("") Q ;CHANGED BY GPL FOR GTM - S I="",L="") - Q - ; -PUSH(INDENT,TAG,ATT) ;Write a TAG and save. - N CNT - S ATT=$G(ATT) - D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") - S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG - Q - ; -POP ;Write last pushed tag and pop - N CNT,TAG,INDENT,X - S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 - S INDENT=+X,TAG=$P(X,"^",2) - D OUTPUT($$BLS(INDENT)_"") - Q - ; -BLS(I) ;Return INDENT string - N S - S S="",I=$G(I) S:I>0 $P(S," ",I)=" " - Q S - ; -INDENT() ;Renturn indent level - Q +$G(^TMP("MXMLBLD",$J,"STK")) +MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver. + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + QUIT + ; + ;DOC - The top level tag + ;DOCTYPE - Want to include a DOCTYPE node + ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, +START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. + K ^TMP("MXMLBLD",$J) + S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 + I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 + I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) + D:$L($G(DOCTYPE)) OUTPUT("") D OUTPUT("<"_DOC_">") + Q + ; +END ;Call this once to close out the document + D OUTPUT("") + I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) + K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") + Q + ; +ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item + N I,X + S ATT=$G(ATT) + I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q + D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"") + Q + ;DOITEM is a callback to output the lower level. +MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule + N I,X,S + S ATT=$G(ATT) + D PUSH($G(INDENT),TAG,.ATT) + D @DOITEM + D POP + Q + ; +ATT(ATT) ;Output a string of attributes + I $D(ATT)<9 Q "" + N I,S,V + S S="",I="" + F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) + Q S + ; +Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 + ;I X'[$C(34) Q $C(34)_X_$C(34) + I X'[$C(39) Q $C(39)_X_$C(39) + ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" + N Q,Y,I,Z S Q=$C(39),(Y,Z)="" + F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q + S Y=Y_$P(X,Q,$L(X,Q)) + ;Q $C(34)_Y_$C(34) + Q $C(39)_Y_$C(39) + ; +XMLHDR() ; -- provides current XML standard header + Q "" + ; +OUTPUT(S) ;Output + N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) + I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q + W S,! + Q + ; +CHARCHK(STR) ; -- replace xml character limits with entities + N A,I,X,Y,Z,NEWSTR + S (Y,Z)="" + ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z + ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" + I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) + I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" + I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" + I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" + I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" + ; + 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)) + QUIT STR + ; +COMMENT(VAL) ;Add Comments + N I,L + ;I $D($G(VAL))=1 D OUTPUT("") Q + I $D(VAL) D OUTPUT("") Q ;CHANGED BY GPL FOR GTM + S I="",L="") + Q + ; +PUSH(INDENT,TAG,ATT) ;Write a TAG and save. + N CNT + S ATT=$G(ATT) + D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") + S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG + Q + ; +POP ;Write last pushed tag and pop + N CNT,TAG,INDENT,X + S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 + S INDENT=+X,TAG=$P(X,"^",2) + D OUTPUT($$BLS(INDENT)_"") + Q + ; +BLS(I) ;Return INDENT string + N S + S S="",I=$G(I) S:I>0 $P(S," ",I)=" " + Q S + ; +INDENT() ;Renturn indent level + Q +$G(^TMP("MXMLBLD",$J,"STK")) Index: /smart/trunk/p/C0SNHIN.m =================================================================== --- /smart/trunk/p/C0SNHIN.m (revision 1570) +++ /smart/trunk/p/C0SNHIN.m (revision 1571) @@ -1,324 +1,324 @@ -C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q -EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT - ; - K GARY,GNARY,GIDX,C0SDOCID - K ZRTN - N GN - K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL - K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM - K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS - D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML - S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL - S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML - D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS - I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 - ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) - Q - ; -PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE - ; - N ZG - S ZG=$NA(^TMP("PQRIXML",$J)) - K @ZG - D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML - N C0SDOCID - S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML - D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS - I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 - Q - ; -PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE - ; - ;N GG - D GETXML^C0SMXP("GG","PQRI ONE MEASURE") - D PROCESS(ZRTN,"GG","root",1) - Q - ; -PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML - ; ZRTN IS PASSED BY REFERENCE - ; ZXML IS PASSED BY NAME - ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED - ; - N GN - S GN=$NA(^TMP("C0SPROCESS",$J)) - K @GN - M @GN=@ZXML - S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML - K @GN - D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS - I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 - Q - ; -LOADSMRT ; - ; - K ^GPL("SMART") - S GN=$NA(^GPL("SMART",1)) - I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" - Q - ; -SMART ; TRY IT WITH SMART - ; - S GN=$NA(^GPL("SMART")) - ;K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"SMART") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -CCR ; TRY IT WITH A CCR - ; - S GN=$NA(^GPL("CCR")) - ;K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"CCR") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -MED ; TRY IT WITH A CCR MED SECTION - ; - S GN=$NA(^GPL("MED")) - K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"MED") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -CCD ; TRY IT WITH A CCD - ; - S GN=$NA(^GPL("CCD")) - ;K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"CCD") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") - ; PARSED WITH MXML - ; RUN THROUGH XPATH - K GARY,GIDX,C0SDOCID - S GN=$NA(^GPL("NHIN")) - ;S GN=$NA(^GPL("DOMI")) - S C0SDOCID=$$PARSE(GN,"GPLTEST") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") - K ^GPL("GNARY") - M ^GPL("GNARY")=GNARY - Q - ; -TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") - ; - S GN=$NA(^GPL("GNARY")) - S C0SDOCID=$$DOMI^C0SDOM(GN,,"results") - D OUTXML^C0SDOM("G",C0SDOCID) - K ^GPL("DOMI") - M ^GPL("DOMI")=G - Q - ; -TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") - ; PARSED WITH MXML - ; RUN THROUGH XPATH - K GARY,GIDX,C0SDOCID - ;S GN=$NA(^GPL("NHIN")) - S GN=$NA(^GPL("DOMI")) - S C0SDOCID=$$PARSE(GN,"GPLTEST") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") - Q - ; -DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE - ; THE XPATH INDEX ZXIDX, PASSED BY NAME - ; THE XPATH ARRAY XPARY, PASSED BY NAME - ; ZOID IS THE STARTING OID - ; ZPATH IS THE STARTING XPATH, USUALLY "/" - ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE - ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT - I $G(ZREDUX)="" S ZREDUX="" - N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY - N NEWNUM S NEWNUM="" - I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" - S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE - I $G(ZREDUX)'="" D ; REDUX PROVIDED? - . N GT S GT=$P(NEWPATH,ZREDUX,2) - . I GT'="" S NEWPATH=GT - S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX - N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE - I $D(GA) D ; PROCESS THE ATTRIBUTES - . N ZI S ZI="" - . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE - . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE - . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY - . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE - N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE - I $D(GD(2)) D ; - . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY - E I $D(GD(1)) D ; - . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY - . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY - N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD - I ZFRST'=0 D ; THERE IS A CHILD - . N ZNUM - . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE - . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD - N GNXT S GNXT=$$NXTSIB(ZOID) - I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES - I GNXT'=0 D ; - . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? - . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES - . . N ZNUM S ZNUM=1 ; - . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB - . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB - Q - ; -ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY - ; - N ZZI,ZZJ,ZZN - S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY - I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE - S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY - S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . - I ZZI'["]" D ; A SINGLETON - . S ZZN=1 - E D ; THERE IS AN [x] OCCURANCE - . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE - . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] - I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE - Q - ; -PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME - ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW - ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML - ;Q $$EN^MXMLDOM(INXML) - Q $$EN^MXMLDOM(INXML,"W") - ; -ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE - N ZN - ;I $$TAG(ZOID)["entry" B - S ZN=$$NXTSIB(ZOID) - I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG - Q 0 - ; -FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID - Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) - ; -PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID - Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) - ; -ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID - S HANDLE=C0SDOCID - K @RTN - D GETTXT^MXMLDOM("A") - Q - ; -TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE - ;I ZOID=149 B ;GPLTEST - N X,Y - S Y="" - S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE - I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y - I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) - Q Y - ; -NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING - Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) - ; -DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE - ;N ZT,ZN S ZT="" - ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) - ;Q $G(@C0SDOM@(ZOID,"T",1)) - S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) - Q - ; -OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM - ; - S C0SDOCID=INID - D START^C0SMXMLB($$TAG(1),,"G") - D NDOUT($$FIRST(1)) - D END^C0SMXMLB ;END THE DOCUMENT - M @ZRTN=^TMP("MXMLBLD",$J) - K ^TMP("MXMLBLD",$J) - Q - ; -NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE - N ZI S ZI=$$FIRST(ZOID) - I ZI'=0 D ; THERE IS A CHILD - . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT - . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN - E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT - . ;W "DOING",ZOID,! - . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA - . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES - . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN - I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING - . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS - Q - ; -WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE - ; - N GN,GN2 - D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML - S GN2=$NA(@GN@(1)) - W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") - Q - ; -TESTNARY ; TEST MAKING A NHIN ARRAY - N ZI S ZI="" - N ZH ; DOM HANDLE - D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM - S ZH=C0SDOCID ; SET THE HANDLE - N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) - F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE - . N ZATT - . D MNARY(.ZATT,ZH,ZI) - . N ZPRE,ZN - . S ZPRE=$$PRE(ZI) - . S ZN=$P(ZPRE,",",2) - . S ZPRE=$P(ZPRE,",",1) - . ;I $D(ZATT) ZWR ZATT - . N ZJ S ZJ="" - . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE - . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! - . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) - Q - ; -PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE - ; - N GI,GI2,GPT,GJ,GN - S GI=$$PARENT(ZNODE) ; PARENT NODE - I GI=0 Q "" ; NO PARENT - S GPT=$$TAG(GI) ; TAG OF PARENT - S GI2=$$PARENT(GI) ; PARENT OF PARENT - I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT - S GJ=$$FIRST(GI) ; NODE OF FIRST SIB - I GJ=ZNODE Q:$$TAG(GI)_",1" - F GN=2:1 Q:GJ=ZNODE D ; - . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING - Q GPT_","_GN - ; -MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE - ; RETURNED IN ZRTN, PASSED BY REFERENCE - ; ZHANDLE IS THE DOM DOCUMENT ID - ; ZOID IS THE DOM NODE - D ATT("ZRTN",ZOID) - Q - ; +C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q +EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT + ; + K GARY,GNARY,GIDX,C0SDOCID + K ZRTN + N GN + K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL + K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM + K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS + D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML + S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL + S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML + D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 + ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) + Q + ; +PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE + ; + N ZG + S ZG=$NA(^TMP("PQRIXML",$J)) + K @ZG + D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML + N C0SDOCID + S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML + D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 + Q + ; +PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE + ; + ;N GG + D GETXML^C0SMXP("GG","PQRI ONE MEASURE") + D PROCESS(ZRTN,"GG","root",1) + Q + ; +PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML + ; ZRTN IS PASSED BY REFERENCE + ; ZXML IS PASSED BY NAME + ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED + ; + N GN + S GN=$NA(^TMP("C0SPROCESS",$J)) + K @GN + M @GN=@ZXML + S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML + K @GN + D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 + Q + ; +LOADSMRT ; + ; + K ^GPL("SMART") + S GN=$NA(^GPL("SMART",1)) + I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" + Q + ; +SMART ; TRY IT WITH SMART + ; + S GN=$NA(^GPL("SMART")) + ;K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"SMART") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +CCR ; TRY IT WITH A CCR + ; + S GN=$NA(^GPL("CCR")) + ;K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"CCR") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +MED ; TRY IT WITH A CCR MED SECTION + ; + S GN=$NA(^GPL("MED")) + K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"MED") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +CCD ; TRY IT WITH A CCD + ; + S GN=$NA(^GPL("CCD")) + ;K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"CCD") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") + ; PARSED WITH MXML + ; RUN THROUGH XPATH + K GARY,GIDX,C0SDOCID + S GN=$NA(^GPL("NHIN")) + ;S GN=$NA(^GPL("DOMI")) + S C0SDOCID=$$PARSE(GN,"GPLTEST") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") + K ^GPL("GNARY") + M ^GPL("GNARY")=GNARY + Q + ; +TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") + ; + S GN=$NA(^GPL("GNARY")) + S C0SDOCID=$$DOMI^C0SDOM(GN,,"results") + D OUTXML^C0SDOM("G",C0SDOCID) + K ^GPL("DOMI") + M ^GPL("DOMI")=G + Q + ; +TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") + ; PARSED WITH MXML + ; RUN THROUGH XPATH + K GARY,GIDX,C0SDOCID + ;S GN=$NA(^GPL("NHIN")) + S GN=$NA(^GPL("DOMI")) + S C0SDOCID=$$PARSE(GN,"GPLTEST") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") + Q + ; +DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE + ; THE XPATH INDEX ZXIDX, PASSED BY NAME + ; THE XPATH ARRAY XPARY, PASSED BY NAME + ; ZOID IS THE STARTING OID + ; ZPATH IS THE STARTING XPATH, USUALLY "/" + ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE + ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT + I $G(ZREDUX)="" S ZREDUX="" + N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY + N NEWNUM S NEWNUM="" + I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" + S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE + I $G(ZREDUX)'="" D ; REDUX PROVIDED? + . N GT S GT=$P(NEWPATH,ZREDUX,2) + . I GT'="" S NEWPATH=GT + S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX + N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE + I $D(GA) D ; PROCESS THE ATTRIBUTES + . N ZI S ZI="" + . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE + . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE + . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY + . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE + N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE + I $D(GD(2)) D ; + . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY + E I $D(GD(1)) D ; + . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY + . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY + N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD + I ZFRST'=0 D ; THERE IS A CHILD + . N ZNUM + . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE + . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD + N GNXT S GNXT=$$NXTSIB(ZOID) + I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES + I GNXT'=0 D ; + . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? + . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES + . . N ZNUM S ZNUM=1 ; + . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB + . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB + Q + ; +ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY + ; + N ZZI,ZZJ,ZZN + S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY + I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE + S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY + S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . + I ZZI'["]" D ; A SINGLETON + . S ZZN=1 + E D ; THERE IS AN [x] OCCURANCE + . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE + . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] + I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE + Q + ; +PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME + ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW + ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML + ;Q $$EN^MXMLDOM(INXML) + Q $$EN^MXMLDOM(INXML,"W") + ; +ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE + N ZN + ;I $$TAG(ZOID)["entry" B + S ZN=$$NXTSIB(ZOID) + I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG + Q 0 + ; +FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID + Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) + ; +PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID + Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) + ; +ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID + S HANDLE=C0SDOCID + K @RTN + D GETTXT^MXMLDOM("A") + Q + ; +TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE + ;I ZOID=149 B ;GPLTEST + N X,Y + S Y="" + S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE + I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y + I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) + Q Y + ; +NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING + Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) + ; +DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE + ;N ZT,ZN S ZT="" + ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) + ;Q $G(@C0SDOM@(ZOID,"T",1)) + S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) + Q + ; +OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM + ; + S C0SDOCID=INID + D START^C0SMXMLB($$TAG(1),,"G") + D NDOUT($$FIRST(1)) + D END^C0SMXMLB ;END THE DOCUMENT + M @ZRTN=^TMP("MXMLBLD",$J) + K ^TMP("MXMLBLD",$J) + Q + ; +NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE + N ZI S ZI=$$FIRST(ZOID) + I ZI'=0 D ; THERE IS A CHILD + . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT + . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN + E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT + . ;W "DOING",ZOID,! + . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA + . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES + . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN + I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING + . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS + Q + ; +WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE + ; + N GN,GN2 + D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML + S GN2=$NA(@GN@(1)) + W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") + Q + ; +TESTNARY ; TEST MAKING A NHIN ARRAY + N ZI S ZI="" + N ZH ; DOM HANDLE + D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM + S ZH=C0SDOCID ; SET THE HANDLE + N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) + F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE + . N ZATT + . D MNARY(.ZATT,ZH,ZI) + . N ZPRE,ZN + . S ZPRE=$$PRE(ZI) + . S ZN=$P(ZPRE,",",2) + . S ZPRE=$P(ZPRE,",",1) + . ;I $D(ZATT) ZWR ZATT + . N ZJ S ZJ="" + . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE + . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! + . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) + Q + ; +PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE + ; + N GI,GI2,GPT,GJ,GN + S GI=$$PARENT(ZNODE) ; PARENT NODE + I GI=0 Q "" ; NO PARENT + S GPT=$$TAG(GI) ; TAG OF PARENT + S GI2=$$PARENT(GI) ; PARENT OF PARENT + I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT + S GJ=$$FIRST(GI) ; NODE OF FIRST SIB + I GJ=ZNODE Q:$$TAG(GI)_",1" + F GN=2:1 Q:GJ=ZNODE D ; + . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING + Q GPT_","_GN + ; +MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE + ; RETURNED IN ZRTN, PASSED BY REFERENCE + ; ZHANDLE IS THE DOM DOCUMENT ID + ; ZOID IS THE DOM NODE + D ATT("ZRTN",ZOID) + Q + ; Index: /smart/trunk/p/C0SNHINV.m =================================================================== --- /smart/trunk/p/C0SNHINV.m (revision 1570) +++ /smart/trunk/p/C0SNHINV.m (revision 1571) @@ -1,118 +1,118 @@ -C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version - ;;1.0;C0S;**1**;Oct 25, 2010;Build 11 - ; - ; External References DBIA# - ; ------------------- ----- - ; ^DPT 10035 - ; ^SC 10040 - ; DIQ 2056 - ; MPIF001 2701 - ; VASITE 10112 - ; XLFDT 10103 - ; XLFSTR 10104 - ; XUAF4 2171 - ; -GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n) - ; RPC = NHIN GET VISTA DATA - N ICN,NHINI,NHINTOTL - S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN - ; - ; parse & validate input parameters - S ICN=+$P(DFN,";",2),DFN=+$G(DFN) - I 'DFN S DFN=+$$GETDFN^MPIF001(ICN) - I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ - S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL - S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999 - I START,STOP,STOP") - F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D - . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q - . D @(RTN_"(DFN,START,STOP,MAX,ID)") - D ADD("") - ; - I $G(NHINTOTL),$G(@NHIN@(1))="" S @NHIN@(1)="" - ; -GTQ ; end - Q - ; -RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X - S X=$$UP^XLFSTR(X),Y="NHINV" - I X="ACCESSION" S Y="NHINVLRA" - I X="ALLERGY" S Y="NHINVART" - I X="APPOINTMENT" S Y="NHINVAPT" - ; X="CONSULT" S Y="NHINVCON" - I X="DOCUMENT" S Y="NHINVTIU" - I X="IMMUNIZATION" S Y="NHINVIMM" - I X="LAB" S Y="NHINVLR" - I X="PANEL" S Y="NHINVLRO" - I X="MED" S Y="NHINVPS" - I X="RX" S Y="NHINVPSO" - ; X="ORDER" S Y="NHINVOR" - I X="PATIENT" S Y="NHINVPT" - I X="PROBLEM" S Y="NHINVPL" - I X="PROCEDURE" S Y="NHINVPRC" - I X="SURGERY" S Y="NHINVSR" - I X="VISIT" S Y="NHINVSIT" - I X="VITAL" S Y="NHINVIT" - I X="RADIOLOGY" S Y="NHINVRA" - I X="NEW" S Y="NHINVPR" - Q Y - ; -ALL() ; -- return string for all types of data - ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure" - Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure" - ; -ERR(X,VAL) ; -- return error message - N MSG S MSG="Error" - I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found" - I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized" - I X=99 S MSG="Unknown request" - ; - D ADD("") - D ADD(""_MSG_"") - D ADD("") - Q - ; -ESC(X) ; -- escape outgoing XML - ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache - ; - N I,Y,QOT S QOT="""" - S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I) - S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I) - S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I) - S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I) - S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I) - Q Y - ; -ADD(X) ; Add a line @NHIN@(n)=X - S NHINI=$G(NHINI)+1 - S @NHIN@(NHINI)=X - Q - ; -STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string - N I,X,Y S Y="" - S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0)) - S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I))) - F S I=$O(ARRAY(I)) Q:I<1 D - . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I)) - . I $E(X)=" " S Y=Y_$C(13,10)_X Q - . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X - Q Y - ; -FAC(X) ; -- return Institution file station# for location X - N HLOC,FAC,Y0,Y S Y="" - S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien - ; Get P:4 via Med Ctr Div, if not directly linked - I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I") - S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn# - S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name - I $L(Y),'Y S $P(Y,U)=FAC - Q Y - ; -VUID(IEN,FILE) ; -- Return VUID for item - Q $$GET1^DIQ(FILE,IEN_",",99.99) +C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ; + ; External References DBIA# + ; ------------------- ----- + ; ^DPT 10035 + ; ^SC 10040 + ; DIQ 2056 + ; MPIF001 2701 + ; VASITE 10112 + ; XLFDT 10103 + ; XLFSTR 10104 + ; XUAF4 2171 + ; +GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n) + ; RPC = NHIN GET VISTA DATA + N ICN,NHINI,NHINTOTL + S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN + ; + ; parse & validate input parameters + S ICN=+$P(DFN,";",2),DFN=+$G(DFN) + I 'DFN S DFN=+$$GETDFN^MPIF001(ICN) + I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ + S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL + S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999 + I START,STOP,STOP") + F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D + . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q + . D @(RTN_"(DFN,START,STOP,MAX,ID)") + D ADD("") + ; + I $G(NHINTOTL),$G(@NHIN@(1))="" S @NHIN@(1)="" + ; +GTQ ; end + Q + ; +RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X + S X=$$UP^XLFSTR(X),Y="NHINV" + I X="ACCESSION" S Y="NHINVLRA" + I X="ALLERGY" S Y="NHINVART" + I X="APPOINTMENT" S Y="NHINVAPT" + ; X="CONSULT" S Y="NHINVCON" + I X="DOCUMENT" S Y="NHINVTIU" + I X="IMMUNIZATION" S Y="NHINVIMM" + I X="LAB" S Y="NHINVLR" + I X="PANEL" S Y="NHINVLRO" + I X="MED" S Y="NHINVPS" + I X="RX" S Y="NHINVPSO" + ; X="ORDER" S Y="NHINVOR" + I X="PATIENT" S Y="NHINVPT" + I X="PROBLEM" S Y="NHINVPL" + I X="PROCEDURE" S Y="NHINVPRC" + I X="SURGERY" S Y="NHINVSR" + I X="VISIT" S Y="NHINVSIT" + I X="VITAL" S Y="NHINVIT" + I X="RADIOLOGY" S Y="NHINVRA" + I X="NEW" S Y="NHINVPR" + Q Y + ; +ALL() ; -- return string for all types of data + ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure" + Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure" + ; +ERR(X,VAL) ; -- return error message + N MSG S MSG="Error" + I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found" + I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized" + I X=99 S MSG="Unknown request" + ; + D ADD("") + D ADD(""_MSG_"") + D ADD("") + Q + ; +ESC(X) ; -- escape outgoing XML + ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache + ; + N I,Y,QOT S QOT="""" + S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I) + S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I) + S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I) + S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I) + S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I) + Q Y + ; +ADD(X) ; Add a line @NHIN@(n)=X + S NHINI=$G(NHINI)+1 + S @NHIN@(NHINI)=X + Q + ; +STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string + N I,X,Y S Y="" + S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0)) + S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I))) + F S I=$O(ARRAY(I)) Q:I<1 D + . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I)) + . I $E(X)=" " S Y=Y_$C(13,10)_X Q + . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X + Q Y + ; +FAC(X) ; -- return Institution file station# for location X + N HLOC,FAC,Y0,Y S Y="" + S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien + ; Get P:4 via Med Ctr Div, if not directly linked + I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I") + S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn# + S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name + I $L(Y),'Y S $P(Y,U)=FAC + Q Y + ; +VUID(IEN,FILE) ; -- Return VUID for item + Q $$GET1^DIQ(FILE,IEN_",",99.99) Index: /smart/trunk/p/C0SPROB.m =================================================================== --- /smart/trunk/p/C0SPROB.m (revision 1570) +++ /smart/trunk/p/C0SPROB.m (revision 1571) @@ -1,323 +1,323 @@ -C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; sample VistA NHIN problem list - ; - ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 - ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 - ;^TMP("C0STBL",91,"problem",1,"id@value")=100 - ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" - ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 - ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",1,"status@value")="A" - ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 - ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 - ;^TMP("C0STBL",91,"problem",2,"id@value")=108 - ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" - ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 - ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",2,"status@value")="A" - ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 - ;^TMP("C0STBL",91,"problem",3,"id@value")=109 - ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" - ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 - ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",3,"status@value")="A" - ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"id@value")=115 - ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",4,"status@value")="A" - ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"id@value")=116 - ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",5,"status@value")="A" - ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"id@value")=117 - ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",6,"status@value")="A" - ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"id@value")=118 - ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",7,"status@value")="A" - ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" - ;^TMP("C0STBL",91,"problem",8,"id@value")=119 - ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," - ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",8,"status@value")="A" - ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 - ; - ; sample Smart lab result triples - ; - ;G("node16rk1fgdvx10882","code")="snomed:40930008" - ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" - ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11051","code")="snomed:188155002" - ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11073","code")="snomed:353295004" - ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" - ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11089","code")="snomed:54302000" - ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" - ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11351","code")="snomed:38341003" - ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" - ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11390","code")="snomed:44054006" - ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" - ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11558","code")="snomed:195967001" - ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" - ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11578","code")="snomed:254837009" - ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11687","code")="snomed:8517006" - ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" - ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11716","code")="snomed:55822004" - ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" - ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" - ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" - ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" - ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" - ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" - ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" - ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" - ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" - ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" - ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" - ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" - ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" - ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" - ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" - ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" - ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" - ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" - ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" - ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" - ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" - ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" - ;G("snomed:188155002","dcterms:identifier")=188155002 - ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("snomed:188155002","rdf:type")="sp:Code" - ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:195967001","dcterms:identifier")=195967001 - ;G("snomed:195967001","dcterms:title")="Asthma" - ;G("snomed:195967001","rdf:type")="sp:Code" - ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:254837009","dcterms:identifier")=254837009 - ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("snomed:254837009","rdf:type")="sp:Code" - ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:353295004","dcterms:identifier")=353295004 - ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" - ;G("snomed:353295004","rdf:type")="sp:Code" - ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:38341003","dcterms:identifier")=38341003 - ;G("snomed:38341003","dcterms:title")="Essential hypertension" - ;G("snomed:38341003","rdf:type")="sp:Code" - ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:40930008","dcterms:identifier")=40930008 - ;G("snomed:40930008","dcterms:title")="Hypothyroidism" - ;G("snomed:40930008","rdf:type")="sp:Code" - ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:44054006","dcterms:identifier")=44054006 - ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" - ;G("snomed:44054006","rdf:type")="sp:Code" - ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:54302000","dcterms:identifier")=54302000 - ;G("snomed:54302000","dcterms:title")="Disorder of breast" - ;G("snomed:54302000","rdf:type")="sp:Code" - ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:55822004","dcterms:identifier")=55822004 - ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" - ;G("snomed:55822004","rdf:type")="sp:Code" - ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:8517006","dcterms:identifier")=8517006 - ;G("snomed:8517006","dcterms:title")="History of tobacco use" - ;G("snomed:8517006","rdf:type")="sp:Code" - ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" - - ; -PROB(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of problems - ; - I $O(C0SARY("problem",""))="" D Q ; - . I $D(DEBUG) W !,"No Problems" - S GRTN="" ; default to no problems - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/problems" - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - D STARTADD^C0XF2N ; initialize to create triples - ; - N ZI S ZI="" - F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; - . N LRN,ZR ; ZR is the local array for building the new triples - . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result - . ; - . N PROBID ; unique Id for this problem - . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number - . ; - . ; i don't like this because the same problems gets a - . ; different ID every time it's reported. Can't trace it back to VistA - . ; I'd rather be using id@value ie "id@value")="118" - . ; - . N SNOMED S SNOMED=$G(@LRN@("icd@value")) - . N SNOGRF S SNOGRF="snomed:"_SNOMED - . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) - . I $D(DEBUG) D ; - . . W !,"Processing Problem List ",PROBID - . . W !,"problem: ",SNOTIT - . . W !,"code: ",SNOMED - . ; - . ; first do the base result graph - . ; - . S ZR("rdf:type")="sp:Problem" - . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems - . ; ie /vista/smart/99912345/problems - . ; - . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name - . S ZR("sp:problemName")=PROBNAME - . ; - . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) - . S ZR("sp:startDate")=STARTDT - . ; - . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples - . K ZR ; clean up - . ; - . ; create the problemName graph - . ; - . S ZR("rdf:type")="sp:CodedValue" - . S ZR("sp:code")="snomed:"_SNOMED - . S ZR("dcterms:title")=$G(@LRN@("name@value")) - . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) - . K ZR - . ; - . ; create snomed graph - . ; - . S ZR("rdf:type")="sp:Code" - . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" - . S ZR("dcterms:identifier")=SNOMED - . S ZR("dcterms:title")=SNOTIT - . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) - . K ZR - . ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; +C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; sample VistA NHIN problem list + ; + ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 + ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 + ;^TMP("C0STBL",91,"problem",1,"id@value")=100 + ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" + ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 + ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",1,"status@value")="A" + ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 + ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 + ;^TMP("C0STBL",91,"problem",2,"id@value")=108 + ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" + ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 + ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",2,"status@value")="A" + ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 + ;^TMP("C0STBL",91,"problem",3,"id@value")=109 + ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" + ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 + ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",3,"status@value")="A" + ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"id@value")=115 + ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",4,"status@value")="A" + ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"id@value")=116 + ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",5,"status@value")="A" + ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"id@value")=117 + ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",6,"status@value")="A" + ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"id@value")=118 + ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",7,"status@value")="A" + ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" + ;^TMP("C0STBL",91,"problem",8,"id@value")=119 + ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," + ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",8,"status@value")="A" + ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 + ; + ; sample Smart lab result triples + ; + ;G("node16rk1fgdvx10882","code")="snomed:40930008" + ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" + ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11051","code")="snomed:188155002" + ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11073","code")="snomed:353295004" + ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" + ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11089","code")="snomed:54302000" + ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" + ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11351","code")="snomed:38341003" + ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" + ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11390","code")="snomed:44054006" + ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" + ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11558","code")="snomed:195967001" + ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" + ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11578","code")="snomed:254837009" + ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11687","code")="snomed:8517006" + ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" + ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11716","code")="snomed:55822004" + ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" + ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" + ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" + ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" + ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" + ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" + ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" + ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" + ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" + ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" + ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" + ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" + ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" + ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" + ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" + ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" + ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" + ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" + ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" + ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" + ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" + ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" + ;G("snomed:188155002","dcterms:identifier")=188155002 + ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("snomed:188155002","rdf:type")="sp:Code" + ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:195967001","dcterms:identifier")=195967001 + ;G("snomed:195967001","dcterms:title")="Asthma" + ;G("snomed:195967001","rdf:type")="sp:Code" + ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:254837009","dcterms:identifier")=254837009 + ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("snomed:254837009","rdf:type")="sp:Code" + ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:353295004","dcterms:identifier")=353295004 + ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" + ;G("snomed:353295004","rdf:type")="sp:Code" + ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:38341003","dcterms:identifier")=38341003 + ;G("snomed:38341003","dcterms:title")="Essential hypertension" + ;G("snomed:38341003","rdf:type")="sp:Code" + ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:40930008","dcterms:identifier")=40930008 + ;G("snomed:40930008","dcterms:title")="Hypothyroidism" + ;G("snomed:40930008","rdf:type")="sp:Code" + ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:44054006","dcterms:identifier")=44054006 + ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" + ;G("snomed:44054006","rdf:type")="sp:Code" + ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:54302000","dcterms:identifier")=54302000 + ;G("snomed:54302000","dcterms:title")="Disorder of breast" + ;G("snomed:54302000","rdf:type")="sp:Code" + ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:55822004","dcterms:identifier")=55822004 + ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" + ;G("snomed:55822004","rdf:type")="sp:Code" + ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:8517006","dcterms:identifier")=8517006 + ;G("snomed:8517006","dcterms:title")="History of tobacco use" + ;G("snomed:8517006","rdf:type")="sp:Code" + ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" + + ; +PROB(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of problems + ; + I $O(C0SARY("problem",""))="" D Q ; + . I $D(DEBUG) W !,"No Problems" + S GRTN="" ; default to no problems + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/problems" + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + D STARTADD^C0XF2N ; initialize to create triples + ; + N ZI S ZI="" + F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; + . N LRN,ZR ; ZR is the local array for building the new triples + . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result + . ; + . N PROBID ; unique Id for this problem + . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number + . ; + . ; i don't like this because the same problems gets a + . ; different ID every time it's reported. Can't trace it back to VistA + . ; I'd rather be using id@value ie "id@value")="118" + . ; + . N SNOMED S SNOMED=$G(@LRN@("icd@value")) + . N SNOGRF S SNOGRF="snomed:"_SNOMED + . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) + . I $D(DEBUG) D ; + . . W !,"Processing Problem List ",PROBID + . . W !,"problem: ",SNOTIT + . . W !,"code: ",SNOMED + . ; + . ; first do the base result graph + . ; + . S ZR("rdf:type")="sp:Problem" + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems + . ; ie /vista/smart/99912345/problems + . ; + . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name + . S ZR("sp:problemName")=PROBNAME + . ; + . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) + . S ZR("sp:startDate")=STARTDT + . ; + . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples + . K ZR ; clean up + . ; + . ; create the problemName graph + . ; + . S ZR("rdf:type")="sp:CodedValue" + . S ZR("sp:code")="snomed:"_SNOMED + . S ZR("dcterms:title")=$G(@LRN@("name@value")) + . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) + . K ZR + . ; + . ; create snomed graph + . ; + . S ZR("rdf:type")="sp:Code" + . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" + . S ZR("dcterms:identifier")=SNOMED + . S ZR("dcterms:title")=SNOTIT + . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) + . K ZR + . ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; Index: /smart/trunk/p/C0SPROB2.m =================================================================== --- /smart/trunk/p/C0SPROB2.m (revision 1570) +++ /smart/trunk/p/C0SPROB2.m (revision 1571) @@ -1,343 +1,343 @@ -C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; sample VistA NHIN problem list - ; - ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 - ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 - ;^TMP("C0STBL",91,"problem",1,"id@value")=100 - ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" - ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 - ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",1,"status@value")="A" - ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 - ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 - ;^TMP("C0STBL",91,"problem",2,"id@value")=108 - ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" - ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 - ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",2,"status@value")="A" - ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 - ;^TMP("C0STBL",91,"problem",3,"id@value")=109 - ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" - ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 - ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",3,"status@value")="A" - ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"id@value")=115 - ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",4,"status@value")="A" - ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"id@value")=116 - ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",5,"status@value")="A" - ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"id@value")=117 - ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",6,"status@value")="A" - ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"id@value")=118 - ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",7,"status@value")="A" - ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" - ;^TMP("C0STBL",91,"problem",8,"id@value")=119 - ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," - ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",8,"status@value")="A" - ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 - ; - ; sample Smart lab result triples - ; - ;G("node16rk1fgdvx10882","code")="snomed:40930008" - ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" - ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11051","code")="snomed:188155002" - ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11073","code")="snomed:353295004" - ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" - ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11089","code")="snomed:54302000" - ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" - ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11351","code")="snomed:38341003" - ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" - ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11390","code")="snomed:44054006" - ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" - ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11558","code")="snomed:195967001" - ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" - ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11578","code")="snomed:254837009" - ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11687","code")="snomed:8517006" - ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" - ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11716","code")="snomed:55822004" - ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" - ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" - ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" - ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" - ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" - ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" - ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" - ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" - ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" - ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" - ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" - ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" - ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" - ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" - ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" - ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" - ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" - ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" - ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" - ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" - ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" - ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" - ;G("snomed:188155002","dcterms:identifier")=188155002 - ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("snomed:188155002","rdf:type")="sp:Code" - ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:195967001","dcterms:identifier")=195967001 - ;G("snomed:195967001","dcterms:title")="Asthma" - ;G("snomed:195967001","rdf:type")="sp:Code" - ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:254837009","dcterms:identifier")=254837009 - ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("snomed:254837009","rdf:type")="sp:Code" - ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:353295004","dcterms:identifier")=353295004 - ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" - ;G("snomed:353295004","rdf:type")="sp:Code" - ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:38341003","dcterms:identifier")=38341003 - ;G("snomed:38341003","dcterms:title")="Essential hypertension" - ;G("snomed:38341003","rdf:type")="sp:Code" - ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:40930008","dcterms:identifier")=40930008 - ;G("snomed:40930008","dcterms:title")="Hypothyroidism" - ;G("snomed:40930008","rdf:type")="sp:Code" - ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:44054006","dcterms:identifier")=44054006 - ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" - ;G("snomed:44054006","rdf:type")="sp:Code" - ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:54302000","dcterms:identifier")=54302000 - ;G("snomed:54302000","dcterms:title")="Disorder of breast" - ;G("snomed:54302000","rdf:type")="sp:Code" - ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:55822004","dcterms:identifier")=55822004 - ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" - ;G("snomed:55822004","rdf:type")="sp:Code" - ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:8517006","dcterms:identifier")=8517006 - ;G("snomed:8517006","dcterms:title")="History of tobacco use" - ;G("snomed:8517006","rdf:type")="sp:Code" - ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" - - ; -PROB(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of problems - ; - I $O(C0SARY("problem",""))="" D Q ; - . I $D(DEBUG) W !,"No Problems" - S GRTN="" ; default to no problems - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/problems" - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - D STARTADD^C0XF2N ; initialize to create triples - ; - N ZI S ZI="" - F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; - . N LRN,ZR ; ZR is the local array for building the new triples - . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result - . ; - . N PROBID ; unique Id for this problem - . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number - . ; - . ; i don't like this because the same problems gets a - . ; different ID every time it's reported. Can't trace it back to VistA - . ; I'd rather be using id@value ie "id@value")="118" - . ; - . N SNOMED,ICD S ICD=$G(@LRN@("icd@value")) - . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map - . N SNOGRF ; graph for SNOMED code - . I SNOMED="" D ; - . . S SNOMED=ICD ; if not found, return the ICD code - . . S SNOGRF="icd9:"_SNOMED - . E S SNOGRF="snomed:"_SNOMED - . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) - . I $D(DEBUG) D ; - . . W !,"Processing Problem List ",PROBID - . . W !,"problem: ",SNOTIT - . . W !,"code: ",SNOMED - . ; - . ; first do the base result graph - . ; - . S ZR("rdf:type")="sp:Problem" - . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems - . ; ie /vista/smart/99912345/problems - . ; - . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name - . S ZR("sp:problemName")=PROBNAME - . ; - . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) - . S ZR("sp:startDate")=STARTDT - . ; - . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples - . K ZR ; clean up - . ; - . ; create the problemName graph - . ; - . S ZR("rdf:type")="sp:CodedValue" - . ;S ZR("sp:code")="snomed:"_SNOMED - . S ZR("sp:code")=SNOGRF - . S ZR("dcterms:title")=$G(@LRN@("name@value")) - . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) - . K ZR - . ; - . ; create snomed graph - . ; - . S ZR("rdf:type")="sp:Code" - . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" - . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9" - . S ZR("dcterms:identifier")=SNOMED - . S ZR("dcterms:title")=SNOTIT - . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) - . K ZR - . ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; -SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code - ; requires the mapping table installed in the triplestore - ; - N ZSN,ZARY,ZSUB,ZSUBS - I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots - D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code - S ZSUB=$O(ZSUBS("")) ; pick the first one - I ZSUB="" Q "" - D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") - S ZSN=$O(ZARY("")) - I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") - Q ZSN - ; +C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; sample VistA NHIN problem list + ; + ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 + ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 + ;^TMP("C0STBL",91,"problem",1,"id@value")=100 + ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" + ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 + ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",1,"status@value")="A" + ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 + ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 + ;^TMP("C0STBL",91,"problem",2,"id@value")=108 + ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" + ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 + ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",2,"status@value")="A" + ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 + ;^TMP("C0STBL",91,"problem",3,"id@value")=109 + ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" + ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 + ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",3,"status@value")="A" + ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"id@value")=115 + ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",4,"status@value")="A" + ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"id@value")=116 + ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",5,"status@value")="A" + ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"id@value")=117 + ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",6,"status@value")="A" + ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"id@value")=118 + ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",7,"status@value")="A" + ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" + ;^TMP("C0STBL",91,"problem",8,"id@value")=119 + ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," + ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",8,"status@value")="A" + ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 + ; + ; sample Smart lab result triples + ; + ;G("node16rk1fgdvx10882","code")="snomed:40930008" + ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" + ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11051","code")="snomed:188155002" + ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11073","code")="snomed:353295004" + ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" + ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11089","code")="snomed:54302000" + ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" + ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11351","code")="snomed:38341003" + ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" + ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11390","code")="snomed:44054006" + ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" + ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11558","code")="snomed:195967001" + ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" + ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11578","code")="snomed:254837009" + ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11687","code")="snomed:8517006" + ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" + ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11716","code")="snomed:55822004" + ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" + ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" + ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" + ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" + ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" + ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" + ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" + ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" + ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" + ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" + ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" + ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" + ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" + ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" + ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" + ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" + ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" + ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" + ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" + ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" + ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" + ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" + ;G("snomed:188155002","dcterms:identifier")=188155002 + ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("snomed:188155002","rdf:type")="sp:Code" + ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:195967001","dcterms:identifier")=195967001 + ;G("snomed:195967001","dcterms:title")="Asthma" + ;G("snomed:195967001","rdf:type")="sp:Code" + ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:254837009","dcterms:identifier")=254837009 + ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("snomed:254837009","rdf:type")="sp:Code" + ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:353295004","dcterms:identifier")=353295004 + ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" + ;G("snomed:353295004","rdf:type")="sp:Code" + ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:38341003","dcterms:identifier")=38341003 + ;G("snomed:38341003","dcterms:title")="Essential hypertension" + ;G("snomed:38341003","rdf:type")="sp:Code" + ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:40930008","dcterms:identifier")=40930008 + ;G("snomed:40930008","dcterms:title")="Hypothyroidism" + ;G("snomed:40930008","rdf:type")="sp:Code" + ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:44054006","dcterms:identifier")=44054006 + ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" + ;G("snomed:44054006","rdf:type")="sp:Code" + ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:54302000","dcterms:identifier")=54302000 + ;G("snomed:54302000","dcterms:title")="Disorder of breast" + ;G("snomed:54302000","rdf:type")="sp:Code" + ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:55822004","dcterms:identifier")=55822004 + ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" + ;G("snomed:55822004","rdf:type")="sp:Code" + ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:8517006","dcterms:identifier")=8517006 + ;G("snomed:8517006","dcterms:title")="History of tobacco use" + ;G("snomed:8517006","rdf:type")="sp:Code" + ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" + + ; +PROB(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of problems + ; + I $O(C0SARY("problem",""))="" D Q ; + . I $D(DEBUG) W !,"No Problems" + S GRTN="" ; default to no problems + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/problems" + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + D STARTADD^C0XF2N ; initialize to create triples + ; + N ZI S ZI="" + F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; + . N LRN,ZR ; ZR is the local array for building the new triples + . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result + . ; + . N PROBID ; unique Id for this problem + . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number + . ; + . ; i don't like this because the same problems gets a + . ; different ID every time it's reported. Can't trace it back to VistA + . ; I'd rather be using id@value ie "id@value")="118" + . ; + . N SNOMED,ICD S ICD=$G(@LRN@("icd@value")) + . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map + . N SNOGRF ; graph for SNOMED code + . I SNOMED="" D ; + . . S SNOMED=ICD ; if not found, return the ICD code + . . S SNOGRF="icd9:"_SNOMED + . E S SNOGRF="snomed:"_SNOMED + . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) + . I $D(DEBUG) D ; + . . W !,"Processing Problem List ",PROBID + . . W !,"problem: ",SNOTIT + . . W !,"code: ",SNOMED + . ; + . ; first do the base result graph + . ; + . S ZR("rdf:type")="sp:Problem" + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems + . ; ie /vista/smart/99912345/problems + . ; + . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name + . S ZR("sp:problemName")=PROBNAME + . ; + . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) + . S ZR("sp:startDate")=STARTDT + . ; + . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples + . K ZR ; clean up + . ; + . ; create the problemName graph + . ; + . S ZR("rdf:type")="sp:CodedValue" + . ;S ZR("sp:code")="snomed:"_SNOMED + . S ZR("sp:code")=SNOGRF + . S ZR("dcterms:title")=$G(@LRN@("name@value")) + . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) + . K ZR + . ; + . ; create snomed graph + . ; + . S ZR("rdf:type")="sp:Code" + . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" + . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9" + . S ZR("dcterms:identifier")=SNOMED + . S ZR("dcterms:title")=SNOTIT + . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) + . K ZR + . ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; +SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code + ; requires the mapping table installed in the triplestore + ; + N ZSN,ZARY,ZSUB,ZSUBS + I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots + D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code + S ZSUB=$O(ZSUBS("")) ; pick the first one + I ZSUB="" Q "" + D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") + S ZSN=$O(ZARY("")) + I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") + Q ZSN + ; Index: /smart/trunk/p/C0STBL.m =================================================================== --- /smart/trunk/p/C0STBL.m (revision 1570) +++ /smart/trunk/p/C0STBL.m (revision 1571) @@ -1,4 +1,4 @@ -C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 +C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 ;Copyright 2012 George Lilly. Licensed under the terms of the GNU ;General Public License See attached copy of the License. Index: /smart/trunk/p/C0SUTIL.m =================================================================== --- /smart/trunk/p/C0SUTIL.m (revision 1570) +++ /smart/trunk/p/C0SUTIL.m (revision 1571) @@ -1,34 +1,34 @@ -C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; -SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd - ; ZDATE is a fileman format date - N TMPDT - S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date - S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens - I TMPDT="" S TMPDT="UNKNOWN" - N Z2,Z3 - S Z2=$P(TMPDT,"-",2) - S Z3=$P(TMPDT,"-",3) - I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2 - I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3 - Q TMPDT - ; +C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; +SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd + ; ZDATE is a fileman format date + N TMPDT + S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date + S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens + I TMPDT="" S TMPDT="UNKNOWN" + N Z2,Z3 + S Z2=$P(TMPDT,"-",2) + S Z3=$P(TMPDT,"-",3) + I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2 + I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3 + Q TMPDT + ; Index: /smart/trunk/p/C0SXPATH.m =================================================================== --- /smart/trunk/p/C0SXPATH.m (revision 1570) +++ /smart/trunk/p/C0SXPATH.m (revision 1571) @@ -1,726 +1,726 @@ -C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 - ;;1.0;C0S;;May 19, 2009;Build 2 - ;Copyright 2008-2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - W "This is an XML XPATH utility library",! - W ! - Q - ; -OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE - ; - N Y - S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) - I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR - I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR - Q - ; -PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) - ; VAL IS A STRING AND STK IS PASSED BY NAME - ; - I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE - S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH - S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY - Q - ; -POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL - ; VAL AND STK ARE PASSED BY REFERENCE - ; - I @STK@(0)<1 D ; IF ARRAY IS EMPTY - . S VAL="" - . S @STK@(0)=0 - I @STK@(0)>0 D ; - . S VAL=@STK@(@STK@(0)) - . K @STK@(@STK@(0)) - . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY - Q - ; -PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME - ; - N ZGI - F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY - . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT - Q - ; -MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK - ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS - ; REDUX IS A STRING TO REMOVE FROM THE RESULT - S RTN="" - N I - ; W "STK= ",STK,! - I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY - . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON - . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON - . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) - I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2) - Q - ; -XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG - ; AND WILL RETURN NAME - ; ISTR IS PASSED BY VALUE - N CUR,TMP - I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET - . S TMP=$P(ISTR,"<",2) - I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE - . S TMP=$P(TMP,"/",2) - S CUR=$P(TMP,">",1) ; EXTRACT THE NAME - ; W "CUR= ",CUR,! - I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> - . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER - ; W "CUR2= ",CUR,! - Q CUR - ; -XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML - ; VALUE WILL RETURN VALUE - N G - S G=$P(ISTR,">",2) ;STRIP OFF - Q $P(G,"<",1) ; STRIP OFF LEAVING VALUE - ; -VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV - ; VDX: @INVDX@(XPATH)=VALUE - ; VDV: @OUTVDV@(X1X2X3X4)=VALUE - ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE - ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS - ; @VDV@("XPATH",X1X2X3X4)="XPATH" - N ZA,ZI,ZW - S ZI="" - F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; - . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME - . W ZW,! - . S @OUTVDV@(ZW)=@INVDX@(ZI) - . S @OUTVDV@("XPATH",ZW)=ZI - Q - ; -VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG - ; VDX: @VDX@(XPATH)=VALUE - ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE - ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX - N ZA,ZI,ZW - S ZI="" - F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; - . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL // - . S ZW2=$P(ZW,"/",1) - . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK)) - . ;ZWR ZA - . S ZW2=ZA(1) - . F ZK=2:1:ZA(0) D ; - . . S ZW2=ZW2_""","""_ZA(ZK) - . K ZA - . S ZW2=""""_ZW2_"""" - . W ZW2,! - . S ZN=OUTXPG_"("_ZW2_")" - . S @ZN=@INVDX@(ZI) - Q - ; -XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY - ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE - ; - ;N G1 - D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED - D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM - Q - ; -DO - D XPG2XML("^GPL2B","^GPL2A") - Q - ; -T1 ; TEST OUT THESE ROUTINES - D XML2XPG("G2","^GPL") - D XPG2XML("G3","G2") - K ^GPLOUT - M ^GPLOUT=G3 - W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p") - Q - ; -XPG2XML(OUTXML,INXPG) ; - N C0CN,FWD,ZA,G,GA,ZQ - S ZQ=0 ; QUIT FLAG - F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING - . I '$D(C0CN) D ; FIRST TIME THROUGH - . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR - . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS - . . S G=$Q(@INXPG) ; THIS ONE - . . S GN=$Q(@G) ; NEXT ONE - . . S C0CN=1 ; SUBSCRIPT COUNT - . . S ZQ=0 ; QUIT FLAG - . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML - . . I $QS(G,1)="ContinuityOfCareRecord" D ; - . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK - . I FWD D ; GOING FORWARDS - . . I C0CN<$QL(G) D ; NOT A DATA NODE - . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT - . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT - . . . I @OUTXML@(@OUTXML@(0))="" D ; - . . . . S @OUTXML@(@OUTXML@(0))="" - . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE - . . E D ; AT THE DATA NODE - . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT - . . . D ZXVAL(ZA,@G) ; OUTPUT VAL FOR DATA NODE - . . . S FWD=0 ; GO BACKWARDS - . I 'FWD D ;GOING BACKWARDS - . . S GN=$Q(@G) ;NEXT XPATH - . . ;W "NEXT!",GN,! - . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT - . . I GN'="" D ; - . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT - . . . . D ZXC($QS(G,C0CN)) ; - . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL - . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH - . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT - . . . . S FWD=1 ; GOING FORWARD NOW - . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE - . . D ZXC($QS(G,C0CN)) ; LAST ONE - . . S ZQ=1 ; QUIT NOW - Q - ; -ZXO(WHAT) - D PUSH("GA",WHAT) - D PUSH(OUTXML,"<"_WHAT_">") - Q - ; -ZXC(WHAT) - D POP("GA",.TMP) - D PUSH(OUTXML,"") - Q - ; -ZXVAL(WHAT,VAL) - D PUSH(OUTXML,"<"_WHAT_">"_VAL_"") - Q - ; -INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce - ; an XPATH index; REDUX is a string to be removed from each xpath - ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME - ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE - ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG - ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME - ; @VDX@("XPATH")=VALUE - ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE - ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE - ; XML SECTION - ; IZXML IS PASSED BY NAME - ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE - N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT - N C0CSTK ; LEAVE OUT FOR DEBUGGING - I '$D(REDUX) S REDUX="" - I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX - N ZXML - I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD - E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP - I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM - . S I="",LCNT=0 - . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1 - E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY - I LCNT=0 D Q ; NO XML PASSED - . W "ERROR IN XML FILE",! - S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX - I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX - S C0CSTK(0)=0 ; INITIALIZE STACK - K LKASD ; KILL LOOKASIDE ARRAY - D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES - F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY - . S LINE=@IZXML@(I) - . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED - . . S @TEMPLATE@(I)=$$CLEAN(LINE) - . ;W LINE,! - . S FOUND=0 ; INTIALIZED FOUND FLAG - . I LINE?.E1"".E) D - . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS - . . . ; ON THE SAME LINE - . . . ; W "FOUND ",LINE,! - . . . S FOUND=1 ; SET FOUND FLAG - . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME - . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES - . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK - . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX - . . . ; W "MDX=",MDX,! - . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE - . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2 - . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1 - . . . . ;W "DUP:",MDX,! - . . . . ;I '$D(CURVAL) S CURVAL="" - . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL - . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER - . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE - . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST - . . . . S CURVAL=$$XVAL(LINE) ; VALUE - . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE - . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED - . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED - . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS - . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@") D ; BEGINNING OF A SECTION - . . . ; W "FOUND ",LINE,! - . . . S FOUND=1 ; SET FOUND FLAG - . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME - . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES - . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK - . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX - . . . ; W "MDX=",MDX,! - . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE - . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER - . . . . ;B - . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE - . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX - S @ZXML@("INDEXED")="" - S @ZXML@("//")="1^"_LCNT ; ROOT XPATH - I NOINX K @ZXML ; DELETE UNWANTED INDEX - Q - ; -MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES - ; - N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2 - F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY - . S ZLINE=@IZXML@(ZI) - . I ZI") D ; BEGINNING OF A SECTION - . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME - . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE - . . . . S OUTBUF(CUR,ZI+1)="" - ;ZWR OUTBUF - S ZI="" - F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE - . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE - . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ; - . S OUTBUF(ZI,ZN)="" - S ZA=1,ZI="",ZN="" - F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] - . S ZN="",ZA=1 - . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ; - . . S OUTBUF(ZI,ZN)="["_ZA_"]" - . . S ZA=ZA+1 - Q - ; -CLEAN(STR,TR) ; extrinsic function; returns string - ;; Removes all non printable characters from a string. - ;; STR by Value - ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE - N TR,I - I '$D(TR) D ; - . F I=0:1:31 S TR=$G(TR)_$C(I) - . S TR=TR_$C(127) - QUIT $TR(STR,TR) - ; -QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION - ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" - ; IARY AND OARY ARE PASSED BY NAME - I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY - . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML - N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN - N TMP,I,J,QXPATH - S FIRST=1 - I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE - . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK - S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT - I XPATH'="//" D ; NOT A ROOT QUERY - . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES - . S FIRST=$P(TMP,"^",1) - . S LAST=$P(TMP,"^",2) - K @OARY - S @OARY@(0)=+LAST-FIRST+1 - S J=1 - FOR I=FIRST:1:LAST D - . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY - . S J=J+1 - ; ZWR OARY - Q - ; -XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH - ; INDEX WITH TWO PIECES START^FINISH - ; IDX IS PASSED BY NAME - Q $P(@IDX@(XPATH),"^",1) - ; -XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH - ; INDEX WITH TWO PIECES START^FINISH - ; IDX IS PASSED BY NAME - Q $P(@IDX@(XPATH),"^",2) - ; -START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX - ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH - ; COMPANION TO FINISH ; IDX IS PASSED BY NAME - Q $P(ISTR,";",2) - ; -FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX - ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH - Q $P(ISTR,";",3) - ; -ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX - ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH - Q $P(ISTR,";",1) - ; -BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST - ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST - ; DEST IS CLEARED TO START - ; USES PUSH TO DO THE COPY - N I - K @BDEST - F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST - . N J,ATMP - . S ATMP=$$ARRAY(@BLIST@(I)) - . I $G(DEBUG) W "ATMP=",ATMP,! - . I $G(DEBUG) W @BLIST@(I),! - . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; - . . ; FOR EACH LINE IN THIS INSTR - . . I $G(DEBUG) W "BDEST= ",BDEST,! - . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! - . . D PUSH(BDEST,@ATMP@(J)) - Q - ; -QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST - ; - I $G(DEBUG) W "QUEUEING ",BLST,! - D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) - Q - ; -CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME - ; KILLS CPDEST FIRST - N CPINSTR - I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! - I @CPSRC@(0)<1 D ; BAD LENGTH - . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! - . Q - ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT - D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY - D BUILD("CPINSTR",CPDEST) - Q - ; -QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST - ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD - ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT - ; USED TO INSERT CHILDREN NODES - I @QOXML@(0)<1 D ; MALFORMED XML - . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! - . Q - I $G(DEBUG) W "DOING QOPEN",! - N S1,E1,QOT,QOTMP - S S1=1 ; OPEN FROM THE BEGINNING OF THE XML - I $D(QOXPATH) D ; XPATH PROVIDED - . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX - . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 - I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT - . S E1=@QOXML@(0)-1 - D QUEUE(QOBLIST,QOXML,S1,E1) - ; S QOTMP=QOXML_"^"_S1_"^"_E1 - ; D PUSH(QOBLIST,QOTMP) - Q - ; -QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN - ; ADDS THE LIST LINE OF QCXML TO QCBLIST - ; USED TO FINISH INSERTING CHILDERN NODES - ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END - ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO - I @QCXML@(0)<1 D ; MALFORMED XML - . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! - I $G(DEBUG) W "GOING TO CLOSE",! - N S1,E1,QCT,QCTMP - S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML - I $D(QCXPATH) D ; XPATH PROVIDED - . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX - . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML - I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT - . S S1=@QCXML@(0) - D QUEUE(QCBLIST,QCXML,S1,E1) - ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) - Q - ; -INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE - ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS - ; OMITTED, INSERTION WILL BE AT THE ROOT - ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW - ; XML AT THE END OF THE XPATH POINT - ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE - N INSBLD,INSTMP - I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! - I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! - I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY - . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT - I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY - . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH - . I $D(INSXPATH) D ; XPATH PROVIDED - . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE - . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") - . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT - . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH - . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML - . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML - . I $D(INSXPATH) D ; XPATH PROVIDED - . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH - . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT - . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH - . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST - . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE - Q - ; -INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW - ; INTO INNXML AT THE INNXPATH XPATH POINT - ; - N INNBLD,UXPATH - N INNTBUF - S INNTBUF=$NA(^TMP($J,"INNTBUF")) - I '$D(INNXPATH) D ; XPATH NOT PASSED - . S UXPATH="//" ; USE ROOT XPATH - I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED - I '$D(@INNXML@(0)) D ; INNXML IS EMPTY - . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER - . D BUILD("INNBLD",INNXML) - I @INNXML@(0)>0 D ; NOT EMPTY - . D QOPEN("INNBLD",INNXML,UXPATH) ; - . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML - . D QCLOSE("INNBLD",INNXML,UXPATH) - . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER - . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST - Q - ; -INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST - ; BUT XDEST AN XNEW ARE PASSED BY NAME - N XBLD,XTMP - D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT - D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST - D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION - D BUILD("XBLD","XTMP") ; BUILD THE RESULT - D CP("XTMP",XDEST) ; COPY TO THE DESTINATION - I $G(DEBUG) D PARY("XDEST") - Q - ; -REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT - ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE - ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE - ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") - N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP - S OLD=$NA(^TMP($J,"REPLACE_OLD")) - D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD - S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS - S XFIRST=$P(XNODE,"^",1) - S XLAST=$P(XNODE,"^",2) - I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG - . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE - . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST - I RENEW'="" D ; NEW XML IS NOT NULL - . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE - . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW - . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST - I $G(DEBUG) W "REPLACE PREBUILD",! - I $G(DEBUG) D PARY("REBLD") - D BUILD("REBLD","RTMP") - K @REXML ; KILL WHAT WAS THERE - D CP("RTMP",REXML) ; COPY IN THE RESULT - Q - ; -DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT - ; REXML IS PASSED BY NAME XPATH IS A VALUE - N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP - S OLD=$NA(^TMP($J,"REPLACE_OLD")) - D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD - S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS - S XFIRST=$P(XNODE,"^",1) - S XLAST=$P(XNODE,"^",2) - D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE - D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST - I $G(DEBUG) D PARY("REBLD") - D BUILD("REBLD","RTMP") - K @REXML ; KILL WHAT WAS THERE - D CP("RTMP",REXML) ; COPY IN THE RESULT - Q - ; -MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY - ; W "Reporting on the missing",! - ; W OARY - I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q - N I - S @OARY@(0)=0 ; INITIALIZED MISSING COUNT - F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY - . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE - . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY - . . Q - Q - ; -MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY - ; AND PUT THE RESULTS IN OXML - N XCNT - I '$D(DEBUG) S DEBUG=0 - I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q - I '$D(@IXML@(0)) D ; INITIALIZE COUNT - . S XCNT=$O(@IXML@(""),-1) - E S XCNT=@IXML@(0) ;COUNT - I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q - N I,J,TNAM,TVAL,TSTR - S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT - F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY - . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT - . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? - . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS - . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS - . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! - . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME - . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED - . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? - . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD - . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE - . . . . E D DOFLD ; PROCESS A FIELD - . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE - . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER - . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES - . . I DEBUG W TSTR - I DEBUG W "MAPPED",! - Q - ; -DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE - ; - Q - ; -TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS - ; THEXML IS PASSED BY NAME - N I,J,TMPXML,DEL,FOUND,INTXT - S FOUND=0 - S INTXT=0 - I $G(DEBUG) W "DELETING EMPTY ELEMENTS",! - F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY - . S J=@THEXML@(I) - . I J["" D - . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM - . . I $G(DEBUG) W "IN HTML SECTION",! - . N JM,JP,JPX ; JMINUS AND JPLUS - . S JM=@THEXML@(I-1) ; LINE BEFORE - . I JM["" S INTXT=0 ; LEFT HTML SECTION,START TRIM - . S JP=@THEXML@(I+1) ; LINE AFTER - . I INTXT=0 D ; IF NOT IN AN HTML SECTION - . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH - . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES - . . . I $G(DEBUG) W I,J,JP,! - . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED - . . . S DEL(I)="" ; SET LINE TO DELETE - . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE - . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE - . . . I $G(DEBUG) W I,J,! - . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED - . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED - . . . I JM=JPX D ; - . . . . I $G(DEBUG) W I,JM_J_JPX,! - . . . . S DEL(I-1)="" - . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL - ; . I J'["><" D PUSH("TMPXML",J) - I FOUND D ; NEED TO DELETE THINGS - . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES - . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED - . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY - . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY - Q FOUND - ; -UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML - ; XSEC IS A SECTION PASSED BY NAME - N XBLD,XTMP - D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML - D BUILD("XBLD","XTMP") ; BUILD THE RESULT - D CP("XTMP",XSEC) ; REPLACE PASSED XML - Q - ; -PARY(GLO,ZN) ;PRINT AN ARRAY - ; IF ZN=-1 NO LINE NUMBERS - N I - F I=1:1:@GLO@(0) D ; - . I $G(ZN)=-1 W @GLO@(I),! - . E W I_" "_@GLO@(I),! - Q - ; -H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY - ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE - I '$D(IPRE) S IPRE="" - N H2I S H2I="" - ; W $O(@IHASH@(H2I)),! - F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH - . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES - . . ;W H2I_"^"_@IHASH@(H2I),! - . . N IH,IHI - . . S IH=$NA(@IHASH@(H2I)) ; - . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR - . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE - . . S IHI="" ; INDEX INTO "M" MULTIPLES - . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE - . . . ; W @IH@(IHI) - . . . S IH3=$NA(@IH2@(IHI)) - . . . ; W "HEY",IH3,! - . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS - . . ; W IH,! - . . ; W "C0CZZ",! - . . ; W $NA(@IHASH@(H2I)),! - . . Q ; - . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I)) - . ; W @IARYRTN@(0),! - Q - ; -XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES - ; DEFINED IN INPUT XML XVIXML BY @@VAR@@ - ; XVRTN AND XVIXML ARE PASSED BY NAME - ; - N XVI,XVTMP,XVT - F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML - . S XVT=@XVIXML@(XVI) - . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI - D H2ARY(XVRTN,"XVTMP") - Q - ; -DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE - ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE - ; - N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED - I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE - . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP - . S DXUSE="DTMP" ; DXUSE IS NAME - E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE - . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP - . S DXUSE="DTMP" ; DXUSE IS NAME - E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE - N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE - D XVARS("DVARS",DXUSE) ; PULL OUT VARS - D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM - Q - ; -TEST ; Run all the test cases - D TESTALL^C0CUNIT("C0CXPAT0") - Q - ; -ZTEST(WHICH) ; RUN ONE SET OF TESTS - N ZTMP - S DEBUG=1 - D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") - D ZTEST^C0CUNIT(.ZTMP,WHICH) - Q - ; -TLIST ; LIST THE TESTS - N ZTMP - D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") - D TLIST^C0CUNIT(.ZTMP) - Q - ; +C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 4 + ;Copyright 2008-2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + W "This is an XML XPATH utility library",! + W ! + Q + ; +OUTPUT(OUTARY,OUTNAME,OUTDIR) ; WRITE AN ARRAY TO A FILE + ; + N Y + S Y=$$GTF^%ZISH(OUTARY,$QL(OUTARY),OUTDIR,OUTNAME) + I Y Q 1_U_"WROTE FILE: "_OUTNAME_" TO "_OUTDIR + I 'Y Q 0_U_"ERROR WRITING FILE"_OUTNAME_" TO "_OUTDIR + Q + ; +PUSH(STK,VAL) ; pushs VAL onto STK and updates STK(0) + ; VAL IS A STRING AND STK IS PASSED BY NAME + ; + I '$D(@STK@(0)) S @STK@(0)=0 ; IF THE ARRAY IS EMPTY, INITIALIZE + S @STK@(0)=@STK@(0)+1 ; INCREMENT ARRAY DEPTH + S @STK@(@STK@(0))=VAL ; PUT VAL A THE END OF THE ARRAY + Q + ; +POP(STK,VAL) ; POPS THE LAST VALUE OFF THE STK AND RETURNS IT IN VAL + ; VAL AND STK ARE PASSED BY REFERENCE + ; + I @STK@(0)<1 D ; IF ARRAY IS EMPTY + . S VAL="" + . S @STK@(0)=0 + I @STK@(0)>0 D ; + . S VAL=@STK@(@STK@(0)) + . K @STK@(@STK@(0)) + . S @STK@(0)=@STK@(0)-1 ; NEW DEPTH OF THE ARRAY + Q + ; +PUSHA(ADEST,ASRC) ; PUSH ASRC ONTO ADEST, BOTH PASSED BY NAME + ; + N ZGI + F ZGI=1:1:@ASRC@(0) D ; FOR ALL OF THE SOURCE ARRAY + . D PUSH(ADEST,@ASRC@(ZGI)) ; PUSH ONE ELEMENT + Q + ; +MKMDX(STK,RTN,INREDUX) ; MAKES A MUMPS INDEX FROM THE ARRAY STK + ; RTN IS SET TO //FIRST/SECOND/THIRD FOR THREE ARRAY ELEMENTS + ; REDUX IS A STRING TO REMOVE FROM THE RESULT + S RTN="" + N I + ; W "STK= ",STK,! + I @STK@(0)>0 D ; IF THE ARRAY IS NOT EMPTY + . S RTN="//"_@STK@(1) ; FIRST ELEMENT NEEDS NO SEMICOLON + . I @STK@(0)>1 D ; SUBSEQUENT ELEMENTS NEED A SEMICOLON + . . F I=2:1:@STK@(0) S RTN=RTN_"/"_@STK@(I) + I $G(INREDUX)'="" S RTN=$P(RTN,INREDUX,1)_$P(RTN,INREDUX,2) + Q + ; +XNAME(ISTR) ; FUNCTION TO EXTRACT A NAME FROM AN XML FRAG + ; AND WILL RETURN NAME + ; ISTR IS PASSED BY VALUE + N CUR,TMP + I ISTR?.E1"<".E D ; STRIP OFF LEFT BRACKET + . S TMP=$P(ISTR,"<",2) + I TMP?1"/".E D ; ALSO STRIP OFF SLASH IF PRESENT IE + . S TMP=$P(TMP,"/",2) + S CUR=$P(TMP,">",1) ; EXTRACT THE NAME + ; W "CUR= ",CUR,! + I CUR?.1"_"1.A1" ".E D ; CONTAINS A BLANK IE NAME ID=TEST> + . S CUR=$P(CUR," ",1) ; STRIP OUT BLANK AND AFTER + ; W "CUR2= ",CUR,! + Q CUR + ; +XVAL(ISTR) ; EXTRACTS THE VALUE FROM A FRAGMENT OF XML + ; VALUE WILL RETURN VALUE + N G + S G=$P(ISTR,">",2) ;STRIP OFF + Q $P(G,"<",1) ; STRIP OFF LEAVING VALUE + ; +VDX2VDV(OUTVDV,INVDX) ; CONVERT AN VDX ARRAY TO VDV + ; VDX: @INVDX@(XPATH)=VALUE + ; VDV: @OUTVDV@(X1X2X3X4)=VALUE + ; THE VDV DATANAMES MIGHT BE MORE CONVENIENT FOR USE IN CODE + ; AN INDEX IS PROVIDED TO GO BACK TO VDX FOR CONVERSIONS + ; @VDV@("XPATH",X1X2X3X4)="XPATH" + N ZA,ZI,ZW + S ZI="" + F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; + . S ZW=$TR(ZI,"/","") ; ELIMINATE ALL SLASHES - CAMEL CASE VARIABLE NAME + . W ZW,! + . S @OUTVDV@(ZW)=@INVDX@(ZI) + . S @OUTVDV@("XPATH",ZW)=ZI + Q + ; +VDX2XPG(OUTXPG,INVDX) ; CONVERT AN VDX ARRAY TO XPG + ; VDX: @VDX@(XPATH)=VALUE + ; XPG: @(VDX(X1,X2,X3,X4))@=VALUE + ; THIS IS A STEP TOWARD GENERATING XML FROM A VDX + N ZA,ZI,ZW + S ZI="" + F S ZI=$O(@INVDX@(ZI)) Q:ZI="" D ; + . S ZW=$E(ZI,3,$L(ZI)) ; STRIP OFF INITIAL // + . S ZW2=$P(ZW,"/",1) + . F ZK=1:1:$L(ZW,"/") D PUSH("ZA",$P(ZW,"/",ZK)) + . ;ZWR ZA + . S ZW2=ZA(1) + . F ZK=2:1:ZA(0) D ; + . . S ZW2=ZW2_""","""_ZA(ZK) + . K ZA + . S ZW2=""""_ZW2_"""" + . W ZW2,! + . S ZN=OUTXPG_"("_ZW2_")" + . S @ZN=@INVDX@(ZI) + Q + ; +XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY + ; XPG MEANS XPATH GLOBAL AND HAS THE FORM @OUTXPG@("X1","X2","X3")=VALUE + ; + ;N G1 + D INDEX(INXML,"G1",1) ; PRODUCES A VDX ARRAY IN G1, NO INDEX IS PRODUCED + D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM + Q + ; +DO + D XPG2XML("^GPL2B","^GPL2A") + Q + ; +T1 ; TEST OUT THESE ROUTINES + D XML2XPG("G2","^GPL") + D XPG2XML("G3","G2") + K ^GPLOUT + M ^GPLOUT=G3 + W $$OUTPUT^C0CXPATH("^GPLOUT(1)","GPLTEST.xml","/home/vademo2/EHR/p") + Q + ; +XPG2XML(OUTXML,INXPG) ; + N C0CN,FWD,ZA,G,GA,ZQ + S ZQ=0 ; QUIT FLAG + F Q:ZQ=1 D ; LOOP THROUGH EVERYTHING + . I '$D(C0CN) D ; FIRST TIME THROUGH + . . K @OUTXML ; MAKE SURE OUTPUT ARRAY IS CLEAR + . . S FWD=1 ; START OUT GOING FORWARD THROUGH SUBSCRIPTS + . . S G=$Q(@INXPG) ; THIS ONE + . . S GN=$Q(@G) ; NEXT ONE + . . S C0CN=1 ; SUBSCRIPT COUNT + . . S ZQ=0 ; QUIT FLAG + . . D ZXO("?xml version=""1.0"" encoding=""UTF-8""?") ;MAKE IT REAL XML + . . I $QS(G,1)="ContinuityOfCareRecord" D ; + . . . D ZXO("?xml-stylesheet type=""text/xsl"" href=""ccr.xsl""?") ; HACK TO MAKE THE CCR STYLESHEET WORK + . I FWD D ; GOING FORWARDS + . . I C0CN<$QL(G) D ; NOT A DATA NODE + . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT + . . . D ZXO(ZA) ; AND OPEN AN XML ELEMENT + . . . I @OUTXML@(@OUTXML@(0))="" D ; + . . . . S @OUTXML@(@OUTXML@(0))="" + . . . S C0CN=C0CN+1 ; MOVE TO THE NEXT ONE + . . E D ; AT THE DATA NODE + . . . S ZA=$QS(G,C0CN) ; PULL OUT THE SUBSCRIPT + . . . D ZXVAL(ZA,@G) ; OUTPUT VAL FOR DATA NODE + . . . S FWD=0 ; GO BACKWARDS + . I 'FWD D ;GOING BACKWARDS + . . S GN=$Q(@G) ;NEXT XPATH + . . ;W "NEXT!",GN,! + . . S C0CN=C0CN-1 ; PREVIOUS SUBSCRIPT + . . I GN'="" D ; + . . . I $QS(G,C0CN)'=$QS(GN,C0CN) D ; NEED TO CLOSE OFF ELEMENT + . . . . D ZXC($QS(G,C0CN)) ; + . . . E I GN'="" D ; MORE ELEMENTS AT THIS LEVEL + . . . . S G=$Q(@G) ; ADVANCE TO NEW XPATH + . . . . S C0CN=C0CN+1 ; GET READY TO PROCESS NEXT SUBSCRIPT + . . . . S FWD=1 ; GOING FORWARD NOW + . I (GN="")&(C0CN=1) D Q ; WHEN WE ARE ALL DONE + . . D ZXC($QS(G,C0CN)) ; LAST ONE + . . S ZQ=1 ; QUIT NOW + Q + ; +ZXO(WHAT) + D PUSH("GA",WHAT) + D PUSH(OUTXML,"<"_WHAT_">") + Q + ; +ZXC(WHAT) + D POP("GA",.TMP) + D PUSH(OUTXML,"") + Q + ; +ZXVAL(WHAT,VAL) + D PUSH(OUTXML,"<"_WHAT_">"_VAL_"") + Q + ; +INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce + ; an XPATH index; REDUX is a string to be removed from each xpath + ; GPL 7/14/09 OPTIONALLY GENERATE AN XML TEMPLATE IF PASSED BY NAME + ; TEMPLATE IS IDENTICAL TO THE PARSED XML LINE BY LINE + ; EXCEPT THAT DATA VALUES ARE REPLACED WITH @@XPATH@@ FOR THE XPATH OF THE TAG + ; GPL 5/24/09 AND OPTIONALLY PRODUCE THE VDX ARRAY PASSED BY NAME + ; @VDX@("XPATH")=VALUE + ; ex. @IZXML@("XPATH")=FIRSTLINE^LASTLINE + ; WHERE FIRSTLINE AND LASTLINE ARE THE BEGINNING AND ENDING OF THE + ; XML SECTION + ; IZXML IS PASSED BY NAME + ; IF NOINX IS SET TO 1, NO INDEX WILL BE GENERATED, BUT THE VDX WILL BE + N I,LINE,FIRST,LAST,CUR,TMP,MDX,FOUND,CURVAL,DVDX,LCNT + N C0CSTK ; LEAVE OUT FOR DEBUGGING + I '$D(REDUX) S REDUX="" + I '$D(NOINX) S NOINX=0 ; IF NOT PASSED, GENERATE AN INDEX + N ZXML + I NOINX S ZXML=$NA(^TMP("C0CINDEX",$J)) ; TEMP PLACE FOR INDEX TO DISCARD + E S ZXML=IZXML ; PLACE FOR INDEX TO KEEP + I '$D(@IZXML@(0)) D ; IF COUNT NOT IN NODE 0 COUNT THEM + . S I="",LCNT=0 + . F S I=$O(@IZXML@(I)) Q:I="" S LCNT=LCNT+1 + E S LCNT=@IZXML@(0) ; LINE COUNT PASSED IN ARRAY + I LCNT=0 D Q ; NO XML PASSED + . W "ERROR IN XML FILE",! + S DVDX=0 ; DEFAULT DO NOT PRODUCE VDX INDEX + I $D(VDX) S DVDX=1 ; IF NAME PASSED, DO VDX + S C0CSTK(0)=0 ; INITIALIZE STACK + K LKASD ; KILL LOOKASIDE ARRAY + D MKLASD(.LKASD,IZXML) ;MAKE LOOK ASIDE BUFFER FOR MULTIPLES + F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY + . S LINE=@IZXML@(I) + . I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED + . . S @TEMPLATE@(I)=$$CLEAN(LINE) + . ;W LINE,! + . S FOUND=0 ; INTIALIZED FOUND FLAG + . I LINE?.E1"".E) D + . . . ; THIS IS THE CASE THERE SECTION BEGINS AND ENDS + . . . ; ON THE SAME LINE + . . . ; W "FOUND ",LINE,! + . . . S FOUND=1 ; SET FOUND FLAG + . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME + . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES + . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK + . . . D MKMDX("C0CSTK",.MDX,REDUX) ; GENERATE THE M INDEX + . . . ; W "MDX=",MDX,! + . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE + . . . . ;I '$D(ZDUP(MDX)) S ZDUP(MDX)=2 + . . . . ;E S ZDUP(MDX)=ZDUP(MDX)+1 + . . . . ;W "DUP:",MDX,! + . . . . ;I '$D(CURVAL) S CURVAL="" + . . . . ;I DVDX S @VDX@(MDX_"["_ZDUP(MDX)_"]")=CURVAL + . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER + . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE + . . . . S @ZXML@(MDX)=I_"^"_I ; ADD INDEX ENTRY-FIRST AND LAST + . . . . S CURVAL=$$XVAL(LINE) ; VALUE + . . . . S $P(@ZXML@(MDX),"^",3)=CURVAL ; THIRD PIECE + . . . . I DVDX S @VDX@(MDX)=CURVAL ; FILL IN VDX ARRAY IF REQUESTED + . . . . I $D(TEMPLATE) D ; IF TEMPLATE IS REQUESTED + . . . . . S LINE=$$CLEAN(LINE) ; CLEAN OUT CONTROL CHARACTERS + . . . . . S @TEMPLATE@(I)=$P(LINE,">",1)_">@@"_MDX_"@@") D ; BEGINNING OF A SECTION + . . . ; W "FOUND ",LINE,! + . . . S FOUND=1 ; SET FOUND FLAG + . . . S CUR=$$XNAME(LINE) ; EXTRACT THE NAME + . . . S CUR=CUR_$G(LKASD(CUR,I)) ; HANDLE MULTIPLES + . . . D PUSH("C0CSTK",CUR) ; ADD TO THE STACK + . . . D MKMDX("C0CSTK",.MDX) ; GENERATE THE M INDEX + . . . ; W "MDX=",MDX,! + . . . I $D(@ZXML@(MDX)) D ; IN THE INDEX, IS A MULTIPLE + . . . . S $P(@ZXML@(MDX),"^",2)=I ; UPDATE LAST LINE NUMBER + . . . . ;B + . . . I '$D(@ZXML@(MDX)) D ; NOT IN THE INDEX, NOT A MULTIPLE + . . . . S @ZXML@(MDX)=I_"^" ; INSERT INTO THE INDEX + S @ZXML@("INDEXED")="" + S @ZXML@("//")="1^"_LCNT ; ROOT XPATH + I NOINX K @ZXML ; DELETE UNWANTED INDEX + Q + ; +MKLASD(OUTBUF,INARY) ; CREATE A LOOKASIDE BUFFER FOR MULTILPLES + ; + N ZI,ZN,ZA,ZLINE,ZLINE2,CUR,CUR2 + F ZI=1:1:LCNT-1 D ; PROCESS THE ENTIRE ARRAY + . S ZLINE=@IZXML@(ZI) + . I ZI") D ; BEGINNING OF A SECTION + . . . S CUR2=$$XNAME(ZLINE2) ; EXTRACT THE NAME + . . . I CUR=CUR2 D ; IF THIS IS A MULTIPLE + . . . . S OUTBUF(CUR,ZI+1)="" + ;ZWR OUTBUF + S ZI="" + F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; FOR EACH KIND OF MULTIPLE + . S ZN=$O(OUTBUF(ZI,"")) ; LINE NUMBER OF SECOND MULTIPLE + . F S ZN=$O(@IZXML@(ZN),-1) Q:ZN="" I $E($P(@IZXML@(ZN),"<"_ZI,2),1,1)=">" Q ; + . S OUTBUF(ZI,ZN)="" + S ZA=1,ZI="",ZN="" + F S ZI=$O(OUTBUF(ZI)) Q:ZI="" D ; ADDING THE COUNT FOR THE MULIPLES [x] + . S ZN="",ZA=1 + . F S ZN=$O(OUTBUF(ZI,ZN)) Q:ZN="" D ; + . . S OUTBUF(ZI,ZN)="["_ZA_"]" + . . S ZA=ZA+1 + Q + ; +CLEAN(STR,TR) ; extrinsic function; returns string + ;; Removes all non printable characters from a string. + ;; STR by Value + ;; TR IS OPTIONAL TO IMPROVE PERFORMANCE + N TR,I + I '$D(TR) D ; + . F I=0:1:31 S TR=$G(TR)_$C(I) + . S TR=TR_$C(127) + QUIT $TR(STR,TR) + ; +QUERY(IARY,XPATH,OARY) ; RETURNS THE XML ARRAY MATCHING THE XPATH EXPRESSION + ; XPATH IS OF THE FORM "//FIRST/SECOND/THIRD" + ; IARY AND OARY ARE PASSED BY NAME + I '$D(@IARY@("INDEXED")) D ; INDEX IS NOT PRESENT IN IARY + . D INDEX(IARY) ; GENERATE AN INDEX FOR THE XML + N FIRST,LAST ; FIRST AND LAST LINES OF ARRAY TO RETURN + N TMP,I,J,QXPATH + S FIRST=1 + I '$D(@IARY@(0)) D ; LINE COUNT NOT IN ZERO NODE + . S @IARY@(0)=$O(@IARY@("//"),-1) ; THIS SHOULD USUALLY WORK + S LAST=@IARY@(0) ; FIRST AND LAST DEFAULT TO ROOT + I XPATH'="//" D ; NOT A ROOT QUERY + . S TMP=@IARY@(XPATH) ; LOOK UP LINE VALUES + . S FIRST=$P(TMP,"^",1) + . S LAST=$P(TMP,"^",2) + K @OARY + S @OARY@(0)=+LAST-FIRST+1 + S J=1 + FOR I=FIRST:1:LAST D + . S @OARY@(J)=@IARY@(I) ; COPY THE LINE TO OARY + . S J=J+1 + ; ZWR OARY + Q + ; +XF(IDX,XPATH) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN XPATH + ; INDEX WITH TWO PIECES START^FINISH + ; IDX IS PASSED BY NAME + Q $P(@IDX@(XPATH),"^",1) + ; +XL(IDX,XPATH) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN XPATH + ; INDEX WITH TWO PIECES START^FINISH + ; IDX IS PASSED BY NAME + Q $P(@IDX@(XPATH),"^",2) + ; +START(ISTR) ; EXTRINSIC TO RETURN THE STARTING LINE FROM AN INDEX + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH + ; COMPANION TO FINISH ; IDX IS PASSED BY NAME + Q $P(ISTR,";",2) + ; +FINISH(ISTR) ; EXTRINSIC TO RETURN THE LAST LINE FROM AN INDEX + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH + Q $P(ISTR,";",3) + ; +ARRAY(ISTR) ; EXTRINSIC TO RETURN THE ARRAY REFERENCE FROM AN INDEX + ; TYPE STRING WITH THREE PIECES ARRAY;START;FINISH + Q $P(ISTR,";",1) + ; +BUILD(BLIST,BDEST) ; A COPY MACHINE THAT TAKE INSTRUCTIONS IN ARRAY BLIST + ; WHICH HAVE ARRAY;START;FINISH AND COPIES THEM TO DEST + ; DEST IS CLEARED TO START + ; USES PUSH TO DO THE COPY + N I + K @BDEST + F I=1:1:@BLIST@(0) D ; FOR EACH INSTRUCTION IN BLIST + . N J,ATMP + . S ATMP=$$ARRAY(@BLIST@(I)) + . I $G(DEBUG) W "ATMP=",ATMP,! + . I $G(DEBUG) W @BLIST@(I),! + . F J=$$START(@BLIST@(I)):1:$$FINISH(@BLIST@(I)) D ; + . . ; FOR EACH LINE IN THIS INSTR + . . I $G(DEBUG) W "BDEST= ",BDEST,! + . . I $G(DEBUG) W "ATMP= ",@ATMP@(J),! + . . D PUSH(BDEST,@ATMP@(J)) + Q + ; +QUEUE(BLST,ARRAY,FIRST,LAST) ; ADD AN ENTRY TO A BLIST + ; + I $G(DEBUG) W "QUEUEING ",BLST,! + D PUSH(BLST,ARRAY_";"_FIRST_";"_LAST) + Q + ; +CP(CPSRC,CPDEST) ; COPIES CPSRC TO CPDEST BOTH PASSED BY NAME + ; KILLS CPDEST FIRST + N CPINSTR + I $G(DEBUG) W "MADE IT TO COPY",CPSRC,CPDEST,! + I @CPSRC@(0)<1 D ; BAD LENGTH + . W "ERROR IN COPY BAD SOURCE LENGTH: ",CPSRC,! + . Q + ; I '$D(@CPDEST@(0)) S @CPDEST@(0)=0 ; IF THE DEST IS EMPTY, INIT + D QUEUE("CPINSTR",CPSRC,1,@CPSRC@(0)) ; BLIST FOR ENTIRE ARRAY + D BUILD("CPINSTR",CPDEST) + Q + ; +QOPEN(QOBLIST,QOXML,QOXPATH) ; ADD ALL BUT THE LAST LINE OF QOXML TO QOBLIST + ; WARNING NEED TO DO QCLOSE FOR SAME XML BEFORE CALLING BUILD + ; QOXPATH IS OPTIONAL - WILL OPEN INSIDE THE XPATH POINT + ; USED TO INSERT CHILDREN NODES + I @QOXML@(0)<1 D ; MALFORMED XML + . W "MALFORMED XML PASSED TO QOPEN: ",QOXML,! + . Q + I $G(DEBUG) W "DOING QOPEN",! + N S1,E1,QOT,QOTMP + S S1=1 ; OPEN FROM THE BEGINNING OF THE XML + I $D(QOXPATH) D ; XPATH PROVIDED + . D QUERY(QOXML,QOXPATH,"QOT") ; INSURE INDEX + . S E1=$P(@QOXML@(QOXPATH),"^",2)-1 + I '$D(QOXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT + . S E1=@QOXML@(0)-1 + D QUEUE(QOBLIST,QOXML,S1,E1) + ; S QOTMP=QOXML_"^"_S1_"^"_E1 + ; D PUSH(QOBLIST,QOTMP) + Q + ; +QCLOSE(QCBLIST,QCXML,QCXPATH) ; CLOSE XML AFTER A QOPEN + ; ADDS THE LIST LINE OF QCXML TO QCBLIST + ; USED TO FINISH INSERTING CHILDERN NODES + ; QCXPATH IS OPTIONAL - IF PROVIDED, WILL CLOSE UNTIL THE END + ; IF QOPEN WAS CALLED WITH XPATH, QCLOSE SHOULD BE TOO + I @QCXML@(0)<1 D ; MALFORMED XML + . W "MALFORMED XML PASSED TO QCLOSE: ",QCXML,! + I $G(DEBUG) W "GOING TO CLOSE",! + N S1,E1,QCT,QCTMP + S E1=@QCXML@(0) ; CLOSE UNTIL THE END OF THE XML + I $D(QCXPATH) D ; XPATH PROVIDED + . D QUERY(QCXML,QCXPATH,"QCT") ; INSURE INDEX + . S S1=$P(@QCXML@(QCXPATH),"^",2) ; REMAINING XML + I '$D(QCXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT + . S S1=@QCXML@(0) + D QUEUE(QCBLIST,QCXML,S1,E1) + ; D PUSH(QCBLIST,QCXML_";"_S1_";"_E1) + Q + ; +INSERT(INSXML,INSNEW,INSXPATH) ; INSERT INSNEW INTO INSXML AT THE + ; INSXPATH XPATH POINT INSXPATH IS OPTIONAL - IF IT IS + ; OMITTED, INSERTION WILL BE AT THE ROOT + ; NOTE INSERT IS NON DESTRUCTIVE AND WILL ADD THE NEW + ; XML AT THE END OF THE XPATH POINT + ; INSXML AND INSNEW ARE PASSED BY NAME INSXPATH IS A VALUE + N INSBLD,INSTMP + I $G(DEBUG) W "DOING INSERT ",INSXML,INSNEW,INSXPATH,! + I $G(DEBUG) F G1=1:1:@INSXML@(0) W @INSXML@(G1),! + I '$D(@INSXML@(1)) D ; INSERT INTO AN EMPTY ARRAY + . D CP^C0CXPATH(INSNEW,INSXML) ; JUST COPY INTO THE OUTPUT + I $D(@INSXML@(1)) D ; IF ORIGINAL ARRAY IS NOT EMPTY + . I '$D(@INSXML@(0)) S @INSXML@(0)=$O(@INSXML@(""),-1) ;SET LENGTH + . I $D(INSXPATH) D ; XPATH PROVIDED + . . D QOPEN("INSBLD",INSXML,INSXPATH) ; COPY THE BEFORE + . . I $G(DEBUG) D PARY^C0CXPATH("INSBLD") + . I '$D(INSXPATH) D ; NO XPATH PROVIDED, OPEN AT ROOT + . . D QOPEN("INSBLD",INSXML,"//") ; OPEN WITH ROOT XPATH + . I '$D(@INSNEW@(0)) S @INSNEW@(0)=$O(@INSNEW@(""),-1) ;SIZE OF XML + . D QUEUE("INSBLD",INSNEW,1,@INSNEW@(0)) ; COPY IN NEW XML + . I $D(INSXPATH) D ; XPATH PROVIDED + . . D QCLOSE("INSBLD",INSXML,INSXPATH) ; CLOSE WITH XPATH + . I '$D(INSXPATH) D ; NO XPATH PROVIDED, CLOSE AT ROOT + . . D QCLOSE("INSBLD",INSXML,"//") ; CLOSE WITH ROOT XPATH + . D BUILD("INSBLD","INSTMP") ; PUT RESULTS IN INDEST + . D CP^C0CXPATH("INSTMP",INSXML) ; COPY BUFFER TO SOURCE + Q + ; +INSINNER(INNXML,INNNEW,INNXPATH) ; INSERT THE INNER XML OF INNNEW + ; INTO INNXML AT THE INNXPATH XPATH POINT + ; + N INNBLD,UXPATH + N INNTBUF + S INNTBUF=$NA(^TMP($J,"INNTBUF")) + I '$D(INNXPATH) D ; XPATH NOT PASSED + . S UXPATH="//" ; USE ROOT XPATH + I $D(INNXPATH) S UXPATH=INNXPATH ; USE THE XPATH THAT'S PASSED + I '$D(@INNXML@(0)) D ; INNXML IS EMPTY + . D QUEUE^C0CXPATH("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER + . D BUILD("INNBLD",INNXML) + I @INNXML@(0)>0 D ; NOT EMPTY + . D QOPEN("INNBLD",INNXML,UXPATH) ; + . D QUEUE("INNBLD",INNNEW,2,@INNNEW@(0)-1) ; JUST INNER XML + . D QCLOSE("INNBLD",INNXML,UXPATH) + . D BUILD("INNBLD",INNTBUF) ; BUILD TO BUFFER + . D CP(INNTBUF,INNXML) ; COPY BUFFER TO DEST + Q + ; +INSB4(XDEST,XNEW) ; INSERT XNEW AT THE BEGINNING OF XDEST + ; BUT XDEST AN XNEW ARE PASSED BY NAME + N XBLD,XTMP + D QUEUE("XBLD",XDEST,1,1) ; NEED TO PRESERVE SECTION ROOT + D QUEUE("XBLD",XNEW,1,@XNEW@(0)) ; ALL OF NEW XML FIRST + D QUEUE("XBLD",XDEST,2,@XDEST@(0)) ; FOLLOWED BY THE REST OF SECTION + D BUILD("XBLD","XTMP") ; BUILD THE RESULT + D CP("XTMP",XDEST) ; COPY TO THE DESTINATION + I $G(DEBUG) D PARY("XDEST") + Q + ; +REPLACE(REXML,RENEW,REXPATH) ; REPLACE THE XML AT THE XPATH POINT + ; WITH RENEW - NOTE THIS WILL DELETE WHAT WAS THERE BEFORE + ; REXML AND RENEW ARE PASSED BY NAME XPATH IS A VALUE + ; THE DELETED XML IS PUT IN ^TMP($J,"REPLACE_OLD") + N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP + S OLD=$NA(^TMP($J,"REPLACE_OLD")) + D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD + S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS + S XFIRST=$P(XNODE,"^",1) + S XLAST=$P(XNODE,"^",2) + I RENEW="" D ; WE ARE DELETING A SECTION, MUST SAVE THE TAG + . D QUEUE("REBLD",REXML,1,XFIRST) ; THE BEFORE + . D QUEUE("REBLD",REXML,XLAST,@REXML@(0)) ; THE REST + I RENEW'="" D ; NEW XML IS NOT NULL + . D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE + . D QUEUE("REBLD",RENEW,1,@RENEW@(0)) ; THE NEW + . D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST + I $G(DEBUG) W "REPLACE PREBUILD",! + I $G(DEBUG) D PARY("REBLD") + D BUILD("REBLD","RTMP") + K @REXML ; KILL WHAT WAS THERE + D CP("RTMP",REXML) ; COPY IN THE RESULT + Q + ; +DELETE(REXML,REXPATH) ; DELETE THE XML AT THE XPATH POINT + ; REXML IS PASSED BY NAME XPATH IS A VALUE + N REBLD,XFIRST,XLAST,OLD,XNODE,RETMP + S OLD=$NA(^TMP($J,"REPLACE_OLD")) + D QUERY(REXML,REXPATH,OLD) ; CREATE INDEX, TEST XPATH, MAKE OLD + S XNODE=@REXML@(REXPATH) ; PULL OUT FIRST AND LAST LINE PTRS + S XFIRST=$P(XNODE,"^",1) + S XLAST=$P(XNODE,"^",2) + D QUEUE("REBLD",REXML,1,XFIRST-1) ; THE BEFORE + D QUEUE("REBLD",REXML,XLAST+1,@REXML@(0)) ; THE REST + I $G(DEBUG) D PARY("REBLD") + D BUILD("REBLD","RTMP") + K @REXML ; KILL WHAT WAS THERE + D CP("RTMP",REXML) ; COPY IN THE RESULT + Q + ; +MISSING(IXML,OARY) ; SEARTH THROUGH INXLM AND PUT ANY @@X@@ VARS IN OARY + ; W "Reporting on the missing",! + ; W OARY + I '$D(@IXML@(0)) W "MALFORMED XML PASSED TO MISSING",! Q + N I + S @OARY@(0)=0 ; INITIALIZED MISSING COUNT + F I=1:1:@IXML@(0) D ; LOOP THROUGH WHOLE ARRAY + . I @IXML@(I)?.E1"@@".E D ; MISSING VARIABLE HERE + . . D PUSH^C0CXPATH(OARY,$P(@IXML@(I),"@@",2)) ; ADD TO OUTARY + . . Q + Q + ; +MAP(IXML,INARY,OXML) ; SUBSTITUTE MULTIPLE @@X@@ VARS WITH VALUES IN INARY + ; AND PUT THE RESULTS IN OXML + N XCNT + I '$D(DEBUG) S DEBUG=0 + I '$D(IXML) W "MALFORMED XML PASSED TO MAP",! Q + I '$D(@IXML@(0)) D ; INITIALIZE COUNT + . S XCNT=$O(@IXML@(""),-1) + E S XCNT=@IXML@(0) ;COUNT + I $O(@INARY@(""))="" W "EMPTY ARRAY PASSED TO MAP",! Q + N I,J,TNAM,TVAL,TSTR + S @OXML@(0)=XCNT ; TOTAL LINES IN OUTPUT + F I=1:1:XCNT D ; LOOP THROUGH WHOLE ARRAY + . S @OXML@(I)=@IXML@(I) ; COPY THE LINE TO OUTPUT + . I @OXML@(I)?.E1"@@".E D ; IS THERE A VARIABLE HERE? + . . S TSTR=$P(@IXML@(I),"@@",1) ; INIT TO PART BEFORE VARS + . . F J=2:2:10 D Q:$P(@IXML@(I),"@@",J+2)="" ; QUIT IF NO MORE VARS + . . . I DEBUG W "IN MAPPING LOOP: ",TSTR,! + . . . S TNAM=$P(@OXML@(I),"@@",J) ; EXTRACT THE VARIABLE NAME + . . . S TVAL="@@"_$P(@IXML@(I),"@@",J)_"@@" ; DEFAULT UNCHANGED + . . . I $D(@INARY@(TNAM)) D ; IS THE VARIABLE IN THE MAP? + . . . . I '$D(@INARY@(TNAM,"F")) D ; NOT A SPECIAL FIELD + . . . . . S TVAL=@INARY@(TNAM) ; PULL OUT MAPPED VALUE + . . . . E D DOFLD ; PROCESS A FIELD + . . . S TVAL=$$SYMENC^MXMLUTL(TVAL) ;MAKE SURE THE VALUE IS XML SAFE + . . . S TSTR=TSTR_TVAL_$P(@IXML@(I),"@@",J+1) ; ADD VAR AND PART AFTER + . . S @OXML@(I)=TSTR ; COPY LINE WITH MAPPED VALUES + . . I DEBUG W TSTR + I DEBUG W "MAPPED",! + Q + ; +DOFLD ; PROCESS A FILEMAN FIELD REFERENCED BY A VARIABLE + ; + Q + ; +TRIM(THEXML) ; TAKES OUT ALL NULL ELEMENTS + ; THEXML IS PASSED BY NAME + N I,J,TMPXML,DEL,FOUND,INTXT + S FOUND=0 + S INTXT=0 + I $G(DEBUG) W "DELETING EMPTY ELEMENTS",! + F I=1:1:(@THEXML@(0)-1) D ; LOOP THROUGH ENTIRE ARRAY + . S J=@THEXML@(I) + . I J["" D + . . S INTXT=1 ; IN HTML SECTION, DON'T TRIM + . . I $G(DEBUG) W "IN HTML SECTION",! + . N JM,JP,JPX ; JMINUS AND JPLUS + . S JM=@THEXML@(I-1) ; LINE BEFORE + . I JM["" S INTXT=0 ; LEFT HTML SECTION,START TRIM + . S JP=@THEXML@(I+1) ; LINE AFTER + . I INTXT=0 D ; IF NOT IN AN HTML SECTION + . . S JPX=$TR(JP,"/","") ; REMOVE THE SLASH + . . I J=JPX D ; AN EMPTY ELEMENT ON TWO LINES + . . . I $G(DEBUG) W I,J,JP,! + . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED + . . . S DEL(I)="" ; SET LINE TO DELETE + . . . S DEL(I+1)="" ; SET NEXT LINE TO DELETE + . . I J["><" D ; AN EMPTY ELEMENT ON ONE LINE + . . . I $G(DEBUG) W I,J,! + . . . S FOUND=1 ; FOUND SOMETHING TO BE DELETED + . . . S DEL(I)="" ; SET THE EMPTY LINE UP TO BE DELETED + . . . I JM=JPX D ; + . . . . I $G(DEBUG) W I,JM_J_JPX,! + . . . . S DEL(I-1)="" + . . . . S DEL(I+1)="" ; SET THE SURROUNDING LINES FOR DEL + ; . I J'["><" D PUSH("TMPXML",J) + I FOUND D ; NEED TO DELETE THINGS + . F I=1:1:@THEXML@(0) D ; COPY ARRAY LEAVING OUT DELELTED LINES + . . I '$D(DEL(I)) D ; IF THE LINE IS NOT DELETED + . . . D PUSH("TMPXML",@THEXML@(I)) ; COPY TO TMPXML ARRAY + . D CP("TMPXML",THEXML) ; REPLACE THE XML WITH THE COPY + Q FOUND + ; +UNMARK(XSEC) ; REMOVE MARKUP FROM FIRST AND LAST LINE OF XML + ; XSEC IS A SECTION PASSED BY NAME + N XBLD,XTMP + D QUEUE("XBLD",XSEC,2,@XSEC@(0)-1) ; BUILD LIST FOR INNER XML + D BUILD("XBLD","XTMP") ; BUILD THE RESULT + D CP("XTMP",XSEC) ; REPLACE PASSED XML + Q + ; +PARY(GLO,ZN) ;PRINT AN ARRAY + ; IF ZN=-1 NO LINE NUMBERS + N I + F I=1:1:@GLO@(0) D ; + . I $G(ZN)=-1 W @GLO@(I),! + . E W I_" "_@GLO@(I),! + Q + ; +H2ARY(IARYRTN,IHASH,IPRE) ; CONVERT IHASH TO RETURN ARRAY + ; IPRE IS OPTIONAL PREFIX FOR THE ELEMENTS. USED FOR MUPTIPLES 1^"VAR"^VALUE + I '$D(IPRE) S IPRE="" + N H2I S H2I="" + ; W $O(@IHASH@(H2I)),! + F S H2I=$O(@IHASH@(H2I)) Q:H2I="" D ; FOR EACH ELEMENT OF THE HASH + . I $QS(H2I,$QL(H2I))="M" D Q ; SPECIAL CASE FOR MULTIPLES + . . ;W H2I_"^"_@IHASH@(H2I),! + . . N IH,IHI + . . S IH=$NA(@IHASH@(H2I)) ; + . . S IH2A=$O(@IH@("")) ; SKIP OVER MULTIPLE DISCRIPTOR + . . S IH2=$NA(@IH@(IH2A)) ; PAST THE "M","DIRETIONS" FOR EXAMPLE + . . S IHI="" ; INDEX INTO "M" MULTIPLES + . . F S IHI=$O(@IH2@(IHI)) Q:IHI="" D ; FOR EACH SUB-MULTIPLE + . . . ; W @IH@(IHI) + . . . S IH3=$NA(@IH2@(IHI)) + . . . ; W "HEY",IH3,! + . . . D H2ARY(.IARYRTN,IH3,IPRE_";"_IHI) ; RECURSIVE CALL - INDENTED ELEMENTS + . . ; W IH,! + . . ; W "C0CZZ",! + . . ; W $NA(@IHASH@(H2I)),! + . . Q ; + . D PUSH(IARYRTN,IPRE_"^"_H2I_"^"_@IHASH@(H2I)) + . ; W @IARYRTN@(0),! + Q + ; +XVARS(XVRTN,XVIXML) ; RETURNS AN ARRAY XVRTN OF ALL UNIQUE VARIABLES + ; DEFINED IN INPUT XML XVIXML BY @@VAR@@ + ; XVRTN AND XVIXML ARE PASSED BY NAME + ; + N XVI,XVTMP,XVT + F XVI=1:1:@XVIXML@(0) D ; FOR ALL LINES OF THE XML + . S XVT=@XVIXML@(XVI) + . I XVT["@@" S XVTMP($P(XVT,"@@",2))=XVI + D H2ARY(XVRTN,"XVTMP") + Q + ; +DXVARS(DXIN) ;DISPLAY ALL VARIABLES IN A TEMPLATE + ; IF PARAMETERS ARE NULL, DEFAULTS TO CCR TEMPLATE + ; + N DXUSE,DTMP ; DXUSE IS NAME OF VARIABLE, DTMP IS VARIABLE IF NOT SUPPLIED + I DXIN="CCR" D ; NEED TO GO GET CCR TEMPLATE + . D LOAD^C0CCCR0("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP + . S DXUSE="DTMP" ; DXUSE IS NAME + E I DXIN="CCD" D ; NEED TO GO GET CCD TEMPLATE + . D LOAD^C0CCCD1("DTMP") ; LOAD CCR TEMPLATE INTO DXTMP + . S DXUSE="DTMP" ; DXUSE IS NAME + E S DXUSE=DXIN ; IF PASSED THE TEMPLATE TO USE + N DVARS ; PUT VARIABLE NAME RESULTS IN ARRAY HERE + D XVARS("DVARS",DXUSE) ; PULL OUT VARS + D PARY^C0CXPATH("DVARS") ;AND DISPLAY THEM + Q + ; +TEST ; Run all the test cases + D TESTALL^C0CUNIT("C0CXPAT0") + Q + ; +ZTEST(WHICH) ; RUN ONE SET OF TESTS + N ZTMP + S DEBUG=1 + D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") + D ZTEST^C0CUNIT(.ZTMP,WHICH) + Q + ; +TLIST ; LIST THE TESTS + N ZTMP + D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0") + D TLIST^C0CUNIT(.ZTMP) + Q + ;