Index: smart/trunk/kids/C0S_1_0_0_T1.KID =================================================================== --- smart/trunk/kids/C0S_1_0_0_T1.KID (revision 1526) +++ smart/trunk/kids/C0S_1_0_0_T1.KID (revision 1526) @@ -0,0 +1,6496 @@ +KIDS Distribution saved on Sep 07, 2012@18:45 +initial VistA Smart container demo +**KIDS**:C0S*1.0*0^ + +**INSTALL NAME** +C0S*1.0*0 +"BLD",7929,0) +C0S*1.0*0^^0^3120907^n +"BLD",7929,4,0) +^9.64PA^^ +"BLD",7929,6.3) +1 +"BLD",7929,"KRN",0) +^9.67PA^779.2^20 +"BLD",7929,"KRN",.4,0) +.4 +"BLD",7929,"KRN",.401,0) +.401 +"BLD",7929,"KRN",.402,0) +.402 +"BLD",7929,"KRN",.403,0) +.403 +"BLD",7929,"KRN",.5,0) +.5 +"BLD",7929,"KRN",.84,0) +.84 +"BLD",7929,"KRN",3.6,0) +3.6 +"BLD",7929,"KRN",3.8,0) +3.8 +"BLD",7929,"KRN",9.2,0) +9.2 +"BLD",7929,"KRN",9.8,0) +9.8 +"BLD",7929,"KRN",9.8,"NM",0) +^9.68A^13^13 +"BLD",7929,"KRN",9.8,"NM",1,0) +C0SDEM^^0^B59022362 +"BLD",7929,"KRN",9.8,"NM",2,0) +C0SDOM^^0^B87367162 +"BLD",7929,"KRN",9.8,"NM",3,0) +C0SLAB^^0^B79265150 +"BLD",7929,"KRN",9.8,"NM",4,0) +C0SMART^^0^B2902265 +"BLD",7929,"KRN",9.8,"NM",5,0) +C0SMED^^0^B40719083 +"BLD",7929,"KRN",9.8,"NM",6,0) +C0SMXMLB^^0^B12189644 +"BLD",7929,"KRN",9.8,"NM",7,0) +C0SNHIN^^0^B88600644 +"BLD",7929,"KRN",9.8,"NM",8,0) +C0SNHINV^^0^B15736572 +"BLD",7929,"KRN",9.8,"NM",9,0) +C0SPROB^^0^B49669400 +"BLD",7929,"KRN",9.8,"NM",10,0) +C0SPROB2^^0^B63749946 +"BLD",7929,"KRN",9.8,"NM",11,0) +C0STBL^^0^B2532386 +"BLD",7929,"KRN",9.8,"NM",12,0) +C0SUTIL^^0^B1005502 +"BLD",7929,"KRN",9.8,"NM",13,0) +C0SXPATH^^0^B521212541 +"BLD",7929,"KRN",9.8,"NM","B","C0SDEM",1) + +"BLD",7929,"KRN",9.8,"NM","B","C0SDOM",2) + +"BLD",7929,"KRN",9.8,"NM","B","C0SLAB",3) + +"BLD",7929,"KRN",9.8,"NM","B","C0SMART",4) + +"BLD",7929,"KRN",9.8,"NM","B","C0SMED",5) + +"BLD",7929,"KRN",9.8,"NM","B","C0SMXMLB",6) + +"BLD",7929,"KRN",9.8,"NM","B","C0SNHIN",7) + +"BLD",7929,"KRN",9.8,"NM","B","C0SNHINV",8) + +"BLD",7929,"KRN",9.8,"NM","B","C0SPROB",9) + +"BLD",7929,"KRN",9.8,"NM","B","C0SPROB2",10) + +"BLD",7929,"KRN",9.8,"NM","B","C0STBL",11) + +"BLD",7929,"KRN",9.8,"NM","B","C0SUTIL",12) + +"BLD",7929,"KRN",9.8,"NM","B","C0SXPATH",13) + +"BLD",7929,"KRN",19,0) +19 +"BLD",7929,"KRN",19.1,0) +19.1 +"BLD",7929,"KRN",101,0) +101 +"BLD",7929,"KRN",409.61,0) +409.61 +"BLD",7929,"KRN",771,0) +771 +"BLD",7929,"KRN",779.2,0) +779.2 +"BLD",7929,"KRN",870,0) +870 +"BLD",7929,"KRN",8989.51,0) +8989.51 +"BLD",7929,"KRN",8989.52,0) +8989.52 +"BLD",7929,"KRN",8994,0) +8994 +"BLD",7929,"KRN","B",.4,.4) + +"BLD",7929,"KRN","B",.401,.401) + +"BLD",7929,"KRN","B",.402,.402) + +"BLD",7929,"KRN","B",.403,.403) + +"BLD",7929,"KRN","B",.5,.5) + +"BLD",7929,"KRN","B",.84,.84) + +"BLD",7929,"KRN","B",3.6,3.6) + +"BLD",7929,"KRN","B",3.8,3.8) + +"BLD",7929,"KRN","B",9.2,9.2) + +"BLD",7929,"KRN","B",9.8,9.8) + +"BLD",7929,"KRN","B",19,19) + +"BLD",7929,"KRN","B",19.1,19.1) + +"BLD",7929,"KRN","B",101,101) + +"BLD",7929,"KRN","B",409.61,409.61) + +"BLD",7929,"KRN","B",771,771) + +"BLD",7929,"KRN","B",779.2,779.2) + +"BLD",7929,"KRN","B",870,870) + +"BLD",7929,"KRN","B",8989.51,8989.51) + +"BLD",7929,"KRN","B",8989.52,8989.52) + +"BLD",7929,"KRN","B",8994,8994) + +"MBREQ") +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) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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^B79265150 +"RTN","C0SLAB",1,0) +C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 +"RTN","C0SLAB",2,0) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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")=$G(@LRN@("test@value")) +"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^B2902265 +"RTN","C0SMART",1,0) +C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 +"RTN","C0SMART",2,0) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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^C0SPROB(.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) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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) + ;;8.0;KERNEL;;;Build 1 +"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) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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;C0S;**1**;Oct 25, 2010;Build 1 +"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) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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^B63749946 +"RTN","C0SPROB2",1,0) +C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 +"RTN","C0SPROB2",2,0) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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="/vista/smart/"_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 ZR("sp:system")["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 +"RTN","C0SPROB2",335,0) + S ZSUB=$$subject^C0XGET1(,ZICD) ; subject of the ICD9 code +"RTN","C0SPROB2",336,0) + D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") +"RTN","C0SPROB2",337,0) + S ZSN=$O(ZARY("")) +"RTN","C0SPROB2",338,0) + I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") +"RTN","C0SPROB2",339,0) + Q ZSN +"RTN","C0SPROB2",340,0) + ; +"RTN","C0STBL") +0^11^B2532386 +"RTN","C0STBL",1,0) +C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 +"RTN","C0STBL",2,0) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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=BEGDFN +"RTN","C0STBL",28,0) + S ZCNT=0 +"RTN","C0STBL",29,0) + F S ZI=$O(^DPT(ZI)) Q:(+ZI="")!(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) + . ;D EN^C0SMART(.G,ZI,"med") +"RTN","C0STBL",37,0) + . ;I $D(G) W !,$$output^C0XGET1("G") +"RTN","C0STBL",38,0) + . ;k G +"RTN","C0STBL",39,0) + . ;D EN^C0SMART(.G,ZI,"patient") +"RTN","C0STBL",40,0) + . ;I $D(G) W !,$$output^C0XGET1("G") +"RTN","C0STBL",41,0) + . ;K G +"RTN","C0STBL",42,0) + . ;D EN^C0SMART(.G,ZI,"lab") +"RTN","C0STBL",43,0) + . ;I $D(G) W !,$$output^C0XGET1("G") +"RTN","C0STBL",44,0) + . ;K G +"RTN","C0STBL",45,0) + . D EN^C0SMART(.G,ZI,"problem") +"RTN","C0STBL",46,0) + . I $D(G) W !,$$output^C0XGET1("G") +"RTN","C0STBL",47,0) + Q +"RTN","C0STBL",48,0) + ; +"RTN","C0STBL",49,0) +LOADHACK ; +"RTN","C0STBL",50,0) + N ZI +"RTN","C0STBL",51,0) + F ZI=2:1:374 D ; +"RTN","C0STBL",52,0) + . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/") +"RTN","C0STBL",53,0) + Q +"RTN","C0STBL",54,0) + ; +"RTN","C0SUTIL") +0^12^B1005502 +"RTN","C0SUTIL",1,0) +C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 +"RTN","C0SUTIL",2,0) + ;;0.1;C0S;nopatch;noreleasedate;Build 1 +"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^B521212541 +"RTN","C0SXPATH",1,0) + C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 +"RTN","C0SXPATH",2,0) + ;;1.0;C0S;;May 19, 2009;Build 1 +"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**