From 333313809d428ce17cfc550c1fcde2c1a1c302b2 Mon Sep 17 00:00:00 2001 From: sam Date: Wed, 26 Sep 2012 17:00:27 +0000 Subject: [PATCH] Updated routines per the KIDS build --- p/C0SDEM.m | 578 +++++++++++++++++++++---------------------- p/C0SDOM.m | 640 +++++++++++++++++++++++------------------------ p/C0SLAB.m | 550 ++++++++++++++++++++--------------------- p/C0SMART.m | 112 ++++----- p/C0SMED.m | 314 +++++++++++------------ p/C0SMXMLB.m | 212 ++++++++-------- p/C0SNHIN.m | 648 ++++++++++++++++++++++++------------------------ p/C0SNHINV.m | 236 +++++++++--------- p/C0SPROB.m | 646 ++++++++++++++++++++++++------------------------ p/C0SPROB2.m | 686 +++++++++++++++++++++++++-------------------------- p/C0STBL.m | 108 ++++---- p/C0SUTIL.m | 68 ++--- p/C0SXPATH.m | 4 +- 13 files changed, 2401 insertions(+), 2401 deletions(-) diff --git a/p/C0SDEM.m b/p/C0SDEM.m index 1689970..c6971c3 100644 --- a/p/C0SDEM.m +++ b/p/C0SDEM.m @@ -1,289 +1,289 @@ -C0SDEM ; GPL - Smart Demographics Processing ;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; - ; - ; - ; - ; - ; - ; Bob - ; J - ; Odenkirk - ; - ; - ; - ; - ; - ; - ; - ; - ; 15 Main St - ; Apt 2 - ; Wonderland - ; OZ - ; 54321 - ; USA - ; - ; - ; - ; - ; - ; - ; - ; 800-555-1212 - ; - ; - ; - ; - ; - ; - ; 800-555-1515 - ; - ; - ; - ; male - ; 1959-12-25 - ; bob.odenkirk@example.com - ; - ; - ; - ; My Hospital Record 2304575 - ; 2304575 - ; My Hospital Record - ; - ; - ; - ; - ; - ; - ; - ; - ; - ; - ; Bob - ; J - ; Odenkirk - ; - ; - ; - ; - ; - ; - ; - ; - ; 15 Main St - ; Apt 2 - ; Wonderland - ; OZ - ; 54321 - ; USA - ; - ; - ; - ; - ; - ; - ; - ; 800-555-1212 - ; - ; - ; - ; - ; - ; - ; 800-555-1515 - ; - ; - ; - ; male - ; 1959-12-25 - ; bob.odenkirk@example.com - ; - ; - ; - ; My Hospital Record 2304575 - ; 2304575 - ; My Hospital Record - ; - ; - ; - ; - ; - ;G(1)="nodeID:25591^rdf:type^v:Home" - ;G(2)="nodeID:25591^rdf:type^v:Pref" - ;G(3)="nodeID:25591^rdf:type^v:Tel" - ;G(4)="nodeID:25591^rdf:value^800-369-6403" - ;G(5)="nodeID:25611^rdf:type^v:Name" - ;G(6)="nodeID:25611^v:additional-name^N" - ;G(7)="nodeID:25611^v:family-name^Brooks" - ;G(8)="nodeID:25611^v:given-name^Brian" - ;G(9)="nodeID:25622^dcterms:identifier^981968" - ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968" - ;G(11)="nodeID:25622^rdf:type^sp:Code" - ;G(12)="nodeID:25622^sp:system^My Hospital Record" - ;G(13)="nodeID:25623^rdf:type^v:Address" - ;G(14)="nodeID:25623^rdf:type^v:Home" - ;G(15)="nodeID:25623^rdf:type^v:Pref" - ;G(16)="nodeID:25623^v:locality^Bixby" - ;G(17)="nodeID:25623^v:postal-code^74008" - ;G(18)="nodeID:25623^v:region^OK" - ;G(19)="nodeID:25623^v:street-address^82 Lake St" - ;G(20)="smart:981968/demographics^foaf:gender^male" - ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics" - ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968" - ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622" - ;G(24)="smart:981968/demographics^v:adr^nodeID:25623" - ;G(25)="smart:981968/demographics^v:bday^1956-03-23" - ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com" - ;G(27)="smart:981968/demographics^v:n^nodeID:25611" - ;G(28)="smart:981968/demographics^v:tel^nodeID:25591" - Q - ; -PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of patient - ; - I $O(C0SARY("patient",""))="" D Q ; - . I $D(DEBUG) W !,"No Patient array" - . S GRTN="" - S GRTN="" ; default to no patient - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/patient" - S ZPAT=C0SGRF ; subject is the same as the graph name - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - N ZPN,ZR - D STARTADD^C0XF2N - ; - ; First do the base demographic graph - ; - S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient - N SEX S SEX=$G(@ZPN@("gender@value")) - I SEX="M" S SEX="male" - I SEX="F" S SEX="female" - S ZR("foaf:gender")=SEX - S ZR("rdf:type")="sp:Demographics" - S ZR("sp:belongsTo")=ZPAT - N PATIENT - S PATIENT=$P(ZPAT,"#",2) - I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT - N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph - S ZR("sp:medicalRecordNumber")=NMREC - N NVADR S NVADR=$$ANONS^C0XF2N ; for address - S ZR("v:adr")=NVADR - N NNAME S NNAME=$$ANONS^C0XF2N ; for name - S ZR("v:n")=NNAME - N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone - I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists - N BDATE - S ZX="" - S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format - S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date - S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens - I BDATE="" S BDATE="UNKNOWN" - N Z2,Z3 - S Z2=$P(BDATE,"-",2) - S Z3=$P(BDATE,"-",3) - I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2 - I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3 - S ZR("v:bday")=BDATE - I $D(C0SVISTA) D ; - . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN - . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN - D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph - K ZR - ; - ; create address sub-graph - ; - S ZR("rdf:type")="v:Address" - S ZR("rdf:type")="v:Home" - S ZR("v:locality")=$G(@ZPN@("address@city")) - S ZR("v:postal-code")=$G(@ZPN@("address@postalCode")) - S ZR("v:region")=$G(@ZPN@("address@stateProvince")) - S ZR("v:street-address")=$G(@ZPN@("address@streetLine1")) - D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address - K ZR - ; - ; create medical record subgraph - ; - S ZR("dcterms:identifier")=$G(@ZPN@("id@value")) - S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier") - S ZR("rdf:type")="sp:Code" - S ZR("sp:system")="VistA Patient Record" - D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph - K ZR - ; - ; create name subgraph - ; - N ZNF,ZNL,ZNM,ZNAM - S ZR("rdf:type")="v:Name" - S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names - S ZNF=$P(ZX," ",1) ; first name is first piece - S ZNM=$P(ZX," ",2) ; middle names are the rest - S ZR("v:additional-name")=ZNM - S ZR("v:family-name")=$G(@ZPN@("familyName@value")) - S ZR("v:given-name")=ZNF - D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph - K ZR - ; - ; create telephone subgraph - ; - D ; - . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value")) - . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph - . S ZR("rdf:type")="v:Tel" - . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR) - K ZR - ; - ; load the demographics graph and all sub graphs to the triple store - ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; -AGES ; LIST ALL PATIENTS AND THEIR AGES - N ZI S ZI=0 - F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT - . N ZDOB - . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB - . N ZNAME - . S ZNAME=$P(^DPT(ZI,0),U) - . N ZSEX - . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX") - . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX - Q - ; +C0SDEM ; GPL - Smart Demographics Processing ;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; + ; + ; + ; + ; + ; + ; Bob + ; J + ; Odenkirk + ; + ; + ; + ; + ; + ; + ; + ; + ; 15 Main St + ; Apt 2 + ; Wonderland + ; OZ + ; 54321 + ; USA + ; + ; + ; + ; + ; + ; + ; + ; 800-555-1212 + ; + ; + ; + ; + ; + ; + ; 800-555-1515 + ; + ; + ; + ; male + ; 1959-12-25 + ; bob.odenkirk@example.com + ; + ; + ; + ; My Hospital Record 2304575 + ; 2304575 + ; My Hospital Record + ; + ; + ; + ; + ; + ; + ; + ; + ; + ; + ; Bob + ; J + ; Odenkirk + ; + ; + ; + ; + ; + ; + ; + ; + ; 15 Main St + ; Apt 2 + ; Wonderland + ; OZ + ; 54321 + ; USA + ; + ; + ; + ; + ; + ; + ; + ; 800-555-1212 + ; + ; + ; + ; + ; + ; + ; 800-555-1515 + ; + ; + ; + ; male + ; 1959-12-25 + ; bob.odenkirk@example.com + ; + ; + ; + ; My Hospital Record 2304575 + ; 2304575 + ; My Hospital Record + ; + ; + ; + ; + ; + ;G(1)="nodeID:25591^rdf:type^v:Home" + ;G(2)="nodeID:25591^rdf:type^v:Pref" + ;G(3)="nodeID:25591^rdf:type^v:Tel" + ;G(4)="nodeID:25591^rdf:value^800-369-6403" + ;G(5)="nodeID:25611^rdf:type^v:Name" + ;G(6)="nodeID:25611^v:additional-name^N" + ;G(7)="nodeID:25611^v:family-name^Brooks" + ;G(8)="nodeID:25611^v:given-name^Brian" + ;G(9)="nodeID:25622^dcterms:identifier^981968" + ;G(10)="nodeID:25622^dcterms:title^My Hospital Record 981968" + ;G(11)="nodeID:25622^rdf:type^sp:Code" + ;G(12)="nodeID:25622^sp:system^My Hospital Record" + ;G(13)="nodeID:25623^rdf:type^v:Address" + ;G(14)="nodeID:25623^rdf:type^v:Home" + ;G(15)="nodeID:25623^rdf:type^v:Pref" + ;G(16)="nodeID:25623^v:locality^Bixby" + ;G(17)="nodeID:25623^v:postal-code^74008" + ;G(18)="nodeID:25623^v:region^OK" + ;G(19)="nodeID:25623^v:street-address^82 Lake St" + ;G(20)="smart:981968/demographics^foaf:gender^male" + ;G(21)="smart:981968/demographics^rdf:type^sp:Demographics" + ;G(22)="smart:981968/demographics^sp:belongsTo^smart:981968" + ;G(23)="smart:981968/demographics^sp:medicalRecordNumber^nodeID:25622" + ;G(24)="smart:981968/demographics^v:adr^nodeID:25623" + ;G(25)="smart:981968/demographics^v:bday^1956-03-23" + ;G(26)="smart:981968/demographics^v:email^brian.brooks@example.com" + ;G(27)="smart:981968/demographics^v:n^nodeID:25611" + ;G(28)="smart:981968/demographics^v:tel^nodeID:25591" + Q + ; +PATIENT(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of patient + ; + I $O(C0SARY("patient",""))="" D Q ; + . I $D(DEBUG) W !,"No Patient array" + . S GRTN="" + S GRTN="" ; default to no patient + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/patient" + S ZPAT=C0SGRF ; subject is the same as the graph name + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + N ZPN,ZR + D STARTADD^C0XF2N + ; + ; First do the base demographic graph + ; + S ZPN=$NA(C0SARY("patient",1)) ; name of predicate array for this patient + N SEX S SEX=$G(@ZPN@("gender@value")) + I SEX="M" S SEX="male" + I SEX="F" S SEX="female" + S ZR("foaf:gender")=SEX + S ZR("rdf:type")="sp:Demographics" + S ZR("sp:belongsTo")=ZPAT + N PATIENT + S PATIENT=$P(ZPAT,"#",2) + I $D(DEBUG) W !,"PROCESSING PATIENT ",PATIENT + N NMREC S NMREC=$$ANONS^C0XF2N ; new anonomous subject for med rec graph + S ZR("sp:medicalRecordNumber")=NMREC + N NVADR S NVADR=$$ANONS^C0XF2N ; for address + S ZR("v:adr")=NVADR + N NNAME S NNAME=$$ANONS^C0XF2N ; for name + S ZR("v:n")=NNAME + N NTEL S NTEL=$$ANONS^C0XF2N ; for telephone + I $D(@ZPN@("telecomList.telecom@value")) S ZR("v:tel")=NTEL ; only if exists + N BDATE + S ZX="" + S ZX=$G(@ZPN@("dob@value")) ; date of birth in fileman format + S BDATE=$$FMTE^XLFDT(ZX,"7D") ; ordered date + S BDATE=$TR(BDATE,"/","-") ; change slashes to hyphens + I BDATE="" S BDATE="UNKNOWN" + N Z2,Z3 + S Z2=$P(BDATE,"-",2) + S Z3=$P(BDATE,"-",3) + I $L(Z2)=1 S $P(BDATE,"-",2)="0"_Z2 + I $L(Z3)=1 S $P(BDATE,"-",3)="0"_Z3 + S ZR("v:bday")=BDATE + I $D(C0SVISTA) D ; + . S ZR("vista:SSN")=$G(@ZPN@("ssn@value")) ; SSN + . S ZR("vista:DFN")=$G(@ZPN@("id@value")) ; DFN + D ADDINN^C0XF2N(C0SGRF,ZPAT,.ZR) ; create base graph + K ZR + ; + ; create address sub-graph + ; + S ZR("rdf:type")="v:Address" + S ZR("rdf:type")="v:Home" + S ZR("v:locality")=$G(@ZPN@("address@city")) + S ZR("v:postal-code")=$G(@ZPN@("address@postalCode")) + S ZR("v:region")=$G(@ZPN@("address@stateProvince")) + S ZR("v:street-address")=$G(@ZPN@("address@streetLine1")) + D ADDINN^C0XF2N(C0SGRF,NVADR,.ZR) ; create the vcard address + K ZR + ; + ; create medical record subgraph + ; + S ZR("dcterms:identifier")=$G(@ZPN@("id@value")) + S ZR("dcterms:title")="VistA Patient Record "_ZR("dcterms:identifier") + S ZR("rdf:type")="sp:Code" + S ZR("sp:system")="VistA Patient Record" + D ADDINN^C0XF2N(C0SGRF,NMREC,.ZR) ; create medical record graph + K ZR + ; + ; create name subgraph + ; + N ZNF,ZNL,ZNM,ZNAM + S ZR("rdf:type")="v:Name" + S ZX=$G(@ZPN@("givenNames@value")) ; first name and middle names + S ZNF=$P(ZX," ",1) ; first name is first piece + S ZNM=$P(ZX," ",2) ; middle names are the rest + S ZR("v:additional-name")=ZNM + S ZR("v:family-name")=$G(@ZPN@("familyName@value")) + S ZR("v:given-name")=ZNF + D ADDINN^C0XF2N(C0SGRF,NNAME,.ZR) ; insert name graph + K ZR + ; + ; create telephone subgraph + ; + D ; + . S ZR("rdf:value")=$G(@ZPN@("telecomList.telecom@value")) + . I ZR("rdf:value")="" Q ; telephone number missing, no subgraph + . S ZR("rdf:type")="v:Tel" + . D ADDINN^C0XF2N(C0SGRF,NTEL,.ZR) + K ZR + ; + ; load the demographics graph and all sub graphs to the triple store + ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; +AGES ; LIST ALL PATIENTS AND THEIR AGES + N ZI S ZI=0 + F S ZI=$O(^DPT(ZI)) Q:+ZI=0 D ; FOR EVERY PATIENT + . N ZDOB + . S ZDOB=$$GET1^DIQ(2,ZI_",","DOB","I") ; FILEMAN DOB + . N ZNAME + . S ZNAME=$P(^DPT(ZI,0),U) + . N ZSEX + . S ZSEX=$$GET1^DIQ(2,ZI_",","SEX") + . W !,"DFN:",ZI," ",ZNAME," AGE: ",+$$BRIEF^VWTIME(ZDOB)," YEAR OLD ",ZSEX + Q + ; diff --git a/p/C0SDOM.m b/p/C0SDOM.m index 6b9f220..d2e9513 100644 --- a/p/C0SDOM.m +++ b/p/C0SDOM.m @@ -1,320 +1,320 @@ -C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2011,2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; -DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE - ; THE XPATH INDEX ZXIDX, PASSED BY NAME - ; THE XPATH ARRAY XPARY, PASSED BY NAME - ; ZOID IS THE STARTING OID - ; ZPATH IS THE STARTING XPATH, USUALLY "/" - ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE - ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT - I $G(ZREDUX)="" S ZREDUX="" - N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY - N NEWNUM S NEWNUM="" - I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" - S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE - I $G(ZREDUX)'="" D ; REDUX PROVIDED? - . N GT S GT=$P(NEWPATH,ZREDUX,2) - . I GT'="" S NEWPATH=GT - S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX - N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE - I $D(GA) D ; PROCESS THE ATTRIBUTES - . N ZI S ZI="" - . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE - . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE - . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY - . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE - N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE - I $D(GD(2)) D ; - . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY - E I $D(GD(1)) D ; - . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY - . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY - N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD - I ZFRST'=0 D ; THERE IS A CHILD - . N ZNUM - . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE - . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD - N GNXT S GNXT=$$NXTSIB(ZOID) - I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES - I GNXT'=0 D ; - . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? - . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES - . . N ZNUM S ZNUM=1 ; - . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB - . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB - Q - ; -ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY - ; - ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES - ; - N ZZI,ZZJ,ZZN - S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY - I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE - S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY - S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . - I ZZI'["]" D ; A SINGLETON - . S ZZN=1 - E D ; THERE IS AN [x] OCCURANCE - . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE - . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] - I ZZJ'="" D ; TIME TO ADD THE VALUE - . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE - Q - ; -PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME - ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW - ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML - ;Q $$EN^MXMLDOM(INXML) - Q $$EN^MXMLDOM(INXML,"W") - ; -ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE - N ZN - ;I $$TAG(ZOID)["entry" B - S ZN=$$NXTSIB(ZOID) - I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG - Q 0 - ; -FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID - Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) - ; -PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID - Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) - ; -ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID - S HANDLE=C0SDOCID - K @RTN - D GETTXT^MXMLDOM("A") - Q - ; -TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE - ;I ZOID=149 B ;GPLTEST - N X,Y - S Y="" - S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE - I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y - I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) - Q Y - ; -NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING - Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) - ; -DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE - ;N ZT,ZN S ZT="" - ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) - ;Q $G(@C0SDOM@(ZOID,"T",1)) - S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) - Q - ; -OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM - ; - S C0SDOCID=INID - I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE 0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID - E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL - . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE - . S ZPARNODE=1 ; - ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET - N ZEXARY - D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY - D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED - I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE - Q HANDLE ; SUCCESS - ; -MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES - N ZI S ZI="" - N ZTAG - F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION - . N ZELEADD S ZELEADD=0 - . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES - . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG - . . K ZATT ; CLEAR OUT LAST ONE - . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY - . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE - . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE - . I $O(@ZARY@(ZI,""))="" D ;END NODE - . . S ZTAG=ZI ; USE ZI FOR THE TAG - . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE - . . S ZELEADD=1 ; ADDED AN ELEMENT - . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE - . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL - . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING - . N NEWARY ; INDENTED ARRAY - . N ZN S ZN=0 - . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE - . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG - . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY - . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY - . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG - Q - ; -EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED - ; CONSISTENT FORMAT - ; GNARY("patient",1,"facilities[2].facility@code")="050" - ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" - ; for easier processing (this is fileman format genius) - ; basically removes the dot notation from the strings - ; - N ZZI - S ZZI="" - F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; - . N ZZN S ZZN=0 - . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; - . . N ZZS S ZZS="" - . . N GA ;PUSH STACK - . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; - . . . K GA ; NEW STACK - . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT - . . . N ZZV ; PLACE TO STASH THE VALUE - . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE - . . . W !,"VALUE:",ZZV - . . . N GK ; COUNTER - . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE - . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] - . . . . N GM S GM=$P(ZZS,".",GK) ; TAG - . . . . I GM["[" D ; IT'S A MULTIPLE - . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER - . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG - . . . . I GM["@" D ; IT'S GOT ATTRIBUTES - . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME - . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG - . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2) - . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ; - . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" - . . . N GZI S GZI="" ; STRING FOR THE INDEX - . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS - . . . . S GM=$P(GA(GK),"^",1) ; THE TAG - . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY - . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE - . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST - . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME - . . . W !,GZI - . . . S @GZI2=ZZV ; REMEMBER THE VALUE? - Q - ; -NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE - N CBK,SUCCESS,LEVEL,NODE,HANDLE - K ^TMP("MXMLERR",$J) - L +^TMP("MXMLDOM",$J):5 - E Q 0 - S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" - L -^TMP("MXMLDOM",$J) - Q HANDLE - ; +C0SDOM ; GPL - Smart Container - DOM PROCESSING ROUTINES ;6/6/11 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2011,2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; +DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE + ; THE XPATH INDEX ZXIDX, PASSED BY NAME + ; THE XPATH ARRAY XPARY, PASSED BY NAME + ; ZOID IS THE STARTING OID + ; ZPATH IS THE STARTING XPATH, USUALLY "/" + ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE + ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT + I $G(ZREDUX)="" S ZREDUX="" + N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY + N NEWNUM S NEWNUM="" + I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" + S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE + I $G(ZREDUX)'="" D ; REDUX PROVIDED? + . N GT S GT=$P(NEWPATH,ZREDUX,2) + . I GT'="" S NEWPATH=GT + S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX + N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE + I $D(GA) D ; PROCESS THE ATTRIBUTES + . N ZI S ZI="" + . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE + . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE + . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY + . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE + N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE + I $D(GD(2)) D ; + . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY + E I $D(GD(1)) D ; + . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY + . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY + N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD + I ZFRST'=0 D ; THERE IS A CHILD + . N ZNUM + . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE + . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD + N GNXT S GNXT=$$NXTSIB(ZOID) + I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES + I GNXT'=0 D ; + . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? + . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES + . . N ZNUM S ZNUM=1 ; + . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB + . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB + Q + ; +ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY + ; + ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES + ; + N ZZI,ZZJ,ZZN + S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY + I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE + S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY + S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . + I ZZI'["]" D ; A SINGLETON + . S ZZN=1 + E D ; THERE IS AN [x] OCCURANCE + . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE + . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] + I ZZJ'="" D ; TIME TO ADD THE VALUE + . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE + Q + ; +PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME + ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW + ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML + ;Q $$EN^MXMLDOM(INXML) + Q $$EN^MXMLDOM(INXML,"W") + ; +ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE + N ZN + ;I $$TAG(ZOID)["entry" B + S ZN=$$NXTSIB(ZOID) + I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG + Q 0 + ; +FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID + Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) + ; +PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID + Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) + ; +ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID + S HANDLE=C0SDOCID + K @RTN + D GETTXT^MXMLDOM("A") + Q + ; +TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE + ;I ZOID=149 B ;GPLTEST + N X,Y + S Y="" + S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE + I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y + I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) + Q Y + ; +NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING + Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) + ; +DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE + ;N ZT,ZN S ZT="" + ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) + ;Q $G(@C0SDOM@(ZOID,"T",1)) + S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) + Q + ; +OUTXML(ZRTN,INID,NO1ST) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM + ; + S C0SDOCID=INID + I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE 0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID + E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL + . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE + . S ZPARNODE=1 ; + ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET + N ZEXARY + D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY + D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED + I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE + Q HANDLE ; SUCCESS + ; +MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES + N ZI S ZI="" + N ZTAG + F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION + . N ZELEADD S ZELEADD=0 + . I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES + . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG + . . K ZATT ; CLEAR OUT LAST ONE + . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY + . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE + . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE + . I $O(@ZARY@(ZI,""))="" D ;END NODE + . . S ZTAG=ZI ; USE ZI FOR THE TAG + . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE + . . S ZELEADD=1 ; ADDED AN ELEMENT + . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE + . I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL + . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING + . N NEWARY ; INDENTED ARRAY + . N ZN S ZN=0 + . F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE + . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG + . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY + . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY + . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG + Q + ; +EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED + ; CONSISTENT FORMAT + ; GNARY("patient",1,"facilities[2].facility@code")="050" + ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050" + ; for easier processing (this is fileman format genius) + ; basically removes the dot notation from the strings + ; + N ZZI + S ZZI="" + F S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI="" D ; + . N ZZN S ZZN=0 + . F S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN="" D ; + . . N ZZS S ZZS="" + . . N GA ;PUSH STACK + . . F S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS="" D ; + . . . K GA ; NEW STACK + . . . D PUSH^C0SXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT + . . . N ZZV ; PLACE TO STASH THE VALUE + . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE + . . . W !,"VALUE:",ZZV + . . . N GK ; COUNTER + . . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE + . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X] + . . . . N GM S GM=$P(ZZS,".",GK) ; TAG + . . . . I GM["[" D ; IT'S A MULTIPLE + . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER + . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG + . . . . I GM["@" D ; IT'S GOT ATTRIBUTES + . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME + . . . . . D PUSH^C0SXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG + . . . . . D PUSH^C0SXPATH("GA",GM2_"^"_ZZN2) + . . . . E D PUSH^C0SXPATH("GA",GM_"^"_ZZN2) ; + . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1" + . . . N GZI S GZI="" ; STRING FOR THE INDEX + . . . F GK=1:1:GA(0) D ; TIME TO REVERSE POP THE TAGS + . . . . S GM=$P(GA(GK),"^",1) ; THE TAG + . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY + . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE + . . . . E S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST + . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME + . . . W !,GZI + . . . S @GZI2=ZZV ; REMEMBER THE VALUE? + Q + ; +NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE + N CBK,SUCCESS,LEVEL,NODE,HANDLE + K ^TMP("MXMLERR",$J) + L +^TMP("MXMLDOM",$J):5 + E Q 0 + S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)="" + L -^TMP("MXMLDOM",$J) + Q HANDLE + ; diff --git a/p/C0SLAB.m b/p/C0SLAB.m index e386dd6..529c063 100644 --- a/p/C0SLAB.m +++ b/p/C0SLAB.m @@ -1,275 +1,275 @@ -C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; sample VistA NHIN lab result - ; - ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16 - ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00" - ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve" - ;^TMP("C0STBL",32,"lab",8,"facility@code")=100 - ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47" - ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101" - ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003" - ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H" - ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336 - ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU" - ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0" - ;^TMP("C0STBL",32,"lab",8,"low@value")="69 " - ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807 - ;^TMP("C0STBL",32,"lab",8,"result@value")=178 - ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006 - ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM" - ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500" - ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM" - ;^TMP("C0STBL",32,"lab",8,"status@value")="completed" - ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE" - ;^TMP("C0STBL",32,"lab",8,"type@value")="CH" - ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL" - ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342 - ; - ; sample Smart lab result triples - ; - ;G("loinc:29571-7","dcterms:identifier")="29571-7" - ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql" - ;G("loinc:29571-7","rdf:type")="sp:Code" - ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/" - ;G("loinc:38478-4","dcterms:identifier")="38478-4" - ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql" - ;G("loinc:38478-4","rdf:type")="sp:Code" - ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/" - ;G("qqWZZIew993","rdf:type")="sp:Attribution" - ;G("qqWZZIew993","sp:startDate")="2007-04-21" - ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult" - ;G("qqWZZIew994","sp:value")="Normal" - ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql" - ;G("qqWZZIew995","rdf:type")="sp:CodedValue" - ;G("qqWZZIew995","sp:code")="loinc:38478-4" - ;G("qqWZZIew997","rdf:type")="sp:Attribution" - ;G("qqWZZIew997","sp:startDate")="2007-09-08" - ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult" - ;G("qqWZZIew998","sp:value")="Normal" - ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql" - ;G("qqWZZIew999","rdf:type")="sp:CodedValue" - ;G("qqWZZIew999","sp:code")="loinc:29571-7" - ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult" - ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345" - ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995" - ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994" - ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993" - ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998" - ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997" - ; - ; - ; another Smart example, this one with sp:quantitativeResult - ; - ;G("loinc:786-4","dcterms:identifier")="786-4" - ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc" - ;G("loinc:786-4","rdf:type")="sp:Code" - ;G("loinc:786-4","sp:system")="http://loinc.org/codes/" - ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit" - ;G("nodeID:4439","sp:unit")="g/dL" - ;G("nodeID:4439","sp:value")=36.6 - ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit" - ;G("nodeID:4613","sp:unit")="g/dL" - ;G("nodeID:4613","sp:value")=32 - ;G("nodeID:4672","rdf:type")="sp:Attribution" - ;G("nodeID:4672","sp:startDate")="2005-03-10" - ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit" - ;G("nodeID:4866","sp:unit")="g/dL" - ;G("nodeID:4866","sp:value")=36 - ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc" - ;G("nodeID:4871","rdf:type")="sp:CodedValue" - ;G("nodeID:4871","sp:code")="loinc:786-4" - ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult" - ;G("nodeID:5221","sp:normalRange")="nodeID:5282" - ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439" - ;G("nodeID:5282","rdf:type")="sp:ValueRange" - ;G("nodeID:5282","sp:maximum")="nodeID:4866" - ;G("nodeID:5282","sp:minimum")="nodeID:4613" - ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult" - ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505" - ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871" - ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221" - ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" - ; -LAB(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of lab - ; - I $O(C0SARY("lab",""))="" D Q ; - . I $D(DEBUG) W !,"No Labs" - S GRTN="" ; default to no labs - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/lab_results" - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - D STARTADD^C0XF2N ; initialize to create triples - ; - N ZI S ZI="" - F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ; - . N LRN,ZR ; ZR is the local array for building the new triples - . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result - . ; - . N RSLTID ; unique Id for this lab result - . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number - . ; - . ; i don't like this because the same labs result gets a - . ; different ID every time it's reported. Can't trace it back to VistA - . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003" - . ; .. either that or store an OID with the lab result - but that - . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012 - . ; - . N LOINC S LOINC=$G(@LRN@("loinc@value")) - . I LOINC="" D Q ; - . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING" - . N LABTST S LABTST=$G(@LRN@("test@value")) - . I $D(DEBUG) D ; - . . W !,"Processing Lab Result ",RSLTID - . . W !,"test: ",LABTST - . . W !,"loinc: ",LOINC - . ; - . ; first do the base result graph - . ; - . S ZR("rdf:type")="sp:LabResult" - . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results - . ; ie /vista/smart/99912345/lab_results - . ; - . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name - . S ZR("sp:labName")=LABNAME - . ; - . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result - . S ZR("sp:narrativeResult")=NARRSLT - . ; - . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result - . S ZR("sp:quantitativeResult")=QNTRSLT - . ; - . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected - . S ZR("sp:specimenCollected")=SPECCOLL - . ; - . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples - . K ZR ; clean up - . ; - . ; create the narrative result graph - . ; - . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L - . I IVAL'="" - . . S ZR("rdf:type")="sp:NarrativeResult" - . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L - . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal" - . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal" - . . I ZR("sp:value")="HH" S ZR("sp:value")="critical" - . . I ZR("sp:value")="LL" S ZR("sp:value")="critical" - . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR) - . . K ZR - . ; - . ; create the quantitative result graph - . ; - . S ZR("rdf:type")="sp:QuantitativeResult" - . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph - . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph - . N HASNORMAL S HASNORMAL=0 - . I $G(@LRN@("high@value"))'="" S HASNORMAL=1 - . I HASNORMAL S ZR("sp:normalRange")=NORMNM - . S ZR("sp:valueAndUnit")=VUNM - . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR) - . K ZR - . ; - . ; create the normal range graph - . ; - . I HASNORMAL D ; - . . S ZR("rdf:type")="sp:ValueRange" - . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph - . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph - . . S ZR("sp:maximum")=MAXNM - . . S ZR("sp:minimum")=MINNM - . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR) - . . K ZR - . . ; - . . ; create the maximum graph - . . ; - . . S ZR("rdf:type")="sp:ValueAndUnit" - . . S ZR("sp:unit")=$G(@LRN@("units@value")) - . . S ZR("sp:value")=$G(@LRN@("high@value")) - . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR) - . . K ZR - . . ; - . . ; create the minimum graph - . . ; - . . S ZR("rdf:type")="sp:ValueAndUnit" - . . S ZR("sp:unit")=$G(@LRN@("units@value")) - . . S ZR("sp:value")=$G(@LRN@("low@value")) - . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR) - . . K ZR - . ; - . ; create the value and unit graph - . ; - . S ZR("rdf:type")="sp:ValueAndUnit" - . S ZR("sp:unit")=$G(@LRN@("units@value")) - . I ZR("sp:unit")="" S ZR("sp:unit")=$G(@LRN@("test@value")) - . S ZR("sp:value")=$G(@LRN@("result@value")) - . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR) - . K ZR - . ; - . ; create specimen collected graph - . ; - . S ZR("rdf:type")="sp:Attribution" - . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value"))) - . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR) - . K ZR - . ; - . ; create lab name graph - this contains the test name and code - . ; - . I LOINC'="" D ; - . . S ZR("rdf:type")="sp:CodedValue" - . . S ZR("dcterms:title")=LABTST - . . N LOINCNM S LOINCNM="loinc:"_LOINC - . . S ZR("sp:code")="loinc:"_LOINC - . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR) - . . K ZR - . . S ZR("dcterms:identifier")=LOINC - . . S ZR("dcterms:title")=LABTST - . . S ZR("rdf:type")="sp:Code" - . . S ZR("sp:system")="http://loinc.org/codes/" - . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR) - . . K ZR - . ; - . ; that's all for now folks (there is more to do like reference ranges - . ; and result values) - . ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; -SAMPLE ; import sample lab tests to the triplestore - N GN - S GN=$NA(^rdf("lab_results")) - D INSRDF^C0XF2N(GN,"/smart/lab/samples") - Q - ; \ No newline at end of file +C0SLAB ; GPL - Smart Lab Processing ;4/15/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; sample VistA NHIN lab result + ; + ;^TMP("C0STBL",32,"lab",8,"collected@value")=3110626.16 + ;^TMP("C0STBL",32,"lab",8,"comment")="Report Released Date/Time: Jun 26, 2011@19:00" + ;^TMP("C0STBL",32,"lab",8,"comment@xml:space")="preserve" + ;^TMP("C0STBL",32,"lab",8,"facility@code")=100 + ;^TMP("C0STBL",32,"lab",8,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",32,"lab",8,"groupName@value")="CH 0626 47" + ;^TMP("C0STBL",32,"lab",8,"high@value")=" 101" + ;^TMP("C0STBL",32,"lab",8,"id@value")="CH;6889372.84;67003" + ;^TMP("C0STBL",32,"lab",8,"interpretation@value")="H" + ;^TMP("C0STBL",32,"lab",8,"labOrderID@value")=336 + ;^TMP("C0STBL",32,"lab",8,"localName@value")="FBLDGLU" + ;^TMP("C0STBL",32,"lab",8,"loinc@value")="14771-0" + ;^TMP("C0STBL",32,"lab",8,"low@value")="69 " + ;^TMP("C0STBL",32,"lab",8,"orderID@value")=807 + ;^TMP("C0STBL",32,"lab",8,"result@value")=178 + ;^TMP("C0STBL",32,"lab",8,"resulted@value")=3110626.190006 + ;^TMP("C0STBL",32,"lab",8,"sample@value")="SERUM" + ;^TMP("C0STBL",32,"lab",8,"specimen@code")="0X500" + ;^TMP("C0STBL",32,"lab",8,"specimen@name")="SERUM" + ;^TMP("C0STBL",32,"lab",8,"status@value")="completed" + ;^TMP("C0STBL",32,"lab",8,"test@value")="FASTING BLOOD GLUCOSE" + ;^TMP("C0STBL",32,"lab",8,"type@value")="CH" + ;^TMP("C0STBL",32,"lab",8,"units@value")="MG/DL" + ;^TMP("C0STBL",32,"lab",8,"vuid@value")=4656342 + ; + ; sample Smart lab result triples + ; + ;G("loinc:29571-7","dcterms:identifier")="29571-7" + ;G("loinc:29571-7","dcterms:title")="Phe DBS Ql" + ;G("loinc:29571-7","rdf:type")="sp:Code" + ;G("loinc:29571-7","sp:system")="http://loinc.org/codes/" + ;G("loinc:38478-4","dcterms:identifier")="38478-4" + ;G("loinc:38478-4","dcterms:title")="Biotinidase DBS Ql" + ;G("loinc:38478-4","rdf:type")="sp:Code" + ;G("loinc:38478-4","sp:system")="http://loinc.org/codes/" + ;G("qqWZZIew993","rdf:type")="sp:Attribution" + ;G("qqWZZIew993","sp:startDate")="2007-04-21" + ;G("qqWZZIew994","rdf:type")="sp:NarrativeResult" + ;G("qqWZZIew994","sp:value")="Normal" + ;G("qqWZZIew995","dcterms:title")="Biotinidase DBS Ql" + ;G("qqWZZIew995","rdf:type")="sp:CodedValue" + ;G("qqWZZIew995","sp:code")="loinc:38478-4" + ;G("qqWZZIew997","rdf:type")="sp:Attribution" + ;G("qqWZZIew997","sp:startDate")="2007-09-08" + ;G("qqWZZIew998","rdf:type")="sp:NarrativeResult" + ;G("qqWZZIew998","sp:value")="Normal" + ;G("qqWZZIew999","dcterms:title")="Phe DBS Ql" + ;G("qqWZZIew999","rdf:type")="sp:CodedValue" + ;G("qqWZZIew999","sp:code")="loinc:29571-7" + ;G("smart:99912345/lab_results/3d9b39249193","rdf:type")="sp:LabResult" + ;G("smart:99912345/lab_results/3d9b39249193","sp:belongsTo")="smart:99912345" + ;G("smart:99912345/lab_results/3d9b39249193","sp:labName")="qqWZZIew995" + ;G("smart:99912345/lab_results/3d9b39249193","sp:narrativeResult")="qqWZZIew994" + ;G("smart:99912345/lab_results/3d9b39249193","sp:specimenCollected")="qqWZZIew993" + ;G("smart:99912345/lab_results/426c7adc4f54","rdf:type")="sp:LabResult" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:belongsTo")="smart:99912345" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:labName")="qqWZZIew999" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:narrativeResult")="qqWZZIew998" + ;G("smart:99912345/lab_results/426c7adc4f54","sp:specimenCollected")="qqWZZIew997" + ; + ; + ; another Smart example, this one with sp:quantitativeResult + ; + ;G("loinc:786-4","dcterms:identifier")="786-4" + ;G("loinc:786-4","dcterms:title")="MCHC RBC Auto-mCnc" + ;G("loinc:786-4","rdf:type")="sp:Code" + ;G("loinc:786-4","sp:system")="http://loinc.org/codes/" + ;G("nodeID:4439","rdf:type")="sp:ValueAndUnit" + ;G("nodeID:4439","sp:unit")="g/dL" + ;G("nodeID:4439","sp:value")=36.6 + ;G("nodeID:4613","rdf:type")="sp:ValueAndUnit" + ;G("nodeID:4613","sp:unit")="g/dL" + ;G("nodeID:4613","sp:value")=32 + ;G("nodeID:4672","rdf:type")="sp:Attribution" + ;G("nodeID:4672","sp:startDate")="2005-03-10" + ;G("nodeID:4866","rdf:type")="sp:ValueAndUnit" + ;G("nodeID:4866","sp:unit")="g/dL" + ;G("nodeID:4866","sp:value")=36 + ;G("nodeID:4871","dcterms:title")="MCHC RBC Auto-mCnc" + ;G("nodeID:4871","rdf:type")="sp:CodedValue" + ;G("nodeID:4871","sp:code")="loinc:786-4" + ;G("nodeID:5221","rdf:type")="sp:QuantitativeResult" + ;G("nodeID:5221","sp:normalRange")="nodeID:5282" + ;G("nodeID:5221","sp:valueAndUnit")="nodeID:4439" + ;G("nodeID:5282","rdf:type")="sp:ValueRange" + ;G("nodeID:5282","sp:maximum")="nodeID:4866" + ;G("nodeID:5282","sp:minimum")="nodeID:4613" + ;G("smart:1540505/lab_results/2fc100850766","rdf:type")="sp:LabResult" + ;G("smart:1540505/lab_results/2fc100850766","sp:belongsTo")="smart:1540505" + ;G("smart:1540505/lab_results/2fc100850766","sp:labName")="nodeID:4871" + ;G("smart:1540505/lab_results/2fc100850766","sp:quantitativeResult")="nodeID:5221" + ;G("smart:1540505/lab_results/2fc100850766","sp:specimenCollected")="nodeID:4672" + ; +LAB(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of lab + ; + I $O(C0SARY("lab",""))="" D Q ; + . I $D(DEBUG) W !,"No Labs" + S GRTN="" ; default to no labs + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/lab_results" + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + D STARTADD^C0XF2N ; initialize to create triples + ; + N ZI S ZI="" + F S ZI=$O(C0SARY("lab",ZI)) Q:ZI="" D ; + . N LRN,ZR ; ZR is the local array for building the new triples + . S LRN=$NA(C0SARY("lab",ZI)) ; base for values in this lab result + . ; + . N RSLTID ; unique Id for this lab result + . S RSLTID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number + . ; + . ; i don't like this because the same labs result gets a + . ; different ID every time it's reported. Can't trace it back to VistA + . ; I'd rather be using id@value ie "id@value")="CH;6889372.84;67003" + . ; .. either that or store an OID with the lab result - but that + . ; will have to wait for the redesign of file 60.. - gpl 4/16/2012 + . ; + . N LOINC S LOINC=$G(@LRN@("loinc@value")) + . I LOINC="" D Q ; + . . I $D(DEBUG) W !,"NO LOINC VALUE, SKIPPING" + . N LABTST S LABTST=$G(@LRN@("test@value")) + . I $D(DEBUG) D ; + . . W !,"Processing Lab Result ",RSLTID + . . W !,"test: ",LABTST + . . W !,"loinc: ",LOINC + . ; + . ; first do the base result graph + . ; + . S ZR("rdf:type")="sp:LabResult" + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's lab results + . ; ie /vista/smart/99912345/lab_results + . ; + . N LABNAME S LABNAME=$$ANONS^C0XF2N ; new node for lab name + . S ZR("sp:labName")=LABNAME + . ; + . N NARRSLT S NARRSLT=$$ANONS^C0XF2N ; new node for narrative result + . S ZR("sp:narrativeResult")=NARRSLT + . ; + . N QNTRSLT S QNTRSLT=$$ANONS^C0XF2N ; new node for narrative result + . S ZR("sp:quantitativeResult")=QNTRSLT + . ; + . N SPECCOLL S SPECCOLL=$$ANONS^C0XF2N ; new node for specimen collected + . S ZR("sp:specimenCollected")=SPECCOLL + . ; + . D ADDINN^C0XF2N(C0SGRF,RSLTID,.ZR) ; addIfNotNull the triples + . K ZR ; clean up + . ; + . ; create the narrative result graph + . ; + . N IVAL S IVAL=$G(@LRN@("interpretation@value"))'="" D ; H OR L + . I IVAL'="" + . . S ZR("rdf:type")="sp:NarrativeResult" + . . S ZR("sp:value")=$G(@LRN@("interpretation@value")) ; H or L + . . I ZR("sp:value")="L" S ZR("sp:value")="abnormal" + . . I ZR("sp:value")="H" S ZR("sp:value")="abnormal" + . . I ZR("sp:value")="HH" S ZR("sp:value")="critical" + . . I ZR("sp:value")="LL" S ZR("sp:value")="critical" + . . D ADDINN^C0XF2N(C0SGRF,NARRSLT,.ZR) + . . K ZR + . ; + . ; create the quantitative result graph + . ; + . S ZR("rdf:type")="sp:QuantitativeResult" + . N NORMNM S NORMNM=$$ANONS^C0XF2N ; new node for normal range graph + . N VUNM S VUNM=$$ANONS^C0XF2N ; new node for value and unit graph + . N HASNORMAL S HASNORMAL=0 + . I $G(@LRN@("high@value"))'="" S HASNORMAL=1 + . I HASNORMAL S ZR("sp:normalRange")=NORMNM + . S ZR("sp:valueAndUnit")=VUNM + . D ADDINN^C0XF2N(C0SGRF,QNTRSLT,.ZR) + . K ZR + . ; + . ; create the normal range graph + . ; + . I HASNORMAL D ; + . . S ZR("rdf:type")="sp:ValueRange" + . . N MAXNM S MAXNM=$$ANONS^C0XF2N ; new node for maximum graph + . . N MINNM S MINNM=$$ANONS^C0XF2N ; new node for minimum graph + . . S ZR("sp:maximum")=MAXNM + . . S ZR("sp:minimum")=MINNM + . . D ADDINN^C0XF2N(C0SGRF,NORMNM,.ZR) + . . K ZR + . . ; + . . ; create the maximum graph + . . ; + . . S ZR("rdf:type")="sp:ValueAndUnit" + . . S ZR("sp:unit")=$G(@LRN@("units@value")) + . . S ZR("sp:value")=$G(@LRN@("high@value")) + . . D ADDINN^C0XF2N(C0SGRF,MAXNM,.ZR) + . . K ZR + . . ; + . . ; create the minimum graph + . . ; + . . S ZR("rdf:type")="sp:ValueAndUnit" + . . S ZR("sp:unit")=$G(@LRN@("units@value")) + . . S ZR("sp:value")=$G(@LRN@("low@value")) + . . D ADDINN^C0XF2N(C0SGRF,MINNM,.ZR) + . . K ZR + . ; + . ; create the value and unit graph + . ; + . S ZR("rdf:type")="sp:ValueAndUnit" + . S ZR("sp:unit")=$G(@LRN@("units@value")) + . I ZR("sp:unit")="" S ZR("sp:unit")=$G(@LRN@("test@value")) + . S ZR("sp:value")=$G(@LRN@("result@value")) + . D ADDINN^C0XF2N(C0SGRF,VUNM,.ZR) + . K ZR + . ; + . ; create specimen collected graph + . ; + . S ZR("rdf:type")="sp:Attribution" + . S ZR("sp:startDate")=$$SPDATE^C0SUTIL($G(@LRN@("collected@value"))) + . D ADDINN^C0XF2N(C0SGRF,SPECCOLL,.ZR) + . K ZR + . ; + . ; create lab name graph - this contains the test name and code + . ; + . I LOINC'="" D ; + . . S ZR("rdf:type")="sp:CodedValue" + . . S ZR("dcterms:title")=LABTST + . . N LOINCNM S LOINCNM="loinc:"_LOINC + . . S ZR("sp:code")="loinc:"_LOINC + . . D ADDINN^C0XF2N(C0SGRF,LABNAME,.ZR) + . . K ZR + . . S ZR("dcterms:identifier")=LOINC + . . S ZR("dcterms:title")=LABTST + . . S ZR("rdf:type")="sp:Code" + . . S ZR("sp:system")="http://loinc.org/codes/" + . . D ADDINN^C0XF2N(C0SGRF,LOINCNM,.ZR) + . . K ZR + . ; + . ; that's all for now folks (there is more to do like reference ranges + . ; and result values) + . ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; +SAMPLE ; import sample lab tests to the triplestore + N GN + S GN=$NA(^rdf("lab_results")) + D INSRDF^C0XF2N(GN,"/smart/lab/samples") + Q + ; diff --git a/p/C0SMART.m b/p/C0SMART.m index 1f72e7f..a432532 100644 --- a/p/C0SMART.m +++ b/p/C0SMART.m @@ -1,56 +1,56 @@ -C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q -EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP - ; for patient ZPATID; ZFORM defaults to rdf - ; ZRTN is passed by reference - ; For now, ZPATID is the DFN - ; - I '$D(ZFORM) S ZFORM="rdf" - K ZRTN ; CLEAN RETURN - N C0SARY - I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient") - E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP) - I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ; - . W !,"Error Retreiving Patient Record" - ; - K C0XFDA - ; - N C0SGR ; graph - ; - ; processing table - ; - N C0SCTRL - S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)" - S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)" - S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)" - S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)" - ; - I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ; - N ZX - S ZX=C0SCTRL(ZTYP) - X ZX ; - ; - I '$D(C0SGR) Q ; - ; - D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM) - ; - Q - ; +C0SMART ; GPL - Smart Container Entry Points;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q +EN(ZRTN,ZPATID,ZTYP,ZFORM,DEBUG) ; return a Smart RDF file section ZTYP + ; for patient ZPATID; ZFORM defaults to rdf + ; ZRTN is passed by reference + ; For now, ZPATID is the DFN + ; + I '$D(ZFORM) S ZFORM="rdf" + K ZRTN ; CLEAN RETURN + N C0SARY + I ZTYP="patient" D EN^C0SNHIN(.C0SARY,ZPATID,"patient") + E D EN^C0SNHIN(.C0SARY,ZPATID,"patient;"_ZTYP) + I $G(C0SARY("patient",1,"id@value"))'=ZPATID D Q ; + . W !,"Error Retreiving Patient Record" + ; + K C0XFDA + ; + N C0SGR ; graph + ; + ; processing table + ; + N C0SCTRL + S C0SCTRL("med")="D MED^C0SMED(.C0SGR,.C0SARY)" + S C0SCTRL("patient")="D PATIENT^C0SDEM(.C0SGR,.C0SARY)" + S C0SCTRL("lab")="D LAB^C0SLAB(.C0SGR,.C0SARY)" + S C0SCTRL("problem")="D PROB^C0SPROB2(.C0SGR,.C0SARY)" + ; + I '$D(C0SCTRL(ZTYP)) W !,ZTYP," ","Not Supported" Q ; + N ZX + S ZX=C0SCTRL(ZTYP) + X ZX ; + ; + I '$D(C0SGR) Q ; + ; + D getGraph^C0XGET1(.ZRTN,C0SGR,ZFORM) + ; + Q + ; diff --git a/p/C0SMED.m b/p/C0SMED.m index 2568c81..de736bd 100644 --- a/p/C0SMED.m +++ b/p/C0SMED.m @@ -1,157 +1,157 @@ -C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; -MED(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of meds - ; - I $O(C0SARY("med",""))="" D Q ; - . I $D(DEBUG) W !,"No Meds" - S GRTN="" ; default to no meds - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - N MEDTRP ; MEDS TRIPLES - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - N DUPCHK S DUPCHK="" ; check for no duplicates - N ZI S ZI="" - F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; - . N SDATE,SDTMP - . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; - . . I $D(DEBUG) W !,"Expired Mediation, Skipping" - . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; - . . I $D(DEBUG) W !,"Inpatient Med, skipping" - . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; - . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" - . ; - . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) - . I SDTMP="" D ; - . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) - . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date - . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens - . I SDATE="" S SDATE="UNKNOWN" - . N DNAME,VUID,DCODE,RXNORM,SIG - . S DNAME=$G(C0SARY("med",ZI,"name@value")) - . I DNAME="" D ; - . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) - . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) - . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) - . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) - . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code - . I $P(RXNORM,"^",2)="RXNORM" D ; - . . S RXVER=$P(RXNORM,"^",3) - . . S RXNORM=$P(RXNORM,"^",1) - . E D Q ; - . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" - . . I $D(DEBUG) W !,RXNORM - . I DNAME="" D Q ; - . . I $D(DEBUG) W !,"Error No Drug Name" - . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) - . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED - . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF - . S DUPCHK(MEDGRF)="" - . I $D(DEBUG) D ; - . . W !,"Processing Medication ",MEDGRF - . . W !,DNAME - . . W !,RXNORM - . S SIG=$G(C0SARY("med",ZI,"sig")) - . I SIG["|" D ; - . . N SIGTMP - . . S SIGTMP=SIG - . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig - . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig - . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig - . K C0XFARY - . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) - . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) - . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) - . N NQTY,NQTY2,NFREQ,NFREQ2 - . S NQTY=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) - . S NQTY2=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) - . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) - . I DOSE="" S DOSE="UNKNOWN" - . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) - . I UNIT="" S UNIT="UNKNOWN" - . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) - . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) - . S NFREQ=$$ANONS^C0XF2N ; anonomous subject - . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) - . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) - . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) - . I SCHED="" S SCHED="UNKNOWN" - . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) - . I SCHUNIT="" S SCHUNIT="UNKNOWN" - . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) - . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) - . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) - . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) - . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) - . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) - . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) - . D BULKLOAD^C0XF2N(.C0XFDA) - . K C0XFDA - S GRTN=C0SGRF - q - ; -RXNFN() Q 1130590011.001 ; RxNorm Concepts file number - ; -RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF - ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR - N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT - I $G(ZVUID)="" Q "" - I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED - N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") - S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES - N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) - S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED - I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" - Q ZRSLT - ; -NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO - ; CONFORM TO NIST REQUIREMENTS - ;INPATIENT CERTIFICATION - I ZRXN=309362 S ZRXN=213169 - I ZRXN=855318 S ZRXN=855320 - I ZRXN=197361 S ZRXN=212549 - ;OUTPATIENT CERTIFICATION - I ZRXN=310534 S ZRXN=205875 - I ZRXN=617312 S ZRXN=617314 - I ZRXN=310429 S ZRXN=200801 - I ZRXN=628953 S ZRXN=628958 - I ZRXN=745679 S ZRXN=630208 - I ZRXN=311564 S ZRXN=979334 - I ZRXN=836343 S ZRXN=836370 - Q ZRXN - ; +C0SMED ; GPL - Smart Meds Processing ;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; +MED(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of meds + ; + I $O(C0SARY("med",""))="" D Q ; + . I $D(DEBUG) W !,"No Meds" + S GRTN="" ; default to no meds + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/"_ZTYP + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + N MEDTRP ; MEDS TRIPLES + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + N DUPCHK S DUPCHK="" ; check for no duplicates + N ZI S ZI="" + F S ZI=$O(C0SARY("med",ZI)) Q:ZI="" D ; + . N SDATE,SDTMP + . I $G(C0SARY("med",ZI,"vaStatus@value"))="EXPIRED" D Q ; + . . I $D(DEBUG) W !,"Expired Mediation, Skipping" + . I $G(COSARY("med",ZI,"vaType@value"))="I" D Q ; + . . I $D(DEBUG) W !,"Inpatient Med, skipping" + . I $G(COSARY("med",ZI,"vaType@value"))="V" D Q ; + . . I $D(DEBUG) W !,"IV Inpatient Med, skipping" + . ; + . S SDTMP=$G(C0SARY("med",ZI,"ordered@value")) + . I SDTMP="" D ; + . . S SDTMP=$G(C0SARY("med",ZI,"start@value")) + . S SDATE=$$FMTE^XLFDT(SDTMP,"7D") ; ordered date + . S SDATE=$TR(SDATE,"/","-") ; change slashes to hyphens + . I SDATE="" S SDATE="UNKNOWN" + . N DNAME,VUID,DCODE,RXNORM,SIG + . S DNAME=$G(C0SARY("med",ZI,"name@value")) + . I DNAME="" D ; + . . S DNAME=$G(C0SARY("med",ZI,"products.product@name")) + . S VUID=$G(C0SARY("med",ZI,"products.product.vaProduct@vuid")) + . S DCODE=$G(C0SARY("med",ZI,"products.product.vaProduct@code")) + . I DCODE="" S DCODE=$G(C0SARY("med",ZI,"id@value")) + . S RXNORM=$$RXCUI(VUID) ; look up RxNorm code + . I $P(RXNORM,"^",2)="RXNORM" D ; + . . S RXVER=$P(RXNORM,"^",3) + . . S RXNORM=$P(RXNORM,"^",1) + . E D Q ; + . . I $D(DEBUG) W !,"NO RXNORM NUMBER AVAILABLE" + . . I $D(DEBUG) W !,RXNORM + . I DNAME="" D Q ; + . . I $D(DEBUG) W !,"Error No Drug Name" + . S MEDGRF=C0SGRF_"/"_DCODE_"-"_$G(SDTMP) + . I +$D(DUPCHK(MEDGRF)) D Q ; NO DUPS ALLOWED + . . I $D(DEBUG) W !,"Found Duplicate Medication ",MEDGRF + . S DUPCHK(MEDGRF)="" + . I $D(DEBUG) D ; + . . W !,"Processing Medication ",MEDGRF + . . W !,DNAME + . . W !,RXNORM + . S SIG=$G(C0SARY("med",ZI,"sig")) + . I SIG["|" D ; + . . N SIGTMP + . . S SIGTMP=SIG + . . S SIG=$P(SIGTMP,"|",2) ; remove the drug name from the sig + . . I DNAME["FREE TXT" D ; eRx free text drug, get drug name from sig + . . . S DNAME=$P(SIGTMP,"|",1) ; eRx Drug name is stored as the first piece of the sig + . K C0XFARY + . D ADD^C0XF2N(C0SGRF,MEDGRF,"rdf:type","sp:Medication",FARY) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:belongsTo",C0SGRF,FARY) + . N DSUBJ S DSUBJ=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:drugName",DSUBJ,FARY) + . I SIG'="" D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:instructions",SIG,FARY) + . N NQTY,NQTY2,NFREQ,NFREQ2 + . S NQTY=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:quantity",NQTY,FARY) + . S NQTY2=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,NQTY,"sp:ValueAndUnit",NQTY2,FARY) + . N DOSE S DOSE=$G(C0SARY("med",ZI,"doses.dose@dose")) + . I DOSE="" S DOSE="UNKNOWN" + . N UNIT S UNIT=$G(C0SARY("med",ZI,"doses.dose@units")) + . I UNIT="" S UNIT="UNKNOWN" + . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:value",DOSE,FARY) + . D ADD^C0XF2N(C0SGRF,NQTY2,"sp:unit",UNIT,FARY) + . S NFREQ=$$ANONS^C0XF2N ; anonomous subject + . S NFREQ2=$$ANONS^C0XF2N ; anonomous subject + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:frequency",NFREQ,FARY) + . D ADD^C0XF2N(C0SGRF,NFREQ,"sp:ValueAndUnit",NFREQ2,FARY) + . N SCHED S SCHED=$G(C0SARY("med",ZI,"doses.dose@schedule")) + . I SCHED="" S SCHED="UNKNOWN" + . N SCHUNIT S SCHUNIT=$G(C0SARY("med",ZI,"doses.dose@route")) + . I SCHUNIT="" S SCHUNIT="UNKNOWN" + . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:value",SCHED,FARY) + . D ADD^C0XF2N(C0SGRF,NFREQ2,"sp:unit",SCHUNIT,FARY) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"rdf:type","sp:CodedValue",FARY) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"sp:code","rxnorm:"_RXNORM,FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","sp:Code",FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:title",DNAME,FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"sp:system","rxnorm:",FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"dcterms:identifier",RXNORM,FARY) + . D ADD^C0XF2N(C0SGRF,DSUBJ,"dcterms:title",DNAME,FARY) + . D ADD^C0XF2N(C0SGRF,MEDGRF,"sp:startDate",SDATE,FARY) + . D ADD^C0XF2N(C0SGRF,"rxnorm:"_RXNORM,"rdf:type","http://smartplatforms.org/terms/codes/RxNorm_Semantic",FARY) + . D BULKLOAD^C0XF2N(.C0XFDA) + . K C0XFDA + S GRTN=C0SGRF + q + ; +RXNFN() Q 1130590011.001 ; RxNorm Concepts file number + ; +RXCUI(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF + ; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR + N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT + I $G(ZVUID)="" Q "" + I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED + N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID") + S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES + N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01) + S ZRXN=$$NISTMAP(ZRXN) ; CHANGE THE CODE IF NEEDED + I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F" + Q ZRSLT + ; +NISTMAP(ZRXN) ; EXTRINSIC WHICH MAPS SOME RXNORM NUMBERS TO + ; CONFORM TO NIST REQUIREMENTS + ;INPATIENT CERTIFICATION + I ZRXN=309362 S ZRXN=213169 + I ZRXN=855318 S ZRXN=855320 + I ZRXN=197361 S ZRXN=212549 + ;OUTPATIENT CERTIFICATION + I ZRXN=310534 S ZRXN=205875 + I ZRXN=617312 S ZRXN=617314 + I ZRXN=310429 S ZRXN=200801 + I ZRXN=628953 S ZRXN=628958 + I ZRXN=745679 S ZRXN=630208 + I ZRXN=311564 S ZRXN=979334 + I ZRXN=836343 S ZRXN=836370 + Q ZRXN + ; diff --git a/p/C0SMXMLB.m b/p/C0SMXMLB.m index ecefc52..45f54e5 100644 --- a/p/C0SMXMLB.m +++ b/p/C0SMXMLB.m @@ -1,106 +1,106 @@ -MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver. - ;;8.0;KERNEL;;;Build 2 - QUIT - ; - ;DOC - The top level tag - ;DOCTYPE - Want to include a DOCTYPE node - ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, -START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. - K ^TMP("MXMLBLD",$J) - S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 - I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 - I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) - D:$L($G(DOCTYPE)) OUTPUT("") D OUTPUT("<"_DOC_">") - Q - ; -END ;Call this once to close out the document - D OUTPUT("") - I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) - K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") - Q - ; -ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item - N I,X - S ATT=$G(ATT) - I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q - D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"") - Q - ;DOITEM is a callback to output the lower level. -MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule - N I,X,S - S ATT=$G(ATT) - D PUSH($G(INDENT),TAG,.ATT) - D @DOITEM - D POP - Q - ; -ATT(ATT) ;Output a string of attributes - I $D(ATT)<9 Q "" - N I,S,V - S S="",I="" - F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) - Q S - ; -Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 - ;I X'[$C(34) Q $C(34)_X_$C(34) - I X'[$C(39) Q $C(39)_X_$C(39) - ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" - N Q,Y,I,Z S Q=$C(39),(Y,Z)="" - F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q - S Y=Y_$P(X,Q,$L(X,Q)) - ;Q $C(34)_Y_$C(34) - Q $C(39)_Y_$C(39) - ; -XMLHDR() ; -- provides current XML standard header - Q "" - ; -OUTPUT(S) ;Output - N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) - I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q - W S,! - Q - ; -CHARCHK(STR) ; -- replace xml character limits with entities - N A,I,X,Y,Z,NEWSTR - S (Y,Z)="" - ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z - ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" - I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) - I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" - I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" - I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" - I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" - ; - S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)) - QUIT STR - ; -COMMENT(VAL) ;Add Comments - N I,L - ;I $D($G(VAL))=1 D OUTPUT("") Q - I $D(VAL) D OUTPUT("") Q ;CHANGED BY GPL FOR GTM - S I="",L="") - Q - ; -PUSH(INDENT,TAG,ATT) ;Write a TAG and save. - N CNT - S ATT=$G(ATT) - D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") - S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG - Q - ; -POP ;Write last pushed tag and pop - N CNT,TAG,INDENT,X - S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 - S INDENT=+X,TAG=$P(X,"^",2) - D OUTPUT($$BLS(INDENT)_"") - Q - ; -BLS(I) ;Return INDENT string - N S - S S="",I=$G(I) S:I>0 $P(S," ",I)=" " - Q S - ; -INDENT() ;Renturn indent level - Q +$G(^TMP("MXMLBLD",$J,"STK")) +MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55 - Smart Container Ver. + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + QUIT + ; + ;DOC - The top level tag + ;DOCTYPE - Want to include a DOCTYPE node + ;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J, +START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining. + K ^TMP("MXMLBLD",$J) + S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0 + I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1 + I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) + D:$L($G(DOCTYPE)) OUTPUT("") D OUTPUT("<"_DOC_">") + Q + ; +END ;Call this once to close out the document + D OUTPUT("") + I '$G(^TMP("MXMLBLD",$J,"CNT")) K ^TMP("MXMLBLD",$J) + K ^TMP("MXMLBLD",$J,"DOC"),^("CNT"),^("STK") + Q + ; +ITEM(INDENT,TAG,ATT,VALUE) ;Output a Item + N I,X + S ATT=$G(ATT) + I '$D(VALUE) D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_" />") Q + D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">"_$$CHARCHK(VALUE)_"") + Q + ;DOITEM is a callback to output the lower level. +MULTI(INDENT,TAG,ATT,DOITEM) ;Output a Multipule + N I,X,S + S ATT=$G(ATT) + D PUSH($G(INDENT),TAG,.ATT) + D @DOITEM + D POP + Q + ; +ATT(ATT) ;Output a string of attributes + I $D(ATT)<9 Q "" + N I,S,V + S S="",I="" + F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I)) + Q S + ; +Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11 + ;I X'[$C(34) Q $C(34)_X_$C(34) + I X'[$C(39) Q $C(39)_X_$C(39) + ;N Q,Y,I,Z S Q=$C(34),(Y,Z)="" + N Q,Y,I,Z S Q=$C(39),(Y,Z)="" + F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q + S Y=Y_$P(X,Q,$L(X,Q)) + ;Q $C(34)_Y_$C(34) + Q $C(39)_Y_$C(39) + ; +XMLHDR() ; -- provides current XML standard header + Q "" + ; +OUTPUT(S) ;Output + N C S C=$G(^TMP("MXMLBLD",$J,"CNT")) + I C S ^TMP("MXMLBLD",$J,C)=S,^TMP("MXMLBLD",$J,"CNT")=C+1 Q + W S,! + Q + ; +CHARCHK(STR) ; -- replace xml character limits with entities + N A,I,X,Y,Z,NEWSTR + S (Y,Z)="" + ;IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z + ;. FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&" + I STR["&" F I=1:1:$L(STR,"&")-1 S STR=$P(STR,"&",1,I)_"&"_$P(STR,"&",I+1,999) + I STR["<" F S STR=$PIECE(STR,"<",1)_"<"_$PIECE(STR,"<",2,99) Q:STR'["<" + I STR[">" F S STR=$PIECE(STR,">",1)_">"_$PIECE(STR,">",2,99) Q:STR'[">" + I STR["'" F S STR=$PIECE(STR,"'",1)_"'"_$PIECE(STR,"'",2,99) Q:STR'["'" + I STR["""" F S STR=$PIECE(STR,"""",1)_"""_$PIECE(STR,"""",2,99) Q:STR'["""" + ; + S STR=$TR(STR,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)) + QUIT STR + ; +COMMENT(VAL) ;Add Comments + N I,L + ;I $D($G(VAL))=1 D OUTPUT("") Q + I $D(VAL) D OUTPUT("") Q ;CHANGED BY GPL FOR GTM + S I="",L="") + Q + ; +PUSH(INDENT,TAG,ATT) ;Write a TAG and save. + N CNT + S ATT=$G(ATT) + D OUTPUT($$BLS($G(INDENT))_"<"_TAG_$$ATT(.ATT)_">") + S CNT=$G(^TMP("MXMLBLD",$J,"STK"))+1,^TMP("MXMLBLD",$J,"STK")=CNT,^TMP("MXMLBLD",$J,"STK",CNT)=INDENT_"^"_TAG + Q + ; +POP ;Write last pushed tag and pop + N CNT,TAG,INDENT,X + S CNT=$G(^TMP("MXMLBLD",$J,"STK")),X=^TMP("MXMLBLD",$J,"STK",CNT),^TMP("MXMLBLD",$J,"STK")=CNT-1 + S INDENT=+X,TAG=$P(X,"^",2) + D OUTPUT($$BLS(INDENT)_"") + Q + ; +BLS(I) ;Return INDENT string + N S + S S="",I=$G(I) S:I>0 $P(S," ",I)=" " + Q S + ; +INDENT() ;Renturn indent level + Q +$G(^TMP("MXMLBLD",$J,"STK")) diff --git a/p/C0SNHIN.m b/p/C0SNHIN.m index 7129123..c051310 100644 --- a/p/C0SNHIN.m +++ b/p/C0SNHIN.m @@ -1,324 +1,324 @@ -C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q -EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT - ; - K GARY,GNARY,GIDX,C0SDOCID - K ZRTN - N GN - K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL - K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM - K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS - D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML - S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL - S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML - D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS - I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 - ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) - Q - ; -PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE - ; - N ZG - S ZG=$NA(^TMP("PQRIXML",$J)) - K @ZG - D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML - N C0SDOCID - S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML - D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS - I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 - Q - ; -PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE - ; - ;N GG - D GETXML^C0SMXP("GG","PQRI ONE MEASURE") - D PROCESS(ZRTN,"GG","root",1) - Q - ; -PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML - ; ZRTN IS PASSED BY REFERENCE - ; ZXML IS PASSED BY NAME - ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED - ; - N GN - S GN=$NA(^TMP("C0SPROCESS",$J)) - K @GN - M @GN=@ZXML - S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML - K @GN - D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS - I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 - Q - ; -LOADSMRT ; - ; - K ^GPL("SMART") - S GN=$NA(^GPL("SMART",1)) - I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" - Q - ; -SMART ; TRY IT WITH SMART - ; - S GN=$NA(^GPL("SMART")) - ;K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"SMART") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -CCR ; TRY IT WITH A CCR - ; - S GN=$NA(^GPL("CCR")) - ;K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"CCR") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -MED ; TRY IT WITH A CCR MED SECTION - ; - S GN=$NA(^GPL("MED")) - K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"MED") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -CCD ; TRY IT WITH A CCD - ; - S GN=$NA(^GPL("CCD")) - ;K ^TMP("MXMLDOM",$J) - K ^TMP("MXMLERR",$J) - S C0SDOCID=$$PARSE(GN,"CCD") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") - ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG - Q - ; -TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") - ; PARSED WITH MXML - ; RUN THROUGH XPATH - K GARY,GIDX,C0SDOCID - S GN=$NA(^GPL("NHIN")) - ;S GN=$NA(^GPL("DOMI")) - S C0SDOCID=$$PARSE(GN,"GPLTEST") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") - K ^GPL("GNARY") - M ^GPL("GNARY")=GNARY - Q - ; -TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") - ; - S GN=$NA(^GPL("GNARY")) - S C0SDOCID=$$DOMI^C0SDOM(GN,,"results") - D OUTXML^C0SDOM("G",C0SDOCID) - K ^GPL("DOMI") - M ^GPL("DOMI")=G - Q - ; -TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") - ; PARSED WITH MXML - ; RUN THROUGH XPATH - K GARY,GIDX,C0SDOCID - ;S GN=$NA(^GPL("NHIN")) - S GN=$NA(^GPL("DOMI")) - S C0SDOCID=$$PARSE(GN,"GPLTEST") - D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") - Q - ; -DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE - ; THE XPATH INDEX ZXIDX, PASSED BY NAME - ; THE XPATH ARRAY XPARY, PASSED BY NAME - ; ZOID IS THE STARTING OID - ; ZPATH IS THE STARTING XPATH, USUALLY "/" - ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE - ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT - I $G(ZREDUX)="" S ZREDUX="" - N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY - N NEWNUM S NEWNUM="" - I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" - S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE - I $G(ZREDUX)'="" D ; REDUX PROVIDED? - . N GT S GT=$P(NEWPATH,ZREDUX,2) - . I GT'="" S NEWPATH=GT - S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX - N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE - I $D(GA) D ; PROCESS THE ATTRIBUTES - . N ZI S ZI="" - . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE - . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE - . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY - . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE - N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE - I $D(GD(2)) D ; - . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY - E I $D(GD(1)) D ; - . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY - . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY - N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD - I ZFRST'=0 D ; THERE IS A CHILD - . N ZNUM - . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE - . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD - N GNXT S GNXT=$$NXTSIB(ZOID) - I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES - I GNXT'=0 D ; - . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? - . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES - . . N ZNUM S ZNUM=1 ; - . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB - . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB - Q - ; -ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY - ; - N ZZI,ZZJ,ZZN - S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY - I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE - S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY - S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . - I ZZI'["]" D ; A SINGLETON - . S ZZN=1 - E D ; THERE IS AN [x] OCCURANCE - . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE - . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] - I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE - Q - ; -PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME - ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW - ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML - ;Q $$EN^MXMLDOM(INXML) - Q $$EN^MXMLDOM(INXML,"W") - ; -ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE - N ZN - ;I $$TAG(ZOID)["entry" B - S ZN=$$NXTSIB(ZOID) - I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG - Q 0 - ; -FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID - Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) - ; -PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID - Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) - ; -ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID - S HANDLE=C0SDOCID - K @RTN - D GETTXT^MXMLDOM("A") - Q - ; -TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE - ;I ZOID=149 B ;GPLTEST - N X,Y - S Y="" - S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE - I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y - I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) - Q Y - ; -NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING - Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) - ; -DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE - ;N ZT,ZN S ZT="" - ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) - ;Q $G(@C0SDOM@(ZOID,"T",1)) - S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) - Q - ; -OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM - ; - S C0SDOCID=INID - D START^C0SMXMLB($$TAG(1),,"G") - D NDOUT($$FIRST(1)) - D END^C0SMXMLB ;END THE DOCUMENT - M @ZRTN=^TMP("MXMLBLD",$J) - K ^TMP("MXMLBLD",$J) - Q - ; -NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE - N ZI S ZI=$$FIRST(ZOID) - I ZI'=0 D ; THERE IS A CHILD - . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT - . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN - E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT - . ;W "DOING",ZOID,! - . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA - . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES - . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN - I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING - . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS - Q - ; -WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE - ; - N GN,GN2 - D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML - S GN2=$NA(@GN@(1)) - W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") - Q - ; -TESTNARY ; TEST MAKING A NHIN ARRAY - N ZI S ZI="" - N ZH ; DOM HANDLE - D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM - S ZH=C0SDOCID ; SET THE HANDLE - N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) - F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE - . N ZATT - . D MNARY(.ZATT,ZH,ZI) - . N ZPRE,ZN - . S ZPRE=$$PRE(ZI) - . S ZN=$P(ZPRE,",",2) - . S ZPRE=$P(ZPRE,",",1) - . ;I $D(ZATT) ZWR ZATT - . N ZJ S ZJ="" - . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE - . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! - . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) - Q - ; -PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE - ; - N GI,GI2,GPT,GJ,GN - S GI=$$PARENT(ZNODE) ; PARENT NODE - I GI=0 Q "" ; NO PARENT - S GPT=$$TAG(GI) ; TAG OF PARENT - S GI2=$$PARENT(GI) ; PARENT OF PARENT - I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT - S GJ=$$FIRST(GI) ; NODE OF FIRST SIB - I GJ=ZNODE Q:$$TAG(GI)_",1" - F GN=2:1 Q:GJ=ZNODE D ; - . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING - Q GPT_","_GN - ; -MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE - ; RETURNED IN ZRTN, PASSED BY REFERENCE - ; ZHANDLE IS THE DOM DOCUMENT ID - ; ZOID IS THE DOM NODE - D ATT("ZRTN",ZOID) - Q - ; +C0SNHIN ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2011-2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q +EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT + ; + K GARY,GNARY,GIDX,C0SDOCID + K ZRTN + N GN + K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL + K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM + K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS + D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML + S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL + S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML + D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 + ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP)) + Q + ; +PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE + ; + N ZG + S ZG=$NA(^TMP("PQRIXML",$J)) + K @ZG + D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML + N C0SDOCID + S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML + D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 + Q + ; +PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE + ; + ;N GG + D GETXML^C0SMXP("GG","PQRI ONE MEASURE") + D PROCESS(ZRTN,"GG","root",1) + Q + ; +PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML + ; ZRTN IS PASSED BY REFERENCE + ; ZXML IS PASSED BY NAME + ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED + ; + N GN + S GN=$NA(^TMP("C0SPROCESS",$J)) + K @GN + M @GN=@ZXML + S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML + K @GN + D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS + I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1 + Q + ; +LOADSMRT ; + ; + K ^GPL("SMART") + S GN=$NA(^GPL("SMART",1)) + I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED" + Q + ; +SMART ; TRY IT WITH SMART + ; + S GN=$NA(^GPL("SMART")) + ;K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"SMART") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +CCR ; TRY IT WITH A CCR + ; + S GN=$NA(^GPL("CCR")) + ;K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"CCR") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +MED ; TRY IT WITH A CCR MED SECTION + ; + S GN=$NA(^GPL("MED")) + K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"MED") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +CCD ; TRY IT WITH A CCD + ; + S GN=$NA(^GPL("CCD")) + ;K ^TMP("MXMLDOM",$J) + K ^TMP("MXMLERR",$J) + S C0SDOCID=$$PARSE(GN,"CCD") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/") + ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG + Q + ; +TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") + ; PARSED WITH MXML + ; RUN THROUGH XPATH + K GARY,GIDX,C0SDOCID + S GN=$NA(^GPL("NHIN")) + ;S GN=$NA(^GPL("DOMI")) + S C0SDOCID=$$PARSE(GN,"GPLTEST") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") + K ^GPL("GNARY") + M ^GPL("GNARY")=GNARY + Q + ; +TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI") + ; + S GN=$NA(^GPL("GNARY")) + S C0SDOCID=$$DOMI^C0SDOM(GN,,"results") + D OUTXML^C0SDOM("G",C0SDOCID) + K ^GPL("DOMI") + M ^GPL("DOMI")=G + Q + ; +TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN") + ; PARSED WITH MXML + ; RUN THROUGH XPATH + K GARY,GIDX,C0SDOCID + ;S GN=$NA(^GPL("NHIN")) + S GN=$NA(^GPL("DOMI")) + S C0SDOCID=$$PARSE(GN,"GPLTEST") + D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/") + Q + ; +DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE + ; THE XPATH INDEX ZXIDX, PASSED BY NAME + ; THE XPATH ARRAY XPARY, PASSED BY NAME + ; ZOID IS THE STARTING OID + ; ZPATH IS THE STARTING XPATH, USUALLY "/" + ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE + ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT + I $G(ZREDUX)="" S ZREDUX="" + N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY + N NEWNUM S NEWNUM="" + I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]" + S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE + I $G(ZREDUX)'="" D ; REDUX PROVIDED? + . N GT S GT=$P(NEWPATH,ZREDUX,2) + . I GT'="" S NEWPATH=GT + S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX + N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE + I $D(GA) D ; PROCESS THE ATTRIBUTES + . N ZI S ZI="" + . F S ZI=$O(GA(ZI)) Q:ZI="" D ; FOR EACH ATTRIBUTE + . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE + . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY + . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE + N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE + I $D(GD(2)) D ; + . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY + E I $D(GD(1)) D ; + . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY + . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY + N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD + I ZFRST'=0 D ; THERE IS A CHILD + . N ZNUM + . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE + . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD + N GNXT S GNXT=$$NXTSIB(ZOID) + I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES + I GNXT'=0 D ; + . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE? + . I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES + . . N ZNUM S ZNUM=1 ; + . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB + . E D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB + Q + ; +ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY + ; + N ZZI,ZZJ,ZZN + S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY + I ZZI="" Q ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE + S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY + S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH . + I ZZI'["]" D ; A SINGLETON + . S ZZN=1 + E D ; THERE IS AN [x] OCCURANCE + . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE + . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X] + I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE + Q + ; +PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME + ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW + ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML + ;Q $$EN^MXMLDOM(INXML) + Q $$EN^MXMLDOM(INXML,"W") + ; +ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE + N ZN + ;I $$TAG(ZOID)["entry" B + S ZN=$$NXTSIB(ZOID) + I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG + Q 0 + ; +FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID + Q $$CHILD^MXMLDOM(C0SDOCID,ZOID) + ; +PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID + Q $$PARENT^MXMLDOM(C0SDOCID,ZOID) + ; +ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID + S HANDLE=C0SDOCID + K @RTN + D GETTXT^MXMLDOM("A") + Q + ; +TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE + ;I ZOID=149 B ;GPLTEST + N X,Y + S Y="" + S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE + I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y + I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID) + Q Y + ; +NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING + Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID) + ; +DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE + ;N ZT,ZN S ZT="" + ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID)) + ;Q $G(@C0SDOM@(ZOID,"T",1)) + S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT) + Q + ; +OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM + ; + S C0SDOCID=INID + D START^C0SMXMLB($$TAG(1),,"G") + D NDOUT($$FIRST(1)) + D END^C0SMXMLB ;END THE DOCUMENT + M @ZRTN=^TMP("MXMLBLD",$J) + K ^TMP("MXMLBLD",$J) + Q + ; +NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE + N ZI S ZI=$$FIRST(ZOID) + I ZI'=0 D ; THERE IS A CHILD + . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT + . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN + E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT + . ;W "DOING",ZOID,! + . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA + . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES + . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN + I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING + . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS + Q + ; +WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE + ; + N GN,GN2 + D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML + S GN2=$NA(@GN@(1)) + W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/") + Q + ; +TESTNARY ; TEST MAKING A NHIN ARRAY + N ZI S ZI="" + N ZH ; DOM HANDLE + D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM + S ZH=C0SDOCID ; SET THE HANDLE + N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH)) + F S ZI=$O(@ZD@(ZI)) Q:ZI="" D ; FOR EACH NODE + . N ZATT + . D MNARY(.ZATT,ZH,ZI) + . N ZPRE,ZN + . S ZPRE=$$PRE(ZI) + . S ZN=$P(ZPRE,",",2) + . S ZPRE=$P(ZPRE,",",1) + . ;I $D(ZATT) ZWR ZATT + . N ZJ S ZJ="" + . F S ZJ=$O(ZATT(ZJ)) Q:ZJ="" D ; FOR EACH ATTRIBUTE + . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),! + . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ) + Q + ; +PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE + ; + N GI,GI2,GPT,GJ,GN + S GI=$$PARENT(ZNODE) ; PARENT NODE + I GI=0 Q "" ; NO PARENT + S GPT=$$TAG(GI) ; TAG OF PARENT + S GI2=$$PARENT(GI) ; PARENT OF PARENT + I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT + S GJ=$$FIRST(GI) ; NODE OF FIRST SIB + I GJ=ZNODE Q:$$TAG(GI)_",1" + F GN=2:1 Q:GJ=ZNODE D ; + . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING + Q GPT_","_GN + ; +MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE + ; RETURNED IN ZRTN, PASSED BY REFERENCE + ; ZHANDLE IS THE DOM DOCUMENT ID + ; ZOID IS THE DOM NODE + D ATT("ZRTN",ZOID) + Q + ; diff --git a/p/C0SNHINV.m b/p/C0SNHINV.m index dfa52d5..c3acfde 100644 --- a/p/C0SNHINV.m +++ b/p/C0SNHINV.m @@ -1,118 +1,118 @@ -C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version - ;;1.0;C0S;**1**;Oct 25, 2010;Build 11 - ; - ; External References DBIA# - ; ------------------- ----- - ; ^DPT 10035 - ; ^SC 10040 - ; DIQ 2056 - ; MPIF001 2701 - ; VASITE 10112 - ; XLFDT 10103 - ; XLFSTR 10104 - ; XUAF4 2171 - ; -GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n) - ; RPC = NHIN GET VISTA DATA - N ICN,NHINI,NHINTOTL - S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN - ; - ; parse & validate input parameters - S ICN=+$P(DFN,";",2),DFN=+$G(DFN) - I 'DFN S DFN=+$$GETDFN^MPIF001(ICN) - I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ - S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL - S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999 - I START,STOP,STOP") - F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D - . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q - . D @(RTN_"(DFN,START,STOP,MAX,ID)") - D ADD("") - ; - I $G(NHINTOTL),$G(@NHIN@(1))="" S @NHIN@(1)="" - ; -GTQ ; end - Q - ; -RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X - S X=$$UP^XLFSTR(X),Y="NHINV" - I X="ACCESSION" S Y="NHINVLRA" - I X="ALLERGY" S Y="NHINVART" - I X="APPOINTMENT" S Y="NHINVAPT" - ; X="CONSULT" S Y="NHINVCON" - I X="DOCUMENT" S Y="NHINVTIU" - I X="IMMUNIZATION" S Y="NHINVIMM" - I X="LAB" S Y="NHINVLR" - I X="PANEL" S Y="NHINVLRO" - I X="MED" S Y="NHINVPS" - I X="RX" S Y="NHINVPSO" - ; X="ORDER" S Y="NHINVOR" - I X="PATIENT" S Y="NHINVPT" - I X="PROBLEM" S Y="NHINVPL" - I X="PROCEDURE" S Y="NHINVPRC" - I X="SURGERY" S Y="NHINVSR" - I X="VISIT" S Y="NHINVSIT" - I X="VITAL" S Y="NHINVIT" - I X="RADIOLOGY" S Y="NHINVRA" - I X="NEW" S Y="NHINVPR" - Q Y - ; -ALL() ; -- return string for all types of data - ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure" - Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure" - ; -ERR(X,VAL) ; -- return error message - N MSG S MSG="Error" - I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found" - I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized" - I X=99 S MSG="Unknown request" - ; - D ADD("") - D ADD(""_MSG_"") - D ADD("") - Q - ; -ESC(X) ; -- escape outgoing XML - ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache - ; - N I,Y,QOT S QOT="""" - S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I) - S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I) - S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I) - S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I) - S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I) - Q Y - ; -ADD(X) ; Add a line @NHIN@(n)=X - S NHINI=$G(NHINI)+1 - S @NHIN@(NHINI)=X - Q - ; -STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string - N I,X,Y S Y="" - S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0)) - S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I))) - F S I=$O(ARRAY(I)) Q:I<1 D - . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I)) - . I $E(X)=" " S Y=Y_$C(13,10)_X Q - . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X - Q Y - ; -FAC(X) ; -- return Institution file station# for location X - N HLOC,FAC,Y0,Y S Y="" - S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien - ; Get P:4 via Med Ctr Div, if not directly linked - I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I") - S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn# - S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name - I $L(Y),'Y S $P(Y,U)=FAC - Q Y - ; -VUID(IEN,FILE) ; -- Return VUID for item - Q $$GET1^DIQ(FILE,IEN_",",99.99) +C0SNHINV ;SLC/MKB - Serve VistA data as XML via RPC - Smart Container Version + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ; + ; External References DBIA# + ; ------------------- ----- + ; ^DPT 10035 + ; ^SC 10040 + ; DIQ 2056 + ; MPIF001 2701 + ; VASITE 10112 + ; XLFDT 10103 + ; XLFSTR 10104 + ; XUAF4 2171 + ; +GET(NHIN,DFN,TYPE,START,STOP,MAX,ID) ; -- Return search results as XML in @NHIN@(n) + ; RPC = NHIN GET VISTA DATA + N ICN,NHINI,NHINTOTL + S NHIN=$NA(^TMP("NHINV",$J)) K @NHIN + ; + ; parse & validate input parameters + S ICN=+$P(DFN,";",2),DFN=+$G(DFN) + I 'DFN S DFN=+$$GETDFN^MPIF001(ICN) + I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ + S TYPE=$G(TYPE) I TYPE="" S TYPE=$$ALL + S:'$G(START) START=1410101 S:'$G(STOP) STOP=9999998 S:'$G(MAX) MAX=9999 + I START,STOP,STOP") + F NHINP=1:1:$L(NHINTYPE,";") S TYPE=$P(NHINTYPE,";",NHINP) I $L(TYPE) D + . S RTN="EN^"_$$RTN(TYPE) Q:'$L($T(@RTN)) ;D ERR(2) Q + . D @(RTN_"(DFN,START,STOP,MAX,ID)") + D ADD("") + ; + I $G(NHINTOTL),$G(@NHIN@(1))="" S @NHIN@(1)="" + ; +GTQ ; end + Q + ; +RTN(X) ; -- Return name of NHINVxxx routine for clinical domain X + S X=$$UP^XLFSTR(X),Y="NHINV" + I X="ACCESSION" S Y="NHINVLRA" + I X="ALLERGY" S Y="NHINVART" + I X="APPOINTMENT" S Y="NHINVAPT" + ; X="CONSULT" S Y="NHINVCON" + I X="DOCUMENT" S Y="NHINVTIU" + I X="IMMUNIZATION" S Y="NHINVIMM" + I X="LAB" S Y="NHINVLR" + I X="PANEL" S Y="NHINVLRO" + I X="MED" S Y="NHINVPS" + I X="RX" S Y="NHINVPSO" + ; X="ORDER" S Y="NHINVOR" + I X="PATIENT" S Y="NHINVPT" + I X="PROBLEM" S Y="NHINVPL" + I X="PROCEDURE" S Y="NHINVPRC" + I X="SURGERY" S Y="NHINVSR" + I X="VISIT" S Y="NHINVSIT" + I X="VITAL" S Y="NHINVIT" + I X="RADIOLOGY" S Y="NHINVRA" + I X="NEW" S Y="NHINVPR" + Q Y + ; +ALL() ; -- return string for all types of data + ;Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;document;procedure" + Q "patient;allergy;problem;vital;lab;med;immunization;visit;appointment;procedure" + ; +ERR(X,VAL) ; -- return error message + N MSG S MSG="Error" + I X=1 S MSG="Patient with dfn '"_$G(VAL)_"' not found" + I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized" + I X=99 S MSG="Unknown request" + ; + D ADD("") + D ADD(""_MSG_"") + D ADD("") + Q + ; +ESC(X) ; -- escape outgoing XML + ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache + ; + N I,Y,QOT S QOT="""" + S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I) + S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I) + S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I) + S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I) + S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I) + Q Y + ; +ADD(X) ; Add a line @NHIN@(n)=X + S NHINI=$G(NHINI)+1 + S @NHIN@(NHINI)=X + Q + ; +STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string + N I,X,Y S Y="" + S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0)) + S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I))) + F S I=$O(ARRAY(I)) Q:I<1 D + . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I)) + . I $E(X)=" " S Y=Y_$C(13,10)_X Q + . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X + Q Y + ; +FAC(X) ; -- return Institution file station# for location X + N HLOC,FAC,Y0,Y S Y="" + S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4) ;Institution ien + ; Get P:4 via Med Ctr Div, if not directly linked + I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(40.8,+$P(HLOC,U,15)_",",.07,"I") + S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn# + S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name + I $L(Y),'Y S $P(Y,U)=FAC + Q Y + ; +VUID(IEN,FILE) ; -- Return VUID for item + Q $$GET1^DIQ(FILE,IEN_",",99.99) diff --git a/p/C0SPROB.m b/p/C0SPROB.m index 3f85b31..7d815ea 100644 --- a/p/C0SPROB.m +++ b/p/C0SPROB.m @@ -1,323 +1,323 @@ -C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; sample VistA NHIN problem list - ; - ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 - ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 - ;^TMP("C0STBL",91,"problem",1,"id@value")=100 - ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" - ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 - ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",1,"status@value")="A" - ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 - ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 - ;^TMP("C0STBL",91,"problem",2,"id@value")=108 - ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" - ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 - ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",2,"status@value")="A" - ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 - ;^TMP("C0STBL",91,"problem",3,"id@value")=109 - ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" - ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 - ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",3,"status@value")="A" - ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"id@value")=115 - ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",4,"status@value")="A" - ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"id@value")=116 - ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",5,"status@value")="A" - ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"id@value")=117 - ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",6,"status@value")="A" - ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"id@value")=118 - ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",7,"status@value")="A" - ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" - ;^TMP("C0STBL",91,"problem",8,"id@value")=119 - ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," - ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",8,"status@value")="A" - ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 - ; - ; sample Smart lab result triples - ; - ;G("node16rk1fgdvx10882","code")="snomed:40930008" - ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" - ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11051","code")="snomed:188155002" - ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11073","code")="snomed:353295004" - ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" - ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11089","code")="snomed:54302000" - ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" - ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11351","code")="snomed:38341003" - ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" - ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11390","code")="snomed:44054006" - ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" - ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11558","code")="snomed:195967001" - ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" - ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11578","code")="snomed:254837009" - ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11687","code")="snomed:8517006" - ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" - ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11716","code")="snomed:55822004" - ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" - ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" - ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" - ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" - ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" - ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" - ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" - ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" - ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" - ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" - ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" - ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" - ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" - ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" - ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" - ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" - ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" - ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" - ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" - ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" - ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" - ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" - ;G("snomed:188155002","dcterms:identifier")=188155002 - ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("snomed:188155002","rdf:type")="sp:Code" - ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:195967001","dcterms:identifier")=195967001 - ;G("snomed:195967001","dcterms:title")="Asthma" - ;G("snomed:195967001","rdf:type")="sp:Code" - ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:254837009","dcterms:identifier")=254837009 - ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("snomed:254837009","rdf:type")="sp:Code" - ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:353295004","dcterms:identifier")=353295004 - ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" - ;G("snomed:353295004","rdf:type")="sp:Code" - ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:38341003","dcterms:identifier")=38341003 - ;G("snomed:38341003","dcterms:title")="Essential hypertension" - ;G("snomed:38341003","rdf:type")="sp:Code" - ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:40930008","dcterms:identifier")=40930008 - ;G("snomed:40930008","dcterms:title")="Hypothyroidism" - ;G("snomed:40930008","rdf:type")="sp:Code" - ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:44054006","dcterms:identifier")=44054006 - ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" - ;G("snomed:44054006","rdf:type")="sp:Code" - ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:54302000","dcterms:identifier")=54302000 - ;G("snomed:54302000","dcterms:title")="Disorder of breast" - ;G("snomed:54302000","rdf:type")="sp:Code" - ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:55822004","dcterms:identifier")=55822004 - ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" - ;G("snomed:55822004","rdf:type")="sp:Code" - ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:8517006","dcterms:identifier")=8517006 - ;G("snomed:8517006","dcterms:title")="History of tobacco use" - ;G("snomed:8517006","rdf:type")="sp:Code" - ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" - - ; -PROB(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of problems - ; - I $O(C0SARY("problem",""))="" D Q ; - . I $D(DEBUG) W !,"No Problems" - S GRTN="" ; default to no problems - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/problems" - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - D STARTADD^C0XF2N ; initialize to create triples - ; - N ZI S ZI="" - F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; - . N LRN,ZR ; ZR is the local array for building the new triples - . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result - . ; - . N PROBID ; unique Id for this problem - . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number - . ; - . ; i don't like this because the same problems gets a - . ; different ID every time it's reported. Can't trace it back to VistA - . ; I'd rather be using id@value ie "id@value")="118" - . ; - . N SNOMED S SNOMED=$G(@LRN@("icd@value")) - . N SNOGRF S SNOGRF="snomed:"_SNOMED - . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) - . I $D(DEBUG) D ; - . . W !,"Processing Problem List ",PROBID - . . W !,"problem: ",SNOTIT - . . W !,"code: ",SNOMED - . ; - . ; first do the base result graph - . ; - . S ZR("rdf:type")="sp:Problem" - . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems - . ; ie /vista/smart/99912345/problems - . ; - . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name - . S ZR("sp:problemName")=PROBNAME - . ; - . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) - . S ZR("sp:startDate")=STARTDT - . ; - . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples - . K ZR ; clean up - . ; - . ; create the problemName graph - . ; - . S ZR("rdf:type")="sp:CodedValue" - . S ZR("sp:code")="snomed:"_SNOMED - . S ZR("dcterms:title")=$G(@LRN@("name@value")) - . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) - . K ZR - . ; - . ; create snomed graph - . ; - . S ZR("rdf:type")="sp:Code" - . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" - . S ZR("dcterms:identifier")=SNOMED - . S ZR("dcterms:title")=SNOTIT - . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) - . K ZR - . ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; \ No newline at end of file +C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; sample VistA NHIN problem list + ; + ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 + ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 + ;^TMP("C0STBL",91,"problem",1,"id@value")=100 + ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" + ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 + ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",1,"status@value")="A" + ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 + ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 + ;^TMP("C0STBL",91,"problem",2,"id@value")=108 + ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" + ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 + ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",2,"status@value")="A" + ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 + ;^TMP("C0STBL",91,"problem",3,"id@value")=109 + ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" + ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 + ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",3,"status@value")="A" + ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"id@value")=115 + ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",4,"status@value")="A" + ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"id@value")=116 + ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",5,"status@value")="A" + ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"id@value")=117 + ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",6,"status@value")="A" + ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"id@value")=118 + ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",7,"status@value")="A" + ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" + ;^TMP("C0STBL",91,"problem",8,"id@value")=119 + ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," + ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",8,"status@value")="A" + ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 + ; + ; sample Smart lab result triples + ; + ;G("node16rk1fgdvx10882","code")="snomed:40930008" + ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" + ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11051","code")="snomed:188155002" + ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11073","code")="snomed:353295004" + ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" + ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11089","code")="snomed:54302000" + ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" + ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11351","code")="snomed:38341003" + ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" + ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11390","code")="snomed:44054006" + ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" + ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11558","code")="snomed:195967001" + ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" + ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11578","code")="snomed:254837009" + ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11687","code")="snomed:8517006" + ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" + ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11716","code")="snomed:55822004" + ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" + ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" + ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" + ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" + ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" + ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" + ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" + ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" + ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" + ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" + ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" + ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" + ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" + ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" + ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" + ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" + ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" + ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" + ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" + ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" + ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" + ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" + ;G("snomed:188155002","dcterms:identifier")=188155002 + ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("snomed:188155002","rdf:type")="sp:Code" + ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:195967001","dcterms:identifier")=195967001 + ;G("snomed:195967001","dcterms:title")="Asthma" + ;G("snomed:195967001","rdf:type")="sp:Code" + ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:254837009","dcterms:identifier")=254837009 + ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("snomed:254837009","rdf:type")="sp:Code" + ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:353295004","dcterms:identifier")=353295004 + ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" + ;G("snomed:353295004","rdf:type")="sp:Code" + ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:38341003","dcterms:identifier")=38341003 + ;G("snomed:38341003","dcterms:title")="Essential hypertension" + ;G("snomed:38341003","rdf:type")="sp:Code" + ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:40930008","dcterms:identifier")=40930008 + ;G("snomed:40930008","dcterms:title")="Hypothyroidism" + ;G("snomed:40930008","rdf:type")="sp:Code" + ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:44054006","dcterms:identifier")=44054006 + ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" + ;G("snomed:44054006","rdf:type")="sp:Code" + ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:54302000","dcterms:identifier")=54302000 + ;G("snomed:54302000","dcterms:title")="Disorder of breast" + ;G("snomed:54302000","rdf:type")="sp:Code" + ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:55822004","dcterms:identifier")=55822004 + ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" + ;G("snomed:55822004","rdf:type")="sp:Code" + ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:8517006","dcterms:identifier")=8517006 + ;G("snomed:8517006","dcterms:title")="History of tobacco use" + ;G("snomed:8517006","rdf:type")="sp:Code" + ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" + + ; +PROB(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of problems + ; + I $O(C0SARY("problem",""))="" D Q ; + . I $D(DEBUG) W !,"No Problems" + S GRTN="" ; default to no problems + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/problems" + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + D STARTADD^C0XF2N ; initialize to create triples + ; + N ZI S ZI="" + F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; + . N LRN,ZR ; ZR is the local array for building the new triples + . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result + . ; + . N PROBID ; unique Id for this problem + . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number + . ; + . ; i don't like this because the same problems gets a + . ; different ID every time it's reported. Can't trace it back to VistA + . ; I'd rather be using id@value ie "id@value")="118" + . ; + . N SNOMED S SNOMED=$G(@LRN@("icd@value")) + . N SNOGRF S SNOGRF="snomed:"_SNOMED + . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) + . I $D(DEBUG) D ; + . . W !,"Processing Problem List ",PROBID + . . W !,"problem: ",SNOTIT + . . W !,"code: ",SNOMED + . ; + . ; first do the base result graph + . ; + . S ZR("rdf:type")="sp:Problem" + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems + . ; ie /vista/smart/99912345/problems + . ; + . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name + . S ZR("sp:problemName")=PROBNAME + . ; + . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) + . S ZR("sp:startDate")=STARTDT + . ; + . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples + . K ZR ; clean up + . ; + . ; create the problemName graph + . ; + . S ZR("rdf:type")="sp:CodedValue" + . S ZR("sp:code")="snomed:"_SNOMED + . S ZR("dcterms:title")=$G(@LRN@("name@value")) + . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) + . K ZR + . ; + . ; create snomed graph + . ; + . S ZR("rdf:type")="sp:Code" + . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" + . S ZR("dcterms:identifier")=SNOMED + . S ZR("dcterms:title")=SNOTIT + . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) + . K ZR + . ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; diff --git a/p/C0SPROB2.m b/p/C0SPROB2.m index ab0a2a0..5fb34d8 100644 --- a/p/C0SPROB2.m +++ b/p/C0SPROB2.m @@ -1,343 +1,343 @@ -C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; - ; sample VistA NHIN problem list - ; - ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 - ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 - ;^TMP("C0STBL",91,"problem",1,"id@value")=100 - ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" - ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 - ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",1,"status@value")="A" - ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 - ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 - ;^TMP("C0STBL",91,"problem",2,"id@value")=108 - ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" - ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 - ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",2,"status@value")="A" - ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" - ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 - ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 - ;^TMP("C0STBL",91,"problem",3,"id@value")=109 - ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" - ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 - ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 - ;^TMP("C0STBL",91,"problem",3,"status@value")="A" - ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 - ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"id@value")=115 - ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" - ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",4,"status@value")="A" - ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"id@value")=116 - ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 - ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",5,"status@value")="A" - ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"id@value")=117 - ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 - ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",6,"status@value")="A" - ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"id@value")=118 - ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 - ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",7,"status@value")="A" - ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 - ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 - ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" - ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" - ;^TMP("C0STBL",91,"problem",8,"id@value")=119 - ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" - ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," - ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 - ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" - ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 - ;^TMP("C0STBL",91,"problem",8,"status@value")="A" - ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 - ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 - ; - ; sample Smart lab result triples - ; - ;G("node16rk1fgdvx10882","code")="snomed:40930008" - ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" - ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11051","code")="snomed:188155002" - ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11073","code")="snomed:353295004" - ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" - ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11089","code")="snomed:54302000" - ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" - ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11351","code")="snomed:38341003" - ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" - ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11390","code")="snomed:44054006" - ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" - ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11558","code")="snomed:195967001" - ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" - ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11578","code")="snomed:254837009" - ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11687","code")="snomed:8517006" - ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" - ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" - ;G("node16rk1fgdvx11716","code")="snomed:55822004" - ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" - ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" - ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" - ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" - ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" - ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" - ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" - ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" - ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" - ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" - ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" - ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" - ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" - ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" - ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" - ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" - ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" - ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" - ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" - ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" - ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" - ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" - ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" - ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" - ;G("snomed:188155002","dcterms:identifier")=188155002 - ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" - ;G("snomed:188155002","rdf:type")="sp:Code" - ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:195967001","dcterms:identifier")=195967001 - ;G("snomed:195967001","dcterms:title")="Asthma" - ;G("snomed:195967001","rdf:type")="sp:Code" - ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:254837009","dcterms:identifier")=254837009 - ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" - ;G("snomed:254837009","rdf:type")="sp:Code" - ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:353295004","dcterms:identifier")=353295004 - ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" - ;G("snomed:353295004","rdf:type")="sp:Code" - ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:38341003","dcterms:identifier")=38341003 - ;G("snomed:38341003","dcterms:title")="Essential hypertension" - ;G("snomed:38341003","rdf:type")="sp:Code" - ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:40930008","dcterms:identifier")=40930008 - ;G("snomed:40930008","dcterms:title")="Hypothyroidism" - ;G("snomed:40930008","rdf:type")="sp:Code" - ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:44054006","dcterms:identifier")=44054006 - ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" - ;G("snomed:44054006","rdf:type")="sp:Code" - ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:54302000","dcterms:identifier")=54302000 - ;G("snomed:54302000","dcterms:title")="Disorder of breast" - ;G("snomed:54302000","rdf:type")="sp:Code" - ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:55822004","dcterms:identifier")=55822004 - ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" - ;G("snomed:55822004","rdf:type")="sp:Code" - ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" - ;G("snomed:8517006","dcterms:identifier")=8517006 - ;G("snomed:8517006","dcterms:title")="History of tobacco use" - ;G("snomed:8517006","rdf:type")="sp:Code" - ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" - - ; -PROB(GRTN,C0SARY) ; GRTN, passed by reference, - ; is the return name of the graph created. "" if none - ; C0SARY is passed in by reference and is the NHIN array of problems - ; - I $O(C0SARY("problem",""))="" D Q ; - . I $D(DEBUG) W !,"No Problems" - S GRTN="" ; default to no problems - N C0SGRF - S C0SGRF="vistaSmart:"_ZPATID_"/problems" - I $D(DEBUG) W !,"Processing ",C0SGRF - D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph - D INITFARY^C0XF2N("C0XFARY") ; which triple store to use - N FARY S FARY="C0XFARY" - D USEFARY^C0XF2N(FARY) - D VOCINIT^C0XUTIL - ; - D STARTADD^C0XF2N ; initialize to create triples - ; - N ZI S ZI="" - F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; - . N LRN,ZR ; ZR is the local array for building the new triples - . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result - . ; - . N PROBID ; unique Id for this problem - . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number - . ; - . ; i don't like this because the same problems gets a - . ; different ID every time it's reported. Can't trace it back to VistA - . ; I'd rather be using id@value ie "id@value")="118" - . ; - . N SNOMED,ICD S ICD=$G(@LRN@("icd@value")) - . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map - . N SNOGRF ; graph for SNOMED code - . I SNOMED="" D ; - . . S SNOMED=ICD ; if not found, return the ICD code - . . S SNOGRF="icd9:"_SNOMED - . E S SNOGRF="snomed:"_SNOMED - . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) - . I $D(DEBUG) D ; - . . W !,"Processing Problem List ",PROBID - . . W !,"problem: ",SNOTIT - . . W !,"code: ",SNOMED - . ; - . ; first do the base result graph - . ; - . S ZR("rdf:type")="sp:Problem" - . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems - . ; ie /vista/smart/99912345/problems - . ; - . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name - . S ZR("sp:problemName")=PROBNAME - . ; - . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) - . S ZR("sp:startDate")=STARTDT - . ; - . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples - . K ZR ; clean up - . ; - . ; create the problemName graph - . ; - . S ZR("rdf:type")="sp:CodedValue" - . ;S ZR("sp:code")="snomed:"_SNOMED - . S ZR("sp:code")=SNOGRF - . S ZR("dcterms:title")=$G(@LRN@("name@value")) - . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) - . K ZR - . ; - . ; create snomed graph - . ; - . S ZR("rdf:type")="sp:Code" - . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" - . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9" - . S ZR("dcterms:identifier")=SNOMED - . S ZR("dcterms:title")=SNOTIT - . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) - . K ZR - . ; - D BULKLOAD^C0XF2N(.C0XFDA) - S GRTN=C0SGRF - Q - ; -SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code - ; requires the mapping table installed in the triplestore - ; - N ZSN,ZARY,ZSUB,ZSUBS - I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots - D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code - S ZSUB=$O(ZSUBS("")) ; pick the first one - I ZSUB="" Q "" - D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") - S ZSN=$O(ZARY("")) - I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") - Q ZSN - ; \ No newline at end of file +C0SPROB ; GPL - Smart Problem Processing ;5/01/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; + ; sample VistA NHIN problem list + ; + ;^TMP("C0STBL",91,"problem",1,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",1,"entered@value")=3110531 + ;^TMP("C0STBL",91,"problem",1,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",1,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",1,"icd@value")=414.9 + ;^TMP("C0STBL",91,"problem",1,"id@value")=100 + ;^TMP("C0STBL",91,"problem",1,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",1,"name@value")="Coronary Artery Disease" + ;^TMP("C0STBL",91,"problem",1,"onset@value")=3100201 + ;^TMP("C0STBL",91,"problem",1,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",1,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",1,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",1,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",1,"status@value")="A" + ;^TMP("C0STBL",91,"problem",1,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",1,"updated@value")=3110531 + ;^TMP("C0STBL",91,"problem",2,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",2,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",2,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",2,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",2,"icd@value")=780.2 + ;^TMP("C0STBL",91,"problem",2,"id@value")=108 + ;^TMP("C0STBL",91,"problem",2,"name@value")="Syncope and collapse" + ;^TMP("C0STBL",91,"problem",2,"onset@value")=3110102 + ;^TMP("C0STBL",91,"problem",2,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",2,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",2,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",2,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",2,"status@value")="A" + ;^TMP("C0STBL",91,"problem",2,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",2,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"acuity@value")="C" + ;^TMP("C0STBL",91,"problem",3,"entered@value")=3110602 + ;^TMP("C0STBL",91,"problem",3,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",3,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",3,"icd@value")=433.91 + ;^TMP("C0STBL",91,"problem",3,"id@value")=109 + ;^TMP("C0STBL",91,"problem",3,"name@value")="Occlusion and Stenosis of Unspecifid Precerebral Artery with Cerebral Infarctio" + ;^TMP("C0STBL",91,"problem",3,"onset@value")=3100101 + ;^TMP("C0STBL",91,"problem",3,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",3,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",3,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",3,"sc@value")=0 + ;^TMP("C0STBL",91,"problem",3,"status@value")="A" + ;^TMP("C0STBL",91,"problem",3,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",3,"updated@value")=3110602 + ;^TMP("C0STBL",91,"problem",4,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",4,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",4,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",4,"icd@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"id@value")=115 + ;^TMP("C0STBL",91,"problem",4,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",4,"name@value")="00.66" + ;^TMP("C0STBL",91,"problem",4,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",4,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",4,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",4,"status@value")="A" + ;^TMP("C0STBL",91,"problem",4,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",4,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",5,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",5,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",5,"icd@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"id@value")=116 + ;^TMP("C0STBL",91,"problem",5,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",5,"name@value")=37.21 + ;^TMP("C0STBL",91,"problem",5,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",5,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",5,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",5,"status@value")="A" + ;^TMP("C0STBL",91,"problem",5,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",5,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",6,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",6,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",6,"icd@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"id@value")=117 + ;^TMP("C0STBL",91,"problem",6,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",6,"name@value")=81.51 + ;^TMP("C0STBL",91,"problem",6,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",6,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",6,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",6,"status@value")="A" + ;^TMP("C0STBL",91,"problem",6,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",6,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",7,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",7,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",7,"icd@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"id@value")=118 + ;^TMP("C0STBL",91,"problem",7,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",7,"name@value")=47.09 + ;^TMP("C0STBL",91,"problem",7,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",7,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",7,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",7,"status@value")="A" + ;^TMP("C0STBL",91,"problem",7,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",7,"updated@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"entered@value")=3110603 + ;^TMP("C0STBL",91,"problem",8,"facility@code")=100 + ;^TMP("C0STBL",91,"problem",8,"facility@name")="VOE OFFICE INSTITUTION" + ;^TMP("C0STBL",91,"problem",8,"icd@value")="250.00" + ;^TMP("C0STBL",91,"problem",8,"id@value")=119 + ;^TMP("C0STBL",91,"problem",8,"location@value")="DR OFFICE" + ;^TMP("C0STBL",91,"problem",8,"name@value")="Diabetes Mellitus without mentionof Complication, type II or unspecified type," + ;^TMP("C0STBL",91,"problem",8,"provider@code")=63 + ;^TMP("C0STBL",91,"problem",8,"provider@name")="KING,MATTHEW MICHAEL" + ;^TMP("C0STBL",91,"problem",8,"removed@value")=0 + ;^TMP("C0STBL",91,"problem",8,"status@value")="A" + ;^TMP("C0STBL",91,"problem",8,"unverified@value")=0 + ;^TMP("C0STBL",91,"problem",8,"updated@value")=3110603 + ; + ; sample Smart lab result triples + ; + ;G("node16rk1fgdvx10882","code")="snomed:40930008" + ;G("node16rk1fgdvx10882","dcterms:title")="Hypothyroidism" + ;G("node16rk1fgdvx10882","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11051","code")="snomed:188155002" + ;G("node16rk1fgdvx11051","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("node16rk1fgdvx11051","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11073","code")="snomed:353295004" + ;G("node16rk1fgdvx11073","dcterms:title")="Toxic diffuse goiter" + ;G("node16rk1fgdvx11073","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11089","code")="snomed:54302000" + ;G("node16rk1fgdvx11089","dcterms:title")="Disorder of breast" + ;G("node16rk1fgdvx11089","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11351","code")="snomed:38341003" + ;G("node16rk1fgdvx11351","dcterms:title")="Essential hypertension" + ;G("node16rk1fgdvx11351","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11390","code")="snomed:44054006" + ;G("node16rk1fgdvx11390","dcterms:title")="Diabetes mellitus type 2" + ;G("node16rk1fgdvx11390","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11558","code")="snomed:195967001" + ;G("node16rk1fgdvx11558","dcterms:title")="Asthma" + ;G("node16rk1fgdvx11558","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11578","code")="snomed:254837009" + ;G("node16rk1fgdvx11578","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("node16rk1fgdvx11578","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11687","code")="snomed:8517006" + ;G("node16rk1fgdvx11687","dcterms:title")="History of tobacco use" + ;G("node16rk1fgdvx11687","rdf:type")="sp:CodedValue" + ;G("node16rk1fgdvx11716","code")="snomed:55822004" + ;G("node16rk1fgdvx11716","dcterms:title")="Hyperlipidemia" + ;G("node16rk1fgdvx11716","rdf:type")="sp:CodedValue" + ;G("smart:1577780/problems/69560e4721e1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/69560e4721e1","problemName")="node16rk1fgdvx11089" + ;G("smart:1577780/problems/69560e4721e1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/69560e4721e1","startDate")="2005-08-02" + ;G("smart:1577780/problems/06ef10c4e92c","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/06ef10c4e92c","problemName")="node16rk1fgdvx11051" + ;G("smart:1577780/problems/06ef10c4e92c","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/06ef10c4e92c","startDate")="2006-02-20" + ;G("smart:1577780/problems/9894ba9dfe5a","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9894ba9dfe5a","problemName")="node16rk1fgdvx11578" + ;G("smart:1577780/problems/9894ba9dfe5a","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9894ba9dfe5a","startDate")="2005-08-22" + ;G("smart:1577780/problems/c109aa7a0675","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/c109aa7a0675","problemName")="node16rk1fgdvx11558" + ;G("smart:1577780/problems/c109aa7a0675","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/c109aa7a0675","startDate")="2005-09-22" + ;G("smart:1577780/problems/1c50100614a2","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/1c50100614a2","problemName")="node16rk1fgdvx11073" + ;G("smart:1577780/problems/1c50100614a2","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/1c50100614a2","startDate")="2007-02-21" + ;G("smart:1577780/problems/083dffb2c4a0","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/083dffb2c4a0","problemName")="node16rk1fgdvx11390" + ;G("smart:1577780/problems/083dffb2c4a0","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/083dffb2c4a0","startDate")="2007-01-07" + ;G("smart:1577780/problems/762b5639a2d1","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/762b5639a2d1","problemName")="node16rk1fgdvx11687" + ;G("smart:1577780/problems/762b5639a2d1","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/762b5639a2d1","startDate")="2006-02-20" + ;G("smart:1577780/problems/9dc9053dd6f4","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9dc9053dd6f4","problemName")="node16rk1fgdvx11716" + ;G("smart:1577780/problems/9dc9053dd6f4","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9dc9053dd6f4","startDate")="2008-04-08" + ;G("smart:1577780/problems/e3fe9b7ee552","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/e3fe9b7ee552","problemName")="node16rk1fgdvx10882" + ;G("smart:1577780/problems/e3fe9b7ee552","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/e3fe9b7ee552","startDate")="2005-10-27" + ;G("smart:1577780/problems/9933307e8f95","belongsTo")="smart:1577780" + ;G("smart:1577780/problems/9933307e8f95","problemName")="node16rk1fgdvx11351" + ;G("smart:1577780/problems/9933307e8f95","rdf:type")="sp:Problem" + ;G("smart:1577780/problems/9933307e8f95","startDate")="2005-08-22" + ;G("snomed:188155002","dcterms:identifier")=188155002 + ;G("snomed:188155002","dcterms:title")="Primary malignant neoplasm of lower outer quadrant of female breast" + ;G("snomed:188155002","rdf:type")="sp:Code" + ;G("snomed:188155002","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:195967001","dcterms:identifier")=195967001 + ;G("snomed:195967001","dcterms:title")="Asthma" + ;G("snomed:195967001","rdf:type")="sp:Code" + ;G("snomed:195967001","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:254837009","dcterms:identifier")=254837009 + ;G("snomed:254837009","dcterms:title")="Primary malignant neoplasm of female breast" + ;G("snomed:254837009","rdf:type")="sp:Code" + ;G("snomed:254837009","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:353295004","dcterms:identifier")=353295004 + ;G("snomed:353295004","dcterms:title")="Toxic diffuse goiter" + ;G("snomed:353295004","rdf:type")="sp:Code" + ;G("snomed:353295004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:38341003","dcterms:identifier")=38341003 + ;G("snomed:38341003","dcterms:title")="Essential hypertension" + ;G("snomed:38341003","rdf:type")="sp:Code" + ;G("snomed:38341003","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:40930008","dcterms:identifier")=40930008 + ;G("snomed:40930008","dcterms:title")="Hypothyroidism" + ;G("snomed:40930008","rdf:type")="sp:Code" + ;G("snomed:40930008","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:44054006","dcterms:identifier")=44054006 + ;G("snomed:44054006","dcterms:title")="Diabetes mellitus type 2" + ;G("snomed:44054006","rdf:type")="sp:Code" + ;G("snomed:44054006","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:54302000","dcterms:identifier")=54302000 + ;G("snomed:54302000","dcterms:title")="Disorder of breast" + ;G("snomed:54302000","rdf:type")="sp:Code" + ;G("snomed:54302000","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:55822004","dcterms:identifier")=55822004 + ;G("snomed:55822004","dcterms:title")="Hyperlipidemia" + ;G("snomed:55822004","rdf:type")="sp:Code" + ;G("snomed:55822004","system")="http://purl.bioontology.org/ontology/SNOMEDCT" + ;G("snomed:8517006","dcterms:identifier")=8517006 + ;G("snomed:8517006","dcterms:title")="History of tobacco use" + ;G("snomed:8517006","rdf:type")="sp:Code" + ;G("snomed:8517006","system")="http://purl.bioontology.org/ontology/SNOMEDCT/" + + ; +PROB(GRTN,C0SARY) ; GRTN, passed by reference, + ; is the return name of the graph created. "" if none + ; C0SARY is passed in by reference and is the NHIN array of problems + ; + I $O(C0SARY("problem",""))="" D Q ; + . I $D(DEBUG) W !,"No Problems" + S GRTN="" ; default to no problems + N C0SGRF + S C0SGRF="vistaSmart:"_ZPATID_"/problems" + I $D(DEBUG) W !,"Processing ",C0SGRF + D DELGRAPH^C0XF2N(C0SGRF) ; delete the old graph + D INITFARY^C0XF2N("C0XFARY") ; which triple store to use + N FARY S FARY="C0XFARY" + D USEFARY^C0XF2N(FARY) + D VOCINIT^C0XUTIL + ; + D STARTADD^C0XF2N ; initialize to create triples + ; + N ZI S ZI="" + F S ZI=$O(C0SARY("problem",ZI)) Q:ZI="" D ; + . N LRN,ZR ; ZR is the local array for building the new triples + . S LRN=$NA(C0SARY("problem",ZI)) ; base for values in this lab result + . ; + . N PROBID ; unique Id for this problem + . S PROBID=C0SGRF_"/"_$$LKY17^C0XF2N ; use a random number + . ; + . ; i don't like this because the same problems gets a + . ; different ID every time it's reported. Can't trace it back to VistA + . ; I'd rather be using id@value ie "id@value")="118" + . ; + . N SNOMED,ICD S ICD=$G(@LRN@("icd@value")) + . S SNOMED=$$SNOMED(ICD) ; look up the snomed code in the map + . N SNOGRF ; graph for SNOMED code + . I SNOMED="" D ; + . . S SNOMED=ICD ; if not found, return the ICD code + . . S SNOGRF="icd9:"_SNOMED + . E S SNOGRF="snomed:"_SNOMED + . N SNOTIT S SNOTIT=$G(@LRN@("name@value")) + . I $D(DEBUG) D ; + . . W !,"Processing Problem List ",PROBID + . . W !,"problem: ",SNOTIT + . . W !,"code: ",SNOMED + . ; + . ; first do the base result graph + . ; + . S ZR("rdf:type")="sp:Problem" + . S ZR("sp:belongsTo")=C0SGRF ; the subject for this patient's problems + . ; ie /vista/smart/99912345/problems + . ; + . N PROBNAME S PROBNAME=$$ANONS^C0XF2N ; new node for problem name + . S ZR("sp:problemName")=PROBNAME + . ; + . N STARTDT S STARTDT=$$SPDATE^C0SUTIL($G(@LRN@("entered@value"))) + . S ZR("sp:startDate")=STARTDT + . ; + . D ADDINN^C0XF2N(C0SGRF,PROBID,.ZR) ; addIfNotNull the triples + . K ZR ; clean up + . ; + . ; create the problemName graph + . ; + . S ZR("rdf:type")="sp:CodedValue" + . ;S ZR("sp:code")="snomed:"_SNOMED + . S ZR("sp:code")=SNOGRF + . S ZR("dcterms:title")=$G(@LRN@("name@value")) + . D ADDINN^C0XF2N(C0SGRF,PROBNAME,.ZR) + . K ZR + . ; + . ; create snomed graph + . ; + . S ZR("rdf:type")="sp:Code" + . S ZR("sp:system")="http://purl.bioontology.org/ontology/SNOMEDCT" + . I SNOGRF["icd9" S ZR("sp:system")="http://purl.bioontology.org/ontology/ICD9" + . S ZR("dcterms:identifier")=SNOMED + . S ZR("dcterms:title")=SNOTIT + . D ADDINN^C0XF2N(C0SGRF,SNOGRF,.ZR) + . K ZR + . ; + D BULKLOAD^C0XF2N(.C0XFDA) + S GRTN=C0SGRF + Q + ; +SNOMED(ZICD) ; extrinsic which returns SNOMED code given an ICD9 code + ; requires the mapping table installed in the triplestore + ; + N ZSN,ZARY,ZSUB,ZSUBS + I $E(ZICD,$L(ZICD))="." S ZICD=$P(ZICD,".",1) ; handle trailing dots + D subjects^C0XGET1(.ZSUBS,"cg:ontology#code",ZICD) ; subjects with the ICD9 code + S ZSUB=$O(ZSUBS("")) ; pick the first one + I ZSUB="" Q "" + D objects^C0XGET1(.ZARY,ZSUB,"cg:ontology#toCode") + S ZSN=$O(ZARY("")) + I $D(DEBUG) W !,ZSN," ",$$object^C0XGET1(ZSUB,"rdfs:label") + Q ZSN + ; diff --git a/p/C0STBL.m b/p/C0STBL.m index 516af92..2f66db6 100644 --- a/p/C0STBL.m +++ b/p/C0STBL.m @@ -1,54 +1,54 @@ -C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q -EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN - I '$D(BEGDFN) S BDGDFN="" - I '$D(DFNCNT) S DFNCNT=150 - I '$D(ZPART) S ZPART="" - N ZTBL S ZTBL=$NA(^TMP("C0STBL")) - N ZI,ZCNT,ZG - S ZI=BEGDFN - S ZCNT=0 - F S ZI=$O(^DPT(ZI)) Q:(+ZI=0)!(ZCNT>DFNCNT) D ; - . S ZCNT=ZCNT+1 - . W ZI," " - . K ZG - . D EN^C0SNHIN(.ZG,ZI,ZPART) - . M @ZTBL@(ZI)=ZG - . K G - . ;D EN^C0SMART(.G,ZI,"med") - . ;I $D(G) W !,$$output^C0XGET1("G") - . ;k G - . ;D EN^C0SMART(.G,ZI,"patient") - . ;I $D(G) W !,$$output^C0XGET1("G") - . ;K G - . ;D EN^C0SMART(.G,ZI,"lab") - . ;I $D(G) W !,$$output^C0XGET1("G") - . ;K G - . D EN^C0SMART(.G,ZI,"problem") - . ;I $D(G) W !,$$output^C0XGET1("G") - Q - ; -LOADHACK ; - N ZI - F ZI=2:1:374 D ; - . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/") - Q - ; \ No newline at end of file +C0STBL ; GPL - Smart Container CREATE A TABLE OF NHINV VALUES;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q +EN(BEGDFN,DFNCNT,ZPART) ; START IS A DFN + I '$D(BEGDFN) S BDGDFN="" + I '$D(DFNCNT) S DFNCNT=150 + I '$D(ZPART) S ZPART="" + N ZTBL S ZTBL=$NA(^TMP("C0STBL")) + N ZI,ZCNT,ZG + S ZI=BEGDFN + S ZCNT=0 + F S ZI=$O(^DPT(ZI)) Q:(+ZI=0)!(ZCNT>DFNCNT) D ; + . S ZCNT=ZCNT+1 + . W ZI," " + . K ZG + . D EN^C0SNHIN(.ZG,ZI,ZPART) + . M @ZTBL@(ZI)=ZG + . K G + . ;D EN^C0SMART(.G,ZI,"med") + . ;I $D(G) W !,$$output^C0XGET1("G") + . ;k G + . ;D EN^C0SMART(.G,ZI,"patient") + . ;I $D(G) W !,$$output^C0XGET1("G") + . ;K G + . ;D EN^C0SMART(.G,ZI,"lab") + . ;I $D(G) W !,$$output^C0XGET1("G") + . ;K G + . D EN^C0SMART(.G,ZI,"problem") + . ;I $D(G) W !,$$output^C0XGET1("G") + Q + ; +LOADHACK ; + N ZI + F ZI=2:1:374 D ; + . D IMPORT^C0XF2N("hack"_ZI_".xml","/home/vista/hack/") + Q + ; diff --git a/p/C0SUTIL.m b/p/C0SUTIL.m index 0db93dc..f1412b9 100644 --- a/p/C0SUTIL.m +++ b/p/C0SUTIL.m @@ -1,34 +1,34 @@ -C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 - ;;0.1;C0S;nopatch;noreleasedate;Build 2 - ;Copyright 2012 George Lilly. Licensed under the terms of the GNU - ;General Public License See attached copy of the License. - ; - ;This program is free software; you can redistribute it and/or modify - ;it under the terms of the GNU General Public License as published by - ;the Free Software Foundation; either version 2 of the License, or - ;(at your option) any later version. - ; - ;This program is distributed in the hope that it will be useful, - ;but WITHOUT ANY WARRANTY; without even the implied warranty of - ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;GNU General Public License for more details. - ; - ;You should have received a copy of the GNU General Public License along - ;with this program; if not, write to the Free Software Foundation, Inc., - ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. - ; - Q - ; -SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd - ; ZDATE is a fileman format date - N TMPDT - S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date - S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens - I TMPDT="" S TMPDT="UNKNOWN" - N Z2,Z3 - S Z2=$P(TMPDT,"-",2) - S Z3=$P(TMPDT,"-",3) - I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2 - I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3 - Q TMPDT - ; \ No newline at end of file +C0SUTIL ; GPL - Smart Processing Utilities ;2/22/12 17:05 + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 + ;Copyright 2012 George Lilly. Licensed under the terms of the GNU + ;General Public License See attached copy of the License. + ; + ;This program is free software; you can redistribute it and/or modify + ;it under the terms of the GNU General Public License as published by + ;the Free Software Foundation; either version 2 of the License, or + ;(at your option) any later version. + ; + ;This program is distributed in the hope that it will be useful, + ;but WITHOUT ANY WARRANTY; without even the implied warranty of + ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;GNU General Public License for more details. + ; + ;You should have received a copy of the GNU General Public License along + ;with this program; if not, write to the Free Software Foundation, Inc., + ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + ; + Q + ; +SPDATE(ZDATE) ; extrinsic which returns the Smart date format yyyy-mm-dd + ; ZDATE is a fileman format date + N TMPDT + S TMPDT=$$FMTE^XLFDT(ZDATE,"7D") ; ordered date + S TMPDT=$TR(TMPDT,"/","-") ; change slashes to hyphens + I TMPDT="" S TMPDT="UNKNOWN" + N Z2,Z3 + S Z2=$P(TMPDT,"-",2) + S Z3=$P(TMPDT,"-",3) + I $L(Z2)=1 S $P(TMPDT,"-",2)="0"_Z2 + I $L(Z3)=1 S $P(TMPDT,"-",3)="0"_Z3 + Q TMPDT + ; diff --git a/p/C0SXPATH.m b/p/C0SXPATH.m index 1957ea9..b33b3be 100644 --- a/p/C0SXPATH.m +++ b/p/C0SXPATH.m @@ -1,5 +1,5 @@ -C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am - ;;1.0;C0S;;May 19, 2009;Build 2 +C0SXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08 ; 9/26/12 10:45am + ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2 ;Copyright 2008-2012 George Lilly. Licensed under the terms of the GNU ;General Public License See attached copy of the License. ;