Ignore:
Timestamp:
Oct 11, 2012, 1:42:56 PM (12 years ago)
Author:
George Lilly
Message:

fix to lab units of measure not found situation

File:
1 edited

Legend:

Unmodified
Added
Removed
  • smart/trunk/p/C0SNHIN.m

    r1540 r1569  
    1 C0SNHIN   ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11  17:05
    2         ;;1.0;VISTA SMART CONTAINER;;Sep 26, 2012;Build 2
    3         ;Copyright 2011-2012 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
    5         ;
    6         ;This program is free software; you can redistribute it and/or modify
    7         ;it under the terms of the GNU General Public License as published by
    8         ;the Free Software Foundation; either version 2 of the License, or
    9         ;(at your option) any later version.
    10         ;
    11         ;This program is distributed in the hope that it will be useful,
    12         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    13         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    14         ;GNU General Public License for more details.
    15         ;
    16         ;You should have received a copy of the GNU General Public License along
    17         ;with this program; if not, write to the Free Software Foundation, Inc.,
    18         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    19         ;
    20         Q
    21 EN(ZRTN,ZDFN,ZPART,KEEP)        ; GENERATE AN NHIN ARRAY FOR A PATIENT
    22         ;
    23         K GARY,GNARY,GIDX,C0SDOCID
    24         K ZRTN
    25         N GN
    26         K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
    27         K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
    28         K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
    29         D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
    30         S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
    31         S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
    32         D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
    33         I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
    34         ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
    35         Q
    36         ;
    37 PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
    38         ;
    39         N ZG
    40         S ZG=$NA(^TMP("PQRIXML",$J))
    41         K @ZG
    42         D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML
    43         N C0SDOCID
    44         S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML
    45         D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
    46         I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
    47         Q
    48         ;
    49 PQRI2(ZRTN)     ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
    50         ;
    51         ;N GG
    52         D GETXML^C0SMXP("GG","PQRI ONE MEASURE")
    53         D PROCESS(ZRTN,"GG","root",1)
    54         Q
    55         ;
    56 PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP)        ; PARSE AND RUN DOMO ON XML
    57         ; ZRTN IS PASSED BY REFERENCE
    58         ; ZXML IS PASSED BY NAME
    59         ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
    60         ;
    61         N GN
    62         S GN=$NA(^TMP("C0SPROCESS",$J))
    63         K @GN
    64         M @GN=@ZXML
    65         S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
    66         K @GN
    67         D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
    68         I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
    69         Q
    70         ;
    71 LOADSMRT        ;
    72         ;
    73         K ^GPL("SMART")
    74         S GN=$NA(^GPL("SMART",1))
    75         I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
    76         Q
    77         ;
    78 SMART   ; TRY IT WITH SMART
    79         ;
    80         S GN=$NA(^GPL("SMART"))
    81         ;K ^TMP("MXMLDOM",$J)
    82         K ^TMP("MXMLERR",$J)
    83         S C0SDOCID=$$PARSE(GN,"SMART")
    84         D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
    85         ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
    86         Q
    87         ;
    88 CCR     ; TRY IT WITH A CCR
    89         ;
    90         S GN=$NA(^GPL("CCR"))
    91         ;K ^TMP("MXMLDOM",$J)
    92         K ^TMP("MXMLERR",$J)
    93         S C0SDOCID=$$PARSE(GN,"CCR")
    94         D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
    95         ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
    96         Q
    97         ;
    98 MED     ; TRY IT WITH A CCR MED SECTION
    99         ;
    100         S GN=$NA(^GPL("MED"))
    101         K ^TMP("MXMLDOM",$J)
    102         K ^TMP("MXMLERR",$J)
    103         S C0SDOCID=$$PARSE(GN,"MED")
    104         D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
    105         ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
    106         Q
    107         ;
    108 CCD     ; TRY IT WITH A CCD
    109         ;
    110         S GN=$NA(^GPL("CCD"))
    111         ;K ^TMP("MXMLDOM",$J)
    112         K ^TMP("MXMLERR",$J)
    113         S C0SDOCID=$$PARSE(GN,"CCD")
    114         D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
    115         ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
    116         Q
    117         ;
    118 TEST1   ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
    119         ; PARSED WITH MXML
    120         ; RUN THROUGH XPATH
    121         K GARY,GIDX,C0SDOCID
    122         S GN=$NA(^GPL("NHIN"))
    123         ;S GN=$NA(^GPL("DOMI"))
    124         S C0SDOCID=$$PARSE(GN,"GPLTEST")
    125         D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
    126         K ^GPL("GNARY")
    127         M ^GPL("GNARY")=GNARY
    128         Q
    129         ;
    130 TEST2   ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
    131         ;
    132         S GN=$NA(^GPL("GNARY"))
    133         S C0SDOCID=$$DOMI^C0SDOM(GN,,"results")
    134         D OUTXML^C0SDOM("G",C0SDOCID)
    135         K ^GPL("DOMI")
    136         M ^GPL("DOMI")=G
    137         Q
    138         ;
    139 TEST3   ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
    140         ; PARSED WITH MXML
    141         ; RUN THROUGH XPATH
    142         K GARY,GIDX,C0SDOCID
    143         ;S GN=$NA(^GPL("NHIN"))
    144         S GN=$NA(^GPL("DOMI"))
    145         S C0SDOCID=$$PARSE(GN,"GPLTEST")
    146         D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
    147         Q
    148         ;
    149 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
    150         ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    151         ; THE XPATH ARRAY XPARY, PASSED BY NAME
    152         ; ZOID IS THE STARTING OID
    153         ; ZPATH IS THE STARTING XPATH, USUALLY "/"
    154         ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
    155         ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
    156         I $G(ZREDUX)="" S ZREDUX=""
    157         N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
    158         N NEWNUM S NEWNUM=""
    159         I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
    160         S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
    161         I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
    162         . N GT S GT=$P(NEWPATH,ZREDUX,2)
    163         . I GT'="" S NEWPATH=GT
    164         S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
    165         N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
    166         I $D(GA) D  ; PROCESS THE ATTRIBUTES
    167         . N ZI S ZI=""
    168         . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
    169         . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
    170         . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
    171         . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
    172         N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
    173         I $D(GD(2)) D  ;
    174         . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
    175         E  I $D(GD(1)) D  ;
    176         . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
    177         . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
    178         N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
    179         I ZFRST'=0 D  ; THERE IS A CHILD
    180         . N ZNUM
    181         . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
    182         . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
    183         N GNXT S GNXT=$$NXTSIB(ZOID)
    184         I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
    185         I GNXT'=0 D  ;
    186         . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
    187         . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
    188         . . N ZNUM S ZNUM=1 ;
    189         . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
    190         . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
    191         Q
    192         ;
    193 ADDNARY(ZXP,ZVALUE)     ; ADD AN NHIN ARRAY VALUE TO ZNARY
    194         ;
    195         N ZZI,ZZJ,ZZN
    196         S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
    197         I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
    198         S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
    199         S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
    200         I ZZI'["]" D  ; A SINGLETON
    201         . S ZZN=1
    202         E  D  ; THERE IS AN [x] OCCURANCE
    203         . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
    204         . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
    205         I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
    206         Q
    207         ;
    208 PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    209         ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    210         ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    211         ;Q $$EN^MXMLDOM(INXML)
    212         Q $$EN^MXMLDOM(INXML,"W")
    213         ;
    214 ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    215         N ZN
    216         ;I $$TAG(ZOID)["entry" B
    217         S ZN=$$NXTSIB(ZOID)
    218         I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
    219         Q 0
    220         ;
    221 FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    222         Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
    223         ;
    224 PARENT(ZOID)    ;RETURNS THE OID OF THE PARENT OF ZOID
    225         Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
    226         ;
    227 ATT(RTN,NODE)   ;GET ATTRIBUTES FOR ZOID
    228         S HANDLE=C0SDOCID
    229         K @RTN
    230         D GETTXT^MXMLDOM("A")
    231         Q
    232         ;
    233 TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
    234         ;I ZOID=149 B ;GPLTEST
    235         N X,Y
    236         S Y=""
    237         S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
    238         I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
    239         I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
    240         Q Y
    241         ;
    242 NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
    243         Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
    244         ;
    245 DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
    246         ;N ZT,ZN S ZT=""
    247         ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
    248         ;Q $G(@C0SDOM@(ZOID,"T",1))
    249         S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
    250         Q
    251         ;
    252 OUTXML(ZRTN,INID)       ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    253         ;
    254         S C0SDOCID=INID
    255         D START^C0SMXMLB($$TAG(1),,"G")
    256         D NDOUT($$FIRST(1))
    257         D END^C0SMXMLB ;END THE DOCUMENT
    258         M @ZRTN=^TMP("MXMLBLD",$J)
    259         K ^TMP("MXMLBLD",$J)
    260         Q
    261         ;
    262 NDOUT(ZOID)     ;CALLBACK ROUTINE - IT IS RECURSIVE
    263         N ZI S ZI=$$FIRST(ZOID)
    264         I ZI'=0 D  ; THERE IS A CHILD
    265         . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
    266         . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
    267         E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
    268         . ;W "DOING",ZOID,!
    269         . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
    270         . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
    271         . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
    272         I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
    273         . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
    274         Q
    275         ;
    276 WNHIN(ZDFN)     ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
    277         ;
    278         N GN,GN2
    279         D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
    280         S GN2=$NA(@GN@(1))
    281         W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
    282         Q
    283         ;
    284 TESTNARY        ; TEST MAKING A NHIN ARRAY
    285         N ZI S ZI=""
    286         N ZH ; DOM HANDLE
    287         D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
    288         S ZH=C0SDOCID ; SET THE HANDLE
    289         N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
    290         F  S ZI=$O(@ZD@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
    291         . N ZATT
    292         . D MNARY(.ZATT,ZH,ZI)
    293         . N ZPRE,ZN
    294         . S ZPRE=$$PRE(ZI)
    295         . S ZN=$P(ZPRE,",",2)
    296         . S ZPRE=$P(ZPRE,",",1)
    297         . ;I $D(ZATT) ZWR ZATT
    298         . N ZJ S ZJ=""
    299         . F  S ZJ=$O(ZATT(ZJ)) Q:ZJ=""  D  ; FOR EACH ATTRIBUTE
    300         . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
    301         . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
    302         Q
    303         ;
    304 PRE(ZNODE)      ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
    305         ;
    306         N GI,GI2,GPT,GJ,GN
    307         S GI=$$PARENT(ZNODE) ; PARENT NODE
    308         I GI=0 Q ""  ; NO PARENT
    309         S GPT=$$TAG(GI) ; TAG OF PARENT
    310         S GI2=$$PARENT(GI) ; PARENT OF PARENT
    311         I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
    312         S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
    313         I GJ=ZNODE Q:$$TAG(GI)_",1"
    314         F GN=2:1 Q:GJ=ZNODE  D  ;
    315         . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
    316         Q GPT_","_GN
    317         ;
    318 MNARY(ZRTN,ZHANDLE,ZOID)        ; MAKE A NHIN ARRAY FROM A DOM NODE
    319         ; RETURNED IN ZRTN, PASSED BY REFERENCE
    320         ; ZHANDLE IS THE DOM DOCUMENT ID
    321         ; ZOID IS THE DOM NODE
    322         D ATT("ZRTN",ZOID)
    323         Q
    324         ;
     1C0SNHIN   ; GPL - Smart Container - OUTPUT OF NHINV ROUTINES;6/3/11  17:05
     2 ;;0.1;C0S;nopatch;noreleasedate;Build 2
     3 ;Copyright 2011-2012 George Lilly.  Licensed under the terms of the GNU
     4 ;General Public License See attached copy of the License.
     5 ;
     6 ;This program is free software; you can redistribute it and/or modify
     7 ;it under the terms of the GNU General Public License as published by
     8 ;the Free Software Foundation; either version 2 of the License, or
     9 ;(at your option) any later version.
     10 ;
     11 ;This program is distributed in the hope that it will be useful,
     12 ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     13 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     14 ;GNU General Public License for more details.
     15 ;
     16 ;You should have received a copy of the GNU General Public License along
     17 ;with this program; if not, write to the Free Software Foundation, Inc.,
     18 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     19 ;
     20 Q
     21EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
     22 ;
     23 K GARY,GNARY,GIDX,C0SDOCID
     24 K ZRTN
     25 N GN
     26 K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
     27 K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
     28 K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
     29 D GET^C0SNHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
     30 S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
     31 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
     32 D DOMO^C0SDOM(C0SDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
     33 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
     34 ;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
     35 Q
     36 ;
     37PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
     38 ;
     39 N ZG
     40 S ZG=$NA(^TMP("PQRIXML",$J))
     41 K @ZG
     42 D GETXML^C0SMXP(ZG,"PQRIXML") ; GET THE XML FROM C0S MISC XML
     43 N C0SDOCID
     44 S C0SDOCID=$$PARSE^C0SDOM(ZG,"PQRIXML") ; PARSE THE XML
     45 D DOMO^C0SDOM(C0SDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
     46 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
     47 Q
     48 ;
     49PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
     50 ;
     51 ;N GG
     52 D GETXML^C0SMXP("GG","PQRI ONE MEASURE")
     53 D PROCESS(ZRTN,"GG","root",1)
     54 Q
     55 ;
     56PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
     57 ; ZRTN IS PASSED BY REFERENCE
     58 ; ZXML IS PASSED BY NAME
     59 ; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
     60 ;
     61 N GN
     62 S GN=$NA(^TMP("C0SPROCESS",$J))
     63 K @GN
     64 M @GN=@ZXML
     65 S C0SDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
     66 K @GN
     67 D DOMO^C0SDOM(C0SDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
     68 I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
     69 Q
     70 ;
     71LOADSMRT ;
     72 ;
     73 K ^GPL("SMART")
     74 S GN=$NA(^GPL("SMART",1))
     75 I $$FTG^%ZISH("/home/george/","alex-lewis2.xml",GN,2) W !,"SMART FILE LOADED"
     76 Q
     77 ;
     78SMART ; TRY IT WITH SMART
     79 ;
     80 S GN=$NA(^GPL("SMART"))
     81 ;K ^TMP("MXMLDOM",$J)
     82 K ^TMP("MXMLERR",$J)
     83 S C0SDOCID=$$PARSE(GN,"SMART")
     84 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//rdf:RDF/")
     85 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
     86 Q
     87 ;
     88CCR ; TRY IT WITH A CCR
     89 ;
     90 S GN=$NA(^GPL("CCR"))
     91 ;K ^TMP("MXMLDOM",$J)
     92 K ^TMP("MXMLERR",$J)
     93 S C0SDOCID=$$PARSE(GN,"CCR")
     94 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ContinuityOfCareRecord/Body/")
     95 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
     96 Q
     97 ;
     98MED ; TRY IT WITH A CCR MED SECTION
     99 ;
     100 S GN=$NA(^GPL("MED"))
     101 K ^TMP("MXMLDOM",$J)
     102 K ^TMP("MXMLERR",$J)
     103 S C0SDOCID=$$PARSE(GN,"MED")
     104 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
     105 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
     106 Q
     107 ;
     108CCD ; TRY IT WITH A CCD
     109 ;
     110 S GN=$NA(^GPL("CCD"))
     111 ;K ^TMP("MXMLDOM",$J)
     112 K ^TMP("MXMLERR",$J)
     113 S C0SDOCID=$$PARSE(GN,"CCD")
     114 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"//ClinicalDocument/component/structuredBody/")
     115 ;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
     116 Q
     117 ;
     118TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
     119 ; PARSED WITH MXML
     120 ; RUN THROUGH XPATH
     121 K GARY,GIDX,C0SDOCID
     122 S GN=$NA(^GPL("NHIN"))
     123 ;S GN=$NA(^GPL("DOMI"))
     124 S C0SDOCID=$$PARSE(GN,"GPLTEST")
     125 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
     126 K ^GPL("GNARY")
     127 M ^GPL("GNARY")=GNARY
     128 Q
     129 ;
     130TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
     131 ;
     132 S GN=$NA(^GPL("GNARY"))
     133 S C0SDOCID=$$DOMI^C0SDOM(GN,,"results")
     134 D OUTXML^C0SDOM("G",C0SDOCID)
     135 K ^GPL("DOMI")
     136 M ^GPL("DOMI")=G
     137 Q
     138 ;
     139TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
     140 ; PARSED WITH MXML
     141 ; RUN THROUGH XPATH
     142 K GARY,GIDX,C0SDOCID
     143 ;S GN=$NA(^GPL("NHIN"))
     144 S GN=$NA(^GPL("DOMI"))
     145 S C0SDOCID=$$PARSE(GN,"GPLTEST")
     146 D DOMO^C0SDOM(C0SDOCID,"/","GNARY","GIDX","GARY",,"/results/")
     147 Q
     148 ;
     149DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
     150 ; THE XPATH INDEX ZXIDX, PASSED BY NAME
     151 ; THE XPATH ARRAY XPARY, PASSED BY NAME
     152 ; ZOID IS THE STARTING OID
     153 ; ZPATH IS THE STARTING XPATH, USUALLY "/"
     154 ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
     155 ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
     156 I $G(ZREDUX)="" S ZREDUX=""
     157 N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
     158 N NEWNUM S NEWNUM=""
     159 I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
     160 S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
     161 I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
     162 . N GT S GT=$P(NEWPATH,ZREDUX,2)
     163 . I GT'="" S NEWPATH=GT
     164 S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
     165 N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
     166 I $D(GA) D  ; PROCESS THE ATTRIBUTES
     167 . N ZI S ZI=""
     168 . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
     169 . . N ZP S ZP=NEWPATH_"/"_ZI ; PATH FOR ATTRIBUTE
     170 . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
     171 . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
     172 N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
     173 I $D(GD(2)) D  ;
     174 . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
     175 E  I $D(GD(1)) D  ;
     176 . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
     177 . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
     178 N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
     179 I ZFRST'=0 D  ; THERE IS A CHILD
     180 . N ZNUM
     181 . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
     182 . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
     183 N GNXT S GNXT=$$NXTSIB(ZOID)
     184 I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
     185 I GNXT'=0 D  ;
     186 . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
     187 . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
     188 . . N ZNUM S ZNUM=1 ;
     189 . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
     190 . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
     191 Q
     192 ;
     193ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
     194 ;
     195 N ZZI,ZZJ,ZZN
     196 S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
     197 I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
     198 S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
     199 S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
     200 I ZZI'["]" D  ; A SINGLETON
     201 . S ZZN=1
     202 E  D  ; THERE IS AN [x] OCCURANCE
     203 . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
     204 . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
     205 I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
     206 Q
     207 ;
     208PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
     209 ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
     210 ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
     211 ;Q $$EN^MXMLDOM(INXML)
     212 Q $$EN^MXMLDOM(INXML,"W")
     213 ;
     214ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
     215 N ZN
     216 ;I $$TAG(ZOID)["entry" B
     217 S ZN=$$NXTSIB(ZOID)
     218 I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
     219 Q 0
     220 ;
     221FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
     222 Q $$CHILD^MXMLDOM(C0SDOCID,ZOID)
     223 ;
     224PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
     225 Q $$PARENT^MXMLDOM(C0SDOCID,ZOID)
     226 ;
     227ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
     228 S HANDLE=C0SDOCID
     229 K @RTN
     230 D GETTXT^MXMLDOM("A")
     231 Q
     232 ;
     233TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
     234 ;I ZOID=149 B ;GPLTEST
     235 N X,Y
     236 S Y=""
     237 S X=$G(C0SCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
     238 I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
     239 I Y="" S Y=$$NAME^MXMLDOM(C0SDOCID,ZOID)
     240 Q Y
     241 ;
     242NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
     243 Q $$SIBLING^MXMLDOM(C0SDOCID,ZOID)
     244 ;
     245DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
     246 ;N ZT,ZN S ZT=""
     247 ;S C0SDOM=$NA(^TMP("MXMLDOM",$J,C0SDOCID))
     248 ;Q $G(@C0SDOM@(ZOID,"T",1))
     249 S ZN=$$TEXT^MXMLDOM(C0SDOCID,ZOID,ZT)
     250 Q
     251 ;
     252OUTXML(ZRTN,INID) ; USES C0SMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
     253 ;
     254 S C0SDOCID=INID
     255 D START^C0SMXMLB($$TAG(1),,"G")
     256 D NDOUT($$FIRST(1))
     257 D END^C0SMXMLB ;END THE DOCUMENT
     258 M @ZRTN=^TMP("MXMLBLD",$J)
     259 K ^TMP("MXMLBLD",$J)
     260 Q
     261 ;
     262NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
     263 N ZI S ZI=$$FIRST(ZOID)
     264 I ZI'=0 D  ; THERE IS A CHILD
     265 . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
     266 . D MULTI^C0SMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0SMXML(ZI)") ;HAVE CHILDREN
     267 E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
     268 . ;W "DOING",ZOID,!
     269 . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
     270 . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
     271 . D ITEM^C0SMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
     272 I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
     273 . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
     274 Q
     275 ;
     276WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
     277 ;
     278 N GN,GN2
     279 D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
     280 S GN2=$NA(@GN@(1))
     281 W $$OUTPUT^C0SXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
     282 Q
     283 ;
     284TESTNARY ; TEST MAKING A NHIN ARRAY
     285 N ZI S ZI=""
     286 N ZH ; DOM HANDLE
     287 D TEST1 ; PARSE AN NHIN RESULT INTO THE DOM
     288 S ZH=C0SDOCID ; SET THE HANDLE
     289 N ZD S ZD=$NA(^TMP("MXMLDOM",$J,ZH))
     290 F  S ZI=$O(@ZD@(ZI)) Q:ZI=""  D  ; FOR EACH NODE
     291 . N ZATT
     292 . D MNARY(.ZATT,ZH,ZI)
     293 . N ZPRE,ZN
     294 . S ZPRE=$$PRE(ZI)
     295 . S ZN=$P(ZPRE,",",2)
     296 . S ZPRE=$P(ZPRE,",",1)
     297 . ;I $D(ZATT) ZWR ZATT
     298 . N ZJ S ZJ=""
     299 . F  S ZJ=$O(ZATT(ZJ)) Q:ZJ=""  D  ; FOR EACH ATTRIBUTE
     300 . . W ZPRE_"["_ZN_"]"_$$TAG(ZI)_"."_ZJ_"="_ZATT(ZJ),!
     301 . . S GOUT(ZPRE,ZN,$$TAG(ZI)_"."_ZJ)=ZATT(ZJ)
     302 Q
     303 ;
     304PRE(ZNODE) ; EXTRINSIC WHICH RETURNS THE PREFIX FOR A NODE
     305 ;
     306 N GI,GI2,GPT,GJ,GN
     307 S GI=$$PARENT(ZNODE) ; PARENT NODE
     308 I GI=0 Q ""  ; NO PARENT
     309 S GPT=$$TAG(GI) ; TAG OF PARENT
     310 S GI2=$$PARENT(GI) ; PARENT OF PARENT
     311 I (GI2'=0)&($$TAG(GI2)'="results") S GPT=$$TAG(GI2)_"."_GPT
     312 S GJ=$$FIRST(GI) ; NODE OF FIRST SIB
     313 I GJ=ZNODE Q:$$TAG(GI)_",1"
     314 F GN=2:1 Q:GJ=ZNODE  D  ;
     315 . S GJ=$$NXTSIB(GJ) ; NEXT SIBLING
     316 Q GPT_","_GN
     317 ;
     318MNARY(ZRTN,ZHANDLE,ZOID) ; MAKE A NHIN ARRAY FROM A DOM NODE
     319 ; RETURNED IN ZRTN, PASSED BY REFERENCE
     320 ; ZHANDLE IS THE DOM DOCUMENT ID
     321 ; ZOID IS THE DOM NODE
     322 D ATT("ZRTN",ZOID)
     323 Q
     324 ;
Note: See TracChangeset for help on using the changeset viewer.