Changeset 1337 for ccr


Ignore:
Timestamp:
Jan 4, 2012, 9:40:24 PM (13 years ago)
Author:
George Lilly
Message:

certification version without tabs

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

Legend:

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

    r1333 r1337  
    1 C0CACTOR        ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
    2         ;;1.0;C0C;;May 19, 2009;Build 1
    3         ;Copyright 2008,2009 George Lilly, University of Minnesota.
    4         ;Licensed under the terms of the GNU General Public License.
    5         ;See attached copy of the License.
    6         ;
    7         ; This program is free software; you can redistribute it and/or modify
    8         ; it under the terms of the GNU General Public License as published by
    9         ; the Free Software Foundation; either version 2 of the License, or
    10         ; (at your option) any later version.
    11         ;
    12         ; This program is distributed in the hope that it will be useful,
    13         ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    14         ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15         ; GNU General Public License for more details.
    16         ;
    17         ; You should have received a copy of the GNU General Public License along
    18         ; with this program; if not, write to the Free Software Foundation, Inc.,
    19         ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20         ;
    21         ;  PROCESS THE ACTORS SECTION OF THE CCR
    22         ;
    23         ; ===Revision History===
    24         ; 0.1 Initial Writing of Skeleton--GPL
    25         ; 0.2 Patient Data Extraction--SMH
    26         ; 0.3 Information System Info Extraction--SMH
    27         ; 0.4 Patient data rouine refactored; adjustments here--SMH
    28         ;
    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/branches/ohum/p/C0CALERT.m

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

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

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

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

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

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

    r1333 r1337  
    1 C0CCMT  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
    2         ;;1.0;C0C;;May 21, 2010;Build 1
    3         ;Copyright 2010 George Lilly, University of Minnesota and others.
    4         ;Licensed under the terms of the GNU General Public License.
    5         ;See attached copy of the License.
    6         ;
    7         ;This program is free software; you can redistribute it and/or modify
    8         ;it under the terms of the GNU General Public License as published by
    9         ;the Free Software Foundation; either version 2 of the License, or
    10         ;(at your option) any later version.
    11         ;
    12         ;This program is distributed in the hope that it will be useful,
    13         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    14         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    15         ;GNU General Public License for more details.
    16         ;
    17         ;You should have received a copy of the GNU General Public License along
    18         ;with this program; if not, write to the Free Software Foundation, Inc.,
    19         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
    20         ;
    21         W "NO ENTRY FROM TOP",!
    22         Q
    23         ;
    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/branches/ohum/p/C0CCPT.m

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

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

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