Changeset 1204 for ccr/trunk/p/C0CCCD.m


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

updates for MU Certification

File:
1 edited

Legend:

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

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