Changeset 1206 for ccr/trunk/p/C0CMXP.m


Ignore:
Timestamp:
Jul 15, 2011, 4:47:06 PM (13 years ago)
Author:
George Lilly
Message:

removed tabs after certification

File:
1 edited

Legend:

Unmodified
Added
Removed
  • ccr/trunk/p/C0CMXP.m

    r1204 r1206  
    1 C0CMXP    ; GPL - MXML based XPath utilities;12/04/09  17:05
    2         ;;0.1;C0C;nopatch;noreleasedate;Build 38
    3         ;Copyright 2009 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         ;
    22 INITXPF(ARY)    ;INITIAL XML/XPATH FILE ARRAY
    23         ; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD
    24         D INITFARY^C0CSOAP(ARY) ;
    25         Q
    26         S @ARY@("XML FILE NUMBER")=178.101
    27         S @ARY@("XML SOURCE FIELD")=2.1
    28         S @ARY@("XML TEMPLATE FIELD")=3
    29         S @ARY@("XPATH BINDING SUBFILE")=178.1014
    30         S @ARY@("REDUX FIELD")=2.5
    31         Q
    32         ;
    33 SETXPF(ARY)     ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY
    34         ;
    35         S C0CXPF=@ARY@("XML FILE NUMBER")
    36         S C0CXFLD=@ARY@("XML")
    37         S C0CXTFLD=@ARY@("TEMPLATE XML")
    38         S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")
    39         S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")
    40         Q
    41         ;
    42 ADDXP(INARY,TID,FARY)   ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
    43         I '$D(FARY) D  ;
    44         . S FARY="FARY" ; FILE ARRAY
    45         . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
    46         D SETXPF(FARY) ;SET FILE VARIABLES
    47         N C0CA,C0CB
    48         S C0CA="" S C0CB=0
    49         F  S C0CA=$O(@INARY@(C0CA)) Q:C0CA=""  D  ; FOR EACH XPATH
    50         . S C0CB=C0CB+1 ; COUNT OF XPATHS
    51         . S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA
    52         . D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH
    53         Q
    54         ;
    55 FIXICD9 ; FIX THE ICD9RESULT XML
    56         D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE
    57         S ZI=""
    58         S G=""
    59         F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ; FOR EACH LINE
    60         . S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML
    61         D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY
    62         D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK
    63         Q
    64 ADDXML(INXML,TEMPID,INFARY)     ;ADD XML TO A TEMPLATE ID TEMPID
    65         ; INXML IS PASSED BY NAME
    66         I '$D(INFARY) D  ;
    67         . S INFARY="FARY" ; FILE ARRAY
    68         . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
    69         I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
    70         D SETXPF(INFARY) ;SET FILE VARIABLES
    71         D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML)
    72         Q
    73         ;
    74 ADDTEMP(INXML,TEMPID,INFARY)    ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID
    75         ;
    76         I '$D(INFARY) D  ;
    77         . S INFARY="FARY" ; FILE ARRAY
    78         . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
    79         I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
    80         D SETXPF(INFARY) ;SET FILE VARIABLES
    81         D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML)
    82         Q
    83         ;
    84 GETXML(OUTXML,TEMPID,INFARY)    ;GET THE XML FROM TEMPLATE TEMPID
    85         ;
    86         I '$D(INFARY) D  ;
    87         . S INFARY="FARY" ; FILE ARRAY
    88         . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
    89         D SETXPF(INFARY) ;SET FILE VARIABLES
    90         I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
    91         I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D  Q  ;
    92         . W "ERROR RETRIEVING TEMPLATE",!
    93         Q
    94         ;
    95 GETTEMP(OUTXML,TEMPID,FARY)     ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
    96         ;
    97         I '$D(FARY) D  ;
    98         . S FARY="FARY" ; FILE ARRAY
    99         . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
    100         D SETXPF(FARY) ;SET FILE VARIABLES
    101         I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME
    102         I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D  Q  ;
    103         . W "ERROR RETRIEVING TEMPLATE",!
    104         Q
    105         ;
    106 COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF)      ; COPIES A WORD PROCESSING FIELD
    107         ; FROM ONE RECORD TO ANOTHER RECORD
    108         ; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF
    109         ; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT
    110         ; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED
    111         ; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME
    112         ; A ZSRCF
    113         I '$D(ZSRCF) D  ;
    114         . S ZSRCF="ZSRCF"
    115         . D INITFARY^C0CSOAP(ZSRCF)
    116         I '$D(ZDESTF) D  ;
    117         . S ZDESTF="ZDESTF"
    118         . M @ZDESTF=@ZSRCF
    119         N ZSF,ZDF,ZSFREF,ZDFREF
    120         S ZSF=@ZSRCF@("XML FILE NUMBER")
    121         S ZSFREF=$$FILEREF^C0CRNF(ZSF)
    122         S ZDF=@ZDESTF@("XML FILE NUMBER")
    123         S ZDFREF=$$FILEREF^C0CRNF(ZDF)
    124         N ZSIEN,ZDIEN
    125         S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))
    126         I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q  ;
    127         S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))
    128         I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q  ;
    129         N ZFLDNUM
    130         I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME
    131         E  S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER
    132         N ZWP,ZWPN
    133         S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE
    134         I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q  ;
    135         D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST
    136         Q
    137         ;
    138 COMPILE(TID,UFARY)      ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS
    139         ; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE
    140         ; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE
    141         ; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT
    142         ; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE
    143         ; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01
    144         I '$D(UFARY) D  ;
    145         . S UFARY="DEFFARY" ; FILE ARRAY
    146         . ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
    147         . D INITFARY^C0CSOAP(UFARY)
    148         D SETXPF(UFARY) ;SET FILE VARIABLES
    149         I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)
    150         E  S INTID=TID
    151         ;B
    152         ;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX
    153         D GETXML("C0CXML",INTID,UFARY)
    154         S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING
    155         D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX
    156         D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE
    157         D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH
    158         Q
    159         ;
    160 MKTPLATE(OUTT,OUTIDX,INXML,REDUX)       ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
    161         ; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED
    162         ; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE
    163         ;
    164         S C0CXLOC=$NA(^TMP("C0CXML",$J))
    165         K @C0CXLOC
    166         M @C0CXLOC=@INXML
    167         S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
    168         K @C0CXLOC
    169         S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    170         ;N GIDX,GIDX2,GARY,GARY2
    171         I '$D(REDUX) S REDUX=""
    172         D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
    173         D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE
    174         N ZI,ZD S ZI=""
    175         F  S ZI=$O(@C0CDOM@(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE DOM
    176         . K ZD ;FOR DATA
    177         . D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE
    178         . ;I $D(ZD(1)) D  ; IF YES
    179         . I $$FIRST^C0CMXML(ZI)=0 D  ; IF THERE ARE NO CHILDREN TO THIS NODE
    180         . . ;I ZI<3 B  ;W !,ZD(1)
    181         . . K @C0CDOM@(ZI,"T") ; KILL THE DATA
    182         . . N ZXPATH
    183         . . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE
    184         . . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"
    185         . . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX
    186         D OUTXML^C0CMXML(OUTT,C0CDOCID)
    187         Q
    188         ;
    189 INVERT(OUTX,INX)        ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from
    190         ; @INX@(XPath)=x
    191         N ZI S ZI=""
    192         F  S ZI=$O(@INX@(ZI)) Q:ZI=""  D  ;FOR EACH XPATH IN THE INPUT
    193         . S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY
    194         Q
    195         ;
    196 DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES
    197         ; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH
    198         N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB
    199         S (ZMULT,ZSUB)=""
    200         S ZX=$P(INX,"[",2)
    201         I ZX'="" D  ; THERE IS A [x] MULTIPLE
    202         . S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH
    203         . S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE
    204         . S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH
    205         . I $P(ZX,"[",2)'="" D  ; A SUB MULTIPLE EXISTS
    206         . . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH
    207         . . S ZX=$P(ZX,"[",2) ; DELETE THE [
    208         . . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE
    209         . . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH
    210         E  S ZX=INX ;NO MULTIPLE HERE
    211         S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH
    212         Q
    213         ;
    214 DEMUXARY(OARY,IARY,DEPTH)       ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
    215         ; FORMAT @OARY@(x,variablename) where x is the first multiple
    216         ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
    217         N ZI,ZJ,ZK,ZL,ZM S ZI=""
    218         F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
    219         . D DEMUX^C0CMXP("ZJ",ZI)
    220         . S ZK=$P(ZJ,"^",3)
    221         . S ZM=$RE($P($RE(ZK),"/",1))
    222         . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
    223         . . S ZM=$RE($P($RE(ZK),"/",2))_ZM
    224         . S ZL=$P(ZJ,"^",1)
    225         . I ZL="" S ZL=1
    226         . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
    227         . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
    228         . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
    229         Q
    230         ;
    231 DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
    232         ; FORMAT @OARY@(x,variablename) where x is the first multiple
    233         ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
    234         N ZI,ZJ,ZK,ZL,ZM S ZI=""
    235         F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
    236         . D DEMUX^C0CMXP("ZJ",ZI)
    237         . S ZK=$P(ZJ,"^",3)
    238         . S ZM=$RE($P($RE(ZK),"/",1))
    239         . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
    240         . . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM
    241         . S ZL=$P(ZJ,"^",1)
    242         . I ZL="" S ZL=1
    243         . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
    244         . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
    245         . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
    246         Q
    247         ;
    248 DEMUXXP1(OARY,IARY)     ;IARY IS INCOMING XPATH ARRAY
    249         ; BOTH IARY AND OARY ARE PASSED BY NAME
    250         ; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED
    251         N ZI,ZJ,ZK
    252         S ZI=""
    253         F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH XPATH IN IARY
    254         . D DEMUX^C0CMXP("ZJ",ZI)
    255         . S ZK=$P(ZJ,"^",3) ;THE XPATH
    256         . S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW
    257         . ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST
    258         . ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE
    259         . ; COMMON XPATH
    260         Q
    261         ;
    262 DEMUXXP2(OARY,IARY)     ; IARY AND OARY ARE PASSED BY NAME
    263         ; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES
    264         ; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM
    265         ; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE
    266         ; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]
    267         ;
    268         N ZI,ZJ,ZK,ZX,ZY,ZP
    269         S ZI=""
    270         F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH INPUT XPATH
    271         . D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES
    272         . S ZX=$P(ZJ,"^",1) ;x
    273         . S ZY=$P(ZJ,"^",2) ;y
    274         . S ZP=$P(ZJ,"^",3) ;Xpath
    275         . I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1
    276         . I ZY'="" D  ;IS THERE A y?
    277         . . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)
    278         . E  D  ;NO y
    279         . . S @OARY@(ZX,ZP)=@IARY@(ZI)
    280         Q
    281         ;
    282 UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
    283         K ZERR
    284         D CLEAN^DILF
    285         D UPDATE^DIE("","C0CFDA","","ZERR")
    286         I $D(ZERR) D  ;
    287         . W "ERROR",!
    288         . ZWR ZERR
    289         . B
    290         K C0CFDA
    291         Q
    292         ;
     1C0CMXP   ; GPL - MXML based XPath utilities;12/04/09  17:05
     2 ;;0.1;C0C;nopatch;noreleasedate;Build 38
     3 ;Copyright 2009 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 ;
     22INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
     23 ; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD
     24 D INITFARY^C0CSOAP(ARY) ;
     25 Q
     26 S @ARY@("XML FILE NUMBER")=178.101
     27 S @ARY@("XML SOURCE FIELD")=2.1
     28 S @ARY@("XML TEMPLATE FIELD")=3
     29 S @ARY@("XPATH BINDING SUBFILE")=178.1014
     30 S @ARY@("REDUX FIELD")=2.5
     31 Q
     32 ;
     33SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY
     34 ;
     35 S C0CXPF=@ARY@("XML FILE NUMBER")
     36 S C0CXFLD=@ARY@("XML")
     37 S C0CXTFLD=@ARY@("TEMPLATE XML")
     38 S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")
     39 S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")
     40 Q
     41 ;
     42ADDXP(INARY,TID,FARY) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
     43 I '$D(FARY) D  ;
     44 . S FARY="FARY" ; FILE ARRAY
     45 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
     46 D SETXPF(FARY) ;SET FILE VARIABLES
     47 N C0CA,C0CB
     48 S C0CA="" S C0CB=0
     49 F  S C0CA=$O(@INARY@(C0CA)) Q:C0CA=""  D  ; FOR EACH XPATH
     50 . S C0CB=C0CB+1 ; COUNT OF XPATHS
     51 . S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA
     52 . D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH
     53 Q
     54 ;
     55FIXICD9 ; FIX THE ICD9RESULT XML
     56 D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE
     57 S ZI=""
     58 S G=""
     59 F  S ZI=$O(GPL(ZI)) Q:ZI=""  D  ; FOR EACH LINE
     60 . S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML
     61 D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY
     62 D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK
     63 Q
     64ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID
     65 ; INXML IS PASSED BY NAME
     66 I '$D(INFARY) D  ;
     67 . S INFARY="FARY" ; FILE ARRAY
     68 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
     69 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
     70 D SETXPF(INFARY) ;SET FILE VARIABLES
     71 D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML)
     72 Q
     73 ;
     74ADDTEMP(INXML,TEMPID,INFARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID
     75 ;
     76 I '$D(INFARY) D  ;
     77 . S INFARY="FARY" ; FILE ARRAY
     78 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
     79 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
     80 D SETXPF(INFARY) ;SET FILE VARIABLES
     81 D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML)
     82 Q
     83 ;
     84GETXML(OUTXML,TEMPID,INFARY) ;GET THE XML FROM TEMPLATE TEMPID
     85 ;
     86 I '$D(INFARY) D  ;
     87 . S INFARY="FARY" ; FILE ARRAY
     88 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
     89 D SETXPF(INFARY) ;SET FILE VARIABLES
     90 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
     91 I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D  Q  ;
     92 . W "ERROR RETRIEVING TEMPLATE",!
     93 Q
     94 ;
     95GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
     96 ;
     97 I '$D(FARY) D  ;
     98 . S FARY="FARY" ; FILE ARRAY
     99 . D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
     100 D SETXPF(FARY) ;SET FILE VARIABLES
     101 I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME
     102 I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D  Q  ;
     103 . W "ERROR RETRIEVING TEMPLATE",!
     104 Q
     105 ;
     106COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF) ; COPIES A WORD PROCESSING FIELD
     107 ; FROM ONE RECORD TO ANOTHER RECORD
     108 ; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF
     109 ; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT
     110 ; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED
     111 ; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME
     112 ; A ZSRCF
     113 I '$D(ZSRCF) D  ;
     114 . S ZSRCF="ZSRCF"
     115 . D INITFARY^C0CSOAP(ZSRCF)
     116 I '$D(ZDESTF) D  ;
     117 . S ZDESTF="ZDESTF"
     118 . M @ZDESTF=@ZSRCF
     119 N ZSF,ZDF,ZSFREF,ZDFREF
     120 S ZSF=@ZSRCF@("XML FILE NUMBER")
     121 S ZSFREF=$$FILEREF^C0CRNF(ZSF)
     122 S ZDF=@ZDESTF@("XML FILE NUMBER")
     123 S ZDFREF=$$FILEREF^C0CRNF(ZDF)
     124 N ZSIEN,ZDIEN
     125 S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))
     126 I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q  ;
     127 S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))
     128 I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q  ;
     129 N ZFLDNUM
     130 I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME
     131 E  S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER
     132 N ZWP,ZWPN
     133 S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE
     134 I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q  ;
     135 D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST
     136 Q
     137 ;
     138COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS
     139 ; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE
     140 ; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE
     141 ; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT
     142 ; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE
     143 ; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01
     144 I '$D(UFARY) D  ;
     145 . S UFARY="DEFFARY" ; FILE ARRAY
     146 . ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
     147 . D INITFARY^C0CSOAP(UFARY)
     148 D SETXPF(UFARY) ;SET FILE VARIABLES
     149 I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)
     150 E  S INTID=TID
     151 ;B
     152 ;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX
     153 D GETXML("C0CXML",INTID,UFARY)
     154 S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING
     155 D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX
     156 D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE
     157 D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH
     158 Q
     159 ;
     160MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
     161 ; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED
     162 ; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE
     163 ;
     164 S C0CXLOC=$NA(^TMP("C0CXML",$J))
     165 K @C0CXLOC
     166 M @C0CXLOC=@INXML
     167 S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
     168 K @C0CXLOC
     169 S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
     170 ;N GIDX,GIDX2,GARY,GARY2
     171 I '$D(REDUX) S REDUX=""
     172 D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
     173 D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE
     174 N ZI,ZD S ZI=""
     175 F  S ZI=$O(@C0CDOM@(ZI)) Q:ZI=""  D  ; FOR EACH NODE IN THE DOM
     176 . K ZD ;FOR DATA
     177 . D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE
     178 . ;I $D(ZD(1)) D  ; IF YES
     179 . I $$FIRST^C0CMXML(ZI)=0 D  ; IF THERE ARE NO CHILDREN TO THIS NODE
     180 . . ;I ZI<3 B  ;W !,ZD(1)
     181 . . K @C0CDOM@(ZI,"T") ; KILL THE DATA
     182 . . N ZXPATH
     183 . . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE
     184 . . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"
     185 . . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX
     186 D OUTXML^C0CMXML(OUTT,C0CDOCID)
     187 Q
     188 ;
     189INVERT(OUTX,INX) ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from
     190 ; @INX@(XPath)=x
     191 N ZI S ZI=""
     192 F  S ZI=$O(@INX@(ZI)) Q:ZI=""  D  ;FOR EACH XPATH IN THE INPUT
     193 . S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY
     194 Q
     195 ;
     196DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES
     197 ; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH
     198 N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB
     199 S (ZMULT,ZSUB)=""
     200 S ZX=$P(INX,"[",2)
     201 I ZX'="" D  ; THERE IS A [x] MULTIPLE
     202 . S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH
     203 . S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE
     204 . S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH
     205 . I $P(ZX,"[",2)'="" D  ; A SUB MULTIPLE EXISTS
     206 . . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH
     207 . . S ZX=$P(ZX,"[",2) ; DELETE THE [
     208 . . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE
     209 . . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH
     210 E  S ZX=INX ;NO MULTIPLE HERE
     211 S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH
     212 Q
     213 ;
     214DEMUXARY(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
     215 ; FORMAT @OARY@(x,variablename) where x is the first multiple
     216 ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
     217 N ZI,ZJ,ZK,ZL,ZM S ZI=""
     218 F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
     219 . D DEMUX^C0CMXP("ZJ",ZI)
     220 . S ZK=$P(ZJ,"^",3)
     221 . S ZM=$RE($P($RE(ZK),"/",1))
     222 . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
     223 . . S ZM=$RE($P($RE(ZK),"/",2))_ZM
     224 . S ZL=$P(ZJ,"^",1)
     225 . I ZL="" S ZL=1
     226 . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
     227 . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
     228 . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
     229 Q
     230 ;
     231DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
     232 ; FORMAT @OARY@(x,variablename) where x is the first multiple
     233 ; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
     234 N ZI,ZJ,ZK,ZL,ZM S ZI=""
     235 F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ;
     236 . D DEMUX^C0CMXP("ZJ",ZI)
     237 . S ZK=$P(ZJ,"^",3)
     238 . S ZM=$RE($P($RE(ZK),"/",1))
     239 . I $G(DEPTH)=2 D  ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
     240 . . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM
     241 . S ZL=$P(ZJ,"^",1)
     242 . I ZL="" S ZL=1
     243 . I $D(@OARY@(ZL,ZM)) D  ;IT'S A DUP
     244 . . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
     245 . E  S @OARY@(ZL,ZM)=@IARY@(ZI)
     246 Q
     247 ;
     248DEMUXXP1(OARY,IARY) ;IARY IS INCOMING XPATH ARRAY
     249 ; BOTH IARY AND OARY ARE PASSED BY NAME
     250 ; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED
     251 N ZI,ZJ,ZK
     252 S ZI=""
     253 F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH XPATH IN IARY
     254 . D DEMUX^C0CMXP("ZJ",ZI)
     255 . S ZK=$P(ZJ,"^",3) ;THE XPATH
     256 . S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW
     257 . ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST
     258 . ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE
     259 . ; COMMON XPATH
     260 Q
     261 ;
     262DEMUXXP2(OARY,IARY) ; IARY AND OARY ARE PASSED BY NAME
     263 ; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES
     264 ; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM
     265 ; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE
     266 ; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]
     267 ;
     268 N ZI,ZJ,ZK,ZX,ZY,ZP
     269 S ZI=""
     270 F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH INPUT XPATH
     271 . D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES
     272 . S ZX=$P(ZJ,"^",1) ;x
     273 . S ZY=$P(ZJ,"^",2) ;y
     274 . S ZP=$P(ZJ,"^",3) ;Xpath
     275 . I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1
     276 . I ZY'="" D  ;IS THERE A y?
     277 . . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)
     278 . E  D  ;NO y
     279 . . S @OARY@(ZX,ZP)=@IARY@(ZI)
     280 Q
     281 ;
     282UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
     283 K ZERR
     284 D CLEAN^DILF
     285 D UPDATE^DIE("","C0CFDA","","ZERR")
     286 I $D(ZERR) D  ;
     287 . W "ERROR",!
     288 . ZWR ZERR
     289 . B
     290 K C0CFDA
     291 Q
     292 ;
Note: See TracChangeset for help on using the changeset viewer.