Changeset 1330


Ignore:
Timestamp:
Jan 3, 2012, 11:45:29 PM (13 years ago)
Author:
George Lilly
Message:

new ohum version

Location:
ccr/branches/ohum/p
Files:
70 edited

Legend:

Unmodified
Added
Removed
  • ccr/branches/ohum/p/C0CACTOR.m

    r1329 r1330  
    1 C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
    2  ;;1.0;C0C;;May 19, 2009;Build 38
    3  ;Copyright 2008,2009 George Lilly, University of Minnesota.
    4  ;Licensed under the terms of the GNU General Public License.
    5  ;See attached copy of the License.
    6  ;
    7  ; This program is free software; you can redistribute it and/or modify
    8  ; it under the terms of the GNU General Public License as published by
    9  ; the Free Software Foundation; either version 2 of the License, or
    10  ; (at your option) any later version.
    11  ;
    12  ; This program is distributed in the hope that it will be useful,
    13  ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    14  ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15  ; GNU General Public License for more details.
    16  ;
    17  ; You should have received a copy of the GNU General Public License along
    18  ; with this program; if not, write to the Free Software Foundation, Inc.,
    19  ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20  ;
    21  ;  PROCESS THE ACTORS SECTION OF THE CCR
    22  ;
    23  ; ===Revision History===
    24  ; 0.1 Initial Writing of Skeleton--GPL
    25  ; 0.2 Patient Data Extraction--SMH
    26  ; 0.3 Information System Info Extraction--SMH
    27  ; 0.4 Patient data rouine refactored; adjustments here--SMH
    28  ;
    29 EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
    30  ; IPXML is the Input Actor Template into which we  substitute values
    31  ; This is straight XML. Values to be substituted are in @@VAL@@ format.
    32  ; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
    33  ; ^TMP(7542,1,"ACTORS",0)=Count
    34  ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
    35  ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
    36  ; AXML is the output arrary, to contain XML.
    37  ;
    38  N I,J,AMAP,AOID,ATYP,AIEN
    39  D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
    40  D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
    41  I DEBUG W "PROCESSING ACTORS ",!
    42  F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
    43  . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
    44  . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
    45  . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
    46  . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
    47  . I AIEN="" D  Q  ; IEN CAN'T BE NULL
    48  . . W "WARING NUL ACTOR: ",ATYP,!
    49  . I ATYP="" Q  ; NOT A VALID ACTOR
    50  . ;
    51  . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
    52  . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
    53  . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
    54  . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
    55  . ;
    56  . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
    57  . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
    58  . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
    59  . ;
    60  . I ATYP="NOK" D  ; NOK ACTOR TYPE
    61  . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
    62  . . D NOK("ATMP",AIEN,AOID,"ATMP2")
    63  . ;
    64  . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
    65  . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
    66  . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
    67  . ;
    68  . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
    69  . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
    70  . . D ORG("ATMP",AIEN,AOID,"ATMP2")
    71  . ;
    72  . W "PROCESSING:",ATYP," ",AIEN,!
    73  . ;I @ATMP2@(0)=0 Q  ; NOTHING RETURNED, SKIP THIS ONE
    74  . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
    75  . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
    76  ;
    77  N ACTTMP
    78  D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
    79  I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
    80  . ; STRINGS MARKED AS @@X@@
    81  . W "ACTORS Missing list: ",!
    82  . F I=1:1:ACTTMP(0) W ACTTMP(I),!
    83  Q
    84  ;
    85 PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
    86  I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
    87  ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
    88  ; CODE REUSABLE FROM ERX
    89  N AMAP
    90  S AMAP=$NA(^TMP($J,"AMAP"))
    91  K @AMAP
    92  D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
    93  I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
    94  I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
    95  D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
    96  K @AMAP ; CLEAN UP BEHIND US
    97  Q
    98  ;
    99 DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
    100  S @GPL@("ACTORADDRESSCITY")="ALTON"
    101  S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
    102  S @GPL@("ACTORADDRESSLINE2")=""
    103  S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
    104  S @GPL@("ACTORADDRESSSTATE")="KANSAS"
    105  S @GPL@("ACTORADDRESSTYPE")="Home"
    106  S @GPL@("ACTORADDRESSZIPCODE")=67623
    107  S @GPL@("ACTORCELLTEL")=""
    108  S @GPL@("ACTORCELLTELTEXT")=""
    109  S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
    110  S @GPL@("ACTOREMAIL")=""
    111  S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
    112  ;S @GPL@("ACTORGENDER")="MALE"
    113  S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
    114  S @GPL@("ACTORIEN")=2
    115  S @GPL@("ACTORMIDDLENAME")="TWO"
    116  S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
    117  S @GPL@("ACTORRESTEL")="888-555-1212"
    118  S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
    119  S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
    120  S @GPL@("ACTORSSN")="769122557P"
    121  S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
    122  S @GPL@("ACTORSSNTEXT")="SSN"
    123  S @GPL@("ACTORSUFFIXNAME")=""
    124  S @GPL@("ACTORWORKTEL")="888-121-1212"
    125  S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
    126  Q
    127  ;
    128 PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
    129  N ZX
    130  S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
    131  S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
    132  S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
    133  S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
    134  S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
    135  S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
    136  S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
    137  S @AMAP@("ACTORSSN")=""
    138  S @AMAP@("ACTORSSNTEXT")=""
    139  S @AMAP@("ACTORSSNSOURCEID")=""
    140  S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
    141  X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
    142  I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
    143  I $G(MRN)'="" D  ; IF MRN IS PRESENT
    144  . S @AMAP@("ACTORSSN")=MRN
    145  . S @AMAP@("ACTORSSNTEXT")="MRN"
    146  . S @AMAP@("ACTORSSNSOURCEID")=AOID
    147  E  D  ; NO MRN, USE SSN
    148  . S ZX=$$SSN^C0CDPT(AIEN)
    149  . I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
    150  . . S @AMAP@("ACTORSSN")=ZX
    151  . . S @AMAP@("ACTORSSNTEXT")="SSN"
    152  . . S @AMAP@("ACTORSSNSOURCEID")=AOID
    153  S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
    154  S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
    155  S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
    156  S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
    157  S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
    158  S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
    159  S @AMAP@("ACTORRESTEL")=""
    160  S @AMAP@("ACTORRESTELTEXT")=""
    161  S ZX=$$RESTEL^C0CDPT(AIEN)
    162  I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
    163  . S @AMAP@("ACTORRESTEL")=ZX
    164  . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
    165  S @AMAP@("ACTORWORKTEL")=""
    166  S @AMAP@("ACTORWORKTELTEXT")=""
    167  S ZX=$$WORKTEL^C0CDPT(AIEN)
    168  I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
    169  . S @AMAP@("ACTORWORKTEL")=ZX
    170  . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
    171  S @AMAP@("ACTORCELLTEL")=""
    172  S @AMAP@("ACTORCELLTELTEXT")=""
    173  S ZX=$$CELLTEL^C0CDPT(AIEN)
    174  I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
    175  . S @AMAP@("ACTORCELLTEL")=ZX
    176  . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
    177  S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
    178  S @AMAP@("ACTORADDRESSSOURCEID")=AOID
    179  S @AMAP@("ACTORIEN")=AIEN
    180  S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
    181  S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
    182  Q
    183  ;
    184 MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
    185  D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
    186  Q
    187  ;
    188 SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
    189      ;
    190      ; N AMAP
    191      S AMAP=$NA(^TMP($J,"AMAP"))
    192      K @AMAP
    193      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
    194      S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
    195      S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
    196      S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
    197      D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
    198      Q
    199      ;
    200 NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
    201      ;
    202      ; N AMAP
    203      S AMAP=$NA(^TMP($J,"AMAP"))
    204      K @AMAP
    205      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
    206      S @AMAP@("ACTORDISPLAYNAME")=""
    207      S @AMAP@("ACTORRELATION")=""
    208      S @AMAP@("ACTORRELATIONSOURCEID")=""
    209      S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
    210      D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
    211      Q
    212      ;
    213 ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
    214      ;
    215      N AMAP,ZIEN,ZSITE
    216      S AMAP=$NA(^TMP($J,"AMAP"))
    217      K @AMAP
    218      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
    219      S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
    220      S ZIEN=$P(ZSITE,"^",1)
    221      S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
    222      S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
    223      S @AMAP@("ACTORADDRESSTYPE")="Office"
    224      S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
    225      S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
    226      S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
    227      S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
    228      S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
    229      S @AMAP@("ACTORTELEPHONE")=""
    230      S @AMAP@("ACTORTELEPHONETYPE")=""
    231      S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
    232      I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
    233      . S @AMAP@("ACTORTELEPHONE")=ZX
    234      . S @AMAP@("ACTORTELEPHONETYPE")="Office"
    235      D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
    236      K @AMAP
    237      Q
    238      ;
    239 PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
    240      ;
    241      ; N AMAP
    242      S AMAP=$NA(^TMP($J,"AMAP"))
    243      K @AMAP
    244      I '$D(^VA(200,AIEN,0)) D  Q  ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
    245      . W "WARNING - MISSING PROVIDER: ",AIEN,!
    246      . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
    247      S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
    248      S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
    249      S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
    250      S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
    251      S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
    252      S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
    253      S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
    254      S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
    255      S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
    256      S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
    257      S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
    258      S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
    259      S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
    260      S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
    261      S @AMAP@("ACTORTELEPHONE")=""
    262      S @AMAP@("ACTORTELEPHONETYPE")=""
    263      S ZX=$$TEL^C0CVA200(AIEN)
    264      I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
    265      . S @AMAP@("ACTORTELEPHONE")=ZX
    266      . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
    267      S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
    268      S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
    269      S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
    270      S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
    271      D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
    272      Q
    273      ;
     1C0CACTOR        ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
     2        ;;1.0;C0C;;May 19, 2009;Build 1
     3        ;Copyright 2008,2009 George Lilly, University of Minnesota.
     4        ;Licensed under the terms of the GNU General Public License.
     5        ;See attached copy of the License.
     6        ;
     7        ; This program is free software; you can redistribute it and/or modify
     8        ; it under the terms of the GNU General Public License as published by
     9        ; the Free Software Foundation; either version 2 of the License, or
     10        ; (at your option) any later version.
     11        ;
     12        ; This program is distributed in the hope that it will be useful,
     13        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     14        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15        ; GNU General Public License for more details.
     16        ;
     17        ; You should have received a copy of the GNU General Public License along
     18        ; with this program; if not, write to the Free Software Foundation, Inc.,
     19        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20        ;
     21        ;  PROCESS THE ACTORS SECTION OF THE CCR
     22        ;
     23        ; ===Revision History===
     24        ; 0.1 Initial Writing of Skeleton--GPL
     25        ; 0.2 Patient Data Extraction--SMH
     26        ; 0.3 Information System Info Extraction--SMH
     27        ; 0.4 Patient data rouine refactored; adjustments here--SMH
     28        ;
     29EXTRACT(IPXML,ALST,AXML)        ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
     30        ; IPXML is the Input Actor Template into which we  substitute values
     31        ; This is straight XML. Values to be substituted are in @@VAL@@ format.
     32        ; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
     33        ; ^TMP(7542,1,"ACTORS",0)=Count
     34        ; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
     35        ; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
     36        ; AXML is the output arrary, to contain XML.
     37        ;
     38        N I,J,AMAP,AOID,ATYP,AIEN
     39        D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
     40        D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
     41        I DEBUG W "PROCESSING ACTORS ",!
     42        F I=1:1:@ALST@(0) D  ; PROCESS ALL ACTORS IN THE LIST
     43        . I @ALST@(I)["@@" Q  ; NOT A VALID ACTOR
     44        . S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
     45        . S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
     46        . S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
     47        . I AIEN="" D  Q  ; IEN CAN'T BE NULL
     48        . . W "WARING NUL ACTOR: ",ATYP,!
     49        . I ATYP="" Q  ; NOT A VALID ACTOR
     50        . ;
     51        . I DEBUG W AOID_" "_ATYP_" "_AIEN,!
     52        . I ATYP="PATIENT" D  ; PATIENT ACTOR TYPE
     53        . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
     54        . . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
     55        . ;
     56        . I ATYP="SYSTEM" D  ; SYSTEM ACTOR TYPE
     57        . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
     58        . . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
     59        . ;
     60        . I ATYP="NOK" D  ; NOK ACTOR TYPE
     61        . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
     62        . . D NOK("ATMP",AIEN,AOID,"ATMP2")
     63        . ;
     64        . I ATYP="PROVIDER" D  ; PROVIDER ACTOR TYPE
     65        . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
     66        . . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
     67        . ;
     68        . I ATYP="ORGANIZATION" D  ; PROVIDER ACTOR TYPE
     69        . . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
     70        . . D ORG("ATMP",AIEN,AOID,"ATMP2")
     71        . ;
     72        . W "PROCESSING:",ATYP," ",AIEN,!
     73        . ;I @ATMP2@(0)=0 Q  ; NOTHING RETURNED, SKIP THIS ONE
     74        . D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
     75        . K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
     76        ;
     77        N ACTTMP
     78        D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
     79        I ACTTMP(0)>0  D  ; IF THERE ARE MISSING VARS -
     80        . ; STRINGS MARKED AS @@X@@
     81        . W "ACTORS Missing list: ",!
     82        . F I=1:1:ACTTMP(0) W ACTTMP(I),!
     83        Q
     84        ;
     85PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
     86        I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
     87        ;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
     88        ; CODE REUSABLE FROM ERX
     89        N AMAP
     90        S AMAP=$NA(^TMP($J,"AMAP"))
     91        K @AMAP
     92        D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
     93        I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
     94        I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
     95        D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
     96        K @AMAP ; CLEAN UP BEHIND US
     97        Q
     98        ;
     99DEIDENT(GPL,ZDFN)       ; QUICK WAY TO DEIDENTIFY THE CCR
     100        S @GPL@("ACTORADDRESSCITY")="ALTON"
     101        S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
     102        S @GPL@("ACTORADDRESSLINE2")=""
     103        S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
     104        S @GPL@("ACTORADDRESSSTATE")="KANSAS"
     105        S @GPL@("ACTORADDRESSTYPE")="Home"
     106        S @GPL@("ACTORADDRESSZIPCODE")=67623
     107        S @GPL@("ACTORCELLTEL")=""
     108        S @GPL@("ACTORCELLTELTEXT")=""
     109        S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
     110        S @GPL@("ACTOREMAIL")=""
     111        S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
     112        ;S @GPL@("ACTORGENDER")="MALE"
     113        S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
     114        S @GPL@("ACTORIEN")=2
     115        S @GPL@("ACTORMIDDLENAME")="TWO"
     116        S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
     117        S @GPL@("ACTORRESTEL")="888-555-1212"
     118        S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
     119        S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
     120        S @GPL@("ACTORSSN")="769122557P"
     121        S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
     122        S @GPL@("ACTORSSNTEXT")="SSN"
     123        S @GPL@("ACTORSUFFIXNAME")=""
     124        S @GPL@("ACTORWORKTEL")="888-121-1212"
     125        S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
     126        Q
     127        ;
     128PEXTRACT(AMAP,AIEN,AOID)        ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
     129        N ZX
     130        S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     131        S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
     132        S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
     133        S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
     134        S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
     135        S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
     136        S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
     137        S @AMAP@("ACTORSSN")=""
     138        S @AMAP@("ACTORSSNTEXT")=""
     139        S @AMAP@("ACTORSSNSOURCEID")=""
     140        S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
     141        X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
     142        I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
     143        I $G(MRN)'="" D  ; IF MRN IS PRESENT
     144        . S @AMAP@("ACTORSSN")=MRN
     145        . S @AMAP@("ACTORSSNTEXT")="MRN"
     146        . S @AMAP@("ACTORSSNSOURCEID")=AOID
     147        E  D  ; NO MRN, USE SSN
     148        . S ZX=$$SSN^C0CDPT(AIEN)
     149        . I ZX'="" D  ; IF THERE IS A SSN IN THE RECORD
     150        . . S @AMAP@("ACTORSSN")=ZX
     151        . . S @AMAP@("ACTORSSNTEXT")="SSN"
     152        . . S @AMAP@("ACTORSSNSOURCEID")=AOID
     153        S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
     154        S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
     155        S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
     156        S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
     157        S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
     158        S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
     159        S @AMAP@("ACTORRESTEL")=""
     160        S @AMAP@("ACTORRESTELTEXT")=""
     161        S ZX=$$RESTEL^C0CDPT(AIEN)
     162        I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
     163        . S @AMAP@("ACTORRESTEL")=ZX
     164        . S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
     165        S @AMAP@("ACTORWORKTEL")=""
     166        S @AMAP@("ACTORWORKTELTEXT")=""
     167        S ZX=$$WORKTEL^C0CDPT(AIEN)
     168        I ZX'="" D  ; IF THERE IS A RESIDENT PHONE IN THE RECORD
     169        . S @AMAP@("ACTORWORKTEL")=ZX
     170        . S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
     171        S @AMAP@("ACTORCELLTEL")=""
     172        S @AMAP@("ACTORCELLTELTEXT")=""
     173        S ZX=$$CELLTEL^C0CDPT(AIEN)
     174        I ZX'="" D  ; IF THERE IS A CELL PHONE IN THE RECORD
     175        . S @AMAP@("ACTORCELLTEL")=ZX
     176        . S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
     177        S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
     178        S @AMAP@("ACTORADDRESSSOURCEID")=AOID
     179        S @AMAP@("ACTORIEN")=AIEN
     180        S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
     181        S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
     182        Q
     183        ;
     184MAP(INXML,AMAP,OUTXML)  ;MAP ANY ACTOR TO XML
     185        D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     186        Q
     187        ;
     188SYSTEM(INXML,AIEN,AOID,OUTXML)  ; PROCESS A SYSTEM ACTOR
     189            ;
     190            ; N AMAP
     191            S AMAP=$NA(^TMP($J,"AMAP"))
     192            K @AMAP
     193            S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     194            S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
     195            S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
     196            S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
     197            D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     198            Q
     199            ;
     200NOK(INXML,AIEN,AOID,OUTXML)     ; PROCESS A NEXT OF KIN TYPE ACTOR
     201            ;
     202            ; N AMAP
     203            S AMAP=$NA(^TMP($J,"AMAP"))
     204            K @AMAP
     205            S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     206            S @AMAP@("ACTORDISPLAYNAME")=""
     207            S @AMAP@("ACTORRELATION")=""
     208            S @AMAP@("ACTORRELATIONSOURCEID")=""
     209            S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
     210            D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     211            Q
     212            ;
     213ORG(INXML,AIEN,AOID,OUTXML)     ; PROCESS AN ORGANIZATION TYPE ACTOR
     214            ;
     215            N AMAP,ZIEN,ZSITE
     216            S AMAP=$NA(^TMP($J,"AMAP"))
     217            K @AMAP
     218            S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     219            S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
     220            S ZIEN=$P(ZSITE,"^",1)
     221            S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
     222            S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
     223            S @AMAP@("ACTORADDRESSTYPE")="Office"
     224            S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
     225            S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
     226            S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
     227            S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
     228            S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
     229            S @AMAP@("ACTORTELEPHONE")=""
     230            S @AMAP@("ACTORTELEPHONETYPE")=""
     231            S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
     232            I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
     233            . S @AMAP@("ACTORTELEPHONE")=ZX
     234            . S @AMAP@("ACTORTELEPHONETYPE")="Office"
     235            D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     236            K @AMAP
     237            Q
     238            ;
     239PROVIDER(INXML,AIEN,AOID,OUTXML)        ; PROCESS A PROVIDER TYPE ACTOR
     240            ;
     241            ; N AMAP
     242            S AMAP=$NA(^TMP($J,"AMAP"))
     243            K @AMAP
     244            I '$D(^VA(200,AIEN,0)) D  Q  ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
     245            . W "WARNING - MISSING PROVIDER: ",AIEN,!
     246            . S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
     247            S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
     248            S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
     249            S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
     250            S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
     251            S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
     252            S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
     253            S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
     254            S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
     255            S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
     256            S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
     257            S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
     258            S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
     259            S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
     260            S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
     261            S @AMAP@("ACTORTELEPHONE")=""
     262            S @AMAP@("ACTORTELEPHONETYPE")=""
     263            S ZX=$$TEL^C0CVA200(AIEN)
     264            I ZX'="" D  ; THERE IS A PHONE NUMBER AVAILABLE
     265            . S @AMAP@("ACTORTELEPHONE")=ZX
     266            . S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
     267            S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
     268            S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
     269            S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
     270            S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
     271            D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
     272            Q
     273            ;
  • ccr/branches/ohum/p/C0CALERT.m

    r1329 r1330  
    1 C0CALERT  ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
    2  ;;1.0;C0C;;May 19, 2009;Build 38
    3  ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
    4  ;Licensed under the terms of the GNU General Public License.
    5  ;See attached copy of the License.
    6  ;
    7  ;This program is free software; you can redistribute it and/or modify
    8  ;it under the terms of the GNU General Public License as published by
    9  ;the Free Software Foundation; either version 2 of the License, or
    10  ;(at your option) any later version.
    11  ;
    12  ;This program is distributed in the hope that it will be useful,
    13  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15  ;GNU General Public License for more details.
    16  ;
    17  ;You should have received a copy of the GNU General Public License along
    18  ;with this program; if not, write to the Free Software Foundation, Inc.,
    19  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20  ;
    21  W "NO ENTRY FROM TOP",!
    22  Q
    23  ;
    24 EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO  XML TEMPLATE
    25  ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
    26  ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    27  ;
    28  ; GET ADVERSE REACTIONS AND ALLERGIES
    29  ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
    30  S GMRA="0^0^111"
    31  D EN1^GMRADPT
    32  I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
    33  . S @ALTOUTXML@(0)=0
    34  ; DEFINE MAPPING
    35  N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
    36  S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
    37  S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
    38  K @ALTTVMAP,@ALTTARYTMP
    39  N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
    40  S ALTTMP="" ;
    41  F  S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP=""  D  ; CHANGED TO $O BY GPL
    42  . W "ALTTMP="_ALTTMP,!
    43  . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
    44  . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
    45  . K @ALTVMAP
    46  . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
    47  . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
    48  . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
    49  . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
    50  . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
    51  . N ADT S ADT="Patient has an " ; X $ZINT H 5
    52  . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
    53  . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
    54  . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
    55  . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
    56  . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
    57  . N ALTCDE ; SNOMED CODE THE THE ALERT
    58  . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
    59  . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
    60  . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
    61  . ; AND  282100009 FOR ADVERSE REACTION TO A SUBSTANCE
    62  . I ALTCDE'="" D  ; IF THERE IS A CODE
    63  . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
    64  . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
    65  . E  D  ; SET TO NULL
    66  . . S @ALTVMAP@("ALERTCODESYSTEM")=""
    67  . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
    68  . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
    69  . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
    70  . I ALTPROV'="" D  ; PROVIDER PROVIDEED
    71  . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
    72  . E  S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
    73  . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
    74  . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
    75  . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
    76  . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
    77  . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
    78  . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
    79  . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
    80  . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
    81  . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
    82  . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
    83  . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
    84  . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
    85  . I ACVUID'="" D  ; IF VUID IS NOT NULL
    86  . . S ZC=$$CODE^C0CUTIL(ACVUID)
    87  . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
    88  . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
    89  . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
    90  . E  D  ; IF REACTANT CODE VALUE IS NULL
    91  . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
    92  . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
    93  . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
    94  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
    95  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
    96  . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
    97  . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
    98  . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
    99  . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
    100  . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
    101  . N ARTMP,ARIEN,ARDES,ARVUID
    102  . S (ARTMP,ARDES,ARVUID)=""
    103  . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
    104  . . S ARTMP=@ALTG@(ALTTMP,"S",1)
    105  . . W "REACTION:",ARTMP,!
    106  . . S ARIEN=$P(ARTMP,";",2)
    107  . . S ARDES=$P(ARTMP,";",1)
    108  . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
    109  . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
    110  . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
    111  . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
    112  . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
    113  . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
    114  . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
    115  . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
    116  . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
    117  . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
    118  . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
    119  . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
    120  . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
    121  . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
    122  . K @ALTARYTMP
    123  . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
    124  . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
    125  . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
    126  . S ALTCNT=ALTCNT+1
    127  S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
    128  Q
    129 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
    130  ; INGLB IS OF THE FORM: PSNDF(50.6,
    131  ; RETURN 50.6
    132  Q $P($P(INGLB,"(",2),",",1)  ;
     1C0CALERT        ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
     2        ;;1.0;C0C;;May 19, 2009;Build 1
     3        ;Copyright 2008,2009 George Lilly, University of Minnesota and others.
     4        ;Licensed under the terms of the GNU General Public License.
     5        ;See attached copy of the License.
     6        ;
     7        ;This program is free software; you can redistribute it and/or modify
     8        ;it under the terms of the GNU General Public License as published by
     9        ;the Free Software Foundation; either version 2 of the License, or
     10        ;(at your option) any later version.
     11        ;
     12        ;This program is distributed in the hope that it will be useful,
     13        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     14        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15        ;GNU General Public License for more details.
     16        ;
     17        ;You should have received a copy of the GNU General Public License along
     18        ;with this program; if not, write to the Free Software Foundation, Inc.,
     19        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20        ;
     21        W "NO ENTRY FROM TOP",!
     22        Q
     23        ;
     24EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK)    ; EXTRACT ALERTS INTO  XML TEMPLATE
     25        ; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
     26        ; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     27        ;
     28        ; GET ADVERSE REACTIONS AND ALLERGIES
     29        ; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
     30        S GMRA="0^0^111"
     31        D EN1^GMRADPT
     32        I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
     33        . S @ALTOUTXML@(0)=0
     34        ; DEFINE MAPPING
     35        N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
     36        S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
     37        S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
     38        K @ALTTVMAP,@ALTTARYTMP
     39        N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
     40        S ALTTMP="" ;
     41        F  S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP=""  D  ; CHANGED TO $O BY GPL
     42        . W "ALTTMP="_ALTTMP,!
     43        . ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
     44        . S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
     45        . K @ALTVMAP
     46        . S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
     47        . N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
     48        . I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
     49        . N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
     50        . N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
     51        . N ADT S ADT="Patient has an " ; X $ZINT H 5
     52        . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
     53        . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
     54        . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
     55        . N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
     56        . S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
     57        . N ALTCDE ; SNOMED CODE THE THE ALERT
     58        . S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
     59        . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
     60        . ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
     61        . ; AND  282100009 FOR ADVERSE REACTION TO A SUBSTANCE
     62        . I ALTCDE'="" D  ; IF THERE IS A CODE
     63        . . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
     64        . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
     65        . E  D  ; SET TO NULL
     66        . . S @ALTVMAP@("ALERTCODESYSTEM")=""
     67        . . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
     68        . S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
     69        . N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
     70        . I ALTPROV'="" D  ; PROVIDER PROVIDEED
     71        . . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
     72        . E  S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
     73        . W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
     74        . N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
     75        . S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
     76        . S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
     77        . S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
     78        . S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
     79        . S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
     80        . S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
     81        . S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
     82        . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
     83        . N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
     84        . S (ZC,ZCD,ZCDS,ZCDSV)="" ; INITIALIZE
     85        . I ACVUID'="" D  ; IF VUID IS NOT NULL
     86        . . S ZC=$$CODE^C0CUTIL(ACVUID)
     87        . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
     88        . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
     89        . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
     90        . E  D  ; IF REACTANT CODE VALUE IS NULL
     91        . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
     92        . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
     93        . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
     94        . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
     95        . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
     96        . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
     97        . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
     98        . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
     99        . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
     100        . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
     101        . N ARTMP,ARIEN,ARDES,ARVUID
     102        . S (ARTMP,ARDES,ARVUID)=""
     103        . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
     104        . . S ARTMP=@ALTG@(ALTTMP,"S",1)
     105        . . W "REACTION:",ARTMP,!
     106        . . S ARIEN=$P(ARTMP,";",2)
     107        . . S ARDES=$P(ARTMP,";",1)
     108        . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
     109        . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
     110        . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
     111        . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
     112        . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
     113        . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
     114        . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
     115        . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
     116        . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
     117        . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
     118        . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
     119        . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
     120        . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
     121        . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
     122        . K @ALTARYTMP
     123        . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
     124        . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
     125        . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
     126        . S ALTCNT=ALTCNT+1
     127        S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
     128        Q
     129PRSGLB(INGLB)   ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
     130        ; INGLB IS OF THE FORM: PSNDF(50.6,
     131        ; RETURN 50.6
     132        Q $P($P(INGLB,"(",2),",",1)  ;
  • ccr/branches/ohum/p/C0CBAT.m

    r1329 r1330  
    1 C0CBAT   ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
    2  ;;1.0;C0C;;May 19, 2009;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  W "This is the CCR Batch Utility Library ",!
    21  Q
    22  ;
    23 STOP ; STOP A CURRENTLY RUNNING BATCH JOB
    24  I '$D(^TMP("C0CBAT","RUNNING")) Q  ;
    25  W !,!,"HALTING CCR BATCH",!
    26  S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE
    27  H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED
    28  I '$D(^TMP("C0CBAT","STOP")) D  ; SIGNAL RECEIVED
    29  . W "CCR BATCH JOB TERMINATING",!
    30  E  D  ;
    31  . K ^TMP("C0CBAT","STOP") ; STOP SIGNALING
    32  . W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!
    33  Q
    34  ;
    35 START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION
    36  ;
    37  I $D(^TMP("C0CBAT","RUNNING")) D  Q  ; ONLY ONE ALLOWED AT A TIME
    38  . W !,"CCR BATCH ALREADY RUNNING",!
    39  . W !,"STOP FIRST WITH STOP^C0CBAT",!
    40  N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO
    41  S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"
    42  S ZTDTH=$H ;
    43  ;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10))
    44  S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""
    45  S ZTIO="NULL" ;
    46  W !,!,"CCR BATCH JOB STARTED",!
    47  D ^%ZTLOAD
    48  Q
    49  ;
    50 EN ; BATCH ENTRY POINT
    51  ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
    52  ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
    53  ; GENERATES A NEW CCR FOR THE PATIENT
    54  ; UPDATES THE E2 CCR ELEMENTS FILE
    55  ;
    56  S C0CQT=1 ; QUIET MODE
    57  I $D(^TMP("C0CBAT","RUNNING")) Q  ; ONLY ONE AT A TIME
    58  S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL
    59  S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN
    60  S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE
    61  S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE
    62  S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
    63  I $D(@C0CBB@(0)) D  ; ERROR SHOULDN'T EXIST
    64  . W "WORK AREA ERROR",!
    65  . B
    66  S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
    67  S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
    68  S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
    69  ;I $D(^C0CB("B",C0CDT)) D  ; BATCH RECORD EXISTS
    70  ;. H 10 ; HANG 10 SECONDS
    71  ;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN
    72  ;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK
    73  D BLDHOT(C0CBH) ; BUILD THE HOT LIST
    74  S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST
    75  S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS
    76  S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL
    77  S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM
    78  S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS
    79  S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST
    80  D UPDIE ; CREATE THE BATCH RECORD
    81  S C0CIEN=$O(^C0CB("B",C0CBDT,""))
    82  S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST
    83  S C0CBCUR="" ; CURRENT PATIENT
    84  S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""
    85  ;F  S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR=""  D  ; HOT LIST LATEST FIRST
    86  F  S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; HOT LIST FIRST
    87  . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")
    88  . I $G(C0CCHK) D  ;
    89  . . D PUTRIM^C0CFM2(C0CBCUR)
    90  . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
    91  . . K C0CFDA
    92  . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
    93  . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
    94  . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
    95  . . D UPDIE ; CREATE UPDATE SUBFILE
    96  . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
    97  . S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL
    98  . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
    99  . S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS
    100  . S C0CNOW=$$NOW^XLFDT
    101  . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
    102  . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
    103  . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
    104  . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
    105  . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
    106  . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
    107  . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
    108  . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED
    109  . D UPDIE ;
    110  . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
    111  . . S C0CSTOP=1
    112  . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
    113  . H 1 ; GIVE OTHERS A CHANCE
    114  F  S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; SUBS LIST
    115  . I $D(@C0CBH@(C0CBCUR)) Q  ; SKIP IF IN HOT LIST - ALREADY DONE
    116  . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")
    117  . I $G(C0CCHK) D  ; IF CHECKSUMS HAVE CHANGED
    118  . . D PUTRIM^C0CFM2(C0CBCUR)
    119  . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
    120  . . K C0CFDA
    121  . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
    122  . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
    123  . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
    124  . . D UPDIE ; CREATE UPDATE SUBFILE
    125  . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
    126  . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
    127  . S C0CNOW=$$NOW^XLFDT
    128  . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
    129  . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
    130  . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
    131  . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
    132  . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
    133  . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
    134  . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
    135  . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ;
    136  . D UPDIE ;
    137  . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
    138  . . S C0CSTOP=1
    139  . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
    140  . H 1 ; GIVE IT A BREAK
    141  I (C0CSTOP) S C0CDISP="KILLED"
    142  E  S C0CDISP="FINISHED"
    143  S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP
    144  D UPDIE ; SET DISPOSITION FIELD
    145  K ^TMP("C0CBAT","RUNNING")
    146  Q
    147  ;
    148 BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME
    149  ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
    150  N ZDFN
    151  S ZDFN=""
    152  F  S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN=""  D  ; ALL PATIENTS IN THE AC INDX
    153  . S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("
    154  . I '$D(@C0CBS@(ZZDFN)) Q  ; SKIP IF NOT IN SUBSCRIPTION LIST
    155  . S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST
    156  Q
    157  ;
    158 COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
    159  N ZI,ZN
    160  S ZN=0
    161  S ZI=""
    162  F  S ZI=$O(@ZB@(ZI)) Q:ZI=""  D  ;
    163  . S ZN=ZN+1
    164  Q ZN
    165  ;
    166 UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
    167  ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
    168  ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
    169  ;
    170  N ZCCRD,ZVARN,C0CFDA2
    171  S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
    172  S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
    173  I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
    174  . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
    175  . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
    176  . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
    177  . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
    178  . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
    179  . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
    180  . I $D(ZERR) D  ; LAYGO ERROR
    181  . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
    182  . E  D  ;
    183  . . D CLEAN^DILF ; CLEAN UP
    184  . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
    185  . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
    186  Q ZVARN
    187  ;
    188 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
    189  K ZERR
    190  D CLEAN^DILF
    191  D UPDATE^DIE("","C0CFDA","","ZERR")
    192  I $D(ZERR) D  ;
    193  . W "ERROR",!
    194  . ZWR ZERR
    195  . B
    196  K C0CFDA
    197  Q
    198  ;
    199 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
    200  ; TO SET TO VALUE C0CSV.
    201  ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
    202  ; C0CSN,C0CSV ARE PASSED BY VALUE
    203  ;
    204  N C0CSI,C0CSJ
    205  S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
    206  S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
    207  S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
    208  Q
    209 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
    210  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
    211  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    212  I '$D(ZTAB) S ZTAB="C0CA"
    213  N ZR
    214  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
    215  E  S ZR=""
    216  Q ZR
    217 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
    218  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
    219  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    220  I '$D(ZTAB) S ZTAB="C0CA"
    221  N ZR
    222  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
    223  E  S ZR=""
    224  Q ZR
    225  ;
    226 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
    227  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
    228  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    229  I '$D(ZTAB) S ZTAB="C0CA"
    230  N ZR
    231  I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
    232  E  S ZR=""
    233  Q ZR
    234  ;
     1C0CBAT    ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
     2        ;;1.0;C0C;;May 19, 2009;Build 1
     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        W "This is the CCR Batch Utility Library ",!
     21        Q
     22        ;
     23STOP    ; STOP A CURRENTLY RUNNING BATCH JOB
     24        I '$D(^TMP("C0CBAT","RUNNING")) Q  ;
     25        W !,!,"HALTING CCR BATCH",!
     26        S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE
     27        H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED
     28        I '$D(^TMP("C0CBAT","STOP")) D  ; SIGNAL RECEIVED
     29        . W "CCR BATCH JOB TERMINATING",!
     30        E  D  ;
     31        . K ^TMP("C0CBAT","STOP") ; STOP SIGNALING
     32        . W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!
     33        Q
     34        ;
     35START   ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION
     36        ;
     37        I $D(^TMP("C0CBAT","RUNNING")) D  Q  ; ONLY ONE ALLOWED AT A TIME
     38        . W !,"CCR BATCH ALREADY RUNNING",!
     39        . W !,"STOP FIRST WITH STOP^C0CBAT",!
     40        N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO
     41        S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"
     42        S ZTDTH=$H ;
     43        ;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10))
     44        S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""
     45        S ZTIO="NULL" ;
     46        W !,!,"CCR BATCH JOB STARTED",!
     47        D ^%ZTLOAD
     48        Q
     49        ;
     50EN      ; BATCH ENTRY POINT
     51        ; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
     52        ; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
     53        ; GENERATES A NEW CCR FOR THE PATIENT
     54        ; UPDATES THE E2 CCR ELEMENTS FILE
     55        ;
     56        S C0CQT=1 ; QUIET MODE
     57        I $D(^TMP("C0CBAT","RUNNING")) Q  ; ONLY ONE AT A TIME
     58        S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL
     59        S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN
     60        S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE
     61        S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE
     62        S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
     63        I $D(@C0CBB@(0)) D  ; ERROR SHOULDN'T EXIST
     64        . W "WORK AREA ERROR",!
     65        . B
     66        S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
     67        S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
     68        S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
     69        ;I $D(^C0CB("B",C0CDT)) D  ; BATCH RECORD EXISTS
     70        ;. H 10 ; HANG 10 SECONDS
     71        ;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN
     72        ;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK
     73        D BLDHOT(C0CBH) ; BUILD THE HOT LIST
     74        S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST
     75        S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS
     76        S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL
     77        S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM
     78        S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS
     79        S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST
     80        D UPDIE ; CREATE THE BATCH RECORD
     81        S C0CIEN=$O(^C0CB("B",C0CBDT,""))
     82        S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST
     83        S C0CBCUR="" ; CURRENT PATIENT
     84        S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""
     85        ;F  S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR=""  D  ; HOT LIST LATEST FIRST
     86        F  S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; HOT LIST FIRST
     87        . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")
     88        . I $G(C0CCHK) D  ;
     89        . . D PUTRIM^C0CFM2(C0CBCUR)
     90        . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
     91        . . K C0CFDA
     92        . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
     93        . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
     94        . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
     95        . . D UPDIE ; CREATE UPDATE SUBFILE
     96        . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
     97        . S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL
     98        . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
     99        . S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS
     100        . S C0CNOW=$$NOW^XLFDT
     101        . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
     102        . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
     103        . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
     104        . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
     105        . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
     106        . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
     107        . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
     108        . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED
     109        . D UPDIE ;
     110        . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
     111        . . S C0CSTOP=1
     112        . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
     113        . H 1 ; GIVE OTHERS A CHANCE
     114        F  S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="")  D  ; SUBS LIST
     115        . I $D(@C0CBH@(C0CBCUR)) Q  ; SKIP IF IN HOT LIST - ALREADY DONE
     116        . D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")
     117        . I $G(C0CCHK) D  ; IF CHECKSUMS HAVE CHANGED
     118        . . D PUTRIM^C0CFM2(C0CBCUR)
     119        . . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
     120        . . K C0CFDA
     121        . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
     122        . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
     123        . . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
     124        . . D UPDIE ; CREATE UPDATE SUBFILE
     125        . S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
     126        . S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
     127        . S C0CNOW=$$NOW^XLFDT
     128        . S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
     129        . S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
     130        . S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
     131        . S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
     132        . S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
     133        . S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
     134        . S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
     135        . S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ;
     136        . D UPDIE ;
     137        . I $D(^TMP("C0CBAT","STOP")) D  ; IF STOP SIGNAL DETECTED
     138        . . S C0CSTOP=1
     139        . . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
     140        . H 1 ; GIVE IT A BREAK
     141        I (C0CSTOP) S C0CDISP="KILLED"
     142        E  S C0CDISP="FINISHED"
     143        S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP
     144        D UPDIE ; SET DISPOSITION FIELD
     145        K ^TMP("C0CBAT","RUNNING")
     146        Q
     147        ;
     148BLDHOT(ZHB)     ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME
     149        ; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
     150        N ZDFN
     151        S ZDFN=""
     152        F  S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN=""  D  ; ALL PATIENTS IN THE AC INDX
     153        . S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("
     154        . I '$D(@C0CBS@(ZZDFN)) Q  ; SKIP IF NOT IN SUBSCRIPTION LIST
     155        . S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST
     156        Q
     157        ;
     158COUNT(ZB)       ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
     159        N ZI,ZN
     160        S ZN=0
     161        S ZI=""
     162        F  S ZI=$O(@ZB@(ZI)) Q:ZI=""  D  ;
     163        . S ZN=ZN+1
     164        Q ZN
     165        ;
     166UPDIEVARPTR(ZVAR,ZTYP)  ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
     167        ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
     168        ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
     169        ;
     170        N ZCCRD,ZVARN,C0CFDA2
     171        S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
     172        S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
     173        I ZVARN="" D  ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
     174        . I '$D(ZTYP) D  Q  ; WON'T ADD A VARIABLE WITHOUT A TYPE
     175        . . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
     176        . S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
     177        . S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
     178        . D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
     179        . D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
     180        . I $D(ZERR) D  ; LAYGO ERROR
     181        . . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
     182        . E  D  ;
     183        . . D CLEAN^DILF ; CLEAN UP
     184        . . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
     185        . . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
     186        Q ZVARN
     187        ;
     188UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
     189        K ZERR
     190        D CLEAN^DILF
     191        D UPDATE^DIE("","C0CFDA","","ZERR")
     192        I $D(ZERR) D  ;
     193        . W "ERROR",!
     194        . ZWR ZERR
     195        . B
     196        K C0CFDA
     197        Q
     198        ;
     199SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
     200        ; TO SET TO VALUE C0CSV.
     201        ; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
     202        ; C0CSN,C0CSV ARE PASSED BY VALUE
     203        ;
     204        N C0CSI,C0CSJ
     205        S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
     206        S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
     207        S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
     208        Q
     209ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
     210        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
     211        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     212        I '$D(ZTAB) S ZTAB="C0CA"
     213        N ZR
     214        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
     215        E  S ZR=""
     216        Q ZR
     217ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
     218        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
     219        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     220        I '$D(ZTAB) S ZTAB="C0CA"
     221        N ZR
     222        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
     223        E  S ZR=""
     224        Q ZR
     225        ;
     226ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
     227        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
     228        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     229        I '$D(ZTAB) S ZTAB="C0CA"
     230        N ZR
     231        I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
     232        E  S ZR=""
     233        Q ZR
     234        ;
  • ccr/branches/ohum/p/C0CCCD.m

    r1329 r1330  
    1 C0CCCD   ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
    2  ;;1.0;C0C;;May 19, 2009;Build 38
    3  ;Copyright 2008,2009 George Lilly, University of Minnesota.
    4  ;Licensed under the terms of the GNU General Public License.
    5  ;See attached copy of the License.
    6  ;
    7  ;This program is free software; you can redistribute it and/or modify
    8  ;it under the terms of the GNU General Public License as published by
    9  ;the Free Software Foundation; either version 2 of the License, or
    10  ;(at your option) any later version.
    11  ;
    12  ;This program is distributed in the hope that it will be useful,
    13  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15  ;GNU General Public License for more details.
    16  ;
    17  ;You should have received a copy of the GNU General Public License along
    18  ;with this program; if not, write to the Free Software Foundation, Inc.,
    19  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20  ;
    21  ; EXPORT A CCR
    22  ;
    23 EXPORT   ; EXPORT ENTRY POINT FOR CCR
    24        ; Select a patient.
    25        S DIC=2,DIC(0)="AEMQ" D ^DIC
    26        I Y<1 Q  ; EXIT
    27        S DFN=$P(Y,U,1) ; SET THE PATIENT
    28        D XPAT(DFN,"","") ; EXPORT TO A FILE
    29        Q
    30        ;
    31 XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
    32        ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
    33        ; FN IS FILE NAME, DEFAULTS IF NULL
    34        ; N CCDGLO
    35        D CCDRPC(.CCDGLO,DFN,"CCD","","","")
    36        S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
    37        S ONAM=FN
    38        I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
    39        S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
    40        I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
    41        . S @ODIRGLB="/home/glilly/CCROUT"
    42        . ;S @ODIRGLB="/home/cedwards/"
    43        . ;S @ODIRGLB="/opt/wv/p/"
    44        S ODIR=DIR
    45        I DIR="" S ODIR=@ODIRGLB
    46        N ZY
    47        S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
    48        W $P(ZY,U,2)
    49        Q
    50        ;
    51 CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
    52     ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
    53     ; DFN IS PATIENT IEN
    54     ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
    55     ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
    56     ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
    57     ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
    58     ; - NULL MEANS NOW
    59     ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
    60     ;    "TO" VARIABLES
    61     ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
    62     I '$D(DEBUG) S DEBUG=0
    63     N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
    64     I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
    65     S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
    66     I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
    67     E  S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
    68     S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
    69     ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
    70     S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
    71     I CCD D LOAD^C0CCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
    72     E  D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
    73     D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
    74     N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
    75     S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
    76     S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
    77     S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
    78     S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
    79     S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
    80     S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
    81     ;
    82     ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
    83     ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
    84     D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
    85     D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
    86     I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
    87     I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
    88     ;
    89     I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
    90     ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
    91     S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
    92     D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
    93     D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
    94     I DEBUG D PARY^C0CXPATH("ACTT2")
    95     D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
    96     I DEBUG D PARY^C0CXPATH(CCDGLO)
    97     K ACTT1 K ACCT2
    98     ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
    99     ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
    100     D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
    101     D CP^C0CXPATH("ACTT2",CCDGLO)
    102     ;
    103     K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
    104     S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
    105     D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
    106     N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
    107     F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
    108     . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
    109     . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
    110     . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
    111     . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
    112     . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
    113     . S IXML="INXML"
    114     . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
    115     . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
    116     . ; W OXML,!
    117     . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
    118     . W "RUNNING ",CALL,!
    119     . X CALL
    120     . I @OXML@(0)'=0 D  ; THERE IS A RESULT
    121     . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
    122     . . I CCD D UNSHAVE("ITMP",OXML)
    123     . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
    124     . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
    125     . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
    126     . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
    127     ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
    128     ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
    129     ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
    130     ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
    131     ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
    132     N I,J,DONE S DONE=0
    133     F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
    134     . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
    135     . W "TRIMMED",J,!
    136     . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
    137     I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
    138     . N I
    139     . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
    140     . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
    141     . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
    142     . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
    143     . . . S @CCDGLO@(I)="</structuredBody></component>"
    144     S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
    145     S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
    146     Q
    147     ;
    148 INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
    149     ; TAB IS PASSED BY NAME
    150     W "TAB= ",TAB,!
    151     ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
    152     D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
    153     ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
    154     I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
    155     Q
    156     ;
    157 SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
    158     ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
    159     N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
    160     W SHXML,!
    161     W @SHXML@(1),!
    162     D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
    163     D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
    164     D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
    165     D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
    166     D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
    167     D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
    168     Q
    169     ;
    170 UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
    171     ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
    172     N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
    173     W SHXML,!
    174     W @SHXML@(1),!
    175     D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
    176     D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
    177     D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
    178     D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
    179     D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
    180     D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
    181     Q
    182     ;
    183 HDRMAP(CXML,DFN,IHDR)   ; MAP HEADER VARIABLES: FROM, TO ECT
    184     N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
    185     ; K @VMAP
    186     S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
    187     I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
    188     . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
    189     . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
    190     . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
    191     . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
    192     . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
    193     . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
    194     . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
    195     I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
    196     . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
    197     N CTMP
    198     D MAP^C0CXPATH(CXML,VMAP,"CTMP")
    199     D CP^C0CXPATH("CTMP",CXML)
    200     Q
    201     ;
    202 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
    203     ; AXML AND ACTRTN ARE PASSED BY NAME
    204     ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
    205     ; P1= OBJECTID - ACTORPATIENT_2
    206     ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
    207     ;OR INSTITUTION
    208     ;  OR PERSON(IN PATIENT FILE IE NOK)
    209     ; P3= IEN RECORD NUMBER FOR ACTOR - 2
    210     N I,J,K,L
    211     K @ACTRTN ; CLEAR RETURN ARRAY
    212     F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
    213     . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
    214     . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
    215     . . W "<ActorID>=>",J,!
    216     . . I J'="" S K(J)="" ; HASHING ACTOR
    217     . . ;  TO GET RID OF DUPLICATES
    218     S I="" ; GOING TO $O THROUGH THE HASH
    219     F J=0:0 D  Q:$O(K(I))=""  ;
    220     . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
    221     . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
    222     . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
    223     . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
    224     . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
    225     Q
    226     ;
    227 TEST ; RUN ALL THE TEST CASES
    228   D TESTALL^C0CUNIT("C0CCCR")
    229   Q
    230   ;
    231 ZTEST(WHICH)  ; RUN ONE SET OF TESTS
    232   N ZTMP
    233   D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
    234   D ZTEST^C0CUNIT(.ZTMP,WHICH)
    235   Q
    236   ;
    237 TLIST  ; LIST THE TESTS
    238   N ZTMP
    239   D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
    240   D TLIST^C0CUNIT(.ZTMP)
    241   Q
    242   ;
    243  ;;><TEST>
    244  ;;><PROBLEMS>
    245  ;;>>>K C0C S C0C=""
    246  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
    247  ;;>>?@C0C@(@C0C@(0))["</Problems>"
    248  ;;><VITALS>
    249  ;;>>>K C0C S C0C=""
    250  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
    251  ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
    252  ;;><CCR>
    253  ;;>>>K C0C S C0C=""
    254  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
    255  ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
    256  ;;><ACTLST>
    257  ;;>>>K C0C S C0C=""
    258  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
    259  ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
    260  ;;><ACTORS>
    261  ;;>>>D ZTEST^C0CCCR("ACTLST")
    262  ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
    263  ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
    264  ;;>>?G3(G3(0))["</Actors>"
    265  ;;><TRIM>
    266  ;;>>>D ZTEST^C0CCCR("CCR")
    267  ;;>>>W $$TRIM^C0CXPATH(CCDGLO)
    268  ;;><CCD>
    269  ;;>>>K C0C S C0C=""
    270  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
    271  ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
    272  ;;></TEST>
     1C0CCCD    ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
     2        ;;1.0;C0C;;May 19, 2009;Build 1
     3        ;Copyright 2008,2009 George Lilly, University of Minnesota.
     4        ;Licensed under the terms of the GNU General Public License.
     5        ;See attached copy of the License.
     6        ;
     7        ;This program is free software; you can redistribute it and/or modify
     8        ;it under the terms of the GNU General Public License as published by
     9        ;the Free Software Foundation; either version 2 of the License, or
     10        ;(at your option) any later version.
     11        ;
     12        ;This program is distributed in the hope that it will be useful,
     13        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     14        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15        ;GNU General Public License for more details.
     16        ;
     17        ;You should have received a copy of the GNU General Public License along
     18        ;with this program; if not, write to the Free Software Foundation, Inc.,
     19        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20        ;
     21        ; EXPORT A CCR
     22        ;
     23EXPORT    ; EXPORT ENTRY POINT FOR CCR
     24              ; Select a patient.
     25              S DIC=2,DIC(0)="AEMQ" D ^DIC
     26              I Y<1 Q  ; EXIT
     27              S DFN=$P(Y,U,1) ; SET THE PATIENT
     28              D XPAT(DFN,"","") ; EXPORT TO A FILE
     29              Q
     30              ;
     31XPAT(DFN,DIR,FN)        ; EXPORT ONE PATIENT TO A FILE
     32              ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
     33              ; FN IS FILE NAME, DEFAULTS IF NULL
     34              ; N CCDGLO
     35              D CCDRPC(.CCDGLO,DFN,"CCD","","","")
     36              S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
     37              S ONAM=FN
     38              I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
     39              S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
     40              I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
     41              . S @ODIRGLB="/home/glilly/CCROUT"
     42              . ;S @ODIRGLB="/home/cedwards/"
     43              . ;S @ODIRGLB="/opt/wv/p/"
     44              S ODIR=DIR
     45              I DIR="" S ODIR=@ODIRGLB
     46              N ZY
     47              S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
     48              W $P(ZY,U,2)
     49              Q
     50              ;
     51CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY)  ;RPC ENTRY POINT FOR CCR OUTPUT
     52           ; CCRGRTN IS RETURN ARRAY PASSED BY NAME
     53           ; DFN IS PATIENT IEN
     54           ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
     55           ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
     56           ; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
     57           ; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
     58           ; - NULL MEANS NOW
     59           ; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
     60           ;    "TO" VARIABLES
     61           ;    IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
     62           I '$D(DEBUG) S DEBUG=0
     63           N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
     64           I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
     65           S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
     66           I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
     67           E  S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
     68           S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
     69           ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
     70           S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
     71           I CCD D LOAD^C0CCCD1(TGLOBAL)  ; LOAD THE CCR TEMPLATE
     72           E  D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
     73           D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
     74           N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
     75           S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
     76           S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
     77           S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
     78           S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
     79           S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
     80           S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
     81           ;
     82           ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
     83           ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
     84           D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
     85           D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
     86           I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
     87           I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
     88           ;
     89           I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
     90           ; MAPPING THE PATIENT PORTION OF THE CDA HEADER
     91           S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
     92           D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
     93           D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
     94           I DEBUG D PARY^C0CXPATH("ACTT2")
     95           D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
     96           I DEBUG D PARY^C0CXPATH(CCDGLO)
     97           K ACTT1 K ACCT2
     98           ; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
     99           ; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
     100           D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
     101           D CP^C0CXPATH("ACTT2",CCDGLO)
     102           ;
     103           K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
     104           S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
     105           D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
     106           N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
     107           F I=1:1:@CCRXTAB@(0)  D  ; PROCESS THE CCR BODY SECTIONS
     108           . S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
     109           . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
     110           . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
     111           . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
     112           . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
     113           . S IXML="INXML"
     114           . I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
     115           . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
     116           . ; W OXML,!
     117           . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
     118           . W "RUNNING ",CALL,!
     119           . X CALL
     120           . I @OXML@(0)'=0 D  ; THERE IS A RESULT
     121           . . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
     122           . . I CCD D UNSHAVE("ITMP",OXML)
     123           . . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
     124           . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
     125           . D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
     126           . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
     127           ; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
     128           ; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
     129           ; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
     130           ; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
     131           ; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
     132           N I,J,DONE S DONE=0
     133           F I=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
     134           . S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
     135           . W "TRIMMED",J,!
     136           . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
     137           I CCD D  ; TURN THE BODY INTO A CCD COMPONENT
     138           . N I
     139           . F I=1:1:@CCDGLO@(0) D  ; SEARCH THROUGH THE ENTIRE ARRAY
     140           . . I @CCDGLO@(I)["<Body>" D  ; REPLACE BODY MARKUP
     141           . . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
     142           . . I @CCDGLO@(I)["</Body>" D  ; REPLACE BODY MARKUP
     143           . . . S @CCDGLO@(I)="</structuredBody></component>"
     144           S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
     145           S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
     146           Q
     147           ;
     148INITSTPS(TAB)    ; INITIALIZE CCR PROCESSING STEPS
     149           ; TAB IS PASSED BY NAME
     150           W "TAB= ",TAB,!
     151           ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
     152           D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
     153           ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
     154           I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
     155           Q
     156           ;
     157SHAVE(SHXML)    ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
     158           ; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
     159           N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
     160           W SHXML,!
     161           W @SHXML@(1),!
     162           D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
     163           D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
     164           D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
     165           D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
     166           D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
     167           D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
     168           Q
     169           ;
     170UNSHAVE(ORIGXML,SHXML)  ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
     171           ; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
     172           N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
     173           W SHXML,!
     174           W @SHXML@(1),!
     175           D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
     176           D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
     177           D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
     178           D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
     179           D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
     180           D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
     181           Q
     182           ;
     183HDRMAP(CXML,DFN,IHDR)     ; MAP HEADER VARIABLES: FROM, TO ECT
     184           N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
     185           ; K @VMAP
     186           S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
     187           I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
     188           . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
     189           . S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
     190           . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
     191           . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN  ; FOR TEST PURPOSES
     192           . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
     193           . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
     194           . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
     195           I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
     196           . D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
     197           N CTMP
     198           D MAP^C0CXPATH(CXML,VMAP,"CTMP")
     199           D CP^C0CXPATH("CTMP",CXML)
     200           Q
     201           ;
     202ACTLST(AXML,ACTRTN)     ; RETURN THE ACTOR LIST FOR THE XML IN AXML
     203           ; AXML AND ACTRTN ARE PASSED BY NAME
     204           ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
     205           ; P1= OBJECTID - ACTORPATIENT_2
     206           ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
     207           ;OR INSTITUTION
     208           ;  OR PERSON(IN PATIENT FILE IE NOK)
     209           ; P3= IEN RECORD NUMBER FOR ACTOR - 2
     210           N I,J,K,L
     211           K @ACTRTN ; CLEAR RETURN ARRAY
     212           F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
     213           . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
     214           . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
     215           . . W "<ActorID>=>",J,!
     216           . . I J'="" S K(J)="" ; HASHING ACTOR
     217           . . ;  TO GET RID OF DUPLICATES
     218           S I="" ; GOING TO $O THROUGH THE HASH
     219           F J=0:0 D  Q:$O(K(I))=""  ;
     220           . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
     221           . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
     222           . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
     223           . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
     224           . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
     225           Q
     226           ;
     227TEST    ; RUN ALL THE TEST CASES
     228        D TESTALL^C0CUNIT("C0CCCR")
     229        Q
     230        ;
     231ZTEST(WHICH)    ; RUN ONE SET OF TESTS
     232        N ZTMP
     233        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
     234        D ZTEST^C0CUNIT(.ZTMP,WHICH)
     235        Q
     236        ;
     237TLIST    ; LIST THE TESTS
     238        N ZTMP
     239        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
     240        D TLIST^C0CUNIT(.ZTMP)
     241        Q
     242        ;
     243        ;;><TEST>
     244        ;;><PROBLEMS>
     245        ;;>>>K C0C S C0C=""
     246        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
     247        ;;>>?@C0C@(@C0C@(0))["</Problems>"
     248        ;;><VITALS>
     249        ;;>>>K C0C S C0C=""
     250        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
     251        ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
     252        ;;><CCR>
     253        ;;>>>K C0C S C0C=""
     254        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
     255        ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
     256        ;;><ACTLST>
     257        ;;>>>K C0C S C0C=""
     258        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
     259        ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
     260        ;;><ACTORS>
     261        ;;>>>D ZTEST^C0CCCR("ACTLST")
     262        ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
     263        ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
     264        ;;>>?G3(G3(0))["</Actors>"
     265        ;;><TRIM>
     266        ;;>>>D ZTEST^C0CCCR("CCR")
     267        ;;>>>W $$TRIM^C0CXPATH(CCDGLO)
     268        ;;><CCD>
     269        ;;>>>K C0C S C0C=""
     270        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
     271        ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
     272        ;;></TEST>
  • ccr/branches/ohum/p/C0CCCD1.m

    r1329 r1330  
    1 C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
    2  ;;1.0;C0C;;May 19, 2009;Build 38
    3  ;Copyright 2008,2009 George Lilly, University of Minnesota.
    4  ;Licensed under the terms of the GNU General Public License.
    5  ;See attached copy of the License.
    6  ;
    7  ;This program is free software; you can redistribute it and/or modify
    8  ;it under the terms of the GNU General Public License as published by
    9  ;the Free Software Foundation; either version 2 of the License, or
    10  ;(at your option) any later version.
    11  ;
    12  ;This program is distributed in the hope that it will be useful,
    13  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15  ;GNU General Public License for more details.
    16  ;
    17  ;You should have received a copy of the GNU General Public License along
    18  ;with this program; if not, write to the Free Software Foundation, Inc.,
    19  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20  ;
    21           W "This is a CCD TEMPLATE with processing routines",!
    22           W !
    23           Q
    24           ;
    25 ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
    26           ; ZARY IS PASSED BY NAME
    27           ; BAT is a string identifying the section
    28           ; LINE is a test which will evaluate to true or false
    29           ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
    30           ; . S @ZARY@(0)=0 ; initially there are no elements
    31           ; . W "GOT HERE LOADING "_LINE,!
    32           N CNT ; count of array elements
    33           S CNT=@ZARY@(0) ; contains array count
    34           S CNT=CNT+1 ; increment count
    35           S @ZARY@(CNT)=LINE ; put the line in the array
    36           ; S @ZARY@(BAT,CNT)="" ; index the test by battery
    37           S @ZARY@(0)=CNT ; update the array counter
    38           Q
    39           ;
    40 ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
    41           ; ZARY IS PASSED BY NAME
    42           ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
    43           ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
    44           K @ZARY S @ZARY=""
    45           S @ZARY@(0)=0 ; initialize array count
    46           N LINE,LABEL,BODY
    47           N INTEST S INTEST=0 ; switch for in the TEMPLATE section
    48           N SECTION S SECTION="[anonymous]" ; NO section LABEL
    49           ;
    50           N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
    51           . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
    52           . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
    53           . I INTEST  D  ; within the section
    54           . . I LINE?." "1";><".E  D  ; sub-section name found
    55           . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
    56           . . I LINE?." "1";;".E  D  ; line found
    57           . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
    58           Q
    59           ;
    60 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
    61           D ZLOAD(ARY,"C0CCCD1")
    62           ; ZWR @ARY
    63           Q
    64           ;
    65 TRMCCD    ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
    66           Q
    67 MARKUP ;<MARKUP>
    68  ;;<Body>
    69  ;;<Problems>
    70  ;;</Problems>
    71  ;;<FamilyHistory>
    72  ;;</FamilyHistory>
    73  ;;<SocialHistory>
    74  ;;</SocialHistory>
    75  ;;<Alerts>
    76  ;;</Alerts>
    77  ;;<Medications>
    78  ;;</Medications>
    79  ;;<VitalSigns>
    80  ;;</VitalSigns>
    81  ;;<Results>
    82  ;;</Results>
    83  ;;</Body>
    84  ;;</ContinuityOfCareRecord>
    85  ;</MARKUP>
    86  ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
    87  ;;</ClinicalDocument>
    88  Q
    89  ;
    90  ;<TEMPLATE>
    91  ;;<?xml version="1.0"?>
    92  ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
    93  ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
    94  ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
    95  ;;<templateId root="2.16.840.1.113883.10.20.1"/>
    96  ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
    97  ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
    98  ;;<title>Continuity of Care Document</title>
    99  ;;<effectiveTime value="20000407130000+0500"/>
    100  ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
    101  ;;<languageCode code="en-US"/>
    102  ;;<recordTarget>
    103  ;;<patientRole>
    104  ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
    105  ;;<patient>
    106  ;;<name>
    107  ;;<given>@@ACTORGIVENNAME@@</given>
    108  ;;<family>@@ACTORFAMILYNAME@@</family>
    109  ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
    110  ;;</name>
    111  ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
    112  ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
    113  ;;</patient>
    114  ;;<providerOrganization>
    115  ;;<id root="2.16.840.1.113883.19.5"/>
    116  ;;<name>@@ORGANIZATIONNAME@@</name>
    117  ;;</providerOrganization>
    118  ;;</patientRole>
    119  ;;</recordTarget>
    120  ;;<author>
    121  ;;<time value="20000407130000+0500"/>
    122  ;;<assignedAuthor>
    123  ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
    124  ;;<assignedPerson>
    125  ;;<name>
    126  ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
    127  ;;<given>@@ACTORGIVENNAME@@</given>
    128  ;;<family>@@ACTORFAMILYNAME@@</family>
    129  ;;</name>
    130  ;;</assignedPerson>
    131  ;;<representedOrganization>
    132  ;;<id root="2.16.840.1.113883.19.5"/>
    133  ;;<name>@@ORGANIZATIONNAME@@</name>
    134  ;;</representedOrganization>
    135  ;;</assignedAuthor>
    136  ;;</author>
    137  ;;<informant>
    138  ;;<assignedEntity>
    139  ;;<id nullFlavor="NI"/>
    140  ;;<representedOrganization>
    141  ;;<id root="2.16.840.1.113883.19.5"/>
    142  ;;<name>@@ORGANIZATIONNAME@@</name>
    143  ;;</representedOrganization>
    144  ;;</assignedEntity>
    145  ;;</informant>
    146  ;;<custodian>
    147  ;;<assignedCustodian>
    148  ;;<representedCustodianOrganization>
    149  ;;<id root="2.16.840.1.113883.19.5"/>
    150  ;;<name>@@ORGANIZATIONNAME@@</name>
    151  ;;</representedCustodianOrganization>
    152  ;;</assignedCustodian>
    153  ;;</custodian>
    154  ;;<legalAuthenticator>
    155  ;;<time value="20000407130000+0500"/>
    156  ;;<signatureCode code="S"/>
    157  ;;<assignedEntity>
    158  ;;<id nullFlavor="NI"/>
    159  ;;<representedOrganization>
    160  ;;<id root="2.16.840.1.113883.19.5"/>
    161  ;;<name>@@ORGANIZATIONNAME@@</name>
    162  ;;</representedOrganization>
    163  ;;</assignedEntity>
    164  ;;</legalAuthenticator>
    165  ;;<Actors>
    166  ;;<ACTOR-NOK>
    167  ;;<participant typeCode="IND">
    168  ;;<associatedEntity classCode="NOK">
    169  ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
    170  ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
    171  ;;<telecom value="tel:(999)555-1212"/>
    172  ;;<associatedPerson>
    173  ;;<name>
    174  ;;<given>Henrietta</given>
    175  ;;<family>Levin</family>
    176  ;;</name>
    177  ;;</associatedPerson>
    178  ;;</associatedEntity>
    179  ;;</participant>
    180  ;;</ACTOR-NOK>
    181  ;;</Actors>
    182  ;;<documentationOf>
    183  ;;<serviceEvent classCode="PCPR">
    184  ;;<effectiveTime>
    185  ;;<high value="@@DATETIME@@"/>
    186  ;;</effectiveTime>
    187  ;;<performer typeCode="PRF">
    188  ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
    189  ;;<time>
    190  ;;<low value="1990"/>
    191  ;;<high value='20000407'/>
    192  ;;</time>
    193  ;;<assignedEntity>
    194  ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
    195  ;;<assignedPerson>
    196  ;;<name>
    197  ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
    198  ;;<given>@@ACTORGIVENNAME@@</given>
    199  ;;<family>@@ACTORFAMILYNAME@@</family>
    200  ;;</name>
    201  ;;</assignedPerson>
    202  ;;<representedOrganization>
    203  ;;<id root="2.16.840.1.113883.19.5"/>
    204  ;;<name>@@ORGANIZATIONNAME@@</name>
    205  ;;</representedOrganization>
    206  ;;</assignedEntity>
    207  ;;</performer>
    208  ;;</serviceEvent>
    209  ;;</documentationOf>
    210  ;;<Body>
    211  ;;<PROBLEMS-HTML>
    212  ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
    213  ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
    214  ;;<td>@@PROBLEMDATEOFONSET@@</td>
    215  ;;<td>Active</td></tr>
    216  ;;</tbody></table></text>
    217  ;;</PROBLEMS-HTML>
    218  ;;<Problems>
    219  ;;<component>
    220  ;;<section>
    221  ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
    222  ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
    223  ;;<title>Problems</title>
    224  ;;<entry typeCode="DRIV">
    225  ;;<act classCode="ACT" moodCode="EVN">
    226  ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
    227  ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
    228  ;;<code nullFlavor="NA"/>
    229  ;;<entryRelationship typeCode="SUBJ">
    230  ;;<observation classCode="OBS" moodCode="EVN">
    231  ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
    232  ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
    233  ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
    234  ;;<statusCode code="completed"/>
    235  ;;<effectiveTime>
    236  ;;<low value="@@PROBLEMDATEOFONSET@@"/>
    237  ;;</effectiveTime>
    238  ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
    239  ;;<entryRelationship typeCode="REFR">
    240  ;;<observation classCode="OBS" moodCode="EVN">
    241  ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
    242  ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
    243  ;;<statusCode code="completed"/>
    244  ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
    245  ;;</observation>
    246  ;;</entryRelationship>
    247  ;;</observation>
    248  ;;</entryRelationship>
    249  ;;</act>
    250  ;;</entry>
    251  ;;</section>
    252  ;;</component>
    253  ;;</Problems>
    254  ;;<FamilyHistory>
    255  ;;</FamilyHistory>
    256  ;;<SocialHistory>
    257  ;;</SocialHistory>
    258  ;;<Alerts>
    259  ;;</Alerts>
    260  ;;<Medications>
    261  ;;</Medications>
    262  ;;<VitalSigns>
    263  ;;</VitalSigns>
    264  ;;<Results>
    265  ;;</Results>
    266  ;;</Body>
    267  ;;</ClinicalDocument>
    268  ;</TEMPLATE>
     1C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
     2        ;;1.0;C0C;;May 19, 2009;Build 1
     3        ;Copyright 2008,2009 George Lilly, University of Minnesota.
     4        ;Licensed under the terms of the GNU General Public License.
     5        ;See attached copy of the License.
     6        ;
     7        ;This program is free software; you can redistribute it and/or modify
     8        ;it under the terms of the GNU General Public License as published by
     9        ;the Free Software Foundation; either version 2 of the License, or
     10        ;(at your option) any later version.
     11        ;
     12        ;This program is distributed in the hope that it will be useful,
     13        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     14        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15        ;GNU General Public License for more details.
     16        ;
     17        ;You should have received a copy of the GNU General Public License along
     18        ;with this program; if not, write to the Free Software Foundation, Inc.,
     19        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20        ;
     21                 W "This is a CCD TEMPLATE with processing routines",!
     22                 W !
     23                 Q
     24                 ;
     25ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
     26                 ; ZARY IS PASSED BY NAME
     27                 ; BAT is a string identifying the section
     28                 ; LINE is a test which will evaluate to true or false
     29                 ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
     30                 ; . S @ZARY@(0)=0 ; initially there are no elements
     31                 ; . W "GOT HERE LOADING "_LINE,!
     32                 N CNT ; count of array elements
     33                 S CNT=@ZARY@(0) ; contains array count
     34                 S CNT=CNT+1 ; increment count
     35                 S @ZARY@(CNT)=LINE ; put the line in the array
     36                 ; S @ZARY@(BAT,CNT)="" ; index the test by battery
     37                 S @ZARY@(0)=CNT ; update the array counter
     38                 Q
     39                 ;
     40ZLOAD(ZARY,ROUTINE)     ; load tests into ZARY which is passed by reference
     41                 ; ZARY IS PASSED BY NAME
     42                 ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
     43                 ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
     44                 K @ZARY S @ZARY=""
     45                 S @ZARY@(0)=0 ; initialize array count
     46                 N LINE,LABEL,BODY
     47                 N INTEST S INTEST=0 ; switch for in the TEMPLATE section
     48                 N SECTION S SECTION="[anonymous]" ; NO section LABEL
     49                 ;
     50                 N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
     51                 . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
     52                 . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
     53                 . I INTEST  D  ; within the section
     54                 . . I LINE?." "1";><".E  D  ; sub-section name found
     55                 . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
     56                 . . I LINE?." "1";;".E  D  ; line found
     57                 . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
     58                 Q
     59                 ;
     60LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
     61                 D ZLOAD(ARY,"C0CCCD1")
     62                 ; ZWR @ARY
     63                 Q
     64                 ;
     65TRMCCD     ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
     66                 Q
     67MARKUP  ;<MARKUP>
     68        ;;<Body>
     69        ;;<Problems>
     70        ;;</Problems>
     71        ;;<FamilyHistory>
     72        ;;</FamilyHistory>
     73        ;;<SocialHistory>
     74        ;;</SocialHistory>
     75        ;;<Alerts>
     76        ;;</Alerts>
     77        ;;<Medications>
     78        ;;</Medications>
     79        ;;<VitalSigns>
     80        ;;</VitalSigns>
     81        ;;<Results>
     82        ;;</Results>
     83        ;;</Body>
     84        ;;</ContinuityOfCareRecord>
     85        ;</MARKUP>
     86        ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
     87        ;;</ClinicalDocument>
     88        Q
     89        ;
     90        ;<TEMPLATE>
     91        ;;<?xml version="1.0"?>
     92        ;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
     93        ;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
     94        ;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
     95        ;;<templateId root="2.16.840.1.113883.10.20.1"/>
     96        ;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
     97        ;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
     98        ;;<title>Continuity of Care Document</title>
     99        ;;<effectiveTime value="20000407130000+0500"/>
     100        ;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
     101        ;;<languageCode code="en-US"/>
     102        ;;<recordTarget>
     103        ;;<patientRole>
     104        ;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
     105        ;;<patient>
     106        ;;<name>
     107        ;;<given>@@ACTORGIVENNAME@@</given>
     108        ;;<family>@@ACTORFAMILYNAME@@</family>
     109        ;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
     110        ;;</name>
     111        ;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
     112        ;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
     113        ;;</patient>
     114        ;;<providerOrganization>
     115        ;;<id root="2.16.840.1.113883.19.5"/>
     116        ;;<name>@@ORGANIZATIONNAME@@</name>
     117        ;;</providerOrganization>
     118        ;;</patientRole>
     119        ;;</recordTarget>
     120        ;;<author>
     121        ;;<time value="20000407130000+0500"/>
     122        ;;<assignedAuthor>
     123        ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
     124        ;;<assignedPerson>
     125        ;;<name>
     126        ;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
     127        ;;<given>@@ACTORGIVENNAME@@</given>
     128        ;;<family>@@ACTORFAMILYNAME@@</family>
     129        ;;</name>
     130        ;;</assignedPerson>
     131        ;;<representedOrganization>
     132        ;;<id root="2.16.840.1.113883.19.5"/>
     133        ;;<name>@@ORGANIZATIONNAME@@</name>
     134        ;;</representedOrganization>
     135        ;;</assignedAuthor>
     136        ;;</author>
     137        ;;<informant>
     138        ;;<assignedEntity>
     139        ;;<id nullFlavor="NI"/>
     140        ;;<representedOrganization>
     141        ;;<id root="2.16.840.1.113883.19.5"/>
     142        ;;<name>@@ORGANIZATIONNAME@@</name>
     143        ;;</representedOrganization>
     144        ;;</assignedEntity>
     145        ;;</informant>
     146        ;;<custodian>
     147        ;;<assignedCustodian>
     148        ;;<representedCustodianOrganization>
     149        ;;<id root="2.16.840.1.113883.19.5"/>
     150        ;;<name>@@ORGANIZATIONNAME@@</name>
     151        ;;</representedCustodianOrganization>
     152        ;;</assignedCustodian>
     153        ;;</custodian>
     154        ;;<legalAuthenticator>
     155        ;;<time value="20000407130000+0500"/>
     156        ;;<signatureCode code="S"/>
     157        ;;<assignedEntity>
     158        ;;<id nullFlavor="NI"/>
     159        ;;<representedOrganization>
     160        ;;<id root="2.16.840.1.113883.19.5"/>
     161        ;;<name>@@ORGANIZATIONNAME@@</name>
     162        ;;</representedOrganization>
     163        ;;</assignedEntity>
     164        ;;</legalAuthenticator>
     165        ;;<Actors>
     166        ;;<ACTOR-NOK>
     167        ;;<participant typeCode="IND">
     168        ;;<associatedEntity classCode="NOK">
     169        ;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
     170        ;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
     171        ;;<telecom value="tel:(999)555-1212"/>
     172        ;;<associatedPerson>
     173        ;;<name>
     174        ;;<given>Henrietta</given>
     175        ;;<family>Levin</family>
     176        ;;</name>
     177        ;;</associatedPerson>
     178        ;;</associatedEntity>
     179        ;;</participant>
     180        ;;</ACTOR-NOK>
     181        ;;</Actors>
     182        ;;<documentationOf>
     183        ;;<serviceEvent classCode="PCPR">
     184        ;;<effectiveTime>
     185        ;;<high value="@@DATETIME@@"/>
     186        ;;</effectiveTime>
     187        ;;<performer typeCode="PRF">
     188        ;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
     189        ;;<time>
     190        ;;<low value="1990"/>
     191        ;;<high value='20000407'/>
     192        ;;</time>
     193        ;;<assignedEntity>
     194        ;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
     195        ;;<assignedPerson>
     196        ;;<name>
     197        ;;<prefix>@@ACTORPREFIXNAME@@</prefix>
     198        ;;<given>@@ACTORGIVENNAME@@</given>
     199        ;;<family>@@ACTORFAMILYNAME@@</family>
     200        ;;</name>
     201        ;;</assignedPerson>
     202        ;;<representedOrganization>
     203        ;;<id root="2.16.840.1.113883.19.5"/>
     204        ;;<name>@@ORGANIZATIONNAME@@</name>
     205        ;;</representedOrganization>
     206        ;;</assignedEntity>
     207        ;;</performer>
     208        ;;</serviceEvent>
     209        ;;</documentationOf>
     210        ;;<Body>
     211        ;;<PROBLEMS-HTML>
     212        ;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
     213        ;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
     214        ;;<td>@@PROBLEMDATEOFONSET@@</td>
     215        ;;<td>Active</td></tr>
     216        ;;</tbody></table></text>
     217        ;;</PROBLEMS-HTML>
     218        ;;<Problems>
     219        ;;<component>
     220        ;;<section>
     221        ;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
     222        ;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
     223        ;;<title>Problems</title>
     224        ;;<entry typeCode="DRIV">
     225        ;;<act classCode="ACT" moodCode="EVN">
     226        ;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
     227        ;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
     228        ;;<code nullFlavor="NA"/>
     229        ;;<entryRelationship typeCode="SUBJ">
     230        ;;<observation classCode="OBS" moodCode="EVN">
     231        ;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
     232        ;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
     233        ;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
     234        ;;<statusCode code="completed"/>
     235        ;;<effectiveTime>
     236        ;;<low value="@@PROBLEMDATEOFONSET@@"/>
     237        ;;</effectiveTime>
     238        ;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
     239        ;;<entryRelationship typeCode="REFR">
     240        ;;<observation classCode="OBS" moodCode="EVN">
     241        ;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
     242        ;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
     243        ;;<statusCode code="completed"/>
     244        ;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
     245        ;;</observation>
     246        ;;</entryRelationship>
     247        ;;</observation>
     248        ;;</entryRelationship>
     249        ;;</act>
     250        ;;</entry>
     251        ;;</section>
     252        ;;</component>
     253        ;;</Problems>
     254        ;;<FamilyHistory>
     255        ;;</FamilyHistory>
     256        ;;<SocialHistory>
     257        ;;</SocialHistory>
     258        ;;<Alerts>
     259        ;;</Alerts>
     260        ;;<Medications>
     261        ;;</Medications>
     262        ;;<VitalSigns>
     263        ;;</VitalSigns>
     264        ;;<Results>
     265        ;;</Results>
     266        ;;</Body>
     267        ;;</ClinicalDocument>
     268        ;</TEMPLATE>
  • ccr/branches/ohum/p/C0CCCR.m

    r1329 r1330  
    1 C0CCCR   ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
    2  ;;1.0;C0C;;May 19, 2009;Build 38
    3  ;Copyright 2008,2009 George Lilly, University of Minnesota.
    4  ;Licensed under the terms of the GNU General Public License.
    5  ;See attached copy of the License.
    6  ;
    7  ;This program is free software; you can redistribute it and/or modify
    8  ;it under the terms of the GNU General Public License as published by
    9  ;the Free Software Foundation; either version 2 of the License, or
    10  ;(at your option) any later version.
    11  ;
    12  ;This program is distributed in the hope that it will be useful,
    13  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15  ;GNU General Public License for more details.
    16  ;
    17  ;You should have received a copy of the GNU General Public License along
    18  ;with this program; if not, write to the Free Software Foundation, Inc.,
    19  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20  ;
    21  ; EXPORT A CCR
    22  ;
    23 EXPORT   ; EXPORT ENTRY POINT FOR CCR
    24  ; Select a patient.
    25  S DIC=2,DIC(0)="AEMQ" D ^DIC
    26  I Y<1 Q  ; EXIT
    27  S DFN=$P(Y,U,1) ; SET THE PATIENT
    28  D XPAT(DFN) ; EXPORT TO A FILE
    29  Q
    30  ;
    31 XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
    32  ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
    33  ; FN IS FILE NAME, DEFAULTS IF NULL
    34  N CCRGLO,UDIR,UFN
    35  S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
    36  I '$D(DIR) S UDIR=""
    37  E  S UDIR=DIR
    38  I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
    39  E  S UFN=FN
    40  I '$D(XPARMS) S XPARMS=""
    41  N C0CRTN  ; RETURN ARRAY
    42  D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
    43  S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1))
    44  S ONAM=UFN
    45  I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
    46  S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
    47  S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
    48  I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
    49  I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
    50  . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
    51  . ;S @ODIRGLB="/home/glilly/CCROUT"
    52  . ;S @ODIRGLB="/home/cedwards/"
    53  . S @ODIRGLB="/opt/wv/p/"
    54  S ODIR=UDIR
    55  I UDIR="" S ODIR=@ODIRGLB
    56  N ZY
    57  S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
    58  W !,$P(ZY,U,2),!
    59  Q
    60  ;
    61 DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
    62  ;
    63  N G1
    64  S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR"))
    65  I $D(@G1@(0)) D  ; CCR EXISTS
    66  . D PARY^C0CXPATH(G1)
    67  E  W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
    68  Q
    69  ;
    70 CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)  ;RPC ENTRY POINT FOR CCR OUTPUT
    71  ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
    72  ; DFN IS PATIENT IEN
    73  ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
    74  ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
    75  ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
    76  ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
    77  ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
    78  ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
    79  K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT
    80  M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS
    81  K ^TMP($J) ; START CLEAN
    82  I '$D(DEBUG) S DEBUG=0
    83  S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
    84  I '$D(CCRPARMS) S CCRPARMS=""
    85  I '$D(CCRPART) S CCRPART="CCR"
    86  I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
    87  D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
    88  I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS
    89  I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
    90  I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
    91  I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
    92  S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
    93  S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
    94  S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
    95  ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
    96  ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
    97  D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
    98  D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
    99  ;
    100  ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
    101  ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
    102  D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
    103  D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
    104  D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
    105  D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments")
    106  I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
    107  ;
    108  D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
    109  ;
    110  K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
    111  S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
    112  D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
    113  N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
    114  F PROCI=1:1:@CCRXTAB@(0) D  ; PROCESS THE CCR BODY SECTIONS
    115  . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
    116  . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
    117  . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
    118  . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
    119  . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
    120  . S IXML="INXML"
    121  . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
    122  . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
    123  . ; W OXML,!
    124  . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
    125  . W "RUNNING ",CALL,!
    126  . X CALL
    127  . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
    128  . I $G(@OXML@(0))>0 D  ; THERE IS A RESULT
    129  . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
    130  . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
    131  N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
    132  D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
    133  D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
    134  D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
    135  D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
    136  K ACTT,ACTT2
    137  ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
    138  ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
    139  ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
    140  ; gpl - turned off Comments for Certification
    141  K CMTT,CMTT2
    142  N TRIMI,J,DONE S DONE=0
    143  F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
    144  . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
    145  . I DEBUG W "TRIMMED",J,!
    146  . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
    147  ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
    148  I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
    149  E  M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
    150  I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
    151  K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
    152  K ^TMP($J) ; REALLY CLEAN UP
    153  M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
    154  Q
    155  ;
    156 INITSTPS(TAB)  ; INITIALIZE CCR PROCESSING STEPS
    157  ; TAB IS PASSED BY NAME
    158  I DEBUG W "TAB= ",TAB,!
    159  ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
    160  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
    161  I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
    162  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
    163  D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
    164  I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
    165  E  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
    166  D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
    167  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
    168  ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
    169  ; gpl - turned off Encounters for Certification
    170  Q
    171  ;
    172 HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
    173  N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
    174  ; K @VMAP
    175  S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
    176  ; I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
    177  D  ; ALWAYS MAP THESE VARIABLES
    178  . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
    179  . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
    180  . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
    181  . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
    182  . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
    183  . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
    184  . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
    185  . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
    186  . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
    187  ;I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
    188  ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
    189  N CTMP
    190  D MAP^C0CXPATH(CXML,VMAP,"CTMP")
    191  D CP^C0CXPATH("CTMP",CXML)
    192  N HRIMVARS ;
    193  S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
    194  M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
    195  S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
    196  Q
    197  ;
    198 ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
    199  ; AXML AND ACTRTN ARE PASSED BY NAME
    200  ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
    201  ; P1= OBJECTID - ACTORPATIENT_2
    202  ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
    203  ;OR INSTITUTION
    204  ;  OR PERSON(IN PATIENT FILE IE NOK)
    205  ; P3= IEN RECORD NUMBER FOR ACTOR - 2
    206  N I,J,K,L
    207  K @ACTRTN ; CLEAR RETURN ARRAY
    208  F I=1:1:@AXML@(0) D  ; FIRST FIX MISSING LINKS
    209  . I @AXML@(I)?.E1"_<".E D  ;
    210  . . N ZA,ZB
    211  . . S ZA=$P(@AXML@(I),">",1)_">"
    212  . . S ZB="<"_$P(@AXML@(I),"<",3)
    213  . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
    214  F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
    215  . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
    216  . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
    217  . . I $G(LINKDEBUG) W "<ActorID>=>",J,!
    218  . . I J'="" S K(J)="" ; HASHING ACTOR
    219  . I @AXML@(I)?.E1"<LinkID>".E D  ; THERE IS AN ACTOR THIS LINE
    220  . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
    221  . . I $G(LINKDEBUG) W "<LinkID>=>",J,!
    222  . . I J'="" S K(J)="" ; HASHING ACTOR
    223  . . ;  TO GET RID OF DUPLICATES
    224  S I="" ; GOING TO $O THROUGH THE HASH
    225  F J=0:0 D  Q:$O(K(I))=""
    226  . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
    227  . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
    228  . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
    229  . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
    230  . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
    231  Q
    232  ;
    233 TEST ; RUN ALL THE TEST CASES
    234  D TESTALL^C0CUNIT("C0CCCR")
    235  Q
    236  ;
    237 ZTEST(WHICH)  ; RUN ONE SET OF TESTS
    238  N ZTMP
    239  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
    240  D ZTEST^C0CUNIT(.ZTMP,WHICH)
    241  Q
    242  ;
    243 TLIST  ; LIST THE TESTS
    244  N ZTMP
    245  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
    246  D TLIST^C0CUNIT(.ZTMP)
    247  Q
    248  ;
    249  ;;><TEST>
    250  ;;><PROBLEMS>
    251  ;;>>>K C0C S C0C=""
    252  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
    253  ;;>>?@C0C@(@C0C@(0))["</Problems>"
    254  ;;><VITALS>
    255  ;;>>>K C0C S C0C=""
    256  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
    257  ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
    258  ;;><CCR>
    259  ;;>>>K C0C S C0C=""
    260  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
    261  ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
    262  ;;><ACTLST>
    263  ;;>>>K C0C S C0C=""
    264  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
    265  ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
    266  ;;><ACTORS>
    267  ;;>>>D ZTEST^C0CCCR("ACTLST")
    268  ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
    269  ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
    270  ;;>>?G3(G3(0))["</Actors>"
    271  ;;><TRIM>
    272  ;;>>>D ZTEST^C0CCCR("CCR")
    273  ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
    274  ;;><ALERTS>
    275  ;;>>>S TESTALERT=1
    276  ;;>>>K C0C S C0C=""
    277  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
    278  ;;>>?@C0C@(@C0C@(0))["</Alerts>"
    279  
    280  
     1C0CCCR    ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
     2        ;;1.0;C0C;;May 19, 2009;Build 1
     3        ;Copyright 2008,2009 George Lilly, University of Minnesota.
     4        ;Licensed under the terms of the GNU General Public License.
     5        ;See attached copy of the License.
     6        ;
     7        ;This program is free software; you can redistribute it and/or modify
     8        ;it under the terms of the GNU General Public License as published by
     9        ;the Free Software Foundation; either version 2 of the License, or
     10        ;(at your option) any later version.
     11        ;
     12        ;This program is distributed in the hope that it will be useful,
     13        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     14        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15        ;GNU General Public License for more details.
     16        ;
     17        ;You should have received a copy of the GNU General Public License along
     18        ;with this program; if not, write to the Free Software Foundation, Inc.,
     19        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20        ;
     21        ; EXPORT A CCR
     22        ;
     23EXPORT    ; EXPORT ENTRY POINT FOR CCR
     24        ; Select a patient.
     25        S DIC=2,DIC(0)="AEMQ" D ^DIC
     26        I Y<1 Q  ; EXIT
     27        S DFN=$P(Y,U,1) ; SET THE PATIENT
     28        ;OHUM/RUT 3120102 To take inputs from user for date limits and notes
     29        D ^C0CVALID
     30        ;OHUM/RUT
     31        D XPAT(DFN) ; EXPORT TO A FILE
     32        Q
     33        ;
     34XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
     35        ; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
     36        ; FN IS FILE NAME, DEFAULTS IF NULL
     37        N CCRGLO,UDIR,UFN
     38        S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
     39        I '$D(DIR) S UDIR=""
     40        E  S UDIR=DIR
     41        I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
     42        E  S UFN=FN
     43        I '$D(XPARMS) S XPARMS=""
     44        N C0CRTN  ; RETURN ARRAY
     45        D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
     46        S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1))
     47        S ONAM=UFN
     48        I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
     49        S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
     50        S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
     51        I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
     52        I '$D(@ODIRGLB) D  ; IF NOT ODIR HAS BEEN SET
     53        . W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
     54        . ;S @ODIRGLB="/home/glilly/CCROUT"
     55        . ;S @ODIRGLB="/home/cedwards/"
     56        . S @ODIRGLB="/opt/wv/p/"
     57        S ODIR=UDIR
     58        I UDIR="" S ODIR=@ODIRGLB
     59        N ZY
     60        S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
     61        W !,$P(ZY,U,2),!
     62        Q
     63        ;
     64DCCR(DFN)       ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
     65        ;
     66        N G1
     67        S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR"))
     68        I $D(@G1@(0)) D  ; CCR EXISTS
     69        . D PARY^C0CXPATH(G1)
     70        E  W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
     71        Q
     72        ;
     73CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART)     ;RPC ENTRY POINT FOR CCR OUTPUT
     74        ; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
     75        ; DFN IS PATIENT IEN
     76        ; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
     77        ;   OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
     78        ; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
     79        ; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
     80        ; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
     81        ; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
     82        K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT
     83        M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS
     84        K ^TMP($J) ; START CLEAN
     85        I '$D(DEBUG) S DEBUG=0
     86        S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
     87        I '$D(CCRPARMS) S CCRPARMS=""
     88        I '$D(CCRPART) S CCRPART="CCR"
     89        I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
     90        D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
     91        I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS
     92        I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
     93        I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
     94        I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
     95        S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
     96        S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
     97        S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
     98        ; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
     99        ;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
     100        D LOAD^C0CCCR0(TGLOBAL)  ; LOAD THE CCR TEMPLATE
     101        D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
     102        ;
     103        ; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
     104        ; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
     105        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
     106        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
     107        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
     108        D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Comments")
     109        I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
     110        ;
     111        D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
     112        ;
     113        K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
     114        S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
     115        D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
     116        N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
     117        F PROCI=1:1:@CCRXTAB@(0) D  ; PROCESS THE CCR BODY SECTIONS
     118        . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
     119        . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
     120        . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
     121        . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
     122        . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
     123        . S IXML="INXML"
     124        . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
     125        . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
     126        . ; W OXML,!
     127        . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
     128        . W "RUNNING ",CALL,!
     129        . X CALL
     130        . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
     131        . I $G(@OXML@(0))>0 D  ; THERE IS A RESULT
     132        . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
     133        . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
     134        N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
     135        D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
     136        D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
     137        D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
     138        D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
     139        K ACTT,ACTT2
     140        ;D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
     141        ;D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
     142        ;D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
     143        ; gpl - turned off Comments for Certification
     144        K CMTT,CMTT2
     145        N TRIMI,J,DONE S DONE=0
     146        F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
     147        . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
     148        . I DEBUG W "TRIMMED",J,!
     149        . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
     150        ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
     151        I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
     152        E  M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
     153        I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
     154        K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
     155        K ^TMP($J) ; REALLY CLEAN UP
     156        M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
     157        Q
     158        ;
     159INITSTPS(TAB)    ; INITIALIZE CCR PROCESSING STEPS
     160        ; TAB IS PASSED BY NAME
     161        I DEBUG W "TAB= ",TAB,!
     162        ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
     163        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
     164        I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
     165        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
     166        D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
     167        I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
     168        E  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
     169        D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
     170        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
     171        ;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
     172        ; gpl - turned off Encounters for Certification
     173        ;OHUM/RUT 3111228 Condition for Notes ; It should be included or not
     174        I ^TMP("C0CCCR","TIULIMIT")'="" D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
     175        ;OHUM/RUT
     176        Q
     177        ;
     178HDRMAP(CXML,DFN)        ; MAP HEADER VARIABLES: FROM, TO ECT
     179        N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
     180        ; K @VMAP
     181        S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
     182        ; I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
     183        D  ; ALWAYS MAP THESE VARIABLES
     184        . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
     185        . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
     186        . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
     187        . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
     188        . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
     189        . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
     190        . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
     191        . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
     192        . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
     193        ;I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
     194        ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
     195        N CTMP
     196        D MAP^C0CXPATH(CXML,VMAP,"CTMP")
     197        D CP^C0CXPATH("CTMP",CXML)
     198        N HRIMVARS ;
     199        S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
     200        M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
     201        S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
     202        Q
     203        ;
     204ACTLST(AXML,ACTRTN)     ; RETURN THE ACTOR LIST FOR THE XML IN AXML
     205        ; AXML AND ACTRTN ARE PASSED BY NAME
     206        ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
     207        ; P1= OBJECTID - ACTORPATIENT_2
     208        ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
     209        ;OR INSTITUTION
     210        ;  OR PERSON(IN PATIENT FILE IE NOK)
     211        ; P3= IEN RECORD NUMBER FOR ACTOR - 2
     212        N I,J,K,L
     213        K @ACTRTN ; CLEAR RETURN ARRAY
     214        F I=1:1:@AXML@(0) D  ; FIRST FIX MISSING LINKS
     215        . I @AXML@(I)?.E1"_<".E D  ;
     216        . . N ZA,ZB
     217        . . S ZA=$P(@AXML@(I),">",1)_">"
     218        . . S ZB="<"_$P(@AXML@(I),"<",3)
     219        . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
     220        F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
     221        . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
     222        . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
     223        . . I $G(LINKDEBUG) W "<ActorID>=>",J,!
     224        . . I J'="" S K(J)="" ; HASHING ACTOR
     225        . I @AXML@(I)?.E1"<LinkID>".E D  ; THERE IS AN ACTOR THIS LINE
     226        . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
     227        . . I $G(LINKDEBUG) W "<LinkID>=>",J,!
     228        . . I J'="" S K(J)="" ; HASHING ACTOR
     229        . . ;  TO GET RID OF DUPLICATES
     230        S I="" ; GOING TO $O THROUGH THE HASH
     231        F J=0:0 D  Q:$O(K(I))=""
     232        . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
     233        . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
     234        . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
     235        . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
     236        . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
     237        Q
     238        ;
     239TEST    ; RUN ALL THE TEST CASES
     240        D TESTALL^C0CUNIT("C0CCCR")
     241        Q
     242        ;
     243ZTEST(WHICH)     ; RUN ONE SET OF TESTS
     244        N ZTMP
     245        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
     246        D ZTEST^C0CUNIT(.ZTMP,WHICH)
     247        Q
     248        ;
     249TLIST    ; LIST THE TESTS
     250        N ZTMP
     251        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
     252        D TLIST^C0CUNIT(.ZTMP)
     253        Q
     254        ;
     255        ;;><TEST>
     256        ;;><PROBLEMS>
     257        ;;>>>K C0C S C0C=""
     258        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
     259        ;;>>?@C0C@(@C0C@(0))["</Problems>"
     260        ;;><VITALS>
     261        ;;>>>K C0C S C0C=""
     262        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
     263        ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
     264        ;;><CCR>
     265        ;;>>>K C0C S C0C=""
     266        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
     267        ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
     268        ;;><ACTLST>
     269        ;;>>>K C0C S C0C=""
     270        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
     271        ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
     272        ;;><ACTORS>
     273        ;;>>>D ZTEST^C0CCCR("ACTLST")
     274        ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
     275        ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
     276        ;;>>?G3(G3(0))["</Actors>"
     277        ;;><TRIM>
     278        ;;>>>D ZTEST^C0CCCR("CCR")
     279        ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
     280        ;;><ALERTS>
     281        ;;>>>S TESTALERT=1
     282        ;;>>>K C0C S C0C=""
     283        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
     284        ;;>>?@C0C@(@C0C@(0))["</Alerts>"
     285       
     286       
  • ccr/branches/ohum/p/C0CCCR0.m

    r1329 r1330  
    1 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
    2  ;;1.0;C0C;;May 19, 2009;Build 38
    3  ;Copyright 2008,2009 George Lilly, University of Minnesota.
    4  ;Licensed under the terms of the GNU General Public License.
    5  ;See attached copy of the License.
    6  ;
    7  ;This program is free software; you can redistribute it and/or modify
    8  ;it under the terms of the GNU General Public License as published by
    9  ;the Free Software Foundation; either version 2 of the License, or
    10  ;(at your option) any later version.
    11  ;
    12  ;This program is distributed in the hope that it will be useful,
    13  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15  ;GNU General Public License for more details.
    16  ;
    17  ;You should have received a copy of the GNU General Public License along
    18  ;with this program; if not, write to the Free Software Foundation, Inc.,
    19  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20  ;
    21  W "This is a CCR TEMPLATE with processing routines",!
    22  W !
    23  Q
    24  ;
    25 ZT(ZARY,BAT,LINE)       ; private routine to add a line to the ZARY array
    26  ; ZARY IS PASSED BY NAME
    27  ; BAT is a string identifying the section
    28  ; LINE is a test which will evaluate to true or false
    29  ; I '$G(@ZARY) D  ;
    30  ; . S @ZARY@(0)=0 ; initially there are no elements
    31  ; . W "GOT HERE LOADING "_LINE,!
    32  N CNT ; count of array elements
    33  S CNT=@ZARY@(0) ; contains array count
    34  S CNT=CNT+1 ; increment count
    35  S @ZARY@(CNT)=LINE ; put the line in the array
    36  ; S @ZARY@(BAT,CNT)="" ; index the test by battery
    37  S @ZARY@(0)=CNT ; update the array counter
    38  Q
    39  ;
    40 ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
    41  ; ZARY IS PASSED BY NAME
    42  ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
    43  ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
    44  K @ZARY S @ZARY=""
    45  S @ZARY@(0)=0 ; initialize array count
    46  N LINE,LABEL,BODY
    47  N INTEST S INTEST=0 ; switch for in the TEMPLATE section
    48  N SECTION S SECTION="[anonymous]" ; NO section LABEL
    49  ;
    50  N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
    51  . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
    52  . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
    53  . I INTEST  D  ; within the section
    54  . . I LINE?." "1";><".E  D  ; sub-section name found
    55  . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
    56  . . I LINE?." "1";;".E  D  ; line found
    57  . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
    58  Q
    59  ;
    60 LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
    61  D ZLOAD(ARY,"C0CCCR0")
    62  ; ZWR @ARY
    63  Q
    64  ;
    65  ;<TEMPLATE>
    66  ;;<?xml version="1.0" encoding="UTF-8"?>
    67  ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
    68  ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
    69  ;;<CCRDocumentObjectID>@@CCRDOCOBJECTID@@</CCRDocumentObjectID>
    70  ;;<Language>
    71  ;;<Text>English</Text>
    72  ;;</Language>
    73  ;;<Version>V1.0</Version>
    74  ;;<DateTime>
    75  ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
    76  ;;</DateTime>
    77  ;;<Patient>
    78  ;;<ActorID>@@ACTORPATIENT@@</ActorID>
    79  ;;</Patient>
    80  ;;<From>
    81  ;;<ActorLink>
    82  ;;<ActorID>@@ACTORFROM@@</ActorID>
    83  ;;</ActorLink>
    84  ;;<ActorLink>
    85  ;;<ActorID>@@ACTORFROM2@@</ActorID>
    86  ;;</ActorLink>
    87  ;;</From>
    88  ;;<To>
    89  ;;<ActorLink>
    90  ;;<ActorID>@@ACTORTO@@</ActorID>
    91  ;;<ActorRole>
    92  ;;<Text>@@ACTORTOTEXT@@</Text>
    93  ;;</ActorRole>
    94  ;;</ActorLink>
    95  ;;</To>
    96  ;;<Purpose>
    97  ;;<Description>
    98  ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
    99  ;;</Description>
    100  ;;</Purpose>
    101  ;;<Body>
    102  ;;<Problems>
    103  ;;<Problem>
    104  ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
    105  ;;<DateTime>
    106  ;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime>
    107  ;;</DateTime>
    108  ;;<Type>
    109  ;;<Text>Problem</Text>
    110  ;;</Type>
    111  ;;<Description>
    112  ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
    113  ;;<Code>
    114  ;;<Value>@@PROBLEMCODEVALUE@@</Value>
    115  ;;<CodingSystem>ICD9CM</CodingSystem>
    116  ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
    117  ;;</Code>
    118  ;;</Description>
    119  ;;<Status>
    120  ;;<Text>@@PROBLEMSTATUS@@</Text>
    121  ;;</Status>
    122  ;;<Source>
    123  ;;<Actor>
    124  ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
    125  ;;</Actor>
    126  ;;</Source>
    127  ;;</Problem>
    128  ;;</Problems>
    129  ;;<Immunizations>
    130  ;;<Immunization>
    131  ;;<CCRDataObjectID>@@IMMUNEOBJECTID@@</CCRDataObjectID>
    132  ;;<DateTime>
    133  ;;<Type>
    134  ;;<Text>@@IMMUNEDATETIMETYPETEXT@@</Text>
    135  ;;</Type>
    136  ;;<ExactDateTime>@@IMMUNEDATETIME@@</ExactDateTime>
    137  ;;</DateTime>
    138  ;;<Source>
    139  ;;<Actor>
    140  ;;<ActorID>@@IMMUNESOURCEACTORID@@</ActorID>
    141  ;;</Actor>
    142  ;;</Source>
    143  ;;<Product>
    144  ;;<ProductName>
    145  ;;<Text>@@IMMUNEPRODUCTNAMETEXT@@</Text>
    146  ;;<Code>
    147  ;;<Value>@@IMMUNEPRODUCTCODE@@</Value>
    148  ;;<CodingSystem>@@IMMUNEPRODUCTCODESYSTEM@@</CodingSystem>
    149  ;;</Code>
    150  ;;</ProductName>
    151  ;;</Product>
    152  ;;</Immunization>
    153  ;;</Immunizations>
    154  ;;<FamilyHistory>
    155  ;;<FamilyProblemHistory>
    156  ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
    157  ;;<Source>
    158  ;;<Actor>
    159  ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
    160  ;;</Actor>
    161  ;;</Source>
    162  ;;<FamilyMember>
    163  ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
    164  ;;<ActorRole>
    165  ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
    166  ;;</ActorRole>
    167  ;;<Source>
    168  ;;<Actor>
    169  ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
    170  ;;</Actor>
    171  ;;</Source>
    172  ;;</FamilyMember>
    173  ;;<Problem>
    174  ;;<Type>
    175  ;;<Text>Problem</Text>
    176  ;;</Type>
    177  ;;<Description>
    178  ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
    179  ;;<Code>
    180  ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
    181  ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
    182  ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
    183  ;;</Code>
    184  ;;</Description>
    185  ;;<Source>
    186  ;;<Actor>
    187  ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
    188  ;;</Actor>
    189  ;;</Source>
    190  ;;</Problem>
    191  ;;</FamilyProblemHistory>
    192  ;;</FamilyHistory>
    193  ;;<SocialHistory>
    194  ;;<SocialHistoryElement>
    195  ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
    196  ;;<Type>
    197  ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
    198  ;;</Type>
    199  ;;<Description>
    200  ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
    201  ;;</Description>
    202  ;;<Source>
    203  ;;<Actor>
    204  ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
    205  ;;</Actor>
    206  ;;</Source>
    207  ;;</SocialHistoryElement>
    208  ;;<SocialHistoryElement>
    209  ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
    210  ;;<Type>
    211  ;;<Text>Ethnic Origin</Text>
    212  ;;</Type>
    213  ;;<Description>
    214  ;;<Text>Not Hispanic or Latino</Text>
    215  ;;</Description>
    216  ;;<Source>
    217  ;;<Actor>
    218  ;;<ActorID>AA0001</ActorID>
    219  ;;</Actor>
    220  ;;</Source>
    221  ;;</SocialHistoryElement>
    222  ;;<SocialHistoryElement>
    223  ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
    224  ;;<Type>
    225  ;;<Text>Race</Text>
    226  ;;</Type>
    227  ;;<Description>
    228  ;;<Text>White</Text>
    229  ;;</Description>
    230  ;;<Source>
    231  ;;<Actor>
    232  ;;<ActorID>AA0001</ActorID>
    233  ;;</Actor>
    234  ;;</Source>
    235  ;;</SocialHistoryElement>
    236  ;;<SocialHistoryElement>
    237  ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
    238  ;;<Type>
    239  ;;<Text>Occupation</Text>
    240  ;;</Type>
    241  ;;<Description>
    242  ;;<Text>Physician</Text>
    243  ;;</Description>
    244  ;;<Source>
    245  ;;<Actor>
    246  ;;<ActorID>AA0001</ActorID>
    247  ;;</Actor>
    248  ;;</Source>
    249  ;;</SocialHistoryElement>
    250  ;;</SocialHistory>
    251  ;;<Alerts>
    252  ;;<Alert>
    253  ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
    254  ;;<DateTime>
    255  ;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime>
    256  ;;</DateTime>
    257  ;;<Type>
    258  ;;<Text>@@ALERTTYPE@@</Text>
    259  ;;</Type>
    260  ;;<Status>
    261  ;;<Text>@@ALERTSTATUSTEXT@@</Text>
    262  ;;</Status>
    263  ;;<Description>
    264  ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
    265  ;;<Code>
    266  ;;<Value>@@ALERTCODEVALUE@@</Value>
    267  ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
    268  ;;</Code>
    269  ;;</Description>
    270  ;;<Source>
    271  ;;<Actor>
    272  ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
    273  ;;</Actor>
    274  ;;</Source>
    275  ;;<Agent>
    276  ;;<Products>
    277  ;;<Product>
    278  ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
    279  ;;<Source>
    280  ;;<Actor>
    281  ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
    282  ;;</Actor>
    283  ;;</Source>
    284  ;;<Product>
    285  ;;<ProductName>
    286  ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
    287  ;;<Code>
    288  ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
    289  ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
    290  ;;</Code>
    291  ;;</ProductName>
    292  ;;</Product>
    293  ;;</Product>
    294  ;;</Products>
    295  ;;</Agent>
    296  ;;<Reaction>
    297  ;;<Description>
    298  ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
    299  ;;<Code>
    300  ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
    301  ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
    302  ;;</Code>
    303  ;;</Description>
    304  ;;</Reaction>
    305  ;;</Alert>
    306  ;;</Alerts>
    307  ;;<Medications>
    308  ;;<Medication>
    309  ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
    310  ;;<DateTime>
    311  ;;<Type>
    312  ;;<Text>@@MEDISSUEDATETXT@@</Text>
    313  ;;</Type>
    314  ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
    315  ;;</DateTime>
    316  ;;<DateTime>
    317  ;;<Type>
    318  ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
    319  ;;</Type>
    320  ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
    321  ;;</DateTime>
    322  ;;<IDs>
    323  ;;<Type>
    324  ;;<Text>@@MEDRXNOTXT@@</Text>
    325  ;;</Type>
    326  ;;<ID>@@MEDRXNO@@</ID>
    327  ;;</IDs>
    328  ;;<Type>
    329  ;;<Text>@@MEDTYPETEXT@@</Text>
    330  ;;</Type>
    331  ;;<Description>
    332  ;;<Text>@@MEDDETAILUNADORNED@@</Text>
    333  ;;</Description>
    334  ;;<Status>
    335  ;;<Text>@@MEDSTATUSTEXT@@</Text>
    336  ;;</Status>
    337  ;;<Source>
    338  ;;<Actor>
    339  ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
    340  ;;</Actor>
    341  ;;</Source>
    342  ;;<Product>
    343  ;;<ProductName>
    344  ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
    345  ;;<Code>
    346  ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
    347  ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
    348  ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
    349  ;;</Code>
    350  ;;</ProductName>
    351  ;;<BrandName>
    352  ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
    353  ;;</BrandName>
    354  ;;<Strength>
    355  ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
    356  ;;<Units>
    357  ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
    358  ;;</Units>
    359  ;;</Strength>
    360  ;;<Form>
    361  ;;<Text>@@MEDFORMTEXT@@</Text>
    362  ;;</Form>
    363  ;;<Concentration>
    364  ;;<Value>@@MEDCONCVALUE@@</Value>
    365  ;;<Units>
    366  ;;<Unit>@@MEDCONCUNIT@@</Unit>
    367  ;;</Units>
    368  ;;</Concentration>
    369  ;;</Product>
    370  ;;<Quantity>
    371  ;;<Value>@@MEDQUANTITYVALUE@@</Value>
    372  ;;<Units>
    373  ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
    374  ;;</Units>
    375  ;;</Quantity>
    376  ;;<Directions>
    377  ;;<Direction>
    378  ;;<Description>
    379  ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
    380  ;;</Description>
    381  ;;<DoseIndicator>
    382  ;;<Text>@@MEDDOSEINDICATOR@@</Text>
    383  ;;</DoseIndicator>
    384  ;;<DeliveryMethod>
    385  ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
    386  ;;</DeliveryMethod>
    387  ;;<Dose>
    388  ;;<Value>@@MEDDOSEVALUE@@</Value>
    389  ;;<Units>
    390  ;;<Unit>@@MEDDOSEUNIT@@</Unit>
    391  ;;</Units>
    392  ;;<Rate>
    393  ;;<Value>@@MEDRATEVALUE@@</Value>
    394  ;;<Units>
    395  ;;<Unit>@@MEDRATEUNIT@@</Unit>
    396  ;;</Units>
    397  ;;</Rate>
    398  ;;</Dose>
    399  ;;<Vehicle>
    400  ;;<Text>@@MEDVEHICLETEXT@@</Text>
    401  ;;</Vehicle>
    402  ;;<Route>
    403  ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
    404  ;;</Route>
    405  ;;<Frequency>
    406  ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
    407  ;;</Frequency>
    408  ;;<Interval>
    409  ;;<Value>@@MEDINTERVALVALUE@@</Value>
    410  ;;<Units>
    411  ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
    412  ;;</Units>
    413  ;;</Interval>
    414  ;;<Duration>
    415  ;;<Value>@@MEDDURATIONVALUE@@</Value>
    416  ;;<Units>
    417  ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
    418  ;;</Units>
    419  ;;</Duration>
    420  ;;<Indication>
    421  ;;<PRNFlag>
    422  ;;<Text>@@MEDPRNFLAG@@</Text>
    423  ;;</PRNFlag>
    424  ;;<Problem>
    425  ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
    426  ;;<Type>
    427  ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
    428  ;;</Type>
    429  ;;<Description>
    430  ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
    431  ;;<Code>
    432  ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
    433  ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
    434  ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
    435  ;;</Code>
    436  ;;</Description>
    437  ;;<Source>
    438  ;;<Actor>
    439  ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
    440  ;;</Actor>
    441  ;;</Source>
    442  ;;</Problem>
    443  ;;</Indication>
    444  ;;<StopIndicator>
    445  ;;<Text>@@MEDSTOPINDICATOR@@</Text>
    446  ;;</StopIndicator>
    447  ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
    448  ;;<MultipleDirectionModifier>
    449  ;;<Text>@@MEDMULDIRMOD@@</Text>
    450  ;;</MultipleDirectionModifier>
    451  ;;</Direction>
    452  ;;</Directions>
    453  ;;<PatientInstructions>
    454  ;;<Instruction>
    455  ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
    456  ;;</Instruction>
    457  ;;</PatientInstructions>
    458  ;;<FullfillmentInstructions>
    459  ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
    460  ;;</FullfillmentInstructions>
    461  ;;<Refills>
    462  ;;<Refill>
    463  ;;<Number>@@MEDRFNO@@</Number>
    464  ;;</Refill>
    465  ;;</Refills>
    466  ;;</Medication>
    467  ;;</Medications>
    468  ;;<VitalSigns>
    469  ;;<Result>
    470  ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
    471  ;;<DateTime>
    472  ;;<Type>
    473  ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
    474  ;;</Type>
    475  ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
    476  ;;</DateTime>
    477  ;;<Description>
    478  ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
    479  ;;</Description>
    480  ;;<Source>
    481  ;;<Actor>
    482  ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
    483  ;;</Actor>
    484  ;;</Source>
    485  ;;<Test>
    486  ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
    487  ;;<Type>
    488  ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
    489  ;;</Type>
    490  ;;<Description>
    491  ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
    492  ;;<Code>
    493  ;;<Value>@@VITALSIGNSDESCCODEVALUE@@</Value>
    494  ;;<CodingSystem>@@VITALSIGNSDESCCODINGSYSTEM@@</CodingSystem>
    495  ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
    496  ;;</Code>
    497  ;;</Description>
    498  ;;<Source>
    499  ;;<Actor>
    500  ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
    501  ;;</Actor>
    502  ;;</Source>
    503  ;;<TestResult>
    504  ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
    505  ;;<Units>
    506  ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
    507  ;;</Units>
    508  ;;</TestResult>
    509  ;;</Test>
    510  ;;</Result>
    511  ;;</VitalSigns>
    512  ;;<Results>
    513  ;;<Result>
    514  ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
    515  ;;<DateTime>
    516  ;;<Type>
    517  ;;<Text>Assessment Time</Text>
    518  ;;</Type>
    519  ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
    520  ;;</DateTime>
    521  ;;<Description>
    522  ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
    523  ;;<Code>
    524  ;;<Value>@@RESULTCODE@@</Value>
    525  ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
    526  ;;</Code>
    527  ;;</Description>
    528  ;;<Status>
    529  ;;<Text>@@RESULTSTATUS@@</Text>
    530  ;;</Status>
    531  ;;<Source>
    532  ;;<Actor>
    533  ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
    534  ;;</Actor>
    535  ;;</Source>
    536  ;;<Test>
    537  ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
    538  ;;<DateTime>
    539  ;;<Type>
    540  ;;<Text>Assessment Time</Text>
    541  ;;</Type>
    542  ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
    543  ;;</DateTime>
    544  ;;<Description>
    545  ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
    546  ;;<Code>
    547  ;;<Value>@@RESULTTESTCODEVALUE@@</Value>
    548  ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
    549  ;;</Code>
    550  ;;</Description>
    551  ;;<Status>
    552  ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
    553  ;;</Status>
    554  ;;<Source>
    555  ;;<Actor>
    556  ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
    557  ;;</Actor>
    558  ;;</Source>
    559  ;;<TestResult>
    560  ;;<Value>@@RESULTTESTVALUE@@</Value>
    561  ;;<Units>
    562  ;;<Unit>@@RESULTTESTUNITS@@</Unit>
    563  ;;</Units>
    564  ;;</TestResult>
    565  ;;<NormalResult>
    566  ;;<Normal>
    567  ;;<Description>
    568  ;;<Text>@@RESULTTESTNORMALDESCTEXT@@</Text>
    569  ;;</Description>
    570  ;;<Source>
    571  ;;<Actor>
    572  ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
    573  ;;</Actor>
    574  ;;</Source>
    575  ;;</Normal>
    576  ;;</NormalResult>
    577  ;;<Flag>
    578  ;;<Text>@@RESULTTESTFLAG@@</Text>
    579  ;;</Flag>
    580  ;;</Test>
    581  ;;</Result>
    582  ;;</Results>
    583  ;;<Procedures>
    584  ;;<Procedure>
    585  ;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID>
    586  ;;<DateTime>
    587  ;;<Type>
    588  ;;<Text>@@PROCDATETEXT@@</Text>
    589  ;;</Type>
    590  ;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime>
    591  ;;</DateTime>
    592  ;;<Description>
    593  ;;<Text>@@PROCDESCTEXT@@</Text>
    594  ;;<ObjectAttribute>
    595  ;;<Attribute>@@PROCDESCOBJATTR@@</Attribute>
    596  ;;<AttributeValue>
    597  ;;<Value>@@PROCDESCOBJATTRVAL@@</Value>
    598  ;;<Code>
    599  ;;<Value>@@PROCDESCOBJATTRCODE@@</Value>
    600  ;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem>
    601  ;;</Code>
    602  ;;</AttributeValue>
    603  ;;</ObjectAttribute>
    604  ;;<Code>
    605  ;;<Value>@@PROCCODE@@</Value>
    606  ;;<CodingSystem>@@PROCCODESYS@@</CodingSystem>
    607  ;;</Code>
    608  ;;</Description>
    609  ;;<Status>
    610  ;;<Text>@@PROCSTATUS@@</Text>
    611  ;;</Status>
    612  ;;<Source>
    613  ;;<Actor>
    614  ;;<ActorID>@@PROCACTOROBJID@@</ActorID>
    615  ;;</Actor>
    616  ;;</Source>
    617  ;;<InternalCCRLink>
    618  ;;<LinkID>@@PROCLINKID@@</LinkID>
    619  ;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship>
    620  ;;</InternalCCRLink>
    621  ;;</Procedure>
    622  ;;</Procedures>
    623  ;;<Encounters>
    624  ;;<Encounter>
    625  ;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID>
    626  ;;<DateTime>
    627  ;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime>
    628  ;;</DateTime>
    629  ;;<Type>
    630  ;;<Text>@@ENCTYPETXT@@</Text>
    631  ;;<Code>
    632  ;;<Value>@@ENCTYPECODE@@</Value>
    633  ;;<CodingSystem>@@ENCTYPECODESYS@@</CodingSystem>
    634  ;;</Code>
    635  ;;</Type>
    636  ;;<Description>
    637  ;;<Text>@@ENCDESCTXT@@</Text>
    638  ;;<Code>
    639  ;;<Value>@@ENCDESCCODE@@</Value>
    640  ;;<CodingSystem>@@ENCDESCCODESYS@@</CodingSystem>
    641  ;;</Code>
    642  ;;</Description>
    643  ;;<Location>
    644  ;;<Actor>
    645  ;;<ActorID>@@ENCLOCACTORID@@</ActorID>
    646  ;;</Actor>
    647  ;;</Location>
    648  ;;<Practioner>
    649  ;;<Actor>
    650  ;;<ActorID>@@ENCPRVACTORID@@</ActorID>
    651  ;;</Actor>
    652  ;;</Practioner>
    653  ;;<Indication>
    654  ;;<Text>@@ENCINDTXT@@</Text>
    655  ;;<Code>
    656  ;;<Value>@@ENCINDCODE@@</Value>
    657  ;;<CodingSystem>@@ENCINDCODESYS@@</CodingSystem>
    658  ;;</Code>
    659  ;;</Indication>
    660  ;;<Source>
    661  ;;<Actor>
    662  ;;<ActorID>@@ENCACTORID@@</ActorID>
    663  ;;</Actor>
    664  ;;</Source>
    665  ;;<CommentID>@@ENCCOMMENTID@@</CommentID>
    666  ;;</Encounter>
    667  ;;</Encounters>
    668  ;;<HealthCareProviders>
    669  ;;<Provider>
    670  ;;<ActorID>AA0005</ActorID>
    671  ;;<ActorRole>
    672  ;;<Text>Primary Provider</Text>
    673  ;;</ActorRole>
    674  ;;</Provider>
    675  ;;</HealthCareProviders>
    676  ;;</Body>
    677  ;;<Actors>
    678  ;;<ACTOR-PATIENT>
    679  ;;<Actor>
    680  ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    681  ;;<Person>
    682  ;;<Name>
    683  ;;<CurrentName>
    684  ;;<Given>@@ACTORGIVENNAME@@</Given>
    685  ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
    686  ;;<Family>@@ACTORFAMILYNAME@@</Family>
    687  ;;</CurrentName>
    688  ;;</Name>
    689  ;;<DateOfBirth>
    690  ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
    691  ;;</DateOfBirth>
    692  ;;<Gender>
    693  ;;<Text>@@ACTORGENDER@@</Text>
    694  ;;<Code>
    695  ;;<Value>@@ACTORGENDERCODE@@</Value>
    696  ;;<CodingSystem>HL7 AdministrativeGender</CodingSystem>
    697  ;;</Code>
    698  ;;</Gender>
    699  ;;</Person>
    700  ;;<IDs>
    701  ;;<Type>
    702  ;;<Text>@@ACTORSSNTEXT@@</Text>
    703  ;;</Type>
    704  ;;<ID>@@ACTORSSN@@</ID>
    705  ;;<Source>
    706  ;;<Actor>
    707  ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
    708  ;;</Actor>
    709  ;;</Source>
    710  ;;</IDs>
    711  ;;<Address>
    712  ;;<Type>
    713  ;;<Text>@@ACTORADDRESSTYPE@@</Text>
    714  ;;</Type>
    715  ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
    716  ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
    717  ;;<City>@@ACTORADDRESSCITY@@</City>
    718  ;;<State>@@ACTORADDRESSSTATE@@</State>
    719  ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
    720  ;;</Address>
    721  ;;<Telephone>
    722  ;;<Value>@@ACTORRESTEL@@</Value>
    723  ;;<Type>
    724  ;;<Text>@@ACTORRESTELTEXT@@</Text>
    725  ;;</Type>
    726  ;;</Telephone>
    727  ;;<Telephone>
    728  ;;<Value>@@ACTORWORKTEL@@</Value>
    729  ;;<Type>
    730  ;;<Text>@@ACTORWORKTELTEXT@@</Text>
    731  ;;</Type>
    732  ;;</Telephone>
    733  ;;<Telephone>
    734  ;;<Value>@@ACTORCELLTEL@@</Value>
    735  ;;<Type>
    736  ;;<Text>@@ACTORCELLTELTEXT@@</Text>
    737  ;;</Type>
    738  ;;</Telephone>
    739  ;;<EMail>
    740  ;;<Value>@@ACTOREMAIL@@</Value>
    741  ;;</EMail>
    742  ;;<Source>
    743  ;;<Actor>
    744  ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
    745  ;;</Actor>
    746  ;;</Source>
    747  ;;</Actor>
    748  ;;</ACTOR-PATIENT>
    749  ;;<ACTOR-SYSTEM>
    750  ;;<Actor>
    751  ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    752  ;;<InformationSystem>
    753  ;;<Name>@@ACTORINFOSYSNAME@@</Name>
    754  ;;<Version>@@ACTORINFOSYSVER@@</Version>
    755  ;;</InformationSystem>
    756  ;;<Source>
    757  ;;<Actor>
    758  ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
    759  ;;</Actor>
    760  ;;</Source>
    761  ;;</Actor>
    762  ;;</ACTOR-SYSTEM>
    763  ;;<ACTOR-NOK>
    764  ;;<Actor>
    765  ;;<ActorObjectID>AA0003</ActorObjectID>
    766  ;;<Person>
    767  ;;<Name>
    768  ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
    769  ;;</Name>
    770  ;;</Person>
    771  ;;<Relation>
    772  ;;<Text>@@ACTORRELATION@@</Text>
    773  ;;</Relation>
    774  ;;<Source>
    775  ;;<Actor>
    776  ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
    777  ;;</Actor>
    778  ;;</Source>
    779  ;;</Actor>
    780  ;;</ACTOR-NOK>
    781  ;;<ACTOR-PROVIDER>
    782  ;;<Actor>
    783  ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    784  ;;<Person>
    785  ;;<Name>
    786  ;;<CurrentName>
    787  ;;<Given>@@ACTORGIVENNAME@@</Given>
    788  ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
    789  ;;<Family>@@ACTORFAMILYNAME@@</Family>
    790  ;;<Title>@@ACTORTITLE@@</Title>
    791  ;;</CurrentName>
    792  ;;</Name>
    793  ;;</Person>
    794  ;;<Specialty>
    795  ;;<Text>@@ACTORSPECIALITY@@</Text>
    796  ;;</Specialty>
    797  ;;<Address>
    798  ;;<Type>
    799  ;;<Text>@@ACTORADDRESSTYPE@@</Text>
    800  ;;</Type>
    801  ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
    802  ;;<City>@@ACTORADDRESSCITY@@</City>
    803  ;;<State>@@ACTORADDRESSSTATE@@</State>
    804  ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
    805  ;;</Address>
    806  ;;<Telephone>
    807  ;;<Value>@@ACTORTELEPHONE@@</Value>
    808  ;;<Type>
    809  ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
    810  ;;</Type>
    811  ;;</Telephone>
    812  ;;<Email>
    813  ;;<Value>@@ACTOREMAIL@@</Value>
    814  ;;</Email>
    815  ;;<Source>
    816  ;;<Actor>
    817  ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
    818  ;;</Actor>
    819  ;;</Source>
    820  ;;<InternalCCRLink>
    821  ;;<LinkID>@@ACTORORGLINK@@</LinkID>
    822  ;;<LinkRelationship>representedOrganization</LinkRelationship>
    823  ;;</InternalCCRLink>
    824  ;;</Actor>
    825  ;;</ACTOR-PROVIDER>
    826  ;;<ACTOR-ORG>
    827  ;;<Actor>
    828  ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    829  ;;<Organization>
    830  ;;<Name>@@ORGANIZATIONNAME@@</Name>
    831  ;;</Organization>
    832  ;;<Address>
    833  ;;<Type>
    834  ;;<Text>@@ACTORADDRESSTYPE@@</Text>
    835  ;;</Type>
    836  ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
    837  ;;<City>@@ACTORADDRESSCITY@@</City>
    838  ;;<State>@@ACTORADDRESSSTATE@@</State>
    839  ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
    840  ;;</Address>
    841  ;;<Telephone>
    842  ;;<Value>@@ACTORTELEPHONE@@</Value>
    843  ;;<Type>
    844  ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
    845  ;;</Type>
    846  ;;</Telephone>
    847  ;;<Source>
    848  ;;<Actor>
    849  ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
    850  ;;</Actor>
    851  ;;</Source>
    852  ;;</Actor>
    853  ;;</ACTOR-ORG>
    854  ;;</Actors>
    855  ;;<Signatures>
    856  ;;<CCRSignature>
    857  ;;<SignatureObjectID>S0001</SignatureObjectID>
    858  ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
    859  ;;<Source>
    860  ;;<ActorID>AA0001</ActorID>
    861  ;;</Source>
    862  ;;<Signature>
    863  ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
    864  ;;<SignedInfo>
    865  ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
    866  ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
    867  ;;<Reference URI="">
    868  ;;<Transforms>
    869  ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
    870  ;;</Transforms>
    871  ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
    872  ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
    873  ;;</Reference>
    874  ;;</SignedInfo>
    875  ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
    876  ;;<KeyInfo>
    877  ;;<KeyValue>
    878  ;;<RSAKeyValue>
    879  ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
    880  ;;<Exponent>AQAB</Exponent>
    881  ;;</RSAKeyValue>
    882  ;;</KeyValue>
    883  ;;</KeyInfo>
    884  ;;</Signature>
    885  ;;</Signature>
    886  ;;</CCRSignature>
    887  ;;</Signatures>
    888  ;;<Comments>
    889  ;;<Comment>
    890  ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID>
    891  ;;<DateTime>
    892  ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime>
    893  ;;</DateTime>
    894  ;;<Description>
    895  ;;<Text>
    896  ;;</Text>
    897  ;;</Description>
    898  ;;<Source>
    899  ;;<Actor>
    900  ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
    901  ;;</Actor>
    902  ;;</Source>
    903  ;;</Comment>
    904  ;;</Comments>
    905  ;;</ContinuityOfCareRecord>
    906  ;</TEMPLATE>
     1C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
     2        ;;1.0;C0C;;May 19, 2009;Build 1
     3        ;Copyright 2008,2009 George Lilly, University of Minnesota.
     4        ;Licensed under the terms of the GNU General Public License.
     5        ;See attached copy of the License.
     6        ;
     7        ;This program is free software; you can redistribute it and/or modify
     8        ;it under the terms of the GNU General Public License as published by
     9        ;the Free Software Foundation; either version 2 of the License, or
     10        ;(at your option) any later version.
     11        ;
     12        ;This program is distributed in the hope that it will be useful,
     13        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     14        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15        ;GNU General Public License for more details.
     16        ;
     17        ;You should have received a copy of the GNU General Public License along
     18        ;with this program; if not, write to the Free Software Foundation, Inc.,
     19        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20        ;
     21        W "This is a CCR TEMPLATE with processing routines",!
     22        W !
     23        Q
     24        ;
     25ZT(ZARY,BAT,LINE)             ; private routine to add a line to the ZARY array
     26        ; ZARY IS PASSED BY NAME
     27        ; BAT is a string identifying the section
     28        ; LINE is a test which will evaluate to true or false
     29        ; I '$G(@ZARY) D  ;
     30        ; . S @ZARY@(0)=0 ; initially there are no elements
     31        ; . W "GOT HERE LOADING "_LINE,!
     32        N CNT ; count of array elements
     33        S CNT=@ZARY@(0) ; contains array count
     34        S CNT=CNT+1 ; increment count
     35        S @ZARY@(CNT)=LINE ; put the line in the array
     36        ; S @ZARY@(BAT,CNT)="" ; index the test by battery
     37        S @ZARY@(0)=CNT ; update the array counter
     38        Q
     39        ;
     40ZLOAD(ZARY,ROUTINE)          ; load tests into ZARY which is passed by reference
     41        ; ZARY IS PASSED BY NAME
     42        ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
     43        ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
     44        K @ZARY S @ZARY=""
     45        S @ZARY@(0)=0 ; initialize array count
     46        N LINE,LABEL,BODY
     47        N INTEST S INTEST=0 ; switch for in the TEMPLATE section
     48        N SECTION S SECTION="[anonymous]" ; NO section LABEL
     49        ;
     50        N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
     51        . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
     52        . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
     53        . I INTEST  D  ; within the section
     54        . . I LINE?." "1";><".E  D  ; sub-section name found
     55        . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
     56        . . I LINE?." "1";;".E  D  ; line found
     57        . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
     58        Q
     59        ;
     60LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
     61        D ZLOAD(ARY,"C0CCCR0")
     62        ; ZWR @ARY
     63        Q
     64        ;
     65        ;<TEMPLATE>
     66        ;;<?xml version="1.0" encoding="UTF-8"?>
     67        ;;<?xml-stylesheet type="text/xsl" href="ccr.xsl"?>
     68        ;;<ContinuityOfCareRecord xmlns="urn:astm-org:CCR">
     69        ;;<CCRDocumentObjectID>@@CCRDOCOBJECTID@@</CCRDocumentObjectID>
     70        ;;<Language>
     71        ;;<Text>English</Text>
     72        ;;</Language>
     73        ;;<Version>V1.0</Version>
     74        ;;<DateTime>
     75        ;;<ExactDateTime>@@DATETIME@@</ExactDateTime>
     76        ;;</DateTime>
     77        ;;<Patient>
     78        ;;<ActorID>@@ACTORPATIENT@@</ActorID>
     79        ;;</Patient>
     80        ;;<From>
     81        ;;<ActorLink>
     82        ;;<ActorID>@@ACTORFROM@@</ActorID>
     83        ;;</ActorLink>
     84        ;;<ActorLink>
     85        ;;<ActorID>@@ACTORFROM2@@</ActorID>
     86        ;;</ActorLink>
     87        ;;</From>
     88        ;;<To>
     89        ;;<ActorLink>
     90        ;;<ActorID>@@ACTORTO@@</ActorID>
     91        ;;<ActorRole>
     92        ;;<Text>@@ACTORTOTEXT@@</Text>
     93        ;;</ActorRole>
     94        ;;</ActorLink>
     95        ;;</To>
     96        ;;<Purpose>
     97        ;;<Description>
     98        ;;<Text>@@PURPOSEDESCRIPTION@@</Text>
     99        ;;</Description>
     100        ;;</Purpose>
     101        ;;<Body>
     102        ;;<Problems>
     103        ;;<Problem>
     104        ;;<CCRDataObjectID>@@PROBLEMOBJECTID@@</CCRDataObjectID>
     105        ;;<DateTime>
     106        ;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime>
     107        ;;</DateTime>
     108        ;;<Type>
     109        ;;<Text>Problem</Text>
     110        ;;</Type>
     111        ;;<Description>
     112        ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
     113        ;;<Code>
     114        ;;<Value>@@PROBLEMCODEVALUE@@</Value>
     115        ;;<CodingSystem>ICD9CM</CodingSystem>
     116        ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
     117        ;;</Code>
     118        ;;</Description>
     119        ;;<Status>
     120        ;;<Text>@@PROBLEMSTATUS@@</Text>
     121        ;;</Status>
     122        ;;<Source>
     123        ;;<Actor>
     124        ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
     125        ;;</Actor>
     126        ;;</Source>
     127        ;;</Problem>
     128        ;;</Problems>
     129        ;;<Immunizations>
     130        ;;<Immunization>
     131        ;;<CCRDataObjectID>@@IMMUNEOBJECTID@@</CCRDataObjectID>
     132        ;;<DateTime>
     133        ;;<Type>
     134        ;;<Text>@@IMMUNEDATETIMETYPETEXT@@</Text>
     135        ;;</Type>
     136        ;;<ExactDateTime>@@IMMUNEDATETIME@@</ExactDateTime>
     137        ;;</DateTime>
     138        ;;<Source>
     139        ;;<Actor>
     140        ;;<ActorID>@@IMMUNESOURCEACTORID@@</ActorID>
     141        ;;</Actor>
     142        ;;</Source>
     143        ;;<Product>
     144        ;;<ProductName>
     145        ;;<Text>@@IMMUNEPRODUCTNAMETEXT@@</Text>
     146        ;;<Code>
     147        ;;<Value>@@IMMUNEPRODUCTCODE@@</Value>
     148        ;;<CodingSystem>@@IMMUNEPRODUCTCODESYSTEM@@</CodingSystem>
     149        ;;</Code>
     150        ;;</ProductName>
     151        ;;</Product>
     152        ;;</Immunization>
     153        ;;</Immunizations>
     154        ;;<FamilyHistory>
     155        ;;<FamilyProblemHistory>
     156        ;;<CCRDataObjectID>@@FAMILYHISTORYOBJECTID@@</CCRDataObjectID>
     157        ;;<Source>
     158        ;;<Actor>
     159        ;;<ActorID>@@FAMILYHISTORYACTORID@@</ActorID>
     160        ;;</Actor>
     161        ;;</Source>
     162        ;;<FamilyMember>
     163        ;;<ActorID>@@FAMILYMEMBERACTORID@@</ActorID>
     164        ;;<ActorRole>
     165        ;;<Text>@@FAMILYMEMBERACTORROLETEXT@@</Text>
     166        ;;</ActorRole>
     167        ;;<Source>
     168        ;;<Actor>
     169        ;;<ActorID>@@FAMILYMEMBERSOURCACTORID@@</ActorID>
     170        ;;</Actor>
     171        ;;</Source>
     172        ;;</FamilyMember>
     173        ;;<Problem>
     174        ;;<Type>
     175        ;;<Text>Problem</Text>
     176        ;;</Type>
     177        ;;<Description>
     178        ;;<Text>@@FAMILYMEMBERPROBLEMDESCRIPTION@@</Text>
     179        ;;<Code>
     180        ;;<Value>@@FAMILYMEMBERPROBLEMCODE@@</Value>
     181        ;;<CodingSystem>@@FAMILYMEMBERCODESYSTEM@@</CodingSystem>
     182        ;;<Version>@@FAMILYMEMBERCODEVERSION@@</Version>
     183        ;;</Code>
     184        ;;</Description>
     185        ;;<Source>
     186        ;;<Actor>
     187        ;;<ActorID>@@FAMILYMEMBERPROBLEMSOURCEID@@</ActorID>
     188        ;;</Actor>
     189        ;;</Source>
     190        ;;</Problem>
     191        ;;</FamilyProblemHistory>
     192        ;;</FamilyHistory>
     193        ;;<SocialHistory>
     194        ;;<SocialHistoryElement>
     195        ;;<CCRDataObjectID>@@SOCIALHISTORYOBJECTID@@</CCRDataObjectID>
     196        ;;<Type>
     197        ;;<Text>@@SOCIALHISTORYTYPETEXT@@</Text>
     198        ;;</Type>
     199        ;;<Description>
     200        ;;<Text>@@SOCIALHISTORYDESCRIPTIONTEXT@@</Text>
     201        ;;</Description>
     202        ;;<Source>
     203        ;;<Actor>
     204        ;;<ActorID>@@SOCIALHISTORYSOURCACTORID@@</ActorID>
     205        ;;</Actor>
     206        ;;</Source>
     207        ;;</SocialHistoryElement>
     208        ;;<SocialHistoryElement>
     209        ;;<CCRDataObjectID>BB0005</CCRDataObjectID>
     210        ;;<Type>
     211        ;;<Text>Ethnic Origin</Text>
     212        ;;</Type>
     213        ;;<Description>
     214        ;;<Text>Not Hispanic or Latino</Text>
     215        ;;</Description>
     216        ;;<Source>
     217        ;;<Actor>
     218        ;;<ActorID>AA0001</ActorID>
     219        ;;</Actor>
     220        ;;</Source>
     221        ;;</SocialHistoryElement>
     222        ;;<SocialHistoryElement>
     223        ;;<CCRDataObjectID>BB0006</CCRDataObjectID>
     224        ;;<Type>
     225        ;;<Text>Race</Text>
     226        ;;</Type>
     227        ;;<Description>
     228        ;;<Text>White</Text>
     229        ;;</Description>
     230        ;;<Source>
     231        ;;<Actor>
     232        ;;<ActorID>AA0001</ActorID>
     233        ;;</Actor>
     234        ;;</Source>
     235        ;;</SocialHistoryElement>
     236        ;;<SocialHistoryElement>
     237        ;;<CCRDataObjectID>BB0007</CCRDataObjectID>
     238        ;;<Type>
     239        ;;<Text>Occupation</Text>
     240        ;;</Type>
     241        ;;<Description>
     242        ;;<Text>Physician</Text>
     243        ;;</Description>
     244        ;;<Source>
     245        ;;<Actor>
     246        ;;<ActorID>AA0001</ActorID>
     247        ;;</Actor>
     248        ;;</Source>
     249        ;;</SocialHistoryElement>
     250        ;;</SocialHistory>
     251        ;;<Alerts>
     252        ;;<Alert>
     253        ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
     254        ;;<DateTime>
     255        ;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime>
     256        ;;</DateTime>
     257        ;;<Type>
     258        ;;<Text>@@ALERTTYPE@@</Text>
     259        ;;</Type>
     260        ;;<Status>
     261        ;;<Text>@@ALERTSTATUSTEXT@@</Text>
     262        ;;</Status>
     263        ;;<Description>
     264        ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
     265        ;;<Code>
     266        ;;<Value>@@ALERTCODEVALUE@@</Value>
     267        ;;<CodingSystem>@@ALERTCODESYSTEM@@</CodingSystem>
     268        ;;</Code>
     269        ;;</Description>
     270        ;;<Source>
     271        ;;<Actor>
     272        ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
     273        ;;</Actor>
     274        ;;</Source>
     275        ;;<Agent>
     276        ;;<Products>
     277        ;;<Product>
     278        ;;<CCRDataObjectID>@@ALERTAGENTPRODUCTOBJECTID@@</CCRDataObjectID>
     279        ;;<Source>
     280        ;;<Actor>
     281        ;;<ActorID>@@ALERTSOURCEID@@</ActorID>
     282        ;;</Actor>
     283        ;;</Source>
     284        ;;<Product>
     285        ;;<ProductName>
     286        ;;<Text>@@ALERTAGENTPRODUCTNAMETEXT@@</Text>
     287        ;;<Code>
     288        ;;<Value>@@ALERTAGENTPRODUCTCODEVALUE@@</Value>
     289        ;;<CodingSystem>@@ALERTAGENTPRODUCTCODESYSTEM@@</CodingSystem>
     290        ;;</Code>
     291        ;;</ProductName>
     292        ;;</Product>
     293        ;;</Product>
     294        ;;</Products>
     295        ;;</Agent>
     296        ;;<Reaction>
     297        ;;<Description>
     298        ;;<Text>@@ALERTREACTIOINDESCRIPTIONTEXT@@</Text>
     299        ;;<Code>
     300        ;;<Value>@@ALERTREACTIONCODEVALUE@@</Value>
     301        ;;<CodingSystem>@@ALERTREACTIONCODESYSTEM@@</CodingSystem>
     302        ;;</Code>
     303        ;;</Description>
     304        ;;</Reaction>
     305        ;;</Alert>
     306        ;;</Alerts>
     307        ;;<Medications>
     308        ;;<Medication>
     309        ;;<CCRDataObjectID>@@MEDOBJECTID@@</CCRDataObjectID>
     310        ;;<DateTime>
     311        ;;<Type>
     312        ;;<Text>@@MEDISSUEDATETXT@@</Text>
     313        ;;</Type>
     314        ;;<ExactDateTime>@@MEDISSUEDATE@@</ExactDateTime>
     315        ;;</DateTime>
     316        ;;<DateTime>
     317        ;;<Type>
     318        ;;<Text>@@MEDLASTFILLDATETXT@@</Text>
     319        ;;</Type>
     320        ;;<ExactDateTime>@@MEDLASTFILLDATE@@</ExactDateTime>
     321        ;;</DateTime>
     322        ;;<IDs>
     323        ;;<Type>
     324        ;;<Text>@@MEDRXNOTXT@@</Text>
     325        ;;</Type>
     326        ;;<ID>@@MEDRXNO@@</ID>
     327        ;;</IDs>
     328        ;;<Type>
     329        ;;<Text>@@MEDTYPETEXT@@</Text>
     330        ;;</Type>
     331        ;;<Description>
     332        ;;<Text>@@MEDDETAILUNADORNED@@</Text>
     333        ;;</Description>
     334        ;;<Status>
     335        ;;<Text>@@MEDSTATUSTEXT@@</Text>
     336        ;;</Status>
     337        ;;<Source>
     338        ;;<Actor>
     339        ;;<ActorID>@@MEDSOURCEACTORID@@</ActorID>
     340        ;;</Actor>
     341        ;;</Source>
     342        ;;<Product>
     343        ;;<ProductName>
     344        ;;<Text>@@MEDPRODUCTNAMETEXT@@</Text>
     345        ;;<Code>
     346        ;;<Value>@@MEDPRODUCTNAMECODEVALUE@@</Value>
     347        ;;<CodingSystem>@@MEDPRODUCTNAMECODINGINGSYSTEM@@</CodingSystem>
     348        ;;<Version>@@MEDPRODUCTNAMECODEVERSION@@</Version>
     349        ;;</Code>
     350        ;;</ProductName>
     351        ;;<BrandName>
     352        ;;<Text>@@MEDBRANDNAMETEXT@@</Text>
     353        ;;</BrandName>
     354        ;;<Strength>
     355        ;;<Value>@@MEDSTRENGTHVALUE@@</Value>
     356        ;;<Units>
     357        ;;<Unit>@@MEDSTRENGTHUNIT@@</Unit>
     358        ;;</Units>
     359        ;;</Strength>
     360        ;;<Form>
     361        ;;<Text>@@MEDFORMTEXT@@</Text>
     362        ;;</Form>
     363        ;;<Concentration>
     364        ;;<Value>@@MEDCONCVALUE@@</Value>
     365        ;;<Units>
     366        ;;<Unit>@@MEDCONCUNIT@@</Unit>
     367        ;;</Units>
     368        ;;</Concentration>
     369        ;;</Product>
     370        ;;<Quantity>
     371        ;;<Value>@@MEDQUANTITYVALUE@@</Value>
     372        ;;<Units>
     373        ;;<Unit>@@MEDQUANTITYUNIT@@</Unit>
     374        ;;</Units>
     375        ;;</Quantity>
     376        ;;<Directions>
     377        ;;<Direction>
     378        ;;<Description>
     379        ;;<Text>@@MEDDIRECTIONDESCRIPTIONTEXT@@</Text>
     380        ;;</Description>
     381        ;;<DoseIndicator>
     382        ;;<Text>@@MEDDOSEINDICATOR@@</Text>
     383        ;;</DoseIndicator>
     384        ;;<DeliveryMethod>
     385        ;;<Text>@@MEDDELIVERYMETHOD@@</Text>
     386        ;;</DeliveryMethod>
     387        ;;<Dose>
     388        ;;<Value>@@MEDDOSEVALUE@@</Value>
     389        ;;<Units>
     390        ;;<Unit>@@MEDDOSEUNIT@@</Unit>
     391        ;;</Units>
     392        ;;<Rate>
     393        ;;<Value>@@MEDRATEVALUE@@</Value>
     394        ;;<Units>
     395        ;;<Unit>@@MEDRATEUNIT@@</Unit>
     396        ;;</Units>
     397        ;;</Rate>
     398        ;;</Dose>
     399        ;;<Vehicle>
     400        ;;<Text>@@MEDVEHICLETEXT@@</Text>
     401        ;;</Vehicle>
     402        ;;<Route>
     403        ;;<Text>@@MEDDIRECTIONROUTETEXT@@</Text>
     404        ;;</Route>
     405        ;;<Frequency>
     406        ;;<Value>@@MEDFREQUENCYVALUE@@</Value>
     407        ;;</Frequency>
     408        ;;<Interval>
     409        ;;<Value>@@MEDINTERVALVALUE@@</Value>
     410        ;;<Units>
     411        ;;<Unit>@@MEDINTERVALUNIT@@</Unit>
     412        ;;</Units>
     413        ;;</Interval>
     414        ;;<Duration>
     415        ;;<Value>@@MEDDURATIONVALUE@@</Value>
     416        ;;<Units>
     417        ;;<Unit>@@MEDDURATIONUNIT@@</Unit>
     418        ;;</Units>
     419        ;;</Duration>
     420        ;;<Indication>
     421        ;;<PRNFlag>
     422        ;;<Text>@@MEDPRNFLAG@@</Text>
     423        ;;</PRNFlag>
     424        ;;<Problem>
     425        ;;<CCRDataObjectID>@@MEDPROBLEMOBJECTID@@</CCRDataObjectID>
     426        ;;<Type>
     427        ;;<Text>@@MEDPROBLEMTYPETXT@@</Text>
     428        ;;</Type>
     429        ;;<Description>
     430        ;;<Text>@@MEDPROBLEMDESCRIPTION@@</Text>
     431        ;;<Code>
     432        ;;<Value>@@MEDPROBLEMCODEVALUE@@</Value>
     433        ;;<CodingSystem>@@MEDPROBLEMCODINGSYSTEM@@</CodingSystem>
     434        ;;<Version>@@MEDPROBLEMCODINGVERSION@@</Version>
     435        ;;</Code>
     436        ;;</Description>
     437        ;;<Source>
     438        ;;<Actor>
     439        ;;<ActorID>@@MEDPROBLEMSOURCEACTORID@@</ActorID>
     440        ;;</Actor>
     441        ;;</Source>
     442        ;;</Problem>
     443        ;;</Indication>
     444        ;;<StopIndicator>
     445        ;;<Text>@@MEDSTOPINDICATOR@@</Text>
     446        ;;</StopIndicator>
     447        ;;<DirectionSequenceModifier>@@MEDDIRSEQ@@</DirectionSequenceModifier>
     448        ;;<MultipleDirectionModifier>
     449        ;;<Text>@@MEDMULDIRMOD@@</Text>
     450        ;;</MultipleDirectionModifier>
     451        ;;</Direction>
     452        ;;</Directions>
     453        ;;<PatientInstructions>
     454        ;;<Instruction>
     455        ;;<Text>@@MEDPTINSTRUCTIONS@@</Text>
     456        ;;</Instruction>
     457        ;;</PatientInstructions>
     458        ;;<FullfillmentInstructions>
     459        ;;<Text>@@MEDFULLFILLMENTINSTRUCTIONS@@</Text>
     460        ;;</FullfillmentInstructions>
     461        ;;<Refills>
     462        ;;<Refill>
     463        ;;<Number>@@MEDRFNO@@</Number>
     464        ;;</Refill>
     465        ;;</Refills>
     466        ;;</Medication>
     467        ;;</Medications>
     468        ;;<VitalSigns>
     469        ;;<Result>
     470        ;;<CCRDataObjectID>@@VITALSIGNSDATAOBJECTID@@</CCRDataObjectID>
     471        ;;<DateTime>
     472        ;;<Type>
     473        ;;<Text>@@VITALSIGNSDATETIMETYPETEXT@@</Text>
     474        ;;</Type>
     475        ;;<ExactDateTime>@@VITALSIGNSEXACTDATETIME@@</ExactDateTime>
     476        ;;</DateTime>
     477        ;;<Description>
     478        ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
     479        ;;</Description>
     480        ;;<Source>
     481        ;;<Actor>
     482        ;;<ActorID>@@VITALSIGNSSOURCEACTORID@@</ActorID>
     483        ;;</Actor>
     484        ;;</Source>
     485        ;;<Test>
     486        ;;<CCRDataObjectID>@@VITALSIGNSTESTOBJECTID@@</CCRDataObjectID>
     487        ;;<Type>
     488        ;;<Text>@@VITALSIGNSTESTTYPETEXT@@</Text>
     489        ;;</Type>
     490        ;;<Description>
     491        ;;<Text>@@VITALSIGNSDESCRIPTIONTEXT@@</Text>
     492        ;;<Code>
     493        ;;<Value>@@VITALSIGNSDESCCODEVALUE@@</Value>
     494        ;;<CodingSystem>@@VITALSIGNSDESCCODINGSYSTEM@@</CodingSystem>
     495        ;;<Version>@@VITALSIGNSCODEVERSION@@</Version>
     496        ;;</Code>
     497        ;;</Description>
     498        ;;<Source>
     499        ;;<Actor>
     500        ;;<ActorID>@@VITALSIGNSTESTSOURCEACTORID@@</ActorID>
     501        ;;</Actor>
     502        ;;</Source>
     503        ;;<TestResult>
     504        ;;<Value>@@VITALSIGNSTESTRESULTVALUE@@</Value>
     505        ;;<Units>
     506        ;;<Unit>@@VITALSIGNSTESTRESULTUNIT@@</Unit>
     507        ;;</Units>
     508        ;;</TestResult>
     509        ;;</Test>
     510        ;;</Result>
     511        ;;</VitalSigns>
     512        ;;<Results>
     513        ;;<Result>
     514        ;;<CCRDataObjectID>@@RESULTOBJECTID@@</CCRDataObjectID>
     515        ;;<DateTime>
     516        ;;<Type>
     517        ;;<Text>Assessment Time</Text>
     518        ;;</Type>
     519        ;;<ExactDateTime>@@RESULTASSESSMENTDATETIME@@</ExactDateTime>
     520        ;;</DateTime>
     521        ;;<Description>
     522        ;;<Text>@@RESULTDESCRIPTIONTEXT@@</Text>
     523        ;;<Code>
     524        ;;<Value>@@RESULTCODE@@</Value>
     525        ;;<CodingSystem>@@RESULTCODINGSYSTEM@@</CodingSystem>
     526        ;;</Code>
     527        ;;</Description>
     528        ;;<Status>
     529        ;;<Text>@@RESULTSTATUS@@</Text>
     530        ;;</Status>
     531        ;;<Source>
     532        ;;<Actor>
     533        ;;<ActorID>@@RESULTSOURCEACTORID@@</ActorID>
     534        ;;</Actor>
     535        ;;</Source>
     536        ;;<Test>
     537        ;;<CCRDataObjectID>@@RESULTTESTOBJECTID@@</CCRDataObjectID>
     538        ;;<DateTime>
     539        ;;<Type>
     540        ;;<Text>Assessment Time</Text>
     541        ;;</Type>
     542        ;;<ExactDateTime>@@RESULTTESTDATETIME@@</ExactDateTime>
     543        ;;</DateTime>
     544        ;;<Description>
     545        ;;<Text>@@RESULTTESTDESCRIPTIONTEXT@@</Text>
     546        ;;<Code>
     547        ;;<Value>@@RESULTTESTCODEVALUE@@</Value>
     548        ;;<CodingSystem>@@RESULTTESTCODINGSYSTEM@@</CodingSystem>
     549        ;;</Code>
     550        ;;</Description>
     551        ;;<Status>
     552        ;;<Text>@@RESULTTESTSTATUSTEXT@@</Text>
     553        ;;</Status>
     554        ;;<Source>
     555        ;;<Actor>
     556        ;;<ActorID>@@RESULTTESTSOURCEACTORID@@</ActorID>
     557        ;;</Actor>
     558        ;;</Source>
     559        ;;<TestResult>
     560        ;;<Value>@@RESULTTESTVALUE@@</Value>
     561        ;;<Units>
     562        ;;<Unit>@@RESULTTESTUNITS@@</Unit>
     563        ;;</Units>
     564        ;;</TestResult>
     565        ;;<NormalResult>
     566        ;;<Normal>
     567        ;;<Description>
     568        ;;<Text>@@RESULTTESTNORMALDESCTEXT@@</Text>
     569        ;;</Description>
     570        ;;<Source>
     571        ;;<Actor>
     572        ;;<ActorID>@@RESULTTESTNORMALSOURCEACTORID@@</ActorID>
     573        ;;</Actor>
     574        ;;</Source>
     575        ;;</Normal>
     576        ;;</NormalResult>
     577        ;;<Flag>
     578        ;;<Text>@@RESULTTESTFLAG@@</Text>
     579        ;;</Flag>
     580        ;;</Test>
     581        ;;</Result>
     582        ;;</Results>
     583        ;;<Procedures>
     584        ;;<Procedure>
     585        ;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID>
     586        ;;<DateTime>
     587        ;;<Type>
     588        ;;<Text>@@PROCDATETEXT@@</Text>
     589        ;;</Type>
     590        ;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime>
     591        ;;</DateTime>
     592        ;;<Description>
     593        ;;<Text>@@PROCDESCTEXT@@</Text>
     594        ;;<ObjectAttribute>
     595        ;;<Attribute>@@PROCDESCOBJATTR@@</Attribute>
     596        ;;<AttributeValue>
     597        ;;<Value>@@PROCDESCOBJATTRVAL@@</Value>
     598        ;;<Code>
     599        ;;<Value>@@PROCDESCOBJATTRCODE@@</Value>
     600        ;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem>
     601        ;;</Code>
     602        ;;</AttributeValue>
     603        ;;</ObjectAttribute>
     604        ;;<Code>
     605        ;;<Value>@@PROCCODE@@</Value>
     606        ;;<CodingSystem>@@PROCCODESYS@@</CodingSystem>
     607        ;;</Code>
     608        ;;</Description>
     609        ;;<Status>
     610        ;;<Text>@@PROCSTATUS@@</Text>
     611        ;;</Status>
     612        ;;<Source>
     613        ;;<Actor>
     614        ;;<ActorID>@@PROCACTOROBJID@@</ActorID>
     615        ;;</Actor>
     616        ;;</Source>
     617        ;;<InternalCCRLink>
     618        ;;<LinkID>@@PROCLINKID@@</LinkID>
     619        ;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship>
     620        ;;</InternalCCRLink>
     621        ;;</Procedure>
     622        ;;</Procedures>
     623        ;;<Encounters>
     624        ;;<Encounter>
     625        ;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID>
     626        ;;<DateTime>
     627        ;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime>
     628        ;;</DateTime>
     629        ;;<Type>
     630        ;;<Text>@@ENCTYPETXT@@</Text>
     631        ;;<Code>
     632        ;;<Value>@@ENCTYPECODE@@</Value>
     633        ;;<CodingSystem>@@ENCTYPECODESYS@@</CodingSystem>
     634        ;;</Code>
     635        ;;</Type>
     636        ;;<Description>
     637        ;;<Text>@@ENCDESCTXT@@</Text>
     638        ;;<Code>
     639        ;;<Value>@@ENCDESCCODE@@</Value>
     640        ;;<CodingSystem>@@ENCDESCCODESYS@@</CodingSystem>
     641        ;;</Code>
     642        ;;</Description>
     643        ;;<Location>
     644        ;;<Actor>
     645        ;;<ActorID>@@ENCLOCACTORID@@</ActorID>
     646        ;;</Actor>
     647        ;;</Location>
     648        ;;<Practioner>
     649        ;;<Actor>
     650        ;;<ActorID>@@ENCPRVACTORID@@</ActorID>
     651        ;;</Actor>
     652        ;;</Practioner>
     653        ;;<Indication>
     654        ;;<Text>@@ENCINDTXT@@</Text>
     655        ;;<Code>
     656        ;;<Value>@@ENCINDCODE@@</Value>
     657        ;;<CodingSystem>@@ENCINDCODESYS@@</CodingSystem>
     658        ;;</Code>
     659        ;;</Indication>
     660        ;;<Source>
     661        ;;<Actor>
     662        ;;<ActorID>@@ENCACTORID@@</ActorID>
     663        ;;</Actor>
     664        ;;</Source>
     665        ;;<CommentID>@@ENCCOMMENTID@@</CommentID>
     666        ;;</Encounter>
     667        ;;</Encounters>
     668        ;;<HealthCareProviders>
     669        ;;<Provider>
     670        ;;<ActorID>AA0005</ActorID>
     671        ;;<ActorRole>
     672        ;;<Text>Primary Provider</Text>
     673        ;;</ActorRole>
     674        ;;</Provider>
     675        ;;</HealthCareProviders>
     676        ;;</Body>
     677        ;;<Actors>
     678        ;;<ACTOR-PATIENT>
     679        ;;<Actor>
     680        ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
     681        ;;<Person>
     682        ;;<Name>
     683        ;;<CurrentName>
     684        ;;<Given>@@ACTORGIVENNAME@@</Given>
     685        ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
     686        ;;<Family>@@ACTORFAMILYNAME@@</Family>
     687        ;;</CurrentName>
     688        ;;</Name>
     689        ;;<DateOfBirth>
     690        ;;<ExactDateTime>@@ACTORDATEOFBIRTH@@</ExactDateTime>
     691        ;;</DateOfBirth>
     692        ;;<Gender>
     693        ;;<Text>@@ACTORGENDER@@</Text>
     694        ;;<Code>
     695        ;;<Value>@@ACTORGENDERCODE@@</Value>
     696        ;;<CodingSystem>HL7 AdministrativeGender</CodingSystem>
     697        ;;</Code>
     698        ;;</Gender>
     699        ;;</Person>
     700        ;;<IDs>
     701        ;;<Type>
     702        ;;<Text>@@ACTORSSNTEXT@@</Text>
     703        ;;</Type>
     704        ;;<ID>@@ACTORSSN@@</ID>
     705        ;;<Source>
     706        ;;<Actor>
     707        ;;<ActorID>@@ACTORSSNSOURCEID@@</ActorID>
     708        ;;</Actor>
     709        ;;</Source>
     710        ;;</IDs>
     711        ;;<Address>
     712        ;;<Type>
     713        ;;<Text>@@ACTORADDRESSTYPE@@</Text>
     714        ;;</Type>
     715        ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
     716        ;;<Line2>@@ACTORADDRESSLINE2@@</Line2>
     717        ;;<City>@@ACTORADDRESSCITY@@</City>
     718        ;;<State>@@ACTORADDRESSSTATE@@</State>
     719        ;;<PostalCode>@@ACTORADDRESSZIPCODE@@</PostalCode>
     720        ;;</Address>
     721        ;;<Telephone>
     722        ;;<Value>@@ACTORRESTEL@@</Value>
     723        ;;<Type>
     724        ;;<Text>@@ACTORRESTELTEXT@@</Text>
     725        ;;</Type>
     726        ;;</Telephone>
     727        ;;<Telephone>
     728        ;;<Value>@@ACTORWORKTEL@@</Value>
     729        ;;<Type>
     730        ;;<Text>@@ACTORWORKTELTEXT@@</Text>
     731        ;;</Type>
     732        ;;</Telephone>
     733        ;;<Telephone>
     734        ;;<Value>@@ACTORCELLTEL@@</Value>
     735        ;;<Type>
     736        ;;<Text>@@ACTORCELLTELTEXT@@</Text>
     737        ;;</Type>
     738        ;;</Telephone>
     739        ;;<EMail>
     740        ;;<Value>@@ACTOREMAIL@@</Value>
     741        ;;</EMail>
     742        ;;<Source>
     743        ;;<Actor>
     744        ;;<ActorID>@@ACTORADDRESSSOURCEID@@</ActorID>
     745        ;;</Actor>
     746        ;;</Source>
     747        ;;</Actor>
     748        ;;</ACTOR-PATIENT>
     749        ;;<ACTOR-SYSTEM>
     750        ;;<Actor>
     751        ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
     752        ;;<InformationSystem>
     753        ;;<Name>@@ACTORINFOSYSNAME@@</Name>
     754        ;;<Version>@@ACTORINFOSYSVER@@</Version>
     755        ;;</InformationSystem>
     756        ;;<Source>
     757        ;;<Actor>
     758        ;;<ActorID>@@ACTORINFOSYSSOURCEID@@</ActorID>
     759        ;;</Actor>
     760        ;;</Source>
     761        ;;</Actor>
     762        ;;</ACTOR-SYSTEM>
     763        ;;<ACTOR-NOK>
     764        ;;<Actor>
     765        ;;<ActorObjectID>AA0003</ActorObjectID>
     766        ;;<Person>
     767        ;;<Name>
     768        ;;<DisplayName>@@ACTORDISPLAYNAME@@</DisplayName>
     769        ;;</Name>
     770        ;;</Person>
     771        ;;<Relation>
     772        ;;<Text>@@ACTORRELATION@@</Text>
     773        ;;</Relation>
     774        ;;<Source>
     775        ;;<Actor>
     776        ;;<ActorID>@@ACTORRELATIONSOURCEID@@</ActorID>
     777        ;;</Actor>
     778        ;;</Source>
     779        ;;</Actor>
     780        ;;</ACTOR-NOK>
     781        ;;<ACTOR-PROVIDER>
     782        ;;<Actor>
     783        ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
     784        ;;<Person>
     785        ;;<Name>
     786        ;;<CurrentName>
     787        ;;<Given>@@ACTORGIVENNAME@@</Given>
     788        ;;<Middle>@@ACTORMIDDLENAME@@</Middle>
     789        ;;<Family>@@ACTORFAMILYNAME@@</Family>
     790        ;;<Title>@@ACTORTITLE@@</Title>
     791        ;;</CurrentName>
     792        ;;</Name>
     793        ;;</Person>
     794        ;;<Specialty>
     795        ;;<Text>@@ACTORSPECIALITY@@</Text>
     796        ;;</Specialty>
     797        ;;<Address>
     798        ;;<Type>
     799        ;;<Text>@@ACTORADDRESSTYPE@@</Text>
     800        ;;</Type>
     801        ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
     802        ;;<City>@@ACTORADDRESSCITY@@</City>
     803        ;;<State>@@ACTORADDRESSSTATE@@</State>
     804        ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
     805        ;;</Address>
     806        ;;<Telephone>
     807        ;;<Value>@@ACTORTELEPHONE@@</Value>
     808        ;;<Type>
     809        ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
     810        ;;</Type>
     811        ;;</Telephone>
     812        ;;<Email>
     813        ;;<Value>@@ACTOREMAIL@@</Value>
     814        ;;</Email>
     815        ;;<Source>
     816        ;;<Actor>
     817        ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
     818        ;;</Actor>
     819        ;;</Source>
     820        ;;<InternalCCRLink>
     821        ;;<LinkID>@@ACTORORGLINK@@</LinkID>
     822        ;;<LinkRelationship>representedOrganization</LinkRelationship>
     823        ;;</InternalCCRLink>
     824        ;;</Actor>
     825        ;;</ACTOR-PROVIDER>
     826        ;;<ACTOR-ORG>
     827        ;;<Actor>
     828        ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
     829        ;;<Organization>
     830        ;;<Name>@@ORGANIZATIONNAME@@</Name>
     831        ;;</Organization>
     832        ;;<Address>
     833        ;;<Type>
     834        ;;<Text>@@ACTORADDRESSTYPE@@</Text>
     835        ;;</Type>
     836        ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
     837        ;;<City>@@ACTORADDRESSCITY@@</City>
     838        ;;<State>@@ACTORADDRESSSTATE@@</State>
     839        ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
     840        ;;</Address>
     841        ;;<Telephone>
     842        ;;<Value>@@ACTORTELEPHONE@@</Value>
     843        ;;<Type>
     844        ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
     845        ;;</Type>
     846        ;;</Telephone>
     847        ;;<Source>
     848        ;;<Actor>
     849        ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
     850        ;;</Actor>
     851        ;;</Source>
     852        ;;</Actor>
     853        ;;</ACTOR-ORG>
     854        ;;</Actors>
     855        ;;<Signatures>
     856        ;;<CCRSignature>
     857        ;;<SignatureObjectID>S0001</SignatureObjectID>
     858        ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
     859        ;;<Source>
     860        ;;<ActorID>AA0001</ActorID>
     861        ;;</Source>
     862        ;;<Signature>
     863        ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
     864        ;;<SignedInfo>
     865        ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
     866        ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
     867        ;;<Reference URI="">
     868        ;;<Transforms>
     869        ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
     870        ;;</Transforms>
     871        ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
     872        ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
     873        ;;</Reference>
     874        ;;</SignedInfo>
     875        ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
     876        ;;<KeyInfo>
     877        ;;<KeyValue>
     878        ;;<RSAKeyValue>
     879        ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
     880        ;;<Exponent>AQAB</Exponent>
     881        ;;</RSAKeyValue>
     882        ;;</KeyValue>
     883        ;;</KeyInfo>
     884        ;;</Signature>
     885        ;;</Signature>
     886        ;;</CCRSignature>
     887        ;;</Signatures>
     888        ;;<Comments>
     889        ;;<Comment>
     890        ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID>
     891        ;;<DateTime>
     892        ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime>
     893        ;;</DateTime>
     894        ;;<Description>
     895        ;;<Text>
     896        ;;</Text>
     897        ;;</Description>
     898        ;;<Source>
     899        ;;<Actor>
     900        ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
     901        ;;</Actor>
     902        ;;</Source>
     903        ;;</Comment>
     904        ;;</Comments>
     905        ;;</ContinuityOfCareRecord>
     906        ;</TEMPLATE>
  • ccr/branches/ohum/p/C0CCMT.m

    r1329 r1330  
    1 C0CCMT  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
    2  ;;1.0;C0C;;May 21, 2010;Build 38
    3  ;Copyright 2010 George Lilly, University of Minnesota and others.
    4  ;Licensed under the terms of the GNU General Public License.
    5  ;See attached copy of the License.
    6  ;
    7  ;This program is free software; you can redistribute it and/or modify
    8  ;it under the terms of the GNU General Public License as published by
    9  ;the Free Software Foundation; either version 2 of the License, or
    10  ;(at your option) any later version.
    11  ;
    12  ;This program is distributed in the hope that it will be useful,
    13  ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14  ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15  ;GNU General Public License for more details.
    16  ;
    17  ;You should have received a copy of the GNU General Public License along
    18  ;with this program; if not, write to the Free Software Foundation, Inc.,
    19  ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20  ;
    21  W "NO ENTRY FROM TOP",!
    22  Q
    23  ;
    24 EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO  XML TEMPLATE
    25  ; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
    26  ;
    27  D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
    28  ;I '$D(@C0CNTE) Q  ; NO NOTES AVAILABLE
    29  D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES
    30  Q
    31  ;
    32 MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML
    33  ;
    34  N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE
    35  K @ZTEMP
    36  N ZBLD
    37  S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA
    38  D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE
    39  N ZINNER
    40  D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE
    41  N ZTMP,ZVAR,ZI
    42  S ZI=""
    43  F  S ZI=$O(@C0CNTE@(ZI)) Q:ZI=""  D  ;FOR EACH NOTE
    44  . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML
    45  . S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES
    46  . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
    47  . N ZNOTE,ZN
    48  . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
    49  . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
    50  . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
    51  . D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")
    52  . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
    53  D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))
    54  N ZZTMP
    55  D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML
    56  K @ZTEMP,@ZBLD,@C0CNTE
    57  Q
    58  
    59 CLEAN(INARY) ; INARY IS PASSED BY NAME
    60  ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
    61  N ZI,ZJ S ZI=""
    62  F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ;
    63  . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
    64  . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
    65  Q
    66  ;
     1C0CCMT  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
     2        ;;1.0;C0C;;May 21, 2010;Build 1
     3        ;Copyright 2010 George Lilly, University of Minnesota and others.
     4        ;Licensed under the terms of the GNU General Public License.
     5        ;See attached copy of the License.
     6        ;
     7        ;This program is free software; you can redistribute it and/or modify
     8        ;it under the terms of the GNU General Public License as published by
     9        ;the Free Software Foundation; either version 2 of the License, or
     10        ;(at your option) any later version.
     11        ;
     12        ;This program is distributed in the hope that it will be useful,
     13        ;but WITHOUT ANY WARRANTY; without even the implied warranty of
     14        ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15        ;GNU General Public License for more details.
     16        ;
     17        ;You should have received a copy of the GNU General Public License along
     18        ;with this program; if not, write to the Free Software Foundation, Inc.,
     19        ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     20        ;
     21        W "NO ENTRY FROM TOP",!
     22        Q
     23        ;
     24EXTRACT(NOTEXML,DFN,NOTEOUT)    ; EXTRACT NOTES INTO  XML TEMPLATE
     25        ; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
     26        ;
     27        D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
     28        ;I '$D(@C0CNTE) Q  ; NO NOTES AVAILABLE
     29        D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES
     30        Q
     31        ;
     32MAP(NOTEXML,C0CNTE,NOTEOUT)     ; MAP PROCEDURES XML
     33        ;
     34        N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE
     35        K @ZTEMP
     36        N ZBLD
     37        S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA
     38        D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE
     39        N ZINNER
     40        D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE
     41        N ZTMP,ZVAR,ZI
     42        S ZI=""
     43        F  S ZI=$O(@C0CNTE@(ZI)) Q:ZI=""  D  ;FOR EACH NOTE
     44        . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML
     45        . S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES
     46        . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
     47        . N ZNOTE,ZN
     48        . D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
     49        . M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
     50        . S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
     51        . D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")
     52        . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
     53        D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))
     54        N ZZTMP
     55        D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML
     56        K @ZTEMP,@ZBLD,@C0CNTE
     57        Q
     58       
     59CLEAN(INARY)    ; INARY IS PASSED BY NAME
     60        ; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
     61        N ZI,ZJ S ZI=""
     62        F  S ZI=$O(@INARY@(ZI)) Q:ZI=""  D  ;
     63        . S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
     64        . S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
     65        Q
     66        ;
  • ccr/branches/ohum/p/C0CCPT.m

    r1329 r1330  
    1 C0CCPT ;;BSL;RETURN CPT DATA;
    2  ;Sequence Managers Software GPL;;;;;Build 38
    3  ;Copied into C0C namespace from SQMCPT with permission from
    4  ;Brian Lord - and with our thanks. gpl 01/20/2010
    5 ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
    6  ;DFN=PATIENT IEN
    7  ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
    8  ;ENDDT=END DATE IN 3100101 FORMAT
    9  ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
    10  ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
    11         ;ALL INCLUSIVE IN THAT DIRECTION
    12         ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
    13         ;BUILD INTO NOTE(Y)=""
    14         S U="^",X=""
    15         F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
    16         . S Y=""
    17         . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
    18         .. S NOTE(Y)=""
    19         ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
    20         ;GET DATE OF NOTE
    21         S Z=""
    22         F  S Z=$O(NOTE(Z)) Q:Z=""  D
    23         . S DT=$P(^TIU(8925,Z,0),U,7)
    24         . I $G(STDT)]"" D
    25         .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
    26         . I $G(ENDDT)]"" D
    27         .. I ENDDT<DT S NOTE(Z)="D"
    28         . I NOTE(Z)="D" K NOTE(Z)
    29  D VISIT
    30         Q
    31 VISIT   ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
    32  S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
    33  S IEN=""  F  S IEN=$O(NOTE(IEN)) Q:IEN=""  D
    34  . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
    35  . S VISIT=$P(X12,U,7)
    36  . I 'VISIT S VISIT=$P(X0,U,3)
    37  . K ^TMP("PXKENC",$J)
    38  . Q:VISIT=""!(VISIT'>0)
    39  . D ENCEVENT^PXKENC(VISIT,1)
    40  . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
    41  . S IPRV=0 F  S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV  D
    42  .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
    43  .. ;Q:$P(X0,U,4)'="P"
    44  .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
    45  .. S PRIM=($P(X0,U,4)="P")
    46  .. S ILST=ILST+1
    47  .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
    48  .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
    49  . S IPOV=0 F  S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV  D
    50  .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
    51  .. S CODE=$P(X0,U)
    52  .. S:CODE CODE=$P(^ICD9(CODE,0),U)
    53  .. S CAT=$P(X802,U)
    54  .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
    55  .. S NARR=$P(X0,U,4)
    56  .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
    57  .. S PRIM=($P(X0,U,12)="P")
    58  .. S PRV=$P(X12,U,4)
    59  .. S ILST=ILST+1
    60  .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
    61  .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
    62  . S ICPT=0 F  S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT  D
    63  .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
    64  .. ;S CODE=$P(X0,U)
    65  .. S CODE=$O(^ICPT("B",$P(X0,U),0))
    66  .. S:CODE CODE=$P(^ICPT(CODE,0),U)
    67  .. S CAT=$P(X802,U)
    68  .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
    69  .. S NARR=$P(X0,U,4)
    70  .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
    71  .. S QTY=$P(X0,U,16)
    72  .. S PRV=$P(X12,U,4)
    73  .. S MCNT=0,MIDX=0,MODS=""
    74  .. F  S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX  D
    75  ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
    76  ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
    77  .. I +MCNT S MODS=MCNT_MODS
    78  .. S ILST=ILST+1
    79  .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
    80  .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
    81  . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
    82  . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
    83  . I $G(TXT)=1 D GETNOTE(IEN)
    84  Q
    85 GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
    86  ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
    87  Q:'$D(VISIT(IEN,"CPT"))
    88  S TXTCNT=0
    89  F  S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0))  D
    90  . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
    91  Q
     1C0CCPT  ;;BSL;RETURN CPT DATA;
     2        ;Sequence Managers Software GPL;;;;;Build 1
     3        ;Copied into C0C namespace from SQMCPT with permission from
     4        ;Brian Lord - and with our thanks. gpl 01/20/2010
     5ENTRY(DFN,STDT,ENDDT,TXT)       ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
     6        ;DFN=PATIENT IEN
     7        ;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
     8        ;ENDDT=END DATE IN 3100101 FORMAT
     9        ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
     10        ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
     11               ;ALL INCLUSIVE IN THAT DIRECTION
     12               ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
     13               ;BUILD INTO NOTE(Y)=""
     14               S U="^",X=""
     15               F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
     16               . S Y=""
     17               . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
     18               .. S NOTE(Y)=""
     19               ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
     20               ;GET DATE OF NOTE
     21        ;OHUM/RUT 3111228 Date Range for Notes
     22               S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
     23               ;OHUM/RUT
     24               S Z=""
     25               F  S Z=$O(NOTE(Z)) Q:Z=""  D
     26               . S DT=$P(^TIU(8925,Z,0),U,7)
     27               . I $G(STDT)]"" D
     28               .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
     29               . I $G(ENDDT)]"" D
     30               .. I ENDDT<DT S NOTE(Z)="D"
     31               . I NOTE(Z)="D" K NOTE(Z)
     32        D VISIT
     33               Q
     34VISIT     ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
     35        S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
     36        S IEN=""  F  S IEN=$O(NOTE(IEN)) Q:IEN=""  D
     37        . S X0=^TIU(8925,IEN,0),X12=$G(^(12))
     38        . S VISIT=$P(X12,U,7)
     39        . I 'VISIT S VISIT=$P(X0,U,3)
     40        . K ^TMP("PXKENC",$J)
     41        . Q:VISIT=""!(VISIT'>0)
     42        . D ENCEVENT^PXKENC(VISIT,1)
     43        . I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
     44        . S IPRV=0 F  S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV  D
     45        .. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
     46        .. ;Q:$P(X0,U,4)'="P"
     47        .. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
     48        .. S PRIM=($P(X0,U,4)="P")
     49        .. S ILST=ILST+1
     50        .. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
     51        .. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
     52        . S IPOV=0 F  S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV  D
     53        .. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
     54        .. S CODE=$P(X0,U)
     55        .. S:CODE CODE=$P(^ICD9(CODE,0),U)
     56        .. S CAT=$P(X802,U)
     57        .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
     58        .. S NARR=$P(X0,U,4)
     59        .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
     60        .. S PRIM=($P(X0,U,12)="P")
     61        .. S PRV=$P(X12,U,4)
     62        .. S ILST=ILST+1
     63        .. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
     64        .. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
     65        . S ICPT=0 F  S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT  D
     66        .. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
     67        .. ;S CODE=$P(X0,U)
     68        .. S CODE=$O(^ICPT("B",$P(X0,U),0))
     69        .. S:CODE CODE=$P(^ICPT(CODE,0),U)
     70        .. S CAT=$P(X802,U)
     71        .. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
     72        .. S NARR=$P(X0,U,4)
     73        .. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
     74        .. S QTY=$P(X0,U,16)
     75        .. S PRV=$P(X12,U,4)
     76        .. S MCNT=0,MIDX=0,MODS=""
     77        .. F  S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX  D
     78        ... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
     79        ... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
     80        .. I +MCNT S MODS=MCNT_MODS
     81        .. S ILST=ILST+1
     82        .. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
     83        .. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
     84        . S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
     85        . S VISIT(IEN,"CLASS")=$$GET1^DIQ(8925,IEN_",",.04) ;GPL 5/21/10
     86        . I $G(TXT)=1 D GETNOTE(IEN)
     87        Q
     88GETNOTE(IEN)    ;GET THE TEXT THAT GOES WITH VISIT
     89        ;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
     90        Q:'$D(VISIT(IEN,"CPT"))
     91        S TXTCNT=0
     92        F  S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0))  D
     93        . S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
     94        Q
  • ccr/branches/ohum/p/C0CDIC.m

    r1329 r1330  
    1 C0CDIC   ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
    2  ;;0.1;CCDCCR;nopatch;noreleasedate
    3  ;Copyright 2008 WorldVistA.  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  W "This is the CCR Dictionary Utility Library ",!
    21  W !
    22  Q
    23  ;
    24 DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE
    25  ;
    26  N ZI
    27  S ZI=""
    28  S G1=$NA(^TMP($J,"C0CCSV",1))
    29  S G1A=$NA(@G1@("V"))
    30  S G2=$NA(^TMP($J,"C0CCSV",2))
    31  D GETN2^C0CRNF(G1,170) ; GET THE MATRIX
    32  F  S ZI=$O(@G1A@(ZI)) Q:ZI=""  D  ;FOR EACH ROW IN THE MATRIX
    33  . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D  ;
    34  . . W @G1A@(ZI,"MAPPING METHOD",1),!
    35  . . ;K @G1A@(ZI,"MAPPING METHOD")
    36  . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))
    37  D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE
    38  K @G1
    39  D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")
    40  K @G2
    41  Q
    42  ;
    43 GVARS(C0CVARS,C0CT) ; Get the CCR variables from the CCR template
    44  ; and return them in C0CVARS, which is passed by name
    45  ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE
    46  ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE
    47  ; C0CT IS RETURNED AS THE CCR TEMPLATE
    48  N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS
    49  D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE
    50  D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS
    51  N C0CI,C0CX
    52  S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT
    53  F C0CI=1:1:C0CTVARS(0) D  ; FOR EVERY LINE IN THE ARRAY
    54  . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL
    55  . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER
    56  ;D PARY^GPLXPATH("C0CVARS")
    57  Q
    58  ;
    59 GXPATH(C0CPVARS,C0CPT) ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES
    60  ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS
    61  ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE
    62  ; BOTH ARE PASSED BY NAME
    63  ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM
    64  ; C0CPVARS(0) IS NUMBER OF VARIABLES
    65  ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE
    66  D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS
    67  ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER
    68  D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS
    69  ; NOW GO GET THE XPATH INDEXES
    70  D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY
    71  S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS
    72  F  S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI=""  D  ; VISIT EVERY LINE
    73  . I +C0CI'=0 Q  ; SKIP EVERYTHING BUT THE XPATH INDEX
    74  . I C0CI=0 Q  ; SKIP THE ZERO NODE
    75  . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y
    76  . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER
    77  . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER
    78  . I C0CY=C0CZ D  ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)
    79  . . ; W "FOUND ",C0CI,!
    80  . . I $D(C0CTVARS(C0CY)) D  ; IF THERE IS A VARIABLE THERE
    81  . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR
    82  D SORTV ; SORT THE ARRAY BY LINE NUMBER
    83  Q
    84  ;
    85 HASHV ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH
    86  ;N C0CI,C0CTVARS,C0CX,C0CY
    87  F C0CI=1:1:@C0CPVARS@(0) D  ; FOR THE ENTIRE ARRAY
    88  . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER
    89  . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME
    90  . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER
    91  Q
    92  ;
    93 SORTV ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER
    94  ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY
    95  S C0CI="" ;
    96  F  S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI=""  D  ; BY LINE NUMBER
    97  . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME
    98  . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE
    99  . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY
    100  K @C0CPVARS
    101  M @C0CPVARS=C0C2
    102  Q
    103  ;
    104 LOAD ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170
    105  ; INITIAL LOAD OF THE CCR DICTIONARY
    106  ;
    107  N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI
    108  S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY
    109  D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY
    110  ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD
    111  D PARY^GPLXPATH("C0CARY") ;TEST
    112  F C0CI=1:1:C0CARY(0) D  ; LOAD EACH VARIABLE
    113  . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME
    114  . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH
    115  . D UPDATE^DIE("","C0CFDA")
    116  . I $D(^TMP("DIERR",$J)) U $P BREAK
    117  . W "LOADING:",C0CI," ",C0CARY(C0CI),!
    118  Q
    119  ;
    120 INIT ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
    121  ;
    122  ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx,
    123  ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY
    124  ;G1("CODING")="170^8"
    125  ;G1("DATA ELEMENT")="170^7"
    126  ;G1("DESCRIPTION")="170^3"
    127  ;G1("ID")="170^1"
    128  ;G1("M","170^8","CODING")="170.08^.01"
    129  ;G1("MAPPING METHOD")="170.08^1"
    130  ;G1("SECTION")="170^10"
    131  ;G1("SOURCE")="170^4"
    132  ;G1("STATUS")="170^9"
    133  ;G1("TYPE")="170^6"
    134  ;G1("VARIABLE")="170^.01"
    135  ;G1("XPATH")="170^2"
    136  ;
    137  N C0CZA,C0CZX,C0CN,C0CSTAT
    138  S C0CZX=0
    139  S C0CSTAT=0 ; INIT STATUS SET FLAG
    140  F  S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0  D  ; FOR EACH DICT ENTRY
    141  . ;W C0CZX,!
    142  . K C0CA,C0CN ; CLEAR OUT THE LAST ONE
    143  . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
    144  . ;ZWR C0CA B ;
    145  . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
    146  . W "VARIABLE: ",C0CN,!
    147  . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;
    148  . I $E(C0CN,1,6)="SOCIAL" D  ;
    149  . . D SETFDA("SECTION","SOC") ;
    150  . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED
    151  . . S C0CSTAT=1
    152  . I $E(C0CN,1,6)="FAMILY" D  ;
    153  . . D SETFDA("SECTION","FAM") ;
    154  . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED
    155  . . S C0CSTAT=1
    156  . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS
    157  . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")
    158  . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")
    159  . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")
    160  . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")
    161  . E  I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")
    162  . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES
    163  . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION
    164  . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM
    165  . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N
    166  . I $$ZVALUE("XPATH")["/Medication/Directions/" D  ; MEDS DIRECTIONS VAR
    167  . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS
    168  . E  I $$ZVALUE("XPATH")["/Medications/Medication/" D  ; ALL OTHER MEDS
    169  . . D SETFDA("SECTION","MEDS") ; A MEDS VAR
    170  . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS
    171  . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE
    172  . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!
    173  . ;ZWR C0CFDA
    174  . I $D(C0CFDA) D  ; WE HAVE CHANGES ON THIS VARIABLE
    175  . . ;ZWR C0CFDA
    176  . . D UPDATE^DIE("","C0CFDA(C0CZX)")
    177  . . I $D(^TMP("DIERR",$J)) U $P BREAK
    178  . . D CLEAN^DILF ; CLEAN UP
    179  . ;ZWR C0CFDA
    180  Q
    181  ;
    182 SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
    183  ; TO SET TO VALUE C0CSV.
    184  ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
    185  ; C0CSN,C0CSV ARE PASSED BY VALUE
    186  ;
    187  N C0CSI,C0CSJ
    188  S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER
    189  S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER
    190  S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV
    191  Q
    192 ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
    193  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
    194  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    195  I '$D(ZTAB) S ZTAB="C0CA"
    196  Q $P(@ZTAB@(ZFN),"^",1)
    197 ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
    198  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
    199  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    200  I '$D(ZTAB) S ZTAB="C0CA"
    201  Q $P(@ZTAB@(ZFN),"^",2)
    202 ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
    203  ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
    204  ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
    205  I '$D(ZTAB) S ZTAB="C0CA"
    206  Q $P(@ZTAB@(ZFN),"^",3)
    207  ;
     1C0CDIC    ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
     2        ;;0.1;CCDCCR;nopatch;noreleasedate;Build 1
     3        ;Copyright 2008 WorldVistA.  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        W "This is the CCR Dictionary Utility Library ",!
     21        W !
     22        Q
     23        ;
     24DIC2CSV ;OUTPUT THE CCR DICTIONARY TO A CSV FILE
     25        ;
     26        N ZI
     27        S ZI=""
     28        S G1=$NA(^TMP($J,"C0CCSV",1))
     29        S G1A=$NA(@G1@("V"))
     30        S G2=$NA(^TMP($J,"C0CCSV",2))
     31        D GETN2^C0CRNF(G1,170) ; GET THE MATRIX
     32        F  S ZI=$O(@G1A@(ZI)) Q:ZI=""  D  ;FOR EACH ROW IN THE MATRIX
     33        . I $G(@G1A@(ZI,"MAPPING METHOD",1))'="" D  ;
     34        . . W @G1A@(ZI,"MAPPING METHOD",1),!
     35        . . ;K @G1A@(ZI,"MAPPING METHOD")
     36        . ;W !,ZI,$G(@G1A@(ZI,"MAPPING METHOD",1))
     37        D RNF2CSV^C0CRNF(G2,G1,"VN") ; PREPARE THE CVS FILE
     38        K @G1
     39        D FILEOUT^C0CRNF(G2,"FILE_"_170_".csv")
     40        K @G2
     41        Q
     42        ;
     43GVARS(C0CVARS,C0CT)     ; Get the CCR variables from the CCR template
     44        ; and return them in C0CVARS, which is passed by name
     45        ; FIRST PIECE OF C0CVARS(x) IS THE VARIABLE NAME, SECOND PIECE
     46        ; IS THE LINE NUMBER OF THE VARIABLE IN THE TEMPLATE
     47        ; C0CT IS RETURNED AS THE CCR TEMPLATE
     48        N C0CTVARS ; ARRAY FOR THE TEMPLATE AND ARRAY FOR THE VARS
     49        D LOAD^GPLCCR0(C0CT) ; LOAD THE CCR TEMPLATE
     50        D XVARS^GPLXPATH("C0CTVARS",C0CT) ; PULL OUT THE VARS
     51        N C0CI,C0CX
     52        S @C0CVARS@(0)=C0CTVARS(0) ; SAME COUNT
     53        F C0CI=1:1:C0CTVARS(0) D  ; FOR EVERY LINE IN THE ARRAY
     54        . S C0CX=C0CTVARS(C0CI) ; THE VARIABLE - 3 PIECES, FIRST ONE NULL
     55        . S @C0CVARS@(C0CI)=$P(C0CX,"^",2)_"^"_$P(C0CX,"^",3) ; VAR NAME^LINE NUMBER
     56        ;D PARY^GPLXPATH("C0CVARS")
     57        Q
     58        ;
     59GXPATH(C0CPVARS,C0CPT)  ; LOAD THE CCR TEMPLATE INTO C0CPT, PULL OUT VARIABLES
     60        ; AND THE XPATH TO THE VARIABLES INTO C0CPVARS
     61        ; BY INDEXING THE TEMPLATE C0CT AND MATCHING THE XPATH TO THE VARIABLE
     62        ; BOTH ARE PASSED BY NAME
     63        ; C0CPVARS(x) IS VAR^LINENUM^XPATH SORTED BY LINENUM
     64        ; C0CPVARS(0) IS NUMBER OF VARIABLES
     65        ; C0CPT(0) IS NUMBER OF LINES IN THE TEMPLATE
     66        D GVARS(C0CPVARS,C0CPT) ; GET THE VARIABLES AND LINE NUMBERS
     67        ;N C0CTVARS ; HASH TABLE FOR VARIABLE BY LINE NUMBER
     68        D HASHV ; PUT THE VARIABLES IN A LINE NUMBER HASH FOR MATCHING TO XPATHS
     69        ; NOW GO GET THE XPATH INDEXES
     70        D INDEX^GPLXPATH(C0CPT) ; ADD THE XPATH INDEXES TO THE TEMPLATE ARRAY
     71        S C0CI="" ; GOING TO LOOP THROUGH THE WHOLE ARRAY LOOKING AT XPATHS
     72        F  S C0CI=$O(@C0CPT@(C0CI)) Q:C0CI=""  D  ; VISIT EVERY LINE
     73        . I +C0CI'=0 Q  ; SKIP EVERYTHING BUT THE XPATH INDEX
     74        . I C0CI=0 Q  ; SKIP THE ZERO NODE
     75        . S C0CX=@C0CPT@(C0CI) ; PULL OUT THE LINE NUMBERS X^Y
     76        . S C0CY=$P(C0CX,"^",1) ; STARTING LINE NUMBER
     77        . S C0CZ=$P(C0CX,"^",2) ; ENDING LINE NUMBER
     78        . I C0CY=C0CZ D  ; THIS IS AN XPATH END NODE, HAS A VARIABLE (WE HOPE)
     79        . . ; W "FOUND ",C0CI,!
     80        . . I $D(C0CTVARS(C0CY)) D  ; IF THERE IS A VARIABLE THERE
     81        . . . S $P(C0CTVARS(C0CY),"^",3)=C0CI ; INSERT THE XPATH FOR THE VAR
     82        D SORTV ; SORT THE ARRAY BY LINE NUMBER
     83        Q
     84        ;
     85HASHV   ; INTERNAL ROUTINE TO PUT VARIABLE NAMES IN A LINE NUMBER HASH
     86        ;N C0CI,C0CTVARS,C0CX,C0CY
     87        F C0CI=1:1:@C0CPVARS@(0) D  ; FOR THE ENTIRE ARRAY
     88        . S C0CX=$P(@C0CPVARS@(C0CI),"^",2) ; LINE NUMBER
     89        . S C0CY=$P(@C0CPVARS@(C0CI),"^",1) ; VARIABLE NAME
     90        . S C0CTVARS(C0CX)=C0CY ; BUILD HASH OF VARIABLES BY LINE NUMBER
     91        Q
     92        ;
     93SORTV   ; INTERNAL ROUTINE TO OUTPUT VARIABLES (AND XPATHS) IN LINE NUMBER ORDER
     94        ;N C0CV2 ; SCRACTH SPACE FOR BUILDING SORTED ARRAY
     95        S C0CI="" ;
     96        F  S C0CI=$O(C0CTVARS(C0CI)) Q:C0CI=""  D  ; BY LINE NUMBER
     97        . S C0CX=C0CTVARS(C0CI) ;VARIABLE NAME
     98        . S $P(C0CX,"^",2)=C0CI ; LINE NUMBER IS SECOND PIECE
     99        . D PUSH^GPLXPATH("C0C2",C0CX) ; PUT ONTO ARRAY
     100        K @C0CPVARS
     101        M @C0CPVARS=C0C2
     102        Q
     103        ;
     104LOAD    ; LOAD VARIABLE NAMES AND XPATH IN ^C0CDIC(170
     105        ; INITIAL LOAD OF THE CCR DICTIONARY
     106        ;
     107        N C0CDIC,C0CARY,C0CXML,C0CFDA,C0CI
     108        S C0CDIC="^C0CDIC(170," ; ROOT OF THE CCR DICTIONARY
     109        D GXPATH("C0CARY","C0CXML") ; FETCH THE VARIABLES AND XPATH INTO C0CARY
     110        ; C0CXML WILL CONTAIN THE TEMPLATE - NOT NEEDED FOR LOAD
     111        D PARY^GPLXPATH("C0CARY") ;TEST
     112        F C0CI=1:1:C0CARY(0) D  ; LOAD EACH VARIABLE
     113        . S C0CFDA(170,"+"_C0CI_",",.01)=$P(C0CARY(C0CI),"^",1) ; VAR NAME
     114        . S C0CFDA(170,"+"_C0CI_",",2)=$P(C0CARY(C0CI),"^",3) ; XPATH
     115        . D UPDATE^DIE("","C0CFDA")
     116        . I $D(^TMP("DIERR",$J)) U $P BREAK
     117        . W "LOADING:",C0CI," ",C0CARY(C0CI),!
     118        Q
     119        ;
     120INIT    ; INITIALIZE CCR DICTIONARY BASED ON VARIABLE NAMES
     121        ;
     122        ; CHEAT SHEET FOR VARIABLE NAMES IN ^C0CDIC(170.xx,
     123        ; THIS IS WHAT WILL BE IN C0CA FOR EACH DICTIONARY ENTRY
     124        ;G1("CODING")="170^8"
     125        ;G1("DATA ELEMENT")="170^7"
     126        ;G1("DESCRIPTION")="170^3"
     127        ;G1("ID")="170^1"
     128        ;G1("M","170^8","CODING")="170.08^.01"
     129        ;G1("MAPPING METHOD")="170.08^1"
     130        ;G1("SECTION")="170^10"
     131        ;G1("SOURCE")="170^4"
     132        ;G1("STATUS")="170^9"
     133        ;G1("TYPE")="170^6"
     134        ;G1("VARIABLE")="170^.01"
     135        ;G1("XPATH")="170^2"
     136        ;
     137        N C0CZA,C0CZX,C0CN,C0CSTAT
     138        S C0CZX=0
     139        S C0CSTAT=0 ; INIT STATUS SET FLAG
     140        F  S C0CZX=$O(^C0CDIC(170,C0CZX)) Q:+C0CZX=0  D  ; FOR EACH DICT ENTRY
     141        . ;W C0CZX,!
     142        . K C0CA,C0CN ; CLEAR OUT THE LAST ONE
     143        . D GETN1^C0CRNF("C0CA",170,C0CZX,"","ALL") ; GET VARIABLE HASH
     144        . ;ZWR C0CA B ;
     145        . S C0CN=$$ZVALUE("VARIABLE") ;NAME OF THE VARIABLE
     146        . W "VARIABLE: ",C0CN,!
     147        . I $E(C0CN,1,5)="ACTOR" D SETFDA("SECTION","ACTORS") ;
     148        . I $E(C0CN,1,6)="SOCIAL" D  ;
     149        . . D SETFDA("SECTION","SOC") ;
     150        . . D SETFDA("STATUS","X") ;SOCIAL HISTORY NOT IMPLEMENTED
     151        . . S C0CSTAT=1
     152        . I $E(C0CN,1,6)="FAMILY" D  ;
     153        . . D SETFDA("SECTION","FAM") ;
     154        . . D SETFDA("STATUS","X") ;FAMILY HISTORY NOT IMPLEMENTED
     155        . . S C0CSTAT=1
     156        . ;D SETFDA("TYPE","") ;CORRECT FOR TYPE ERRORS
     157        . I $E(C0CN,1,5)="ALERT" D SETFDA("SECTION","ALERTS")
     158        . I $E(C0CN,1,5)="VITAL" D SETFDA("SECTION","VITALS")
     159        . I $E(C0CN,1,7)="PROBLEM" D SETFDA("SECTION","PROBLEMS")
     160        . I $E(C0CN,1,10)="RESULTTEST" D SETFDA("SECTION","TEST")
     161        . E  I $E(C0CN,1,6)="RESULT" D SETFDA("SECTION","LABS")
     162        . I C0CN["CODEVALUE" D SETFDA("TYPE","CD") ;CODES
     163        . I C0CN["CODEVERSION" D SETFDA("TYPE","CV") ; CODE VERSION
     164        . I C0CN["CODINGSYSTEM" D SETFDA("TYPE","CS") ;CODING SYSTEM
     165        . I $$ZVALUE("STATUS")=""!'C0CSTAT D SETFDA("STATUS","N") ;BLANK STATUS TO N
     166        . I $$ZVALUE("XPATH")["/Medication/Directions/" D  ; MEDS DIRECTIONS VAR
     167        . . D SETFDA("SECTION","DIR") ; SPECIAL SECTION FOR DIRECTIONS
     168        . E  I $$ZVALUE("XPATH")["/Medications/Medication/" D  ; ALL OTHER MEDS
     169        . . D SETFDA("SECTION","MEDS") ; A MEDS VAR
     170        . I $E(C0CN,($L(C0CN)-1),$L(C0CN))="ID" D SETFDA("TYPE","ID") ;CATCH THE IDS
     171        . I C0CN["DATETIME" D SETFDA("TYPE","DT") ; DATE/TIME VARIABLE
     172        . W "VARIABLE: ",C0CZX," ",C0CA("VARIABLE"),!
     173        . ;ZWR C0CFDA
     174        . I $D(C0CFDA) D  ; WE HAVE CHANGES ON THIS VARIABLE
     175        . . ;ZWR C0CFDA
     176        . . D UPDATE^DIE("","C0CFDA(C0CZX)")
     177        . . I $D(^TMP("DIERR",$J)) U $P BREAK
     178        . . D CLEAN^DILF ; CLEAN UP
     179        . ;ZWR C0CFDA
     180        Q
     181        ;
     182SETFDA(C0CSN,C0CSV)     ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
     183        ; TO SET TO VALUE C0CSV.
     184        ; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
     185        ; C0CSN,C0CSV ARE PASSED BY VALUE
     186        ;
     187        N C0CSI,C0CSJ
     188        S C0CSI=$$ZFILE(C0CSN,"C0CA") ; FILE NUMBER
     189        S C0CSJ=$$ZFIELD(C0CSN,"C0CA") ; FIELD NUMBER
     190        S C0CFDA(C0CZX,C0CSI,C0CZX_",",C0CSJ)=C0CSV
     191        Q
     192ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
     193        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
     194        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     195        I '$D(ZTAB) S ZTAB="C0CA"
     196        Q $P(@ZTAB@(ZFN),"^",1)
     197ZFIELD(ZFN,ZTAB)        ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
     198        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
     199        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     200        I '$D(ZTAB) S ZTAB="C0CA"
     201        Q $P(@ZTAB@(ZFN),"^",2)
     202ZVALUE(ZFN,ZTAB)        ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
     203        ; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
     204        ; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
     205        I '$D(ZTAB) S ZTAB="C0CA"
     206        Q $P(@ZTAB@(ZFN),"^",3)
     207        ;
  • ccr/branches/ohum/p/C0CDOM.m

    r1329 r1330  
    11C0CDOM    ; GPL - DOM PROCESSING ROUTINES ;6/6/11  17:05
    2  ;;0.1;C0C;nopatch;noreleasedate;Build 38
    3  ;Copyright 2011 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  ;
     2        ;;0.1;C0C;nopatch;noreleasedate;Build 1
     3        ;Copyright 2011 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        ;
    2222DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
    23  ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    24  ; THE XPATH ARRAY XPARY, PASSED BY NAME
    25  ; ZOID IS THE STARTING OID
    26  ; ZPATH IS THE STARTING XPATH, USUALLY "/"
    27  ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
    28  ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
    29  I $G(ZREDUX)="" S ZREDUX=""
    30  N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
    31  N NEWNUM S NEWNUM=""
    32  I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
    33  S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
    34  I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
    35  . N GT S GT=$P(NEWPATH,ZREDUX,2)
    36  . I GT'="" S NEWPATH=GT
    37  S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
    38  N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
    39  I $D(GA) D  ; PROCESS THE ATTRIBUTES
    40  . N ZI S ZI=""
    41  . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
    42  . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
    43  . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
    44  . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
    45  N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
    46  I $D(GD(2)) D  ;
    47  . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
    48  E  I $D(GD(1)) D  ;
    49  . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
    50  . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
    51  N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
    52  I ZFRST'=0 D  ; THERE IS A CHILD
    53  . N ZNUM
    54  . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
    55  . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
    56  N GNXT S GNXT=$$NXTSIB(ZOID)
    57  I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
    58  I GNXT'=0 D  ;
    59  . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
    60  . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
    61  . . N ZNUM S ZNUM=1 ;
    62  . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
    63  . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
    64  Q
    65  ;
    66 ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
    67  ;
    68  ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
    69  ;
    70  N ZZI,ZZJ,ZZN
    71  S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
    72  I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
    73  S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
    74  S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
    75  I ZZI'["]" D  ; A SINGLETON
    76  . S ZZN=1
    77  E  D  ; THERE IS AN [x] OCCURANCE
    78  . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
    79  . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
    80  I ZZJ'="" D  ; TIME TO ADD THE VALUE
    81  . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
    82  Q
    83  ;
     23        ; THE XPATH INDEX ZXIDX, PASSED BY NAME
     24        ; THE XPATH ARRAY XPARY, PASSED BY NAME
     25        ; ZOID IS THE STARTING OID
     26        ; ZPATH IS THE STARTING XPATH, USUALLY "/"
     27        ; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
     28        ; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
     29        I $G(ZREDUX)="" S ZREDUX=""
     30        N NEWPATH,NARY ; NEWPATH IS AN XPATH NARY IS AN NHIN MUMPS ARRAY
     31        N NEWNUM S NEWNUM=""
     32        I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
     33        S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
     34        I $G(ZREDUX)'="" D  ; REDUX PROVIDED?
     35        . N GT S GT=$P(NEWPATH,ZREDUX,2)
     36        . I GT'="" S NEWPATH=GT
     37        S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
     38        N GA D ATT("GA",ZOID) ; GET ATTRIBUTES FOR THIS NODE
     39        I $D(GA) D  ; PROCESS THE ATTRIBUTES
     40        . N ZI S ZI=""
     41        . F  S ZI=$O(GA(ZI)) Q:ZI=""  D  ; FOR EACH ATTRIBUTE
     42        . . N ZP S ZP=NEWPATH_"@"_ZI ; PATH FOR ATTRIBUTE
     43        . . S @ZXPARY@(ZP)=GA(ZI) ; ADD THE ATTRIBUTE XPATH TO THE XP ARRAY
     44        . . I GA(ZI)'="" D ADDNARY(ZP,GA(ZI)) ; ADD THE NHIN ARRAY VALUE
     45        N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
     46        I $D(GD(2)) D  ;
     47        . M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
     48        E  I $D(GD(1)) D  ;
     49        . S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
     50        . I GD(1)'="" D ADDNARY(NEWPATH,GD(1)) ; ADD TO NHIN ARRAY
     51        N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
     52        I ZFRST'=0 D  ; THERE IS A CHILD
     53        . N ZNUM
     54        . N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
     55        . D DOMO(ZFRST,NEWPATH,ZNARY,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; THE CHILD
     56        N GNXT S GNXT=$$NXTSIB(ZOID)
     57        I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
     58        I GNXT'=0 D  ;
     59        . N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
     60        . I (ZNUM="")&(ZMULT) D  ; SIBLING IS FIRST OF MULTIPLES
     61        . . N ZNUM S ZNUM=1 ;
     62        . . D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
     63        . E  D DOMO(GNXT,ZPATH,ZNARY,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; SIB
     64        Q
     65        ;
     66ADDNARY(ZXP,ZVALUE)     ; ADD AN NHIN ARRAY VALUE TO ZNARY
     67        ;
     68        ; IF ZATT=1 THE ARRAY IS ADDED AS ATTRIBUTES
     69        ;
     70        N ZZI,ZZJ,ZZN
     71        S ZZI=$P(ZXP,"/",1) ; FIRST PIECE OF XPATH ARRAY
     72        I ZZI="" Q  ; DON'T ADD THIS ONE .. PROBABLY THE //results NODE
     73        S ZZJ=$P(ZXP,ZZI_"/",2) ; REST OF XPATH ARRAY
     74        S ZZJ=$TR(ZZJ,"/",".") ; REPLACE / WITH .
     75        I ZZI'["]" D  ; A SINGLETON
     76        . S ZZN=1
     77        E  D  ; THERE IS AN [x] OCCURANCE
     78        . S ZZN=$P($P(ZZI,"[",2),"]",1) ; PULL OUT THE OCCURANCE
     79        . S ZZI=$P(ZZI,"[",1) ; TAKE OUT THE [X]
     80        I ZZJ'="" D  ; TIME TO ADD THE VALUE
     81        . S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
     82        Q
     83        ;
    8484PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    85  ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    86  ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    87  ;Q $$EN^MXMLDOM(INXML)
    88  Q $$EN^MXMLDOM(INXML,"W")
    89  ;
     85        ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
     86        ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
     87        ;Q $$EN^MXMLDOM(INXML)
     88        Q $$EN^MXMLDOM(INXML,"W")
     89        ;
    9090ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    91  N ZN
    92  ;I $$TAG(ZOID)["entry" B
    93  S ZN=$$NXTSIB(ZOID)
    94  I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
    95  Q 0
    96  ;
     91        N ZN
     92        ;I $$TAG(ZOID)["entry" B
     93        S ZN=$$NXTSIB(ZOID)
     94        I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
     95        Q 0
     96        ;
    9797FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    98  Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
    99  ;
     98        Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
     99        ;
    100100PARENT(ZOID)    ;RETURNS THE OID OF THE PARENT OF ZOID
    101  Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
    102  ;
     101        Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
     102        ;
    103103ATT(RTN,NODE)   ;GET ATTRIBUTES FOR ZOID
    104  S HANDLE=C0CDOCID
    105  K @RTN
    106  D GETTXT^MXMLDOM("A")
    107  Q
    108  ;
     104        S HANDLE=C0CDOCID
     105        K @RTN
     106        D GETTXT^MXMLDOM("A")
     107        Q
     108        ;
    109109TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
    110  ;I ZOID=149 B ;GPLTEST
    111  N X,Y
    112  S Y=""
    113  S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
    114  I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
    115  I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
    116  Q Y
    117  ;
     110        ;I ZOID=149 B ;GPLTEST
     111        N X,Y
     112        S Y=""
     113        S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
     114        I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
     115        I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
     116        Q Y
     117        ;
    118118NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
    119  Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
    120  ;
     119        Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
     120        ;
    121121DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
    122  ;N ZT,ZN S ZT=""
    123  ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    124  ;Q $G(@C0CDOM@(ZOID,"T",1))
    125  S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
    126  Q
    127  ;
     122        ;N ZT,ZN S ZT=""
     123        ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
     124        ;Q $G(@C0CDOM@(ZOID,"T",1))
     125        S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
     126        Q
     127        ;
    128128OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    129  ;
    130  S C0CDOCID=INID
    131  I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
    132  D START^C0CMXMLB($$TAG(1),,"G",NO1ST)
    133  D NDOUT($$FIRST(1))
    134  D END^C0CMXMLB ;END THE DOCUMENT
    135  M @ZRTN=^TMP("MXMLBLD",$J)
    136  K ^TMP("MXMLBLD",$J)
    137  Q
    138  ;
     129        ;
     130        S C0CDOCID=INID
     131        I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
     132        D START^C0CMXMLB($$TAG(1),,"G",NO1ST)
     133        D NDOUT($$FIRST(1))
     134        D END^C0CMXMLB ;END THE DOCUMENT
     135        M @ZRTN=^TMP("MXMLBLD",$J)
     136        K ^TMP("MXMLBLD",$J)
     137        Q
     138        ;
    139139NDOUT(ZOID)     ;CALLBACK ROUTINE - IT IS RECURSIVE
    140  N ZI S ZI=$$FIRST(ZOID)
    141  I ZI'=0 D  ; THERE IS A CHILD
    142  . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
    143  . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
    144  E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
    145  . ;W "DOING",ZOID,!
    146  . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
    147  . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
    148  . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
    149  I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
    150  . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
    151  Q
    152  ;
    153 WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
    154  ;
    155  N GN,GN2
    156  D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
    157  S GN2=$NA(@GN@(1))
    158  W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
    159  Q
    160  ;
    161 NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY
    162  ; ZGOUT AND ZGIN ARE PASSED BY NAME
    163  N C0CDOCID
    164  W !,ZGOUT," ",ZGIN
    165  S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
    166  D OUTXML(ZGOUT,C0CDOCID)
    167  Q
    168  ;
    169  ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
    170  ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
    171  ;
    172  ;GNARY("med",1,"doses.dose@dose")=10
    173  ;GNARY("med",1,"doses.dose@noun")="TABLET"
    174  ;GNARY("med",1,"doses.dose@route")="PO"
    175  ;GNARY("med",1,"doses.dose@schedule")="QD"
    176  ;GNARY("med",1,"doses.dose@units")="MG"
    177  ;GNARY("med",1,"doses.dose@unitsPerDose")=1
    178  ;GNARY("med",1,"facility@code")=100
    179  ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"
    180  ;GNARY("med",1,"form@value")="TAB"
    181  ;GNARY("med",1,"id@value")="1N;O"
    182  ;GNARY("med",1,"location@code")=5
    183  ;GNARY("med",1,"location@name")="3 WEST"
    184  ;GNARY("med",1,"name@value")="LISINOPRIL TAB"
    185  ;GNARY("med",1,"orderID@value")=294
    186  ;GNARY("med",1,"ordered@value")=3110531.001233
    187  ;GNARY("med",1,"orderingProvider@code")=63
    188  ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"
    189  ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"
    190  ;GNARY("med",1,"products.product.vaGeneric@code")=1990
    191  ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"
    192  ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380
    193  ;GNARY("med",1,"products.product.vaProduct@code")=8118
    194  ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"
    195  ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593
    196  ;GNARY("med",1,"products.product@code")=6174
    197  ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"
    198  ;GNARY("med",1,"products.product@role")="D"
    199  ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"
    200  ;GNARY("med",1,"sig@xml:space")="preserve"
    201  ;GNARY("med",1,"status@value")="active"
    202  ;GNARY("med",1,"type@value")="OTC"
    203  ;GNARY("med",1,"vaType@value")="N"
    204  ;
    205  ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM
    206  ; it returns 0 or 1 based on success.
    207  ;
    208  ; INARY is passed by name and has the format shown above
    209  ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will
    210  ; be supported eventually - initial implementation is for MXML
    211  ;
    212  ; PARENT is the node id or tag of the parent under which the DOM will
    213  ; be populated. If it is numeric, it is a node. If it is a string, the DOM
    214  ; will be searched to find the tag. If not found and there is no root,
    215  ; it will be inserted as the root. If not found and there is a root, it
    216  ; will be inserted under the root.
    217  ;
    218  ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")
    219  ; because "results" is the root tag. Use OUTXML to render the xml from
    220  ; the DOM.
    221  ;
    222 DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
    223  ;
    224  N ZPARNODE
    225  S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
    226  I '$D(INARY) Q 0 ; NO ARRAY PASSED
    227  I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
    228  ;I PARENT="" S PARENT="root"
    229  I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
    230  E  I $L($G(PARENT))>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
    231  . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
    232  . S ZPARNODE=1 ;
    233  ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
    234  N ZEXARY
    235  D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
    236  D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
    237  I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
    238  Q HANDLE ; SUCCESS
    239  ;
    240 MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
    241  N ZI S ZI=""
    242  N ZTAG
    243  F  S ZI=$O(@ZARY@(ZI)) Q:ZI=""  D  ; FOR EACH SECTION
    244  . N ZELEADD S ZELEADD=0
    245  . I ZI["@" D  ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
    246  . . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
    247  . . K ZATT ; CLEAR OUT LAST ONE
    248  . . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
    249  . . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
    250  . . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
    251  . I $O(@ZARY@(ZI,""))="" D  ;END NODE
    252  . . S ZTAG=ZI ; USE ZI FOR THE TAG
    253  . . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
    254  . . S ZELEADD=1 ; ADDED AN ELEMENT
    255  . . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
    256  . I ZELEADD D  Q  ; NO MORE TO DO ON THIS LEVEL
    257  . . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
    258  . N NEWARY ; INDENTED ARRAY
    259  . N ZN S ZN=0
    260  . F  S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN=""  D  ; FOR EACH MULTIPLE
    261  . . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
    262  . . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
    263  . . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
    264  . . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
    265  Q
    266  ;
    267 EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
    268  ; CONSISTENT FORMAT
    269  ; GNARY("patient",1,"facilities[2].facility@code")="050"
    270  ; becomes G2ARY("patient",1,"facilities",2,"facility@",1,"code")="050"
    271  ; for easier processing (this is fileman format genius)
    272  ; basically removes the dot notation from the strings
    273  ;
    274  N ZZI
    275  S ZZI=""
    276  F  S ZZI=$O(@ZZIN@(ZZI)) Q:ZZI=""  D  ;
    277  . N ZZN S ZZN=0
    278  . F  S ZZN=$O(@ZZIN@(ZZI,ZZN)) Q:ZZN=""  D  ;
    279  . . N ZZS S ZZS=""
    280  . . N GA ;PUSH STACK
    281  . . F  S ZZS=$O(@ZZIN@(ZZI,ZZN,ZZS)) Q:ZZS=""  D  ;
    282  . . . K GA ; NEW STACK
    283  . . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
    284  . . . N ZZV ; PLACE TO STASH THE VALUE
    285  . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
    286  . . . W !,"VALUE:",ZZV
    287  . . . N GK ; COUNTER
    288  . . . F GK=1:1:$L(ZZS,".") D  ; FOR EACH INTERMEDIATE NODE
    289  . . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
    290  . . . . N GM S GM=$P(ZZS,".",GK) ; TAG
    291  . . . . I GM["[" D  ; IT'S A MULTIPLE
    292  . . . . . S ZZN2=$P($P(GM,"[",2),"]",1) ; PULL OUT THE NUMBER
    293  . . . . . S GM=$P(GM,"[",1) ; PULL OUT THE TAG
    294  . . . . I GM["@" D  ; IT'S GOT ATTRIBUTES
    295  . . . . . N GM2 S GM2=$P(GM,"@",2) ; PULLOUT THE ATTRIBUTE NAME
    296  . . . . . D PUSH^C0CXPATH("GA",$P(GM,"@",1)_"@"_"^"_ZZN2) ; PUSH THE TAG
    297  . . . . . D PUSH^C0CXPATH("GA",GM2_"^"_ZZN2)
    298  . . . . E  D PUSH^C0CXPATH("GA",GM_"^"_ZZN2) ;
    299  . . . S GA(GA(0))=$P(GA(GA(0)),"^",1)_"^" ; GET RID OF THE LAST "1"
    300  . . . N GZI S GZI="" ; STRING FOR THE INDEX
    301  . . . F GK=1:1:GA(0) D  ; TIME TO REVERSE POP THE TAGS
    302  . . . . S GM=$P(GA(GK),"^",1) ; THE TAG
    303  . . . . S ZZN2=$P(GA(GK),"^",2) ; THE NUMBER IF ANY
    304  . . . . I ZZN2="" S GZI=GZI_""""_GM_"""" ; FOR THE LAST ONE
    305  . . . . E  S GZI=GZI_""""_GM_""""_","_ZZN2_"," ; FOR THE REST
    306  . . . S GZI2=ZZOUT_"("_GZI_")" ; INCLUDE THE ARRAY NAME
    307  . . . W !,GZI
    308  . . . S @GZI2=ZZV ; REMEMBER THE VALUE?
    309  Q
    310  ;
    311 NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
    312  N CBK,SUCCESS,LEVEL,NODE,HANDLE
    313  K ^TMP("MXMLERR",$J)
    314  L +^TMP("MXMLDOM",$J):5
    315  E  Q 0
    316  S HANDLE=$O(^TMP("MXMLDOM",$J,""),-1)+1,^(HANDLE)=""
    317  L -^TMP("MXMLDOM",$J)
    318  Q HANDLE
    319  ;
     140        N ZI S ZI=$$FIRST(ZOID)
     141        I ZI'=0 D  ; THERE IS A CHILD
     142        . N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
     143        . D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
     144        E  D  ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
     145        . ;W "DOING",ZOID,!
     146        . N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
     147        . N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
     148        . D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
     149        I $$NXTSIB(ZOID)'=0 D  ; THERE IS A SIBLING
     150        . D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
     151        Q
     152        ;
     153WNHIN(ZDFN)     ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
     154        ;
     155        N GN,GN2
     156        D GET^NHINV(.GN,ZDFN) ; EXTRACT THE XML
     157        S GN2=$NA(@GN@(1))
     158        W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
     159        Q
     160        ;
     161NARY2XML(ZGOUT,ZGIN)    ; CREATE XML FROM AN NHIN ARRAY
     162        ; ZGOUT AND ZGIN ARE PASSED BY NAME
     163        N C0CDOCID
     164        W !,ZGOUT," ",ZGIN
     165        S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
     166        D OUTXML(ZGOUT,C0CDOCID)
     167        Q
     168        ;
     169        ; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
     170        ; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
     171        ;
     172        ;GNARY("med",1,"doses.dose@dose")=10
     173        ;GNARY("med",1,"doses.dose@noun")="TABLET"
     174        ;GNARY("med",1,"doses.dose@route")="PO"
     175        ;GNARY("med",1,"doses.dose@schedule")="QD"
     176        ;GNARY("med",1,"doses.dose@units")="MG"
     177        ;GNARY("med",1,"doses.dose@unitsPerDose")=1
     178        ;GNARY("med",1,"facility@code")=100
     179        ;GNARY("med",1,"facility@name")="VOE OFFICE INSTITUTION"
     180        ;GNARY("med",1,"form@value")="TAB"
     181        ;GNARY("med",1,"id@value")="1N;O"
     182        ;GNARY("med",1,"location@code")=5
     183        ;GNARY("med",1,"location@name")="3 WEST"
     184        ;GNARY("med",1,"name@value")="LISINOPRIL TAB"
     185        ;GNARY("med",1,"orderID@value")=294
     186        ;GNARY("med",1,"ordered@value")=3110531.001233
     187        ;GNARY("med",1,"orderingProvider@code")=63
     188        ;GNARY("med",1,"orderingProvider@name")="KING,MATTHEW MICHAEL"
     189        ;GNARY("med",1,"products.product.class@code")="ACE INHIBITORS"
     190        ;GNARY("med",1,"products.product.vaGeneric@code")=1990
     191        ;GNARY("med",1,"products.product.vaGeneric@name")="LISINOPRIL"
     192        ;GNARY("med",1,"products.product.vaGeneric@vuid")=4019380
     193        ;GNARY("med",1,"products.product.vaProduct@code")=8118
     194        ;GNARY("med",1,"products.product.vaProduct@name")="LISINOPRIL 10MG TAB"
     195        ;GNARY("med",1,"products.product.vaProduct@vuid")=4008593
     196        ;GNARY("med",1,"products.product@code")=6174
     197        ;GNARY("med",1,"products.product@name")="LISINOPRIL 10MG U/D"
     198        ;GNARY("med",1,"products.product@role")="D"
     199        ;GNARY("med",1,"sig")="10MG BY MOUTH EVERY DAY"
     200        ;GNARY("med",1,"sig@xml:space")="preserve"
     201        ;GNARY("med",1,"status@value")="active"
     202        ;GNARY("med",1,"type@value")="OTC"
     203        ;GNARY("med",1,"vaType@value")="N"
     204        ;
     205        ; DOMI is an extrinsic to insert NHIN ARRAY FORMAT arrays into the DOM
     206        ; it returns 0 or 1 based on success.
     207        ;
     208        ; INARY is passed by name and has the format shown above
     209        ; HANDLE is the document number in the DOM (both MXML and EWD DOMs will
     210        ; be supported eventually - initial implementation is for MXML
     211        ;
     212        ; PARENT is the node id or tag of the parent under which the DOM will
     213        ; be populated. If it is numeric, it is a node. If it is a string, the DOM
     214        ; will be searched to find the tag. If not found and there is no root,
     215        ; it will be inserted as the root. If not found and there is a root, it
     216        ; will be inserted under the root.
     217        ;
     218        ; For the above example the call would be OK=$$DOMI("GNARY",0,"results")
     219        ; because "results" is the root tag. Use OUTXML to render the xml from
     220        ; the DOM.
     221        ;
     222DOMI(INARY,HANDLE,PARENT)       ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
     223        ;
     224        N ZPARNODE
     225        S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
     226        I '$D(INARY) Q 0 ; NO ARRAY PASSED
     227        I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
     228        ;I PARENT="" S PARENT="root"
     229        I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
     230        E  I $L($G(PARENT))>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
     231        . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
     232        . S ZPARNODE=1 ;
     233        ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
     234        N ZEXARY
     235        D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
     236        D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
     237        I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
     238        Q HANDLE ; SUCCESS
     239        ;
     240MAJOR(ZARY)     ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
     241        N ZI S ZI=""
     242        N ZTAG
     243