Changeset 1204


Ignore:
Timestamp:
Jun 23, 2011, 3:01:41 PM (13 years ago)
Author:
George Lilly
Message:

updates for MU Certification

Location:
ccr/trunk/p
Files:
3 added
44 edited

Legend:

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

    r770 r1204  
    1 C0CACTOR  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
    2  ;;1.0;C0C;;May 19, 2009;
    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 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        ;
     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/trunk/p/C0CALERT.m

    r666 r1204  
    1 C0CALERT  ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
    2  ;;1.0;C0C;;May 19, 2009;
    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":"418634005",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  . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID
    84  . I ACVUID'="" D  ; IF VUID IS NOT NULL
    85  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID"
    86  . E  D  ; IF REACTANT CODE VALUE IS NULL
    87  . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
    88  . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
    89  . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
    90  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
    91  . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
    92  . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
    93  . N ARTMP,ARIEN,ARDES,ARVUID
    94  . S (ARTMP,ARDES,ARVUID)=""
    95  . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
    96  . . S ARTMP=@ALTG@(ALTTMP,"S",1)
    97  . . W "REACTION:",ARTMP,!
    98  . . S ARIEN=$P(ARTMP,";",2)
    99  . . S ARDES=$P(ARTMP,";",1)
    100  . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
    101  . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
    102  . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
    103  . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
    104  . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
    105  . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
    106  . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
    107  . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
    108  . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
    109  . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
    110  . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
    111  . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
    112  . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
    113  . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
    114  . K @ALTARYTMP
    115  . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
    116  . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
    117  . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
    118  . S ALTCNT=ALTCNT+1
    119  S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
    120  Q
    121 PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
    122  ; INGLB IS OF THE FORM: PSNDF(50.6,
    123  ; RETURN 50.6
    124  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 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        ;
     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        . I ACVUID'="" D  ; IF VUID IS NOT NULL
     85        . . S ZC=$$CODE^C0CUTIL(ACVUID)
     86        . . S ZCD=$P(ZC,"^",1) ; CODE TO USE
     87        . . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
     88        . . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
     89        . E  D  ; IF REACTANT CODE VALUE IS NULL
     90        . . I $G(DUZ("AG"))="I" D  ; IF WE ARE RUNNING ON RPMS
     91        . . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
     92        . . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
     93        . . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
     94        . . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
     95        . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
     96        . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
     97        . S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
     98        . S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
     99        . ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
     100        . N ARTMP,ARIEN,ARDES,ARVUID
     101        . S (ARTMP,ARDES,ARVUID)=""
     102        . I $D(@ALTG@(ALTTMP,"S",1)) D  ; IF REACTION EXISTS
     103        . . S ARTMP=@ALTG@(ALTTMP,"S",1)
     104        . . W "REACTION:",ARTMP,!
     105        . . S ARIEN=$P(ARTMP,";",2)
     106        . . S ARDES=$P(ARTMP,";",1)
     107        . . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
     108        . S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
     109        . I ARVUID'="" D  ; IF REACTION VUID IS NOT NULL
     110        . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
     111        . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
     112        . E  D  ; IF IT IS NULL DON'T SET CODE SYSTEM
     113        . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
     114        . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
     115        . S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
     116        . ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
     117        . N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
     118        . D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
     119        . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
     120        . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
     121        . K @ALTARYTMP
     122        . D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
     123        . I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
     124        . I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
     125        . S ALTCNT=ALTCNT+1
     126        S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
     127        Q
     128PRSGLB(INGLB)   ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
     129        ; INGLB IS OF THE FORM: PSNDF(50.6,
     130        ; RETURN 50.6
     131        Q $P($P(INGLB,"(",2),",",1)  ;
  • ccr/trunk/p/C0CBAT.m

    r572 r1204  
    11C0CBAT    ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
    2  ;;1.0;C0C;;May 19, 2009;
    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  ;
     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        ;
    2323STOP    ; 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  ;
     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        ;
    3535START   ; 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  ;
     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        ;
    5050EN      ; 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  ;
     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        ;
    148148BLDHOT(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  ;
     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        ;
    158158COUNT(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  ;
     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        ;
    166166UPDIEVARPTR(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  ;
     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        ;
    188188UPDIE   ; 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  ;
     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        ;
    199199SETFDA(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
     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
    209209ZFILE(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
     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
    217217ZFIELD(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  ;
     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        ;
    226226ZVALUE(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  ;
     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/trunk/p/C0CCCD.m

    r508 r1204  
    11C0CCCD    ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
    2  ;;1.0;C0C;;May 19, 2009;
    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  ;
     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        ;
    2323EXPORT    ; 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        ;
     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              ;
    3131XPAT(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        ;
     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              ;
    5151CCDRPC(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     ;
     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           ;
    148148INITSTPS(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     ;
     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           ;
    157157SHAVE(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     ;
     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           ;
    170170UNSHAVE(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     ;
     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           ;
    183183HDRMAP(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     ;
     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           ;
    202202ACTLST(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     ;
     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           ;
    227227TEST    ; RUN ALL THE TEST CASES
    228   D TESTALL^C0CUNIT("C0CCCR")
    229   Q
    230   ;
     228        D TESTALL^C0CUNIT("C0CCCR")
     229        Q
     230        ;
    231231ZTEST(WHICH)     ; RUN ONE SET OF TESTS
    232   N ZTMP
    233   D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
    234   D ZTEST^C0CUNIT(.ZTMP,WHICH)
    235   Q
    236   ;
     232        N ZTMP
     233        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
     234        D ZTEST^C0CUNIT(.ZTMP,WHICH)
     235        Q
     236        ;
    237237TLIST    ; 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>
     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/trunk/p/C0CCCD1.m

    r508 r1204  
    11C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
    2  ;;1.0;C0C;;May 19, 2009;
    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           ;
     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                 ;
    2525ZT(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           ;
     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                 ;
    4040ZLOAD(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           ;
     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                 ;
    6060LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
    61           D ZLOAD(ARY,"C0CCCD1")
    62           ; ZWR @ARY
    63           Q
    64           ;
     61                 D ZLOAD(ARY,"C0CCCD1")
     62                 ; ZWR @ARY
     63                 Q
     64                 ;
    6565TRMCCD     ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
    66           Q
     66                 Q
    6767MARKUP  ;<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>
     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/trunk/p/C0CCCR.m

    r974 r1204  
    11C0CCCR    ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
    2  ;;1.0;C0C;;May 19, 2009;
    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  ;
     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        ;
    2323EXPORT    ; 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  ;
     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,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        ;
    6161DCCR(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  ;
     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        ;
    7070CCRRPC(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  I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
    106  ;
    107  D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
    108  ;
    109  K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
    110  S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
    111  D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
    112  N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
    113  F PROCI=1:1:@CCRXTAB@(0) D  ; PROCESS THE CCR BODY SECTIONS
    114  . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
    115  . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
    116  . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
    117  . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
    118  . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
    119  . S IXML="INXML"
    120  . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
    121  . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
    122  . ; W OXML,!
    123  . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
    124  . W "RUNNING ",CALL,!
    125  . X CALL
    126  . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
    127  . I $G(@OXML@(0))>0 D  ; THERE IS A RESULT
    128  . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
    129  . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
    130  N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
    131  D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
    132  D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
    133  D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
    134  D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
    135  K ACTT,ACTT2
    136  D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
    137  D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
    138  D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
    139  K CMTT,CMTT2
    140  N TRIMI,J,DONE S DONE=0
    141  F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
    142  . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
    143  . I DEBUG W "TRIMMED",J,!
    144  . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
    145  ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
    146  I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
    147  E  M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
    148  I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
    149  K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
    150  K ^TMP($J) ; REALLY CLEAN UP
    151  M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
    152  Q
    153  ;
     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        I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
     106        ;
     107        D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
     108        ;
     109        K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
     110        S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
     111        D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
     112        N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
     113        F PROCI=1:1:@CCRXTAB@(0) D  ; PROCESS THE CCR BODY SECTIONS
     114        . S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
     115        . S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
     116        . S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
     117        . S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
     118        . D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
     119        . S IXML="INXML"
     120        . S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
     121        . ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
     122        . ; W OXML,!
     123        . S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
     124        . W "RUNNING ",CALL,!
     125        . X CALL
     126        . ; NOW INSERT THE RESULTS IN THE CCR BUFFER
     127        . I $G(@OXML@(0))>0 D  ; THERE IS A RESULT
     128        . . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
     129        . . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
     130        N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
     131        D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
     132        D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
     133        D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
     134        D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
     135        K ACTT,ACTT2
     136        D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
     137        D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
     138        D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
     139        K CMTT,CMTT2
     140        N TRIMI,J,DONE S DONE=0
     141        F TRIMI=0:0 D  Q:DONE  ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
     142        . S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
     143        . I DEBUG W "TRIMMED",J,!
     144        . I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
     145        ;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
     146        I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
     147        E  M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
     148        I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
     149        K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
     150        K ^TMP($J) ; REALLY CLEAN UP
     151        M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
     152        Q
     153        ;
    154154INITSTPS(TAB)    ; INITIALIZE CCR PROCESSING STEPS
    155  ; TAB IS PASSED BY NAME
    156  I DEBUG W "TAB= ",TAB,!
    157  ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
    158  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
    159  I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
    160  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
    161  D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
    162  I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
    163  E  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
    164  D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
    165  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
    166  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
    167  Q
    168  ;
     155        ; TAB IS PASSED BY NAME
     156        I DEBUG W "TAB= ",TAB,!
     157        ; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
     158        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
     159        I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
     160        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
     161        D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
     162        I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
     163        E  D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
     164        D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
     165        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
     166        D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
     167        Q
     168        ;
    169169HDRMAP(CXML,DFN)        ; MAP HEADER VARIABLES: FROM, TO ECT
    170  N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
    171  ; K @VMAP
    172  S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
    173  ; I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
    174  D  ; ALWAYS MAP THESE VARIABLES
    175  . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
    176  . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
    177  . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
    178  . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
    179  . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
    180  . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
    181  . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
    182  . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
    183  . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
    184  ;I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
    185  ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
    186  N CTMP
    187  D MAP^C0CXPATH(CXML,VMAP,"CTMP")
    188  D CP^C0CXPATH("CTMP",CXML)
    189  N HRIMVARS ;
    190  S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
    191  M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
    192  S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
    193  Q
    194  ;
     170        N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
     171        ; K @VMAP
     172        S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
     173        ; I IHDR="" D  ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
     174        D  ; ALWAYS MAP THESE VARIABLES
     175        . S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
     176        . S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
     177        . S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
     178        . ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
     179        . S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
     180        . S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
     181        . S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR"  ; FOR TEST PURPOSES
     182        . S @VMAP@("ACTORTOTEXT")="Patient"  ; FOR TEST PURPOSES
     183        . ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
     184        ;I IHDR'="" D  ; HEADER VALUES ARE PROVIDED
     185        ;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
     186        N CTMP
     187        D MAP^C0CXPATH(CXML,VMAP,"CTMP")
     188        D CP^C0CXPATH("CTMP",CXML)
     189        N HRIMVARS ;
     190        S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
     191        M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
     192        S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
     193        Q
     194        ;
    195195ACTLST(AXML,ACTRTN)     ; RETURN THE ACTOR LIST FOR THE XML IN AXML
    196  ; AXML AND ACTRTN ARE PASSED BY NAME
    197  ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
    198  ; P1= OBJECTID - ACTORPATIENT_2
    199  ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
    200  ;OR INSTITUTION
    201  ;  OR PERSON(IN PATIENT FILE IE NOK)
    202  ; P3= IEN RECORD NUMBER FOR ACTOR - 2
    203  N I,J,K,L
    204  K @ACTRTN ; CLEAR RETURN ARRAY
    205  F I=1:1:@AXML@(0) D  ; FIRST FIX MISSING LINKS
    206  . I @AXML@(I)?.E1"_<".E D  ;
    207  . . N ZA,ZB
    208  . . S ZA=$P(@AXML@(I),">",1)_">"
    209  . . S ZB="<"_$P(@AXML@(I),"<",3)
    210  . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
    211  F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
    212  . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
    213  . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
    214  . . I $G(LINKDEBUG) W "<ActorID>=>",J,!
    215  . . I J'="" S K(J)="" ; HASHING ACTOR
    216  . I @AXML@(I)?.E1"<LinkID>".E D  ; THERE IS AN ACTOR THIS LINE
    217  . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
    218  . . I $G(LINKDEBUG) W "<LinkID>=>",J,!
    219  . . I J'="" S K(J)="" ; HASHING ACTOR
    220  . . ;  TO GET RID OF DUPLICATES
    221  S I="" ; GOING TO $O THROUGH THE HASH
    222  F J=0:0 D  Q:$O(K(I))=""
    223  . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
    224  . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
    225  . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
    226  . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
    227  . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
    228  Q
    229  ;
     196        ; AXML AND ACTRTN ARE PASSED BY NAME
     197        ; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
     198        ; P1= OBJECTID - ACTORPATIENT_2
     199        ; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
     200        ;OR INSTITUTION
     201        ;  OR PERSON(IN PATIENT FILE IE NOK)
     202        ; P3= IEN RECORD NUMBER FOR ACTOR - 2
     203        N I,J,K,L
     204        K @ACTRTN ; CLEAR RETURN ARRAY
     205        F I=1:1:@AXML@(0) D  ; FIRST FIX MISSING LINKS
     206        . I @AXML@(I)?.E1"_<".E D  ;
     207        . . N ZA,ZB
     208        . . S ZA=$P(@AXML@(I),">",1)_">"
     209        . . S ZB="<"_$P(@AXML@(I),"<",3)
     210        . . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
     211        F I=1:1:@AXML@(0) D  ; SCAN ALL LINES
     212        . I @AXML@(I)?.E1"<ActorID>".E D  ; THERE IS AN ACTOR THIS LINE
     213        . . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
     214        . . I $G(LINKDEBUG) W "<ActorID>=>",J,!
     215        . . I J'="" S K(J)="" ; HASHING ACTOR
     216        . I @AXML@(I)?.E1"<LinkID>".E D  ; THERE IS AN ACTOR THIS LINE
     217        . . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
     218        . . I $G(LINKDEBUG) W "<LinkID>=>",J,!
     219        . . I J'="" S K(J)="" ; HASHING ACTOR
     220        . . ;  TO GET RID OF DUPLICATES
     221        S I="" ; GOING TO $O THROUGH THE HASH
     222        F J=0:0 D  Q:$O(K(I))=""
     223        . S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
     224        . S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
     225        . S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
     226        . S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
     227        . D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
     228        Q
     229        ;
    230230TEST    ; RUN ALL THE TEST CASES
    231  D TESTALL^C0CUNIT("C0CCCR")
    232  Q
    233  ;
     231        D TESTALL^C0CUNIT("C0CCCR")
     232        Q
     233        ;
    234234ZTEST(WHICH)     ; RUN ONE SET OF TESTS
    235  N ZTMP
    236  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
    237  D ZTEST^C0CUNIT(.ZTMP,WHICH)
    238  Q
    239  ;
     235        N ZTMP
     236        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
     237        D ZTEST^C0CUNIT(.ZTMP,WHICH)
     238        Q
     239        ;
    240240TLIST    ; LIST THE TESTS
    241  N ZTMP
    242  D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
    243  D TLIST^C0CUNIT(.ZTMP)
    244  Q
    245  ;
    246  ;;><TEST>
    247  ;;><PROBLEMS>
    248  ;;>>>K C0C S C0C=""
    249  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
    250  ;;>>?@C0C@(@C0C@(0))["</Problems>"
    251  ;;><VITALS>
    252  ;;>>>K C0C S C0C=""
    253  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
    254  ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
    255  ;;><CCR>
    256  ;;>>>K C0C S C0C=""
    257  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
    258  ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
    259  ;;><ACTLST>
    260  ;;>>>K C0C S C0C=""
    261  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
    262  ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
    263  ;;><ACTORS>
    264  ;;>>>D ZTEST^C0CCCR("ACTLST")
    265  ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
    266  ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
    267  ;;>>?G3(G3(0))["</Actors>"
    268  ;;><TRIM>
    269  ;;>>>D ZTEST^C0CCCR("CCR")
    270  ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
    271  ;;><ALERTS>
    272  ;;>>>S TESTALERT=1
    273  ;;>>>K C0C S C0C=""
    274  ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
    275  ;;>>?@C0C@(@C0C@(0))["</Alerts>"
    276  
    277  
     241        N ZTMP
     242        D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
     243        D TLIST^C0CUNIT(.ZTMP)
     244        Q
     245        ;
     246        ;;><TEST>
     247        ;;><PROBLEMS>
     248        ;;>>>K C0C S C0C=""
     249        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
     250        ;;>>?@C0C@(@C0C@(0))["</Problems>"
     251        ;;><VITALS>
     252        ;;>>>K C0C S C0C=""
     253        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
     254        ;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
     255        ;;><CCR>
     256        ;;>>>K C0C S C0C=""
     257        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
     258        ;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
     259        ;;><ACTLST>
     260        ;;>>>K C0C S C0C=""
     261        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
     262        ;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
     263        ;;><ACTORS>
     264        ;;>>>D ZTEST^C0CCCR("ACTLST")
     265        ;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
     266        ;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
     267        ;;>>?G3(G3(0))["</Actors>"
     268        ;;><TRIM>
     269        ;;>>>D ZTEST^C0CCCR("CCR")
     270        ;;>>>W $$TRIM^C0CXPATH(CCRGLO)
     271        ;;><ALERTS>
     272        ;;>>>S TESTALERT=1
     273        ;;>>>K C0C S C0C=""
     274        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
     275        ;;>>?@C0C@(@C0C@(0))["</Alerts>"
     276       
     277       
  • ccr/trunk/p/C0CCCR0.m

    r781 r1204  
    1 C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
    2  ;;1.0;C0C;;May 19, 2009;Build 32
    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  ;;<IDs>
    795  ;;<Type>
    796  ;;<Text>@@IDTYPE@@</Text>
    797  ;;</Type>
    798  ;;<ID>@@ID@@</ID>
    799  ;;<IssuedBy>
    800  ;;<Description>
    801  ;;<Text>@@IDDESC@@</Text>
    802  ;;</Description>
    803  ;;</IssuedBy>
    804  ;;</IDs>
    805  ;;<Specialty>
    806  ;;<Text>@@ACTORSPECIALITY@@</Text>
    807  ;;</Specialty>
    808  ;;<Address>
    809  ;;<Type>
    810  ;;<Text>@@ACTORADDRESSTYPE@@</Text>
    811  ;;</Type>
    812  ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
    813  ;;<City>@@ACTORADDRESSCITY@@</City>
    814  ;;<State>@@ACTORADDRESSSTATE@@</State>
    815  ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
    816  ;;</Address>
    817  ;;<Telephone>
    818  ;;<Value>@@ACTORTELEPHONE@@</Value>
    819  ;;<Type>
    820  ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
    821  ;;</Type>
    822  ;;</Telephone>
    823  ;;<Email>
    824  ;;<Value>@@ACTOREMAIL@@</Value>
    825  ;;</Email>
    826  ;;<Source>
    827  ;;<Actor>
    828  ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
    829  ;;</Actor>
    830  ;;</Source>
    831  ;;<InternalCCRLink>
    832  ;;<LinkID>@@ACTORORGLINK@@</LinkID>
    833  ;;<LinkRelationship>representedOrganization</LinkRelationship>
    834  ;;</InternalCCRLink>
    835  ;;</Actor>
    836  ;;</ACTOR-PROVIDER>
    837  ;;<ACTOR-ORG>
    838  ;;<Actor>
    839  ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
    840  ;;<Organization>
    841  ;;<Name>@@ORGANIZATIONNAME@@</Name>
    842  ;;</Organization>
    843  ;;<Address>
    844  ;;<Type>
    845  ;;<Text>@@ACTORADDRESSTYPE@@</Text>
    846  ;;</Type>
    847  ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
    848  ;;<City>@@ACTORADDRESSCITY@@</City>
    849  ;;<State>@@ACTORADDRESSSTATE@@</State>
    850  ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
    851  ;;</Address>
    852  ;;<Telephone>
    853  ;;<Value>@@ACTORTELEPHONE@@</Value>
    854  ;;<Type>
    855  ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
    856  ;;</Type>
    857  ;;</Telephone>
    858  ;;<Source>
    859  ;;<Actor>
    860  ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
    861  ;;</Actor>
    862  ;;</Source>
    863  ;;</Actor>
    864  ;;</ACTOR-ORG>
    865  ;;</Actors>
    866  ;;<Signatures>
    867  ;;<CCRSignature>
    868  ;;<SignatureObjectID>S0001</SignatureObjectID>
    869  ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
    870  ;;<Source>
    871  ;;<ActorID>AA0001</ActorID>
    872  ;;</Source>
    873  ;;<Signature>
    874  ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
    875  ;;<SignedInfo>
    876  ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
    877  ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
    878  ;;<Reference URI="">
    879  ;;<Transforms>
    880  ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
    881  ;;</Transforms>
    882  ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
    883  ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
    884  ;;</Reference>
    885  ;;</SignedInfo>
    886  ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
    887  ;;<KeyInfo>
    888  ;;<KeyValue>
    889  ;;<RSAKeyValue>
    890  ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
    891  ;;<Exponent>AQAB</Exponent>
    892  ;;</RSAKeyValue>
    893  ;;</KeyValue>
    894  ;;</KeyInfo>
    895  ;;</Signature>
    896  ;;</Signature>
    897  ;;</CCRSignature>
    898  ;;</Signatures>
    899  ;;<Comments>
    900  ;;<Comment>
    901  ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID>
    902  ;;<DateTime>
    903  ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime>
    904  ;;</DateTime>
    905  ;;<Description>
    906  ;;<Text>
    907  ;;</Text>
    908  ;;</Description>
    909  ;;<Source>
    910  ;;<Actor>
    911  ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
    912  ;;</Actor>
    913  ;;</Source>
    914  ;;</Comment>
    915  ;;</Comments>
    916  ;;</ContinuityOfCareRecord>
    917  ;</TEMPLATE>
     1C0CCCR0 ; 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        ;
     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        ;;<IDs>
     795        ;;<Type>
     796        ;;<Text>@@IDTYPE@@</Text>
     797        ;;</Type>
     798        ;;<ID>@@ID@@</ID>
     799        ;;<IssuedBy>
     800        ;;<Description>
     801        ;;<Text>@@IDDESC@@</Text>
     802        ;;</Description>
     803        ;;</IssuedBy>
     804        ;;</IDs>
     805        ;;<Specialty>
     806        ;;<Text>@@ACTORSPECIALITY@@</Text>
     807        ;;</Specialty>
     808        ;;<Address>
     809        ;;<Type>
     810        ;;<Text>@@ACTORADDRESSTYPE@@</Text>
     811        ;;</Type>
     812        ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
     813        ;;<City>@@ACTORADDRESSCITY@@</City>
     814        ;;<State>@@ACTORADDRESSSTATE@@</State>
     815        ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
     816        ;;</Address>
     817        ;;<Telephone>
     818        ;;<Value>@@ACTORTELEPHONE@@</Value>
     819        ;;<Type>
     820        ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
     821        ;;</Type>
     822        ;;</Telephone>
     823        ;;<Email>
     824        ;;<Value>@@ACTOREMAIL@@</Value>
     825        ;;</Email>
     826        ;;<Source>
     827        ;;<Actor>
     828        ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
     829        ;;</Actor>
     830        ;;</Source>
     831        ;;<InternalCCRLink>
     832        ;;<LinkID>@@ACTORORGLINK@@</LinkID>
     833        ;;<LinkRelationship>representedOrganization</LinkRelationship>
     834        ;;</InternalCCRLink>
     835        ;;</Actor>
     836        ;;</ACTOR-PROVIDER>
     837        ;;<ACTOR-ORG>
     838        ;;<Actor>
     839        ;;<ActorObjectID>@@ACTOROBJECTID@@</ActorObjectID>
     840        ;;<Organization>
     841        ;;<Name>@@ORGANIZATIONNAME@@</Name>
     842        ;;</Organization>
     843        ;;<Address>
     844        ;;<Type>
     845        ;;<Text>@@ACTORADDRESSTYPE@@</Text>
     846        ;;</Type>
     847        ;;<Line1>@@ACTORADDRESSLINE1@@</Line1>
     848        ;;<City>@@ACTORADDRESSCITY@@</City>
     849        ;;<State>@@ACTORADDRESSSTATE@@</State>
     850        ;;<PostalCode>@@ACTORPOSTALCODE@@</PostalCode>
     851        ;;</Address>
     852        ;;<Telephone>
     853        ;;<Value>@@ACTORTELEPHONE@@</Value>
     854        ;;<Type>
     855        ;;<Text>@@ACTORTELEPHONETYPE@@</Text>
     856        ;;</Type>
     857        ;;</Telephone>
     858        ;;<Source>
     859        ;;<Actor>
     860        ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
     861        ;;</Actor>
     862        ;;</Source>
     863        ;;</Actor>
     864        ;;</ACTOR-ORG>
     865        ;;</Actors>
     866        ;;<Signatures>
     867        ;;<CCRSignature>
     868        ;;<SignatureObjectID>S0001</SignatureObjectID>
     869        ;;<ExactDateTime>2008-03-18T23:10:58Z</ExactDateTime>
     870        ;;<Source>
     871        ;;<ActorID>AA0001</ActorID>
     872        ;;</Source>
     873        ;;<Signature>
     874        ;;<Signature xmlns="http://www.w3.org/2000/09/xmldsig#">
     875        ;;<SignedInfo>
     876        ;;<CanonicalizationMethod Algorithm="http://www.w3.org/TR/2001/REC-xml-c14n-20010315"/>
     877        ;;<SignatureMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
     878        ;;<Reference URI="">
     879        ;;<Transforms>
     880        ;;<Transform Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
     881        ;;</Transforms>
     882        ;;<DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
     883        ;;<DigestValue>YFveLLyo+75P7rSciv0/m1O6Ot4=</DigestValue>
     884        ;;</Reference>
     885        ;;</SignedInfo>
     886        ;;<SignatureValue>Bj6sACXl74hrlbUYnu8HqnRab5VGy69BOYjOH7dETxgppXMEd7AoVYaePZvgJft78JR4oQY76hbFyGcIslYauPpJxx2hCd5d56xFeaQg01R6AQOvGnhjlq63TbpFdUq0B4tYsmiibJPbQJhTQe+TcWTBvWaQt8Fkk5blO571YvI=</SignatureValue>
     887        ;;<KeyInfo>
     888        ;;<KeyValue>
     889        ;;<RSAKeyValue>
     890        ;;<Modulus>meH817QYol+/uUEg6j8Mg89s7GTlaN9B+/CGlzrtnQH+swMigZRnEPxHVO8PhEymP/W9nlhAjTScV/CUzA9yJ9WiaOn17c+KReKhfBqL24DX9BpbJ+kLYVz7mBO5Qydk5AzUT2hFwW93irD8iRKP+/t+2Mi2CjNfj8VTjJpHpm0=</Modulus>
     891        ;;<Exponent>AQAB</Exponent>
     892        ;;</RSAKeyValue>
     893        ;;</KeyValue>
     894        ;;</KeyInfo>
     895        ;;</Signature>
     896        ;;</Signature>
     897        ;;</CCRSignature>
     898        ;;</Signatures>
     899        ;;<Comments>
     900        ;;<Comment>
     901        ;;<CommentObjectID>@@COMMENTOBJECTID@@</CommentObjectID>
     902        ;;<DateTime>
     903        ;;<ExactDateTime>@@CMTDATETIME@@</ExactDateTime>
     904        ;;</DateTime>
     905        ;;<Description>
     906        ;;<Text>
     907        ;;</Text>
     908        ;;</Description>
     909        ;;<Source>
     910        ;;<Actor>
     911        ;;<ActorID>@@ACTORSOURCEID@@</ActorID>
     912        ;;</Actor>
     913        ;;</Source>
     914        ;;</Comment>
     915        ;;</Comments>
     916        ;;</ContinuityOfCareRecord>
     917        ;</TEMPLATE>
  • ccr/trunk/p/C0CCMT.m

    r785 r1204  
    1 C0CCMT  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
    2  ;;1.0;C0C;;May 21, 2010;
    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 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        ;
     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/trunk/p/C0CCPT.m

    r780 r1204  
    11C0CCPT  ;;BSL;RETURN CPT DATA;
    2         ;Sequence Managers Software GPL
     2        ;Sequence Managers Software GPL;;;;;Build 38
    33        ;Copied into C0C namespace from SQMCPT with permission from
    44        ;Brian Lord - and with our thanks. gpl 01/20/2010
     
    99        ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
    1010        ;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)
     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)
    2929        D VISIT
    30         Q
    31 VISIT   ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
     30               Q
     31VISIT     ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
    3232        S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
    3333        S IEN=""  F  S IEN=$O(NOTE(IEN)) Q:IEN=""  D
  • ccr/trunk/p/C0CDOM.m

    r1203 r1204  
    126126 Q
    127127 ;
    128 OUTXML(ZRTN,INID)       ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
     128OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    129129 ;
    130130 S C0CDOCID=INID
    131  D START^C0CMXMLB($$TAG(1),,"G")
     131 I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
     132 D START^C0CMXMLB($$TAG(1),,"G",NO1ST)
    132133 D NDOUT($$FIRST(1))
    133134 D END^C0CMXMLB ;END THE DOCUMENT
     
    156157 S GN2=$NA(@GN@(1))
    157158 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)
    158167 Q
    159168 ;
     
    217226 I '$D(INARY) Q 0 ; NO ARRAY PASSED
    218227 I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
     228 ;I PARENT="" S PARENT="root"
    219229 I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
    220  E  I $L(PARENT)>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
     230 E  I $L($G(PARENT))>0 D  ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
    221231 . D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
    222232 . S ZPARNODE=1 ;
    223233 ; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
    224  D MAJOR(INARY,"",0) ; PROCESS ALL THE NODES TO BE ADDED
    225  I $L(PARENT)>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
    226  Q 1 ; SUCCESS
     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
    227239 ;
    228 MAJOR(ZARY,ZTAG,ZNUM) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
     240MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
    229241 N ZI S ZI=""
     242 N ZTAG
    230243 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
    231259 . N ZN S ZN=0
    232260 . F  S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN=""  D  ; FOR EACH MULTIPLE
    233  . . N ZS S ZS=""
    234  . . I $O(@ZARY@(ZI,ZN,ZS))'["." D  ; END NODES HERE
    235  . . . N NEWARY
    236  . . . S NEWARY=$NA(@ZARY@(ZI,ZN))
    237  . . . D MINOR("NEWARY") ; INSERT THE END NODES
    238  . . E  F  S ZS=$O(@ZARY@(ZI,ZN,ZS)) Q:ZS=""  D  ; FOR EACH STRING
    239  . . . I ZS["." D  ; INTERMEDIATE NODE FOUND
    240  . . . . W !,"IM:",ZS
    241  . . . W !,ZI,":",ZN,":",ZS_" : ",@ZARY@(ZI,ZN,ZS)
    242  Q
    243  ;
    244 MINOR(ZINARY) ; DOES THE WORK FOR END NODES, HANDLES ATTRIBUTES
    245  ;
    246  N ZZI S ZZI=""
    247  F  S ZZI=$O(@ZINARY@(ZZI)) Q:ZZI=""  D  ;
    248  . W !,"MINOR",ZZI,":",@ZINARY@(ZZI)
     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
    249265 Q
    250266 ;
     
    268284 . . . N ZZV ; PLACE TO STASH THE VALUE
    269285 . . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
     286 . . . W !,"VALUE:",ZZV
    270287 . . . N GK ; COUNTER
    271288 . . . F GK=1:1:$L(ZZS,".") D  ; FOR EACH INTERMEDIATE NODE
     
    292309 Q
    293310 ;
    294 POP(OSTR,ISTR) ; EXTRINSIC WHICH RETURNS TRUE IF ISTR IS EMPTY
    295  ; IF ISTR IS NOT EMPTY, LOOKS FOR "." AND "@" AND RETURNS
    296  ; xxx,1,yyyetc for xxx.yyyetc   and xx@,1,yyy for xxx@yyyetc
    297  ; OSTR IS PASSED BY REFERENCE AND CONTAINS yyyetc
    298  I $L(ISTR)=0 Q 1 ; WE ARE DONE
    299  N ZG,ZN,ZR
    300  S ZN=1
    301  I ISTR["." D  ;
    302  . S ZG=$P(ISTR,".",1)
    303  . S OSTR=$P(ISTR,".",2)
    304  . S ZR=ZG_","_ZN_","_OSTR
    305  Q ZR
    306  ;
    307311NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
    308312 N CBK,SUCCESS,LEVEL,NODE,HANDLE
     
    314318 Q HANDLE
    315319 ;
    316  
    317 
  • ccr/trunk/p/C0CDPT.m

    r767 r1204  
    11C0CDPT  ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
    2  ;;1.0;C0C;;May 19, 2009;
    3  ;
    4  ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    5  ; General Public License.
    6  ;
    7  ; This program is distributed in the hope that it will be useful,
    8  ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    9  ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    10  ; GNU General Public License for more details.
    11  ;
    12  ; You should have received a copy of the GNU General Public License along
    13  ; with this program; if not, write to the Free Software Foundation, Inc.,
    14  ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    15  ;
    16  ; FAMILY       Family Name
    17  ; GIVEN        Given Name
    18  ; MIDDLE       Middle Name
    19  ; SUFFIX       Suffix Name
    20  ; DISPNAME     Display Name
    21  ; DOB          Date of Birth
    22  ; GENDER       Get Gender
    23  ; SSN          Get SSN for ID
    24  ; ADDRTYPE     Get Home Address
    25  ; ADDR1        Get Home Address line 1
    26  ; ADDR2        Get Home Address line 2
    27  ; CITY         Get City for Home Address
    28  ; STATE        Get State for Home Address
    29  ; ZIP          Get Zip code for Home Address
    30  ; COUNTY       Get County for our Address
    31  ; COUNTRY      Get Country for our Address
    32  ; RESTEL       Residential Telephone
    33  ; WORKTEL      Work Telephone
    34  ; EMAIL        Email Adddress
    35  ; CELLTEL      Cell Phone
    36  ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
    37  ; NOK1GIV      NOK1 Given Name
    38  ; NOK1MID      NOK1 Middle Name
    39  ; NOK1SUF      NOK1 Suffi Name
    40  ; NOK1DISP     NOK1 Display Name
    41  ; NOK1REL      NOK1 Relationship to the patient
    42  ; NOK1ADD1     NOK1 Address 1
    43  ; NOK1ADD2     NOK1 Address 2
    44  ; NOK1CITY     NOK1 City
    45  ; NOK1STAT     NOK1 State
    46  ; NOK1ZIP      NOK1 Zip Code
    47  ; NOK1HTEL     NOK1 Home Telephone
    48  ; NOK1WTEL     NOK1 Work Telephone
    49  ; NOK1SAME     Is NOK1's Address the same the patient?
    50  ; NOK2FAM      NOK2 Family Name
    51  ; NOK2GIV      NOK2 Given Name
    52  ; NOK2MID      NOK2 Middle Name
    53  ; NOK2SUF      NOK2 Suffi Name
    54  ; NOK2DISP     NOK2 Display Name
    55  ; NOK2REL      NOK2 Relationship to the patient
    56  ; NOK2ADD1     NOK2 Address 1
    57  ; NOK2ADD2     NOK2 Address 2
    58  ; NOK2CITY     NOK2 City
    59  ; NOK2STAT     NOK2 State
    60  ; NOK2ZIP      NOK2 Zip Code
    61  ; NOK2HTEL     NOK2 Home Telephone
    62  ; NOK2WTEL     NOK2 Work Telephone
    63  ; NOK2SAME     Is NOK2's Address the same the patient?
    64  ; EMERFAM      Emergency Contact (EMER) Family Name
    65  ; EMERGIV      EMER Given Name
    66  ; EMERMID      EMER Middle Name
    67  ; EMERSUF      EMER Suffi Name
    68  ; EMERDISP     EMER Display Name
    69  ; EMERREL      EMER Relationship to the patient
    70  ; EMERADD1     EMER Address 1
    71  ; EMERADD2     EMER Address 2
    72  ; EMERCITY     EMER City
    73  ; EMERSTAT     EMER State
    74  ; EMERZIP      EMER Zip Code
    75  ; EMERHTEL     EMER Home Telephone
    76  ; EMERWTEL     EMER Work Telephone
    77  ; EMERSAME     Is EMER's Address the same the NOK?
    78  ;
    79  W "No Entry at top!" Q
    80  ;
    81  ;**Revision History**
    82  ; - June 15, 08: v0.1 using merged global
    83  ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
    84  ;
    85  ; All methods are Public and Extrinsic
    86  ; All calls use Fileman file 2 (Patient).
    87  ; You can obtain field numbers using the data dictionary
    88  ;
     2        ;;1.0;C0C;;May 19, 2009;Build 38
     3        ;
     4        ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
     5        ; General Public License.
     6        ;
     7        ; This program is distributed in the hope that it will be useful,
     8        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     9        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     10        ; GNU General Public License for more details.
     11        ;
     12        ; You should have received a copy of the GNU General Public License along
     13        ; with this program; if not, write to the Free Software Foundation, Inc.,
     14        ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     15        ;
     16        ; FAMILY       Family Name
     17        ; GIVEN        Given Name
     18        ; MIDDLE       Middle Name
     19        ; SUFFIX       Suffix Name
     20        ; DISPNAME     Display Name
     21        ; DOB          Date of Birth
     22        ; GENDER       Get Gender
     23        ; SSN          Get SSN for ID
     24        ; ADDRTYPE     Get Home Address
     25        ; ADDR1        Get Home Address line 1
     26        ; ADDR2        Get Home Address line 2
     27        ; CITY         Get City for Home Address
     28        ; STATE        Get State for Home Address
     29        ; ZIP          Get Zip code for Home Address
     30        ; COUNTY       Get County for our Address
     31        ; COUNTRY      Get Country for our Address
     32        ; RESTEL       Residential Telephone
     33        ; WORKTEL      Work Telephone
     34        ; EMAIL        Email Adddress
     35        ; CELLTEL      Cell Phone
     36        ; NOK1FAM      Next of Kin 1 (NOK1) Family Name
     37        ; NOK1GIV      NOK1 Given Name
     38        ; NOK1MID      NOK1 Middle Name
     39        ; NOK1SUF      NOK1 Suffi Name
     40        ; NOK1DISP     NOK1 Display Name
     41        ; NOK1REL      NOK1 Relationship to the patient
     42        ; NOK1ADD1     NOK1 Address 1
     43        ; NOK1ADD2     NOK1 Address 2
     44        ; NOK1CITY     NOK1 City
     45        ; NOK1STAT     NOK1 State
     46        ; NOK1ZIP      NOK1 Zip Code
     47        ; NOK1HTEL     NOK1 Home Telephone
     48        ; NOK1WTEL     NOK1 Work Telephone
     49        ; NOK1SAME     Is NOK1's Address the same the patient?
     50        ; NOK2FAM      NOK2 Family Name
     51        ; NOK2GIV      NOK2 Given Name
     52        ; NOK2MID      NOK2 Middle Name
     53        ; NOK2SUF      NOK2 Suffi Name
     54        ; NOK2DISP     NOK2 Display Name
     55        ; NOK2REL      NOK2 Relationship to the patient
     56        ; NOK2ADD1     NOK2 Address 1
     57        ; NOK2ADD2     NOK2 Address 2
     58        ; NOK2CITY     NOK2 City
     59        ; NOK2STAT     NOK2 State
     60        ; NOK2ZIP      NOK2 Zip Code
     61        ; NOK2HTEL     NOK2 Home Telephone
     62        ; NOK2WTEL     NOK2 Work Telephone
     63        ; NOK2SAME     Is NOK2's Address the same the patient?
     64        ; EMERFAM      Emergency Contact (EMER) Family Name
     65        ; EMERGIV      EMER Given Name
     66        ; EMERMID      EMER Middle Name
     67        ; EMERSUF      EMER Suffi Name
     68        ; EMERDISP     EMER Display Name
     69        ; EMERREL      EMER Relationship to the patient
     70        ; EMERADD1     EMER Address 1
     71        ; EMERADD2     EMER Address 2
     72        ; EMERCITY     EMER City
     73        ; EMERSTAT     EMER State
     74        ; EMERZIP      EMER Zip Code
     75        ; EMERHTEL     EMER Home Telephone
     76        ; EMERWTEL     EMER Work Telephone
     77        ; EMERSAME     Is EMER's Address the same the NOK?
     78        ;
     79        W "No Entry at top!" Q
     80        ;
     81        ;**Revision History**
     82        ; - June 15, 08: v0.1 using merged global
     83        ; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
     84        ;
     85        ; All methods are Public and Extrinsic
     86        ; All calls use Fileman file 2 (Patient).
     87        ; You can obtain field numbers using the data dictionary
     88        ;
    8989FAMILY(DFN)     ; Family Name
    90  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    91  D NAMECOMP^XLFNAME(.NAME)
    92  Q NAME("FAMILY")
     90        N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     91        D NAMECOMP^XLFNAME(.NAME)
     92        Q NAME("FAMILY")
    9393GIVEN(DFN)      ; Given Name
    94  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    95  D NAMECOMP^XLFNAME(.NAME)
    96  Q NAME("GIVEN")
     94        N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     95        D NAMECOMP^XLFNAME(.NAME)
     96        Q NAME("GIVEN")
    9797MIDDLE(DFN)     ; Middle Name
    98  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    99  D NAMECOMP^XLFNAME(.NAME)
    100  Q NAME("MIDDLE")
     98        N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     99        D NAMECOMP^XLFNAME(.NAME)
     100        Q NAME("MIDDLE")
    101101SUFFIX(DFN)     ; Suffi Name
    102  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    103  D NAMECOMP^XLFNAME(.NAME)
    104  Q NAME("SUFFIX")
     102        N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     103        D NAMECOMP^XLFNAME(.NAME)
     104        Q NAME("SUFFIX")
    105105DISPNAME(DFN)   ; Display Name
    106  N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
    107  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    108  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     106        N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
     107        ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     108        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    109109DOB(DFN)        ; Date of Birth
    110  N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
    111  ; Date in FM Date Format. Convert to UTC/ISO 8601.
    112  Q $$FMDTOUTC^C0CUTIL(DOB,"D")
     110        N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
     111        ; Date in FM Date Format. Convert to UTC/ISO 8601.
     112        Q $$FMDTOUTC^C0CUTIL(DOB,"D")
    113113GENDER(DFN)     ; Gender/Sex
    114  Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
     114        Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
    115115SSN(DFN)        ; SSN
    116  Q $$GET1^DIQ(2,DFN,.09)
     116        Q $$GET1^DIQ(2,DFN,.09)
    117117ADDRTYPE(DFN)   ; Address Type
    118  ; Vista only stores a home address for the patient.
    119  Q "Home"
     118        ; Vista only stores a home address for the patient.
     119        Q "Home"
    120120ADDR1(DFN)      ; Get Home Address line 1
    121  Q $$GET1^DIQ(2,DFN,.111)
     121        Q $$GET1^DIQ(2,DFN,.111)
    122122ADDR2(DFN)      ; Get Home Address line 2
    123  ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
    124  N ADDLN2,ADDLN3
    125  S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
    126  Q:ADDLN3="" ADDLN2
    127  Q ADDLN2_", "_ADDLN3
     123        ; Vista has Lines 2,3; CCR has only line 1,2; so compromise
     124        N ADDLN2,ADDLN3
     125        S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
     126        Q:ADDLN3="" ADDLN2
     127        Q ADDLN2_", "_ADDLN3
    128128CITY(DFN)       ; Get City for Home Address
    129  Q $$GET1^DIQ(2,DFN,.114)
     129        Q $$GET1^DIQ(2,DFN,.114)
    130130STATE(DFN)      ; Get State for Home Address
    131  Q $$GET1^DIQ(2,DFN,.115)
     131        Q $$GET1^DIQ(2,DFN,.115)
    132132ZIP(DFN)        ; Get Zip code for Home Address
    133  Q $$GET1^DIQ(2,DFN,.116)
     133        Q $$GET1^DIQ(2,DFN,.116)
    134134COUNTY(DFN)     ; Get County for our Address
    135  Q $$GET1^DIQ(2,DFN,.117)
     135        Q $$GET1^DIQ(2,DFN,.117)
    136136COUNTRY(DFN)    ; Get Country for our Address
    137  ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
    138  Q "USA"
     137        ; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
     138        Q "USA"
    139139RESTEL(DFN)     ; Residential Telephone
    140  Q $$GET1^DIQ(2,DFN,.131)
     140        Q $$GET1^DIQ(2,DFN,.131)
    141141WORKTEL(DFN)    ; Work Telephone
    142  Q $$GET1^DIQ(2,DFN,.132)
     142        Q $$GET1^DIQ(2,DFN,.132)
    143143EMAIL(DFN)      ; Email Adddress
    144  Q $$GET1^DIQ(2,DFN,.133)
     144        Q $$GET1^DIQ(2,DFN,.133)
    145145CELLTEL(DFN)    ; Cell Phone
    146  Q $$GET1^DIQ(2,DFN,.134)
     146        Q $$GET1^DIQ(2,DFN,.134)
    147147NOK1FAM(DFN)    ; Next of Kin 1 (NOK1) Family Name
    148  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    149  D NAMECOMP^XLFNAME(.NAME)
    150  Q NAME("FAMILY")
     148        N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     149        D NAMECOMP^XLFNAME(.NAME)
     150        Q NAME("FAMILY")
    151151NOK1GIV(DFN)    ; NOK1 Given Name
    152  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    153  D NAMECOMP^XLFNAME(.NAME)
    154  Q NAME("GIVEN")
     152        N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     153        D NAMECOMP^XLFNAME(.NAME)
     154        Q NAME("GIVEN")
    155155NOK1MID(DFN)    ; NOK1 Middle Name
    156  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    157  D NAMECOMP^XLFNAME(.NAME)
    158  Q NAME("MIDDLE")
     156        N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     157        D NAMECOMP^XLFNAME(.NAME)
     158        Q NAME("MIDDLE")
    159159NOK1SUF(DFN)    ; NOK1 Suffi Name
    160  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    161  D NAMECOMP^XLFNAME(.NAME)
    162  Q NAME("SUFFIX")
     160        N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     161        D NAMECOMP^XLFNAME(.NAME)
     162        Q NAME("SUFFIX")
    163163NOK1DISP(DFN)   ; NOK1 Display Name
    164  N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
    165  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    166  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     164        N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
     165        ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     166        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    167167NOK1REL(DFN)    ; NOK1 Relationship to the patient
    168  Q $$GET1^DIQ(2,DFN,.212)
     168        Q $$GET1^DIQ(2,DFN,.212)
    169169NOK1ADD1(DFN)   ; NOK1 Address 1
    170  Q $$GET1^DIQ(2,DFN,.213)
     170        Q $$GET1^DIQ(2,DFN,.213)
    171171NOK1ADD2(DFN)   ; NOK1 Address 2
    172  N ADDLN2,ADDLN3
    173  S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
    174  Q:ADDLN3="" ADDLN2
    175  Q ADDLN2_", "_ADDLN3
     172        N ADDLN2,ADDLN3
     173        S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
     174        Q:ADDLN3="" ADDLN2
     175        Q ADDLN2_", "_ADDLN3
    176176NOK1CITY(DFN)   ; NOK1 City
    177  Q $$GET1^DIQ(2,DFN,.216)
     177        Q $$GET1^DIQ(2,DFN,.216)
    178178NOK1STAT(DFN)   ; NOK1 State
    179  Q $$GET1^DIQ(2,DFN,.217)
     179        Q $$GET1^DIQ(2,DFN,.217)
    180180NOK1ZIP(DFN)    ; NOK1 Zip Code
    181  Q $$GET1^DIQ(2,DFN,.218)
     181        Q $$GET1^DIQ(2,DFN,.218)
    182182NOK1HTEL(DFN)   ; NOK1 Home Telephone
    183  Q $$GET1^DIQ(2,DFN,.219)
     183        Q $$GET1^DIQ(2,DFN,.219)
    184184NOK1WTEL(DFN)   ; NOK1 Work Telephone
    185  Q $$GET1^DIQ(2,DFN,.21011)
     185        Q $$GET1^DIQ(2,DFN,.21011)
    186186NOK1SAME(DFN)   ; Is NOK1's Address the same the patient?
    187  Q $$GET1^DIQ(2,DFN,.2125)
     187        Q $$GET1^DIQ(2,DFN,.2125)
    188188NOK2FAM(DFN)    ; NOK2 Family Name
    189  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    190  D NAMECOMP^XLFNAME(.NAME)
    191  Q NAME("FAMILY")
     189        N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     190        D NAMECOMP^XLFNAME(.NAME)
     191        Q NAME("FAMILY")
    192192NOK2GIV(DFN)    ; NOK2 Given Name
    193  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    194  D NAMECOMP^XLFNAME(.NAME)
    195  Q NAME("GIVEN")
     193        N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     194        D NAMECOMP^XLFNAME(.NAME)
     195        Q NAME("GIVEN")
    196196NOK2MID(DFN)    ; NOK2 Middle Name
    197  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    198  D NAMECOMP^XLFNAME(.NAME)
    199  Q NAME("MIDDLE")
     197        N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     198        D NAMECOMP^XLFNAME(.NAME)
     199        Q NAME("MIDDLE")
    200200NOK2SUF(DFN)    ; NOK2 Suffi Name
    201  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    202  D NAMECOMP^XLFNAME(.NAME)
    203  Q NAME("SUFFIX")
     201        N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     202        D NAMECOMP^XLFNAME(.NAME)
     203        Q NAME("SUFFIX")
    204204NOK2DISP(DFN)   ; NOK2 Display Name
    205  N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
    206  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    207  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     205        N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
     206        ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     207        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    208208NOK2REL(DFN)    ; NOK2 Relationship to the patient
    209  Q $$GET1^DIQ(2,DFN,.2192)
     209        Q $$GET1^DIQ(2,DFN,.2192)
    210210NOK2ADD1(DFN)   ; NOK2 Address 1
    211  Q $$GET1^DIQ(2,DFN,.2193)
     211        Q $$GET1^DIQ(2,DFN,.2193)
    212212NOK2ADD2(DFN)   ; NOK2 Address 2
    213  N ADDLN2,ADDLN3
    214  S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
    215  Q:ADDLN3="" ADDLN2
    216  Q ADDLN2_", "_ADDLN3
     213        N ADDLN2,ADDLN3
     214        S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
     215        Q:ADDLN3="" ADDLN2
     216        Q ADDLN2_", "_ADDLN3
    217217NOK2CITY(DFN)   ; NOK2 City
    218  Q $$GET1^DIQ(2,DFN,.2196)
     218        Q $$GET1^DIQ(2,DFN,.2196)
    219219NOK2STAT(DFN)   ; NOK2 State
    220  Q $$GET1^DIQ(2,DFN,.2197)
     220        Q $$GET1^DIQ(2,DFN,.2197)
    221221NOK2ZIP(DFN)    ; NOK2 Zip Code
    222  Q $$GET1^DIQ(2,DFN,.2198)
     222        Q $$GET1^DIQ(2,DFN,.2198)
    223223NOK2HTEL(DFN)   ; NOK2 Home Telephone
    224  Q $$GET1^DIQ(2,DFN,.2199)
     224        Q $$GET1^DIQ(2,DFN,.2199)
    225225NOK2WTEL(DFN)   ; NOK2 Work Telephone
    226  Q $$GET1^DIQ(2,DFN,.211011)
     226        Q $$GET1^DIQ(2,DFN,.211011)
    227227NOK2SAME(DFN)   ; Is NOK2's Address the same the patient?
    228  Q $$GET1^DIQ(2,DFN,.21925)
     228        Q $$GET1^DIQ(2,DFN,.21925)
    229229EMERFAM(DFN)    ; Emergency Contact (EMER) Family Name
    230  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    231  D NAMECOMP^XLFNAME(.NAME)
    232  Q NAME("FAMILY")
     230        N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     231        D NAMECOMP^XLFNAME(.NAME)
     232        Q NAME("FAMILY")
    233233EMERGIV(DFN)    ; EMER Given Name
    234  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    235  D NAMECOMP^XLFNAME(.NAME)
    236  Q NAME("GIVEN")
     234        N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     235        D NAMECOMP^XLFNAME(.NAME)
     236        Q NAME("GIVEN")
    237237EMERMID(DFN)    ; EMER Middle Name
    238  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    239  D NAMECOMP^XLFNAME(.NAME)
    240  Q NAME("MIDDLE")
     238        N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     239        D NAMECOMP^XLFNAME(.NAME)
     240        Q NAME("MIDDLE")
    241241EMERSUF(DFN)    ; EMER Suffi Name
    242  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    243  D NAMECOMP^XLFNAME(.NAME)
    244  Q NAME("SUFFIX")
     242        N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     243        D NAMECOMP^XLFNAME(.NAME)
     244        Q NAME("SUFFIX")
    245245EMERDISP(DFN)   ; EMER Display Name
    246  N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
    247  ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
    248  Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
     246        N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
     247        ; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
     248        Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
    249249EMERREL(DFN)    ; EMER Relationship to the patient
    250  Q $$GET1^DIQ(2,DFN,.331)
     250        Q $$GET1^DIQ(2,DFN,.331)
    251251EMERADD1(DFN)   ; EMER Address 1
    252  Q $$GET1^DIQ(2,DFN,.333)
     252        Q $$GET1^DIQ(2,DFN,.333)
    253253EMERADD2(DFN)   ; EMER Address 2
    254  N ADDLN2,ADDLN3
    255  S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
    256  Q:ADDLN3="" ADDLN2
    257  Q ADDLN2_", "_ADDLN3
     254        N ADDLN2,ADDLN3
     255        S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
     256        Q:ADDLN3="" ADDLN2
     257        Q ADDLN2_", "_ADDLN3
    258258EMERCITY(DFN)   ; EMER City
    259  Q $$GET1^DIQ(2,DFN,.336)
     259        Q $$GET1^DIQ(2,DFN,.336)
    260260EMERSTAT(DFN)   ; EMER State
    261  Q $$GET1^DIQ(2,DFN,.337)
     261        Q $$GET1^DIQ(2,DFN,.337)
    262262EMERZIP(DFN)    ; EMER Zip Code
    263  Q $$GET1^DIQ(2,DFN,.338)
     263        Q $$GET1^DIQ(2,DFN,.338)
    264264EMERHTEL(DFN)   ; EMER Home Telephone
    265  Q $$GET1^DIQ(2,DFN,.339)
     265        Q $$GET1^DIQ(2,DFN,.339)
    266266EMERWTEL(DFN)   ; EMER Work Telephone
    267  Q $$GET1^DIQ(2,DFN,.33011)
     267        Q $$GET1^DIQ(2,DFN,.33011)
    268268EMERSAME(DFN)   ; Is EMER's Address the same the NOK?
    269  Q $$GET1^DIQ(2,DFN,.3305)
     269        Q $$GET1^DIQ(2,DFN,.3305)
  • ccr/trunk/p/C0CENC.m

    r786 r1204  
    1 C0CENC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
    2  ;;1.0;C0C;;May 21, 2010;
    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(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO  XML TEMPLATE
    25  ; ENCXML AND ENCOUT 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(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
    29  K @C0CENC
    30  D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
    31  D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
    32  Q
    33  ;
    34 TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
    35  ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
    36  ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
    37  ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
    38  ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
    39  ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
    40  ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
    41  ;
    42  ;K VISIT,LST,NOTE
    43  I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE
    44  I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE
    45  ; NEED TO ADD START AND END DATES FROM PARAMETERS
    46  N ZI S ZI=""
    47  N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
    48  F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
    49  . N ZDATE
    50  . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
    51  . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
    52  . N ZPRV
    53  . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
    54  . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
    55  . ; ENCOBJECTID - ENCOUNTER OBJECT ID
    56  . ; ENCDATETIME - ENCOUNTER DATE TIME
    57  . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)
    58  . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE
    59  . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4
    60  . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT
    61  . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE
    62  . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM
    63  . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID
    64  . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID
    65  . ; ENCINDTXT - ENCOUNTER INDICATION TEXT
    66  . ; ENCINDCODE - ENCOUNTER INDICATION CODE
    67  . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM
    68  . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID
    69  . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION
    70  . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI
    71  . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME
    72  . S ZRNF("ENCTYPETXT")=""
    73  . S ZRNF("ENCTYPECODE")=""
    74  . S ZRNF("ENCTYPECODESYS")=""
    75  . S ZRNF("ENCDESCTXT")=""
    76  . S ZRNF("ENCDESCCODE")=""
    77  . S ZRNF("ENCDESCCODESYS")=""
    78  . N TYPTXT,TYPCDE,TYPSYS  ; WILL BE UPDATED BY GETTYPE CALL
    79  . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D  ; RETURNS FALSE IF NO TYPE
    80  . . S ZRNF("ENCTYPETXT")=TYPTXT
    81  . . S ZRNF("ENCTYPECODE")=TYPCDE
    82  . . S ZRNF("ENCTYPECODESYS")=TYPSYS
    83  . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE
    84  . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)
    85  . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA
    86  . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"
    87  . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER
    88  . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE
    89  . S ZRNF("ENCINDCODE")=""
    90  . S ZRNF("ENCINDCODESYS")=""
    91  . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER
    92  . S ZRNF("ENCCOMMENTID")=""
    93  . I $G(VISIT(ZI,"TEXT",1))'="" D  ; THERE IS A NOTE
    94  . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE
    95  . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI
    96  . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE
    97  . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE
    98  . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER
    99  . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
    100  . ;S PREVCPT=ZCPT
    101  . ;S PREVDT=ZDATE
    102  N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))
    103  M @ZRIM=@C0CENC@("V")
    104  K VISIT,LST,NOTE
    105  Q
    106  ;
    107 GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE
    108  ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE
    109  ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM
    110  ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE
    111  ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
    112  N ZS,ZC
    113  S ZC="" S ZS=""
    114  S (ZTXT,ZCDE,ZSYS)=""
    115  F  S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC=""  D  ; TRY AND FIND A "99" CPT CODE
    116  . N ZT
    117  . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
    118  . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
    119  I ZS'="" D  ; CODED ENCOUNTER TYPE FOUND
    120  . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
    121  . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
    122  . S ZSYS=""
    123  . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
    124  I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
    125  I ZTXT="" Q 0 ; FAILED
    126  W !,ZTXT
    127  Q 1 ; SUCCESS
    128  ;
    129 ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
    130  ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
    131  ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
    132  ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
    133  N ZK,ZL
    134  S ZK="" S ZL=""
    135  F  S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK=""  D  ; LOOK FOR SOME TEXT TO USE
    136  . N ZT
    137  . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE
    138  . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3)
    139  . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
    140  I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
    141  Q ZL
    142  ;
    143 PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
    144  N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
    145  F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
    146  . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
    147  . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
    148  I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
    149  Q ZRTN
    150  ;
    151 DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
    152  Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
    153  ;
    154 CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
    155  ; CPT^CATEGORY^TEXT
    156  N Z1,Z2,Z3,ZRTN
    157  S Z1=$P(ISTR,U,1)
    158  I Z1="" D  ;
    159  . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
    160  I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
    161  . ;S Z1=$P(ISTR,U,1)
    162  . S Z2=$P(ISTR,U,2)
    163  . S Z3=$P(ISTR,U,3)
    164  . S ZRTN=Z1_U_Z2_U_Z3
    165  E  S ZRTN=""
    166  Q ZRTN
    167  ;
    168 MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML
    169  ;
    170  N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE
    171  K @ZTEMP
    172  N ZBLD
    173  S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA
    174  D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE
    175  N ZINNER
    176  D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER
    177  N ZTMP,ZVAR,ZI
    178  S ZI=""
    179  F  S ZI=$O(@C0CENC@("V",ZI)) Q:ZI=""  D  ;FOR EACH ENCOUNTER
    180  . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML
    181  . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES
    182  . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
    183  . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
    184  D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))
    185  N ZZTMP
    186  D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML
    187  K @ZTEMP,@ZBLD,@C0CENC
    188  Q
    189  
     1C0CENC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 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        ;
     24EXTRACT(ENCXML,DFN,ENCOUT)      ; EXTRACT ENCOUNTERS INTO  XML TEMPLATE
     25        ; ENCXML AND ENCOUT 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(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
     29        K @C0CENC
     30        D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
     31        D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
     32        Q
     33        ;
     34TIUGET(DFN,C0CENC,C0CPRC,C0CNTE)        ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
     35        ; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
     36        ; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
     37        ; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
     38        ; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
     39        ; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
     40        ; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
     41        ;
     42        ;K VISIT,LST,NOTE
     43        I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE
     44        I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE
     45        ; NEED TO ADD START AND END DATES FROM PARAMETERS
     46        N ZI S ZI=""
     47        N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
     48        F  S ZI=$O(VISIT(ZI),-1) Q:ZI=""  D  ; REVERSE TIME ORDER - MOST RECENT FIRST
     49        . N ZDATE
     50        . S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
     51        . S ZPRVARY=$NA(VISIT(ZI,"PRV"))
     52        . N ZPRV
     53        . S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
     54        . ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
     55        . ; ENCOBJECTID - ENCOUNTER OBJECT ID
     56        . ; ENCDATETIME - ENCOUNTER DATE TIME
     57        . ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)
     58        . ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE
     59        . ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4
     60        . ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT
     61        . ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE
     62        . ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM
     63        . ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID
     64        . ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID
     65        . ; ENCINDTXT - ENCOUNTER INDICATION TEXT
     66        . ; ENCINDCODE - ENCOUNTER INDICATION CODE
     67        . ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM
     68        . ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID
     69        . ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION
     70        . S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI
     71        . S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME
     72        . S ZRNF("ENCTYPETXT")=""
     73        . S ZRNF("ENCTYPECODE")=""
     74        . S ZRNF("ENCTYPECODESYS")=""
     75        . S ZRNF("ENCDESCTXT")=""
     76        . S ZRNF("ENCDESCCODE")=""
     77        . S ZRNF("ENCDESCCODESYS")=""
     78        . N TYPTXT,TYPCDE,TYPSYS  ; WILL BE UPDATED BY GETTYPE CALL
     79        . I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D  ; RETURNS FALSE IF NO TYPE
     80        . . S ZRNF("ENCTYPETXT")=TYPTXT
     81        . . S ZRNF("ENCTYPECODE")=TYPCDE
     82        . . S ZRNF("ENCTYPECODESYS")=TYPSYS
     83        . . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE
     84        . . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)
     85        . . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA
     86        . S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"
     87        . S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER
     88        . S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE
     89        . S ZRNF("ENCINDCODE")=""
     90        . S ZRNF("ENCINDCODESYS")=""
     91        . S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER
     92        . S ZRNF("ENCCOMMENTID")=""
     93        . I $G(VISIT(ZI,"TEXT",1))'="" D  ; THERE IS A NOTE
     94        . . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE
     95        . . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI
     96        . . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE
     97        . . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE
     98        . . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER
     99        . D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
     100        . ;S PREVCPT=ZCPT
     101        . ;S PREVDT=ZDATE
     102        N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))
     103        M @ZRIM=@C0CENC@("V")
     104        K VISIT,LST,NOTE
     105        Q
     106        ;
     107GETTYPE(ZARY,ZTXT,ZCDE,ZSYS)    ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE
     108        ; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE
     109        ; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM
     110        ; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE
     111        ; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
     112        N ZS,ZC
     113        S ZC="" S ZS=""
     114        S (ZTXT,ZCDE,ZSYS)=""
     115        F  S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC=""  D  ; TRY AND FIND A "99" CPT CODE
     116        . N ZT
     117        . S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
     118        . I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
     119        I ZS'="" D  ; CODED ENCOUNTER TYPE FOUND
     120        . S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
     121        . S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
     122        . S ZSYS=""
     123        . I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
     124        I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
     125        I ZTXT="" Q 0 ; FAILED
     126        W !,ZTXT
     127        Q 1 ; SUCCESS
     128        ;
     129ANYTXT(ZVST)    ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
     130        ; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
     131        ; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
     132        ; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
     133        N ZK,ZL
     134        S ZK="" S ZL=""
     135        F  S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK=""  D  ; LOOK FOR SOME TEXT TO USE
     136        . N ZT
     137        . S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE
     138        . I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3)
     139        . ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
     140        I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
     141        Q ZL
     142        ;
     143PRV(IARY)       ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
     144        N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
     145        F  S ZI=$O(@IARY@(ZI)) Q:ZI=""  D  ; FOR EACH PRV SEG
     146        . I ZR'="" Q  ;ONLY WANT THE FIRST PRIMARY PROVIDER
     147        . I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
     148        I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
     149        Q ZRTN
     150        ;
     151DATE(ISTR)      ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
     152        Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
     153        ;
     154CPT(ISTR)       ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
     155        ; CPT^CATEGORY^TEXT
     156        N Z1,Z2,Z3,ZRTN
     157        S Z1=$P(ISTR,U,1)
     158        I Z1="" D  ;
     159        . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
     160        I Z1'="" D  ; IF THERE IS A CPT CODE IN THERE
     161        . ;S Z1=$P(ISTR,U,1)
     162        . S Z2=$P(ISTR,U,2)
     163        . S Z3=$P(ISTR,U,3)
     164        . S ZRTN=Z1_U_Z2_U_Z3
     165        E  S ZRTN=""
     166        Q ZRTN
     167        ;
     168MAP(ENCXML,C0CENC,ENCOUT)       ; MAP PROCEDURES XML
     169        ;
     170        N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE
     171        K @ZTEMP
     172        N ZBLD
     173        S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA
     174        D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE
     175        N ZINNER
     176        D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER
     177        N ZTMP,ZVAR,ZI
     178        S ZI=""
     179        F  S ZI=$O(@C0CENC@("V",ZI)) Q:ZI=""  D  ;FOR EACH ENCOUNTER
     180        . S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML
     181        . S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES
     182        . D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
     183        . D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
     184        D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))
     185        N ZZTMP
     186        D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML
     187        K @ZTEMP,@ZBLD,@C0CENC
     188        Q
     189       
  • ccr/trunk/p/C0CEWD.m

    </
    r1060 r1204  
    1 C0CEWD   ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
    2  ;;0.1;CCDCCR;nopatch;noreleasedate
    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  ;
    22 TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN
    23  Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE
    24  ;
    25 STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN
    26  ; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION
    27  ; RETURNS THE TOKEN. ZARY IS PASSED BY NAME
    28  N ZT
    29  S ZT=$$TOKEN ; GET A NEW TOKEN
    30  M ^TMP("C0E","TOKEN",ZT)=@ZARY ;
    31  Q ZT
    32  ;
    33 GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN
    34  ; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1
    35  ; C0ERTN IS PASSED BY NAME
    36  I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D  Q  ; DOESN'T EXIST
    37  . S @C0ERTN="" ; PASS BACK NULL
    38  M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE
    39  I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE
    40  Q
    41  ;
    42 URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL
    43  ; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345"
    44  N token
    45  S token=""
    46  s token=$$getRequestValue^%zewdAPI("token",sessid)
    47  s token=$tr(token,"""") ; strip out quotes
    48  Q token
    49  ;
    50 cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options)
    51  ;
    52  n maxNo,noFound
    53  ;
    54  s maxNo=50
    55  s noFound=0
    56  f  s seedValue=$o(^DPT("B",seedValue)) q:seedValue=""  q:noFound=maxNo  d
    57  . s lastSeedValue=seedValue
    58  . i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
    59  . s optionNo=optionNo+1
    60  . s noFound=noFound+1
    61  . s options(optionNo)=seedValue
    62  QUIT
    63  ;
    64 set1 ;
    65  s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
    66  q
    67  ;
    68 test1(sessid) ;
    69  d setSessionValue^%zewdAPI("testing","ZZ",sessid)
    70  q 0
    71  ;
     1C0CEWD    ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
     2        ;;0.1;CCDCCR;nopatch;noreleasedate;Build 77
     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        ;
     22TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN
     23        Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE
     24        ;
     25STORE(ZARY)     ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN
     26        ; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION
     27        ; RETURNS THE TOKEN. ZARY IS PASSED BY NAME
     28        N ZT
     29        S ZT=$$TOKEN ; GET A NEW TOKEN
     30        M ^TMP("C0E","TOKEN",ZT)=@ZARY ;
     31        Q ZT
     32        ;
     33GET(C0ERTN,C0ETOKEN,NOKILL)     ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN
     34        ; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1
     35        ; C0ERTN IS PASSED BY NAME
     36        I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D  Q  ; DOESN'T EXIST
     37        . S @C0ERTN="" ; PASS BACK NULL
     38        M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE
     39        I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE
     40        Q
     41        ;
     42URLTOKEN(sessid)        ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL