Changed license to AGPL. Some clean-up for XINDEX
This commit is contained in:
parent
0da3fa68d0
commit
4ab1d88817
21
p/C0CACTOR.m
21
p/C0CACTOR.m
|
@ -1,22 +1,19 @@
|
||||||
C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08 ; 10/29/12 4:04pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; (at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
; PROCESS THE ACTORS SECTION OF THE CCR
|
; PROCESS THE ACTORS SECTION OF THE CCR
|
||||||
;
|
;
|
||||||
|
|
30
p/C0CALERT.m
30
p/C0CALERT.m
|
@ -1,22 +1,20 @@
|
||||||
C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
|
C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08 ; 10/29/12 4:04pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota and others.
|
;Copyright 2008,2009 George Lilly, University of Minnesota and others.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -29,7 +27,7 @@ EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE
|
||||||
; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
|
; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
|
||||||
S GMRA="0^0^111"
|
S GMRA="0^0^111"
|
||||||
D EN1^GMRADPT
|
D EN1^GMRADPT
|
||||||
I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*
|
I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*
|
||||||
. S @ALTOUTXML@(0)=0
|
. S @ALTOUTXML@(0)=0
|
||||||
; DEFINE MAPPING
|
; DEFINE MAPPING
|
||||||
N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
|
N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
|
||||||
|
|
36
p/C0CBAT.m
36
p/C0CBAT.m
|
@ -1,21 +1,20 @@
|
||||||
C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
|
C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR Batch Utility Library ",!
|
W "This is the CCR Batch Utility Library ",!
|
||||||
Q
|
Q
|
||||||
|
@ -62,7 +61,7 @@ EN ; BATCH ENTRY POINT
|
||||||
S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
|
S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
|
||||||
I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST
|
I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST
|
||||||
. W "WORK AREA ERROR",!
|
. W "WORK AREA ERROR",!
|
||||||
. B
|
. S $EC=",U1,"
|
||||||
S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
|
S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
|
||||||
S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
|
S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
|
||||||
S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
|
S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
|
||||||
|
@ -163,7 +162,7 @@ COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
|
||||||
. S ZN=ZN+1
|
. S ZN=ZN+1
|
||||||
Q ZN
|
Q ZN
|
||||||
;
|
;
|
||||||
UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
|
UVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
|
||||||
; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
|
; CCR DICTIONARY. IT IS LAYGO, AS IT WILL ADD THE VARIABLE TO
|
||||||
; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
|
; THE CCR DICTIONARY IF IT IS NOT THERE. ZTYP IS REQUIRED FOR LAYGO
|
||||||
;
|
;
|
||||||
|
@ -189,10 +188,7 @@ UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR
|
K ZERR
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
443
p/C0CCCD.m
443
p/C0CCCD.m
|
@ -1,245 +1,242 @@
|
||||||
C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
|
C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
; EXPORT A CCR
|
; EXPORT A CCR
|
||||||
;
|
;
|
||||||
EXPORT ; EXPORT ENTRY POINT FOR CCR
|
EXPORT ; EXPORT ENTRY POINT FOR CCR
|
||||||
; Select a patient.
|
; Select a patient.
|
||||||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||||
I Y<1 Q ; EXIT
|
I Y<1 Q ; EXIT
|
||||||
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
||||||
D XPAT(DFN,"","") ; EXPORT TO A FILE
|
D XPAT(DFN,"","") ; EXPORT TO A FILE
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
|
XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
|
||||||
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
|
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
|
||||||
; FN IS FILE NAME, DEFAULTS IF NULL
|
; FN IS FILE NAME, DEFAULTS IF NULL
|
||||||
; N CCDGLO
|
; N CCDGLO
|
||||||
D CCDRPC(.CCDGLO,DFN,"CCD","","","")
|
D CCDRPC(.CCDGLO,DFN,"CCD","","","")
|
||||||
S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
|
S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
|
||||||
S ONAM=FN
|
S ONAM=FN
|
||||||
I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
|
I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
|
||||||
S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
|
S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
|
||||||
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
||||||
. S @ODIRGLB="/home/glilly/CCROUT"
|
. S @ODIRGLB="/home/glilly/CCROUT"
|
||||||
. ;S @ODIRGLB="/home/cedwards/"
|
. ;S @ODIRGLB="/home/cedwards/"
|
||||||
. ;S @ODIRGLB="/opt/wv/p/"
|
. ;S @ODIRGLB="/opt/wv/p/"
|
||||||
S ODIR=DIR
|
S ODIR=DIR
|
||||||
I DIR="" S ODIR=@ODIRGLB
|
I DIR="" S ODIR=@ODIRGLB
|
||||||
N ZY
|
N ZY
|
||||||
S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
|
S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
|
||||||
W $P(ZY,U,2)
|
W $P(ZY,U,2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
|
CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
|
||||||
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
|
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
|
||||||
; DFN IS PATIENT IEN
|
; DFN IS PATIENT IEN
|
||||||
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
||||||
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
||||||
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
|
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
|
||||||
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
|
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
|
||||||
; - NULL MEANS NOW
|
; - NULL MEANS NOW
|
||||||
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
|
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
|
||||||
; "TO" VARIABLES
|
; "TO" VARIABLES
|
||||||
; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
|
; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
|
||||||
I '$D(DEBUG) S DEBUG=0
|
I '$D(DEBUG) S DEBUG=0
|
||||||
N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
|
N CCD S CCD=0 ; FLAG FOR PROCESSING A CCD
|
||||||
I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
|
I CCRPART="CCD" S CCD=1 ; WE ARE PROCESSING A CCD
|
||||||
S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
|
S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
|
||||||
I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
|
I CCD S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCD")) ; GLOBAL FOR THE CCD
|
||||||
E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
|
E S CCDGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
|
||||||
S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
||||||
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
|
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
|
||||||
S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
|
S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLO NM OF PART OR ALL
|
||||||
I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
I CCD D LOAD^C0CCCD1(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
||||||
E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
E D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
||||||
D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
|
D CP^C0CXPATH(TGLOBAL,CCDGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
|
||||||
N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
|
N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
|
||||||
S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
|
S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
|
||||||
S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
|
S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
|
||||||
S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
|
S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
|
||||||
S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
|
S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
|
||||||
S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
|
S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
|
||||||
S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
|
S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
|
||||||
;
|
;
|
||||||
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
||||||
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
||||||
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
|
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
|
||||||
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
|
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
|
||||||
I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
|
I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
|
||||||
I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
|
I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
|
||||||
;
|
;
|
||||||
I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
|
I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
|
||||||
; MAPPING THE PATIENT PORTION OF THE CDA HEADER
|
; MAPPING THE PATIENT PORTION OF THE CDA HEADER
|
||||||
S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
|
S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
|
||||||
D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
|
D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
|
||||||
D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
|
D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
|
||||||
I DEBUG D PARY^C0CXPATH("ACTT2")
|
I DEBUG D PARY^C0CXPATH("ACTT2")
|
||||||
D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
|
D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
|
||||||
I DEBUG D PARY^C0CXPATH(CCDGLO)
|
I DEBUG D PARY^C0CXPATH(CCDGLO)
|
||||||
K ACTT1 K ACCT2
|
K ACTT1 K ACCT2
|
||||||
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
|
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
|
||||||
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
|
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
|
||||||
D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
|
D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
|
||||||
D CP^C0CXPATH("ACTT2",CCDGLO)
|
D CP^C0CXPATH("ACTT2",CCDGLO)
|
||||||
;
|
;
|
||||||
K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
||||||
S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
||||||
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
||||||
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
||||||
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
||||||
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
|
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
|
||||||
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
|
. S RTN=$P(XI,";",2) ; NAME OF ROUTINE TO CALL
|
||||||
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
|
. S TAG=$P(XI,";",1) ; LABEL INSIDE ROUTINE TO CALL
|
||||||
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
|
. S XPATH=$P(XI,";",3) ; XPATH TO XML TO PASS TO ROUTINE
|
||||||
. D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
. D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
||||||
. S IXML="INXML"
|
. S IXML="INXML"
|
||||||
. I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
|
. I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
|
||||||
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
||||||
. ; W OXML,!
|
. ; W OXML,!
|
||||||
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
||||||
. W "RUNNING ",CALL,!
|
. W "RUNNING ",CALL,!
|
||||||
. X CALL
|
. X CALL
|
||||||
. I @OXML@(0)'=0 D ; THERE IS A RESULT
|
. I @OXML@(0)'=0 D ; THERE IS A RESULT
|
||||||
. . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
|
. . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
|
||||||
. . I CCD D UNSHAVE("ITMP",OXML)
|
. . I CCD D UNSHAVE("ITMP",OXML)
|
||||||
. . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
|
. . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
|
||||||
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
||||||
. D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
|
. D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
|
||||||
. I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
|
. I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
|
||||||
; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
|
; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
|
||||||
; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
|
; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
|
||||||
; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
||||||
; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
|
; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
|
||||||
; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
||||||
N I,J,DONE S DONE=0
|
N I,J,DONE S DONE=0
|
||||||
F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
||||||
. S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
|
. S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
|
||||||
. W "TRIMMED",J,!
|
. W "TRIMMED",J,!
|
||||||
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
||||||
I CCD D ; TURN THE BODY INTO A CCD COMPONENT
|
I CCD D ; TURN THE BODY INTO A CCD COMPONENT
|
||||||
. N I
|
. N I
|
||||||
. F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
|
. F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
|
||||||
. . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP
|
. . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP
|
||||||
. . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
|
. . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
|
||||||
. . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP
|
. . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP
|
||||||
. . . S @CCDGLO@(I)="</structuredBody></component>"
|
. . . S @CCDGLO@(I)="</structuredBody></component>"
|
||||||
S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
|
S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
|
||||||
S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
|
S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
|
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
|
||||||
; TAB IS PASSED BY NAME
|
; TAB IS PASSED BY NAME
|
||||||
W "TAB= ",TAB,!
|
W "TAB= ",TAB,!
|
||||||
; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
|
; ORDER FOR CCR IS PROBLEMS,FAMILYHISTORY,SOCIALHISTORY,MEDICATIONS,VITALSIGNS,RESULTS,HEALTHCAREPROVIDERS
|
||||||
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
|
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROBS;//ContinuityOfCareRecord/Body/Problems;^TMP(""C0CCCR"",$J,DFN,""PROBLEMS"")")
|
||||||
;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
|
;D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
|
||||||
I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
|
I 'CCD D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
|
SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
|
||||||
; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
|
; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
|
||||||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||||||
W SHXML,!
|
W SHXML,!
|
||||||
W @SHXML@(1),!
|
W @SHXML@(1),!
|
||||||
D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
|
D QUEUE^C0CXPATH("SHBLD",SHXML,1,1) ; THE FIRST LINE IS NEEDED
|
||||||
D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
|
D QUEUE^C0CXPATH("SHBLD",SHXML,7,@SHXML@(0)-3) ; REPEATING PART
|
||||||
D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
|
D QUEUE^C0CXPATH("SHBLD",SHXML,@SHXML@(0),@SHXML@(0)) ; LAST LINE
|
||||||
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
||||||
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||||||
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
|
UNSHAVE(ORIGXML,SHXML) ; REPLACES THE 2-6 AND N-1 AND N-2 LINES FROM TEMPLATE
|
||||||
; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
|
; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
|
||||||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||||||
W SHXML,!
|
W SHXML,!
|
||||||
W @SHXML@(1),!
|
W @SHXML@(1),!
|
||||||
D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
|
D QUEUE^C0CXPATH("SHBLD",ORIGXML,1,6) ; FIRST 6 LINES OF TEMPLATE
|
||||||
D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
|
D QUEUE^C0CXPATH("SHBLD",SHXML,2,@SHXML@(0)-1) ; INS ALL BUT FIRST/LAST
|
||||||
D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
|
D QUEUE^C0CXPATH("SHBLD",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
|
||||||
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
||||||
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||||||
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
|
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
|
||||||
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
|
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
|
||||||
; K @VMAP
|
; K @VMAP
|
||||||
S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
|
S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
|
||||||
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
||||||
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
||||||
. S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
. S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
||||||
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
||||||
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
||||||
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
||||||
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
||||||
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
||||||
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
||||||
. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
||||||
N CTMP
|
N CTMP
|
||||||
D MAP^C0CXPATH(CXML,VMAP,"CTMP")
|
D MAP^C0CXPATH(CXML,VMAP,"CTMP")
|
||||||
D CP^C0CXPATH("CTMP",CXML)
|
D CP^C0CXPATH("CTMP",CXML)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
|
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
|
||||||
; AXML AND ACTRTN ARE PASSED BY NAME
|
; AXML AND ACTRTN ARE PASSED BY NAME
|
||||||
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
||||||
; P1= OBJECTID - ACTORPATIENT_2
|
; P1= OBJECTID - ACTORPATIENT_2
|
||||||
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
||||||
;OR INSTITUTION
|
;OR INSTITUTION
|
||||||
; OR PERSON(IN PATIENT FILE IE NOK)
|
; OR PERSON(IN PATIENT FILE IE NOK)
|
||||||
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
||||||
N I,J,K,L
|
N I,J,K,L
|
||||||
K @ACTRTN ; CLEAR RETURN ARRAY
|
K @ACTRTN ; CLEAR RETURN ARRAY
|
||||||
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
||||||
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
||||||
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
||||||
. . W "<ActorID>=>",J,!
|
. . W "<ActorID>=>",J,!
|
||||||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||||||
. . ; TO GET RID OF DUPLICATES
|
. . ; TO GET RID OF DUPLICATES
|
||||||
S I="" ; GOING TO $O THROUGH THE HASH
|
S I="" ; GOING TO $O THROUGH THE HASH
|
||||||
F J=0:0 D Q:$O(K(I))="" ;
|
F J=0:0 D Q:$O(K(I))="" ;
|
||||||
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
|
. S I=$O(K(I)) ; WALK THROUGH THE HASH OF ACTORS
|
||||||
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
|
. S $P(L,U,1)=I ; FIRST PIECE IS THE OBJECT ID
|
||||||
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
. S $P(L,U,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
||||||
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
|
. S $P(L,U,3)=$P(I,"_",2) ; IEN RECORD NUMBER FOR ACTOR
|
||||||
. D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
|
. D PUSH^C0CXPATH(ACTRTN,L) ; ADD THE ACTOR TO THE RETURN ARRAY
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TEST ; RUN ALL THE TEST CASES
|
TEST ; RUN ALL THE TEST CASES
|
||||||
D TESTALL^C0CUNIT("C0CCCR")
|
D TESTALL^C0CUNIT("C0CCCR")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
||||||
N ZTMP
|
N ZTMP
|
||||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||||
D ZTEST^C0CUNIT(.ZTMP,WHICH)
|
D ZTEST^C0CUNIT(.ZTMP,WHICH)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TLIST ; LIST THE TESTS
|
TLIST ; LIST THE TESTS
|
||||||
N ZTMP
|
N ZTMP
|
||||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||||
D TLIST^C0CUNIT(.ZTMP)
|
D TLIST^C0CUNIT(.ZTMP)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
;;><TEST>
|
;;><TEST>
|
||||||
;;><PROBLEMS>
|
;;><PROBLEMS>
|
||||||
;;>>>K C0C S C0C=""
|
;;>>>K C0C S C0C=""
|
||||||
|
|
110
p/C0CCCD1.m
110
p/C0CCCD1.m
|
@ -1,69 +1,67 @@
|
||||||
C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
|
C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
;
|
||||||
|
;
|
||||||
|
W "This is a CCD TEMPLATE with processing routines",!
|
||||||
|
W !
|
||||||
|
Q
|
||||||
;
|
;
|
||||||
W "This is a CCD TEMPLATE with processing routines",!
|
|
||||||
W !
|
|
||||||
Q
|
|
||||||
;
|
|
||||||
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
|
ZT(ZARY,BAT,LINE) ; private routine to add a line to the ZARY array
|
||||||
; ZARY IS PASSED BY NAME
|
; ZARY IS PASSED BY NAME
|
||||||
; BAT is a string identifying the section
|
; BAT is a string identifying the section
|
||||||
; LINE is a test which will evaluate to true or false
|
; LINE is a test which will evaluate to true or false
|
||||||
; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
|
; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
|
||||||
; . S @ZARY@(0)=0 ; initially there are no elements
|
; . S @ZARY@(0)=0 ; initially there are no elements
|
||||||
; . W "GOT HERE LOADING "_LINE,!
|
; . W "GOT HERE LOADING "_LINE,!
|
||||||
N CNT ; count of array elements
|
N CNT ; count of array elements
|
||||||
S CNT=@ZARY@(0) ; contains array count
|
S CNT=@ZARY@(0) ; contains array count
|
||||||
S CNT=CNT+1 ; increment count
|
S CNT=CNT+1 ; increment count
|
||||||
S @ZARY@(CNT)=LINE ; put the line in the array
|
S @ZARY@(CNT)=LINE ; put the line in the array
|
||||||
; S @ZARY@(BAT,CNT)="" ; index the test by battery
|
; S @ZARY@(BAT,CNT)="" ; index the test by battery
|
||||||
S @ZARY@(0)=CNT ; update the array counter
|
S @ZARY@(0)=CNT ; update the array counter
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
||||||
; ZARY IS PASSED BY NAME
|
; ZARY IS PASSED BY NAME
|
||||||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||||||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||||||
K @ZARY S @ZARY=""
|
K @ZARY S @ZARY=""
|
||||||
S @ZARY@(0)=0 ; initialize array count
|
S @ZARY@(0)=0 ; initialize array count
|
||||||
N LINE,LABEL,BODY
|
N LINE,LABEL,BODY
|
||||||
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
|
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
|
||||||
N SECTION S SECTION="[anonymous]" ; NO section LABEL
|
N SECTION S SECTION="[anonymous]" ; NO section LABEL
|
||||||
;
|
;
|
||||||
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
|
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
|
||||||
. I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
|
. I LINE?." "1";<TEMPLATE>".E S INTEST=1 ; entering section
|
||||||
. I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
|
. I LINE?." "1";</TEMPLATE>".E S INTEST=0 ; leaving section
|
||||||
. I INTEST D ; within the section
|
. I INTEST D ; within the section
|
||||||
. . I LINE?." "1";><".E D ; sub-section name found
|
. . I LINE?." "1";><".E D ; sub-section name found
|
||||||
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
|
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
|
||||||
. . I LINE?." "1";;".E D ; line found
|
. . I LINE?." "1";;".E D ; line found
|
||||||
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
|
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
|
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
|
||||||
D ZLOAD(ARY,"C0CCCD1")
|
D ZLOAD(ARY,"C0CCCD1")
|
||||||
; ZWR @ARY
|
; ZWR @ARY
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
|
TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
|
||||||
Q
|
Q
|
||||||
MARKUP ;<MARKUP>
|
MARKUP ;<MARKUP>
|
||||||
;;<Body>
|
;;<Body>
|
||||||
;;<Problems>
|
;;<Problems>
|
||||||
|
|
27
p/C0CCCR.m
27
p/C0CCCR.m
|
@ -1,22 +1,19 @@
|
||||||
C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
|
C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
; EXPORT A CCR
|
; EXPORT A CCR
|
||||||
;
|
;
|
||||||
|
@ -287,5 +284,3 @@ TLIST ; LIST THE TESTS
|
||||||
;;>>>K C0C S C0C=""
|
;;>>>K C0C S C0C=""
|
||||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
|
;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
|
||||||
;;>>?@C0C@(@C0C@(0))["</Alerts>"
|
;;>>?@C0C@(@C0C@(0))["</Alerts>"
|
||||||
|
|
||||||
|
|
||||||
|
|
25
p/C0CCCR0.m
25
p/C0CCCR0.m
|
@ -1,22 +1,19 @@
|
||||||
C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
|
C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is a CCR TEMPLATE with processing routines",!
|
W "This is a CCR TEMPLATE with processing routines",!
|
||||||
W !
|
W !
|
||||||
|
|
26
p/C0CCMT.m
26
p/C0CCMT.m
|
@ -1,22 +1,20 @@
|
||||||
C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
|
C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2010 George Lilly, University of Minnesota and others.
|
;Copyright 2010 George Lilly, University of Minnesota and others.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
|
64
p/C0CCPT.m
64
p/C0CCPT.m
|
@ -1,43 +1,55 @@
|
||||||
C0CCPT ;;BSL;RETURN CPT DATA;
|
C0CCPT ;;BSL;RETURN CPT DATA;
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Sequence Managers Software GPL;;;;;Build 2
|
; (C) George Lilly 2010
|
||||||
;Copied into C0C namespace from SQMCPT with permission from
|
;
|
||||||
;Brian Lord - and with our thanks. gpl 01/20/2010
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
|
ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
|
||||||
;DFN=PATIENT IEN
|
;DFN=PATIENT IEN
|
||||||
;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
|
;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
|
||||||
;ENDDT=END DATE IN 3100101 FORMAT
|
;ENDDT=END DATE IN 3100101 FORMAT
|
||||||
;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
|
;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
|
||||||
;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
|
;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
|
||||||
;ALL INCLUSIVE IN THAT DIRECTION
|
;ALL INCLUSIVE IN THAT DIRECTION
|
||||||
;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
|
;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
|
||||||
;BUILD INTO NOTE(Y)=""
|
;BUILD INTO NOTE(Y)=""
|
||||||
S U="^",X=""
|
S U="^",X=""
|
||||||
F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D
|
F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D
|
||||||
. S Y=""
|
. S Y=""
|
||||||
. F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D
|
. F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D
|
||||||
.. S NOTE(Y)=""
|
.. S NOTE(Y)=""
|
||||||
;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
|
;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
|
||||||
;GET DATE OF NOTE
|
;GET DATE OF NOTE
|
||||||
;RUT 3120109 Changing DATE in FILMAN's FORMAT
|
;RUT 3120109 Changing DATE in FILMAN's FORMAT
|
||||||
;;OHUM/RUT 3111228 Date Range for Notes
|
;OHUM/RUT 3111228 Date Range for Notes
|
||||||
;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
|
;S STDT=^TMP("C0CCCR","TIULIMIT") D NOW^%DTC S ENDDT=X
|
||||||
N FLAGS1,FLAGS2
|
N FLAGS1,FLAGS2
|
||||||
S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1)
|
S FLAGS1=$P(^C0CPARM(1,2),"^",1) S STDT=$$HTOF^C0CVALID(FLAGS1)
|
||||||
S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2)
|
S FLAGS2=$P(^C0CPARM(1,2),"^",2) S ENDDT=$$HTOF^C0CVALID(FLAGS2)
|
||||||
;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART")
|
;S STDT=^TMP("C0CCCR","TIULIMIT"),ENDDT=^TMP("C0CCCR","TIUSTART")
|
||||||
;;OHUM/RUT
|
;OHUM/RUT
|
||||||
;RUT
|
;RUT
|
||||||
S Z=""
|
S Z=""
|
||||||
F S Z=$O(NOTE(Z)) Q:Z="" D
|
F S Z=$O(NOTE(Z)) Q:Z="" D
|
||||||
. S DT=$P(^TIU(8925,Z,0),U,7)
|
. S DT=$P(^TIU(8925,Z,0),U,7)
|
||||||
. I $G(STDT)]"" D
|
. I $G(STDT)]"" D
|
||||||
.. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED
|
.. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED
|
||||||
. I $G(ENDDT)]"" D
|
. I $G(ENDDT)]"" D
|
||||||
.. I ENDDT<DT S NOTE(Z)="D"
|
.. I ENDDT<DT S NOTE(Z)="D"
|
||||||
. I NOTE(Z)="D" K NOTE(Z)
|
. I NOTE(Z)="D" K NOTE(Z)
|
||||||
D VISIT
|
D VISIT
|
||||||
Q
|
Q
|
||||||
VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
|
VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
|
||||||
S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
|
S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
|
||||||
S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D
|
S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D
|
||||||
|
|
26
p/C0CDIC.m
26
p/C0CDIC.m
|
@ -1,21 +1,19 @@
|
||||||
C0CDIC ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
|
C0CDIC ; CCDCCR/GPL - CCR Dictionary utilities; 6/1/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
;Copyright 2008 WorldVistA.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR Dictionary Utility Library ",!
|
W "This is the CCR Dictionary Utility Library ",!
|
||||||
W !
|
W !
|
||||||
|
|
51
p/C0CDOM.m
51
p/C0CDOM.m
|
@ -1,25 +1,24 @@
|
||||||
C0CDOM ; GPL - DOM PROCESSING ROUTINES ;6/6/11 17:05
|
C0CDOM ; GPL - DOM PROCESSING ROUTINES ;6/6/11 17:05
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2011 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2011 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
||||||
; THE XPATH INDEX ZXIDX, PASSED BY NAME
|
; THE XPATH INDEX ZXIDX, PASSED BY NAME
|
||||||
; THE XPATH ARRAY XPARY, PASSED BY NAME
|
; THE XPATH ARRAY XPARY, PASSED BY NAME
|
||||||
; ZOID IS THE STARTING OID
|
; ZOID IS THE STARTING OID
|
||||||
|
@ -81,32 +80,32 @@ ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
|
||||||
. S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
|
. S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
|
PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
|
||||||
; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
|
; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
|
||||||
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
|
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
|
||||||
;Q $$EN^MXMLDOM(INXML)
|
;Q $$EN^MXMLDOM(INXML)
|
||||||
Q $$EN^MXMLDOM(INXML,"W")
|
Q $$EN^MXMLDOM(INXML,"W")
|
||||||
;
|
;
|
||||||
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
|
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
|
||||||
N ZN
|
N ZN
|
||||||
;I $$TAG(ZOID)["entry" B
|
;I $$TAG(ZOID)["entry" B
|
||||||
S ZN=$$NXTSIB(ZOID)
|
S ZN=$$NXTSIB(ZOID)
|
||||||
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
|
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
|
||||||
Q 0
|
Q 0
|
||||||
;
|
;
|
||||||
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
|
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
|
||||||
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
|
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
|
||||||
;
|
;
|
||||||
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
|
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
|
||||||
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
|
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
|
||||||
;
|
;
|
||||||
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
|
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
|
||||||
S HANDLE=C0CDOCID
|
S HANDLE=C0CDOCID
|
||||||
K @RTN
|
K @RTN
|
||||||
D GETTXT^MXMLDOM("A")
|
D GETTXT^MXMLDOM("A")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
||||||
;I ZOID=149 B ;GPLTEST
|
;I ZOID=149 B ;GPLTEST
|
||||||
N X,Y
|
N X,Y
|
||||||
S Y=""
|
S Y=""
|
||||||
|
@ -115,17 +114,17 @@ TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
||||||
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
|
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
|
||||||
Q Y
|
Q Y
|
||||||
;
|
;
|
||||||
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
|
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
|
||||||
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
|
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
|
||||||
;
|
;
|
||||||
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
|
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
|
||||||
;N ZT,ZN S ZT=""
|
;N ZT,ZN S ZT=""
|
||||||
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
||||||
;Q $G(@C0CDOM@(ZOID,"T",1))
|
;Q $G(@C0CDOM@(ZOID,"T",1))
|
||||||
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
|
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
||||||
;
|
;
|
||||||
S C0CDOCID=INID
|
S C0CDOCID=INID
|
||||||
I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
|
I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
|
||||||
|
@ -136,7 +135,7 @@ OUTXML(ZRTN,INID,NO1ST) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
||||||
K ^TMP("MXMLBLD",$J)
|
K ^TMP("MXMLBLD",$J)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
|
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
|
||||||
N ZI S ZI=$$FIRST(ZOID)
|
N ZI S ZI=$$FIRST(ZOID)
|
||||||
I ZI'=0 D ; THERE IS A CHILD
|
I ZI'=0 D ; THERE IS A CHILD
|
||||||
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
|
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
|
||||||
|
|
22
p/C0CDPT.m
22
p/C0CDPT.m
|
@ -1,17 +1,21 @@
|
||||||
C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
;
|
||||||
|
; Copyright 2008 WorldVistA.
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
|
||||||
; General Public License.
|
|
||||||
;
|
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
;
|
||||||
;
|
;
|
||||||
; FAMILY Family Name
|
; FAMILY Family Name
|
||||||
; GIVEN Given Name
|
; GIVEN Given Name
|
||||||
|
|
27
p/C0CENC.m
27
p/C0CENC.m
|
@ -1,22 +1,19 @@
|
||||||
C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
|
C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2010 George Lilly, University of Minnesota and others.
|
;Copyright 2010 George Lilly, University of Minnesota and others.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -154,7 +151,7 @@ DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
|
||||||
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
||||||
; CPT^CATEGORY^TEXT
|
; CPT^CATEGORY^TEXT
|
||||||
N Z1,Z2,Z3,ZRTN
|
N Z1,Z2,Z3,ZRTN
|
||||||
S Z1=$P(ISTR,U,1)
|
S Z1=$P(ISTR,U,1)
|
||||||
I Z1="" D ;
|
I Z1="" D ;
|
||||||
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
||||||
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
||||||
|
|
17
p/C0CENV.m
17
p/C0CENV.m
|
@ -1,5 +1,20 @@
|
||||||
C0CENV ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009
|
C0CENV ;WV/JMC - CCD/CCR Environment Check/Install Routine ; Aug 16, 2009
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
;
|
||||||
|
; (C) John McCormack 2009
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
ENV ; Does not prevent loading of the transport global.
|
ENV ; Does not prevent loading of the transport global.
|
||||||
|
|
20
p/C0CEVC.m
20
p/C0CEVC.m
|
@ -1,5 +1,21 @@
|
||||||
C0CEVC ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
|
C0CEVC ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
;
|
||||||
|
; (C) Geroge Lilly 2010.
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
gpltest2 ; experiment with sending a CCR to an ewd page
|
gpltest2 ; experiment with sending a CCR to an ewd page
|
||||||
N ZI
|
N ZI
|
||||||
S ZI=""
|
S ZI=""
|
||||||
|
|
27
p/C0CEWD.m
27
p/C0CEWD.m
|
@ -1,21 +1,20 @@
|
||||||
C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
|
C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2011 George Lilly. Licensed under the terms of the GNU
|
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
;Copyright 2011 George Lilly.
|
||||||
;it under the terms of the GNU General Public License as published by
|
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
|
||||||
;(at your option) any later version.
|
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;GNU General Public License for more details.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; This program is distributed in the hope that it will be useful,
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
25
p/C0CEWD1.m
25
p/C0CEWD1.m
|
@ -1,21 +1,18 @@
|
||||||
C0CEWD1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
C0CEWD1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
29
p/C0CFM1.m
29
p/C0CFM1.m
|
@ -1,21 +1,20 @@
|
||||||
C0CFM1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
C0CFM1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR FILEMAN Utility Library ",!
|
W "This is the CCR FILEMAN Utility Library ",!
|
||||||
W !
|
W !
|
||||||
|
@ -68,7 +67,7 @@ PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
|
S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
|
||||||
K ZERR
|
K ZERR
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
||||||
I $D(ZERR) B ;OOPS
|
I $D(ZERR) S $EC=",U1,"
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
||||||
W "RECORD NUMBER: ",ZD0,!
|
W "RECORD NUMBER: ",ZD0,!
|
||||||
|
|
44
p/C0CFM2.m
44
p/C0CFM2.m
|
@ -1,21 +1,20 @@
|
||||||
C0CFM2 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
C0CFM2 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR FILEMAN Utility Library ",!
|
W "This is the CCR FILEMAN Utility Library ",!
|
||||||
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
|
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
|
||||||
|
@ -148,10 +147,7 @@ UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR
|
K ZERR
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
@ -182,7 +178,7 @@ CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR A PATIENT
|
||||||
. . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
|
. . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
|
||||||
. . W ZCHK,!
|
. . W ZCHK,!
|
||||||
. . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
|
. . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
|
||||||
ZWR ^TMP("C0CCHK",ZPAT,*)
|
; ZWR ^TMP("C0CCHK",ZPAT,*)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
|
DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
|
||||||
|
@ -223,7 +219,7 @@ SETXUP ; SET UP ENVIRONMENT
|
||||||
S XQXFLG="^^XUP"
|
S XQXFLG="^^XUP"
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
|
; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
|
||||||
; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
|
; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
|
||||||
; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
|
; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
|
||||||
|
@ -248,11 +244,10 @@ PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
K ZERR
|
K ZERR
|
||||||
;B
|
;B
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
||||||
I $D(ZERR) B ;OOPS
|
I $D(ZERR) S $EC=",U1,"
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
||||||
W "RECORD NUMBER: ",ZD0,!
|
W "RECORD NUMBER: ",ZD0,!
|
||||||
;B
|
|
||||||
S ZCNT=0
|
S ZCNT=0
|
||||||
S ZC0CI="" ;
|
S ZC0CI="" ;
|
||||||
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
||||||
|
@ -270,10 +265,7 @@ PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
44
p/C0CFM3.m
44
p/C0CFM3.m
|
@ -1,21 +1,20 @@
|
||||||
C0CFM3 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
C0CFM3 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR FILEMAN Utility Library ",!
|
W "This is the CCR FILEMAN Utility Library ",!
|
||||||
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
|
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
|
||||||
|
@ -134,14 +133,11 @@ UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR
|
K ZERR
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
PUTELSO(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
|
; 171.101, ^C0CE DFN IS THE PATIENT IEN PASSED BY VALUE
|
||||||
; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
|
; ZTYPE IS THE NODE TYPE IE RESULTS,PROBLEMS PASSED BY VALUE
|
||||||
; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
|
; ZOCC IS THE OCCURANCE NUMBER IE PROBLEM NUMBER 1,2,3 ETC
|
||||||
|
@ -166,7 +162,7 @@ PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
K ZERR
|
K ZERR
|
||||||
;B
|
;B
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
||||||
I $D(ZERR) B ;OOPS
|
I $D(ZERR) S $EC=",U1,"
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
||||||
W "RECORD NUMBER: ",ZD0,!
|
W "RECORD NUMBER: ",ZD0,!
|
||||||
|
@ -188,10 +184,7 @@ PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||||
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
@ -282,6 +275,7 @@ SHOWE4(DFN) ;
|
||||||
;
|
;
|
||||||
N ZG
|
N ZG
|
||||||
S ZG=""
|
S ZG=""
|
||||||
F S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG="" D ZWR ^C0CE4(ZG,*)
|
F S ZG=$O(^C0CE4("P",DFN,ZG)) Q:ZG="" D
|
||||||
|
. ; ZWR ^C0CE4(ZG,*)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
25
p/C0CIM2.m
25
p/C0CIM2.m
|
@ -1,22 +1,19 @@
|
||||||
C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
|
C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2010 George Lilly, University of Minnesota and others.
|
;Copyright 2010 George Lilly, University of Minnesota and others.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
|
26
p/C0CIMMU.m
26
p/C0CIMMU.m
|
@ -1,23 +1,19 @@
|
||||||
C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
|
C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
|
; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
|
||||||
;
|
;
|
||||||
|
|
31
p/C0CIN.m
31
p/C0CIN.m
|
@ -1,21 +1,19 @@
|
||||||
C0CIN ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
|
C0CIN ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR Import Utility Library ",!
|
W "This is the CCR Import Utility Library ",!
|
||||||
Q
|
Q
|
||||||
|
@ -184,10 +182,7 @@ UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR,C0CIEN
|
K ZERR,C0CIEN
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
|
D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
40
p/C0CLA7DD.m
40
p/C0CLA7DD.m
|
@ -1,8 +1,22 @@
|
||||||
C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009
|
C0CLA7DD ;WV/JMC - CCD/CCR Post Install DD X-Ref Setup Routine ; Aug 31, 2009 ; 10/30/12 10:16am
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;
|
; (C) 2009 John McCormack
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file.
|
; Tasked by C0C post-install routine C0CENV to create C0C cross-references on V LAB file.
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
|
@ -248,12 +262,12 @@ BMES(STR) ; Write BMES^XPDUTL statements
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
SENDXQA(MSG) ; Send alert for reindex status
|
SENDXQA(MSG) ; Send alert for reindex status
|
||||||
;
|
;
|
||||||
N XQA,XQAMSG
|
N XQA,XQAMSG
|
||||||
;
|
;
|
||||||
S XQA(DUZ)=""
|
S XQA(DUZ)=""
|
||||||
S XQAMSG=MSG
|
S XQAMSG=MSG
|
||||||
D SETUP^XQALERT
|
D SETUP^XQALERT
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
|
|
19
p/C0CLA7Q.m
19
p/C0CLA7Q.m
|
@ -1,5 +1,20 @@
|
||||||
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009
|
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009 ; 10/30/12 10:16am
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
;
|
||||||
|
; (C) 2009 John McCormack
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
|
|
31
p/C0CLABS.m
31
p/C0CLABS.m
|
@ -1,23 +1,20 @@
|
||||||
C0CLABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ; 5/10/12 2:49pm
|
C0CLABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08 ; 5/10/12 2:49pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
|
||||||
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
||||||
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
|
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
|
||||||
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
||||||
|
@ -63,7 +60,7 @@ RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
||||||
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
|
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
|
||||||
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
||||||
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
||||||
I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
|
I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
|
||||||
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
||||||
K @RIMVARS
|
K @RIMVARS
|
||||||
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
||||||
|
@ -106,7 +103,7 @@ RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
||||||
. ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
|
. ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
|
||||||
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
||||||
. ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
|
. ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
|
||||||
. . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;
|
. ;. D CP^C0CXPATH(C0CRTMP,"RTN") ;
|
||||||
. ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
|
. ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
|
||||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
||||||
D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
|
D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
|
||||||
|
|
27
p/C0CMAIL.m
27
p/C0CMAIL.m
|
@ -1,24 +1,21 @@
|
||||||
C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
|
C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
|
||||||
V ;;1.2;C0C;;May 11, 2012;Build 47
|
V ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2011 Chris Richardson, Richardson Computer Research
|
;Copyright 2011 Chris Richardson, Richardson Computer Research
|
||||||
; Modified 3110516@1818
|
; Modified 3110516@1818
|
||||||
; rcr@rcresearch.us
|
; rcr@rcresearch.us
|
||||||
; Licensed under the terms of the GNU
|
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
; ------------------
|
; ------------------
|
||||||
;Entry Points
|
;Entry Points
|
||||||
|
|
25
p/C0CMAIL2.m
25
p/C0CMAIL2.m
|
@ -1,24 +1,21 @@
|
||||||
C0CMAIL2 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:50pm
|
C0CMAIL2 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:50pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2011 Chris Richardson, Richardson Computer Research
|
;Copyright 2011 Chris Richardson, Richardson Computer Research
|
||||||
; Modified 3110615@1040
|
; Modified 3110615@1040
|
||||||
; rcr@rcresearch.us
|
; rcr@rcresearch.us
|
||||||
; Licensed under the terms of the GNU
|
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
; ------------------
|
; ------------------
|
||||||
;Entry Points
|
;Entry Points
|
||||||
|
|
25
p/C0CMAIL3.m
25
p/C0CMAIL3.m
|
@ -1,24 +1,21 @@
|
||||||
C0CMAIL3 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:51pm
|
C0CMAIL3 ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr ; 5/10/12 2:51pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2011 Chris Richardson, Richardson Computer Research
|
;Copyright 2011 Chris Richardson, Richardson Computer Research
|
||||||
; Modified 3110619@2038
|
; Modified 3110619@2038
|
||||||
; rcr@rcresearch.us
|
; rcr@rcresearch.us
|
||||||
; Licensed under the terms of the GNU
|
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
; ------------------
|
; ------------------
|
||||||
;Entry Points
|
;Entry Points
|
||||||
|
|
35
p/C0CMCCD.m
35
p/C0CMCCD.m
|
@ -1,21 +1,19 @@
|
||||||
C0CMCCD ; GPL - MXML based CCD utilities;12/04/09 17:05
|
C0CMCCD ; GPL - MXML based CCD utilities;12/04/09 17:05
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
@ -280,14 +278,11 @@ WHRUSD(ZD) ; UPDATE THE C0C XDS FILE WITH WHERE USED DATA FROM
|
||||||
. I ZI="" S DONE=1
|
. I ZI="" S DONE=1
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR
|
K ZERR
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
53
p/C0CMED.m
53
p/C0CMED.m
|
@ -1,22 +1,20 @@
|
||||||
C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
|
C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
|
; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
|
||||||
; Licensed under the terms of the GNU General Public License.
|
;
|
||||||
; See attached copy of the License.
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; it under the terms of the GNU General Public License as published by
|
; License, or (at your option) any later version.
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
;
|
||||||
; (at your option) any later version.
|
|
||||||
;
|
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
;
|
||||||
;
|
;
|
||||||
; --Revision History
|
; --Revision History
|
||||||
; July 2008 - Initial Version/GPL
|
; July 2008 - Initial Version/GPL
|
||||||
|
@ -52,7 +50,7 @@ EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML t
|
||||||
W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
|
W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
|
||||||
I $$RPMS^C0CUTIL() D RPMS QUIT
|
I $$RPMS^C0CUTIL() D RPMS QUIT
|
||||||
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
|
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
|
||||||
RPMS
|
RPMS ;
|
||||||
;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
|
;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
|
||||||
N MEDCOUNT S MEDCOUNT=0
|
N MEDCOUNT S MEDCOUNT=0
|
||||||
K ^TMP($J,"MED")
|
K ^TMP($J,"MED")
|
||||||
|
@ -61,15 +59,15 @@ RPMS
|
||||||
S @HIST@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
|
S @HIST@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
|
||||||
D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
|
D EXTRACT^C0CMED6(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
|
||||||
D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
||||||
I @HIST@(0)>0 D
|
I @HIST@(0)>0 D
|
||||||
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
||||||
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
||||||
I @NVA@(0)>0 D
|
I @NVA@(0)>0 D
|
||||||
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
||||||
. ;E D CP^C0CXPATH(NVA,MEDOUTXML)
|
. ;E D CP^C0CXPATH(NVA,MEDOUTXML)
|
||||||
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
||||||
Q
|
Q
|
||||||
VISTA
|
VISTA ;
|
||||||
N MEDCOUNT S MEDCOUNT=0
|
N MEDCOUNT S MEDCOUNT=0
|
||||||
K ^TMP($J,"MED")
|
K ^TMP($J,"MED")
|
||||||
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
||||||
|
@ -87,20 +85,20 @@ VISTA
|
||||||
;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
||||||
D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
|
D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
|
||||||
D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
|
D EXTRACT^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
|
||||||
I @HIST@(0)>0 D
|
I @HIST@(0)>0 D
|
||||||
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
||||||
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
||||||
I @PEND@(0)>0 D
|
I @PEND@(0)>0 D
|
||||||
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
|
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
|
||||||
. E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
|
. E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
|
||||||
. W:$G(DEBUG) "HAS OP PENDING MEDS",!
|
. W:$G(DEBUG) "HAS OP PENDING MEDS",!
|
||||||
I @NVA@(0)>0 D
|
I @NVA@(0)>0 D
|
||||||
. I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
. I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
||||||
. E D CP^C0CXPATH(NVA,MEDOUTXML)
|
. E D CP^C0CXPATH(NVA,MEDOUTXML)
|
||||||
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
||||||
I @IPUD@(0)>0 D
|
I @IPUD@(0)>0 D
|
||||||
. I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD)
|
. I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD)
|
||||||
. E D CP^C0CXPATH(IPUD,MEDOUTXML)
|
. E D CP^C0CXPATH(IPUD,MEDOUTXML)
|
||||||
. W:$G(DEBUG) "HAS INPATIENT MEDS",!
|
. W:$G(DEBUG) "HAS INPATIENT MEDS",!
|
||||||
N ZI
|
N ZI
|
||||||
S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
||||||
|
@ -111,4 +109,3 @@ VISTA
|
||||||
K @NVA
|
K @NVA
|
||||||
K @IPUD
|
K @IPUD
|
||||||
Q
|
Q
|
||||||
|
|
||||||
|
|
24
p/C0CMED1.m
24
p/C0CMED1.m
|
@ -1,22 +1,20 @@
|
||||||
C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
|
C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;;Last modified Sat Jan 10 21:42:27 PST 2009
|
;;Last modified Sat Jan 10 21:42:27 PST 2009
|
||||||
; Copyright 2009 WorldVistA. Licensed under the terms of the GNU
|
; Copyright 2009 WorldVistA.
|
||||||
; General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; (at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -57,12 +55,12 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XM
|
||||||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||||||
; If it is -1, we quit.
|
; If it is -1, we quit.
|
||||||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q
|
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 Q
|
||||||
ZWRITE:$G(DEBUG) MEDS
|
; ZWRITE:$G(DEBUG) MEDS
|
||||||
N RXIEN S RXIEN=0
|
N RXIEN S RXIEN=0
|
||||||
F S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)="" D ; FOR EACH MEDICATION IN THE LIST
|
F S RXIEN=$O(MEDS(RXIEN)) Q:$G(RXIEN)="" D ; FOR EACH MEDICATION IN THE LIST
|
||||||
. N MED M MED=MEDS(RXIEN)
|
. N MED M MED=MEDS(RXIEN)
|
||||||
. I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
|
. I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
|
||||||
. I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
|
. I 'ALL,PENDING,$P(MED(100),U,2)'="PENDING" QUIT ;OHUM/RUT 3120504 ADDED FOR VALIDATION OF PENDING MEDICATIONS
|
||||||
. S MEDCOUNT=MEDCOUNT+1
|
. S MEDCOUNT=MEDCOUNT+1
|
||||||
. W:$G(DEBUG) "RXIEN IS ",RXIEN,!
|
. W:$G(DEBUG) "RXIEN IS ",RXIEN,!
|
||||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||||
|
|
22
p/C0CMED2.m
22
p/C0CMED2.m
|
@ -1,22 +1,20 @@
|
||||||
C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
|
C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;;Last Modified Sat Jan 10 21:41:14 PST 2009
|
;;Last Modified Sat Jan 10 21:41:14 PST 2009
|
||||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
; Copyright 2008 WorldVistA.
|
||||||
; General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; (at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -47,7 +45,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDE
|
||||||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||||||
; If it is -1, we quit.
|
; If it is -1, we quit.
|
||||||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
||||||
ZWRITE:$G(DEBUG) MEDS
|
; ZWRITE:$G(DEBUG) MEDS
|
||||||
N RXIEN S RXIEN=0
|
N RXIEN S RXIEN=0
|
||||||
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
|
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED IN THIS SECTION FOR MERGING
|
||||||
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST
|
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="B" D ; FOR EACH MEDICATION IN THE LIST
|
||||||
|
|
22
p/C0CMED3.m
22
p/C0CMED3.m
|
@ -1,22 +1,20 @@
|
||||||
C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
|
C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
|
;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
|
||||||
; Copyright 2009 WorldVistA. Licensed under the terms of the GNU
|
; Copyright 2009 WorldVistA.
|
||||||
; General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; (at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -48,7 +46,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml temp
|
||||||
; We are done with NVA
|
; We are done with NVA
|
||||||
K NVA
|
K NVA
|
||||||
;
|
;
|
||||||
I DEBUG ZWRITE MEDS
|
; I DEBUG ZWRITE MEDS
|
||||||
N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
|
N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
|
||||||
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
|
N MEDFIRST S MEDFIRST=1 ; FLAG FOR FIRST MED PROCESSED HERE
|
||||||
F S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN="" D ; FOR EACH MEDICATION IN THE LIST
|
F S FDAIEN=$O(MEDS(FDAIEN)) Q:FDAIEN="" D ; FOR EACH MEDICATION IN THE LIST
|
||||||
|
|
40
p/C0CMED4.m
40
p/C0CMED4.m
|
@ -1,21 +1,19 @@
|
||||||
C0CMED4 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:38pm
|
C0CMED4 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:38pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
; Copyright 2008 WorldVistA.
|
||||||
; General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; (at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -48,10 +46,10 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
|
||||||
I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit
|
I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit
|
||||||
; Otherwise, we go on...
|
; Otherwise, we go on...
|
||||||
M MEDS=^TMP($J,"UD")
|
M MEDS=^TMP($J,"UD")
|
||||||
I DEBUG ZWR MEDS
|
; I DEBUG ZWR MEDS
|
||||||
S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
|
S MEDMAP=$NA(^TMP("GPLCCR",$J,"MEDMAP"))
|
||||||
N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
|
N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
|
||||||
N I S I=0
|
N I S I=0
|
||||||
F S I=$O(MEDS("B",I)) Q:'I D ; For each medication in B index
|
F S I=$O(MEDS("B",I)) Q:'I D ; For each medication in B index
|
||||||
. N MED M MED=MEDS(I)
|
. N MED M MED=MEDS(I)
|
||||||
. S MEDCOUNT=MEDCOUNT+1
|
. S MEDCOUNT=MEDCOUNT+1
|
||||||
|
@ -60,7 +58,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
|
||||||
. N RXIEN S RXIEN=MED(.01) ; Order Number
|
. N RXIEN S RXIEN=MED(.01) ; Order Number
|
||||||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||||||
. I DEBUG W "MAP= ",MAP,!
|
. I DEBUG W "MAP= ",MAP,!
|
||||||
. S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
|
. S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
|
||||||
. S @MAP@("MEDISSUEDATETXT")="Order Date"
|
. S @MAP@("MEDISSUEDATETXT")="Order Date"
|
||||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
|
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
|
||||||
. S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
|
. S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
|
||||||
|
@ -69,7 +67,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
|
||||||
. S @MAP@("MEDRXNO")="" ; For Outpatient
|
. S @MAP@("MEDRXNO")="" ; For Outpatient
|
||||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||||
. S @MAP@("MEDSTATUSTEXT")="ACTIVE"
|
. S @MAP@("MEDSTATUSTEXT")="ACTIVE"
|
||||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
|
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
|
||||||
. S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
|
. S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
|
||||||
. ; NDC is field 31 in the drug file.
|
. ; NDC is field 31 in the drug file.
|
||||||
|
@ -113,7 +111,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
|
||||||
. . D DATA^PSS50(MEDIEN,,,,,"QTY")
|
. . D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||||
. . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
. . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||||
. . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
. . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||||
E S @MAP@("MEDQUANTITYUNIT")=""
|
. E S @MAP@("MEDQUANTITYUNIT")=""
|
||||||
. ;
|
. ;
|
||||||
. ; --- START OF DIRECTIONS ---
|
. ; --- START OF DIRECTIONS ---
|
||||||
. ; Dosage is field 2, route is 3, schedule is 4
|
. ; Dosage is field 2, route is 3, schedule is 4
|
||||||
|
@ -125,9 +123,9 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
||||||
|
@ -142,7 +140,7 @@ EXTRACT(MINXML,DFN,OUTXML) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEM
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
||||||
. ;
|
. ;
|
||||||
|
|
29
p/C0CMED6.m
29
p/C0CMED6.m
|
@ -1,21 +1,19 @@
|
||||||
C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
|
C0CMED6 ; WV/CCDCCR/SMH - Meds from RPMS: Outpatient Meds;01/10/09
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
; Copyright 2008 WorldVistA.
|
||||||
; General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; (at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -54,7 +52,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED X
|
||||||
S @OUTXML@(0)=0 ;By default, no meds
|
S @OUTXML@(0)=0 ;By default, no meds
|
||||||
; If MEDS1 is not defined, then no meds
|
; If MEDS1 is not defined, then no meds
|
||||||
I '$D(MEDS1) QUIT
|
I '$D(MEDS1) QUIT
|
||||||
I DEBUG ZWR MEDS1,MINXML
|
;I DEBUG ZWR MEDS1,MINXML
|
||||||
N MEDCNT S MEDCNT=0 ; Med Count
|
N MEDCNT S MEDCNT=0 ; Med Count
|
||||||
; The next line is a super line. It goes through the array return
|
; The next line is a super line. It goes through the array return
|
||||||
; and if the first characters are ~OP, it grabs the line.
|
; and if the first characters are ~OP, it grabs the line.
|
||||||
|
@ -228,7 +226,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED X
|
||||||
. . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
|
. . D FIND^DIC(51.1,,"@;2","PX",SCHNOPRN,1,"B",,,"C0C515")
|
||||||
. . N INTERVAL S INTERVAL="" ; Default
|
. . N INTERVAL S INTERVAL="" ; Default
|
||||||
. . ; If there are entries found, get it
|
. . ; If there are entries found, get it
|
||||||
. . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2)
|
. . I +$G(C0C515("DILIST",0)) S INTERVAL=$P(C0C515("DILIST",1,0),U,2)
|
||||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
||||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
||||||
. . ; Duration is 10M minutes, 10H hours, 10D for Days
|
. . ; Duration is 10M minutes, 10H hours, 10D for Days
|
||||||
|
@ -264,7 +262,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED X
|
||||||
. ; Notice buffer overflow protection set at 10,000 chars
|
. ; Notice buffer overflow protection set at 10,000 chars
|
||||||
. ; -- 1. Med Patient Instructions
|
. ; -- 1. Med Patient Instructions
|
||||||
. N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
|
. N MEDPTIN1 S MEDPTIN1=$$GET1^DIQ(52,RXIEN,115,,"MEDPTIN1")
|
||||||
. N MEDPTIN2,J S (MEDPTIN2,J)=""
|
. N MEDPTIN2,J S (MEDPTIN2,J)=""
|
||||||
. I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
|
. I $L(MEDPTIN1) F S J=$O(@MEDPTIN1@(J)) Q:J="" Q:$L(MEDPTIN2)>10000 S MEDPTIN2=MEDPTIN2_@MEDPTIN1@(J)_" "
|
||||||
. S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
|
. S @MAP@("MEDPTINSTRUCTIONS")=MEDPTIN2
|
||||||
. K J
|
. K J
|
||||||
|
@ -311,7 +309,7 @@ GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm
|
||||||
S NDC=$TR(NDC,"-") ; Remove dashes
|
S NDC=$TR(NDC,"-") ; Remove dashes
|
||||||
N RXNORM,C0CZRXN,DIERR
|
N RXNORM,C0CZRXN,DIERR
|
||||||
D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
|
D FIND^DIC(176.002,,"@;.01","PX",NDC,"*","NDC",,,"C0CZRXN","DIERR")
|
||||||
I $D(DIERR) D ^%ZTER BREAK
|
I $D(DIERR) S $EC=",U1,"
|
||||||
S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
|
S RXNORM(0)=+C0CZRXN("DILIST",0) ; RxNorm(0) will be # of entries
|
||||||
N I S I=0
|
N I S I=0
|
||||||
F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
|
F S I=$O(C0CZRXN("DILIST",I)) Q:I="" S RXNORM(I)=$P(C0CZRXN("DILIST",I,0),U,2)
|
||||||
|
@ -328,4 +326,3 @@ GETRXN(NDC) ; Extrinsic Function; PUBLIC; NDC to RxNorm
|
||||||
. . I +$G(RXNIEN)=0 QUIT ; try the next entry...
|
. . I +$G(RXNIEN)=0 QUIT ; try the next entry...
|
||||||
. . E S RXNORM=RXNORM(I) QUIT ; We found the right code
|
. . E S RXNORM=RXNORM(I) QUIT ; We found the right code
|
||||||
QUIT +$G(RXNORM) ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
|
QUIT +$G(RXNORM) ; RETURN RXNORM; if we couldn't find a clnical drug, return with 0
|
||||||
|
|
||||||
|
|
40
p/C0CMIME.m
40
p/C0CMIME.m
|
@ -1,21 +1,19 @@
|
||||||
C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm
|
C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2008 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
@ -44,7 +42,7 @@ ENCODE(ZRTN,ZARY) ;
|
||||||
D CHUNK(ZRTN,"G",45)
|
D CHUNK(ZRTN,"G",45)
|
||||||
Q
|
Q
|
||||||
; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN
|
; THIS ROUTINE WAS COPIED FROM LRSRVR4 AND THEN MODIFIED . THANKS JOHN
|
||||||
ENCODEOLD(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line
|
ENCODEO(IARY,LRNODE,LRSTR) ; Encode a string, keep remainder for next line
|
||||||
; Call with LRSTR by reference, Remainder returned in LRSTR
|
; Call with LRSTR by reference, Remainder returned in LRSTR
|
||||||
; IARY IS PASSED BY NAME
|
; IARY IS PASSED BY NAME
|
||||||
S LRQUIT=0,LRLEN=$L(LRSTR)
|
S LRQUIT=0,LRLEN=$L(LRSTR)
|
||||||
|
@ -69,10 +67,10 @@ TESTMAIL ;
|
||||||
. M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
|
. M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
|
||||||
S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
|
S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
|
||||||
D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH)
|
D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,,ZATTACH)
|
||||||
ZWR GR
|
; ZWR GR
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TESTMAIL2 ;
|
TESTMAI2 ;
|
||||||
; TEST OF MAILSEND TO gpl.mdc-crew.net
|
; TEST OF MAILSEND TO gpl.mdc-crew.net
|
||||||
N C0CGM
|
N C0CGM
|
||||||
S C0CGM(1)="This is a test message."
|
S C0CGM(1)="This is a test message."
|
||||||
|
@ -84,7 +82,7 @@ TESTMAIL2 ;
|
||||||
;S ZTO("george.lilly@pobox.com")=""
|
;S ZTO("george.lilly@pobox.com")=""
|
||||||
;S ZTO("george@nhin.openforum.opensourcevista.net")=""
|
;S ZTO("george@nhin.openforum.opensourcevista.net")=""
|
||||||
;S ZTO("mish@nhin.openforum.opensourcevista.net")=""
|
;S ZTO("mish@nhin.openforum.opensourcevista.net")=""
|
||||||
S ZTO("brooks.richard@securemail.opensourcevista.net")=""
|
S ZTO("brooks.richard@securemail.opensourcevista.net")=""
|
||||||
;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
|
;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
|
||||||
;S ZTO("ncoal@live.com")=""
|
;S ZTO("ncoal@live.com")=""
|
||||||
;S ZTO("martijn@djigzo.com")=""
|
;S ZTO("martijn@djigzo.com")=""
|
||||||
|
@ -98,7 +96,7 @@ TESTMAIL2 ;
|
||||||
. M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
|
. M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
|
||||||
S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
|
S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
|
||||||
D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")
|
D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")
|
||||||
ZWR GR
|
; ZWR GR
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
LINE(C0CFILE,C0CTO) ; read a file name passed in C0CFILE and send it to
|
LINE(C0CFILE,C0CTO) ; read a file name passed in C0CFILE and send it to
|
||||||
|
@ -202,7 +200,7 @@ MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FNAME,FLAGS) ; MAIL SENDING INTER
|
||||||
S RTN(1)="OK"
|
S RTN(1)="OK"
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
MAILSEND0(LRMSUBJ) ; Send extract back to requestor.
|
MAILSEN0(LRMSUBJ) ; Send extract back to requestor.
|
||||||
;
|
;
|
||||||
;D TEST
|
;D TEST
|
||||||
S GN=$NA(^TMP($J,"C0CMIME"))
|
S GN=$NA(^TMP($J,"C0CMIME"))
|
||||||
|
@ -250,7 +248,7 @@ MAILSEND0(LRMSUBJ) ; Send extract back to requestor.
|
||||||
;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
|
;S ^XMB(3.9,LRTASK,1,.1130591,0)="Content-type: multipart/mixed; boundary=000e0cd6ae026c3d4b049e7befe9"
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
MAILSEND2(UDFN,ADDR) ; Send extract back to requestor.
|
MAILSEN2(UDFN,ADDR) ; Send extract back to requestor.
|
||||||
;
|
;
|
||||||
I +$G(UDFN)=0 S UDFN=2 ;
|
I +$G(UDFN)=0 S UDFN=2 ;
|
||||||
D TEST(UDFN)
|
D TEST(UDFN)
|
||||||
|
|
37
p/C0CMXML.m
37
p/C0CMXML.m
|
@ -1,21 +1,19 @@
|
||||||
C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05
|
C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
|
; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
|
||||||
|
@ -44,7 +42,7 @@ TEST2 ;
|
||||||
D XPATH(1,"/","GIDX","GARY","",REDUX)
|
D XPATH(1,"/","GIDX","GARY","",REDUX)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TEST3
|
TEST3 ;
|
||||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||||
K GARY,GTMP,GIDX
|
K GARY,GTMP,GIDX
|
||||||
K @C0CXMLIN
|
K @C0CXMLIN
|
||||||
|
@ -113,7 +111,7 @@ TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
|
||||||
D NDOUT($$FIRST(1))
|
D NDOUT($$FIRST(1))
|
||||||
D END^C0CMXMLB ;END THE DOCUMENT
|
D END^C0CMXMLB ;END THE DOCUMENT
|
||||||
M ZCCR=^TMP("MXMLBLD",$J)
|
M ZCCR=^TMP("MXMLBLD",$J)
|
||||||
ZWR ZCCR
|
; ZWR ZCCR
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
|
TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
|
||||||
|
@ -136,7 +134,7 @@ TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
|
||||||
;D NDOUT($$FIRST(1))
|
;D NDOUT($$FIRST(1))
|
||||||
;D END^C0CMXMLB ;EOND THE DOCUMENT
|
;D END^C0CMXMLB ;EOND THE DOCUMENT
|
||||||
;M ZCCD=^TMP("MXMLBLD",$J)
|
;M ZCCD=^TMP("MXMLBLD",$J)
|
||||||
ZWR ZCCD(1:30)
|
; ZWR ZCCD(1:30)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
||||||
|
@ -245,10 +243,7 @@ UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR
|
K ZERR
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
|
@ -1,7 +1,9 @@
|
||||||
C0CMXMLB ;;ISF/RWF - Tool to build XML ; 5/10/12 2:51pm
|
C0CMXMLB ;;ISF/RWF - Tool to build XML ; 5/10/12 2:51pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
QUIT
|
QUIT
|
||||||
;
|
;
|
||||||
|
; FOIA Routine - Public Domain
|
||||||
|
;
|
||||||
;DOC - The top level tag
|
;DOC - The top level tag
|
||||||
;DOCTYPE - Want to include a DOCTYPE node
|
;DOCTYPE - Want to include a DOCTYPE node
|
||||||
;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
|
;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
|
||||||
|
@ -9,7 +11,7 @@ START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
|
||||||
K ^TMP("MXMLBLD",$J)
|
K ^TMP("MXMLBLD",$J)
|
||||||
S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
|
S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
|
||||||
I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
|
I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
|
||||||
I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
|
I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
|
||||||
D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
|
D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
33
p/C0CMXP.m
33
p/C0CMXP.m
|
@ -1,21 +1,19 @@
|
||||||
C0CMXP ; GPL - MXML based XPath utilities;12/04/09 17:05
|
C0CMXP ; GPL - MXML based XPath utilities;12/04/09 17:05
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
@ -166,7 +164,7 @@ MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
|
||||||
M @C0CXLOC=@INXML
|
M @C0CXLOC=@INXML
|
||||||
S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
|
S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
|
||||||
K @C0CXLOC
|
K @C0CXLOC
|
||||||
S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
||||||
;N GIDX,GIDX2,GARY,GARY2
|
;N GIDX,GIDX2,GARY,GARY2
|
||||||
I '$D(REDUX) S REDUX=""
|
I '$D(REDUX) S REDUX=""
|
||||||
D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
|
D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
|
||||||
|
@ -283,10 +281,7 @@ UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR
|
K ZERR
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
50
p/C0CNHIN.m
50
p/C0CNHIN.m
|
@ -1,21 +1,19 @@
|
||||||
C0CNHIN ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11 17:05
|
C0CNHIN ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11 17:05
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2011 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2011 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
|
EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
|
||||||
|
@ -145,7 +143,7 @@ TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
|
||||||
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
|
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
DOMO(ZOID,ZPATH,ZNARY,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
||||||
; THE XPATH INDEX ZXIDX, PASSED BY NAME
|
; THE XPATH INDEX ZXIDX, PASSED BY NAME
|
||||||
; THE XPATH ARRAY XPARY, PASSED BY NAME
|
; THE XPATH ARRAY XPARY, PASSED BY NAME
|
||||||
; ZOID IS THE STARTING OID
|
; ZOID IS THE STARTING OID
|
||||||
|
@ -204,32 +202,32 @@ ADDNARY(ZXP,ZVALUE) ; ADD AN NHIN ARRAY VALUE TO ZNARY
|
||||||
I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
|
I ZZJ'="" S @ZNARY@(ZZI,ZZN,ZZJ)=ZVALUE
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
|
PARSE(INXML,INDOC) ;CALL THE MXML PARSER ON INXML, PASSED BY NAME
|
||||||
; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
|
; INDOC IS PASSED AS THE DOCUMENT NAME - DON'T KNOW WHERE TO STORE THIS NOW
|
||||||
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
|
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
|
||||||
;Q $$EN^MXMLDOM(INXML)
|
;Q $$EN^MXMLDOM(INXML)
|
||||||
Q $$EN^MXMLDOM(INXML,"W")
|
Q $$EN^MXMLDOM(INXML,"W")
|
||||||
;
|
;
|
||||||
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
|
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
|
||||||
N ZN
|
N ZN
|
||||||
;I $$TAG(ZOID)["entry" B
|
;I $$TAG(ZOID)["entry" B
|
||||||
S ZN=$$NXTSIB(ZOID)
|
S ZN=$$NXTSIB(ZOID)
|
||||||
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
|
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
|
||||||
Q 0
|
Q 0
|
||||||
;
|
;
|
||||||
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
|
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
|
||||||
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
|
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
|
||||||
;
|
;
|
||||||
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
|
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
|
||||||
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
|
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
|
||||||
;
|
;
|
||||||
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
|
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
|
||||||
S HANDLE=C0CDOCID
|
S HANDLE=C0CDOCID
|
||||||
K @RTN
|
K @RTN
|
||||||
D GETTXT^MXMLDOM("A")
|
D GETTXT^MXMLDOM("A")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
||||||
;I ZOID=149 B ;GPLTEST
|
;I ZOID=149 B ;GPLTEST
|
||||||
N X,Y
|
N X,Y
|
||||||
S Y=""
|
S Y=""
|
||||||
|
@ -238,17 +236,17 @@ TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
||||||
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
|
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
|
||||||
Q Y
|
Q Y
|
||||||
;
|
;
|
||||||
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
|
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
|
||||||
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
|
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
|
||||||
;
|
;
|
||||||
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
|
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
|
||||||
;N ZT,ZN S ZT=""
|
;N ZT,ZN S ZT=""
|
||||||
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
||||||
;Q $G(@C0CDOM@(ZOID,"T",1))
|
;Q $G(@C0CDOM@(ZOID,"T",1))
|
||||||
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
|
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
||||||
;
|
;
|
||||||
S C0CDOCID=INID
|
S C0CDOCID=INID
|
||||||
D START^C0CMXMLB($$TAG(1),,"G")
|
D START^C0CMXMLB($$TAG(1),,"G")
|
||||||
|
@ -258,7 +256,7 @@ OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
||||||
K ^TMP("MXMLBLD",$J)
|
K ^TMP("MXMLBLD",$J)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
|
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
|
||||||
N ZI S ZI=$$FIRST(ZOID)
|
N ZI S ZI=$$FIRST(ZOID)
|
||||||
I ZI'=0 D ; THERE IS A CHILD
|
I ZI'=0 D ; THERE IS A CHILD
|
||||||
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
|
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
|
||||||
|
|
26
p/C0CNMED2.m
26
p/C0CNMED2.m
|
@ -1,22 +1,20 @@
|
||||||
C0CNMED2 ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 ; 5/10/12 2:53pm
|
C0CNMED2 ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009 ; 5/10/12 2:53pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
|
; Copyright 2008,2009 George Lilly, University of Minnesota and Sam Habiel.
|
||||||
; Licensed under the terms of the GNU General Public License.
|
;
|
||||||
; See attached copy of the License.
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; it under the terms of the GNU General Public License as published by
|
; License, or (at your option) any later version.
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
;
|
||||||
; (at your option) any later version.
|
|
||||||
;
|
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
;
|
||||||
;
|
;
|
||||||
; --Revision History
|
; --Revision History
|
||||||
; July 2008 - Initial Version/GPL
|
; July 2008 - Initial Version/GPL
|
||||||
|
|
48
p/C0CNMED4.m
48
p/C0CNMED4.m
|
@ -1,21 +1,19 @@
|
||||||
C0CNMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm
|
C0CNMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08 ; 5/10/12 2:54pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
; Copyright 2008 WorldVistA.
|
||||||
; General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; (at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -57,19 +55,19 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMP
|
||||||
. I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1
|
. I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1
|
||||||
IF ZCOUNT=0 Q ; no inpatient meds
|
IF ZCOUNT=0 Q ; no inpatient meds
|
||||||
;M MEDS=^TMP($J,"UD")
|
;M MEDS=^TMP($J,"UD")
|
||||||
I DEBUG ZWR MEDS
|
;I DEBUG ZWR MEDS
|
||||||
S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
||||||
;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
|
;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
|
||||||
S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG
|
S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING") ;SETTING FLAG
|
||||||
N I S I=0
|
N I S I=0
|
||||||
F S I=$O(MEDS("med",I)) Q:'I D ; For each medication
|
F S I=$O(MEDS("med",I)) Q:'I D ; For each medication
|
||||||
. ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT
|
. ;OHUM/RUT 3120507 ;STATUS VALIDATION FOR INPATIENT
|
||||||
. I ($P(C0CMFLAG,"^",1)'=1) D
|
. I ($P(C0CMFLAG,"^",1)'=1) D
|
||||||
. . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
|
. . I ($P(C0CMFLAG,"^",3)=1)&(MEDS("med",I,"vaStatus@value")'="ACTIVE") D
|
||||||
. . . K MEDS("med",I) Q
|
. . . K MEDS("med",I) Q
|
||||||
. . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
|
. . I ($P(C0CMFLAG,"^",4)=1)&(MEDS("med",I,"vaStatus@value")'="PENDING") D
|
||||||
. . . K MEDS("med",I) Q
|
. . . K MEDS("med",I) Q
|
||||||
. ;OHUM/RUT
|
. ;OHUM/RUT
|
||||||
. N MED M MED=MEDS("med",I)
|
. N MED M MED=MEDS("med",I)
|
||||||
. I $G(MED("vaType@value"))'="I" Q ; not inpatient
|
. I $G(MED("vaType@value"))'="I" Q ; not inpatient
|
||||||
. S MEDCOUNT=MEDCOUNT+1
|
. S MEDCOUNT=MEDCOUNT+1
|
||||||
|
@ -79,7 +77,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMP
|
||||||
. N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med
|
. N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med
|
||||||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||||||
. I DEBUG W "MAP= ",MAP,!
|
. I DEBUG W "MAP= ",MAP,!
|
||||||
. S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
|
. S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
|
||||||
. S @MAP@("MEDISSUEDATETXT")="Order Date"
|
. S @MAP@("MEDISSUEDATETXT")="Order Date"
|
||||||
. ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
|
. ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
|
||||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT")
|
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT")
|
||||||
|
@ -173,9 +171,9 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMP
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
||||||
|
@ -190,7 +188,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMP
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
||||||
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
||||||
. ;
|
. ;
|
||||||
|
|
25
p/C0CORSLT.m
25
p/C0CORSLT.m
|
@ -1,22 +1,19 @@
|
||||||
C0CORSLT ; CCDCCR/GPL - CCR/CCD PROCESSING ADDITIONAL RESULTS ; 06/27/11
|
C0CORSLT ; CCDCCR/GPL - CCR/CCD PROCESSING ADDITIONAL RESULTS ; 06/27/11
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2011 George Lilly.
|
;Copyright 2011 George Lilly.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
|
153
p/C0COVREL.m
153
p/C0COVREL.m
|
@ -1,70 +1,85 @@
|
||||||
C0COVREL ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
|
C0COVREL ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
; (C) ELN 2012
|
||||||
N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
|
;
|
||||||
I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
; This program is free software: you can redistribute it and/or modify
|
||||||
I '$D(C0CQT) S C0CQT=0
|
; it under the terms of the GNU Affero General Public License as
|
||||||
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
|
; License, or (at your option) any later version.
|
||||||
I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
|
;
|
||||||
I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
|
; This program is distributed in the hope that it will be useful,
|
||||||
S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
S C0CHB=$NA(^TMP("HLS",$J))
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
S C0CI=""
|
; GNU Affero General Public License for more details.
|
||||||
S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
|
;
|
||||||
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
. K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
|
;
|
||||||
. D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
|
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
||||||
. M XV=C0CVAR ;
|
N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CLB2,C0CLB,C0CLI,C0CLOBX,C0CTAB,C0CTYP
|
||||||
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
|
I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||||||
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
|
I '$D(C0CQT) S C0CQT=0
|
||||||
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
|
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
|
||||||
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
|
I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL^C0COVREU ;INITIALIZE LAB TABLE
|
||||||
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
|
I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL^C0COVREU ;NEED NEWEST VERSION
|
||||||
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
|
I '$D(^TMP("HLS",$J,1)) D GHL7^C0COVREU ; GET HL7 MGS IF NOT ALREADY DONE
|
||||||
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
|
S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
|
||||||
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
|
S C0CHB=$NA(^TMP("HLS",$J))
|
||||||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
S C0CI=""
|
||||||
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
|
||||||
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
|
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
|
||||||
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
|
. K C0CVAR,XV,C0CX1,C0CX2 ; CLEAR OUT VARIABLE VALUES
|
||||||
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX
|
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
|
||||||
. . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
|
. D LTYP^C0COVREU(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
|
||||||
. . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC
|
. M XV=C0CVAR ;
|
||||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
|
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
|
||||||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
|
||||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
|
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
|
||||||
. . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC
|
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
|
||||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
|
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
|
||||||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
|
||||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
|
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
|
||||||
. . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT
|
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
|
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
|
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
||||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
|
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
|
||||||
. . E D ; NO SECONDARY, USE PRIMARY
|
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
|
||||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
|
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX
|
||||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
|
. . ; RESULTTESTCODEVALUE AND RESULTTESTDESCRIPTIONTEXT
|
||||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
|
. . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC
|
||||||
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
|
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
|
||||||
. . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
|
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||||||
. . S C0CZG=XV("RESULTTESTVALUE")
|
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
|
||||||
. . S XV("RESULTTESTVALUE")=C0CZG
|
. . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC
|
||||||
. I C0CTYP="OBX" D ; PROCESS TEST RESULTS
|
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
|
||||||
. . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION
|
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||||||
. . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
|
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
|
||||||
. . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
|
. . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT
|
||||||
. . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
|
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
|
||||||
. . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
|
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
|
||||||
. . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
|
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
|
||||||
. . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
|
. . E D ; NO SECONDARY, USE PRIMARY
|
||||||
. . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
|
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
|
||||||
. . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
|
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
|
||||||
. . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
|
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
|
||||||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
|
||||||
. . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
. . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
|
||||||
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
|
. . S C0CZG=XV("RESULTTESTVALUE")
|
||||||
. I 'C0CQT D ;
|
. . S XV("RESULTTESTVALUE")=C0CZG
|
||||||
. . W C0CI," ",C0CTYP,!
|
. I C0CTYP="OBX" D ; PROCESS TEST RESULTS
|
||||||
Q
|
. . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION
|
||||||
|
. . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
|
||||||
|
. . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
|
||||||
|
. . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
|
||||||
|
. . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
|
||||||
|
. . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
|
||||||
|
. . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
|
||||||
|
. . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
|
||||||
|
. . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
|
||||||
|
. . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||||||
|
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||||||
|
. . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
||||||
|
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
|
||||||
|
. I 'C0CQT D ;
|
||||||
|
. . W C0CI," ",C0CTYP,!
|
||||||
|
Q
|
||||||
|
|
194
p/C0COVRES.m
194
p/C0COVRES.m
|
@ -1,94 +1,108 @@
|
||||||
C0COVRES ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
|
C0COVRES ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;
|
; (C) ELN 2012
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
||||||
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
|
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
|
||||||
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
||||||
; MIXML IS THE TEMPLATE TO USE
|
; MIXML IS THE TEMPLATE TO USE
|
||||||
; MOXML IS THE OUTPUT XML ARRAY
|
; MOXML IS THE OUTPUT XML ARRAY
|
||||||
; DFN IS THE PATIENT RECORD NUMBER
|
; DFN IS THE PATIENT RECORD NUMBER
|
||||||
N C0COXML,C0CO,C0CV,C0CIXML
|
N C0COXML,C0CO,C0CV,C0CIXML
|
||||||
I '$D(MIVAR) S C0CV="" ;DEFAULT
|
I '$D(MIVAR) S C0CV="" ;DEFAULT
|
||||||
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
|
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
|
||||||
I '$D(MIXML) S C0CIXML="" ;DEFAULT
|
I '$D(MIXML) S C0CIXML="" ;DEFAULT
|
||||||
E S C0CIXML=MIXML ;PASSED INPUT XML
|
E S C0CIXML=MIXML ;PASSED INPUT XML
|
||||||
D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
|
D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
|
||||||
I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
|
I '$D(MOXML) S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
|
||||||
E S C0CO=MOXML
|
E S C0CO=MOXML
|
||||||
M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
|
M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
|
||||||
Q
|
Q
|
||||||
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
||||||
; RTN IS PASSED BY REFERENCE
|
; RTN IS PASSED BY REFERENCE
|
||||||
N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
|
N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
|
||||||
N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
|
N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
|
||||||
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
|
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
|
||||||
I RMIXML="" D ; INPUT XML NOT PASSED
|
I RMIXML="" D ; INPUT XML NOT PASSED
|
||||||
. D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
|
. D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
|
||||||
. D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
|
. D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
|
||||||
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
|
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
|
||||||
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
|
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
|
||||||
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
|
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
|
||||||
. S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
|
. S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
|
||||||
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
|
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
|
||||||
D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
|
D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
|
||||||
D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
|
D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
|
||||||
D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
|
D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
|
||||||
D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
|
D EXTRACT("C0CT",DFN,) ; LAB EXTRACT
|
||||||
D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
|
D EXTRACT^C0CRARPT("C0CT",DFN,) ; RAD REPORT EXTRACT
|
||||||
;OHUM/RUT 3111221
|
;OHUM/RUT 3111221
|
||||||
;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
|
;D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
|
||||||
I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
|
I ^TMP("C0CCCR","TIULIMIT")'="" D EXTRACT^C0CTIU("C0CT",DFN,) ; TIU EXTRACT
|
||||||
;OHUM/RUT
|
;OHUM/RUT
|
||||||
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
||||||
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
||||||
; NO RESULTS
|
; NO RESULTS
|
||||||
I @C0CV@(0)=0 S RTN(0)=0 Q
|
I @C0CV@(0)=0 S RTN(0)=0 Q
|
||||||
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
||||||
K @RIMVARS
|
K @RIMVARS
|
||||||
;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
;M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
||||||
N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
|
N C0CI,C0CIN,C0CJ,C0CJN,C0CJE,C0CJS,C0CMAP,C0CTMAP,C0CTMP
|
||||||
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
|
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
|
||||||
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
|
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
|
||||||
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
|
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
|
||||||
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
|
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
|
||||||
; TO IMPROVE PERFORMANCE
|
; TO IMPROVE PERFORMANCE
|
||||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
|
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
|
||||||
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
|
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
|
||||||
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
|
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
|
||||||
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
|
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
|
||||||
. S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
|
. S C0CMAP=$NA(@C0CV@(C0CI)) ;MAPPING FOR TEST REQUEST GOES HERE
|
||||||
. D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
|
. D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
|
||||||
. D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
|
. D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
|
||||||
. I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
|
. I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
|
||||||
. . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
|
. . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
|
||||||
. . K C0CTO ; CLEAR OUTPUT VARIABLE
|
. . K C0CTO ; CLEAR OUTPUT VARIABLE
|
||||||
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
|
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
|
||||||
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
|
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
|
||||||
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
|
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
|
||||||
. . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
|
. . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
|
||||||
. . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
|
. . . D XMAP^C0CTIU1("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
|
||||||
. . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
|
. . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
|
||||||
. . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>
|
. . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>
|
||||||
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
|
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
|
||||||
. . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
|
. . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
|
||||||
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
||||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
||||||
D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
|
D BUILD^C0CTIU1("C0CRBLD","RTN") ;RENDER THE XML
|
||||||
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
|
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
|
||||||
Q
|
Q
|
||||||
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
|
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
|
||||||
; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||||
N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
|
N C0CNSSN,C0CLB ; IS THERE AN SSN FLAG
|
||||||
S C0CNSSN=0
|
S C0CNSSN=0
|
||||||
S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||||||
D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
|
D GHL7^C0COVREU ; GET HL7 MESSAGE FOR THIS PATIENT
|
||||||
I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
|
I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
|
||||||
. S @C0CLB@(0)=0
|
. S @C0CLB@(0)=0
|
||||||
;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
|
;K @C0CLB ; CLEAR OUT OLD VARS IF ANY
|
||||||
N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
|
N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
|
||||||
S C0CQT=1 ; SURPRESS LISTING
|
S C0CQT=1 ; SURPRESS LISTING
|
||||||
D LIST^C0COVREL ; EXTRACT THE VARIABLES
|
D LIST^C0COVREL ; EXTRACT THE VARIABLES
|
||||||
S C0CQT=QTSAV ; RESET SILENT FLAG
|
S C0CQT=QTSAV ; RESET SILENT FLAG
|
||||||
K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
|
K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
|
||||||
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
|
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
|
||||||
Q
|
Q
|
||||||
|
|
359
p/C0COVREU.m
359
p/C0COVREU.m
|
@ -1,178 +1,191 @@
|
||||||
C0COVREU ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
|
C0COVREU ; CCDCCR/ELN - CCR/CCD PROCESSING FOR LAB,RAD,TIU RESULTS ; 10/12/15
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;
|
;
|
||||||
;
|
;
|
||||||
GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
|
; This program is free software: you can redistribute it and/or modify
|
||||||
N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; SET UP FOR LAB API CALL
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
|
; License, or (at your option) any later version.
|
||||||
I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT
|
;
|
||||||
. W "LAB LOOKUP FAILED, NO SSN",!
|
; This program is distributed in the hope that it will be useful,
|
||||||
. S C0CNSSN=1 ; SET NO SSN FLAG
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
S C0CSPC="*" ; LOOKING FOR ALL LABS
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS
|
; GNU Affero General Public License for more details.
|
||||||
;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
|
;
|
||||||
;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
|
;
|
||||||
S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
|
;
|
||||||
D DT^DILF(,C0CLLMT,.C0CSDT) ;
|
GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
|
||||||
W "LAB LIMIT: ",C0CLLMT,!
|
N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR,C0CLLMT,C0CLSTRT
|
||||||
D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
|
; SET UP FOR LAB API CALL
|
||||||
S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
|
S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
|
||||||
Q
|
I C0CPTID="" D Q ; NO SSN, COMPLAIN AND QUIT
|
||||||
|
. W "LAB LOOKUP FAILED, NO SSN",!
|
||||||
|
. S C0CNSSN=1 ; SET NO SSN FLAG
|
||||||
|
S C0CSPC="*" ; LOOKING FOR ALL LABS
|
||||||
|
;I $D(^TMP("C0CCCR","RPMS")) D ; RUNNING RPMS
|
||||||
|
;. D DT^DILF(,"T-365",.C0CSDT) ; START DATE ONE YEAR AGO TO LIMIT VOLUME
|
||||||
|
;E D DT^DILF(,"T-5000",.C0CSDT) ; START DATE LONG AGO TO GET EVERYTHING
|
||||||
|
;D DT^DILF(,"T",.C0CEDT) ; END DATE TODAY
|
||||||
|
S C0CLLMT=$$GET^C0CPARMS("LABLIMIT") ; GET THE LIMIT PARM
|
||||||
|
S C0CLSTRT=$$GET^C0CPARMS("LABSTART") ; GET START PARM
|
||||||
|
D DT^DILF(,C0CLLMT,.C0CSDT) ;
|
||||||
|
W "LAB LIMIT: ",C0CLLMT,!
|
||||||
|
D DT^DILF(,C0CLSTRT,.C0CEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
|
||||||
|
S C0CR=$$LAB^C0CLA7Q(C0CPTID,C0CSDT,C0CEDT,C0CSPC,C0CSPC) ; CALL LAB LOOKUP
|
||||||
|
Q
|
||||||
LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
|
LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
|
||||||
N OI,OI2,OTAB,OTI,OV,OVAR
|
N OI,OI2,OTAB,OTI,OV,OVAR
|
||||||
S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
|
S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
|
||||||
I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
|
I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
|
||||||
E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
|
E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
|
||||||
I 1 D ; FOR HL7 SEGMENT TYPE
|
I 1 D ; FOR HL7 SEGMENT TYPE
|
||||||
. S OI="" ; INDEX INTO FIELDS IN SEG
|
. S OI="" ; INDEX INTO FIELDS IN SEG
|
||||||
. F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
|
. F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
|
||||||
. . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
|
. . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
|
||||||
. . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
|
. . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
|
||||||
. . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
|
. . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
|
||||||
. . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
|
. . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
|
||||||
. . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
|
. . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
|
||||||
. . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
|
. . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
|
||||||
. . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
|
. . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
|
||||||
. . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE
|
. . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE
|
||||||
. . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
|
. . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
|
||||||
Q
|
Q
|
||||||
LOBX ;
|
LOBX ;
|
||||||
Q
|
Q
|
||||||
;
|
|
||||||
OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
|
OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
|
||||||
N GA,GF,GD
|
N GA,GF,GD
|
||||||
S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
|
S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
|
||||||
S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
|
S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
|
||||||
S GD=^TMP("C0CCCR","ODIR")
|
S GD=^TMP("C0CCCR","ODIR")
|
||||||
W $$OUTPUT^C0CXPATH(GA,GF,GD)
|
W $$OUTPUT^C0CXPATH(GA,GF,GD)
|
||||||
Q
|
Q
|
||||||
SETTBL ;
|
SETTBL ;
|
||||||
K X ; CLEAR X
|
K X ; CLEAR X
|
||||||
S X("PID","PID1")="1^00104^Set ID - Patient ID"
|
S X("PID","PID1")="1^00104^Set ID - Patient ID"
|
||||||
S X("PID","PID2")="2^00105^Patient ID (External ID)"
|
S X("PID","PID2")="2^00105^Patient ID (External ID)"
|
||||||
S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
|
S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
|
||||||
S X("PID","PID4")="4^00107^Alternate Patient ID"
|
S X("PID","PID4")="4^00107^Alternate Patient ID"
|
||||||
S X("PID","PID5")="5^00108^Patient's Name"
|
S X("PID","PID5")="5^00108^Patient's Name"
|
||||||
S X("PID","PID6")="6^00109^Mother's Maiden Name"
|
S X("PID","PID6")="6^00109^Mother's Maiden Name"
|
||||||
S X("PID","PID7")="7^00110^Date of Birth"
|
S X("PID","PID7")="7^00110^Date of Birth"
|
||||||
S X("PID","PID8")="8^00111^Sex"
|
S X("PID","PID8")="8^00111^Sex"
|
||||||
S X("PID","PID9")="9^00112^Patient Alias"
|
S X("PID","PID9")="9^00112^Patient Alias"
|
||||||
S X("PID","PID10")="10^00113^Race"
|
S X("PID","PID10")="10^00113^Race"
|
||||||
S X("PID","PID11")="11^00114^Patient Address"
|
S X("PID","PID11")="11^00114^Patient Address"
|
||||||
S X("PID","PID12")="12^00115^County Code"
|
S X("PID","PID12")="12^00115^County Code"
|
||||||
S X("PID","PID13")="13^00116^Phone Number - Home"
|
S X("PID","PID13")="13^00116^Phone Number - Home"
|
||||||
S X("PID","PID14")="14^00117^Phone Number - Business"
|
S X("PID","PID14")="14^00117^Phone Number - Business"
|
||||||
S X("PID","PID15")="15^00118^Language - Patient"
|
S X("PID","PID15")="15^00118^Language - Patient"
|
||||||
S X("PID","PID16")="16^00119^Marital Status"
|
S X("PID","PID16")="16^00119^Marital Status"
|
||||||
S X("PID","PID17")="17^00120^Religion"
|
S X("PID","PID17")="17^00120^Religion"
|
||||||
S X("PID","PID18")="18^00121^Patient Account Number"
|
S X("PID","PID18")="18^00121^Patient Account Number"
|
||||||
S X("PID","PID19")="19^00122^SSN Number - Patient"
|
S X("PID","PID19")="19^00122^SSN Number - Patient"
|
||||||
S X("PID","PID20")="20^00123^Drivers License - Patient"
|
S X("PID","PID20")="20^00123^Drivers License - Patient"
|
||||||
S X("PID","PID21")="21^00124^Mother's Identifier"
|
S X("PID","PID21")="21^00124^Mother's Identifier"
|
||||||
S X("PID","PID22")="22^00125^Ethnic Group"
|
S X("PID","PID22")="22^00125^Ethnic Group"
|
||||||
S X("PID","PID23")="23^00126^Birth Place"
|
S X("PID","PID23")="23^00126^Birth Place"
|
||||||
S X("PID","PID24")="24^00127^Multiple Birth Indicator"
|
S X("PID","PID24")="24^00127^Multiple Birth Indicator"
|
||||||
S X("PID","PID25")="25^00128^Birth Order"
|
S X("PID","PID25")="25^00128^Birth Order"
|
||||||
S X("PID","PID26")="26^00129^Citizenship"
|
S X("PID","PID26")="26^00129^Citizenship"
|
||||||
S X("PID","PID27")="27^00130^Veteran.s Military Status"
|
S X("PID","PID27")="27^00130^Veteran.s Military Status"
|
||||||
S X("PID","PID28")="28^00739^Nationality"
|
S X("PID","PID28")="28^00739^Nationality"
|
||||||
S X("PID","PID29")="29^00740^Patient Death Date/Time"
|
S X("PID","PID29")="29^00740^Patient Death Date/Time"
|
||||||
S X("PID","PID30")="30^00741^Patient Death Indicator"
|
S X("PID","PID30")="30^00741^Patient Death Indicator"
|
||||||
S X("NTE","NTE1")="1^00573^Set ID - NTE"
|
S X("NTE","NTE1")="1^00573^Set ID - NTE"
|
||||||
S X("NTE","NTE2")="2^00574^Source of Comment"
|
S X("NTE","NTE2")="2^00574^Source of Comment"
|
||||||
S X("NTE","NTE3")="3^00575^Comment"
|
S X("NTE","NTE3")="3^00575^Comment"
|
||||||
S X("ORC","ORC1")="1^00215^Order Control"
|
S X("ORC","ORC1")="1^00215^Order Control"
|
||||||
S X("ORC","ORC2")="2^00216^Placer Order Number"
|
S X("ORC","ORC2")="2^00216^Placer Order Number"
|
||||||
S X("ORC","ORC3")="3^00217^Filler Order Number"
|
S X("ORC","ORC3")="3^00217^Filler Order Number"
|
||||||
S X("ORC","ORC4")="4^00218^Placer Order Number"
|
S X("ORC","ORC4")="4^00218^Placer Order Number"
|
||||||
S X("ORC","ORC5")="5^00219^Order Status"
|
S X("ORC","ORC5")="5^00219^Order Status"
|
||||||
S X("ORC","ORC6")="6^00220^Response Flag"
|
S X("ORC","ORC6")="6^00220^Response Flag"
|
||||||
S X("ORC","ORC7")="7^00221^Quantity/Timing"
|
S X("ORC","ORC7")="7^00221^Quantity/Timing"
|
||||||
S X("ORC","ORC8")="8^00222^Parent"
|
S X("ORC","ORC8")="8^00222^Parent"
|
||||||
S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
|
S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
|
||||||
S X("ORC","ORC10")="10^00224^Entered By"
|
S X("ORC","ORC10")="10^00224^Entered By"
|
||||||
S X("ORC","ORC11")="11^00225^Verified By"
|
S X("ORC","ORC11")="11^00225^Verified By"
|
||||||
S X("ORC","ORC12")="12^00226^Ordering Provider"
|
S X("ORC","ORC12")="12^00226^Ordering Provider"
|
||||||
S X("ORC","ORC13")="13^00227^Enterer's Location"
|
S X("ORC","ORC13")="13^00227^Enterer's Location"
|
||||||
S X("ORC","ORC14")="14^00228^Call Back Phone Number"
|
S X("ORC","ORC14")="14^00228^Call Back Phone Number"
|
||||||
S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
|
S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
|
||||||
S X("ORC","ORC16")="16^00230^Order Control Code Reason"
|
S X("ORC","ORC16")="16^00230^Order Control Code Reason"
|
||||||
S X("ORC","ORC17")="17^00231^Entering Organization"
|
S X("ORC","ORC17")="17^00231^Entering Organization"
|
||||||
S X("ORC","ORC18")="18^00232^Entering Device"
|
S X("ORC","ORC18")="18^00232^Entering Device"
|
||||||
S X("ORC","ORC19")="19^00233^Action By"
|
S X("ORC","ORC19")="19^00233^Action By"
|
||||||
S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
|
S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
|
||||||
S X("OBR","OBR2")="2^00216^Placer Order Number"
|
S X("OBR","OBR2")="2^00216^Placer Order Number"
|
||||||
S X("OBR","OBR3")="3^00217^Filler Order Number"
|
S X("OBR","OBR3")="3^00217^Filler Order Number"
|
||||||
S X("OBR","OBR4")="4^00238^Universal Service ID"
|
S X("OBR","OBR4")="4^00238^Universal Service ID"
|
||||||
S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
|
S X("OBR","OBR4;LOINC")="4;1^00238^Universal Service ID - LOINC^RESULTCODE"
|
||||||
S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
|
S X("OBR","OBR4;DESC")="4;2^00238^Universal Service ID - DESC^RESULTDESCRIPTIONTEXT"
|
||||||
S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
|
S X("OBR","OBR4;VACODE")="4;3^00238^Universal Service ID - VACODE^RESULTCODINGSYSTEM"
|
||||||
S X("OBR","OBR5")="5^00239^Priority"
|
S X("OBR","OBR5")="5^00239^Priority"
|
||||||
S X("OBR","OBR6")="6^00240^Requested Date/Time"
|
S X("OBR","OBR6")="6^00240^Requested Date/Time"
|
||||||
S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
|
S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
|
||||||
S X("OBR","OBR8")="8^00242^Observation End Date/Time"
|
S X("OBR","OBR8")="8^00242^Observation End Date/Time"
|
||||||
S X("OBR","OBR9")="9^00243^Collection Volume"
|
S X("OBR","OBR9")="9^00243^Collection Volume"
|
||||||
S X("OBR","OBR10")="10^00244^Collector Identifier"
|
S X("OBR","OBR10")="10^00244^Collector Identifier"
|
||||||
S X("OBR","OBR11")="11^00245^Specimen Action Code"
|
S X("OBR","OBR11")="11^00245^Specimen Action Code"
|
||||||
S X("OBR","OBR12")="12^00246^Danger Code"
|
S X("OBR","OBR12")="12^00246^Danger Code"
|
||||||
S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
|
S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
|
||||||
S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
|
S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
|
||||||
S X("OBR","OBR15")="15^00249^Specimen Source"
|
S X("OBR","OBR15")="15^00249^Specimen Source"
|
||||||
S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
|
S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
|
||||||
S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
|
S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
|
||||||
S X("OBR","OBR18")="18^00251^Placers Field 1"
|
S X("OBR","OBR18")="18^00251^Placers Field 1"
|
||||||
S X("OBR","OBR19")="19^00252^Placers Field 2"
|
S X("OBR","OBR19")="19^00252^Placers Field 2"
|
||||||
S X("OBR","OBR20")="20^00253^Filler Field 1"
|
S X("OBR","OBR20")="20^00253^Filler Field 1"
|
||||||
S X("OBR","OBR21")="21^00254^Filler Field 2"
|
S X("OBR","OBR21")="21^00254^Filler Field 2"
|
||||||
S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
|
S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
|
||||||
S X("OBR","OBR23")="23^00256^Charge to Practice"
|
S X("OBR","OBR23")="23^00256^Charge to Practice"
|
||||||
S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
|
S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
|
||||||
S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
|
S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
|
||||||
S X("OBR","OBR26")="26^00259^Parent Result"
|
S X("OBR","OBR26")="26^00259^Parent Result"
|
||||||
S X("OBR","OBR27")="27^00221^Quantity/Timing"
|
S X("OBR","OBR27")="27^00221^Quantity/Timing"
|
||||||
S X("OBR","OBR28")="28^00260^Result Copies to"
|
S X("OBR","OBR28")="28^00260^Result Copies to"
|
||||||
S X("OBR","OBR29")="29^00261^Parent Number"
|
S X("OBR","OBR29")="29^00261^Parent Number"
|
||||||
S X("OBR","OBR30")="30^00262^Transportation Mode"
|
S X("OBR","OBR30")="30^00262^Transportation Mode"
|
||||||
S X("OBR","OBR31")="31^00263^Reason for Study"
|
S X("OBR","OBR31")="31^00263^Reason for Study"
|
||||||
S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
|
S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
|
||||||
S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
|
S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
|
||||||
S X("OBR","OBR34")="34^00266^Technician"
|
S X("OBR","OBR34")="34^00266^Technician"
|
||||||
S X("OBR","OBR35")="35^00267^Transcriptionist"
|
S X("OBR","OBR35")="35^00267^Transcriptionist"
|
||||||
S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
|
S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
|
||||||
S X("OBR","OBR37")="37^01028^Number of Sample Containers"
|
S X("OBR","OBR37")="37^01028^Number of Sample Containers"
|
||||||
S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
|
S X("OBR","OBR38")="38^38^01029 Transport Logistics of Collected Sample"
|
||||||
S X("OBR","OBR39")="39^01030^Collector.s Comment"
|
S X("OBR","OBR39")="39^01030^Collector.s Comment"
|
||||||
S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
|
S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
|
||||||
S X("OBR","OBR41")="41^01032^Transport Arranged"
|
S X("OBR","OBR41")="41^01032^Transport Arranged"
|
||||||
S X("OBR","OBR42")="42^01033^Escort Required"
|
S X("OBR","OBR42")="42^01033^Escort Required"
|
||||||
S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
|
S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
|
||||||
S X("OBX","OBX1")="1^00559^Set ID - OBX"
|
S X("OBX","OBX1")="1^00559^Set ID - OBX"
|
||||||
S X("OBX","OBX2")="2^00676^Value Type"
|
S X("OBX","OBX2")="2^00676^Value Type"
|
||||||
S X("OBX","OBX3")="3^00560^Observation Identifier"
|
S X("OBX","OBX3")="3^00560^Observation Identifier"
|
||||||
S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
|
S X("OBX","OBX3;C1")="3;1^00560^Observation Identifier^C1"
|
||||||
S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
|
S X("OBX","OBX3;C2")="3;2^00560^Observation Identifier^C2"
|
||||||
S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
|
S X("OBX","OBX3;C3")="3;3^00560^Observation Identifier^C3"
|
||||||
S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
|
S X("OBX","OBX3;C4")="3;4^00560^Observation Identifier^C4"
|
||||||
S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
|
S X("OBX","OBX3;C5")="3;5^00560^Observation Identifier^C5"
|
||||||
S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
|
S X("OBX","OBX3;C6")="3;6^00560^Observation Identifier^C6"
|
||||||
S X("OBX","OBX4")="4^00769^Observation Sub-Id"
|
S X("OBX","OBX4")="4^00769^Observation Sub-Id"
|
||||||
S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
|
S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
|
||||||
S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
|
S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
|
||||||
S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
|
S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
|
||||||
S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
|
S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
|
||||||
S X("OBX","OBX9")="9^00639^Probability"
|
S X("OBX","OBX9")="9^00639^Probability"
|
||||||
S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
|
S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
|
||||||
S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
|
S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
|
||||||
S X("OBX","OBX12")="12^00567^Date Last Normal Value"
|
S X("OBX","OBX12")="12^00567^Date Last Normal Value"
|
||||||
S X("OBX","OBX13")="13^00581^User Defined Access Checks"
|
S X("OBX","OBX13")="13^00581^User Defined Access Checks"
|
||||||
S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
|
S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
|
||||||
S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
|
S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
|
||||||
S X("OBX","OBX16")="16^00584^Responsible Observer"
|
S X("OBX","OBX16")="16^00584^Responsible Observer"
|
||||||
S X("OBX","OBX17")="17^00936^Observation Method"
|
S X("OBX","OBX17")="17^00936^Observation Method"
|
||||||
K ^TMP("C0CCCR","LABTBL")
|
K ^TMP("C0CCCR","LABTBL")
|
||||||
M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
|
M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
|
||||||
S ^TMP("C0CCCR","LABTBL",0)="V3"
|
S ^TMP("C0CCCR","LABTBL",0)="V3"
|
||||||
Q
|
Q
|
||||||
|
|
26
p/C0CPARMS.m
26
p/C0CPARMS.m
|
@ -1,21 +1,19 @@
|
||||||
C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 ; 6/15/12 3:46pm
|
C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09 ; 6/15/12 3:46pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 49
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
;Copyright 2008 WorldVistA.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS
|
SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS
|
||||||
; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"
|
; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"
|
||||||
|
|
34
p/C0CPROBS.m
34
p/C0CPROBS.m
|
@ -1,23 +1,19 @@
|
||||||
C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
|
C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
; PROCESS THE PROBLEMS SECTION OF THE CCR
|
; PROCESS THE PROBLEMS SECTION OF THE CCR
|
||||||
;
|
;
|
||||||
|
@ -91,7 +87,7 @@ RPMS ; GETS THE PROBLEM LIST FOR RPMS
|
||||||
; $$HTML^DILF(
|
; $$HTML^DILF(
|
||||||
; GENERATE THE NARITIVE HTML FOR THE CCD
|
; GENERATE THE NARITIVE HTML FOR THE CCD
|
||||||
I CCD D CCD ; IF THIS IS FOR A CCD
|
I CCD D CCD ; IF THIS IS FOR A CCD
|
||||||
D MISSINGVARS
|
D MISSVARS
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
VISTA ; GETS THE PROBLEM LIST FOR VISTA
|
VISTA ; GETS THE PROBLEM LIST FOR VISTA
|
||||||
|
@ -148,9 +144,9 @@ VISTA ; GETS THE PROBLEM LIST FOR VISTA
|
||||||
; $$HTML^DILF(
|
; $$HTML^DILF(
|
||||||
; GENERATE THE NARITIVE HTML FOR THE CCD
|
; GENERATE THE NARITIVE HTML FOR THE CCD
|
||||||
I CCD D CCD ; IF THIS IS FOR A CCD
|
I CCD D CCD ; IF THIS IS FOR A CCD
|
||||||
D MISSINGVARS
|
D MISSVARS
|
||||||
Q
|
Q
|
||||||
CCD
|
CCD ;
|
||||||
N HTMP,HOUT,HTMLO,C0CPROBI,ZX
|
N HTMP,HOUT,HTMLO,C0CPROBI,ZX
|
||||||
F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
|
F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
|
||||||
. S VMAP=$NA(@TVMAP@(C0CPROBI))
|
. S VMAP=$NA(@TVMAP@(C0CPROBI))
|
||||||
|
@ -174,7 +170,7 @@ CCD
|
||||||
I DEBUG D PARY^C0CXPATH("HTMLO")
|
I DEBUG D PARY^C0CXPATH("HTMLO")
|
||||||
D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
|
D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
|
||||||
Q
|
Q
|
||||||
MISSINGVARS
|
MISSVARS ; Missing Variables
|
||||||
N PROBSTMP,I
|
N PROBSTMP,I
|
||||||
D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
|
D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
|
||||||
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||||
|
|
28
p/C0CPROC.m
28
p/C0CPROC.m
|
@ -1,22 +1,18 @@
|
||||||
C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
|
C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2010 George Lilly, University of Minnesota and others.
|
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -111,7 +107,7 @@ DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
|
||||||
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
||||||
; CPT^CATEGORY^TEXT
|
; CPT^CATEGORY^TEXT
|
||||||
N Z1,Z2,Z3,ZRTN
|
N Z1,Z2,Z3,ZRTN
|
||||||
S Z1=$P(ISTR,U,1)
|
S Z1=$P(ISTR,U,1)
|
||||||
I Z1="" D ;
|
I Z1="" D ;
|
||||||
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
||||||
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
||||||
|
|
142
p/C0CPXRM.m
142
p/C0CPXRM.m
|
@ -1,74 +1,74 @@
|
||||||
C0CPXRM ;
|
C0CPXRM ;
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
DOIT ;
|
DOIT ;
|
||||||
S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.224804" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.223957" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.223738" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.223516" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.222158" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.213944" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.212219" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.211506" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.002714" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.001841" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110302.000846" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110115.141918" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110115.132312" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110115.131653" ZWR ^XTMP(G,*)
|
||||||
S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
|
; S G="PXRMXSEPCLINIC3110115.131008" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT988 3110224.210456" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT986 3110224.210456" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT932 3110224.210456" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT932 3110224.210455" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT8015 3110301.215142" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT8015 3110301.215141" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT5265 3110309.124047" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT5265 3110309.124046" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT4742 3101129.221201" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT4742 3101129.215741" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT4710 3101129.215701" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT3297 3101127.123134" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT32495 3110224.194246" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT32493 3110224.194246" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT32354 3110224.194246" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT32354 3110224.194245" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT31106 3110224.175105" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT31090 3110224.175105" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT30339 3110224.175105" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT30339 3110224.175103" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT2761 3110115.174109" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT2761 3110115.174108" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT27327 3110227.013658" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT27327 3110227.013657" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT27327 3110227.013523" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT27327 3110227.013522" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT27253 3110227.012747" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT27253 3110227.012746" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT2559 3110115.170835" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT25549 3110228.231135" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT25549 3110228.231134" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT2205 3101129.215343" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT21092 3110114.195621" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT21092 3110114.193803" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT19640 3110226.032943" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT19640 3110226.032941" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT19353 3101212.162833" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT18780 3110221.215603" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT18156 3101212.152654" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT17800 3110315.202432" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT1650 3110220.192925" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT16110 3110313.224636" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT16004 3110317.151215" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT16004 3110317.150834" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT14955 3110315.165018" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT14816 3110315.164839" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT14816 3110315.164512" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT12415 3110315.135514" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT11797 3110315.131141" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT11573 3110315.131811" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT10728 3110114.025022" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT10578 3110114.021524" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT10243 3110114.020338" ZWR ^XTMP(G,*)
|
||||||
S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
|
; S G="PXRM PXK EVENT10105 3101204.230554" ZWR ^XTMP(G,*)
|
||||||
Q
|
; Q
|
||||||
;
|
;
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99 13:48
|
LA7QRY1 ;DALOI/JMC - Lab HL7 Query Utility ;01/19/99 13:48
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
20
p/C0CQRY2.m
20
p/C0CQRY2.m
|
@ -1,7 +1,23 @@
|
||||||
LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09
|
LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 ; 10/30/12 10:16am
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; JMC - mods to check for IHS V LAB file
|
; JMC - mods to check for IHS V LAB file
|
||||||
;
|
;
|
||||||
|
; (C) John McCormack 2009
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PATID ; Resolve patient id and establish patient environment
|
PATID ; Resolve patient id and establish patient environment
|
||||||
|
|
284
p/C0CRAHL7.m
284
p/C0CRAHL7.m
|
@ -1,136 +1,152 @@
|
||||||
C0CRAHL7 ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010
|
C0CRAHL7 ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 25/10/2010
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;;
|
;
|
||||||
Q
|
; (C) ELN 2010.
|
||||||
;LENGTH OF SEGMENTS COMPROMISED
|
;
|
||||||
GHL7 ; Loop through ^RADPT with RADFN
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; Get Case Number and Reprot Information
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; Extract RAD Report as HL7 Message
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
|
; This program is distributed in the hope that it will be useful,
|
||||||
D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
S C0CCNT=0
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
F S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT) D
|
; GNU Affero General Public License for more details.
|
||||||
. S C0CRAIDT=0
|
;
|
||||||
. F S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0 D
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
. . S C0CRANO=0
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
. . F S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0 D
|
;
|
||||||
. . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
|
;
|
||||||
. . . Q:C0CRAXAM(0)=""
|
Q
|
||||||
. . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
|
;LENGTH OF SEGMENTS COMPROMISED
|
||||||
. . . Q:RARPT=""!(RARPT=0)
|
GHL7 ; Loop through ^RADPT with RADFN
|
||||||
. . . ;Quit if no report information present
|
; Get Case Number and Reprot Information
|
||||||
. . . D SETHL7
|
; Extract RAD Report as HL7 Message
|
||||||
. . . S C0CSBCNT=0
|
; HL7 Message Set In Sequence as ^TMP("HLS",$J,SEQ)
|
||||||
. . . F S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT="" D
|
;
|
||||||
. . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
|
D DT^DILF(,$$GET^C0CPARMS("RASTART"),.C0CRASDT)
|
||||||
. . . . S C0CCNT=C0CCNT+1
|
D DT^DILF(,$$GET^C0CPARMS("RALIMIT"),.C0CRAEDT) ; END DATE TODAY - IMPLEMENT END DATE PARM
|
||||||
;
|
S C0CCNT=0
|
||||||
K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
|
F S C0CRAEDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT)) Q:C0CRAEDT'>0!(C0CRAEDT>C0CRASDT) D
|
||||||
K C0CRAXAM,C0CCNT,C0CRAEDT
|
. S C0CRAIDT=0
|
||||||
Q
|
. F S C0CRAIDT=$O(^RADPT(RADFN,"DT","B",C0CRAEDT,C0CRAIDT)) Q:C0CRAIDT'>0 D
|
||||||
;
|
. . S C0CRANO=0
|
||||||
SETHL7 ;SETHL7 SEGMENTS
|
. . F S C0CRANO=$O(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO)) Q:C0CRANO'>0 D
|
||||||
N RASET,RACN0
|
. . . S C0CRAXAM(0)=$G(^RADPT(RADFN,"DT",C0CRAIDT,"P",C0CRANO,0))
|
||||||
S RASET=0
|
. . . Q:C0CRAXAM(0)=""
|
||||||
S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
|
. . . S RARPT=+$P(C0CRAXAM(0),"^",17),RACNI=C0CRANO,RADTI=C0CRAIDT
|
||||||
I +$P(RACN0,U,25)=2 D Q ; printset
|
. . . Q:RARPT=""!(RARPT=0)
|
||||||
. ; loop through all cases in set and create message
|
. . . ;Quit if no report information present
|
||||||
. S RASET=1
|
. . . D SETHL7
|
||||||
. N RACNI,RAII S RAII=0
|
. . . S C0CSBCNT=0
|
||||||
. F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0 D
|
. . . F S C0CSBCNT=$O(HLA("HLS",C0CSBCNT)) Q:C0CSBCNT="" D
|
||||||
. . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
|
. . . . S ^TMP("HLS",$J,C0CCNT)=$G(HLA("HLS",C0CSBCNT))
|
||||||
. . S RACNI=RAII
|
. . . . S C0CCNT=C0CCNT+1
|
||||||
. . D NEW
|
;
|
||||||
NEW ; new variables
|
K HLA("HLS"),RARPT,C0CSBCNT,C0CRANO,C0CRAIDT,C0CRASDT,C0CRLMT,C0CSTRT
|
||||||
;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
|
K C0CRAXAM,C0CCNT,C0CRAEDT
|
||||||
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
|
Q
|
||||||
N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
|
;
|
||||||
S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
|
SETHL7 ;SETHL7 SEGMENTS
|
||||||
S (HLECH,HL("ECH"))="^~\&"
|
N RASET,RACN0
|
||||||
S (HLFS,HL("FS"))="|"
|
S RASET=0
|
||||||
S (HLQ,HL("Q"))=""""
|
S RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
|
||||||
S DFN=RADFN D DEM^VADPT
|
I +$P(RACN0,U,25)=2 D Q ; printset
|
||||||
I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
|
. ; loop through all cases in set and create message
|
||||||
S RAN=0
|
. S RASET=1
|
||||||
S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
|
. N RACNI,RAII S RAII=0
|
||||||
D SETUP,PID,OBR,OBXRPT
|
. F S RAII=$O(^RADPT(RADFN,"DT",RADTI,"P",RAII)) Q:RAII'>0 D
|
||||||
EXIT ;EXIT FROM NEW
|
. . Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RAII,0),U,25)'=2
|
||||||
K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
|
. . S RACNI=RAII
|
||||||
Q
|
. . D NEW
|
||||||
;
|
NEW ; new variables
|
||||||
OBR ;Compile 'OBR' Segment
|
;S:$D(ZTQUEUED) ZTREQ="@" ; delete task from task global
|
||||||
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"
|
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
|
||||||
S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
|
N EID,HL,INT,HLQ,HLFS,HLECH,RAN K RAVADM
|
||||||
; Replace above with following when Imaging can cope with ESC chars
|
S HLDT=$$NOW^XLFDT(),HLDT1=$$HLDATE^HLFNC(HLDT)
|
||||||
; 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"
|
S (HLECH,HL("ECH"))="^~\&"
|
||||||
; Have to use LOCAL code if Broad Procedure - no CPT code
|
S (HLFS,HL("FS"))="|"
|
||||||
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"
|
S (HLQ,HL("Q"))=""""
|
||||||
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
|
S DFN=RADFN D DEM^VADPT
|
||||||
S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
|
I VADM(1)']"" S HLP("ERRTEXT")="Invalid Patient Identifier" G EXIT
|
||||||
S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
|
S RAN=0
|
||||||
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")
|
S RAVADM(3)=$S($E(+VADM(3),6,7)="00":"",1:+VADM(3))
|
||||||
; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
|
D SETUP,PID,OBR,OBXRPT
|
||||||
N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
|
EXIT ;EXIT FROM NEW
|
||||||
S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
|
K HL,HLDT,HLDT1,VADM,VA("PID"),C0COBRFR,RADTI
|
||||||
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)),"^")
|
Q
|
||||||
S $P(X1,HLFS,21)=$P(X1,HLFS,21)
|
;
|
||||||
; Replace above with following when Imaging can cope with ESC chars
|
OBR ;Compile 'OBR' Segment
|
||||||
; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
|
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"
|
||||||
;
|
S C0COBRFR=$P(RACPTNDE,U)_$E(HLECH)_"RAD Procedure"_$E(HLECH)_"C4"_$E(HLECH)_+RAPROC_$E(HLECH)_$P(RAPRCNDE,U)_$E(HLECH)_"99RAP"
|
||||||
S OBR36=9999999.9999-RADTI
|
; Replace above with following when Imaging can cope with ESC chars
|
||||||
S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
|
; 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"
|
||||||
;
|
; Have to use LOCAL code if Broad Procedure - no CPT code
|
||||||
S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
|
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"
|
||||||
S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
|
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
|
||||||
;Principal Result Interpreter = Verifying Physician
|
S RAPRV=$$GET1^DIQ(200,+$P(RACN0,"^",14),.01)
|
||||||
S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
|
S Y=$$HLNAME^HLFNC(RAPRV) S X1=X1_$S(Y]"":+$P(RACN0,"^",14)_$E(HLECH)_Y,1:"")
|
||||||
.S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
|
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")
|
||||||
.S Y=$$HLNAME^HLFNC(X2) Q:Y']""
|
; PCE 21 -> ien file #79.1~name of img loc~stn #~stn name
|
||||||
.S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
|
N RACN00,RA20 S RACN00=$G(^RADPT(RADFN,"DT",RADTI,0))
|
||||||
;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
|
S RA20=+$G(^RA(79.1,+$P(RACN00,U,4),0))
|
||||||
S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
|
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)),"^")
|
||||||
.S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
|
S $P(X1,HLFS,21)=$P(X1,HLFS,21)
|
||||||
.S Y=$$HLNAME^HLFNC(X2) Q:Y']""
|
; Replace above with following when Imaging can cope with ESC chars
|
||||||
.S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
|
; S $P(X1,HLFS,21)=$$ESCAPE^RAHLRU($P(X1,HLFS,21))
|
||||||
I $P(RACN0,"^",12) D
|
;
|
||||||
.S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
|
S OBR36=9999999.9999-RADTI
|
||||||
.S Y=$$HLNAME^HLFNC(X2) Q:Y']""
|
S $P(X1,HLFS,37)=$$FMTHL7^XLFDT(OBR36)
|
||||||
.S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
|
;
|
||||||
;Technician = Technologist
|
S RADTV=HLDT1 I $P(RARPT0,"^",5)="V",$P(RARPT0,"^",7) K RADTV S RADTV=$$HLDATE^HLFNC($P(RARPT0,"^",7))
|
||||||
S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
|
S $P(X1,HLFS,23)=RADTV,$P(X1,HLFS,26)=$S($P(RARPT0,"^",5)="V":"F",1:"R")
|
||||||
.S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
|
;Principal Result Interpreter = Verifying Physician
|
||||||
.S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
|
S $P(X1,HLFS,33)="" I $P(RARPT0,"^",9) D
|
||||||
.S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
|
.S X2=$$GET1^DIQ(200,$P(RARPT0,"^",9),.01) Q:X2']""
|
||||||
.S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
|
.S Y=$$HLNAME^HLFNC(X2) Q:Y']""
|
||||||
.S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
|
.S $P(X1,HLFS,33)=$P(RARPT0,"^",9)_$E(HLECH)_Y
|
||||||
;Transcriptionist
|
;Assistant Result Interpreter = Primary Interpreting Staff OR Resident
|
||||||
S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
|
S $P(X1,HLFS,34)="" I $P(RACN0,"^",15) D
|
||||||
.S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
|
.S X2=$$GET1^DIQ(200,$P(RACN0,"^",15),.01) Q:X2']""
|
||||||
.S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
|
.S Y=$$HLNAME^HLFNC(X2) Q:Y']""
|
||||||
.S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
|
.S $P(X1,HLFS,34)=$P(RACN0,"^",15)_$E(HLECH)_Y
|
||||||
;
|
I $P(RACN0,"^",12) D
|
||||||
S RAN=RAN+1
|
.S X2=$$GET1^DIQ(200,$P(RACN0,"^",12),.01) Q:X2']""
|
||||||
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
|
.S Y=$$HLNAME^HLFNC(X2) Q:Y']""
|
||||||
S HLA("HLS",RAN)=X1
|
.S $P(X1,HLFS,34)=$P(RACN0,"^",12)_$E(HLECH)_Y
|
||||||
Q
|
;Technician = Technologist
|
||||||
|
S $P(X1,HLFS,35)="" I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) D
|
||||||
|
.S X2=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0)) I X2']"" Q
|
||||||
|
.S X2=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",X2,0)) I X2']"" Q
|
||||||
|
.S XX2=$$GET1^DIQ(200,X2,.01) Q:XX2']""
|
||||||
|
.S Y=$$HLNAME^HLFNC(XX2) I Y']"" Q
|
||||||
|
.S $P(X1,HLFS,35)=X2_$E(HLECH)_Y
|
||||||
|
;Transcriptionist
|
||||||
|
S $P(X1,HLFS,36)="" I $G(^RARPT(RARPT,"T")) D
|
||||||
|
.S X2=$$GET1^DIQ(200,^RARPT(RARPT,"T"),.01) I X2']"" Q
|
||||||
|
.S Y=$$HLNAME^HLFNC(X2) I Y']"" Q
|
||||||
|
.S $P(X1,HLFS,36)=^RARPT(RARPT,"T")_$E(HLECH)_Y
|
||||||
|
;
|
||||||
|
S RAN=RAN+1
|
||||||
|
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
|
||||||
|
S HLA("HLS",RAN)=X1
|
||||||
|
Q
|
||||||
OBXRPT ;Compile 'OBX' Segment for Radiology Report Text
|
OBXRPT ;Compile 'OBX' Segment for Radiology Report Text
|
||||||
N RATX
|
N RATX
|
||||||
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
|
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
|
||||||
S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI I $D(^(RAI,0)) S RATX=RATX_^(0)
|
S RATX="" F RAI=0:0 S RAI=$O(^RARPT(RARPT,"R",RAI)) Q:'RAI I $D(^(RAI,0)) S RATX=RATX_^(0)
|
||||||
S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
|
S RAN=RAN+1,HLA("HLS",RAN)="OBX"_HLFS_HLFS_"TX"_HLFS_RAOBR4_HLFS_HLFS_$G(RATX) D OBX11^RAHLRU
|
||||||
Q
|
Q
|
||||||
PID ;Compile 'PID' Segment
|
PID ;Compile 'PID' Segment
|
||||||
;
|
;
|
||||||
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
|
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
|
||||||
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
|
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
|
||||||
Q
|
Q
|
||||||
SETUP ; Setup basic examination information
|
SETUP ; Setup basic examination information
|
||||||
S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
|
S:RASET RACN0=^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)
|
||||||
S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
|
S RADTE0=9999999.9999-RADTI,RADTECN=$E(RADTE0,4,7)_$E(RADTE0,2,3)_"-"_+RACN0,RARPT0=^RARPT(RARPT,0)
|
||||||
S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
|
S RAPROC=+$P(RACN0,U,2),RAPROCIT=+$P($G(^RAMIS(71,RAPROC,0)),U,12),RAPROCIT=$P(^RA(79.2,RAPROCIT,0),U,1)
|
||||||
S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
|
S RAPRCNDE=$G(^RAMIS(71,+RAPROC,0)),RACPT=+$P(RAPRCNDE,U,9)
|
||||||
S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
|
S RACPTNDE=$$NAMCODE^RACPTMSC(RACPT,DT)
|
||||||
S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
|
S Y=$$HLDATE^HLFNC(RADTE0) S RADTE0=$S(Y:Y,1:HLQ),Y=$$M11^HLFNC(RADFN)
|
||||||
Q
|
Q
|
||||||
|
|
348
p/C0CRARPT.m
348
p/C0CRARPT.m
|
@ -1,166 +1,182 @@
|
||||||
C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
|
C0CRARPT ; C0C/ELN - CCR/CCD PROCESSING FOR RAD REPORT ; 19/10/2010
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
;
|
||||||
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
|
; (C) ELN 2010
|
||||||
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
;
|
||||||
; MIXML IS THE TEMPLATE TO USE
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; MOXML IS THE OUTPUT XML ARRAY
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; DFN IS THE PATIENT RECORD NUMBER
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
N C0COXML,C0CO,C0CV,C0CIXML
|
; License, or (at your option) any later version.
|
||||||
I '$D(MIVAR) S C0CV="" ;DEFAULT
|
;
|
||||||
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
|
; This program is distributed in the hope that it will be useful,
|
||||||
I '$D(MIXML) S C0CIXML="" ;DEFAULT
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
E S C0CIXML=MIXML ;PASSED INPUT XML
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
|
; GNU Affero General Public License for more details.
|
||||||
I '$D(MOXML) D Q
|
;
|
||||||
. S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
. M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
E D
|
;
|
||||||
. N C0COOXML
|
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
||||||
. S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
|
; ASSUMES THAT EXTRACT HAS BEEN RUN AND THE VARIABLES STORED IN MIVAR
|
||||||
. D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
|
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
||||||
. S C0COCNT=$O(C0CRSXML(""),-1)
|
; MIXML IS THE TEMPLATE TO USE
|
||||||
. S C0CRES=0
|
; MOXML IS THE OUTPUT XML ARRAY
|
||||||
. F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D
|
; DFN IS THE PATIENT RECORD NUMBER
|
||||||
. . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
|
N C0COXML,C0CO,C0CV,C0CIXML
|
||||||
. . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
|
I '$D(MIVAR) S C0CV="" ;DEFAULT
|
||||||
. . S C0COCNT=C0COCNT+1
|
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
|
||||||
. S C0CRSXML(C0COCNT)="</Results>"
|
I '$D(MIXML) S C0CIXML="" ;DEFAULT
|
||||||
. S C0CRSXML(0)=C0COCNT
|
E S C0CIXML=MIXML ;PASSED INPUT XML
|
||||||
. D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
|
D RPCMAP(.C0COXML,DFN,C0CV,C0CIXML) ; CALL RPC TO DO THE WORK
|
||||||
. D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
|
I '$D(MOXML) D Q
|
||||||
S C0CO=MOXML,@C0CO@(0)=0
|
. S C0CO=$NA(^TMP("C0CCCR",$J,DFN,"RESULTS")) ;DEFAULT FOR OUTPUT
|
||||||
K C0CRSXML,C0COCNT,C0COXML,C0CRES
|
. M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
|
||||||
Q
|
E D
|
||||||
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
. N C0COOXML
|
||||||
; RTN IS PASSED BY REFERENCE
|
. S CCRGLO=$NA(^TMP("C0CCCR",$J,DFN,"CCR"))
|
||||||
N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
|
. D QUERY^C0CXPATH(CCRGLO,"//ContinuityOfCareRecord/Body/Results","C0CRSXML")
|
||||||
N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
|
. S C0COCNT=$O(C0CRSXML(""),-1)
|
||||||
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
|
. S C0CRES=0
|
||||||
I RMIXML="" D ; INPUT XML NOT PASSED
|
. F S C0CRES=$O(C0COXML(C0CRES)) Q:C0CRES="" D
|
||||||
. D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
|
. . Q:$G(C0COXML(C0CRES))="<Results>"!($G(C0COXML(C0CRES))="</Results>")
|
||||||
. D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
|
. . S C0CRSXML(C0COCNT)=$G(C0COXML(C0CRES))
|
||||||
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
|
. . S C0COCNT=C0COCNT+1
|
||||||
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
|
. S C0CRSXML(C0COCNT)="</Results>"
|
||||||
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
|
. S C0CRSXML(0)=C0COCNT
|
||||||
. S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
|
. D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
|
||||||
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
|
. D INSERT^C0CXPATH(CCRGLO,"C0CRSXML","//ContinuityOfCareRecord/Body")
|
||||||
D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
|
S C0CO=MOXML,@C0CO@(0)=0
|
||||||
D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
|
K C0CRSXML,C0COCNT,C0COXML,C0CRES
|
||||||
D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
|
Q
|
||||||
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
|
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
||||||
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
; RTN IS PASSED BY REFERENCE
|
||||||
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
|
||||||
; NO RESULTS
|
N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
|
||||||
I @C0CV@(0)=0 S RTN(0)=0 Q
|
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
|
||||||
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
I RMIXML="" D ; INPUT XML NOT PASSED
|
||||||
K @RIMVARS
|
. D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
|
||||||
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
. D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
|
||||||
N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
|
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
|
||||||
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
|
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
|
||||||
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
|
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
|
||||||
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
|
. S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
|
||||||
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
|
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
|
||||||
; TO IMPROVE PERFORMANCE
|
D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
|
||||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
|
D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
|
||||||
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
|
D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
|
||||||
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
|
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
|
||||||
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
|
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
||||||
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
|
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
||||||
. D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
|
; NO RESULTS
|
||||||
. D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
|
I @C0CV@(0)=0 S RTN(0)=0 Q
|
||||||
. I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
|
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
||||||
. . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
|
K @RIMVARS
|
||||||
. . K C0CTO ; CLEAR OUTPUT VARIABLE
|
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
||||||
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
|
N C0CI,C0CIN,C0CJ,C0CJE,C0CJS,C0CJN,C0CMAP,C0CTMAP,C0CTMP
|
||||||
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
|
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
|
||||||
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
|
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
|
||||||
. . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
|
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
|
||||||
. . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
|
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
|
||||||
. . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
|
; TO IMPROVE PERFORMANCE
|
||||||
. . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>
|
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
|
||||||
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
|
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
|
||||||
. . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
|
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
|
||||||
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
|
||||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
|
||||||
D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
|
. D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
|
||||||
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
|
. D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
|
||||||
Q
|
. I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
|
||||||
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
|
. . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
|
||||||
S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
|
. . K C0CTO ; CLEAR OUTPUT VARIABLE
|
||||||
S RADFN=DFN
|
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
|
||||||
D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
|
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
|
||||||
;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
|
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
|
||||||
N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
|
. . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
|
||||||
S C0CQT=1 ; SURPRESS LISTING
|
. . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
|
||||||
D LIST ; EXTRACT THE VARIABLES
|
. . . I C0CJ=1 S C0CJS=2 E S C0CJS=1 ;FIRST TIME,SKIP THE <Test>
|
||||||
;S C0CQT=QTSAV ; RESET SILENT FLAG
|
. . . I C0CJ=C0CJN S C0CJE=@C0CTMP@(0)-1 E S C0CJE=@C0CTMP@(0) ;</Test>
|
||||||
K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
|
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
|
||||||
K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
|
. . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
|
||||||
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
|
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
||||||
Q
|
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
||||||
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
|
||||||
N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
|
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
|
||||||
I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
Q
|
||||||
I '$D(C0CQT) S C0CQT=0
|
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT RADIOLOGY REPORTS INTO THE C0CLVAR GLOBAL
|
||||||
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
|
S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR RADS VARS
|
||||||
I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
|
S RADFN=DFN
|
||||||
. D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
|
D GHL7^C0CRAHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
|
||||||
. K ^TMP("C0CCCR","RATBL")
|
;ELN K @C0CLB ; CLEAR OUT OLD VARS IF ANY
|
||||||
. M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
|
N QTSAV S QTSAV=$G(C0CQT) ;SAVE QUIET FLAG
|
||||||
I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
|
S C0CQT=1 ; SURPRESS LISTING
|
||||||
S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
|
D LIST ; EXTRACT THE VARIABLES
|
||||||
S C0CHB=$NA(^TMP("HLS",$J))
|
;S C0CQT=QTSAV ; RESET SILENT FLAG
|
||||||
S C0CI=""
|
K ^TMP("HLS",$J),^TMP("C0CCCR","RATBL") ; KILL HL7 MESSAGE OUTPUT
|
||||||
S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
|
K C0CLB,C0CLB2,C0CLI,C0CLOBX,RADFN
|
||||||
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
|
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
|
||||||
. K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
|
Q
|
||||||
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
|
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
||||||
. D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
|
N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR,C0CTAB,C0CTYP
|
||||||
. M XV=C0CVAR ;
|
I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||||||
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
|
I '$D(C0CQT) S C0CQT=0
|
||||||
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
|
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
|
||||||
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
|
I '$D(^TMP("C0CCCR","RATBL",0))!($G(^TMP("C0CCCR","RATBL",0))'="V3") D
|
||||||
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
|
. D SETTBL^C0CLABS ;INITIALIZE LAB TABLE
|
||||||
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
|
. K ^TMP("C0CCCR","RATBL")
|
||||||
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
|
. M ^TMP("C0CCCR","RATBL")=^TMP("C0CCCR","LABTBL")
|
||||||
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
|
I '$D(^TMP("HLS",$J,1)) D GHL7^C0CRAHL7 ; GET HL7 MGS IF NOT ALREADY DONE
|
||||||
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
|
S C0CTAB=$NA(^TMP("C0CCCR","RATBL")) ; BASE OF OBX TABLE
|
||||||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
S C0CHB=$NA(^TMP("HLS",$J))
|
||||||
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
S C0CI=""
|
||||||
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
|
S @C0CLB@(0)=$O(^TMP("C0CCCR",$J,"RESULTS",""),-1) ; INITALIZE RESULTS VARS COUNT
|
||||||
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
|
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
|
||||||
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3
|
. K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
|
||||||
. . ; RESULTTESTCODEVALUE
|
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
|
||||||
. . ; RESULTTESTDESCRIPTIONTEXT
|
. D LTYP^C0CLABS(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
|
||||||
. . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT"
|
. M XV=C0CVAR ;
|
||||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
|
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
|
||||||
. . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
|
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
|
||||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
|
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
|
||||||
. . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT
|
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
|
||||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
|
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
|
||||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
|
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
|
||||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
|
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
|
||||||
. . E D ; NO SECONDARY, USE PRIMARY
|
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
|
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
|
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
||||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
|
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
|
||||||
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
|
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
|
||||||
. . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
|
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3
|
||||||
. . S C0CZG=XV("RESULTTESTVALUE")
|
. . ; RESULTTESTCODEVALUE
|
||||||
. . S XV("RESULTTESTVALUE")=C0CZG
|
. . ; RESULTTESTDESCRIPTIONTEXT
|
||||||
. . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION
|
. . I C0CVAR("C3")="C4" D ; PRIMARY CODE "CPT"
|
||||||
. . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
|
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE CPT CODE VALUE
|
||||||
. . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
|
. . . S XV("RESULTTESTCODINGSYSTEM")="CPT" ; DISPLAY NAME FOR CPT
|
||||||
. . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
|
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
|
||||||
. . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
|
. . E I C0CVAR("C6")'="" D ; NO CPT CODES, USE SECONDARY IF PRESENT
|
||||||
. . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
|
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
|
||||||
. . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
|
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
|
||||||
. . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
|
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
|
||||||
. . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
|
. . E D ; NO SECONDARY, USE PRIMARY
|
||||||
. . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
|
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
|
||||||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
|
||||||
. . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
|
||||||
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
|
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
|
||||||
K XV,C0CZG,C0CX1,C0CX2,C0CVAR
|
. . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
|
||||||
Q
|
. . S C0CZG=XV("RESULTTESTVALUE")
|
||||||
|
. . S XV("RESULTTESTVALUE")=C0CZG
|
||||||
|
. . I C0CLOBX=0 D ; FIRST TEST RESULT FOR THIS SECTION
|
||||||
|
. . . S C0CLB2=$NA(@C0CLB@(C0CLI,"M","TEST")) ; INDENT FOR TEST RESULTS
|
||||||
|
. . S C0CLOBX=C0CLOBX+1 ; INCREMENT TEST COUNT
|
||||||
|
. . S @C0CLB2@(0)=C0CLOBX ; STORE THE TEST COUNT
|
||||||
|
. . S XV("RESULTTESTOBJECTID")="RESULTTEST_"_C0CLI_"_"_C0CLOBX
|
||||||
|
. . S C0CX1=XV("RESULTTESTSOURCEACTORID") ; TEST SOURCE
|
||||||
|
. . S C0CX2=$P($P(C0CX1,"^",1),"-",1) ; PULL OUT STATION NUMBER
|
||||||
|
. . S XV("RESULTTESTSOURCEACTORID")="ACTORORGANIZATION_"_C0CX2
|
||||||
|
. . S XV("RESULTTESTNORMALSOURCEACTORID")=XV("RESULTTESTSOURCEACTORID")
|
||||||
|
. . S C0CX1=XV("RESULTTESTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||||||
|
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||||||
|
. . S XV("RESULTTESTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
||||||
|
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
|
||||||
|
K XV,C0CZG,C0CX1,C0CX2,C0CVAR
|
||||||
|
Q
|
||||||
|
|
31
p/C0CRIMA.m
31
p/C0CRIMA.m
|
@ -1,22 +1,19 @@
|
||||||
C0CRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
|
C0CRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
|
; THESE ROUTINES EXAMINE ONE OR MORE, UP TO ALL, OF THE PATIENTS ON THE
|
||||||
; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
|
; SYSTEM TO DETERMINE HOW COMPLETE THE RESULTING CCR OR CCD WOULD BE FOR
|
||||||
|
@ -99,7 +96,7 @@ ANALYZE(BEGDFN,DFNCNT,APARMS) ; RIM COHERANCE ANALYSIS ROUTINE
|
||||||
. D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
|
. D CPUSH(.CATNAME,RIMBASE,"RIMTBL",RIMDFN,RATTR) ; ADD TO CATEGORY
|
||||||
. W "CATEGORY NAME: ",CATNAME,!
|
. W "CATEGORY NAME: ",CATNAME,!
|
||||||
. ;
|
. ;
|
||||||
. F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
|
. F S RIMDFN=$O(^DPT(RIMDFN)) Q:'$$PTST^C0CSYS(RIMDFN) ; NEXT PATIENT
|
||||||
. ; PTST TESTS TO SEE IF PATIENT WAS MERGED
|
. ; PTST TESTS TO SEE IF PATIENT WAS MERGED
|
||||||
. ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
|
. ; IF CCRTEST=0, PTST WILL CHECK TO SEE IF THIS IS A TEST PATIENT
|
||||||
. ; AND WE SKIP IT
|
. ; AND WE SKIP IT
|
||||||
|
@ -385,7 +382,7 @@ GETPA(RTN,DFN,ISEC,IVAR) ; RETURNS ARRAY OF RIM VARIABLES FOR PATIENT DFN
|
||||||
S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
|
S RTN(0)=0 ; SET NULL DEFAULT RETURN VALUE
|
||||||
I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
|
I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
|
||||||
S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
|
S ZVBASE=$NA(@RIMBASE@("VARS")) ; BASE OF VARIABLES
|
||||||
I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION
|
I '$D(@ZVBASE@(DFN,ISEC,0)) D Q ; NO VARIABLES IN SECTION
|
||||||
. W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
|
. W "NO VARIABLES IN THIS SECTION FOR PATIENT ",DFN,!
|
||||||
N ZZI,ZZS
|
N ZZI,ZZS
|
||||||
S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
|
S ZZS=$NA(@ZVBASE@(DFN,ISEC)) ; SECTION VARIABLE ARRAY FOR THIS PATIENT
|
||||||
|
@ -419,7 +416,7 @@ PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
|
||||||
S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
|
S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
|
||||||
N ZNC ; ZNC IS NUMBER OF CATEGORIES
|
N ZNC ; ZNC IS NUMBER OF CATEGORIES
|
||||||
S ZNC=@ZCBASE@(0)
|
S ZNC=@ZCBASE@(0)
|
||||||
I ZNC=0 Q ; NO CATEGORIES TO SEARCH
|
I ZNC=0 Q ; NO CATEGORIES TO SEARCH
|
||||||
N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
|
N ZAP ; ZAP IS THE PIECE INDEX OF THE ATTRIBUTE IN THE RIM ATTR TABLE
|
||||||
S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
|
S ZAP=@RIMBASE@("RIMTBL","TABLE",IATTR)
|
||||||
N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
|
N ZI,ZCATTBL,ZATBL,ZCNT,ZPAT
|
||||||
|
|
30
p/C0CRNF.m
30
p/C0CRNF.m
|
@ -1,21 +1,19 @@
|
||||||
C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
|
C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the Reference Name Format (RNF) Utility Library ",!
|
W "This is the Reference Name Format (RNF) Utility Library ",!
|
||||||
W !
|
W !
|
||||||
|
@ -28,7 +26,7 @@ FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
|
||||||
N C0CFN ; FIELD NAME
|
N C0CFN ; FIELD NAME
|
||||||
S C0CFI=0 S C0CFJ=C0CF
|
S C0CFI=0 S C0CFJ=C0CF
|
||||||
K @C0CFRTN ; CLEAR THE RETURN ARRAY
|
K @C0CFRTN ; CLEAR THE RETURN ARRAY
|
||||||
F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
|
F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
|
||||||
. ;W "1: "_C0CFJ," ",C0CFI,!
|
. ;W "1: "_C0CFJ," ",C0CFI,!
|
||||||
. F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD
|
. F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD
|
||||||
. . ;W "2: "_C0CFJ," ",C0CFI,!
|
. . ;W "2: "_C0CFJ," ",C0CFI,!
|
||||||
|
@ -52,7 +50,7 @@ TESTRNF ; TEST THE RNF1TO2 ROUTINE
|
||||||
S G1("TWO")="STILL2"
|
S G1("TWO")="STILL2"
|
||||||
S G1("THREE")=3
|
S G1("THREE")=3
|
||||||
D RNF1TO2("GPL","G1")
|
D RNF1TO2("GPL","G1")
|
||||||
ZWR GPL
|
; ZWR GPL
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
|
RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
|
||||||
|
|
26
p/C0CRNFRP.m
26
p/C0CRNFRP.m
|
@ -1,21 +1,19 @@
|
||||||
C0CRNFRP ; CCDCCR/GPL - Reference Name Format (RNF) RPCs; 12/9/09 ; 5/10/12 2:56pm
|
C0CRNFRP ; CCDCCR/GPL - Reference Name Format (RNF) RPCs; 12/9/09 ; 5/10/12 2:56pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the Reference Name Format (RNF) RPC Library ",!
|
W "This is the Reference Name Format (RNF) RPC Library ",!
|
||||||
W !
|
W !
|
||||||
|
|
29
p/C0CRPMS.m
29
p/C0CRPMS.m
|
@ -1,21 +1,18 @@
|
||||||
C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09 14:33
|
C0CRPMS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR RPMS ;1/14/09 14:33
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 George Lilly. Licensed under the terms of the GNU
|
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -26,7 +23,7 @@ DISPLAY ; RUN THE PCC DISPLAY ROUTINE
|
||||||
;
|
;
|
||||||
VTYPES ;
|
VTYPES ;
|
||||||
D GETN2^C0CRNF("G1",9999999.07)
|
D GETN2^C0CRNF("G1",9999999.07)
|
||||||
ZWR G1
|
; ZWR G1
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN
|
VISITS(C0CDFN,C0CCNT) ;LIST VISIT DATES FOR PATIENT DFN
|
||||||
|
@ -91,7 +88,7 @@ GETTBL(C0CTBL) ; SCAN FOR AND DISPLAY PATIENTS IN A RIMTBL, PASSED BY VALUE
|
||||||
F S C0CG=$O(@ZG@(C0CG),-1) Q:(C0CG="") D ;
|
F S C0CG=$O(@ZG@(C0CG),-1) Q:(C0CG="") D ;
|
||||||
. W "PAT: ",C0CG,!
|
. W "PAT: ",C0CG,!
|
||||||
. D GETNV^C0CRPMS(C0CG)
|
. D GETNV^C0CRPMS(C0CG)
|
||||||
. K X R X
|
. K X R X:DTIME
|
||||||
. I X="Q" S C0CQ=1 ; QUIT IF Q
|
. I X="Q" S C0CQ=1 ; QUIT IF Q
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
37
p/C0CRXN.m
37
p/C0CRXN.m
|
@ -1,21 +1,19 @@
|
||||||
C0CRXN ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
|
C0CRXN ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR RXNORM Utility Library ",!
|
W "This is the CCR RXNORM Utility Library ",!
|
||||||
W !
|
W !
|
||||||
|
@ -52,7 +50,7 @@ EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
|
||||||
. . S NOVUID=NOVUID+1
|
. . S NOVUID=NOVUID+1
|
||||||
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
||||||
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
||||||
. . ;ZWR C0CA
|
. ;ZWR C0CA
|
||||||
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
||||||
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
||||||
. . S RXFOUND=RXFOUND+1
|
. . S RXFOUND=RXFOUND+1
|
||||||
|
@ -73,7 +71,7 @@ EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
|
||||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||||
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
||||||
. D UPDATE^DIE("","C0CFDA")
|
. D UPDATE^DIE("","C0CFDA")
|
||||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
. I $D(^TMP("DIERR",$J)) S $EC=",U1,"
|
||||||
W "HAS RXN=",HASRXN,!
|
W "HAS RXN=",HASRXN,!
|
||||||
W "NO RXN=",NORXN,!
|
W "NO RXN=",NORXN,!
|
||||||
W "NO VUID=",NOVUID,!
|
W "NO VUID=",NOVUID,!
|
||||||
|
@ -149,7 +147,7 @@ EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
|
||||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||||
. S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
|
. S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
|
||||||
. D UPDATE^DIE("","C0CFDA")
|
. D UPDATE^DIE("","C0CFDA")
|
||||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
. I $D(^TMP("DIERR",$J)) S $EC=",U1,"
|
||||||
W "VA MAPPING VUID COUNT: ",VAVCNT,!
|
W "VA MAPPING VUID COUNT: ",VAVCNT,!
|
||||||
W "VA MAPPING MISSING: ",VANO,!
|
W "VA MAPPING MISSING: ",VANO,!
|
||||||
W "VA MAPPING TEXT MISMATCH: ",VATCNT,!
|
W "VA MAPPING TEXT MISMATCH: ",VATCNT,!
|
||||||
|
@ -215,6 +213,7 @@ CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
|
||||||
W "ERRORS: ",NOVUID,!
|
W "ERRORS: ",NOVUID,!
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
D
|
||||||
. I $$ZVALUE("MEDIATION CODE")="" D
|
. I $$ZVALUE("MEDIATION CODE")="" D
|
||||||
. . S NORXN=NORXN+1 ;
|
. . S NORXN=NORXN+1 ;
|
||||||
. E D ; PROCESS MEDIATION CODE
|
. E D ; PROCESS MEDIATION CODE
|
||||||
|
@ -224,7 +223,7 @@ CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
|
||||||
. . S NOVUID=NOVUID+1
|
. . S NOVUID=NOVUID+1
|
||||||
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
||||||
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
||||||
. . ;ZWR C0CA
|
. ;ZWR C0CA
|
||||||
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
||||||
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
||||||
. . S RXFOUND=RXFOUND+1
|
. . S RXFOUND=RXFOUND+1
|
||||||
|
@ -244,7 +243,7 @@ CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
|
||||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||||
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
||||||
. D UPDATE^DIE("","C0CFDA")
|
. D UPDATE^DIE("","C0CFDA")
|
||||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
. I $D(^TMP("DIERR",$J)) S $EC=",U1,"
|
||||||
W "HAS RXN=",HASRXN,!
|
W "HAS RXN=",HASRXN,!
|
||||||
W "NO RXN=",NORXN,!
|
W "NO RXN=",NORXN,!
|
||||||
W "NO VUID=",NOVUID,!
|
W "NO VUID=",NOVUID,!
|
||||||
|
|
28
p/C0CRXNRD.m
28
p/C0CRXNRD.m
|
@ -1,7 +1,22 @@
|
||||||
C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
|
C0CRXNRD ; WV/SMH - CCR/CCD PROJECT: Routine to Read RxNorm files;11/15/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
; Copyright Sam Habiel 2008.
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
W "No entry from top" Q
|
W "No entry from top" Q
|
||||||
IMPORT(PATH)
|
IMPORT(PATH) ; Main entry point
|
||||||
I PATH="" QUIT
|
I PATH="" QUIT
|
||||||
D READSRC(PATH),READCON(PATH),READNDC(PATH)
|
D READSRC(PATH),READCON(PATH),READNDC(PATH)
|
||||||
QUIT
|
QUIT
|
||||||
|
@ -20,7 +35,7 @@ GETLINES(PATH,FILENAME) ; Get number of lines in a file
|
||||||
D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
|
D OPEN^%ZISH("FILE",PATH,FILENAME,"R")
|
||||||
U IO
|
U IO
|
||||||
N I
|
N I
|
||||||
F I=1:1 R LINE Q:$$STATUS^%ZISH
|
F I=1:1 R LINE:0 Q:$$STATUS^%ZISH
|
||||||
D CLOSE^%ZISH("FILE")
|
D CLOSE^%ZISH("FILE")
|
||||||
Q I-1
|
Q I-1
|
||||||
READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP
|
READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP
|
||||||
|
@ -36,7 +51,7 @@ READCON(PATH,INCRES) ; Open and read concepts file: RXNCONSO.RRF; EP
|
||||||
N C0CCOUNT
|
N C0CCOUNT
|
||||||
F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH
|
F C0CCOUNT=1:1 D Q:$$STATUS^%ZISH
|
||||||
. U IO
|
. U IO
|
||||||
. N LINE R LINE
|
. N LINE R LINE:0
|
||||||
. IF $$STATUS^%ZISH QUIT
|
. IF $$STATUS^%ZISH QUIT
|
||||||
. I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
|
. I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
|
||||||
. N RXCUI,RXAUI,SAB,TTY,CODE,STR ; Fileman fields numbers below
|
. N RXCUI,RXAUI,SAB,TTY,CODE,STR ; Fileman fields numbers below
|
||||||
|
@ -81,7 +96,7 @@ READNDC(PATH) ; Open and read NDC/RxNorm/VANDF relationship file: RXNSAT.RRF
|
||||||
IF POP W "Error reading file..., Please check...",! G EX2
|
IF POP W "Error reading file..., Please check...",! G EX2
|
||||||
F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D
|
F C0CCOUNT=1:1 Q:$$STATUS^%ZISH D
|
||||||
. U IO
|
. U IO
|
||||||
. N LINE R LINE
|
. N LINE R LINE:0
|
||||||
. IF $$STATUS^%ZISH QUIT
|
. IF $$STATUS^%ZISH QUIT
|
||||||
. I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
|
. I '(C0CCOUNT#1000) U $P W C0CCOUNT," of ",LINES," read ",! U IO ; update every 1000
|
||||||
. IF LINE'["NDC|RXNORM" QUIT
|
. IF LINE'["NDC|RXNORM" QUIT
|
||||||
|
@ -105,7 +120,7 @@ READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF
|
||||||
IF POP W "Error reading file..., Please check...",! G EX3
|
IF POP W "Error reading file..., Please check...",! G EX3
|
||||||
F I=1:1 Q:$$STATUS^%ZISH D
|
F I=1:1 Q:$$STATUS^%ZISH D
|
||||||
. U IO
|
. U IO
|
||||||
. N LINE R LINE
|
. N LINE R LINE:0
|
||||||
. IF $$STATUS^%ZISH QUIT
|
. IF $$STATUS^%ZISH QUIT
|
||||||
. U $P W I,! U IO ; Write I to the screen, then go back to reading the file
|
. U $P W I,! U IO ; Write I to the screen, then go back to reading the file
|
||||||
. N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
|
. N VCUI,RCUI,VSAB,RSAB,SON,SF,SVER,SRL,SCIT ; Fileman fields numbers below
|
||||||
|
@ -140,4 +155,3 @@ READSRC(PATH) ; Open the read RxNorm Sources file: RXNSAB.RRF
|
||||||
. D WP^DIE(176.003,I_",",25,,$NA(SCIT))
|
. D WP^DIE(176.003,I_",",25,,$NA(SCIT))
|
||||||
EX3 D CLOSE^%ZISH("FILE")
|
EX3 D CLOSE^%ZISH("FILE")
|
||||||
Q
|
Q
|
||||||
|
|
||||||
|
|
307
p/C0CSNOA.m
307
p/C0CSNOA.m
|
@ -1,67 +1,60 @@
|
||||||
C0CSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08
|
C0CSNOA ; CCDCCR/GPL - SNOMED CT ANALYSIS ROUTINES; 10/14/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
;Copyright 2008,2009 George Lilly, University of Minnesota.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
|
||||||
; THESE ROUTINES ANALYZE THE POTENTIAL RETRIEVAL OF SNOMED CT CODES
|
|
||||||
; FOR PATIENT DRUG ALLERGIES FOR INCLUSION IN THE CCR OR CCD
|
|
||||||
; USING THE VISTA LEXICON ^LEX
|
|
||||||
;
|
;
|
||||||
ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
|
ANALYZE(BEGIEN,IENCNT) ; SNOMED RETRIEVAL ANALYSIS ROUTINE
|
||||||
; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
|
; BEGINS AT BEGIEN AND GOES FOR IENCNT DRUGS IN GMRD
|
||||||
; TO RESUME AT NEXT DRUG, USE BEGIEN=""
|
; TO RESUME AT NEXT DRUG, USE BEGIEN=""
|
||||||
; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
|
; USE RESET^C0CSNOA TO RESET TO TOP OF DRUG LIST
|
||||||
;
|
;
|
||||||
N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
|
N SNOARY,SNOTMP,SNOI,SNOIEN,RATTR
|
||||||
N CCRGLO
|
N CCRGLO
|
||||||
D ASETUP ; SET UP VARIABLES AND GLOBALS
|
D ASETUP ; SET UP VARIABLES AND GLOBALS
|
||||||
D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
|
D AINIT ; INITIALIZE ATTRIBUTE VALUE TABLE
|
||||||
I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
|
I '$D(@SNOBASE@("RESUME")) S @SNOBASE@("RESUME")=$O(@GMRBASE@(1)) ;1ST TME
|
||||||
S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
|
S RESUME=@SNOBASE@("RESUME") ; WHERE WE LEFT OFF LAST RUN
|
||||||
S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
|
S SNOIEN=BEGIEN ; BEGIN WITH THE BEGIEN RECORD
|
||||||
I SNOIEN="" S SNOIEN=RESUME
|
I SNOIEN="" S SNOIEN=RESUME
|
||||||
I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST
|
I +SNOIEN=0 D Q ; AT THE END OF THE ALLERGY LIST
|
||||||
. W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
|
. W "END OF DRUG LIST, CALL RESET^C0CSNOA",!
|
||||||
F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END
|
F SNOI=1:1:IENCNT D Q:+SNOIEN=0 ; FOR IENCNT NUMBER OF PATIENTS OR END
|
||||||
. ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
|
. ;D CCRRPC^C0CCCR(.CCRGLO,SNOIEN,"CCR","","","") ;PROCESS THE CCR
|
||||||
. W SNOIEN,@GMRBASE@(SNOIEN,0),!
|
. W SNOIEN,@GMRBASE@(SNOIEN,0),!
|
||||||
. N SNORTN,TTERM ; RETURN ARRAY
|
. N SNORTN,TTERM ; RETURN ARRAY
|
||||||
. S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
|
. S TTERM=$P(@GMRBASE@(SNOIEN,0),"^",1)_" ALLERGY"
|
||||||
. D TEXTRPC(.SNORTN,TTERM)
|
. D TEXTRPC(.SNORTN,TTERM)
|
||||||
. I $D(SNORTN) ZWR SNORTN
|
. ; I $D(SNORTN) ZWR SNORTN
|
||||||
. K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
|
. K @SNOBASE@("VARS",SNOIEN) ; CLEAR OUT OLD VARS
|
||||||
. I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
|
. I $P(TTMP,"^",1)=1 S @SNOBASE@("VARS",SNOIEN)=TTERM_"^"_TTMP_"^"_SNORTN(0)
|
||||||
. ;
|
. ;
|
||||||
. ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
|
. ; EVALUATE THE VARIABLES AND CREATE AN ATTRIBUTE MAP
|
||||||
. ;
|
. ;
|
||||||
. S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
|
. S RATTR=$$SETATTR(SNOIEN) ; SET THE ATTRIBUTE STRING BASED ON THE VARS
|
||||||
. S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
|
. S @SNOBASE@("ATTR",SNOIEN)=RATTR ; SAVE THE ATRIBUTES FOR THIS DRUG
|
||||||
. ;
|
. ;
|
||||||
. N CATNAME,CATTBL
|
. N CATNAME,CATTBL
|
||||||
. S CATNAME=""
|
. S CATNAME=""
|
||||||
. D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
|
. D CPUSH(.CATNAME,SNOBASE,"SNOTBL",SNOIEN,RATTR) ; ADD TO CATEGORY
|
||||||
. ; W "CATEGORY NAME: ",CATNAME,!
|
. ; W "CATEGORY NAME: ",CATNAME,!
|
||||||
. ;
|
. ;
|
||||||
. S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
|
. S SNOIEN=$O(@GMRBASE@(SNOIEN)) ; NEXT RECORD
|
||||||
. S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
|
. S @SNOBASE@("RESUME")=SNOIEN ; WHERE WE ARE LEAVING OFF THIS RUN
|
||||||
; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
|
; D PARY^C0CXPATH(@SNOBASE@("ATTRTBL"))
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
|
TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
|
||||||
;
|
;
|
||||||
;N TTMP
|
;N TTMP
|
||||||
|
@ -70,111 +63,111 @@ TEXTRPC(ORTN,ITEXT) ; CALL THE LEXICON WITH ITEXT AND RETURN RESULTS IN ORTN
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
|
ASETUP ; SET UP GLOBALS AND VARS SNOBASE AND SNOTBL
|
||||||
I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
|
I '$D(SNOBASE) S SNOBASE=$NA(^TMP("C0CSNO"))
|
||||||
I '$D(@SNOBASE) S @SNOBASE=""
|
I '$D(@SNOBASE) S @SNOBASE=""
|
||||||
I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
|
I '$D(GMRBASE) S GMRBASE=$NA(^GMRD(120.82))
|
||||||
I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
|
I '$D(SNOTBL) S SNOTBL=$NA(^TMP("C0CSNO","SNOTBL","TABLE")) ; ATTR TABLE
|
||||||
S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
|
S ^TMP("C0CSNO","TABLES","SNOTBL")=SNOTBL ; TABLE OF TABLES
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
AINIT ; INITIALIZE ATTRIBUTE TABLE
|
AINIT ; INITIALIZE ATTRIBUTE TABLE
|
||||||
I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||||||
K @SNOTBL
|
K @SNOTBL
|
||||||
D APUSH^C0CRIMA(SNOTBL,"CODE")
|
D APUSH^C0CRIMA(SNOTBL,"CODE")
|
||||||
D APUSH^C0CRIMA(SNOTBL,"NOCODE")
|
D APUSH^C0CRIMA(SNOTBL,"NOCODE")
|
||||||
D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
|
D APUSH^C0CRIMA(SNOTBL,"MULTICODE")
|
||||||
D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
|
D APUSH^C0CRIMA(SNOTBL,"SUBMULTI")
|
||||||
D APUSH^C0CRIMA(SNOTBL,"DONE")
|
D APUSH^C0CRIMA(SNOTBL,"DONE")
|
||||||
Q
|
Q
|
||||||
APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
|
APOST(PRSLT,PTBL,PVAL) ; POST AN ATTRIBUTE PVAL TO PRSLT USING PTBL
|
||||||
; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
|
; PSRLT AND PTBL ARE PASSED BY NAME. PVAL IS A STRING
|
||||||
; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
|
; PTBL IS THE NAME OF A TABLE IN @SNOBASE@("TABLES") - "SNOTBL"=ALL VALUES
|
||||||
; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
|
; PVAL WILL BE PLACED IN THE STRING PRSLT AT $P(X,U,@PTBL@(PVAL))
|
||||||
I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
|
I '$D(SNOBASE) D ASETUP ; FOR COMMANDLINE PROCESSING
|
||||||
N USETBL
|
N USETBL
|
||||||
I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE
|
I '$D(@SNOBASE@("TABLES",PTBL)) D Q ; NO TABLE
|
||||||
. W "ERROR NO SUCH TABLE",!
|
. W "ERROR NO SUCH TABLE",!
|
||||||
S USETBL=@SNOBASE@("TABLES",PTBL)
|
S USETBL=@SNOBASE@("TABLES",PTBL)
|
||||||
S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
|
S $P(@PRSLT,U,@USETBL@(PVAL))=PVAL
|
||||||
Q
|
Q
|
||||||
SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
|
SETATTR(SDFN) ; SET ATTRIBUTES BASED ON VARS
|
||||||
N SBASE,SATTR
|
N SBASE,SATTR
|
||||||
S SBASE=$NA(@SNOBASE@("VARS",SDFN))
|
S SBASE=$NA(@SNOBASE@("VARS",SDFN))
|
||||||
D APOST("SATTR","SNOTBL","DONE")
|
D APOST("SATTR","SNOTBL","DONE")
|
||||||
I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
|
I $P(TTMP,"^",1)=1 D APOST("SATTR","SNOTBL","CODE")
|
||||||
I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
|
I $P(TTMP,"^",1)=-1 D APOST("SATTR","SNOTBL","NOCODE")
|
||||||
Q SATTR ; C0C
|
Q SATTR ; C0C
|
||||||
I $D(@SBASE@("PROBLEMS",1)) D ;
|
I $D(@SBASE@("PROBLEMS",1)) D ;
|
||||||
. D APOST("SATTR","SNOTBL","PROBLEMS")
|
. D APOST("SATTR","SNOTBL","PROBLEMS")
|
||||||
. ; W "POSTING PROBLEMS",!
|
. ; W "POSTING PROBLEMS",!
|
||||||
I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
|
I $D(@SBASE@("VITALS",1)) D APOST("SATTR","SNOTBL","VITALS")
|
||||||
I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
|
I $D(@SBASE@("MEDS",1)) D ; IF THE PATIENT HAS MEDS VARIABLES
|
||||||
. D APOST("SATTR","SNOTBL","MEDS")
|
. D APOST("SATTR","SNOTBL","MEDS")
|
||||||
. N ZR,ZI
|
. N ZR,ZI
|
||||||
. D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
|
. D GETPA^C0CRIMA(.ZR,SDFN,"MEDS","MEDPRODUCTNAMECODEVALUE") ;CHECK FOR MED CODES
|
||||||
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
|
. I ZR(0)>0 D ; VAR LOOKUP WAS GOOD, CHECK FOR NON=NULL RETURN
|
||||||
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
|
. . F ZI=1:1:ZR(0) D ; LOOP THROUGH RETURNED VAR^VALUE PAIRS
|
||||||
. . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
|
. . . I $P(ZR(ZI),"^",2)'="" D APOST("SATTR","SNOTBL","MEDSCODE") ;CODES
|
||||||
. ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
|
. ; D PATD^C0CSNOA(2,"MEDS","MEDPRODUCTNAMECODEVALUE") CHECK FOR MED CODES
|
||||||
D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
|
D APOST("SATTR","SNOTBL","NOTEXTRACTED") ; OUTPUT NOT YET PRODUCED
|
||||||
; W "ATTRIBUTES: ",SATTR,!
|
; W "ATTRIBUTES: ",SATTR,!
|
||||||
Q SATTR
|
Q SATTR
|
||||||
;
|
;
|
||||||
RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
|
RESET ; KILL RESUME INDICATOR TO START OVER. ALSO KILL SNO TMP VALUES
|
||||||
K ^TMP("C0CSNO","RESUME")
|
K ^TMP("C0CSNO","RESUME")
|
||||||
K ^TMP("C0CSNO")
|
K ^TMP("C0CSNO")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
CLIST ; LIST THE CATEGORIES
|
CLIST ; LIST THE CATEGORIES
|
||||||
;
|
;
|
||||||
I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
I '$D(SNOBASE) D ASETUP ; FOR COMMAND LINE CALLS
|
||||||
N CLBASE,CLNUM,ZI,CLIDX
|
N CLBASE,CLNUM,ZI,CLIDX
|
||||||
S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
|
S CLBASE=$NA(@SNOBASE@("SNOTBL","CATS"))
|
||||||
S CLNUM=@CLBASE@(0)
|
S CLNUM=@CLBASE@(0)
|
||||||
F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
|
F ZI=1:1:CLNUM D ; LOOP THROUGH THE CATEGORIES
|
||||||
. S CLIDX=@CLBASE@(ZI)
|
. S CLIDX=@CLBASE@(ZI)
|
||||||
. W "(",$P(@CLBASE@(CLIDX),"^",1)
|
. W "(",$P(@CLBASE@(CLIDX),"^",1)
|
||||||
. W ":",$P(@CLBASE@(CLIDX),"^",2),") "
|
. W ":",$P(@CLBASE@(CLIDX),"^",2),") "
|
||||||
. W CLIDX,!
|
. W CLIDX,!
|
||||||
; D PARY^C0CXPATH(CLBASE)
|
; D PARY^C0CXPATH(CLBASE)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
|
CPUSH(CATRTN,CBASE,CTBL,CDFN,CATTR) ; ADD PATIENTS TO CATEGORIES
|
||||||
; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
|
; AND PASS BACK THE NAME OF THE CATEGORY TO WHICH THE PATIENT
|
||||||
; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
|
; WAS ADDED IN CATRTN, WHICH IS PASSED BY REFERENCE
|
||||||
; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
|
; CBASE IS WHERE TO PUT THE CATEGORIES PASSED BY NAME
|
||||||
; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
|
; CTBL IS THE NAME OF THE TABLE USED TO CREATE THE ATTRIBUTES,
|
||||||
; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
|
; PASSED BY NAME AND USED TO CREATE CATEGORY NAMES IE "@CTBL_X"
|
||||||
; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
|
; WHERE X IS THE CATEGORY NUMBER. CTBL(0) IS THE NUMBER OF CATEGORIES
|
||||||
; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
|
; CATBL(X)=CATTR STORES THE ATTRIBUTE IN THE CATEGORY
|
||||||
; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
|
; CDFN IS THE PATIENT DFN, CATTR IS THE ATTRIBUTE STRING
|
||||||
; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
|
; THE LIST OF PATIENTS IN A CATEGORY IS STORED INDEXED BY CATEGORY
|
||||||
; NUMBER IE CTBL_X(CDFN)=""
|
; NUMBER IE CTBL_X(CDFN)=""
|
||||||
;
|
;
|
||||||
; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
|
; N CCTBL,CENTRY,CNUM,CCOUNT,CPATLIST
|
||||||
S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
|
S CCTBL=$NA(@CBASE@(CTBL,"CATS"))
|
||||||
; W "CBASE: ",CCTBL,!
|
; W "CBASE: ",CCTBL,!
|
||||||
;
|
;
|
||||||
I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
|
I '$D(@CCTBL@(CATTR)) D ; FIRST PATIENT IN THIS CATEGORY
|
||||||
. D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
|
. D PUSH^C0CXPATH(CCTBL,CATTR) ; ADD THE CATEGORY TO THE ARRAY
|
||||||
. S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
|
. S CNUM=@CCTBL@(0) ; ARRAY ENTRY NUMBER FOR THIS CATEGORY
|
||||||
. S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
|
. S CENTRY=CTBL_"_"_CNUM_U_0 ; TABLE ENTRY DEFAULT
|
||||||
. S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
|
. S @CCTBL@(CATTR)=CENTRY ; DEFAULT NON INCREMENTED TABLE ENTRY
|
||||||
. ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
|
. ; NOTE THAT P1 IS THE CATEGORY NAME MADE UP OF THE TABLE NAME
|
||||||
. ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
|
. ; AND CATGORY ARRAY NUMBER. P2 IS THE COUNT WHICH IS INITIALLY 0
|
||||||
;
|
;
|
||||||
S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
|
S CCOUNT=$P(@CCTBL@(CATTR),U,2) ; COUNT OF PATIENTS IN THIS CATEGORY
|
||||||
S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
|
S CCOUNT=CCOUNT+1 ; INCREMENT THE COUNT
|
||||||
S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
|
S $P(@CCTBL@(CATTR),U,2)=CCOUNT ; PUT IT BACK
|
||||||
;
|
;
|
||||||
S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
|
S CATRTN=$P(@CCTBL@(CATTR),U,1) ; THE CATEGORY NAME WHICH IS RETURNED
|
||||||
;
|
;
|
||||||
S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
|
S CPATLIST=$NA(@CBASE@(CTBL,"IENS",CATRTN)) ; BASE OF PAT LIST FOR THIS CAT
|
||||||
; W "IENS BASE: ",CPATLIST,!
|
; W "IENS BASE: ",CPATLIST,!
|
||||||
S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
|
S @CPATLIST@(CDFN)="" ; ADD THIS PATIENT TO THE CAT PAT LIST
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
|
REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
|
||||||
;
|
;
|
||||||
D ASETUP
|
D ASETUP
|
||||||
|
@ -182,7 +175,7 @@ REUSE ; GET SAVED VALUES FROM ^TMP("C0CSAV") AND PUT THEM IN A DATABASE
|
||||||
N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
|
N SNOI,SNOJ,SNOK,SNOSNO,SNOSEC,SNOIEN,SNOOLD,SNOSRCH
|
||||||
S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
|
S SAVBASE=$NA(^TMP("C0CSAV","VARS"))
|
||||||
S SNOI=""
|
S SNOI=""
|
||||||
F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
|
F D Q:$O(@SAVBASE@(SNOI))="" ;THE WHOLE LIST
|
||||||
. S SNOI=$O(@SAVBASE@(SNOI))
|
. S SNOI=$O(@SAVBASE@(SNOI))
|
||||||
. S SNOJ=@SAVBASE@(SNOI)
|
. S SNOJ=@SAVBASE@(SNOI)
|
||||||
. S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
|
. S SNOK=$P($P(SNOJ,"^",1)," ALLERGY",1)
|
||||||
|
|
26
p/C0CSOAP.m
26
p/C0CSOAP.m
|
@ -1,21 +1,19 @@
|
||||||
C0CSOAP ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
|
C0CSOAP ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2008 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is an SOAP utility library",!
|
W "This is an SOAP utility library",!
|
||||||
W !
|
W !
|
||||||
|
|
16
p/C0CSQMB.m
16
p/C0CSQMB.m
|
@ -1,5 +1,19 @@
|
||||||
C0CSQMB ; SQMCCR/ELN - BATCH PROGRAM ;16/11/2010
|
C0CSQMB ; SQMCCR/ELN - BATCH PROGRAM ;16/11/2010
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
; (C) 2010 ELN
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
EN ;Traverse the DPT global and export CCR xml for each DFN
|
EN ;Traverse the DPT global and export CCR xml for each DFN
|
||||||
;and write to directory set in ^TMP("C0CCCR","ODIR")=
|
;and write to directory set in ^TMP("C0CCCR","ODIR")=
|
||||||
|
|
37
p/C0CSUB1.m
37
p/C0CSUB1.m
|
@ -1,21 +1,19 @@
|
||||||
C0CSUB1 ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
|
C0CSUB1 ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is the CCR SUBSCRIPTIONN Utility Library ",!
|
W "This is the CCR SUBSCRIPTIONN Utility Library ",!
|
||||||
Q
|
Q
|
||||||
|
@ -28,14 +26,14 @@ CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
|
||||||
S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
|
S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
|
||||||
S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
|
S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
|
||||||
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
|
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
|
S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
|
||||||
I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
|
I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
|
||||||
E Q ; NO CHECKSUMS FOR THISPATIENT
|
E Q ; NO CHECKSUMS FOR THISPATIENT
|
||||||
D UPDIE
|
D UPDIE
|
||||||
N C0CJ S C0CJ=""
|
N C0CJ S C0CJ=""
|
||||||
F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN
|
F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN
|
||||||
. S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
|
. S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
|
||||||
. W C0CJ," ",C0CD,!
|
. W C0CJ," ",C0CD,!
|
||||||
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
|
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
|
||||||
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
|
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
|
||||||
|
@ -69,10 +67,7 @@ UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||||
K ZERR
|
K ZERR
|
||||||
D CLEAN^DILF
|
D CLEAN^DILF
|
||||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||||
I $D(ZERR) D ;
|
I $D(ZERR) S $EC=",U1,"
|
||||||
. W "ERROR",!
|
|
||||||
. ZWR ZERR
|
|
||||||
. B
|
|
||||||
K C0CFDA
|
K C0CFDA
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
26
p/C0CSYS.m
26
p/C0CSYS.m
|
@ -1,21 +1,19 @@
|
||||||
C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
|
C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
; Copyright 2008 WorldVistA.
|
||||||
; General Public License See attached copy of the License.
|
;
|
||||||
;
|
; This program is free software: you can redistribute it and/or modify
|
||||||
; This program is free software; you can redistribute it and/or modify
|
; it under the terms of the GNU Affero General Public License as
|
||||||
; it under the terms of the GNU General Public License as published by
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
; the Free Software Foundation; either version 2 of the License, or
|
; License, or (at your option) any later version.
|
||||||
; (at your option) any later version.
|
;
|
||||||
;
|
|
||||||
; This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
; GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
; You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
; with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "Enter at appropriate points." Q
|
W "Enter at appropriate points." Q
|
||||||
;
|
;
|
||||||
|
|
15
p/C0CTIU.m
15
p/C0CTIU.m
|
@ -1,6 +1,19 @@
|
||||||
C0CTIU ; C0C/ELN - PROCESSING FOR TIU NOTES ; 19/10/2010
|
C0CTIU ; C0C/ELN - PROCESSING FOR TIU NOTES ; 19/10/2010
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
; (C) ELN 2010
|
||||||
;
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;ELN - Modified Routine of C0CLABS
|
;ELN - Modified Routine of C0CLABS
|
||||||
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
MAP(MIXML,DFN,MOXML) ;TO MAKE THIS COMPATIBLE WITH OLD CALLING FOR EXTRACT
|
||||||
|
|
17
p/C0CTIU1.m
17
p/C0CTIU1.m
|
@ -1,6 +1,21 @@
|
||||||
C0CTIU1 ; C0C/ELN - PROCESSING FOR TIU NOTES Contd. ; 19/10/2010
|
C0CTIU1 ; C0C/ELN - PROCESSING FOR TIU NOTES Contd. ; 19/10/2010
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;ELN UTILITY PROGRAM TO SUPPORT C0CTIU
|
;ELN UTILITY PROGRAM TO SUPPORT C0CTIU
|
||||||
|
; (C) ELN 2010.
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
C0CDATE(EDTE) ; Converts external date to internal date format
|
C0CDATE(EDTE) ; Converts external date to internal date format
|
||||||
; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
|
; INPUT : EXTERNAL DATE (TIME IS OPTIONAL)
|
||||||
; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
|
; OUTOUT: INTERNAL DATE, STORAGE FORMAT YYYMMMDD
|
||||||
|
|
290
p/C0CUNIT.m
290
p/C0CUNIT.m
|
@ -1,160 +1,158 @@
|
||||||
C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
|
C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2008 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
;
|
||||||
|
W "This is a unit testing library",!
|
||||||
|
W !
|
||||||
|
Q
|
||||||
;
|
;
|
||||||
W "This is a unit testing library",!
|
|
||||||
W !
|
|
||||||
Q
|
|
||||||
;
|
|
||||||
ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
|
ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
|
||||||
; ZARY IS PASSED BY REFERENCE
|
; ZARY IS PASSED BY REFERENCE
|
||||||
; BAT is a string identifying the test battery
|
; BAT is a string identifying the test battery
|
||||||
; TST is a test which will evaluate to true or false
|
; TST is a test which will evaluate to true or false
|
||||||
; I '$G(ZARY) D
|
; I '$G(ZARY) D
|
||||||
; . S ZARY(0)=0 ; initially there are no elements
|
; . S ZARY(0)=0 ; initially there are no elements
|
||||||
; W "GOT HERE LOADING "_TST,!
|
; W "GOT HERE LOADING "_TST,!
|
||||||
N CNT ; count of array elements
|
N CNT ; count of array elements
|
||||||
S CNT=ZARY(0) ; contains array count
|
S CNT=ZARY(0) ; contains array count
|
||||||
S CNT=CNT+1 ; increment count
|
S CNT=CNT+1 ; increment count
|
||||||
S ZARY(CNT)=TST ; put the test in the array
|
S ZARY(CNT)=TST ; put the test in the array
|
||||||
I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
|
I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
|
||||||
. N II,TN ; TEMP FOR ENDING TEST IN BATTERY
|
. N II,TN ; TEMP FOR ENDING TEST IN BATTERY
|
||||||
. S II=$P(ZARY(BAT),"^",2)
|
. S II=$P(ZARY(BAT),"^",2)
|
||||||
. S $P(ZARY(BAT),"^",2)=II+1
|
. S $P(ZARY(BAT),"^",2)=II+1
|
||||||
I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
|
I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
|
||||||
. S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
|
. S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
|
||||||
. S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
|
. S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
|
||||||
. ; S TN=$NA(ZARY("TESTS"))
|
. ; S TN=$NA(ZARY("TESTS"))
|
||||||
. ; D PUSH^C0CXPATH(TN,BAT)
|
. ; D PUSH^C0CXPATH(TN,BAT)
|
||||||
S ZARY(0)=CNT ; update the array counter
|
S ZARY(0)=CNT ; update the array counter
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
||||||
; ZARY IS PASSED BY NAME
|
; ZARY IS PASSED BY NAME
|
||||||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||||||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||||||
K @ZARY
|
K @ZARY
|
||||||
S @ZARY@(0)=0 ; initialize array count
|
S @ZARY@(0)=0 ; initialize array count
|
||||||
N LINE,LABEL,BODY
|
N LINE,LABEL,BODY
|
||||||
N INTEST S INTEST=0 ; switch for in the test case section
|
N INTEST S INTEST=0 ; switch for in the test case section
|
||||||
N SECTION S SECTION="[anonymous]" ; test case section
|
N SECTION S SECTION="[anonymous]" ; test case section
|
||||||
;
|
;
|
||||||
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
|
N NUM F NUM=1:1 S LINE=$T(+NUM^@ROUTINE) Q:LINE="" D
|
||||||
. I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
|
. I LINE?." "1";;><TEST>".E S INTEST=1 ; entering test section
|
||||||
. I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
|
. I LINE?." "1";;><TEMPLATE>".E S INTEST=1 ; entering TEMPLATE section
|
||||||
. I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
|
. I LINE?." "1";;></TEST>".E S INTEST=0 ; leaving test section
|
||||||
. I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
|
. I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
|
||||||
. I INTEST D ; within the testing section
|
. I INTEST D ; within the testing section
|
||||||
. . I LINE?." "1";;><".E D ; section name found
|
. . I LINE?." "1";;><".E D ; section name found
|
||||||
. . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
|
. . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
|
||||||
. . I LINE?." "1";;>>".E D ; test case found
|
. . I LINE?." "1";;>>".E D ; test case found
|
||||||
. . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
|
. . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
|
||||||
S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
|
S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST
|
ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST
|
||||||
N ZI,ZX,ZR,ZP
|
N ZI,ZX,ZR,ZP
|
||||||
S DEBUG=0
|
S DEBUG=0
|
||||||
; I WHICH="ALL" D Q ; RUN ALL THE TESTS
|
; I WHICH="ALL" D Q ; RUN ALL THE TESTS
|
||||||
; . W "DOING ALL",!
|
; . W "DOING ALL",!
|
||||||
; . N J,NT
|
; . N J,NT
|
||||||
; . S NT=$NA(ZARY("TESTS"))
|
; . S NT=$NA(ZARY("TESTS"))
|
||||||
; . W NT,@NT@(0),!
|
; . W NT,@NT@(0),!
|
||||||
; . F J=1:1:@NT@(0) D ;
|
; . F J=1:1:@NT@(0) D ;
|
||||||
; . . W @NT@(J),!
|
; . . W @NT@(J),!
|
||||||
; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
|
; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
|
||||||
I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST
|
I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST
|
||||||
. W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
|
. W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
|
||||||
N FIRST,LAST
|
N FIRST,LAST
|
||||||
S FIRST=$P(ZARY(WHICH),"^",1)
|
S FIRST=$P(ZARY(WHICH),"^",1)
|
||||||
S LAST=$P(ZARY(WHICH),"^",2)
|
S LAST=$P(ZARY(WHICH),"^",2)
|
||||||
F ZI=FIRST:1:LAST D
|
F ZI=FIRST:1:LAST D
|
||||||
. I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
|
. I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
|
||||||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||||||
. . ; W ZP,!
|
. . ; W ZP,!
|
||||||
. . S ZX=ZP
|
. . S ZX=ZP
|
||||||
. . W "RUNNING: "_ZP
|
. . W "RUNNING: "_ZP
|
||||||
. . X ZX
|
. . X ZX
|
||||||
. . W "..SUCCESS: ",WHICH,!
|
. . W "..SUCCESS: ",WHICH,!
|
||||||
. I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST
|
. I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST
|
||||||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||||||
. . S ZX="S ZR="_ZP
|
. . S ZX="S ZR="_ZP
|
||||||
. . W "TRYING: "_ZP
|
. . W "TRYING: "_ZP
|
||||||
. . X ZX
|
. . X ZX
|
||||||
. . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
|
. . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
|
||||||
. . I '$D(TPASSED) D ; NOT INITIALIZED YET
|
. . I '$D(TPASSED) D ; NOT INITIALIZED YET
|
||||||
. . . S TPASSED=0 S TFAILED=0
|
. . . S TPASSED=0 S TFAILED=0
|
||||||
. . I ZR S TPASSED=TPASSED+1
|
. . I ZR S TPASSED=TPASSED+1
|
||||||
. . I 'ZR S TFAILED=TFAILED+1
|
. . I 'ZR S TFAILED=TFAILED+1
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TEST ; RUN ALL THE TEST CASES
|
TEST ; RUN ALL THE TEST CASES
|
||||||
N ZTMP
|
N ZTMP
|
||||||
D ZLOAD(.ZTMP)
|
D ZLOAD(.ZTMP)
|
||||||
D ZTEST(.ZTMP,"ALL")
|
D ZTEST(.ZTMP,"ALL")
|
||||||
W "PASSED: ",TPASSED,!
|
W "PASSED: ",TPASSED,!
|
||||||
W "FAILED: ",TFAILED,!
|
W "FAILED: ",TFAILED,!
|
||||||
W !
|
W !
|
||||||
W "THE TESTS!",!
|
W "THE TESTS!",!
|
||||||
; I DEBUG ZWR ZTMP
|
; I DEBUG ZWR ZTMP
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
GTSTS(GTZARY,RTN) ; return an array of test names
|
GTSTS(GTZARY,RTN) ; return an array of test names
|
||||||
N I,J S I="" S I=$O(GTZARY("TESTS",I))
|
N I,J S I="" S I=$O(GTZARY("TESTS",I))
|
||||||
F J=0:0 Q:I="" D
|
F J=0:0 Q:I="" D
|
||||||
. D PUSH^C0CXPATH(RTN,I)
|
. D PUSH^C0CXPATH(RTN,I)
|
||||||
. S I=$O(GTZARY("TESTS",I))
|
. S I=$O(GTZARY("TESTS",I))
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TESTALL(RNM) ; RUN ALL THE TESTS
|
TESTALL(RNM) ; RUN ALL THE TESTS
|
||||||
N ZI,J,TZTMP,TSTS,TOTP,TOTF
|
N ZI,J,TZTMP,TSTS,TOTP,TOTF
|
||||||
S TOTP=0 S TOTF=0
|
S TOTP=0 S TOTF=0
|
||||||
D ZLOAD^C0CUNIT("TZTMP",RNM)
|
D ZLOAD^C0CUNIT("TZTMP",RNM)
|
||||||
D GTSTS(.TZTMP,"TSTS")
|
D GTSTS(.TZTMP,"TSTS")
|
||||||
F ZI=1:1:TSTS(0) D ;
|
F ZI=1:1:TSTS(0) D ;
|
||||||
. S TPASSED=0 S TFAILED=0
|
. S TPASSED=0 S TFAILED=0
|
||||||
. D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
|
. D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
|
||||||
. S TOTP=TOTP+TPASSED
|
. S TOTP=TOTP+TPASSED
|
||||||
. S TOTF=TOTF+TFAILED
|
. S TOTF=TOTF+TFAILED
|
||||||
. S $P(TSTS(ZI),"^",2)=TPASSED
|
. S $P(TSTS(ZI),"^",2)=TPASSED
|
||||||
. S $P(TSTS(ZI),"^",3)=TFAILED
|
. S $P(TSTS(ZI),"^",3)=TFAILED
|
||||||
F ZI=1:1:TSTS(0) D ;
|
F ZI=1:1:TSTS(0) D ;
|
||||||
. W "TEST=> ",$P(TSTS(ZI),"^",1)
|
. W "TEST=> ",$P(TSTS(ZI),"^",1)
|
||||||
. W " PASSED=>",$P(TSTS(ZI),"^",2)
|
. W " PASSED=>",$P(TSTS(ZI),"^",2)
|
||||||
. W " FAILED=>",$P(TSTS(ZI),"^",3),!
|
. W " FAILED=>",$P(TSTS(ZI),"^",3),!
|
||||||
W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
|
W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TLIST(ZARY) ; LIST ALL THE TESTS
|
TLIST(ZARY) ; LIST ALL THE TESTS
|
||||||
; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
|
; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
|
||||||
; ZARY IS PASSED BY REFERENCE
|
; ZARY IS PASSED BY REFERENCE
|
||||||
N I,J,K S I="" S I=$O(ZARY("TESTS",I))
|
N I,J,K S I="" S I=$O(ZARY("TESTS",I))
|
||||||
S K=1
|
S K=1
|
||||||
F J=0:0 Q:I="" D
|
F J=0:0 Q:I="" D
|
||||||
. ; W "I IS NOW=",I,!
|
. ; W "I IS NOW=",I,!
|
||||||
. W I," "
|
. W I," "
|
||||||
. S I=$O(ZARY("TESTS",I))
|
. S I=$O(ZARY("TESTS",I))
|
||||||
. S K=K+1 I K=6 D
|
. S K=K+1 I K=6 D
|
||||||
. . W !
|
. . W !
|
||||||
. . S K=1
|
. . S K=1
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
MEDS
|
MEDS ;
|
||||||
N DEBUG S DEBUG=0
|
N DEBUG S DEBUG=0
|
||||||
N DFN S DFN=5685
|
N DFN S DFN=5685
|
||||||
K ^TMP($J)
|
K ^TMP($J)
|
||||||
|
@ -171,7 +169,7 @@ MEDS
|
||||||
D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
|
D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
|
||||||
D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
|
D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
|
||||||
Q
|
Q
|
||||||
PAT
|
PAT ;
|
||||||
D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
|
D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
|
||||||
N X,Y
|
N X,Y
|
||||||
; Select Patient
|
; Select Patient
|
||||||
|
|
36
p/C0CUTIL.m
36
p/C0CUTIL.m
|
@ -1,31 +1,28 @@
|
||||||
C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
|
C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008-2009 Sam Habiel & George Lilly.
|
;Copyright 2008-2009 Sam Habiel & George Lilly.
|
||||||
;Licensed under the terms of the GNU
|
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "No Entry at Top!"
|
W "No Entry at Top!"
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
UUID() ; thanks to Wally for this.
|
UUID() ; thanks to Wally for this.
|
||||||
N R,I,J,N
|
N R,I,J,N
|
||||||
S N="",R="" F S N=N_$R(100000) Q:$L(N)>64
|
S N="",R="" F S N=N_$R(100000) Q:$L(N)>64
|
||||||
F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))
|
F I=1:2:64 S R=R_$E("0123456789abcdef",($E(N,I,I+1)#16+1))
|
||||||
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)
|
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)
|
||||||
;
|
;
|
||||||
OLDUUID() ; GENERATE A RANDOM UUID (Version 4)
|
OLDUUID() ; GENERATE A RANDOM UUID (Version 4)
|
||||||
N I,J,ZS
|
N I,J,ZS
|
||||||
|
@ -39,7 +36,7 @@ FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrins
|
||||||
; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
|
; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
|
||||||
; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
|
; UTC date is formatted as follows: YYYY-MM-DDThh:mm:ss_offsetfromUTC
|
||||||
; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
|
; UTC, Year, Month, Day, Hours, Minutes, Seconds, Time offset (obtained from Mailman Site Parameters)
|
||||||
N UTC,Y,M,D,H,MM,S,OFF
|
N UTC,Y,M,D,H,MM,S,OFF,OFFS,OFF0,OFF1,OFF2
|
||||||
S Y=1700+$E(DATE,1,3)
|
S Y=1700+$E(DATE,1,3)
|
||||||
S M=$E(DATE,4,5)
|
S M=$E(DATE,4,5)
|
||||||
S D=$E(DATE,6,7)
|
S D=$E(DATE,6,7)
|
||||||
|
@ -172,4 +169,3 @@ WV() ; Are we running on WorldVista?
|
||||||
Q $G(DUZ("AG"))="E" ; Code for WV.
|
Q $G(DUZ("AG"))="E" ; Code for WV.
|
||||||
OV() ; Are we running on OpenVista?
|
OV() ; Are we running on OpenVista?
|
||||||
Q $G(DUZ("AG"))="O" ; Code for OpenVista
|
Q $G(DUZ("AG"))="O" ; Code for OpenVista
|
||||||
|
|
||||||
|
|
27
p/C0CVA200.m
27
p/C0CVA200.m
|
@ -1,21 +1,20 @@
|
||||||
C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
|
C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 Sam Habiel. Licensed under the terms of the GNU
|
;Copyright 2008 Sam Habiel.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
Q
|
Q
|
||||||
; This routine uses Kernel APIs and Direct Global Access to get
|
; This routine uses Kernel APIs and Direct Global Access to get
|
||||||
; Proivder Data from File 200.
|
; Proivder Data from File 200.
|
||||||
|
|
17
p/C0CVALID.m
17
p/C0CVALID.m
|
@ -1,5 +1,20 @@
|
||||||
C0CVALID ; C0C/OHUM/RUT - PROCESSING FOR DATE LIMITS, NOTES ; 22/12/2011
|
C0CVALID ; C0C/OHUM/RUT - PROCESSING FOR DATE LIMITS, NOTES ; 22/12/2011
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47;Build 2
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50;Build 2
|
||||||
|
; (C) RUT 2011.
|
||||||
|
;
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")=""
|
S ^TMP("C0CCCR","LABLIMIT")="",^TMP("C0CCCR","VITLIMIT")="",^TMP("C0CCCR","MEDLIMIT")="",^TMP("C0CCCR","TIULIMIT")=""
|
||||||
S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y
|
S %DT="AEX",%DT("A")="LAB Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","LABLIMIT")=Y
|
||||||
S %DT="AEX",%DT("A")="VITAL Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","VITLIMIT")=Y
|
S %DT="AEX",%DT("A")="VITAL Report From: ",%DT("B")="T-36500" D ^%DT S ^TMP("C0CCCR","VITLIMIT")=Y
|
||||||
|
|
59
p/C0CVIT2.m
59
p/C0CVIT2.m
|
@ -1,22 +1,19 @@
|
||||||
C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota and others.
|
;Copyright 2008,2009 George Lilly, University of Minnesota and others.
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -65,7 +62,7 @@ GETVISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVI TO GET VITAL SIGNS.
|
||||||
D VITALS^ORQQVI(.VIT,DFN,START,END) ; RUN QUERY VITALS CALL
|
D VITALS^ORQQVI(.VIT,DFN,START,END) ; RUN QUERY VITALS CALL
|
||||||
I '$D(VIT) S @VITOUT@(0)=0 K VIT Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT
|
I '$D(VIT) S @VITOUT@(0)=0 K VIT Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT
|
||||||
I $P(VIT(1),U,2)="No vitals found." D Q ; signal no vitals and quit
|
I $P(VIT(1),U,2)="No vitals found." D Q ; signal no vitals and quit
|
||||||
. I $D(VITOUT) S @VITOUT@(0)=0
|
. I $D(VITOUT) S @VITOUT@(0)=0
|
||||||
. K VIT
|
. K VIT
|
||||||
;
|
;
|
||||||
; PREFORM SORT HERE IF NEEDED
|
; PREFORM SORT HERE IF NEEDED
|
||||||
|
@ -167,7 +164,7 @@ GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS.
|
||||||
M @ZRIM=@C0CVIT@("V")
|
M @ZRIM=@C0CVIT@("V")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
HEIGHT
|
HEIGHT ;
|
||||||
I DEBUG W "IN VITAL: HEIGHT",!
|
I DEBUG W "IN VITAL: HEIGHT",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -184,7 +181,7 @@ HEIGHT
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
WEIGHT
|
WEIGHT ;
|
||||||
I DEBUG W "IN VITAL: WEIGHT",!
|
I DEBUG W "IN VITAL: WEIGHT",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -201,7 +198,7 @@ WEIGHT
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
BP
|
BP ;
|
||||||
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -218,7 +215,7 @@ BP
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TMP
|
TMP ;
|
||||||
I DEBUG W "IN VITAL: TEMPERATURE",!
|
I DEBUG W "IN VITAL: TEMPERATURE",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -235,7 +232,7 @@ TMP
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
RESP
|
RESP ;
|
||||||
I DEBUG W "IN VITAL: RESPIRATION",!
|
I DEBUG W "IN VITAL: RESPIRATION",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -252,7 +249,7 @@ RESP
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PULSE
|
PULSE ;
|
||||||
I DEBUG W "IN VITAL: PULSE",!
|
I DEBUG W "IN VITAL: PULSE",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -269,7 +266,7 @@ PULSE
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PAIN
|
PAIN ;
|
||||||
I DEBUG W "IN VITAL: PAIN",!
|
I DEBUG W "IN VITAL: PAIN",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -286,7 +283,7 @@ PAIN
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
OTHER
|
OTHER ;
|
||||||
I DEBUG W "IN VITAL: OTHER",!
|
I DEBUG W "IN VITAL: OTHER",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -304,7 +301,7 @@ OTHER
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
|
;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
|
||||||
HEIGHT1(DT,ACTOR,VALUE,UNIT)
|
HEIGHT1(DT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: HEIGHT",!
|
I DEBUG W "IN VITAL: HEIGHT",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -321,7 +318,7 @@ HEIGHT1(DT,ACTOR,VALUE,UNIT)
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
WEIGHT1(DT,ACTOR,VALUE,UNIT)
|
WEIGHT1(DT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: WEIGHT",!
|
I DEBUG W "IN VITAL: WEIGHT",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -338,7 +335,7 @@ WEIGHT1(DT,ACTOR,VALUE,UNIT)
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
BP1(DT,ACTOR,VALUE,UNIT)
|
BP1(DT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -355,7 +352,7 @@ BP1(DT,ACTOR,VALUE,UNIT)
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
TMP1(DT,ACTOR,VALUE,UNIT)
|
TMP1(DT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: TEMPERATURE",!
|
I DEBUG W "IN VITAL: TEMPERATURE",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -372,7 +369,7 @@ TMP1(DT,ACTOR,VALUE,UNIT)
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
RESP1(DT,ACTOR,VALUE,UNIT)
|
RESP1(DT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: RESPIRATION",!
|
I DEBUG W "IN VITAL: RESPIRATION",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -389,7 +386,7 @@ RESP1(DT,ACTOR,VALUE,UNIT)
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PULSE1(DT,ACTOR,VALUE,UNIT)
|
PULSE1(DT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: PULSE",!
|
I DEBUG W "IN VITAL: PULSE",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -406,7 +403,7 @@ PULSE1(DT,ACTOR,VALUE,UNIT)
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
PAIN1(DT,ACTOR,VALUE,UNIT)
|
PAIN1(DT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: PAIN",!
|
I DEBUG W "IN VITAL: PAIN",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
@ -423,7 +420,7 @@ PAIN1(DT,ACTOR,VALUE,UNIT)
|
||||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)
|
OTHER1(DT,TEXT,ACTOR,VALUE,UNIT) ;
|
||||||
I DEBUG W "IN VITAL: OTHER",!
|
I DEBUG W "IN VITAL: OTHER",!
|
||||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||||
|
|
36
p/C0CVITAL.m
36
p/C0CVITAL.m
|
@ -1,22 +1,18 @@
|
||||||
C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
C0CVITAL ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008,2009 George Lilly, University of Minnesota and others.
|
|
||||||
;Licensed under the terms of the GNU General Public License.
|
|
||||||
;See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "NO ENTRY FROM TOP",!
|
W "NO ENTRY FROM TOP",!
|
||||||
Q
|
Q
|
||||||
|
@ -56,8 +52,8 @@ VITVISTA ; EXTRACT VITALS FROM VISTA INTO PROVIDED XML TEMPLATE
|
||||||
S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
|
S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
|
||||||
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
|
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
|
||||||
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
||||||
D VITDVISTA(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
D SORTVIST(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
||||||
I DEBUG ZWR VDATES ;DEBUG
|
; I DEBUG ZWR VDATES ;DEBUG
|
||||||
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
||||||
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
|
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
|
||||||
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
|
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
|
||||||
|
@ -238,7 +234,7 @@ VITRPMS ; EXTRACT VITALS FROM RPMS INTO PROVIDED XML TEMPLATE
|
||||||
S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
|
S VITTARYTMP=$NA(^TMP("C0CCCR",$J,"VITALARYTMP"))
|
||||||
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
|
K @VITTVMAP,@VITTARYTMP ; KILL OLD ARRAY VALUES
|
||||||
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
||||||
D VITDRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
D SORTRPMS(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
||||||
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
||||||
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
|
; DATE ORDER AND COUNT THEM. VSORT CONTAINS INDIRECT INDEXES ONLY
|
||||||
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
|
S @VITTVMAP@(0)=VCNT ; SAVE NUMBER OF VITALS
|
||||||
|
@ -385,7 +381,7 @@ VITRPMS ; EXTRACT VITALS FROM RPMS INTO PROVIDED XML TEMPLATE
|
||||||
K ^TMP("CIAVMRPC",$J)
|
K ^TMP("CIAVMRPC",$J)
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
VITDRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS
|
SORTRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS
|
||||||
; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
|
; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
|
||||||
; OF DATES IN THE VITALS RESULTS
|
; OF DATES IN THE VITALS RESULTS
|
||||||
N VDTI,VDTJ,VTDCNT
|
N VDTI,VDTJ,VTDCNT
|
||||||
|
@ -398,7 +394,7 @@ VITDRPMS(VDT) ; RUN DATE SORTING ALGORITHM FOR RPMS
|
||||||
S VDT(0)=VTDCNT
|
S VDT(0)=VTDCNT
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
VITDVISTA(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA
|
SORTVIST(VDT) ; RUN DATE SORTING ALGORITHM FOR VISTA
|
||||||
; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
|
; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
|
||||||
; OF DATES IN THE VITALS RESULTS
|
; OF DATES IN THE VITALS RESULTS
|
||||||
N VDTI,VDTJ,VTDCNT
|
N VDTI,VDTJ,VTDCNT
|
||||||
|
|
16
p/C0CVOBX1.m
16
p/C0CVOBX1.m
|
@ -1,7 +1,21 @@
|
||||||
LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
|
LA7VOBX1 ;DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd; 04/21/09
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
; JMC - mods to check for IHS V LAB file
|
; JMC - mods to check for IHS V LAB file
|
||||||
;
|
;
|
||||||
|
; (C) 2009 John McCormack
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
;
|
||||||
CH ; Observation/Result segment for "CH" subscript results.
|
CH ; Observation/Result segment for "CH" subscript results.
|
||||||
; Called by LA7VOBX
|
; Called by LA7VOBX
|
||||||
;
|
;
|
||||||
|
|
16
p/C0CVORU.m
16
p/C0CVORU.m
|
@ -1,5 +1,19 @@
|
||||||
C0C7VORU ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009 ; 5/10/12 5:19pm
|
C0C7VORU ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009 ; 5/10/12 5:19pm
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
|
;
|
||||||
|
; (C) 2009 John McCormack
|
||||||
|
; This program is free software: you can redistribute it and/or modify
|
||||||
|
; it under the terms of the GNU Affero General Public License as
|
||||||
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
|
; License, or (at your option) any later version.
|
||||||
|
;
|
||||||
|
; This program is distributed in the hope that it will be useful,
|
||||||
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
; GNU Affero General Public License for more details.
|
||||||
|
;
|
||||||
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;
|
;
|
||||||
EN(LA) ; called from C0CVLAB
|
EN(LA) ; called from C0CVLAB
|
||||||
; variables
|
; variables
|
||||||
|
|
26
p/C0CXEWD.m
26
p/C0CXEWD.m
|
@ -1,21 +1,19 @@
|
||||||
C0CXEWD ; C0C/GPL - EWD based XPath utilities; 10/11/09
|
C0CXEWD ; C0C/GPL - EWD based XPath utilities; 10/11/09
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2009 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2009 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
|
32
p/C0CXPAT0.m
32
p/C0CXPAT0.m
|
@ -1,25 +1,23 @@
|
||||||
C0CXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
|
C0CXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2008 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
;
|
||||||
|
W "NO ENTRY",!
|
||||||
|
Q
|
||||||
;
|
;
|
||||||
W "NO ENTRY",!
|
|
||||||
Q
|
|
||||||
;
|
|
||||||
;;><TEST>
|
;;><TEST>
|
||||||
;;><INIT>
|
;;><INIT>
|
||||||
;;>>>K C0C S C0C=""
|
;;>>>K C0C S C0C=""
|
||||||
|
|
36
p/C0CXPATH.m
36
p/C0CXPATH.m
|
@ -1,21 +1,19 @@
|
||||||
C0CXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
|
C0CXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
|
||||||
;;1.2;C0C;;May 11, 2012;Build 47
|
;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
|
||||||
;Copyright 2008 George Lilly. Licensed under the terms of the GNU
|
;Copyright 2008 George Lilly.
|
||||||
;General Public License See attached copy of the License.
|
|
||||||
;
|
;
|
||||||
;This program is free software; you can redistribute it and/or modify
|
; This program is free software: you can redistribute it and/or modify
|
||||||
;it under the terms of the GNU General Public License as published by
|
; it under the terms of the GNU Affero General Public License as
|
||||||
;the Free Software Foundation; either version 2 of the License, or
|
; published by the Free Software Foundation, either version 3 of the
|
||||||
;(at your option) any later version.
|
; License, or (at your option) any later version.
|
||||||
;
|
;
|
||||||
;This program is distributed in the hope that it will be useful,
|
; This program is distributed in the hope that it will be useful,
|
||||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;GNU General Public License for more details.
|
; GNU Affero General Public License for more details.
|
||||||
;
|
;
|
||||||
;You should have received a copy of the GNU General Public License along
|
; You should have received a copy of the GNU Affero General Public License
|
||||||
;with this program; if not, write to the Free Software Foundation, Inc.,
|
; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
||||||
;
|
;
|
||||||
W "This is an XML XPATH utility library",!
|
W "This is an XML XPATH utility library",!
|
||||||
W !
|
W !
|
||||||
|
@ -134,7 +132,7 @@ XML2XPG(OUTXPG,INXML) ; CONVERT AN XML ARRAY, PASSED BY NAME TO AN XPG ARRAY
|
||||||
D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
|
D VDX2XPG(OUTXPG,"G1") ; CONVERTS THE VDX ARRAY TO XPG FORM
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
DO
|
DO ;
|
||||||
D XPG2XML("^GPL2B","^GPL2A")
|
D XPG2XML("^GPL2B","^GPL2A")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
@ -187,17 +185,17 @@ XPG2XML(OUTXML,INXPG) ;
|
||||||
. . S ZQ=1 ; QUIT NOW
|
. . S ZQ=1 ; QUIT NOW
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZXO(WHAT)
|
ZXO(WHAT) ;
|
||||||
D PUSH("GA",WHAT)
|
D PUSH("GA",WHAT)
|
||||||
D PUSH(OUTXML,"<"_WHAT_">")
|
D PUSH(OUTXML,"<"_WHAT_">")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZXC(WHAT)
|
ZXC(WHAT) ;
|
||||||
D POP("GA",.TMP)
|
D POP("GA",.TMP)
|
||||||
D PUSH(OUTXML,"</"_WHAT_">")
|
D PUSH(OUTXML,"</"_WHAT_">")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
ZXVAL(WHAT,VAL)
|
ZXVAL(WHAT,VAL) ;
|
||||||
D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
|
D PUSH(OUTXML,"<"_WHAT_">"_VAL_"</"_WHAT_">")
|
||||||
Q
|
Q
|
||||||
;
|
;
|
||||||
|
@ -234,7 +232,7 @@ INDEX(IZXML,VDX,NOINX,TEMPLATE,REDUX) ; parse XML in IZXML and produce
|
||||||
F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY
|
F I=1:1:LCNT D ; PROCESS THE ENTIRE ARRAY
|
||||||
. S LINE=@IZXML@(I)
|
. S LINE=@IZXML@(I)
|
||||||
. I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED
|
. I $D(TEMPLATE) D ;IF TEMPLATE IS REQUESTED
|
||||||
. . S @TEMPLATE@(I)=$$CLEAN(LINE)
|
. . S @TEMPLATE@(I)=$$CLEAN(LINE)
|
||||||
. ;W LINE,!
|
. ;W LINE,!
|
||||||
. S FOUND=0 ; INTIALIZED FOUND FLAG
|
. S FOUND=0 ; INTIALIZED FOUND FLAG
|
||||||
. I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
|
. I LINE?.E1"<!".E S FOUND=1 ; SKIP OVER COMMENTS
|
||||||
|
|
Loading…
Reference in New Issue