Ignore:
Timestamp:
May 11, 2012, 6:06:25 PM (12 years ago)
Author:
Sam Habiel
Message:

Update of all routines

File:
1 edited

Legend:

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

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