Changeset 1586 for ccr/trunk/p


Ignore:
Timestamp:
Oct 30, 2012, 1:11:02 PM (12 years ago)
Author:
Sam Habiel
Message:

Changed license to AGPL. Some clean-up for XINDEX

Location:
ccr/trunk/p
Files:
79 edited

Legend:

Unmodified
Added
Removed

  • ccr/trunk/p/C0CACTOR.m

    r1544 r1586  
    1 C0CACTOR         ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     1C0CACTOR         ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ; 10/29/12 4:04pm
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    1210        ; This program is distributed in the hope that it will be useful,
    1311        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1412        ; 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.
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        ;  PROCESS THE ACTORS SECTION OF THE CCR

  • ccr/trunk/p/C0CALERT.m

    r1544 r1586  
    1 C0CALERT         ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     1C0CALERT         ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 ; 10/29/12 4:04pm
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    2018        ;
    2119        W "NO ENTRY FROM TOP",!
    … …  
    3028        S GMRA="0^0^111"
    3129        D EN1^GMRADPT
    32         I $G(GMRAL)'=1 D  Q ; NO ALLERGIES FOUND THUS *QUIT*
     30        I $G(GMRAL)'=1 D  Q  ; NO ALLERGIES FOUND THUS *QUIT*
    3331        . S @ALTOUTXML@(0)=0
    3432        ; DEFINE MAPPING

  • ccr/trunk/p/C0CBAT.m

    r1544 r1586  
    11C0CBAT    ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    1918        ;
    2019        W "This is the CCR Batch Utility Library ",!
    … …  
    6362        I $D(@C0CBB@(0)) D  ; ERROR SHOULDN'T EXIST
    6463        . W "WORK AREA ERROR",!
    65         . B
     64        . S $EC=",U1,"
    6665        S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
    6766        S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
    … …  
    164163        Q ZN
    165164        ;
    166 UPDIEVARPTR(ZVAR,ZTYP)  ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
     165UVARPTR(ZVAR,ZTYP)      ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
    167166        ; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
    168167        ; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
    … …  
    190189        D CLEAN^DILF
    191190        D UPDATE^DIE("","C0CFDA","","ZERR")
    192         I $D(ZERR) D  ;
    193         . W "ERROR",!
    194         . ZWR ZERR
    195         . B
     191        I $D(ZERR) S $EC=",U1,"
    196192        K C0CFDA
    197193        Q

  • ccr/trunk/p/C0CCCD.m

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

  • ccr/trunk/p/C0CCCD1.m

    r1544 r1586  
    11C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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                  ;
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
     18        ;
     19        W "This is a CCD TEMPLATE with processing routines",!
     20        W !
     21        Q
     22        ;
    2523ZT(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                  ;
     24        ; ZARY IS PASSED BY NAME
     25        ; BAT is a string identifying the section
     26        ; LINE is a test which will evaluate to true or false
     27        ; I '$G(@ZARY) D  ; IF ZARY DOES NOT EXIST '
     28        ; . S @ZARY@(0)=0 ; initially there are no elements
     29        ; . W "GOT HERE LOADING "_LINE,!
     30        N CNT ; count of array elements
     31        S CNT=@ZARY@(0) ; contains array count
     32        S CNT=CNT+1 ; increment count
     33        S @ZARY@(CNT)=LINE ; put the line in the array
     34        ; S @ZARY@(BAT,CNT)="" ; index the test by battery
     35        S @ZARY@(0)=CNT ; update the array counter
     36        Q
     37        ;
    4038ZLOAD(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                  ;
     39        ; ZARY IS PASSED BY NAME
     40        ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
     41        ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
     42        K @ZARY S @ZARY=""
     43        S @ZARY@(0)=0 ; initialize array count
     44        N LINE,LABEL,BODY
     45        N INTEST S INTEST=0 ; switch for in the TEMPLATE section
     46        N SECTION S SECTION="[anonymous]" ; NO section LABEL
     47        ;
     48        N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
     49        . I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
     50        . I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
     51        . I INTEST  D  ; within the section
     52        . . I LINE?." "1";><".E  D  ; sub-section name found
     53        . . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
     54        . . I LINE?." "1";;".E  D  ; line found
     55        . . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
     56        Q
     57        ;
    6058LOAD(ARY)       ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
    61                  D ZLOAD(ARY,"C0CCCD1")
    62                  ; ZWR @ARY
    63                  Q
    64                  ;
     59        D ZLOAD(ARY,"C0CCCD1")
     60        ; ZWR @ARY
     61        Q
     62        ;
    6563TRMCCD     ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
    66                  Q
     64        Q
    6765MARKUP  ;<MARKUP>
    6866        ;;<Body>

  • ccr/trunk/p/C0CCCR.m

    r1544 r1586  
    11C0CCCR    ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        ; EXPORT A CCR
    … …  
    288285        ;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
    289286        ;;>>?@C0C@(@C0C@(0))["</Alerts>"
    290        
    291        

  • ccr/trunk/p/C0CCCR0.m

    r1544 r1586  
    11C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        W "This is a CCR TEMPLATE with processing routines",!

  • ccr/trunk/p/C0CCMT.m

    r1544 r1586  
    11C0CCMT   ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    2018        ;
    2119        W "NO ENTRY FROM TOP",!

  • ccr/trunk/p/C0CCPT.m

    r1544 r1586  
    11C0CCPT  ;;BSL;RETURN CPT DATA;
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Sequence Managers Software GPL;;;;;Build 2
    4         ;Copied into C0C namespace from SQMCPT with permission from
    5         ;Brian Lord - and with our thanks. gpl 01/20/2010
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; (C) George Lilly 2010
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    618ENTRY(DFN,STDT,ENDDT,TXT)       ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
    719        ;DFN=PATIENT IEN
    … …  
    1022        ;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
    1123        ;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
    12                ;ALL INCLUSIVE IN THAT DIRECTION
    13                ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
    14                ;BUILD INTO NOTE(Y)=""
    15                S U="^",X=""
    16                F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
    17                . S Y=""
    18                . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
    19                .. S NOTE(Y)=""
    20                ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
    21                ;GET DATE OF NOTE
     24        ;ALL INCLUSIVE IN THAT DIRECTION
     25        ;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
     26        ;BUILD INTO NOTE(Y)=""
     27        S U="^",X=""
     28        F  S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X=""  D
     29        . S Y=""
     30        . F  S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y=""  D
     31        .. S NOTE(Y)=""
     32        ;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
     33        ;GET DATE OF NOTE
    2234        ;RUT 3120109 Changing DATE in FILMAN's FORMAT
    23         ;;OHUM/RUT 3111228 Date Range for Notes
    24                ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
     35        ;OHUM/RUT 3111228 Date Range for Notes
     36        ;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
    2537        N FLAGS1,FLAGS2
    2638        S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1)
    2739        S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2)
    2840        ;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART")
    29                ;;OHUM/RUT
     41        ;OHUM/RUT
    3042        ;RUT
    31                S Z=""
    32                F  S Z=$O(NOTE(Z)) Q:Z=""  D
    33                . S DT=$P(^TIU(8925,Z,0),U,7)
    34                . I $G(STDT)]"" D
    35                .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
    36                . I $G(ENDDT)]"" D
    37                .. I ENDDT<DT S NOTE(Z)="D"
    38                . I NOTE(Z)="D" K NOTE(Z)
     43        S Z=""
     44        F  S Z=$O(NOTE(Z)) Q:Z=""  D
     45        . S DT=$P(^TIU(8925,Z,0),U,7)
     46        . I $G(STDT)]"" D
     47        .. I STDT>DT S NOTE(Z)="D"  ;SET NOTE TO BE DELETED
     48        . I $G(ENDDT)]"" D
     49        .. I ENDDT<DT S NOTE(Z)="D"
     50        . I NOTE(Z)="D" K NOTE(Z)
    3951        D VISIT
    40                Q
     52        Q
    4153VISIT     ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
    4254        S ILST=1,X0="",X12="",VISIT="",LST="",X811=""

  • ccr/trunk/p/C0CDIC.m

    r1544 r1586  
    11C0CDIC    ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 WorldVistA. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is the CCR Dictionary Utility Library ",!

  • ccr/trunk/p/C0CDOM.m

    r1544 r1586  
    1 C0CDOM   ; GPL - DOM PROCESSING ROUTINES ;6/6/11  17:05
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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
     1C0CDOM    ; GPL - DOM PROCESSING ROUTINES ;6/6/11  17:05
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2011 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
     18        ;
     19        Q
     20        ;
     21DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
    2322        ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    2423        ; THE XPATH ARRAY XPARY, PASSED BY NAME
    … …  
    8281        Q
    8382        ;
    84 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
     83PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    8584        ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    8685        ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    … …  
    8887        Q $$EN^MXMLDOM(INXML,"W")
    8988        ;
    90 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
     89ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    9190        N ZN
    9291        ;I $$TAG(ZOID)["entry" B
    … …  
    9594        Q 0
    9695        ;
    97 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
     96FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    9897        Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
    9998        ;
    100 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
     99PARENT(ZOID)    ;RETURNS THE OID OF THE PARENT OF ZOID
    101100        Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
    102101        ;
    103 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
     102ATT(RTN,NODE)   ;GET ATTRIBUTES FOR ZOID
    104103        S HANDLE=C0CDOCID
    105104        K @RTN
    … …  
    107106        Q
    108107        ;
    109 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
     108TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
    110109        ;I ZOID=149 B ;GPLTEST
    111110        N X,Y
    … …  
    116115        Q Y
    117116        ;
    118 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
     117NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
    119118        Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
    120119        ;
    121 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
     120DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
    122121        ;N ZT,ZN S ZT=""
    123122        ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    … …  
    126125        Q
    127126        ;
    128 OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
     127OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    129128        ;
    130129        S C0CDOCID=INID
    … …  
    137136        Q
    138137        ;
    139 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
     138NDOUT(ZOID)     ;CALLBACK ROUTINE - IT IS RECURSIVE
    140139        N ZI S ZI=$$FIRST(ZOID)
    141140        I ZI'=0 D  ; THERE IS A CHILD

  • ccr/trunk/p/C0CDPT.m

    r1544 r1586  
    11C0CDPT  ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;
    4         ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    5         ; General Public License.
    6         ;
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; Copyright 2008 WorldVistA. 
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (at your option) any later version.
     10        ;
    711        ; This program is distributed in the hope that it will be useful,
    812        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    913        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    10         ; GNU General Public License for more details.
    11         ; 
    12         ; You should have received a copy of the GNU General Public License along
    13         ; with this program; if not, write to the Free Software Foundation, Inc.,
    14         ; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     14        ; GNU Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     18        ;
    1519        ;
    1620        ; FAMILY       Family Name

  • ccr/trunk/p/C0CENC.m

    r1544 r1586  
    11C0CENC   ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        W "NO ENTRY FROM TOP",!
    … …  
    155152        ; CPT^CATEGORY^TEXT
    156153        N Z1,Z2,Z3,ZRTN
    157         S Z1=$P(ISTR,U,1) 
     154        S Z1=$P(ISTR,U,1)
    158155        I Z1="" D  ;
    159156        . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)

  • ccr/trunk/p/C0CENV.m

    r1544 r1586  
    11C0CENV  ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; (C) John McCormack 2009
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    318        ;
    419        ;

  • ccr/trunk/p/C0CEVC.m

    r1544 r1586  
    1 C0CEVC   ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     1C0CEVC    ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; (C) Geroge Lilly 2010.
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     18        ;
    319gpltest2        ; experiment with sending a CCR to an ewd page
    420        N ZI

  • ccr/trunk/p/C0CEWD.m

    r1544 r1586  
    11C0CEWD    ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2011 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    53        ;
    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.
     4        ;Copyright 2011 George Lilly. 
    105        ;
    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.
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (at your option) any later version.
    1510        ;
    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.
     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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1918        ;
    2019        Q

  • ccr/trunk/p/C0CEWD1.m

    r1544 r1586  
    11C0CEWD1   ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    53        ;
    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.
     4        ; This program is free software: you can redistribute it and/or modify
     5        ; it under the terms of the GNU Affero General Public License as
     6        ; published by the Free Software Foundation, either version 3 of the
     7        ; License, or (at your option) any later version.
    108        ;
    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.
     9        ; This program is distributed in the hope that it will be useful,
     10        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     11        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12        ; GNU Affero General Public License for more details.
    1513        ;
    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.
     14        ; You should have received a copy of the GNU Affero General Public License
     15        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1916        ;
    2017        Q

  • ccr/trunk/p/C0CFM1.m

    r1544 r1586  
    11C0CFM1    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    1918        ;
    2019        W "This is the CCR FILEMAN Utility Library ",!
    … …  
    6968        K ZERR
    7069        D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
    71         I $D(ZERR) B  ;OOPS
     70        I $D(ZERR) S $EC=",U1,"
    7271        K C0CFDA
    7372        S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))

  • ccr/trunk/p/C0CFM2.m

    r1544 r1586  
    11C0CFM2    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    1918        ;
    2019        W "This is the CCR FILEMAN Utility Library ",!
    … …  
    149148        D CLEAN^DILF
    150149        D UPDATE^DIE("","C0CFDA","","ZERR")
    151         I $D(ZERR) D  ;
    152         . W "ERROR",!
    153         . ZWR ZERR
    154         . B
     150        I $D(ZERR) S $EC=",U1,"
    155151        K C0CFDA
    156152        Q
    … …  
    183179        . . W ZCHK,!
    184180        . . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
    185         ZWR ^TMP("C0CCHK",ZPAT,*)
     181        ; ZWR ^TMP("C0CCHK",ZPAT,*)
    186182        Q
    187183        ;
    … …  
    224220        Q
    225221        ;
    226 PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
     222PUTELSO(DFN,ZTYPE,ZOCC,ZVALS)   ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
    227223        ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
    228224        ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
    … …  
    249245        ;B
    250246        D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
    251         I $D(ZERR) B  ;OOPS
     247        I $D(ZERR) S $EC=",U1,"
    252248        K C0CFDA
    253249        S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
    254250        W "RECORD NUMBER: ",ZD0,!
    255         ;B
    256251        S ZCNT=0
    257252        S ZC0CI="" ;
    … …  
    271266        D CLEAN^DILF
    272267        D UPDATE^DIE("","C0CFDA","","ZERR")
    273         I $D(ZERR) D  ;
    274         . W "ERROR",!
    275         . ZWR ZERR
    276         . B
     268        I $D(ZERR) S $EC=",U1,"
    277269        K C0CFDA
    278270        Q

  • ccr/trunk/p/C0CFM3.m

    r1544 r1586  
    11C0CFM3    ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly.
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    1918        ;
    2019        W "This is the CCR FILEMAN Utility Library ",!
    … …  
    135134        D CLEAN^DILF
    136135        D UPDATE^DIE("","C0CFDA","","ZERR")
    137         I $D(ZERR) D  ;
    138         . W "ERROR",!
    139         . ZWR ZERR
    140         . B
    141         K C0CFDA
    142         Q
    143         ;
    144 PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
     136        I $D(ZERR) S $EC=",U1,"
     137        K C0CFDA
     138        Q
     139        ;
     140PUTELSO(DFN,ZTYPE,ZOCC,ZVALS)   ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
    145141        ; 171.101, ^C0CE  DFN IS THE PATIENT IEN PASSED BY VALUE
    146142        ; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
    … …  
    167163        ;B
    168164        D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
    169         I $D(ZERR) B  ;OOPS
     165        I $D(ZERR) S $EC=",U1,"
    170166        K C0CFDA
    171167        S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
    … …  
    189185        D CLEAN^DILF
    190186        D UPDATE^DIE("","C0CFDA","","ZERR")
    191         I $D(ZERR) D  ;
    192         . W "ERROR",!
    193         . ZWR ZERR
    194         . B
     187        I $D(ZERR) S $EC=",U1,"
    195188        K C0CFDA
    196189        Q
    … …  
    283276        N ZG
    284277        S ZG=""
    285         F  S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG=""  D  ZWR ^C0CE4(ZG,*)
    286         Q
    287         ;
     278        F  S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG=""  D
     279        . ; ZWR ^C0CE4(ZG,*)
     280        Q
     281        ;

  • ccr/trunk/p/C0CIM2.m

    r1544 r1586  
    11C0CIM2   ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        W "NO ENTRY FROM TOP",!

  • ccr/trunk/p/C0CIMMU.m

    r1544 r1586  
    11C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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         ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2117        ;
    2218        ; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR

  • ccr/trunk/p/C0CIN.m

    r1544 r1586  
    11C0CIN     ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is the CCR Import Utility Library ",!
    … …  
    185183        D CLEAN^DILF
    186184        D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
    187         I $D(ZERR) D  ;
    188         . W "ERROR",!
    189         . ZWR ZERR
    190         . B
     185        I $D(ZERR) S $EC=",U1,"
    191186        K C0CFDA
    192187        Q

  • ccr/trunk/p/C0CLA7DD.m

    r1544 r1586  
    1 C0CLA7DD        ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3  ;
     1C0CLA7DD        ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 ; 10/30/12 10:16am
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; (C) 2009 John McCormack
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    418        ; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file.
    5  ;
     19        ;
    620        Q
    721        ;
    … …  
    249263        ;
    250264        ;
    251 SENDXQA(MSG) ; Send alert for reindex status
    252  ;
    253  N XQA,XQAMSG
    254  ;
    255  S XQA(DUZ)=""
    256  S XQAMSG=MSG
    257  D SETUP^XQALERT
    258  ;
    259  Q
     265SENDXQA(MSG)    ; Send alert for reindex status
     266        ;
     267        N XQA,XQAMSG
     268        ;
     269        S XQA(DUZ)=""
     270        S XQAMSG=MSG
     271        D SETUP^XQALERT
     272        ;
     273        Q

  • ccr/trunk/p/C0CLA7Q.m

    r1544 r1586  
    1 C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     1C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 ; 10/30/12 10:16am
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; (C) 2009 John McCormack
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    318        ;
    419        ;

  • ccr/trunk/p/C0CLABS.m

    r1544 r1586  
    11C0CLABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ; 5/10/12 2:49pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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                   ;
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    2118MAP(MIXML,DFN,MOXML)    ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
    2219        ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
    … …  
    6461        I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
    6562        . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
    66         I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
     63        I @C0CV@(0)=0 S RTN(0)=0 Q  ; NO RESULTS
    6764        S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
    6865        K @RIMVARS
    … …  
    107104        . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
    108105        . ;I C0CI=1 D  ; FIRST TIME, COPY INSTEAD OF INSERT
    109         . . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;
     106        . ;. D CP^C0CXPATH(C0CRTMP,"RTN") ;
    110107        . ;E  D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
    111108        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>

  • ccr/trunk/p/C0CMAIL.m

    r1544 r1586  
    1 C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
    2 V       ;;1.2;C0C;;May 11, 2012;Build 47
     1C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
     2V       ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;Copyright 2011 Chris Richardson, Richardson Computer Research
    44        ; Modified 3110516@1818
    55        ;   rcr@rcresearch.us
    6         ;  Licensed under the terms of the GNU
    7         ;General Public License See attached copy of the License.
    8         ;
    9         ;This program is free software; you can redistribute it and/or modify
    10         ;it under the terms of the GNU General Public License as published by
    11         ;the Free Software Foundation; either version 2 of the License, or
    12         ;(at your option) any later version.
    13         ;
    14         ;This program is distributed in the hope that it will be useful,
    15         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    16         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    17         ;GNU General Public License for more details.
    18         ;
    19         ;You should have received a copy of the GNU General Public License along
    20         ;with this program; if not, write to the Free Software Foundation, Inc.,
    21         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     6        ;
     7        ; This program is free software: you can redistribute it and/or modify
     8        ; it under the terms of the GNU Affero General Public License as
     9        ; published by the Free Software Foundation, either version 3 of the
     10        ; License, or (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 Affero General Public License for more details.
     16        ;
     17        ; You should have received a copy of the GNU Affero General Public License
     18        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2219        ;
    2320        ;  ------------------

  • ccr/trunk/p/C0CMAIL2.m

    r1544 r1586  
    11C0CMAIL2        ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr  ; 5/10/12 2:50pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;Copyright 2011 Chris Richardson, Richardson Computer Research
    44        ; Modified 3110615@1040
    55        ;   rcr@rcresearch.us
    6         ;  Licensed under the terms of the GNU
    7         ;General Public License See attached copy of the License.
    8         ;
    9         ;This program is free software; you can redistribute it and/or modify
    10         ;it under the terms of the GNU General Public License as published by
    11         ;the Free Software Foundation; either version 2 of the License, or
    12         ;(at your option) any later version.
    13         ;
    14         ;This program is distributed in the hope that it will be useful,
    15         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    16         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    17         ;GNU General Public License for more details.
    18         ;
    19         ;You should have received a copy of the GNU General Public License along
    20         ;with this program; if not, write to the Free Software Foundation, Inc.,
    21         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     6        ;
     7        ; This program is free software: you can redistribute it and/or modify
     8        ; it under the terms of the GNU Affero General Public License as
     9        ; published by the Free Software Foundation, either version 3 of the
     10        ; License, or (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 Affero General Public License for more details.
     16        ;
     17        ; You should have received a copy of the GNU Affero General Public License
     18        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2219        ;
    2320        ;  ------------------

  • ccr/trunk/p/C0CMAIL3.m

    r1544 r1586  
    11C0CMAIL3        ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr   ; 5/10/12 2:51pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;Copyright 2011 Chris Richardson, Richardson Computer Research
    44        ; Modified 3110619@2038
    55        ;   rcr@rcresearch.us
    6         ;  Licensed under the terms of the GNU
    7         ;General Public License See attached copy of the License.
    8         ;
    9         ;This program is free software; you can redistribute it and/or modify
    10         ;it under the terms of the GNU General Public License as published by
    11         ;the Free Software Foundation; either version 2 of the License, or
    12         ;(at your option) any later version.
    13         ;
    14         ;This program is distributed in the hope that it will be useful,
    15         ;but WITHOUT ANY WARRANTY; without even the implied warranty of
    16         ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    17         ;GNU General Public License for more details.
    18         ;
    19         ;You should have received a copy of the GNU General Public License along
    20         ;with this program; if not, write to the Free Software Foundation, Inc.,
    21         ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
     6        ;
     7        ; This program is free software: you can redistribute it and/or modify
     8        ; it under the terms of the GNU Affero General Public License as
     9        ; published by the Free Software Foundation, either version 3 of the
     10        ; License, or (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 Affero General Public License for more details.
     16        ;
     17        ; You should have received a copy of the GNU Affero General Public License
     18        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2219        ;
    2320        ;  ------------------

  • ccr/trunk/p/C0CMCCD.m

    r1544 r1586  
    1 C0CMCCD   ; GPL - MXML based CCD utilities;12/04/09  17:05
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     1C0CMCCD   ; GPL - MXML based CCD utilities;12/04/09  17:05
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        Q
    … …  
    281279        Q
    282280        ;
    283 UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
     281UPDIE   ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
    284282        K ZERR
    285283        D CLEAN^DILF
    286284        D UPDATE^DIE("","C0CFDA","","ZERR")
    287         I $D(ZERR) D  ;
    288         . W "ERROR",!
    289         . ZWR ZERR
    290         . B
     285        I $D(ZERR) S $EC=",U1,"
    291286        K C0CFDA
    292287        Q

  • ccr/trunk/p/C0CMED.m

    r1544 r1586  
    11C0CMED  ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
    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         ;
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
    1210        ; This program is distributed in the hope that it will be useful,
    1311        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1412        ; 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.
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    2018        ;
    2119        ; --Revision History
    … …  
    5351        I $$RPMS^C0CUTIL() D RPMS QUIT
    5452        I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
    55 RPMS   
     53RPMS    ;
    5654        ;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
    5755        N MEDCOUNT S MEDCOUNT=0
    … …  
    6260        D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
    6361        D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
    64         I @HIST@(0)>0 D 
     62        I @HIST@(0)>0 D
    6563        . D CP^C0CXPATH(HIST,MEDOUTXML)
    6664        . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
    67         I @NVA@(0)>0 D 
    68         . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
     65        I @NVA@(0)>0 D
     66        . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
    6967        . ;E  D CP^C0CXPATH(NVA,MEDOUTXML)
    7068        . W:$G(DEBUG) "HAS NON-VA MEDS",!
    7169        Q
    72 VISTA   
     70VISTA   ;
    7371        N MEDCOUNT S MEDCOUNT=0
    7472        K ^TMP($J,"MED")
    … …  
    8886        D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
    8987        D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
    90         I @HIST@(0)>0 D 
     88        I @HIST@(0)>0 D
    9189        . D CP^C0CXPATH(HIST,MEDOUTXML)
    9290        . W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
    93         I @PEND@(0)>0 D 
     91        I @PEND@(0)>0 D
    9492        . I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
    9593        . E  D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
    9694        . W:$G(DEBUG) "HAS OP PENDING MEDS",!
    97         I @NVA@(0)>0 D 
    98         . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA) 
    99         . E  D CP^C0CXPATH(NVA,MEDOUTXML) 
     95        I @NVA@(0)>0 D
     96        . I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
     97        . E  D CP^C0CXPATH(NVA,MEDOUTXML)
    10098        . W:$G(DEBUG) "HAS NON-VA MEDS",!
    101         I @IPUD@(0)>0 D 
    102         . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD) 
    103         . E  D CP^C0CXPATH(IPUD,MEDOUTXML) 
     99        I @IPUD@(0)>0 D
     100        . I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD)
     101        . E  D CP^C0CXPATH(IPUD,MEDOUTXML)
    104102        . W:$G(DEBUG) "HAS INPATIENT MEDS",!
    105103        N ZI
    … …  
    112110        K @IPUD
    113111        Q
    114        

  • ccr/trunk/p/C0CMED1.m

    r1544 r1586  
    11C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;;Last modified Sat Jan 10 21:42:27 PST 2009
    4         ; Copyright 2009 WorldVistA.  Licensed under the terms of the GNU
    5         ; General Public License 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.
     4        ; Copyright 2009 WorldVistA. 
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (at your option) any later version.
    1110        ;
    1211        ; This program is distributed in the hope that it will be useful,
    1312        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1413        ; 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.
     14        ; GNU Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2018        ;
    2119        W "NO ENTRY FROM TOP",!
    … …  
    5856        ; If it is -1, we quit.
    5957        I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q
    60         ZWRITE:$G(DEBUG) MEDS
     58        ; ZWRITE:$G(DEBUG) MEDS
    6159        N RXIEN S RXIEN=0
    6260        F  S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)=""  D  ; FOR EACH MEDICATION IN THE LIST
    6361        . N MED M MED=MEDS(RXIEN)
    6462        . I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
    65         . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
     63        . I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT  ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
    6664        . S MEDCOUNT=MEDCOUNT+1
    6765        . W:$G(DEBUG) "RXIEN IS ",RXIEN,!

  • ccr/trunk/p/C0CMED2.m

    r1544 r1586  
    11C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;;Last Modified Sat Jan 10 21:41:14 PST 2009
    4         ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    5         ; General Public License 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.
     4        ; Copyright 2008 WorldVistA. 
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (at your option) any later version.
    1110        ;
    1211        ; This program is distributed in the hope that it will be useful,
    1312        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1413        ; 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.
     14        ; GNU Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2018        ;
    2119        W "NO ENTRY FROM TOP",!
    … …  
    4846        ; If it is -1, we quit.
    4947        I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
    50         ZWRITE:$G(DEBUG) MEDS
     48        ; ZWRITE:$G(DEBUG) MEDS
    5149        N RXIEN S RXIEN=0
    5250        N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING

  • ccr/trunk/p/C0CMED3.m

    r1544 r1586  
    11C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
    4         ; Copyright 2009 WorldVistA.  Licensed under the terms of the GNU
    5         ; General Public License 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.
     4        ; Copyright 2009 WorldVistA. 
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (at your option) any later version.
    1110        ;
    1211        ; This program is distributed in the hope that it will be useful,
    1312        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1413        ; 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.
     14        ; GNU Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2018        ;
    2119        W "NO ENTRY FROM TOP",!
    … …  
    4947        K NVA
    5048        ;
    51         I DEBUG ZWRITE MEDS
     49        ; I DEBUG ZWRITE MEDS
    5250        N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
    5351        N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE

  • ccr/trunk/p/C0CMED4.m

    r1544 r1586  
    11C0CMED4         ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:38pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ; Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    4         ; General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; Copyright 2008 WorldVistA. 
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    1110        ; This program is distributed in the hope that it will be useful,
    1211        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1312        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    14         ; GNU General Public License for more details.
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "NO ENTRY FROM TOP",!
    … …  
    4947        ; Otherwise, we go on...
    5048        M MEDS=^TMP($J,"UD")
    51         I DEBUG ZWR MEDS
    52         S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP")) 
     49        ; I DEBUG ZWR MEDS
     50        S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
    5351        N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
    54         N I S I=0 
     52        N I S I=0
    5553        F  S I=$O(MEDS("B",I)) Q:'I  D  ; For each medication in B index
    5654        . N MED M MED=MEDS(I)
    … …  
    6159        . I DEBUG W "RXIEN IS ",RXIEN,!
    6260        . I DEBUG W "MAP= ",MAP,!
    63         . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
     61        . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
    6462        . S @MAP@("MEDISSUEDATETXT")="Order Date"
    6563        . S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
    … …  
    7068        . S @MAP@("MEDTYPETEXT")="Medication"
    7169        . S @MAP@("MEDDETAILUNADORNED")=""  ; Leave blank, field has its uses
    72         . S @MAP@("MEDSTATUSTEXT")="ACTIVE" 
     70        . S @MAP@("MEDSTATUSTEXT")="ACTIVE"
    7371        . S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
    7472        . S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
    … …  
    114112        . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
    115113        . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
    116           E  S @MAP@("MEDQUANTITYUNIT")=""
     114        . E  S @MAP@("MEDQUANTITYUNIT")=""
    117115        . ;
    118116        . ; --- START OF DIRECTIONS ---
    … …  
    126124        . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
    127125        . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
    128         . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 
    129         . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 
    130         . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 
     126        . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
     127        . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
     128        . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
    131129        . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
    132130        . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
    … …  
    143141        . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
    144142        . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
    145         . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
     143        . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
    146144        . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
    147145        . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""

  • ccr/trunk/p/C0CMED6.m

    r1544 r1586  
    11C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; Copyright 2008 WorldVistA. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    1110        ; This program is distributed in the hope that it will be useful,
    1211        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1312        ; 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.
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "NO ENTRY FROM TOP",!
    … …  
    5553        ; If MEDS1 is not defined, then no meds
    5654        I '$D(MEDS1) QUIT
    57         I DEBUG ZWR MEDS1,MINXML
     55        ;I DEBUG ZWR MEDS1,MINXML
    5856        N MEDCNT S MEDCNT=0 ; Med Count
    5957        ; The next line is a super line. It goes through the array return
    … …  
    229227        . . N INTERVAL S INTERVAL="" ; Default
    230228        . . ; If there are entries found, get it
    231         . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2) 
     229        . . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2)
    232230        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
    233231        . . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
    … …  
    265263        . ; -- 1. Med Patient Instructions
    266264        . N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
    267         . N MEDPTIN2,J  S (MEDPTIN2,J)="" 
     265        . N MEDPTIN2,J  S (MEDPTIN2,J)=""
    268266        . I $L(MEDPTIN1) F  S J=$O(@MEDPTIN1@(J)) Q:J=""  Q:$L(MEDPTIN2)>10000  S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
    269267        . S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
    … …  
    312310        N RXNORM,C0CZRXN,DIERR
    313311        D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
    314         I $D(DIERR) D ^%ZTER BREAK
     312        I $D(DIERR) S $EC=",U1,"
    315313        S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
    316314        N I S I=0
    … …  
    329327        . . E  S RXNORM=RXNORM(I) QUIT  ; We found the right code
    330328        QUIT +$G(RXNORM)  ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
    331        

  • ccr/trunk/p/C0CMIME.m

    r1544 r1586  
    11C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2008 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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        Q
    … …  
    4543        Q
    4644        ; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN
    47 ENCODEOLD(IARY,LRNODE,LRSTR)    ; Encode a string, keep remainder for next line
     45ENCODEO(IARY,LRNODE,LRSTR)      ; Encode a string, keep remainder for next line
    4846        ; Call with LRSTR by reference, Remainder returned in LRSTR
    4947        ; IARY IS PASSED BY NAME
    … …  
    7068        S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
    7169        D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH)
    72         ZWR GR
    73         Q
    74         ;
    75 TESTMAIL2       ;
     70        ; ZWR GR
     71        Q
     72        ;
     73TESTMAI2        ;
    7674        ; TEST OF MAILSEND TO gpl.mdc-crew.net
    7775        N C0CGM
    … …  
    8583        ;S ZTO("george@nhin.openforum.opensourcevista.net")=""
    8684        ;S ZTO("mish@nhin.openforum.opensourcevista.net")=""
    87         S ZTO("brooks.richard@securemail.opensourcevista.net")="" 
     85        S ZTO("brooks.richard@securemail.opensourcevista.net")=""
    8886        ;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
    8987        ;S ZTO("ncoal@live.com")=""
    … …  
    9997        S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
    10098        D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")
    101         ZWR GR
     99        ; ZWR GR
    102100        Q
    103101        ;
    … …  
    203201        Q
    204202        ;
    205 MAILSEND0(LRMSUBJ)      ; Send extract back to requestor.
     203MAILSEN0(LRMSUBJ)       ; Send extract back to requestor.
    206204        ;
    207205        ;D TEST
    … …  
    251249        Q
    252250        ;
    253 MAILSEND2(UDFN,ADDR)    ; Send extract back to requestor.
     251MAILSEN2(UDFN,ADDR)     ; Send extract back to requestor.
    254252        ;
    255253        I +$G(UDFN)=0 S UDFN=2 ;

  • ccr/trunk/p/C0CMXML.m

    r1544 r1586  
    11C0CMXML   ; GPL - MXML based XPath utilities;10/13/09  17:05
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        Q
    … …  
    4543        Q
    4644        ;
    47 TEST3   
     45TEST3   ;
    4846        S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
    4947        K GARY,GTMP,GIDX
    … …  
    114112        D END^C0CMXMLB ;END THE DOCUMENT
    115113        M ZCCR=^TMP("MXMLBLD",$J)
    116         ZWR ZCCR
     114        ; ZWR ZCCR
    117115        Q
    118116        ;
    … …  
    137135        ;D END^C0CMXMLB ;EOND THE DOCUMENT
    138136        ;M ZCCD=^TMP("MXMLBLD",$J)
    139         ZWR ZCCD(1:30)
     137        ; ZWR ZCCD(1:30)
    140138        Q
    141139        ;
    … …  
    246244        D CLEAN^DILF
    247245        D UPDATE^DIE("","C0CFDA","","ZERR")
    248         I $D(ZERR) D  ;
    249         . W "ERROR",!
    250         . ZWR ZERR
    251         . B
     246        I $D(ZERR) S $EC=",U1,"
    252247        K C0CFDA
    253248        Q

  • ccr/trunk/p/C0CMXMLB.m

    r1544 r1586  
    11C0CMXMLB        ;;ISF/RWF - Tool to build XML ; 5/10/12 2:51pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        QUIT
     4        ;
     5        ; FOIA Routine - Public Domain
    46        ;
    57        ;DOC - The top level tag
    … …  
    1012        S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
    1113        I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
    12         I $G(NO1ST)'=1 D OUTPUT($$XMLHDR) 
     14        I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
    1315        D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
    1416        Q

  • ccr/trunk/p/C0CMXP.m

    r1544 r1586  
    11C0CMXP    ; GPL - MXML based XPath utilities;12/04/09  17:05
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        Q
    … …  
    167165        S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
    168166        K @C0CXLOC
    169         S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID)) 
     167        S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    170168        ;N GIDX,GIDX2,GARY,GARY2
    171169        I '$D(REDUX) S REDUX=""
    … …  
    284282        D CLEAN^DILF
    285283        D UPDATE^DIE("","C0CFDA","","ZERR")
    286         I $D(ZERR) D  ;
    287         . W "ERROR",!
    288         . ZWR ZERR
    289         . B
     284        I $D(ZERR) S $EC=",U1,"
    290285        K C0CFDA
    291286        Q

  • ccr/trunk/p/C0CNHIN.m

    r1544 r1586  
    1 C0CNHIN   ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11  17:05
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     1C0CNHIN   ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11  17:05
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2011 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        Q
    … …  
    146144        Q
    147145        ;
    148 DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
     146DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
    149147        ; THE XPATH INDEX ZXIDX, PASSED BY NAME
    150148        ; THE XPATH ARRAY XPARY, PASSED BY NAME
    … …  
    205203        Q
    206204        ;
    207 PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
     205PARSE(INXML,INDOC)      ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
    208206        ; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
    209207        ; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
    … …  
    211209        Q $$EN^MXMLDOM(INXML,"W")
    212210        ;
    213 ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
     211ISMULT(ZOID)    ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
    214212        N ZN
    215213        ;I $$TAG(ZOID)["entry" B
    … …  
    218216        Q 0
    219217        ;
    220 FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
     218FIRST(ZOID)     ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
    221219        Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
    222220        ;
    223 PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
     221PARENT(ZOID)    ;RETURNS THE OID OF THE PARENT OF ZOID
    224222        Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
    225223        ;
    226 ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
     224ATT(RTN,NODE)   ;GET ATTRIBUTES FOR ZOID
    227225        S HANDLE=C0CDOCID
    228226        K @RTN
    … …  
    230228        Q
    231229        ;
    232 TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
     230TAG(ZOID)       ; RETURNS THE XML TAG FOR THE NODE
    233231        ;I ZOID=149 B ;GPLTEST
    234232        N X,Y
    … …  
    239237        Q Y
    240238        ;
    241 NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
     239NXTSIB(ZOID)    ; RETURNS THE NEXT SIBLING
    242240        Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
    243241        ;
    244 DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
     242DATA(ZT,ZOID)   ; RETURNS DATA FOR THE NODE
    245243        ;N ZT,ZN S ZT=""
    246244        ;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
    … …  
    249247        Q
    250248        ;
    251 OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
     249OUTXML(ZRTN,INID)       ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
    252250        ;
    253251        S C0CDOCID=INID
    … …  
    259257        Q
    260258        ;
    261 NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
     259NDOUT(ZOID)     ;CALLBACK ROUTINE - IT IS RECURSIVE
    262260        N ZI S ZI=$$FIRST(ZOID)
    263261        I ZI'=0 D  ; THERE IS A CHILD

  • ccr/trunk/p/C0CNMED2.m

    r1544 r1586  
    11C0CNMED2        ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 ; 5/10/12 2:53pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
    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         ;
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
    1210        ; This program is distributed in the hope that it will be useful,
    1311        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1412        ; 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.
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    2018        ;
    2119        ; --Revision History

  • ccr/trunk/p/C0CNMED4.m

    r1544 r1586  
    11C0CNMED4        ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; Copyright 2008 WorldVistA. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    1110        ; This program is distributed in the hope that it will be useful,
    1211        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1312        ; 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.
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "NO ENTRY FROM TOP",!
    … …  
    5856        IF ZCOUNT=0 Q  ; no inpatient meds
    5957        ;M MEDS=^TMP($J,"UD")
    60         I DEBUG ZWR MEDS
    61         S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP")) 
     58        ;I DEBUG ZWR MEDS
     59        S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
    6260        ;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
    6361        S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG
    64         N I S I=0 
     62        N I S I=0
    6563        F  S I=$O(MEDS("med",I)) Q:'I  D  ; For each medication
    6664        . ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT
    67                . I ($P(C0CMFLAG,"^",1)'=1) D
    68                . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
    69                . . . K MEDS("med",I) Q
    70                . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
    71                . . . K MEDS("med",I) Q
    72                . ;OHUM/RUT
     65        . I ($P(C0CMFLAG,"^",1)'=1) D
     66        . . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
     67        . . . K MEDS("med",I) Q
     68        . . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
     69        . . . K MEDS("med",I) Q
     70        . ;OHUM/RUT
    7371        . N MED M MED=MEDS("med",I)
    7472        . I $G(MED("vaType@value"))'="I" Q  ; not inpatient
    … …  
    8078        . I DEBUG W "RXIEN IS ",RXIEN,!
    8179        . I DEBUG W "MAP= ",MAP,!
    82         . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN 
     80        . S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
    8381        . S @MAP@("MEDISSUEDATETXT")="Order Date"
    8482        . ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
    … …  
    174172        . S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
    175173        . S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
    176         . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")="" 
    177         . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")="" 
    178         . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")="" 
     174        . S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
     175        . S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
     176        . S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
    179177        . S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
    180178        . S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
    … …  
    191189        . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
    192190        . S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
    193         . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")="" 
     191        . S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
    194192        . S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
    195193        . S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""

  • ccr/trunk/p/C0CORSLT.m

    r1544 r1586  
    11C0CORSLT        ; CCDCCR/GPL - CCR/CCD PROCESSING ADDITIONAL RESULTS ; 06/27/11
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;Copyright 2011 George Lilly.
    4         ;Licensed under the terms of the GNU General Public License.
    5         ;See attached copy of the License.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        W "NO ENTRY FROM TOP",!

  • ccr/trunk/p/C0COVREL.m

    r1544 r1586  
    11C0COVREL        ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
    2                ;;1.2;C0C;;May 11, 2012;Build 47
    3 LIST       ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
    4                N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
    5                I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
    6                I '$D(C0CQT) S C0CQT=0
    7                I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
    8                I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
    9                I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
    10                I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
    11                S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
    12                S C0CHB=$NA(^TMP("HLS",$J))
    13                S C0CI=""
    14                S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
    15                F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
    16                . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
    17                . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
    18                . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
    19                . M XV=C0CVAR ;
    20                . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
    21                . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
    22                . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
    23                . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
    24                . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
    25                . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
    26                . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
    27                . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
    28                . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
    29                . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
    30                . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
    31                . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
    32                . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX
    33                . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
    34                . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
    35                . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
    36                . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
    37                . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
    38                . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
    39                . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
    40                . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
    41                . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
    42                . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
    43                . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
    44                . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
    45                . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
    46                . . E  D  ; NO SECONDARY, USE PRIMARY
    47                . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
    48                . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
    49                . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
    50                . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
    51                . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
    52                . . S C0CZG=XV("RESULTTESTVALUE")
    53                . . S XV("RESULTTESTVALUE")=C0CZG
    54                . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
    55                . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
    56                . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
    57                . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
    58                . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
    59                . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
    60                . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
    61                . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
    62                . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
    63                . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
    64                . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
    65                . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
    66                . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
    67                . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
    68                . I 'C0CQT D  ;
    69                . . W C0CI," ",C0CTYP,!
    70                Q
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; (C) ELN 2012
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
     18LIST    ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
     19        N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
     20        I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
     21        I '$D(C0CQT) S C0CQT=0
     22        I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
     23        I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
     24        I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
     25        I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
     26        S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
     27        S C0CHB=$NA(^TMP("HLS",$J))
     28        S C0CI=""
     29        S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
     30        F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
     31        . K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
     32        . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
     33        . D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
     34        . M XV=C0CVAR ;
     35        . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
     36        . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
     37        . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
     38        . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
     39        . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
     40        . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
     41        . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
     42        . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
     43        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
     44        . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
     45        . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
     46        . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
     47        . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX
     48        . . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
     49        . . I C0CVAR("C3")="LN" D  ; PRIMARY CODE IS LOINC
     50        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
     51        . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
     52        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
     53        . . E  I C0CVAR("C6")="LN" D  ; SECONDARY CODE IS LOINC
     54        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
     55        . . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
     56        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
     57        . . E  I C0CVAR("C6")'="" D  ; NO LOINC CODES, USE SECONDARY IF PRESENT
     58        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
     59        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
     60        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
     61        . . E  D  ; NO SECONDARY, USE PRIMARY
     62        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
     63        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
     64        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
     65        . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
     66        . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
     67        . . S C0CZG=XV("RESULTTESTVALUE")
     68        . . S XV("RESULTTESTVALUE")=C0CZG
     69        . I C0CTYP="OBX" D  ; PROCESS TEST RESULTS
     70        . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
     71        . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
     72        . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
     73        . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
     74        . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
     75        . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
     76        . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
     77        . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
     78        . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
     79        . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
     80        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
     81        . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
     82        . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
     83        . I 'C0CQT D  ;
     84        . . W C0CI," ",C0CTYP,!
     85        Q

  • ccr/trunk/p/C0COVRES.m

    r1544 r1586  
    11C0COVRES        ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
    2                ;;1.2;C0C;;May 11, 2012;Build 47
    3                ;
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; (C) ELN 2012
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    418MAP(MIXML,DFN,MOXML)       ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
    5                ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
    6                ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
    7                ; MIXML IS THE TEMPLATE TO USE
    8                ; MOXML IS THE OUTPUT XML ARRAY
    9                ; DFN IS THE PATIENT RECORD NUMBER
    10                N C0COXML,C0CO,C0CV,C0CIXML
    11                I '$D(MIVAR) S C0CV="" ;DEFAULT
    12                E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
    13                I '$D(MIXML) S C0CIXML="" ;DEFAULT
    14                E  S C0CIXML=MIXML ;PASSED INPUT XML
    15                D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
    16                I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
    17                E  S C0CO=MOXML
    18                M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
    19                Q
     19        ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
     20        ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
     21        ; MIXML IS THE TEMPLATE TO USE
     22        ; MOXML IS THE OUTPUT XML ARRAY
     23        ; DFN IS THE PATIENT RECORD NUMBER
     24        N C0COXML,C0CO,C0CV,C0CIXML
     25        I '$D(MIVAR) S C0CV="" ;DEFAULT
     26        E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
     27        I '$D(MIXML) S C0CIXML="" ;DEFAULT
     28        E  S C0CIXML=MIXML ;PASSED INPUT XML
     29        D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
     30        I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
     31        E  S C0CO=MOXML
     32        M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
     33        Q
    2034RPCMAP(RTN,DFN,RMIVAR,RMIXML)   ; RPC ENTRY POINT FOR MAPPING RESULTS
    21                ; RTN IS PASSED BY REFERENCE
    22                N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
    23                N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
    24                I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
    25                I RMIXML="" D  ; INPUT XML NOT PASSED
    26                . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
    27                . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
    28                . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
    29                E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
    30                I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
    31                . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
    32                E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
    33                D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
    34                D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
    35                D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
    36                D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
    37                D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
    38                ;OHUM/RUT 3111221
    39                ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
    40                I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
    41                ;OHUM/RUT
    42                I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
    43                . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
    44                ; NO RESULTS
    45                I @C0CV@(0)=0 S RTN(0)=0 Q
    46                S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
    47                K @RIMVARS
    48                ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
    49                N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
    50                S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
    51                N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
    52                N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
    53                N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
    54                ; TO IMPROVE PERFORMANCE
    55                D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
    56                F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
    57                . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
    58                . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
    59                . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
    60                . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
    61                . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
    62                . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
    63                . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
    64                . . K C0CTO ; CLEAR OUTPUT VARIABLE
    65                . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
    66                . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
    67                . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
    68                . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
    69                . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
    70                . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
    71                . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
    72                . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
    73                . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
    74                . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
    75                D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
    76                D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
    77                K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
    78                Q
     35        ; RTN IS PASSED BY REFERENCE
     36        N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
     37        N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
     38        I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
     39        I RMIXML="" D  ; INPUT XML NOT PASSED
     40        . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
     41        . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
     42        . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
     43        E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
     44        I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
     45        . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
     46        E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
     47        D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
     48        D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
     49        D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
     50        D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
     51        D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
     52        ;OHUM/RUT 3111221
     53        ;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
     54        I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
     55        ;OHUM/RUT
     56        I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
     57        . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
     58        ; NO RESULTS
     59        I @C0CV@(0)=0 S RTN(0)=0 Q
     60        S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
     61        K @RIMVARS
     62        ;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
     63        N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
     64        S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
     65        N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
     66        N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
     67        N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
     68        ; TO IMPROVE PERFORMANCE
     69        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
     70        F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
     71        . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
     72        . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
     73        . S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
     74        . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
     75        . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
     76        . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
     77        . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
     78        . . K C0CTO ; CLEAR OUTPUT VARIABLE
     79        . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
     80        . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
     81        . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
     82        . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
     83        . . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
     84        . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
     85        . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
     86        . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
     87        . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
     88        . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
     89        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
     90        D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
     91        K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
     92        Q
    7993EXTRACT(ILXML,DFN,OLXML)        ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
    80                ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
    81                N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
    82                S C0CNSSN=0
    83                S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
    84                D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
    85                I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
    86                . S @C0CLB@(0)=0
    87                ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
    88                N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
    89                S C0CQT=1 ; SURPRESS LISTING
    90                D LIST^C0COVREL ; EXTRACT THE VARIABLES
    91                S C0CQT=QTSAV ; RESET SILENT FLAG
    92                K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
    93                I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
    94                Q
     94        ; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
     95        N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
     96        S C0CNSSN=0
     97        S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
     98        D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
     99        I C0CNSSN=1 D  Q  ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
     100        . S @C0CLB@(0)=0
     101        ;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
     102        N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
     103        S C0CQT=1 ; SURPRESS LISTING
     104        D LIST^C0COVREL ; EXTRACT THE VARIABLES
     105        S C0CQT=QTSAV ; RESET SILENT FLAG
     106        K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
     107        I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
     108        Q

  • ccr/trunk/p/C0COVREU.m

    r1544 r1586  
    11C0COVREU        ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
    2                ;;1.2;C0C;;May 11, 2012;Build 47
    3                ;
    4                ;
    5 GHL7       ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
    6                N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
    7                ; SET UP FOR LAB API CALL
    8                S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
    9                I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
    10                . W "LAB LOOKUP FAILED, NO SSN",!
    11                . S C0CNSSN=1 ; SET NO SSN FLAG
    12                S C0CSPC="*" ; LOOKING FOR ALL LABS
    13                ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
    14                ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
    15                ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
    16                ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
    17                S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
    18                S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
    19                D DT^DILF(,C0CLLMT,.C0CSDT) ;
    20                W "LAB LIMIT: ",C0CLLMT,!
    21                D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
    22                S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
    23                Q
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
     18        ;
     19GHL7    ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
     20        N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
     21        ; SET UP FOR LAB API CALL
     22        S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
     23        I C0CPTID="" D  Q  ; NO SSN, COMPLAIN AND QUIT
     24        . W "LAB LOOKUP FAILED, NO SSN",!
     25        . S C0CNSSN=1 ; SET NO SSN FLAG
     26        S C0CSPC="*" ; LOOKING FOR ALL LABS
     27        ;I $D(^TMP("C0CCCR","RPMS")) D  ; RUNNING RPMS
     28        ;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
     29        ;E  D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
     30        ;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
     31        S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
     32        S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
     33        D DT^DILF(,C0CLLMT,.C0CSDT) ;
     34        W "LAB LIMIT: ",C0CLLMT,!
     35        D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
     36        S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
     37        Q
    2438LTYP(OSEG,OTYP,OVARA,OC0CQT)       ;
    25                N OI,OI2,OTAB,OTI,OV,OVAR
    26                S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
    27                I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
    28                E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
    29                I 1 D  ; FOR HL7 SEGMENT TYPE
    30                . S OI="" ; INDEX INTO FIELDS IN SEG
    31                . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
    32                . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
    33                . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
    34                . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
    35                . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
    36                . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
    37                . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
    38                . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
    39                . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
    40                . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
    41                Q
     39        N OI,OI2,OTAB,OTI,OV,OVAR
     40        S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
     41        I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
     42        E  S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
     43        I 1 D  ; FOR HL7 SEGMENT TYPE
     44        . S OI="" ; INDEX INTO FIELDS IN SEG
     45        . F  S OI=$O(@OTAB@(OI)) Q:OI=""  D  ; FOR EACH FIELD OF THE SEGMENT
     46        . . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
     47        . . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
     48        . . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
     49        . . I $P(OI,";",2)'="" D  ; THIS IS DEFINING A SUB-VALUE
     50        . . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
     51        . . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
     52        . . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
     53        . . I 'C0CQT D  ; PRINT OUTPUT IF C0CQT IS FALSE
     54        . . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
     55        Q
    4256LOBX       ;
    43                Q
    44                ;
     57        Q
    4558OUT(DFN)        ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
    46                N GA,GF,GD
    47                S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
    48                S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
    49                S GD=^TMP("C0CCCR","ODIR")
    50                W $$OUTPUT^C0CXPATH(GA,GF,GD)
    51                Q
     59        N GA,GF,GD
     60        S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
     61        S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
     62        S GD=^TMP("C0CCCR","ODIR")
     63        W $$OUTPUT^C0CXPATH(GA,GF,GD)
     64        Q
    5265SETTBL   ;
    53                K X ; CLEAR X
    54                S X("PID","PID1")="1^00104^Set ID - Patient ID"
    55                S X("PID","PID2")="2^00105^Patient ID (External ID)"
    56                S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
    57                S X("PID","PID4")="4^00107^Alternate Patient ID"
    58                S X("PID","PID5")="5^00108^Patient's Name"
    59                S X("PID","PID6")="6^00109^Mother's Maiden Name"
    60                S X("PID","PID7")="7^00110^Date of Birth"
    61                S X("PID","PID8")="8^00111^Sex"
    62                S X("PID","PID9")="9^00112^Patient Alias"
    63                S X("PID","PID10")="10^00113^Race"
    64                S X("PID","PID11")="11^00114^Patient Address"
    65                S X("PID","PID12")="12^00115^County Code"
    66                S X("PID","PID13")="13^00116^Phone Number - Home"
    67                S X("PID","PID14")="14^00117^Phone Number - Business"
    68                S X("PID","PID15")="15^00118^Language - Patient"
    69                S X("PID","PID16")="16^00119^Marital Status"
    70                S X("PID","PID17")="17^00120^Religion"
    71                S X("PID","PID18")="18^00121^Patient Account Number"
    72                S X("PID","PID19")="19^00122^SSN Number - Patient"
    73                S X("PID","PID20")="20^00123^Drivers License - Patient"
    74                S X("PID","PID21")="21^00124^Mother's Identifier"
    75                S X("PID","PID22")="22^00125^Ethnic Group"
    76                S X("PID","PID23")="23^00126^Birth Place"
    77                S X("PID","PID24")="24^00127^Multiple Birth Indicator"
    78                S X("PID","PID25")="25^00128^Birth Order"
    79                S X("PID","PID26")="26^00129^Citizenship"
    80                S X("PID","PID27")="27^00130^Veteran.s Military Status"
    81                S X("PID","PID28")="28^00739^Nationality"
    82                S X("PID","PID29")="29^00740^Patient Death Date/Time"
    83                S X("PID","PID30")="30^00741^Patient Death Indicator"
    84                S X("NTE","NTE1")="1^00573^Set ID - NTE"
    85                S X("NTE","NTE2")="2^00574^Source of Comment"
    86                S X("NTE","NTE3")="3^00575^Comment"
    87                S X("ORC","ORC1")="1^00215^Order Control"
    88                S X("ORC","ORC2")="2^00216^Placer Order Number"
    89                S X("ORC","ORC3")="3^00217^Filler Order Number"
    90                S X("ORC","ORC4")="4^00218^Placer Order Number"
    91                S X("ORC","ORC5")="5^00219^Order Status"
    92                S X("ORC","ORC6")="6^00220^Response Flag"
    93                S X("ORC","ORC7")="7^00221^Quantity/Timing"
    94                S X("ORC","ORC8")="8^00222^Parent"
    95                S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
    96                S X("ORC","ORC10")="10^00224^Entered By"
    97                S X("ORC","ORC11")="11^00225^Verified By"
    98                S X("ORC","ORC12")="12^00226^Ordering Provider"
    99                S X("ORC","ORC13")="13^00227^Enterer's Location"
    100                S X("ORC","ORC14")="14^00228^Call Back Phone Number"
    101                S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
    102                S X("ORC","ORC16")="16^00230^Order Control Code Reason"
    103                S X("ORC","ORC17")="17^00231^Entering Organization"
    104                S X("ORC","ORC18")="18^00232^Entering Device"
    105                S X("ORC","ORC19")="19^00233^Action By"
    106                S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
    107                S X("OBR","OBR2")="2^00216^Placer Order Number"
    108                S X("OBR","OBR3")="3^00217^Filler Order Number"
    109                S X("OBR","OBR4")="4^00238^Universal Service ID"
    110                S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
    111                S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
    112                S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
    113                S X("OBR","OBR5")="5^00239^Priority"
    114                S X("OBR","OBR6")="6^00240^Requested Date/Time"
    115                S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
    116                S X("OBR","OBR8")="8^00242^Observation End Date/Time"
    117                S X("OBR","OBR9")="9^00243^Collection Volume"
    118                S X("OBR","OBR10")="10^00244^Collector Identifier"
    119                S X("OBR","OBR11")="11^00245^Specimen Action Code"
    120                S X("OBR","OBR12")="12^00246^Danger Code"
    121                S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
    122                S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
    123                S X("OBR","OBR15")="15^00249^Specimen Source"
    124                S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
    125                S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
    126                S X("OBR","OBR18")="18^00251^Placers Field 1"
    127                S X("OBR","OBR19")="19^00252^Placers Field 2"
    128                S X("OBR","OBR20")="20^00253^Filler Field 1"
    129                S X("OBR","OBR21")="21^00254^Filler Field 2"
    130                S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
    131                S X("OBR","OBR23")="23^00256^Charge to Practice"
    132                S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
    133                S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
    134                S X("OBR","OBR26")="26^00259^Parent Result"
    135                S X("OBR","OBR27")="27^00221^Quantity/Timing"
    136                S X("OBR","OBR28")="28^00260^Result Copies to"
    137                S X("OBR","OBR29")="29^00261^Parent Number"
    138                S X("OBR","OBR30")="30^00262^Transportation Mode"
    139                S X("OBR","OBR31")="31^00263^Reason for Study"
    140                S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
    141                S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
    142                S X("OBR","OBR34")="34^00266^Technician"
    143                S X("OBR","OBR35")="35^00267^Transcriptionist"
    144                S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
    145                S X("OBR","OBR37")="37^01028^Number of Sample Containers"
    146                S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
    147                S X("OBR","OBR39")="39^01030^Collector.s Comment"
    148                S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
    149                S X("OBR","OBR41")="41^01032^Transport Arranged"
    150                S X("OBR","OBR42")="42^01033^Escort Required"
    151                S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
    152                S X("OBX","OBX1")="1^00559^Set ID - OBX"
    153                S X("OBX","OBX2")="2^00676^Value Type"
    154                S X("OBX","OBX3")="3^00560^Observation Identifier"
    155                S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
    156                S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
    157                S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
    158                S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
    159                S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
    160                S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
    161                S X("OBX","OBX4")="4^00769^Observation Sub-Id"
    162                S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
    163                S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
    164                S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
    165                S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
    166                S X("OBX","OBX9")="9^00639^Probability"
    167                S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
    168                S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
    169                S X("OBX","OBX12")="12^00567^Date Last Normal Value"
    170                S X("OBX","OBX13")="13^00581^User Defined Access Checks"
    171                S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
    172                S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
    173                S X("OBX","OBX16")="16^00584^Responsible Observer"
    174                S X("OBX","OBX17")="17^00936^Observation Method"
    175                K ^TMP("C0CCCR","LABTBL")
    176                M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
    177                S ^TMP("C0CCCR","LABTBL",0)="V3"
    178                Q
     66        K X ; CLEAR X
     67        S X("PID","PID1")="1^00104^Set ID - Patient ID"
     68        S X("PID","PID2")="2^00105^Patient ID (External ID)"
     69        S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
     70        S X("PID","PID4")="4^00107^Alternate Patient ID"
     71        S X("PID","PID5")="5^00108^Patient's Name"
     72        S X("PID","PID6")="6^00109^Mother's Maiden Name"
     73        S X("PID","PID7")="7^00110^Date of Birth"
     74        S X("PID","PID8")="8^00111^Sex"
     75        S X("PID","PID9")="9^00112^Patient Alias"
     76        S X("PID","PID10")="10^00113^Race"
     77        S X("PID","PID11")="11^00114^Patient Address"
     78        S X("PID","PID12")="12^00115^County Code"
     79        S X("PID","PID13")="13^00116^Phone Number - Home"
     80        S X("PID","PID14")="14^00117^Phone Number - Business"
     81        S X("PID","PID15")="15^00118^Language - Patient"
     82        S X("PID","PID16")="16^00119^Marital Status"
     83        S X("PID","PID17")="17^00120^Religion"
     84        S X("PID","PID18")="18^00121^Patient Account Number"
     85        S X("PID","PID19")="19^00122^SSN Number - Patient"
     86        S X("PID","PID20")="20^00123^Drivers License - Patient"
     87        S X("PID","PID21")="21^00124^Mother's Identifier"
     88        S X("PID","PID22")="22^00125^Ethnic Group"
     89        S X("PID","PID23")="23^00126^Birth Place"
     90        S X("PID","PID24")="24^00127^Multiple Birth Indicator"
     91        S X("PID","PID25")="25^00128^Birth Order"
     92        S X("PID","PID26")="26^00129^Citizenship"
     93        S X("PID","PID27")="27^00130^Veteran.s Military Status"
     94        S X("PID","PID28")="28^00739^Nationality"
     95        S X("PID","PID29")="29^00740^Patient Death Date/Time"
     96        S X("PID","PID30")="30^00741^Patient Death Indicator"
     97        S X("NTE","NTE1")="1^00573^Set ID - NTE"
     98        S X("NTE","NTE2")="2^00574^Source of Comment"
     99        S X("NTE","NTE3")="3^00575^Comment"
     100        S X("ORC","ORC1")="1^00215^Order Control"
     101        S X("ORC","ORC2")="2^00216^Placer Order Number"
     102        S X("ORC","ORC3")="3^00217^Filler Order Number"
     103        S X("ORC","ORC4")="4^00218^Placer Order Number"
     104        S X("ORC","ORC5")="5^00219^Order Status"
     105        S X("ORC","ORC6")="6^00220^Response Flag"
     106        S X("ORC","ORC7")="7^00221^Quantity/Timing"
     107        S X("ORC","ORC8")="8^00222^Parent"
     108        S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
     109        S X("ORC","ORC10")="10^00224^Entered By"
     110        S X("ORC","ORC11")="11^00225^Verified By"
     111        S X("ORC","ORC12")="12^00226^Ordering Provider"
     112        S X("ORC","ORC13")="13^00227^Enterer's Location"
     113        S X("ORC","ORC14")="14^00228^Call Back Phone Number"
     114        S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
     115        S X("ORC","ORC16")="16^00230^Order Control Code Reason"
     116        S X("ORC","ORC17")="17^00231^Entering Organization"
     117        S X("ORC","ORC18")="18^00232^Entering Device"
     118        S X("ORC","ORC19")="19^00233^Action By"
     119        S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
     120        S X("OBR","OBR2")="2^00216^Placer Order Number"
     121        S X("OBR","OBR3")="3^00217^Filler Order Number"
     122        S X("OBR","OBR4")="4^00238^Universal Service ID"
     123        S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
     124        S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
     125        S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
     126        S X("OBR","OBR5")="5^00239^Priority"
     127        S X("OBR","OBR6")="6^00240^Requested Date/Time"
     128        S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
     129        S X("OBR","OBR8")="8^00242^Observation End Date/Time"
     130        S X("OBR","OBR9")="9^00243^Collection Volume"
     131        S X("OBR","OBR10")="10^00244^Collector Identifier"
     132        S X("OBR","OBR11")="11^00245^Specimen Action Code"
     133        S X("OBR","OBR12")="12^00246^Danger Code"
     134        S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
     135        S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
     136        S X("OBR","OBR15")="15^00249^Specimen Source"
     137        S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
     138        S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
     139        S X("OBR","OBR18")="18^00251^Placers Field 1"
     140        S X("OBR","OBR19")="19^00252^Placers Field 2"
     141        S X("OBR","OBR20")="20^00253^Filler Field 1"
     142        S X("OBR","OBR21")="21^00254^Filler Field 2"
     143        S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
     144        S X("OBR","OBR23")="23^00256^Charge to Practice"
     145        S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
     146        S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
     147        S X("OBR","OBR26")="26^00259^Parent Result"
     148        S X("OBR","OBR27")="27^00221^Quantity/Timing"
     149        S X("OBR","OBR28")="28^00260^Result Copies to"
     150        S X("OBR","OBR29")="29^00261^Parent Number"
     151        S X("OBR","OBR30")="30^00262^Transportation Mode"
     152        S X("OBR","OBR31")="31^00263^Reason for Study"
     153        S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
     154        S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
     155        S X("OBR","OBR34")="34^00266^Technician"
     156        S X("OBR","OBR35")="35^00267^Transcriptionist"
     157        S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
     158        S X("OBR","OBR37")="37^01028^Number of Sample Containers"
     159        S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
     160        S X("OBR","OBR39")="39^01030^Collector.s Comment"
     161        S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
     162        S X("OBR","OBR41")="41^01032^Transport Arranged"
     163        S X("OBR","OBR42")="42^01033^Escort Required"
     164        S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
     165        S X("OBX","OBX1")="1^00559^Set ID - OBX"
     166        S X("OBX","OBX2")="2^00676^Value Type"
     167        S X("OBX","OBX3")="3^00560^Observation Identifier"
     168        S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
     169        S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
     170        S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
     171        S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
     172        S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
     173        S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
     174        S X("OBX","OBX4")="4^00769^Observation Sub-Id"
     175        S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
     176        S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
     177        S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
     178        S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
     179        S X("OBX","OBX9")="9^00639^Probability"
     180        S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
     181        S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
     182        S X("OBX","OBX12")="12^00567^Date Last Normal Value"
     183        S X("OBX","OBX13")="13^00581^User Defined Access Checks"
     184        S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
     185        S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
     186        S X("OBX","OBX16")="16^00584^Responsible Observer"
     187        S X("OBX","OBX17")="17^00936^Observation Method"
     188        K ^TMP("C0CCCR","LABTBL")
     189        M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
     190        S ^TMP("C0CCCR","LABTBL",0)="V3"
     191        Q

  • ccr/trunk/p/C0CPARMS.m

    r1544 r1586  
    11C0CPARMS        ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 ; 6/15/12 3:46pm
    2         ;;1.2;C0C;;May 11, 2012;Build 49
    3         ;Copyright 2008 WorldVistA.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 WorldVistA. 
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018SET(INPARMS)    ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS

  • ccr/trunk/p/C0CPROBS.m

    r1544 r1586  
    11C0CPROBS        ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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         ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2117        ;
    2218        ; PROCESS THE PROBLEMS SECTION OF THE CCR
    … …  
    9288        ; GENERATE THE NARITIVE HTML FOR THE CCD
    9389        I CCD D CCD ; IF THIS IS FOR A CCD
    94         D MISSINGVARS
     90        D MISSVARS
    9591        Q
    9692        ;
    … …  
    149145        ; GENERATE THE NARITIVE HTML FOR THE CCD
    150146        I CCD D CCD ; IF THIS IS FOR A CCD
    151         D MISSINGVARS
     147        D MISSVARS
    152148        Q
    153 CCD     
     149CCD     ;
    154150        N HTMP,HOUT,HTMLO,C0CPROBI,ZX
    155151        F C0CPROBI=1:1:RPCRSLT(0) D  ; FOR EACH PROBLEM
    … …  
    175171        D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
    176172        Q
    177 MISSINGVARS     
     173MISSVARS        ; Missing Variables
    178174        N PROBSTMP,I
    179175        D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS

  • ccr/trunk/p/C0CPROC.m

    r1544 r1586  
    11C0CPROC  ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    63        ;
    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.
     4        ; This program is free software: you can redistribute it and/or modify
     5        ; it under the terms of the GNU Affero General Public License as
     6        ; published by the Free Software Foundation, either version 3 of the
     7        ; License, or (at your option) any later version.
    118        ;
    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.
     9        ; This program is distributed in the hope that it will be useful,
     10        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     11        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12        ; GNU Affero General Public License for more details.
    1613        ;
    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.
     14        ; You should have received a copy of the GNU Affero General Public License
     15        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2016        ;
    2117        W "NO ENTRY FROM TOP",!
    … …  
    112108        ; CPT^CATEGORY^TEXT
    113109        N Z1,Z2,Z3,ZRTN
    114         S Z1=$P(ISTR,U,1) 
     110        S Z1=$P(ISTR,U,1)
    115111        I Z1="" D  ;
    116112        . I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)

  • ccr/trunk/p/C0CPXRM.m

    r1544 r1586  
    11C0CPXRM ;
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33DOIT    ;
    4         S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
    5         S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
    6         S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
    7         S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
    8         S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
    9         S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
    10         S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
    11         S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
    12         S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
    13         S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
    14         S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
    15         S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
    16         S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
    17         S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
    18         S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
    19         S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
    20         S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
    21         S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
    22         S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
    23         S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
    24         S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
    25         S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
    26         S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
    27         S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
    28         S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
    29         S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
    30         S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
    31         S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
    32         S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
    33         S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
    34         S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
    35         S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
    36         S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
    37         S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
    38         S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
    39         S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
    40         S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
    41         S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
    42         S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
    43         S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
    44         S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
    45         S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
    46         S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
    47         S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
    48         S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
    49         S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
    50         S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
    51         S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
    52         S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
    53         S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
    54         S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
    55         S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
    56         S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
    57         S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
    58         S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
    59         S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
    60         S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
    61         S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
    62         S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
    63         S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
    64         S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
    65         S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
    66         S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
    67         S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
    68         S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
    69         S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
    70         S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
    71         S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
    72         S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
    73         Q
     4        ; S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
     5        ; S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
     6        ; S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
     7        ; S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
     8        ; S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
     9        ; S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
     10        ; S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
     11        ; S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
     12        ; S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
     13        ; S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
     14        ; S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
     15        ; S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
     16        ; S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
     17        ; S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
     18        ; S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
     19        ; S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
     20        ; S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
     21        ; S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
     22        ; S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
     23        ; S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
     24        ; S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
     25        ; S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
     26        ; S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
     27        ; S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
     28        ; S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
     29        ; S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
     30        ; S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
     31        ; S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
     32        ; S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
     33        ; S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
     34        ; S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
     35        ; S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
     36        ; S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
     37        ; S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
     38        ; S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
     39        ; S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
     40        ; S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
     41        ; S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
     42        ; S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
     43        ; S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
     44        ; S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
     45        ; S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
     46        ; S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
     47        ; S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
     48        ; S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
     49        ; S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
     50        ; S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
     51        ; S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
     52        ; S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
     53        ; S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
     54        ; S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
     55        ; S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
     56        ; S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
     57        ; S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
     58        ; S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
     59        ; S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
     60        ; S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
     61        ; S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
     62        ; S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
     63        ; S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
     64        ; S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
     65        ; S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
     66        ; S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
     67        ; S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
     68        ; S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
     69        ; S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
     70        ; S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
     71        ; S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
     72        ; S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
     73        ; Q
    7474        ;

  • ccr/trunk/p/C0CQRY1.m

    r1544 r1586  
    11LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99  13:48
    2                ;;1.2;C0C;;May 11, 2012;Build 47
     2               ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33               ;
    44               Q

  • ccr/trunk/p/C0CQRY2.m

    r1544 r1586  
    1 LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     1LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 ; 10/30/12 10:16am
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ; JMC - mods to check for IHS V LAB file
     4        ;
     5        ; (C) John McCormack 2009
     6        ;
     7        ; This program is free software: you can redistribute it and/or modify
     8        ; it under the terms of the GNU Affero General Public License as
     9        ; published by the Free Software Foundation, either version 3 of the
     10        ; License, or (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 Affero General Public License for more details.
     16        ;
     17        ; You should have received a copy of the GNU Affero General Public License
     18        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     19        ;
    420        ;
    521        Q

  • ccr/trunk/p/C0CRAHL7.m

    r1544 r1586  
    11C0CRAHL7        ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010
    2                ;;1.2;C0C;;May 11, 2012;Build 47
    3                ;;
    4                Q
    5                ;LENGTH OF SEGMENTS COMPROMISED
    6 GHL7       ; Loop through ^RADPT with RADFN
    7                ; Get Case Number and Reprot Information
    8                ; Extract RAD Report as HL7 Message
    9                ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
    10                ;
    11                D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
    12                D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
    13                S C0CCNT=0
    14                F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
    15                . S C0CRAIDT=0
    16                . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
    17                . . S C0CRANO=0
    18                . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
    19                . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
    20                . . . Q:C0CRAXAM(0)=""
    21                . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
    22                . . . Q:RARPT=""!(RARPT=0)
    23                . . . ;Quit if no report information present
    24                . . . D SETHL7
    25                . . . S C0CSBCNT=0
    26                . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
    27                . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
    28                . . . . S C0CCNT=C0CCNT+1
    29                ;
    30                K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
    31                K C0CRAXAM,C0CCNT,C0CRAEDT
    32                Q
    33                ;
    34 SETHL7   ;SETHL7 SEGMENTS
    35                N RASET,RACN0
    36                S RASET=0
    37                S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
    38                I +$P(RACN0,U,25)=2 D  Q  ; printset
    39                . ; loop through all cases in set and create message
    40                . S RASET=1
    41                . N RACNI,RAII S RAII=0
    42                . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
    43                . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
    44                . . S RACNI=RAII
    45                . . D NEW
    46 NEW         ; new variables
    47                ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
    48                N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN
    49                N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
    50                S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
    51                S (HLECH,HL("ECH"))="^~\&"
    52                S (HLFS,HL("FS"))="|"
    53                S (HLQ,HL("Q"))=""""
    54                S DFN=RADFN D DEM^VADPT
    55                I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
    56                S RAN=0
    57                S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
    58                D SETUP,PID,OBR,OBXRPT
    59 EXIT       ;EXIT FROM NEW
    60                K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
    61                Q
    62                ;
    63 OBR         ;Compile 'OBR' Segment
    64                        S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
    65                S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
    66                ; Replace above with following when Imaging can cope with ESC chars
    67                ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP"
    68                ; Have to use LOCAL code if Broad Procedure - no CPT code
    69                I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL"
    70                S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS
    71                S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
    72                S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
    73                S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown")
    74                ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
    75                N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
    76                S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
    77                S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^")
    78                S $P(X1,HLFS,21)=$P(X1,HLFS,21)
    79                ; Replace above with following when Imaging can cope with ESC chars
    80                ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
    81                ;
    82                S OBR36=9999999.9999-RADTI
    83                S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
    84                ;
    85                S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
    86                S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
    87                ;Principal Result Interpreter = Verifying Physician
    88                S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
    89                .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
    90                .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
    91                .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
    92                ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
    93                S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
    94                .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
    95                .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
    96                .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
    97                I $P(RACN0,"^",12) D
    98                .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
    99                .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
    100                .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
    101                ;Technician = Technologist
    102                S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
    103                .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
    104                .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
    105                .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
    106                .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
    107                .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
    108                ;Transcriptionist
    109                S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
    110                .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
    111                .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
    112                .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
    113                ;
    114                S RAN=RAN+1
    115                I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q
    116                S HLA("HLS",RAN)=X1
    117                Q
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; (C) ELN 2010.
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     18        ;
     19        ;
     20        Q
     21        ;LENGTH OF SEGMENTS COMPROMISED
     22GHL7    ; Loop through ^RADPT with RADFN
     23        ; Get Case Number and Reprot Information
     24        ; Extract RAD Report as HL7 Message
     25        ; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
     26        ;
     27        D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
     28        D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
     29        S C0CCNT=0
     30        F  S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT)  D
     31        . S C0CRAIDT=0
     32        . F  S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0  D
     33        . . S C0CRANO=0
     34        . . F  S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0  D
     35        . . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
     36        . . . Q:C0CRAXAM(0)=""
     37        . . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
     38        . . . Q:RARPT=""!(RARPT=0)
     39        . . . ;Quit if no report information present
     40        . . . D SETHL7
     41        . . . S C0CSBCNT=0
     42        . . . F  S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT=""  D
     43        . . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
     44        . . . . S C0CCNT=C0CCNT+1
     45        ;
     46        K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
     47        K C0CRAXAM,C0CCNT,C0CRAEDT
     48        Q
     49        ;
     50SETHL7  ;SETHL7 SEGMENTS
     51        N RASET,RACN0
     52        S RASET=0
     53        S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
     54        I +$P(RACN0,U,25)=2 D  Q  ; printset
     55        . ; loop through all cases in set and create message
     56        . S RASET=1
     57        . N RACNI,RAII S RAII=0
     58        . F  S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0  D
     59        . . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
     60        . . S RACNI=RAII
     61        . . D NEW
     62NEW     ; new variables
     63        ;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
     64        N DIWF,DIWL,DIWR,RACPT,RACPTNDE,RADTECN,RADTE0,RADTV,RAI,RAN,RAOBR4,RAPRCNDE,RAPROC,RAPROCIT,RAPRV,RARPT0,VADM,VAERR,X,X1,X2,XX2,Y,X0,OBR36,DFN
     65        N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
     66        S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
     67        S (HLECH,HL("ECH"))="^~\&"
     68        S (HLFS,HL("FS"))="|"
     69        S (HLQ,HL("Q"))=""""
     70        S DFN=RADFN D DEM^VADPT
     71        I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
     72        S RAN=0
     73        S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
     74        D SETUP,PID,OBR,OBXRPT
     75EXIT    ;EXIT FROM NEW
     76        K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
     77        Q
     78        ;
     79OBR     ;Compile 'OBR' Segment
     80        S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$P(RACPTNDE,U,2)_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
     81        S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
     82        ; Replace above with following when Imaging can cope with ESC chars
     83        ; S RAOBR4=$P(RACPTNDE,U)_$E(HLECH)_$$ESCAPE^RAHLRU($P(RACPTNDE,U,2))_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$$ESCAPE^RAHLRU($P(RAPRCNDE,U))_$E(HLECH)_"99RAP"
     84        ; Have to use LOCAL code if Broad Procedure - no CPT code
     85        I $P(RAOBR4,$E(HLECH))=""!($P(RAOBR4,$E(HLECH),2)="") S $P(RAOBR4,$E(HLECH),1,3)=$P(RAOBR4,$E(HLECH),4,5)_$E(HLECH)_"LOCAL"
     86        S X1="OBR"_HLFS_HLFS_HLFS_RADTI_"-"_RACNI_$E(HLECH)_RADTECN_$E(HLECH)_"L"_HLFS_C0COBRFR_HLFS_HLFS_HLFS_RADTE0_HLFS_HLQ_HLFS_HLQ_HLFS_HLFS_HLFS_HLFS_HLFS,Y=$$HLDATE^HLFNC($P(RARPT0,"^",6)) S X1=X1_Y_HLFS_HLFS
     87        S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
     88        S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
     89        S $P(X1,HLFS,19)=$S($D(^DIC(42,+$P(RACN0,"^",6),0)):$P(^(0),"^"),$D(^SC(+$P(RACN0,"^",8),0)):$P(^(0),"^"),1:"Unknown")
     90        ; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
     91        N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
     92        S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
     93        S $P(X1,HLFS,21)=$P(RACN00,"^",4)_$E(HLECH)_$P($G(^SC(RA20,0)),"^")_$E(HLECH)_$P(RACN00,"^",3)_$E(HLECH)_$P($G(^DIC(4,$P(RACN00,U,3),0)),"^")
     94        S $P(X1,HLFS,21)=$P(X1,HLFS,21)
     95        ; Replace above with following when Imaging can cope with ESC chars
     96        ; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
     97        ;
     98        S OBR36=9999999.9999-RADTI
     99        S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
     100        ;
     101        S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
     102        S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
     103        ;Principal Result Interpreter = Verifying Physician
     104        S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
     105        .S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
     106        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
     107        .S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
     108        ;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
     109        S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
     110        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
     111        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
     112        .S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
     113        I $P(RACN0,"^",12) D
     114        .S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
     115        .S Y=$$HLNAME^HLFNC(X2) Q:Y']""
     116        .S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
     117        ;Technician = Technologist
     118        S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
     119        .S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
     120        .S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
     121        .S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
     122        .S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
     123        .S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
     124        ;Transcriptionist
     125        S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
     126        .S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
     127        .S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
     128        .S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
     129        ;
     130        S RAN=RAN+1
     131        I $D(RAPART) S HLA("HLS",RAN)=$P(RAPART(1),HLFS)_HLFS,HLA("HLS",RAN,1)=$P(RAPART(1),HLFS,2,99)_HLFS,HLA("HLS",RAN,2)=RAPART(2) K RAPART Q
     132        S HLA("HLS",RAN)=X1
     133        Q
    118134OBXRPT   ;Compile 'OBX' Segment for Radiology Report Text
    119                N RATX
    120                I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q
    121                S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
    122                S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
    123                Q
    124 PID         ;Compile 'PID' Segment
    125                ;
    126                S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS
    127                S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"))  S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
    128                Q
    129 SETUP     ; Setup basic examination information
    130                S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
    131                S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
    132                S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
    133                S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
    134                S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
    135                S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
    136                Q
     135        N RATX
     136        I '$O(^RARPT(RARPT,"R",0)) S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_"None Entered" D OBX11^RAHLRU Q
     137        S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI  I $D(^(RAI,0)) S RATX=RATX_^(0)
     138        S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
     139        Q
     140PID     ;Compile 'PID' Segment
     141        ;
     142        S X1="",X1="PID"_HLFS_HLFS_$G(VA("PID"))_HLFS_Y_HLFS_HLFS S X=VADM(1),Y=$$HLNAME^HLFNC(X) S X1=X1_Y_HLFS_HLFS
     143        S X=RAVADM(3),Y=$$HLDATE^HLFNC(X) S X1=X1_Y_HLFS_$S(VADM(5)]"":$S("MF"[$P(VADM(5),"^"):$P(VADM(5),"^"),1:"O"))  S:$P(VADM(2),"^")]"" $P(X1,HLFS,20)=$P(VADM(2),"^") S RAN=RAN+1,HLA("HLS",RAN)=X1
     144        Q
     145SETUP   ; Setup basic examination information
     146        S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
     147        S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
     148        S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
     149        S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
     150        S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
     151        S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
     152        Q

  • ccr/trunk/p/C0CRARPT.m

    r1544 r1586  
    1 C0CRARPT               ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
    2                ;;1.2;C0C;;May 11, 2012;Build 47
    3 MAP(MIXML,DFN,MOXML)       ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
    4                ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
    5                ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
    6                ; MIXML IS THE TEMPLATE TO USE
    7                ; MOXML IS THE OUTPUT XML ARRAY
    8                ; DFN IS THE PATIENT RECORD NUMBER
    9                N C0COXML,C0CO,C0CV,C0CIXML
    10                I '$D(MIVAR) S C0CV="" ;DEFAULT
    11                E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
    12                I '$D(MIXML) S C0CIXML="" ;DEFAULT
    13                E  S C0CIXML=MIXML ;PASSED INPUT XML
    14                D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
    15                I '$D(MOXML) D  Q
    16                . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
    17                . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
    18                E  D
    19                . N C0COOXML
    20                . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
    21                . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
    22                . S C0COCNT=$O(C0CRSXML(""),-1)
    23                . S C0CRES=0
    24                . F  S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES=""  D
    25                . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
    26                . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
    27                . . S C0COCNT=C0COCNT+1
    28                . S C0CRSXML(C0COCNT)="</Results>"
    29                . S C0CRSXML(0)=C0COCNT
    30                . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
    31                . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
    32                S C0CO=MOXML,@C0CO@(0)=0
    33                K C0CRSXML,C0COCNT,C0COXML,C0CRES
    34                Q
    35 RPCMAP(RTN,DFN,RMIVAR,RMIXML)     ; RPC ENTRY POINT FOR MAPPING RESULTS
    36                ; RTN IS PASSED BY REFERENCE
    37                N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
    38                N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
    39                I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
    40                I RMIXML="" D  ; INPUT XML NOT PASSED
    41                . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
    42                . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
    43                . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
    44                E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
    45                I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
    46                . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
    47                E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
    48                D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
    49                D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
    50                D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
    51                D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
    52                I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
    53                . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
    54                ; NO RESULTS
    55                I @C0CV@(0)=0 S RTN(0)=0 Q
    56                S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
    57                K @RIMVARS
    58                M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
    59                N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
    60                S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
    61                N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
    62                N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
    63                N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
    64                ; TO IMPROVE PERFORMANCE
    65                D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
    66                F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
    67                . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
    68                . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
    69                . S C0CMAP=$NA(@C0CV@(C0CI)) ;
    70                . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
    71                . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
    72                . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
    73                . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
    74                . . K C0CTO ; CLEAR OUTPUT VARIABLE
    75                . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
    76                . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
    77                . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
    78                . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
    79                . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
    80                . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
    81                . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
    82                . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
    83                . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
    84                . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
    85                D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
    86                D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
    87                K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
    88                Q
    89 EXTRACT(ILXML,DFN,OLXML)               ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
    90                S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
    91                S RADFN=DFN
    92                D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
    93                ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
    94                N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
    95                S C0CQT=1 ; SURPRESS LISTING
    96                D LIST ; EXTRACT THE VARIABLES
    97                ;S C0CQT=QTSAV ; RESET SILENT FLAG
    98                K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
    99                K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
    100                I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
    101                Q
    102 LIST       ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
    103                N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
    104                I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
    105                I '$D(C0CQT) S C0CQT=0
    106                I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
    107                I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
    108                . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
    109                . K ^TMP("C0CCCR","RATBL")
    110                . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
    111                I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
    112                S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
    113                S C0CHB=$NA(^TMP("HLS",$J))
    114                S C0CI=""
    115                S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
    116                F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
    117                . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
    118                . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
    119                . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
    120                . M XV=C0CVAR ;
    121                . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
    122                . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
    123                . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
    124                . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
    125                . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
    126                . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
    127                . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
    128                . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
    129                . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
    130                . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
    131                . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
    132                . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
    133                . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
    134                . . ; RESULTTESTCODEVALUE
    135                . . ; RESULTTESTDESCRIPTIONTEXT
    136                . . I C0CVAR("C3")="C4" D  ; PRIMARY CODE "CPT"
    137                . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
    138                . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
    139                . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
    140                . . E  I C0CVAR("C6")'="" D  ; NO CPT CODES, USE SECONDARY IF PRESENT
    141                . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
    142                . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
    143                . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
    144                . . E  D  ; NO SECONDARY, USE PRIMARY
    145                . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
    146                . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
    147                . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
    148                . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
    149                . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
    150                . . S C0CZG=XV("RESULTTESTVALUE")
    151                . . S XV("RESULTTESTVALUE")=C0CZG
    152                . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
    153                . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
    154                . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
    155                . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
    156                . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
    157                . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
    158                . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
    159                . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
    160                . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
    161                . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
    162                . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
    163                . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
    164                . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
    165                K XV,C0CZG,C0CX1,C0CX2,C0CVAR
    166                Q
     1C0CRARPT        ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; (C) ELN 2010
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     18        ;
     19MAP(MIXML,DFN,MOXML)      ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
     20        ; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
     21        ; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
     22        ; MIXML IS THE TEMPLATE TO USE
     23        ; MOXML IS THE OUTPUT XML ARRAY
     24        ; DFN IS THE PATIENT RECORD NUMBER
     25        N C0COXML,C0CO,C0CV,C0CIXML
     26        I '$D(MIVAR) S C0CV="" ;DEFAULT
     27        E  S C0CV=MIVAR ;PASSED VARIABLE ARRAY
     28        I '$D(MIXML) S C0CIXML="" ;DEFAULT
     29        E  S C0CIXML=MIXML ;PASSED INPUT XML
     30        D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
     31        I '$D(MOXML) D  Q
     32        . S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
     33        . M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
     34        E  D
     35        . N C0COOXML
     36        . S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
     37        . D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
     38        . S C0COCNT=$O(C0CRSXML(""),-1)
     39        . S C0CRES=0
     40        . F  S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES=""  D
     41        . . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
     42        . . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
     43        . . S C0COCNT=C0COCNT+1
     44        . S C0CRSXML(C0COCNT)="</Results>"
     45        . S C0CRSXML(0)=C0COCNT
     46        . D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
     47        . D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
     48        S C0CO=MOXML,@C0CO@(0)=0
     49        K C0CRSXML,C0COCNT,C0COXML,C0CRES
     50        Q
     51RPCMAP(RTN,DFN,RMIVAR,RMIXML)   ; RPC ENTRY POINT FOR MAPPING RESULTS
     52        ; RTN IS PASSED BY REFERENCE
     53        N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
     54        N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
     55        I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
     56        I RMIXML="" D  ; INPUT XML NOT PASSED
     57        . D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
     58        . D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
     59        . S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
     60        E  S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
     61        I RMIVAR="" D  ; LOCATION OF VARIABLES NOT PASSED
     62        . S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
     63        E  S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
     64        D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
     65        D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
     66        D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
     67        D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
     68        I '$D(@C0CV@(0)) D  Q  ; NO VARS THERE
     69        . S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
     70        ; NO RESULTS
     71        I @C0CV@(0)=0 S RTN(0)=0 Q
     72        S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
     73        K @RIMVARS
     74        M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
     75        N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
     76        S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
     77        N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
     78        N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
     79        N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
     80        ; TO IMPROVE PERFORMANCE
     81        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
     82        F C0CI=1:1:C0CIN D  ; LOOP THROUGH VARIABLES
     83        . K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
     84        . S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
     85        . S C0CMAP=$NA(@C0CV@(C0CI)) ;
     86        . D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
     87        . D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
     88        . I $D(@C0CMAP@("M","TEST",0)) D  ; TESTS EXIST
     89        . . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
     90        . . K C0CTO ; CLEAR OUTPUT VARIABLE
     91        . . F C0CJ=1:1:C0CJN D   ;FOR EACH TEST RESULT
     92        . . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
     93        . . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
     94        . . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
     95        . . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
     96        . . . I C0CJ=1 S C0CJS=2 E  S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
     97        . . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E  S C0CJE=@C0CTMP@(0) ;</Test>
     98        . . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
     99        . . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
     100        . D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
     101        D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
     102        D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
     103        K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
     104        Q
     105EXTRACT(ILXML,DFN,OLXML)        ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
     106        S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
     107        S RADFN=DFN
     108        D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
     109        ;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
     110        N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
     111        S C0CQT=1 ; SURPRESS LISTING
     112        D LIST ; EXTRACT THE VARIABLES
     113        ;S C0CQT=QTSAV ; RESET SILENT FLAG
     114        K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
     115        K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
     116        I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
     117        Q
     118LIST    ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
     119        N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
     120        I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
     121        I '$D(C0CQT) S C0CQT=0
     122        I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
     123        I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
     124        . D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
     125        . K ^TMP("C0CCCR","RATBL")
     126        . M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
     127        I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
     128        S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
     129        S C0CHB=$NA(^TMP("HLS",$J))
     130        S C0CI=""
     131        S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
     132        F  S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI=""  D  ; FOR ALL RECORDS IN HL7 MSG
     133        . K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
     134        . S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
     135        . D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
     136        . M XV=C0CVAR ;
     137        . I C0CTYP="OBR" D  ; BEGINNING OF NEW SECTION
     138        . . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
     139        . . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
     140        . . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
     141        . . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
     142        . . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
     143        . . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
     144        . . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
     145        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
     146        . . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
     147        . . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
     148        . . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
     149        . I C0CTYP="OBX" D  ; SPECIAL CASE FOR OBX3
     150        . . ; RESULTTESTCODEVALUE
     151        . . ; RESULTTESTDESCRIPTIONTEXT
     152        . . I C0CVAR("C3")="C4" D  ; PRIMARY CODE "CPT"
     153        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
     154        . . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
     155        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
     156        . . E  I C0CVAR("C6")'="" D  ; NO CPT CODES, USE SECONDARY IF PRESENT
     157        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
     158        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
     159        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
     160        . . E  D  ; NO SECONDARY, USE PRIMARY
     161        . . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
     162        . . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
     163        . . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
     164        . . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
     165        . . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
     166        . . S C0CZG=XV("RESULTTESTVALUE")
     167        . . S XV("RESULTTESTVALUE")=C0CZG
     168        . . I C0CLOBX=0 D  ; FIRST TEST RESULT FOR THIS SECTION
     169        . . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
     170        . . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
     171        . . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
     172        . . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
     173        . . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
     174        . . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
     175        . . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
     176        . . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
     177        . . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
     178        . . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
     179        . . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
     180        . . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
     181        K XV,C0CZG,C0CX1,C0CX2,C0CVAR
     182        Q

  • ccr/trunk/p/C0CRIMA.m

    r1544 r1586  
    11C0CRIMA   ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        ; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
    … …  
    10097           . W "CATEGORY NAME: ",CATNAME,!
    10198           . ;
    102            . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
     99           . F  S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN)  ; NEXT PATIENT
    103100           . ; PTST TESTS TO SEE IF PATIENT WAS MERGED
    104101           . ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
    … …  
    386383           I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
    387384           S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
    388            I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q ; NO VARIABLES IN SECTION
     385           I '$D(@ZVBASE@(DFN,ISEC,0)) D  Q  ; NO VARIABLES IN SECTION
    389386           . W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
    390387           N ZZI,ZZS
    … …  
    420417           N ZNC  ; ZNC IS NUMBER OF CATEGORIES
    421418           S ZNC=@ZCBASE@(0)
    422            I ZNC=0 Q ; NO CATEGORIES TO SEARCH
     419           I ZNC=0 Q  ; NO CATEGORIES TO SEARCH
    423420           N ZAP  ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
    424421           S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)

  • ccr/trunk/p/C0CRNF.m

    r1544 r1586  
    11C0CRNF    ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is the Reference Name Format (RNF) Utility Library ",!
    … …  
    2927        S C0CFI=0 S C0CFJ=C0CF
    3028        K @C0CFRTN ; CLEAR THE RETURN ARRAY
    31         F  Q:C0CFJ'[C0CF  D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
     29        F  Q:C0CFJ'[C0CF  D  ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
    3230        . ;W "1: "_C0CFJ," ",C0CFI,!
    3331        . F  S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0  D  ; EVERY FIELD
    … …  
    5351        S G1("THREE")=3
    5452        D RNF1TO2("GPL","G1")
    55         ZWR GPL
     53        ; ZWR GPL
    5654        Q
    5755        ;

  • ccr/trunk/p/C0CRNFRP.m

    r1544 r1586  
    11C0CRNFRP        ; CCDCCR/GPL - Reference Name Format (RNF) RPCs; 12/9/09 ; 5/10/12 2:56pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is the Reference Name Format (RNF) RPC Library ",!

  • ccr/trunk/p/C0CRPMS.m

    r1544 r1586  
    11C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09  14:33
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2008 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    53        ;
    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.
     4        ; This program is free software: you can redistribute it and/or modify
     5        ; it under the terms of the GNU Affero General Public License as
     6        ; published by the Free Software Foundation, either version 3 of the
     7        ; License, or (at your option) any later version.
    108        ;
    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.
     9        ; This program is distributed in the hope that it will be useful,
     10        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     11        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12        ; GNU Affero General Public License for more details.
    1513        ;
    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.
     14        ; You should have received a copy of the GNU Affero General Public License
     15        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1916        ;
    2017        W "NO ENTRY FROM TOP",!
    … …  
    2724VTYPES  ;
    2825        D GETN2^C0CRNF("G1",9999999.07)
    29         ZWR G1
     26        ; ZWR G1
    3027        Q
    3128        ;
    … …  
    9289        . W "PAT: ",C0CG,!
    9390        . D GETNV^C0CRPMS(C0CG)
    94         . K X R X
     91        . K X R X:DTIME
    9592        . I X="Q" S C0CQ=1 ; QUIT IF Q
    9693        Q

  • ccr/trunk/p/C0CRXN.m

    r1544 r1586  
    11C0CRXN    ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is the CCR RXNORM Utility Library ",!
    … …  
    5351        . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
    5452        . E  D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
    55         . . ;ZWR C0CA
     53        . ;ZWR C0CA
    5654        . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
    5755        . I $$ZVALUE("RXCUI","C0CB")'="" D  ; RXNORM FOUND
    … …  
    7472        . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
    7573        . D UPDATE^DIE("","C0CFDA")
    76         . I $D(^TMP("DIERR",$J)) U $P BREAK
     74        . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
    7775        W "HAS RXN=",HASRXN,!
    7876        W "NO RXN=",NORXN,!
    … …  
    150148        . S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
    151149        . D UPDATE^DIE("","C0CFDA")
    152         . I $D(^TMP("DIERR",$J)) U $P BREAK
     150        . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
    153151        W "VA MAPPING VUID COUNT: ",VAVCNT,!
    154152        W "VA MAPPING MISSING: ",VANO,!
    … …  
    216214        Q
    217215        ;
     216        D
    218217        . I $$ZVALUE("MEDIATION CODE")="" D
    219218        . . S NORXN=NORXN+1 ;
    … …  
    225224        . . ;D SETFDA("VUID",$$ZVALUE("VUID"))
    226225        . E  D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
    227         . . ;ZWR C0CA
     226        . ;ZWR C0CA
    228227        . D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
    229228        . I $$ZVALUE("RXCUI","C0CB")'="" D  ; RXNORM FOUND
    … …  
    245244        . S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
    246245        . D UPDATE^DIE("","C0CFDA")
    247         . I $D(^TMP("DIERR",$J)) U $P BREAK
     246        . I $D(^TMP("DIERR",$J)) S $EC=",U1,"
    248247        W "HAS RXN=",HASRXN,!
    249248        W "NO RXN=",NORXN,!

  • ccr/trunk/p/C0CRXNRD.m

    r1544 r1586  
    11C0CRXNRD        ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; Copyright Sam Habiel 2008.
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    318        W "No entry from top" Q
    4 IMPORT(PATH)   
     19IMPORT(PATH)    ; Main entry point
    520        I PATH="" QUIT
    621        D READSRC(PATH),READCON(PATH),READNDC(PATH)
    … …  
    2136        U IO
    2237        N I
    23         F I=1:1 R LINE Q:$$STATUS^%ZISH
     38        F I=1:1 R LINE:0 Q:$$STATUS^%ZISH
    2439        D CLOSE^%ZISH("FILE")
    2540        Q I-1
    … …  
    3752        F C0CCOUNT=1:1 D  Q:$$STATUS^%ZISH
    3853        . U IO
    39         . N LINE R LINE
     54        . N LINE R LINE:0
    4055        . IF $$STATUS^%ZISH QUIT
    4156        . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
    … …  
    8297        F C0CCOUNT=1:1 Q:$$STATUS^%ZISH  D
    8398        . U IO
    84         . N LINE R LINE
     99        . N LINE R LINE:0
    85100        . IF $$STATUS^%ZISH QUIT
    86101        . I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
    … …  
    106121        F I=1:1 Q:$$STATUS^%ZISH  D
    107122        . U IO
    108         . N LINE R LINE
     123        . N LINE R LINE:0
    109124        . IF $$STATUS^%ZISH QUIT
    110125        . U $P W I,! U IO  ; Write I to the screen, then go back to reading the file
    … …  
    141156EX3     D CLOSE^%ZISH("FILE")
    142157        Q
    143        

  • ccr/trunk/p/C0CSNOA.m

    r1544 r1586  
    11C0CSNOA   ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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         ; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES
    22         ; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD
    23         ; USING THE VISTA LEXICON ^LEX
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2417        ;
    2518ANALYZE(BEGIEN,IENCNT)  ; SNOMED RETRIEVAL ANALYSIS ROUTINE
    26            ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
    27            ; TO RESUME AT NEXT DRUG, USE BEGIEN=""
    28            ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
    29            ;
    30            N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
    31            N CCRGLO
    32            D ASETUP ; SET UP VARIABLES AND GLOBALS
    33            D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
    34            I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
    35            S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
    36            S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
    37            I SNOIEN="" S SNOIEN=RESUME
    38            I +SNOIEN=0 D  Q  ; AT THE END OF THE ALLERGY LIST
    39            . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
    40            F SNOI=1:1:IENCNT  D  Q:+SNOIEN=0  ; FOR IENCNT NUMBER OF PATIENTS OR END
    41            . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
    42            . W SNOIEN,@GMRBASE@(SNOIEN,0),!
    43            . N SNORTN,TTERM ; RETURN ARRAY
    44            . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
    45            . D TEXTRPC(.SNORTN,TTERM)
    46            . I $D(SNORTN) ZWR SNORTN
    47            . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
    48            . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
    49            . ;
    50            . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
    51            . ;
    52            . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
    53            . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
    54            . ;
    55            . N CATNAME,CATTBL
    56            . S CATNAME=""
    57            . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
    58            . ; W "CATEGORY NAME: ",CATNAME,!
    59            . ;
    60            . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
    61            . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
    62            ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
    63            Q
    64            ;
     19        ; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
     20        ; TO RESUME AT NEXT DRUG, USE BEGIEN=""
     21        ; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
     22        ;
     23        N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
     24        N CCRGLO
     25        D ASETUP ; SET UP VARIABLES AND GLOBALS
     26        D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
     27        I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
     28        S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
     29        S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
     30        I SNOIEN="" S SNOIEN=RESUME
     31        I +SNOIEN=0 D  Q  ; AT THE END OF THE ALLERGY LIST
     32        . W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
     33        F SNOI=1:1:IENCNT  D  Q:+SNOIEN=0  ; FOR IENCNT NUMBER OF PATIENTS OR END
     34        . ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
     35        . W SNOIEN,@GMRBASE@(SNOIEN,0),!
     36        . N SNORTN,TTERM ; RETURN ARRAY
     37        . S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
     38        . D TEXTRPC(.SNORTN,TTERM)
     39        . ; I $D(SNORTN) ZWR SNORTN
     40        . K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
     41        . I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
     42        . ;
     43        . ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
     44        . ;
     45        . S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
     46        . S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
     47        . ;
     48        . N CATNAME,CATTBL
     49        . S CATNAME=""
     50        . D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
     51        . ; W "CATEGORY NAME: ",CATNAME,!
     52        . ;
     53        . S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
     54        . S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
     55        ; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
     56        Q
     57        ;
    6558TEXTRPC(ORTN,ITEXT)     ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
    6659        ;
    … …  
    7164        ;
    7265ASETUP  ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
    73              I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
    74              I '$D(@SNOBASE) S @SNOBASE=""
    75              I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
    76              I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
    77              S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
    78              Q
    79              ;
     66        I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
     67        I '$D(@SNOBASE) S @SNOBASE=""
     68        I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
     69        I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
     70        S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
     71        Q
     72        ;
    8073AINIT   ; INITIALIZE ATTRIBUTE TABLE
    81              I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
    82              K @SNOTBL
    83              D APUSH^C0CRIMA(SNOTBL,"CODE")
    84              D APUSH^C0CRIMA(SNOTBL,"NOCODE")
    85              D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
    86              D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
    87              D APUSH^C0CRIMA(SNOTBL,"DONE")
    88              Q
     74        I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
     75        K @SNOTBL
     76        D APUSH^C0CRIMA(SNOTBL,"CODE")
     77        D APUSH^C0CRIMA(SNOTBL,"NOCODE")
     78        D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
     79        D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
     80        D APUSH^C0CRIMA(SNOTBL,"DONE")
     81        Q
    8982APOST(PRSLT,PTBL,PVAL)  ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
    90            ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
    91            ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
    92            ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
    93            I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
    94            N USETBL
    95            I '$D(@SNOBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
    96            . W "ERROR NO SUCH TABLE",!
    97            S USETBL=@SNOBASE@("TABLES",PTBL)
    98            S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
    99            Q
     83        ; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
     84        ; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
     85        ; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
     86        I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
     87        N USETBL
     88        I '$D(@SNOBASE@("TABLES",PTBL)) D  Q  ; NO TABLE
     89        . W "ERROR NO SUCH TABLE",!
     90        S USETBL=@SNOBASE@("TABLES",PTBL)
     91        S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
     92        Q
    10093SETATTR(SDFN)   ; SET ATTRIBUTES BASED ON VARS
    101            N SBASE,SATTR
    102            S SBASE=$NA(@SNOBASE@("VARS",SDFN))
    103            D APOST("SATTR","SNOTBL","DONE")
    104            I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
    105            I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
    106            Q SATTR  ; C0C
    107            I $D(@SBASE@("PROBLEMS",1)) D  ;
    108            . D APOST("SATTR","SNOTBL","PROBLEMS")
    109            . ; W "POSTING PROBLEMS",!
    110            I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
    111            I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
    112            . D APOST("SATTR","SNOTBL","MEDS")
    113            . N ZR,ZI
    114            . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
    115            . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
    116            . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
    117            . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
    118            . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
    119            D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
    120            ; W "ATTRIBUTES: ",SATTR,!
    121            Q SATTR
    122            ;
     94        N SBASE,SATTR
     95        S SBASE=$NA(@SNOBASE@("VARS",SDFN))
     96        D APOST("SATTR","SNOTBL","DONE")
     97        I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
     98        I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
     99        Q SATTR  ; C0C
     100        I $D(@SBASE@("PROBLEMS",1)) D  ;
     101        . D APOST("SATTR","SNOTBL","PROBLEMS")
     102        . ; W "POSTING PROBLEMS",!
     103        I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
     104        I $D(@SBASE@("MEDS",1)) D  ; IF THE PATIENT HAS MEDS VARIABLES
     105        . D APOST("SATTR","SNOTBL","MEDS")
     106        . N ZR,ZI
     107        . D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
     108        . I ZR(0)>0 D  ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
     109        . . F ZI=1:1:ZR(0) D  ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
     110        . . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
     111        . ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
     112        D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
     113        ; W "ATTRIBUTES: ",SATTR,!
     114        Q SATTR
     115        ;
    123116RESET   ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
    124            K ^TMP("C0CSNO","RESUME")
    125            K ^TMP("C0CSNO")
    126            Q
    127            ;
     117        K ^TMP("C0CSNO","RESUME")
     118        K ^TMP("C0CSNO")
     119        Q
     120        ;
    128121CLIST   ; LIST THE CATEGORIES
    129            ;
    130            I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
    131            N CLBASE,CLNUM,ZI,CLIDX
    132            S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
    133            S CLNUM=@CLBASE@(0)
    134            F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
    135            . S CLIDX=@CLBASE@(ZI)
    136            . W "(",$P(@CLBASE@(CLIDX),"^",1)
    137            . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
    138            . W CLIDX,!
    139            ; D PARY^C0CXPATH(CLBASE)
    140            Q
    141            ;
     122        ;
     123        I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
     124        N CLBASE,CLNUM,ZI,CLIDX
     125        S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
     126        S CLNUM=@CLBASE@(0)
     127        F ZI=1:1:CLNUM D  ; LOOP THROUGH THE CATEGORIES
     128        . S CLIDX=@CLBASE@(ZI)
     129        . W "(",$P(@CLBASE@(CLIDX),"^",1)
     130        . W ":",$P(@CLBASE@(CLIDX),"^",2),") "
     131        . W CLIDX,!
     132        ; D PARY^C0CXPATH(CLBASE)
     133        Q
     134        ;
    142135CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR)     ; ADD PATIENTS TO CATEGORIES
    143            ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
    144            ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
    145            ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
    146            ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
    147            ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
    148            ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
    149            ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
    150            ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
    151            ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
    152            ; NUMBER IE CTBL_X(CDFN)=""
    153            ;
    154            ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
    155            S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
    156            ; W "CBASE: ",CCTBL,!
    157            ;
    158            I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
    159            . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
    160            . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
    161            . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
    162            . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
    163            . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
    164            . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
    165            ;
    166            S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
    167            S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
    168            S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
    169            ;
    170            S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
    171            ;
    172            S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
    173            ; W "IENS BASE: ",CPATLIST,!
    174            S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
    175            ;
    176            Q
    177            ;
     136        ; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
     137        ; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
     138        ; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
     139        ; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
     140        ; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
     141        ; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
     142        ; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
     143        ; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
     144        ; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
     145        ; NUMBER IE CTBL_X(CDFN)=""
     146        ;
     147        ; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
     148        S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
     149        ; W "CBASE: ",CCTBL,!
     150        ;
     151        I '$D(@CCTBL@(CATTR)) D  ; FIRST PATIENT IN THIS CATEGORY
     152        . D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
     153        . S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
     154        . S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
     155        . S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
     156        . ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
     157        . ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
     158        ;
     159        S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
     160        S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
     161        S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
     162        ;
     163        S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
     164        ;
     165        S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
     166        ; W "IENS BASE: ",CPATLIST,!
     167        S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
     168        ;
     169        Q
     170        ;
    178171REUSE   ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
    179172        ;
    … …  
    183176        S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
    184177        S SNOI=""
    185         F  D  Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
     178        F  D  Q:$O(@SAVBASE@(SNOI))=""  ;THE WHOLE LIST
    186179        . S SNOI=$O(@SAVBASE@(SNOI))
    187180        . S SNOJ=@SAVBASE@(SNOI)

  • ccr/trunk/p/C0CSOAP.m

    r1544 r1586  
    11C0CSOAP  ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2008 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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is an SOAP utility library",!

  • ccr/trunk/p/C0CSQMB.m

    r1544 r1586  
    11C0CSQMB ; SQMCCR/ELN  - BATCH PROGRAM ;16/11/2010
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; (C) 2010 ELN
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    317        ;
    418EN      ;Traverse the DPT global and export CCR xml for each DFN

  • ccr/trunk/p/C0CSUB1.m

    r1544 r1586  
    11C0CSUB1   ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is the CCR SUBSCRIPTIONN Utility Library ",!
    … …  
    2927        S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
    3028        S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
    31         K C0CFDA 
     29        K C0CFDA
    3230        S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
    3331        I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
    34         E  Q ; NO CHECKSUMS FOR THISPATIENT
     32        E  Q  ; NO CHECKSUMS FOR THISPATIENT
    3533        D UPDIE
    3634        N C0CJ S C0CJ=""
    3735        F  S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ=""  D  ; FOR EACH DOMAIN
    38         . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,"")) 
     36        . S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
    3937        . W C0CJ," ",C0CD,!
    4038        . S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
    … …  
    7068        D CLEAN^DILF
    7169        D UPDATE^DIE("","C0CFDA","","ZERR")
    72         I $D(ZERR) D  ;
    73         . W "ERROR",!
    74         . ZWR ZERR
    75         . B
     70        I $D(ZERR) S $EC=",U1,"
    7671        K C0CFDA
    7772        Q

  • ccr/trunk/p/C0CSYS.m

    r1544 r1586  
    11C0CSYS  ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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         ;
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; Copyright 2008 WorldVistA. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
    1110        ; This program is distributed in the hope that it will be useful,
    1211        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1312        ; 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.
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "Enter at appropriate points." Q

  • ccr/trunk/p/C0CTIU.m

    r1544 r1586  
    11C0CTIU  ; C0C/ELN - PROCESSING FOR TIU NOTES ; 19/10/2010
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ; (C) ELN 2010
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    417        ;
    518        ;ELN - Modified Routine of C0CLABS

  • ccr/trunk/p/C0CTIU1.m

    r1544 r1586  
    11C0CTIU1 ; C0C/ELN - PROCESSING FOR TIU NOTES Contd. ; 19/10/2010
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;ELN UTILITY PROGRAM TO SUPPORT C0CTIU
     4        ; (C) ELN 2010.
     5        ;
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     18        ;
    419C0CDATE(EDTE)   ; Converts external date to internal date format
    520        ; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)

  • ccr/trunk/p/C0CUNIT.m

    r1544 r1586  
    11C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2008 George Lilly. Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 George Lilly.
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    20                  W "This is a unit testing library",!
    21                  W !
    22                  Q
    23                  ;
     18        W "This is a unit testing library",!
     19        W !
     20        Q
     21        ;
    2422ZT(ZARY,BAT,TST)        ; private routine to add a test case to the ZARY array
    25                  ; ZARY IS PASSED BY REFERENCE
    26                  ; BAT is a string identifying the test battery
    27                  ; TST is a test which will evaluate to true or false
    28                  ; I '$G(ZARY) D
    29                  ; . S ZARY(0)=0 ; initially there are no elements
    30                  ; W "GOT HERE LOADING "_TST,!
    31                  N CNT ; count of array elements
    32                  S CNT=ZARY(0) ; contains array count
    33                  S CNT=CNT+1 ; increment count
    34                  S ZARY(CNT)=TST ; put the test in the array
    35                  I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
    36                  . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
    37                  . S II=$P(ZARY(BAT),"^",2)
    38                  . S $P(ZARY(BAT),"^",2)=II+1
    39                  I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
    40                  . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
    41                  . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
    42                  . ; S TN=$NA(ZARY("TESTS"))
    43                  . ; D PUSH^C0CXPATH(TN,BAT)
    44                  S ZARY(0)=CNT ; update the array counter
    45                  Q
    46                  ;
     23        ; ZARY IS PASSED BY REFERENCE
     24        ; BAT is a string identifying the test battery
     25        ; TST is a test which will evaluate to true or false
     26        ; I '$G(ZARY) D
     27        ; . S ZARY(0)=0 ; initially there are no elements
     28        ; W "GOT HERE LOADING "_TST,!
     29        N CNT ; count of array elements
     30        S CNT=ZARY(0) ; contains array count
     31        S CNT=CNT+1 ; increment count
     32        S ZARY(CNT)=TST ; put the test in the array
     33        I $D(ZARY(BAT))  D  ; NOT THE FIRST TEST IN BATTERY
     34        . N II,TN ; TEMP FOR ENDING TEST IN BATTERY
     35        . S II=$P(ZARY(BAT),"^",2)
     36        . S $P(ZARY(BAT),"^",2)=II+1
     37        I '$D(ZARY(BAT))  D  ; FIRST TEST IN THIS BATTERY
     38        . S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
     39        . S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
     40        . ; S TN=$NA(ZARY("TESTS"))
     41        . ; D PUSH^C0CXPATH(TN,BAT)
     42        S ZARY(0)=CNT ; update the array counter
     43        Q
     44        ;
    4745ZLOAD(ZARY,ROUTINE)      ; load tests into ZARY which is passed by reference
    48                  ; ZARY IS PASSED BY NAME
    49                  ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
    50                  ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
    51                  K @ZARY
    52                  S @ZARY@(0)=0 ; initialize array count
    53                  N LINE,LABEL,BODY
    54                  N INTEST S INTEST=0 ; switch for in the test case section
    55                  N SECTION S SECTION="[anonymous]" ; test case section
    56                  ;
    57                  N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
    58                  . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
    59                  . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
    60                  . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
    61                  . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
    62                  . I INTEST  D  ; within the testing section
    63                  . . I LINE?." "1";;><".E  D  ; section name found
    64                  . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
    65                  . . I LINE?." "1";;>>".E  D  ; test case found
    66                  . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
    67                  S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
    68                  Q
    69                  ;
     46        ; ZARY IS PASSED BY NAME
     47        ; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
     48        ; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
     49        K @ZARY
     50        S @ZARY@(0)=0 ; initialize array count
     51        N LINE,LABEL,BODY
     52        N INTEST S INTEST=0 ; switch for in the test case section
     53        N SECTION S SECTION="[anonymous]" ; test case section
     54        ;
     55        N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE=""  D
     56        . I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
     57        . I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
     58        . I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
     59        . I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
     60        . I INTEST  D  ; within the testing section
     61        . . I LINE?." "1";;><".E  D  ; section name found
     62        . . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
     63        . . I LINE?." "1";;>>".E  D  ; test case found
     64        . . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
     65        S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
     66        Q
     67        ;
    7068ZTEST(ZARY,WHICH)         ; try out the tests using a passed array ZTEST
    71                  N ZI,ZX,ZR,ZP
    72                  S DEBUG=0
    73                  ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
    74                  ; . W "DOING ALL",!
    75                  ; . N J,NT
    76                  ; . S NT=$NA(ZARY("TESTS"))
    77                  ; . W NT,@NT@(0),!
    78                  ; . F J=1:1:@NT@(0) D  ;
    79                  ; . . W @NT@(J),!
    80                  ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
    81                  I '$D(ZARY(WHICH))  D  Q ; TEST SECTION DOESN'T EXIST
    82                  . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
    83                  N FIRST,LAST
    84                  S FIRST=$P(ZARY(WHICH),"^",1)
    85                  S LAST=$P(ZARY(WHICH),"^",2)
    86                  F ZI=FIRST:1:LAST  D
    87                  . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
    88                  . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
    89                  . . ;  W ZP,!
    90                  . . S ZX=ZP
    91                  . . W "RUNNING: "_ZP
    92                  . . X ZX
    93                  . . W "..SUCCESS: ",WHICH,!
    94                  . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
    95                  . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
    96                  . . S ZX="S ZR="_ZP
    97                  . . W "TRYING: "_ZP
    98                  . . X ZX
    99                  . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
    100                  . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
    101                  . . . S TPASSED=0 S TFAILED=0
    102                  . . I ZR S TPASSED=TPASSED+1
    103                  . . I 'ZR S TFAILED=TFAILED+1
    104                  Q
    105                  ;
     69        N ZI,ZX,ZR,ZP
     70        S DEBUG=0
     71        ; I WHICH="ALL" D  Q ; RUN ALL THE TESTS
     72        ; . W "DOING ALL",!
     73        ; . N J,NT
     74        ; . S NT=$NA(ZARY("TESTS"))
     75        ; . W NT,@NT@(0),!
     76        ; . F J=1:1:@NT@(0) D  ;
     77        ; . . W @NT@(J),!
     78        ; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
     79        I '$D(ZARY(WHICH))  D  Q ; TEST SECTION DOESN'T EXIST
     80        . W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
     81        N FIRST,LAST
     82        S FIRST=$P(ZARY(WHICH),"^",1)
     83        S LAST=$P(ZARY(WHICH),"^",2)
     84        F ZI=FIRST:1:LAST  D
     85        . I ZARY(ZI)?1">"1.E  D  ; NOT A TEST, JUST RUN THE STATEMENT
     86        . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
     87        . . ;  W ZP,!
     88        . . S ZX=ZP
     89        . . W "RUNNING: "_ZP
     90        . . X ZX
     91        . . W "..SUCCESS: ",WHICH,!
     92        . I ZARY(ZI)?1"?"1.E  D  ; THIS IS A TEST
     93        . . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
     94        . . S ZX="S ZR="_ZP
     95        . . W "TRYING: "_ZP
     96        . . X ZX
     97        . . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
     98        . . I '$D(TPASSED) D  ; NOT INITIALIZED YET
     99        . . . S TPASSED=0 S TFAILED=0
     100        . . I ZR S TPASSED=TPASSED+1
     101        . . I 'ZR S TFAILED=TFAILED+1
     102        Q
     103        ;
    106104TEST      ; RUN ALL THE TEST CASES
    107                  N ZTMP
    108                  D ZLOAD(.ZTMP)
    109                  D ZTEST(.ZTMP,"ALL")
    110                  W "PASSED: ",TPASSED,!
    111                  W "FAILED: ",TFAILED,!
    112                  W !
    113                  W "THE TESTS!",!
    114                  ; I DEBUG ZWR ZTMP
    115                  Q
    116                  ;
     105        N ZTMP
     106        D ZLOAD(.ZTMP)
     107        D ZTEST(.ZTMP,"ALL")
     108        W "PASSED: ",TPASSED,!
     109        W "FAILED: ",TFAILED,!
     110        W !
     111        W "THE TESTS!",!
     112        ; I DEBUG ZWR ZTMP
     113        Q
     114        ;
    117115GTSTS(GTZARY,RTN)       ; return an array of test names
    118                  N I,J S I="" S I=$O(GTZARY("TESTS",I))
    119                  F J=0:0  Q:I=""  D
    120                  . D PUSH^C0CXPATH(RTN,I)
    121                  . S I=$O(GTZARY("TESTS",I))
    122                  Q
    123                  ;
     116        N I,J S I="" S I=$O(GTZARY("TESTS",I))
     117        F J=0:0  Q:I=""  D
     118        . D PUSH^C0CXPATH(RTN,I)
     119        . S I=$O(GTZARY("TESTS",I))
     120        Q
     121        ;
    124122TESTALL(RNM)    ; RUN ALL THE TESTS
    125                  N ZI,J,TZTMP,TSTS,TOTP,TOTF
    126                  S TOTP=0 S TOTF=0
    127                  D ZLOAD^C0CUNIT("TZTMP",RNM)
    128                  D GTSTS(.TZTMP,"TSTS")
    129                  F ZI=1:1:TSTS(0) D  ;
    130                  . S TPASSED=0 S TFAILED=0
    131                  . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
    132                  . S TOTP=TOTP+TPASSED
    133                  . S TOTF=TOTF+TFAILED
    134                  . S $P(TSTS(ZI),"^",2)=TPASSED
    135                  . S $P(TSTS(ZI),"^",3)=TFAILED
    136                  F ZI=1:1:TSTS(0) D  ;
    137                  . W "TEST=> ",$P(TSTS(ZI),"^",1)
    138                  . W " PASSED=>",$P(TSTS(ZI),"^",2)
    139                  . W " FAILED=>",$P(TSTS(ZI),"^",3),!
    140                  W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
    141                  Q
    142                  ;
     123        N ZI,J,TZTMP,TSTS,TOTP,TOTF
     124        S TOTP=0 S TOTF=0
     125        D ZLOAD^C0CUNIT("TZTMP",RNM)
     126        D GTSTS(.TZTMP,"TSTS")
     127        F ZI=1:1:TSTS(0) D  ;
     128        . S TPASSED=0 S TFAILED=0
     129        . D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
     130        . S TOTP=TOTP+TPASSED
     131        . S TOTF=TOTF+TFAILED
     132        . S $P(TSTS(ZI),"^",2)=TPASSED
     133        . S $P(TSTS(ZI),"^",3)=TFAILED
     134        F ZI=1:1:TSTS(0) D  ;
     135        . W "TEST=> ",$P(TSTS(ZI),"^",1)
     136        . W " PASSED=>",$P(TSTS(ZI),"^",2)
     137        . W " FAILED=>",$P(TSTS(ZI),"^",3),!
     138        W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
     139        Q
     140        ;
    143141TLIST(ZARY)     ; LIST ALL THE TESTS
    144                  ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
    145                  ; ZARY IS PASSED BY REFERENCE
    146                  N I,J,K S I="" S I=$O(ZARY("TESTS",I))
    147                  S K=1
    148                  F J=0:0  Q:I=""  D
    149                  . ; W "I IS NOW=",I,!
    150                  . W I," "
    151                  . S I=$O(ZARY("TESTS",I))
    152                  . S K=K+1 I K=6  D
    153                  . . W !
    154                  . . S K=1
    155                  Q
    156                  ;
    157 MEDS   
     142        ; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
     143        ; ZARY IS PASSED BY REFERENCE
     144        N I,J,K S I="" S I=$O(ZARY("TESTS",I))
     145        S K=1
     146        F J=0:0  Q:I=""  D
     147        . ; W "I IS NOW=",I,!
     148        . W I," "
     149        . S I=$O(ZARY("TESTS",I))
     150        . S K=K+1 I K=6  D
     151        . . W !
     152        . . S K=1
     153        Q
     154        ;
     155MEDS    ;
    158156        N DEBUG S DEBUG=0
    159157        N DFN S DFN=5685
    … …  
    172170        D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
    173171        Q
    174 PAT     
     172PAT     ;
    175173        D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
    176174        N X,Y

  • ccr/trunk/p/C0CUTIL.m

    r1544 r1586  
    11C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;Copyright 2008-2009 Sam Habiel & George Lilly. 
    4         ;Licensed under the terms of the GNU
    5         ;General Public License See attached copy of the License.
    64        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    119        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1614        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        W "No Entry at Top!"
    … …  
    2320        ;
    2421UUID()   ; thanks to Wally for this.
    25                N R,I,J,N
    26                S N="",R="" F  S N=N_$R(100000) Q:$L(N)>64
    27                F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))
    28                Q $E(R,1,8)_"-"_$E(R,9,12)_"-4"_$E(R,14,16)_"-"_$E("89ab",$E(N,17)#4+1)_$E(R,18,20)_"-"_$E(R,21,32)
     22        N R,I,J,N
     23        S N="",R="" F  S N=N_$R(100000) Q:$L(N)>64
     24        F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))
     25        Q $E(R,1,8)_"-"_$E(R,9,12)_"-4"_$E(R,14,16)_"-"_$E("89ab",$E(N,17)#4+1)_$E(R,18,20)_"-"_$E(R,21,32)
    2926        ;
    3027OLDUUID()       ; GENERATE A RANDOM UUID (Version 4)
    … …  
    4037        ; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
    4138        ; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
    42         N UTC,Y,M,D,H,MM,S,OFF
     39        N UTC,Y,M,D,H,MM,S,OFF,OFFS,OFF0,OFF1,OFF2
    4340        S Y=1700+$E(DATE,1,3)
    4441        S M=$E(DATE,4,5)
    … …  
    173170OV()    ; Are we running on OpenVista?
    174171        Q $G(DUZ("AG"))="O" ; Code for OpenVista
    175        

  • ccr/trunk/p/C0CVA200.m

    r1544 r1586  
    11C0CVA200        ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2008 Sam Habiel.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 Sam Habiel. 
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    1918        Q
    2019        ; This routine uses Kernel APIs and Direct Global Access to get

  • ccr/trunk/p/C0CVALID.m

    r1544 r1586  
    11C0CVALID        ; C0C/OHUM/RUT - PROCESSING FOR DATE LIMITS, NOTES ; 22/12/2011
    2         ;;1.2;C0C;;May 11, 2012;Build 47;Build 2
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50;Build 2
     3        ; (C) RUT 2011.
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
    318        S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")=""
    419        S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y

  • ccr/trunk/p/C0CVIT2.m

    r1544 r1586  
    11C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ;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.
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2017        ;
    2118        W "NO ENTRY FROM TOP",!
    … …  
    6663        I '$D(VIT) S @VITOUT@(0)=0 K VIT Q  ; RETURN NOT FOUND, KILL ARRAY AND QUIT
    6764        I $P(VIT(1),U,2)="No vitals found." D  Q  ; signal no vitals and quit
    68         . I $D(VITOUT) S @VITOUT@(0)=0 
     65        . I $D(VITOUT) S @VITOUT@(0)=0
    6966        . K VIT
    7067        ;
    … …  
    168165        Q
    169166        ;
    170 HEIGHT 
     167HEIGHT  ;
    171168        I DEBUG W "IN VITAL:  HEIGHT",!
    172169        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
    … …  
    185182        Q
    186183        ;
    187 WEIGHT 
     184WEIGHT  ;
    188185        I DEBUG W "IN VITAL:  WEIGHT",!
    189186        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    202199        Q
    203200        ;
    204 BP     
     201BP      ;
    205202        I DEBUG W "IN VITAL:  BLOOD PRESSURE",!
    206203        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    219216        Q
    220217        ;
    221 TMP     
     218TMP     ;
    222219        I DEBUG W "IN VITAL:  TEMPERATURE",!
    223220        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    236233        Q
    237234        ;
    238 RESP   
     235RESP    ;
    239236        I DEBUG W "IN VITAL:  RESPIRATION",!
    240237        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    253250        Q
    254251        ;
    255 PULSE   
     252PULSE   ;
    256253        I DEBUG W "IN VITAL:  PULSE",!
    257254        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    270267        Q
    271268        ;
    272 PAIN   
     269PAIN    ;
    273270        I DEBUG W "IN VITAL:  PAIN",!
    274271        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    287284        Q
    288285        ;
    289 OTHER   
     286OTHER   ;
    290287        I DEBUG W "IN VITAL:  OTHER",!
    291288        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    305302        ;
    306303        ;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
    307 HEIGHT1(DT,ACTOR,VALUE,UNIT)   
     304HEIGHT1(DT,ACTOR,VALUE,UNIT)    ;
    308305        I DEBUG W "IN VITAL:  HEIGHT",!
    309306        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
    … …  
    322319        Q
    323320        ;
    324 WEIGHT1(DT,ACTOR,VALUE,UNIT)   
     321WEIGHT1(DT,ACTOR,VALUE,UNIT)    ;
    325322        I DEBUG W "IN VITAL:  WEIGHT",!
    326323        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    339336        Q
    340337        ;
    341 BP1(DT,ACTOR,VALUE,UNIT)       
     338BP1(DT,ACTOR,VALUE,UNIT)        ;
    342339        I DEBUG W "IN VITAL:  BLOOD PRESSURE",!
    343340        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    356353        Q
    357354        ;
    358 TMP1(DT,ACTOR,VALUE,UNIT)       
     355TMP1(DT,ACTOR,VALUE,UNIT)       ;
    359356        I DEBUG W "IN VITAL:  TEMPERATURE",!
    360357        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    373370        Q
    374371        ;
    375 RESP1(DT,ACTOR,VALUE,UNIT)     
     372RESP1(DT,ACTOR,VALUE,UNIT)      ;
    376373        I DEBUG W "IN VITAL:  RESPIRATION",!
    377374        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    390387        Q
    391388        ;
    392 PULSE1(DT,ACTOR,VALUE,UNIT)     
     389PULSE1(DT,ACTOR,VALUE,UNIT)     ;
    393390        I DEBUG W "IN VITAL:  PULSE",!
    394391        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    407404        Q
    408405        ;
    409 PAIN1(DT,ACTOR,VALUE,UNIT)     
     406PAIN1(DT,ACTOR,VALUE,UNIT)      ;
    410407        I DEBUG W "IN VITAL:  PAIN",!
    411408        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
    … …  
    424421        Q
    425422        ;
    426 OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)       
     423OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)        ;
    427424        I DEBUG W "IN VITAL:  OTHER",!
    428425        S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC

  • ccr/trunk/p/C0CVITAL.m

    r1544 r1586  
    11C0CVITAL        ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; This program is free software: you can redistribute it and/or modify
     5        ; it under the terms of the GNU Affero General Public License as
     6        ; published by the Free Software Foundation, either version 3 of the
     7        ; License, or (at your option) any later version.
     8        ;
     9        ; This program is distributed in the hope that it will be useful,
     10        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     11        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12        ; GNU Affero General Public License for more details.
     13        ;
     14        ; You should have received a copy of the GNU Affero General Public License
     15        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2016        ;
    2117        W "NO ENTRY FROM TOP",!
    … …  
    5753        K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
    5854        N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
    59         D VITDVISTA(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
    60         I DEBUG ZWR VDATES ;DEBUG
     55        D SORTVIST(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
     56        ; I DEBUG ZWR VDATES ;DEBUG
    6157        S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
    6258        ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
    … …  
    239235        K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
    240236        N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
    241         D VITDRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
     237        D SORTRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
    242238        S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
    243239        ; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
    … …  
    386382        Q
    387383        ;
    388 VITDRPMS(VDT)   ; RUN DATE SORTING ALGORITHM FOR RPMS
     384SORTRPMS(VDT)   ; RUN DATE SORTING ALGORITHM FOR RPMS
    389385        ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
    390386        ; OF DATES IN THE VITALS RESULTS
    … …  
    399395        Q
    400396        ;
    401 VITDVISTA(VDT)  ; RUN DATE SORTING ALGORITHM FOR VISTA
     397SORTVIST(VDT)   ; RUN DATE SORTING ALGORITHM FOR VISTA
    402398        ; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
    403399        ; OF DATES IN THE VITALS RESULTS

  • ccr/trunk/p/C0CVOBX1.m

    r1544 r1586  
    11LA7VOBX1        ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
    33        ; JMC - mods to check for IHS V LAB file
     4        ;
     5        ; (C) 2009 John McCormack
     6        ; This program is free software: you can redistribute it and/or modify
     7        ; it under the terms of the GNU Affero General Public License as
     8        ; published by the Free Software Foundation, either version 3 of the
     9        ; License, or (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 Affero General Public License for more details.
     15        ;
     16        ; You should have received a copy of the GNU Affero General Public License
     17        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    418        ;
    519CH      ; Observation/Result segment for "CH" subscript results.

  • ccr/trunk/p/C0CVORU.m

    r1544 r1586  
    11C0C7VORU        ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009 ; 5/10/12 5:19pm
    2         ;;1.2;C0C;;May 11, 2012;Build 47
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;
     4        ; (C) 2009 John McCormack
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    317        ;
    418EN(LA)  ; called from C0CVLAB

  • ccr/trunk/p/C0CXEWD.m

    r1544 r1586  
    11C0CXEWD   ; C0C/GPL - EWD based XPath utilities; 10/11/09
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2009 George Lilly.  Licensed under the terms of the GNU
    4         ;General Public License See attached copy of the License.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2009 George Lilly. 
    54        ;
    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.
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
    109        ;
    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.
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
    1514        ;
    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.
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        Q

  • ccr/trunk/p/C0CXPAT0.m

    r1544 r1586  
    11C0CXPAT0          ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2008 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 "NO ENTRY",!
    21                Q
    22                ;
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     17        ;
     18        W "NO ENTRY",!
     19        Q
     20        ;
    2321        ;;><TEST>
    2422        ;;><INIT>

  • ccr/trunk/p/C0CXPATH.m

    r1544 r1586  
    11C0CXPATH          ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
    2         ;;1.2;C0C;;May 11, 2012;Build 47
    3         ;Copyright 2008 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.
     2        ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
     3        ;Copyright 2008 George Lilly. 
     4        ;
     5        ; This program is free software: you can redistribute it and/or modify
     6        ; it under the terms of the GNU Affero General Public License as
     7        ; published by the Free Software Foundation, either version 3 of the
     8        ; License, or (at your option) any later version.
     9        ;
     10        ; This program is distributed in the hope that it will be useful,
     11        ; but WITHOUT ANY WARRANTY; without even the implied warranty of
     12        ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13        ; GNU Affero General Public License for more details.
     14        ;
     15        ; You should have received a copy of the GNU Affero General Public License
     16        ; along with this program.  If not, see <http://www.gnu.org/licenses/>.
    1917        ;
    2018        W "This is an XML XPATH utility library",!
    … …  
    135133        Q
    136134        ;
    137 DO     
     135DO      ;
    138136        D XPG2XML("^GPL2B","^GPL2A")
    139137        Q
    … …  
    188186        Q
    189187        ;
    190 ZXO(WHAT)       
     188ZXO(WHAT)       ;
    191189        D PUSH("GA",WHAT)
    192190        D PUSH(OUTXML,"<"_WHAT_">")
    193191        Q
    194192        ;
    195 ZXC(WHAT)       
     193ZXC(WHAT)       ;
    196194        D POP("GA",.TMP)
    197195        D PUSH(OUTXML,"</"_WHAT_">")
    198196        Q
    199197        ;
    200 ZXVAL(WHAT,VAL)
     198ZXVAL(WHAT,VAL)  ;
    201199        D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
    202200        Q
    … …  
    235233        . S LINE=@IZXML@(I)
    236234        . I $D(TEMPLATE) D  ;IF TEMPLATE IS REQUESTED
    237         . . S @TEMPLATE@(I)=$$CLEAN(LINE) 
     235        . . S @TEMPLATE@(I)=$$CLEAN(LINE)
    238236        . ;W LINE,!
    239237        . S FOUND=0  ; INTIALIZED FOUND FLAG
Note: See TracChangeset for help on using the changeset viewer.