updates for MU Certification
This commit is contained in:
parent
ac1f7a441b
commit
07194d2d80
546
p/C0CACTOR.m
546
p/C0CACTOR.m
|
@ -1,273 +1,273 @@
|
|||
C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
; 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
; PROCESS THE ACTORS SECTION OF THE CCR
|
||||
;
|
||||
; ===Revision History===
|
||||
; 0.1 Initial Writing of Skeleton--GPL
|
||||
; 0.2 Patient Data Extraction--SMH
|
||||
; 0.3 Information System Info Extraction--SMH
|
||||
; 0.4 Patient data rouine refactored; adjustments here--SMH
|
||||
;
|
||||
EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
||||
; IPXML is the Input Actor Template into which we substitute values
|
||||
; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
||||
; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
|
||||
; ^TMP(7542,1,"ACTORS",0)=Count
|
||||
; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
||||
; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
||||
; AXML is the output arrary, to contain XML.
|
||||
;
|
||||
N I,J,AMAP,AOID,ATYP,AIEN
|
||||
D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
||||
D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
||||
I DEBUG W "PROCESSING ACTORS ",!
|
||||
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
||||
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
||||
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
||||
. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
||||
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
||||
. I AIEN="" D Q ; IEN CAN'T BE NULL
|
||||
. . W "WARING NUL ACTOR: ",ATYP,!
|
||||
. I ATYP="" Q ; NOT A VALID ACTOR
|
||||
. ;
|
||||
. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
||||
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
||||
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
||||
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="NOK" D ; NOK ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
||||
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
||||
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
||||
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. W "PROCESSING:",ATYP," ",AIEN,!
|
||||
. ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE
|
||||
. D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
||||
. K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
|
||||
;
|
||||
N ACTTMP
|
||||
D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W "ACTORS Missing list: ",!
|
||||
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
||||
Q
|
||||
;
|
||||
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
||||
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
||||
;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
|
||||
; CODE REUSABLE FROM ERX
|
||||
N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
|
||||
I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
|
||||
I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
|
||||
D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
|
||||
K @AMAP ; CLEAN UP BEHIND US
|
||||
Q
|
||||
;
|
||||
DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
|
||||
S @GPL@("ACTORADDRESSCITY")="ALTON"
|
||||
S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
|
||||
S @GPL@("ACTORADDRESSLINE2")=""
|
||||
S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
|
||||
S @GPL@("ACTORADDRESSSTATE")="KANSAS"
|
||||
S @GPL@("ACTORADDRESSTYPE")="Home"
|
||||
S @GPL@("ACTORADDRESSZIPCODE")=67623
|
||||
S @GPL@("ACTORCELLTEL")=""
|
||||
S @GPL@("ACTORCELLTELTEXT")=""
|
||||
S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
|
||||
S @GPL@("ACTOREMAIL")=""
|
||||
S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
|
||||
;S @GPL@("ACTORGENDER")="MALE"
|
||||
S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
|
||||
S @GPL@("ACTORIEN")=2
|
||||
S @GPL@("ACTORMIDDLENAME")="TWO"
|
||||
S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
|
||||
S @GPL@("ACTORRESTEL")="888-555-1212"
|
||||
S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
|
||||
S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
||||
S @GPL@("ACTORSSN")="769122557P"
|
||||
S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
|
||||
S @GPL@("ACTORSSNTEXT")="SSN"
|
||||
S @GPL@("ACTORSUFFIXNAME")=""
|
||||
S @GPL@("ACTORWORKTEL")="888-121-1212"
|
||||
S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
|
||||
Q
|
||||
;
|
||||
PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
|
||||
N ZX
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
|
||||
S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
|
||||
S @AMAP@("ACTORSSN")=""
|
||||
S @AMAP@("ACTORSSNTEXT")=""
|
||||
S @AMAP@("ACTORSSNSOURCEID")=""
|
||||
S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
|
||||
X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
|
||||
I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
|
||||
I $G(MRN)'="" D ; IF MRN IS PRESENT
|
||||
. S @AMAP@("ACTORSSN")=MRN
|
||||
. S @AMAP@("ACTORSSNTEXT")="MRN"
|
||||
. S @AMAP@("ACTORSSNSOURCEID")=AOID
|
||||
E D ; NO MRN, USE SSN
|
||||
. S ZX=$$SSN^C0CDPT(AIEN)
|
||||
. I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
||||
. . S @AMAP@("ACTORSSN")=ZX
|
||||
. . S @AMAP@("ACTORSSNTEXT")="SSN"
|
||||
. . S @AMAP@("ACTORSSNSOURCEID")=AOID
|
||||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORRESTEL")=""
|
||||
S @AMAP@("ACTORRESTELTEXT")=""
|
||||
S ZX=$$RESTEL^C0CDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORRESTEL")=ZX
|
||||
. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
||||
S @AMAP@("ACTORWORKTEL")=""
|
||||
S @AMAP@("ACTORWORKTELTEXT")=""
|
||||
S ZX=$$WORKTEL^C0CDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORWORKTEL")=ZX
|
||||
. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
||||
S @AMAP@("ACTORCELLTEL")=""
|
||||
S @AMAP@("ACTORCELLTELTEXT")=""
|
||||
S ZX=$$CELLTEL^C0CDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORCELLTEL")=ZX
|
||||
. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
||||
S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
||||
S @AMAP@("ACTORIEN")=AIEN
|
||||
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
Q
|
||||
;
|
||||
MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
|
||||
;
|
||||
; N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
|
||||
S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
|
||||
S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
|
||||
;
|
||||
; N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORDISPLAYNAME")=""
|
||||
S @AMAP@("ACTORRELATION")=""
|
||||
S @AMAP@("ACTORRELATIONSOURCEID")=""
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
|
||||
;
|
||||
N AMAP,ZIEN,ZSITE
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
|
||||
S ZIEN=$P(ZSITE,"^",1)
|
||||
S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
||||
S @AMAP@("ACTORADDRESSTYPE")="Office"
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
|
||||
S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
|
||||
S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
|
||||
S @AMAP@("ACTORTELEPHONE")=""
|
||||
S @AMAP@("ACTORTELEPHONETYPE")=""
|
||||
S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
|
||||
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
||||
. S @AMAP@("ACTORTELEPHONE")=ZX
|
||||
. S @AMAP@("ACTORTELEPHONETYPE")="Office"
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
K @AMAP
|
||||
Q
|
||||
;
|
||||
PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
|
||||
;
|
||||
; N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
|
||||
. W "WARNING - MISSING PROVIDER: ",AIEN,!
|
||||
. S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
|
||||
S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
|
||||
S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
|
||||
S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
|
||||
S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORTELEPHONE")=""
|
||||
S @AMAP@("ACTORTELEPHONETYPE")=""
|
||||
S ZX=$$TEL^C0CVA200(AIEN)
|
||||
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
||||
. S @AMAP@("ACTORTELEPHONE")=ZX
|
||||
. S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
; 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
; PROCESS THE ACTORS SECTION OF THE CCR
|
||||
;
|
||||
; ===Revision History===
|
||||
; 0.1 Initial Writing of Skeleton--GPL
|
||||
; 0.2 Patient Data Extraction--SMH
|
||||
; 0.3 Information System Info Extraction--SMH
|
||||
; 0.4 Patient data rouine refactored; adjustments here--SMH
|
||||
;
|
||||
EXTRACT(IPXML,ALST,AXML) ; EXTRACT ACTOR FROM ALST INTO PROVIDED XML TEMPLATE
|
||||
; IPXML is the Input Actor Template into which we substitute values
|
||||
; This is straight XML. Values to be substituted are in @@VAL@@ format.
|
||||
; ALST is the actor list global generated by ACTLST^C0CCCR and has format:
|
||||
; ^TMP(7542,1,"ACTORS",0)=Count
|
||||
; ^TMP(7542,1,"ACTORS",n)="ActorID^ActorType^ActorIEN"
|
||||
; ActorType is an enum containing either "PROVIDER" "PATIENT" "SYSTEM"
|
||||
; AXML is the output arrary, to contain XML.
|
||||
;
|
||||
N I,J,AMAP,AOID,ATYP,AIEN
|
||||
D CP^C0CXPATH(IPXML,AXML) ; MAKE A COPY OF ACTORS XML
|
||||
D REPLACE^C0CXPATH(AXML,"","//Actors") ; DELETE THE INSIDES
|
||||
I DEBUG W "PROCESSING ACTORS ",!
|
||||
F I=1:1:@ALST@(0) D ; PROCESS ALL ACTORS IN THE LIST
|
||||
. I @ALST@(I)["@@" Q ; NOT A VALID ACTOR
|
||||
. S AOID=$P(@ALST@(I),"^",1) ; ACTOR OBJECT ID
|
||||
. S ATYP=$P(@ALST@(I),"^",2) ; ACTOR TYPE
|
||||
. S AIEN=$P(@ALST@(I),"^",3) ; ACTOR RECORD NUMBER
|
||||
. I AIEN="" D Q ; IEN CAN'T BE NULL
|
||||
. . W "WARING NUL ACTOR: ",ATYP,!
|
||||
. I ATYP="" Q ; NOT A VALID ACTOR
|
||||
. ;
|
||||
. I DEBUG W AOID_" "_ATYP_" "_AIEN,!
|
||||
. I ATYP="PATIENT" D ; PATIENT ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PATIENT","ATMP")
|
||||
. . D PATIENT("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="SYSTEM" D ; SYSTEM ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-SYSTEM","ATMP")
|
||||
. . D SYSTEM("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="NOK" D ; NOK ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-NOK","ATMP")
|
||||
. . D NOK("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="PROVIDER" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-PROVIDER","ATMP")
|
||||
. . D PROVIDER("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. I ATYP="ORGANIZATION" D ; PROVIDER ACTOR TYPE
|
||||
. . D QUERY^C0CXPATH(IPXML,"//Actors/ACTOR-ORG","ATMP")
|
||||
. . D ORG("ATMP",AIEN,AOID,"ATMP2")
|
||||
. ;
|
||||
. W "PROCESSING:",ATYP," ",AIEN,!
|
||||
. ;I @ATMP2@(0)=0 Q ; NOTHING RETURNED, SKIP THIS ONE
|
||||
. D INSINNER^C0CXPATH(AXML,"ATMP2") ; INSERT INTO ROOT
|
||||
. K ATYP,AIEN,AOID,ATMP,ATMP2 ; BE SURE TO GET THE NEXT ONE
|
||||
;
|
||||
N ACTTMP
|
||||
D MISSING^C0CXPATH(AXML,"ACTTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I ACTTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W "ACTORS Missing list: ",!
|
||||
. F I=1:1:ACTTMP(0) W ACTTMP(I),!
|
||||
Q
|
||||
;
|
||||
PATIENT(INXML,AIEN,AOID,OUTXML) ; PROCESS A PATIENT ACTOR
|
||||
I DEBUG W "PROCESSING ACTOR PATIENT ",AIEN,!
|
||||
;GPL SEPARATED EXTRACT FROM MAP FOR PROCESSING PATIENTS - TO MAKE
|
||||
; CODE REUSABLE FROM ERX
|
||||
N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
D PEXTRACT(AMAP,AIEN,AOID) ;EXTRACT THE PATIENT ACTOR
|
||||
I $P($$SITE^VASITE(),U,2)="OROVILLE HOSPITAL" S C0CDE=1
|
||||
I $G(C0CDE)'="" D DEIDENT(AMAP,AIEN) ; DEIDENTIFY THE CCR
|
||||
D MAP(INXML,AMAP,OUTXML) ;MAP TO XML
|
||||
K @AMAP ; CLEAN UP BEHIND US
|
||||
Q
|
||||
;
|
||||
DEIDENT(GPL,ZDFN) ; QUICK WAY TO DEIDENTIFY THE CCR
|
||||
S @GPL@("ACTORADDRESSCITY")="ALTON"
|
||||
S @GPL@("ACTORADDRESSLINE1")="1234 Somewhere Lane"
|
||||
S @GPL@("ACTORADDRESSLINE2")=""
|
||||
S @GPL@("ACTORADDRESSSOURCEID")="ACTORPATIENT_"_ZDFN
|
||||
S @GPL@("ACTORADDRESSSTATE")="KANSAS"
|
||||
S @GPL@("ACTORADDRESSTYPE")="Home"
|
||||
S @GPL@("ACTORADDRESSZIPCODE")=67623
|
||||
S @GPL@("ACTORCELLTEL")=""
|
||||
S @GPL@("ACTORCELLTELTEXT")=""
|
||||
S @GPL@("ACTORDATEOFBIRTH")="1957-12-25"
|
||||
S @GPL@("ACTOREMAIL")=""
|
||||
S @GPL@("ACTORFAMILYNAME")="ZZ PATIENT"_ZDFN
|
||||
;S @GPL@("ACTORGENDER")="MALE"
|
||||
S @GPL@("ACTORGIVENNAME")="TEST"_ZDFN
|
||||
S @GPL@("ACTORIEN")=2
|
||||
S @GPL@("ACTORMIDDLENAME")="TWO"
|
||||
S @GPL@("ACTOROBJECTID")="ACTORPATIENT_"_ZDFN
|
||||
S @GPL@("ACTORRESTEL")="888-555-1212"
|
||||
S @GPL@("ACTORRESTELTEXT")="Residential Telephone"
|
||||
S @GPL@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
||||
S @GPL@("ACTORSSN")="769122557P"
|
||||
S @GPL@("ACTORSSNSOURCEID")="ACTORPATIENT_"_ZDFN
|
||||
S @GPL@("ACTORSSNTEXT")="SSN"
|
||||
S @GPL@("ACTORSUFFIXNAME")=""
|
||||
S @GPL@("ACTORWORKTEL")="888-121-1212"
|
||||
S @GPL@("ACTORWORKTELTEXT")="Work Telephone"
|
||||
Q
|
||||
;
|
||||
PEXTRACT(AMAP,AIEN,AOID) ; EXTRACT TO RETURN ARRAY RARY PASSED BY NAME
|
||||
N ZX
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORDATEOFBIRTH")=$$DOB^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORGENDER")=$P($$GENDER^C0CDPT(AIEN),U,2)
|
||||
S @AMAP@("ACTORGENDERCODE")=$P($$GENDER^C0CDPT(AIEN),U,1)
|
||||
S @AMAP@("ACTORSSN")=""
|
||||
S @AMAP@("ACTORSSNTEXT")=""
|
||||
S @AMAP@("ACTORSSNSOURCEID")=""
|
||||
S X="MSCDPTID" ; ROUTINE TO TEST FOR MRN ON OPENVISTA
|
||||
X ^%ZOSF("TEST") ; TEST TO SEE IF THE ROUTINE EXISTS
|
||||
I $T S MRN=$$^MSCDPTID(DFN) ;TEST FOR MRN ON OPENVISTA ;GPL
|
||||
I $G(MRN)'="" D ; IF MRN IS PRESENT
|
||||
. S @AMAP@("ACTORSSN")=MRN
|
||||
. S @AMAP@("ACTORSSNTEXT")="MRN"
|
||||
. S @AMAP@("ACTORSSNSOURCEID")=AOID
|
||||
E D ; NO MRN, USE SSN
|
||||
. S ZX=$$SSN^C0CDPT(AIEN)
|
||||
. I ZX'="" D ; IF THERE IS A SSN IN THE RECORD
|
||||
. . S @AMAP@("ACTORSSN")=ZX
|
||||
. . S @AMAP@("ACTORSSNTEXT")="SSN"
|
||||
. . S @AMAP@("ACTORSSNSOURCEID")=AOID
|
||||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDRTYPE^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDR1^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE2")=$$ADDR2^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSZIPCODE")=$$ZIP^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORRESTEL")=""
|
||||
S @AMAP@("ACTORRESTELTEXT")=""
|
||||
S ZX=$$RESTEL^C0CDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORRESTEL")=ZX
|
||||
. S @AMAP@("ACTORRESTELTEXT")="Residential Telephone"
|
||||
S @AMAP@("ACTORWORKTEL")=""
|
||||
S @AMAP@("ACTORWORKTELTEXT")=""
|
||||
S ZX=$$WORKTEL^C0CDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A RESIDENT PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORWORKTEL")=ZX
|
||||
. S @AMAP@("ACTORWORKTELTEXT")="Work Telephone"
|
||||
S @AMAP@("ACTORCELLTEL")=""
|
||||
S @AMAP@("ACTORCELLTELTEXT")=""
|
||||
S ZX=$$CELLTEL^C0CDPT(AIEN)
|
||||
I ZX'="" D ; IF THERE IS A CELL PHONE IN THE RECORD
|
||||
. S @AMAP@("ACTORCELLTEL")=ZX
|
||||
. S @AMAP@("ACTORCELLTELTEXT")="Cell Phone"
|
||||
S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CDPT(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSOURCEID")=AOID
|
||||
S @AMAP@("ACTORIEN")=AIEN
|
||||
S @AMAP@("ACTORSUFFIXNAME")="" ; DOES VISTA STORE THE SUFFIX
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
Q
|
||||
;
|
||||
MAP(INXML,AMAP,OUTXML) ;MAP ANY ACTOR TO XML
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
SYSTEM(INXML,AIEN,AOID,OUTXML) ; PROCESS A SYSTEM ACTOR
|
||||
;
|
||||
; N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORINFOSYSNAME")=$$SYSNAME^C0CSYS
|
||||
S @AMAP@("ACTORINFOSYSVER")=$$SYSVER^C0CSYS
|
||||
S @AMAP@("ACTORINFOSYSSOURCEID")=AOID
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
NOK(INXML,AIEN,AOID,OUTXML) ; PROCESS A NEXT OF KIN TYPE ACTOR
|
||||
;
|
||||
; N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORDISPLAYNAME")=""
|
||||
S @AMAP@("ACTORRELATION")=""
|
||||
S @AMAP@("ACTORRELATIONSOURCEID")=""
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
ORG(INXML,AIEN,AOID,OUTXML) ; PROCESS AN ORGANIZATION TYPE ACTOR
|
||||
;
|
||||
N AMAP,ZIEN,ZSITE
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S ZSITE=$$SITE^VASITE ; SITE FORMAT IEN^NAME^DATE
|
||||
S ZIEN=$P(ZSITE,"^",1)
|
||||
S @AMAP@("ORGANIZATIONNAME")=$P(ZSITE,U,2)
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1"
|
||||
S @AMAP@("ACTORADDRESSTYPE")="Office"
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$GET1^DIQ(4,ZIEN_",",1.01)
|
||||
S @AMAP@("ACTORADDRESSLINE2")=$$GET1^DIQ(4,ZIEN_",",1.02)
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$GET1^DIQ(4,ZIEN_",",1.03)
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$GET1^DIQ(4,ZIEN_",",.02)
|
||||
S @AMAP@("ACTORPOSTALCODE")=$$GET1^DIQ(4,ZIEN_",",1.04)
|
||||
S @AMAP@("ACTORTELEPHONE")=""
|
||||
S @AMAP@("ACTORTELEPHONETYPE")=""
|
||||
S ZX=$$GET1^DIQ(4.03,"1,"_ZIEN_",",.03)
|
||||
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
||||
. S @AMAP@("ACTORTELEPHONE")=ZX
|
||||
. S @AMAP@("ACTORTELEPHONETYPE")="Office"
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
K @AMAP
|
||||
Q
|
||||
;
|
||||
PROVIDER(INXML,AIEN,AOID,OUTXML) ; PROCESS A PROVIDER TYPE ACTOR
|
||||
;
|
||||
; N AMAP
|
||||
S AMAP=$NA(^TMP($J,"AMAP"))
|
||||
K @AMAP
|
||||
I '$D(^VA(200,AIEN,0)) D Q ; IF NO PROVIDER RECORD (SHOULDN'T HAPPEN)
|
||||
. W "WARNING - MISSING PROVIDER: ",AIEN,!
|
||||
. S @OUTXML@(0)=0 ; SIGNAL NO OUTPUT
|
||||
S @AMAP@("ACTOROBJECTID")=AOID ;ACTOR OBJECT ID
|
||||
S @AMAP@("ACTORGIVENNAME")=$$GIVEN^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORMIDDLENAME")=$$MIDDLE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORFAMILYNAME")=$$FAMILY^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORTITLE")=$$TITLE^C0CVA200(AIEN)
|
||||
S @AMAP@("IDTYPE")=$P($$NPI^C0CVA200(AIEN),U,1)
|
||||
S @AMAP@("ID")=$P($$NPI^C0CVA200(AIEN),U,2)
|
||||
S @AMAP@("IDDESC")=$P($$NPI^C0CVA200(AIEN),U,3)
|
||||
S @AMAP@("ACTORSPECIALITY")=$$SPEC^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSTYPE")=$$ADDTYPE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSLINE1")=$$ADDLINE1^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSCITY")=$$CITY^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSTATE")=$$STATE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORPOSTALCODE")=$$POSTCODE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORTELEPHONE")=""
|
||||
S @AMAP@("ACTORTELEPHONETYPE")=""
|
||||
S ZX=$$TEL^C0CVA200(AIEN)
|
||||
I ZX'="" D ; THERE IS A PHONE NUMBER AVAILABLE
|
||||
. S @AMAP@("ACTORTELEPHONE")=ZX
|
||||
. S @AMAP@("ACTORTELEPHONETYPE")=$$TELTYPE^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTOREMAIL")=$$EMAIL^C0CVA200(AIEN)
|
||||
S @AMAP@("ACTORADDRESSSOURCEID")="ACTORSYSTEM_1"
|
||||
S @AMAP@("ACTORSOURCEID")="ACTORSYSTEM_1" ; THE SYSTEM IS THE SOURCE
|
||||
S @AMAP@("ACTORORGLINK")="ACTORORGANIZATION_1"
|
||||
D MAP^C0CXPATH(INXML,AMAP,OUTXML) ; MAP THE VARIABLE
|
||||
Q
|
||||
;
|
||||
|
|
255
p/C0CALERT.m
255
p/C0CALERT.m
|
@ -1,124 +1,131 @@
|
|||
C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE
|
||||
; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
|
||||
; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
; GET ADVERSE REACTIONS AND ALLERGIES
|
||||
; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
|
||||
S GMRA="0^0^111"
|
||||
D EN1^GMRADPT
|
||||
I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*
|
||||
. S @ALTOUTXML@(0)=0
|
||||
; DEFINE MAPPING
|
||||
N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
|
||||
S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
|
||||
S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
|
||||
K @ALTTVMAP,@ALTTARYTMP
|
||||
N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
|
||||
S ALTTMP="" ;
|
||||
F S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP="" D ; CHANGED TO $O BY GPL
|
||||
. W "ALTTMP="_ALTTMP,!
|
||||
. ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
|
||||
. S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
|
||||
. K @ALTVMAP
|
||||
. S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
|
||||
. N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
|
||||
. I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
|
||||
. N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
|
||||
. N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
|
||||
. N ADT S ADT="Patient has an " ; X $ZINT H 5
|
||||
. S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
|
||||
. S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
|
||||
. S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
|
||||
. N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
|
||||
. S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
|
||||
. N ALTCDE ; SNOMED CODE THE THE ALERT
|
||||
. S ALTCDE=$S(A2="P":"282100009",A2="A":"418634005",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
|
||||
. S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
|
||||
. ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
|
||||
. ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE
|
||||
. I ALTCDE'="" D ; IF THERE IS A CODE
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
|
||||
. E D ; SET TO NULL
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEM")=""
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
|
||||
. S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
|
||||
. N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
|
||||
. I ALTPROV'="" D ; PROVIDER PROVIDEED
|
||||
. . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
|
||||
. E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
|
||||
. W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
|
||||
. N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
|
||||
. S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
|
||||
. S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
|
||||
. S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
|
||||
. S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
|
||||
. S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID
|
||||
. I ACVUID'="" D ; IF VUID IS NOT NULL
|
||||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID"
|
||||
. E D ; IF REACTANT CODE VALUE IS NULL
|
||||
. . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS
|
||||
. . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
|
||||
. . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
|
||||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
|
||||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
|
||||
. ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
|
||||
. N ARTMP,ARIEN,ARDES,ARVUID
|
||||
. S (ARTMP,ARDES,ARVUID)=""
|
||||
. I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS
|
||||
. . S ARTMP=@ALTG@(ALTTMP,"S",1)
|
||||
. . W "REACTION:",ARTMP,!
|
||||
. . S ARIEN=$P(ARTMP,";",2)
|
||||
. . S ARDES=$P(ARTMP,";",1)
|
||||
. . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
|
||||
. S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
|
||||
. I ARVUID'="" D ; IF REACTION VUID IS NOT NULL
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
|
||||
. E D ; IF IT IS NULL DON'T SET CODE SYSTEM
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
|
||||
. S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
|
||||
. ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
|
||||
. N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
|
||||
. D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
|
||||
. S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
|
||||
. S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
|
||||
. K @ALTARYTMP
|
||||
. D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
|
||||
. I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
|
||||
. I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
|
||||
. S ALTCNT=ALTCNT+1
|
||||
S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
|
||||
Q
|
||||
PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
|
||||
; INGLB IS OF THE FORM: PSNDF(50.6,
|
||||
; RETURN 50.6
|
||||
Q $P($P(INGLB,"(",2),",",1) ;
|
||||
C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE
|
||||
; CALLBACK IF PROVIDED IS CALLED FOR EACH ALLERGY BEFORE MAPPING
|
||||
; ALTXML AND ALTOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
; GET ADVERSE REACTIONS AND ALLERGIES
|
||||
; N GMRA,GMRAL ; FOR DEBUGGING, DON'T NEW THESE VARIABLES
|
||||
S GMRA="0^0^111"
|
||||
D EN1^GMRADPT
|
||||
I $G(GMRAL)'=1 D Q ; NO ALLERGIES FOUND THUS *QUIT*
|
||||
. S @ALTOUTXML@(0)=0
|
||||
; DEFINE MAPPING
|
||||
N ALTTVMAP,ALTVMAP,ALTTARYTMP,ALTARYTMP
|
||||
S ALTTVMAP=$NA(^TMP("C0CCCR",$J,"ALERTS"))
|
||||
S ALTTARYTMP=$NA(^TMP("C0CCCR",$J,"ALERTSARYTMP"))
|
||||
K @ALTTVMAP,@ALTTARYTMP
|
||||
N ALTTMP,ALTCNT S ALTG=$NA(GMRAL),ALTCNT=1
|
||||
S ALTTMP="" ;
|
||||
F S ALTTMP=$O(@ALTG@(ALTTMP)) Q:ALTTMP="" D ; CHANGED TO $O BY GPL
|
||||
. W "ALTTMP="_ALTTMP,!
|
||||
. ; I $QS(ALTTMP,2)="S" W !,"S FOUND",! Q
|
||||
. S ALTVMAP=$NA(@ALTTVMAP@(ALTCNT))
|
||||
. K @ALTVMAP
|
||||
. S @ALTVMAP@("ALERTOBJECTID")="ALERT"_ALTCNT
|
||||
. N A1 S A1=@ALTG@(ALTTMP) ; ALL THE PIECES
|
||||
. I $D(CALLBK) D @CALLBK ;CALLBACK FOR EPRESCRIBING
|
||||
. N A2 S A2=$$GET1^DIQ(120.8,ALTTMP,"MECHANISM","I") ; MECHANISM
|
||||
. N A3 S A3=$P(A1,U,5) ; ADVERSE FLAG
|
||||
. N ADT S ADT="Patient has an " ; X $ZINT H 5
|
||||
. S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
|
||||
. S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
|
||||
. S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT
|
||||
. N ADTY S ADTY=$S(A2="P":"Adverse Reaction",A2="A":"Allergy",1:"") ;
|
||||
. S @ALTVMAP@("ALERTTYPE")=ADTY ; type of allergy
|
||||
. N ALTCDE ; SNOMED CODE THE THE ALERT
|
||||
. S ALTCDE=$S(A2="P":"282100009",A2="A":"416098002",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
|
||||
. S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
|
||||
. ; WILL USE 418634005 FOR ALLERGIC REACTION TO A SUBSTANCE
|
||||
. ; AND 282100009 FOR ADVERSE REACTION TO A SUBSTANCE
|
||||
. I ALTCDE'="" D ; IF THERE IS A CODE
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEM")="SNOMED CT"
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")="2008"
|
||||
. E D ; SET TO NULL
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEM")=""
|
||||
. . S @ALTVMAP@("ALERTCODESYSTEMVERSION")=""
|
||||
. S @ALTVMAP@("ALERTSTATUSTEXT")="" ; WHERE DO WE GET THIS?
|
||||
. N ALTPROV S ALTPROV=$P(^GMR(120.8,ALTTMP,0),U,5) ; SOURCE PROVIDER IEN
|
||||
. I ALTPROV'="" D ; PROVIDER PROVIDEED
|
||||
. . S @ALTVMAP@("ALERTSOURCEID")="ACTORPROVIDER_"_ALTPROV
|
||||
. E S @ALTVMAP@("ALERTSOURCEID")="" ; SOURCE NULL - SHOULD NOT HAPPEN
|
||||
. W "RUNNING ALERTS, PROVIDER: ",@ALTVMAP@("ALERTSOURCEID"),!
|
||||
. N ACGL1,ACGFI,ACIEN,ACVUID,ACNM,ACTMP
|
||||
. S ACGL1=$P(@ALTG@(ALTTMP),U,9) ; ADDRESS OF THE REACTANT XX;GLB(YY.Z,
|
||||
. S ACGFI=$$PRSGLB($P(ACGL1,";",2)) ; FILE NUMBER
|
||||
. S ACIEN=$P(ACGL1,";",1) ; IEN OF REACTANT
|
||||
. S ACVUID=$$GET1^DIQ(ACGFI,ACIEN,"VUID") ; VUID OF THE REACTANT
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTOBJECTID")="PRODUCT_"_ACIEN ; IE OF REACTANT
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
|
||||
. S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
|
||||
. N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
|
||||
. I ACVUID'="" D ; IF VUID IS NOT NULL
|
||||
. . S ZC=$$CODE^C0CUTIL(ACVUID)
|
||||
. . S ZCD=$P(ZC,"^",1) ; CODE TO USE
|
||||
. . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
|
||||
. . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
|
||||
. E D ; IF REACTANT CODE VALUE IS NULL
|
||||
. . I $G(DUZ("AG"))="I" D ; IF WE ARE RUNNING ON RPMS
|
||||
. . . S ACTMP=$O(^C0CCODES(176.112,"C",ACNM,0)) ;
|
||||
. . . W "RPMS NAME FOUND",ACNM," ",ACTMP,!
|
||||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=""
|
||||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=""
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ZCD
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")=ZCDS
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM_" "_ZCDS_": "_ZCD
|
||||
. S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT_" "_ZCDS_": "_ZCD
|
||||
. ; REACTIONS - THIS SHOULD BE MULTIPLE, IS SINGLE NOW
|
||||
. N ARTMP,ARIEN,ARDES,ARVUID
|
||||
. S (ARTMP,ARDES,ARVUID)=""
|
||||
. I $D(@ALTG@(ALTTMP,"S",1)) D ; IF REACTION EXISTS
|
||||
. . S ARTMP=@ALTG@(ALTTMP,"S",1)
|
||||
. . W "REACTION:",ARTMP,!
|
||||
. . S ARIEN=$P(ARTMP,";",2)
|
||||
. . S ARDES=$P(ARTMP,";",1)
|
||||
. . S ARVUID=$$GET1^DIQ(120.83,ARIEN,"VUID")
|
||||
. S @ALTVMAP@("ALERTREACTIOINDESCRIPTIONTEXT")=ARDES
|
||||
. I ARVUID'="" D ; IF REACTION VUID IS NOT NULL
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=ARVUID
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="VUID"
|
||||
. E D ; IF IT IS NULL DON'T SET CODE SYSTEM
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
|
||||
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
|
||||
. S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT))
|
||||
. ; NOW GO TO THE GLOBAL TO GET THE DATE/TIME AND BETTER DESCRIPTION
|
||||
. N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
|
||||
. D GETN1^C0CRNF("C0CG1",120.8,ALTTMP,"") ;GET VALUES BY NAME
|
||||
. S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
|
||||
. S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CT,"DT")
|
||||
. K @ALTARYTMP
|
||||
. D MAP^C0CXPATH(ALTXML,ALTVMAP,ALTARYTMP)
|
||||
. I ALTCNT=1 D CP^C0CXPATH(ALTARYTMP,ALTOUTXML)
|
||||
. I ALTCNT>1 D INSINNER^C0CXPATH(ALTOUTXML,ALTARYTMP)
|
||||
. S ALTCNT=ALTCNT+1
|
||||
S @ALTTVMAP@(0)=ALTCNT-1 ; RECORD THE NUMBER OF ALERTS
|
||||
Q
|
||||
PRSGLB(INGLB) ; EXTRINSIC TO PARSE GLOBALS AND RETURN THE FILE NUMBER
|
||||
; INGLB IS OF THE FORM: PSNDF(50.6,
|
||||
; RETURN 50.6
|
||||
Q $P($P(INGLB,"(",2),",",1) ;
|
||||
|
|
444
p/C0CBAT.m
444
p/C0CBAT.m
|
@ -1,234 +1,234 @@
|
|||
C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR Batch Utility Library ",!
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR Batch Utility Library ",!
|
||||
Q
|
||||
;
|
||||
STOP ; STOP A CURRENTLY RUNNING BATCH JOB
|
||||
I '$D(^TMP("C0CBAT","RUNNING")) Q ;
|
||||
W !,!,"HALTING CCR BATCH",!
|
||||
S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE
|
||||
H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED
|
||||
I '$D(^TMP("C0CBAT","STOP")) D ; SIGNAL RECEIVED
|
||||
. W "CCR BATCH JOB TERMINATING",!
|
||||
E D ;
|
||||
. K ^TMP("C0CBAT","STOP") ; STOP SIGNALING
|
||||
. W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!
|
||||
Q
|
||||
;
|
||||
I '$D(^TMP("C0CBAT","RUNNING")) Q ;
|
||||
W !,!,"HALTING CCR BATCH",!
|
||||
S ^TMP("C0CBAT","STOP")="" ; SIGNAL JOB TO TERMINATE
|
||||
H 10 ; WAIT TEN SECONDS FOR SIGNAL TO BE RECEIVED
|
||||
I '$D(^TMP("C0CBAT","STOP")) D ; SIGNAL RECEIVED
|
||||
. W "CCR BATCH JOB TERMINATING",!
|
||||
E D ;
|
||||
. K ^TMP("C0CBAT","STOP") ; STOP SIGNALING
|
||||
. W !,"BATCH PROCESSING APPARENTLY NOT RUNNING",!
|
||||
Q
|
||||
;
|
||||
START ; STARTS A TAKSMAN CCR BATCH JOB - FOR USE IN A MENU OPTION
|
||||
;
|
||||
I $D(^TMP("C0CBAT","RUNNING")) D Q ; ONLY ONE ALLOWED AT A TIME
|
||||
. W !,"CCR BATCH ALREADY RUNNING",!
|
||||
. W !,"STOP FIRST WITH STOP^C0CBAT",!
|
||||
N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO
|
||||
S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"
|
||||
S ZTDTH=$H ;
|
||||
;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10))
|
||||
S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""
|
||||
S ZTIO="NULL" ;
|
||||
W !,!,"CCR BATCH JOB STARTED",!
|
||||
D ^%ZTLOAD
|
||||
Q
|
||||
;
|
||||
;
|
||||
I $D(^TMP("C0CBAT","RUNNING")) D Q ; ONLY ONE ALLOWED AT A TIME
|
||||
. W !,"CCR BATCH ALREADY RUNNING",!
|
||||
. W !,"STOP FIRST WITH STOP^C0CBAT",!
|
||||
N ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTSK,ZTIO
|
||||
S ZTRTN="EN^C0CBAT",ZTDESC="CCR Batch"
|
||||
S ZTDTH=$H ;
|
||||
;S ZTDTH=$S(($P(ZTDTH,",",2)+10)\86400:(1+ZTDTH)_","_((($P(ZTDTH,",",2)+10)#86400)/100000),1:(+ZTDTH)_","_($P(ZTDTH,",",2)+10))
|
||||
S ZTSAVE("C0C")="",ZTSAVE("C0C*")=""
|
||||
S ZTIO="NULL" ;
|
||||
W !,!,"CCR BATCH JOB STARTED",!
|
||||
D ^%ZTLOAD
|
||||
Q
|
||||
;
|
||||
EN ; BATCH ENTRY POINT
|
||||
; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
|
||||
; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
|
||||
; GENERATES A NEW CCR FOR THE PATIENT
|
||||
; UPDATES THE E2 CCR ELEMENTS FILE
|
||||
;
|
||||
S C0CQT=1 ; QUIET MODE
|
||||
I $D(^TMP("C0CBAT","RUNNING")) Q ; ONLY ONE AT A TIME
|
||||
S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL
|
||||
S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN
|
||||
S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE
|
||||
S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE
|
||||
S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
|
||||
I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST
|
||||
. W "WORK AREA ERROR",!
|
||||
. B
|
||||
S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
|
||||
S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
|
||||
S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
|
||||
;I $D(^C0CB("B",C0CDT)) D ; BATCH RECORD EXISTS
|
||||
;. H 10 ; HANG 10 SECONDS
|
||||
;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN
|
||||
;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK
|
||||
D BLDHOT(C0CBH) ; BUILD THE HOT LIST
|
||||
S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST
|
||||
S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS
|
||||
S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL
|
||||
S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM
|
||||
S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS
|
||||
S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST
|
||||
D UPDIE ; CREATE THE BATCH RECORD
|
||||
S C0CIEN=$O(^C0CB("B",C0CBDT,""))
|
||||
S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST
|
||||
S C0CBCUR="" ; CURRENT PATIENT
|
||||
S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""
|
||||
;F S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR="" D ; HOT LIST LATEST FIRST
|
||||
F S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; HOT LIST FIRST
|
||||
. D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")
|
||||
. I $G(C0CCHK) D ;
|
||||
. . D PUTRIM^C0CFM2(C0CBCUR)
|
||||
. . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
|
||||
. . K C0CFDA
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
|
||||
. . D UPDIE ; CREATE UPDATE SUBFILE
|
||||
. S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
|
||||
. S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS
|
||||
. S C0CNOW=$$NOW^XLFDT
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
|
||||
. S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
|
||||
. S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
|
||||
. S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
|
||||
. S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED
|
||||
. D UPDIE ;
|
||||
. I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED
|
||||
. . S C0CSTOP=1
|
||||
. . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
|
||||
. H 1 ; GIVE OTHERS A CHANCE
|
||||
F S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; SUBS LIST
|
||||
. I $D(@C0CBH@(C0CBCUR)) Q ; SKIP IF IN HOT LIST - ALREADY DONE
|
||||
. D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")
|
||||
. I $G(C0CCHK) D ; IF CHECKSUMS HAVE CHANGED
|
||||
. . D PUTRIM^C0CFM2(C0CBCUR)
|
||||
. . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
|
||||
. . K C0CFDA
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
|
||||
. . D UPDIE ; CREATE UPDATE SUBFILE
|
||||
. S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
|
||||
. S C0CNOW=$$NOW^XLFDT
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
|
||||
. S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
|
||||
. S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
|
||||
. S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
|
||||
. S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ;
|
||||
. D UPDIE ;
|
||||
. I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED
|
||||
. . S C0CSTOP=1
|
||||
. . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
|
||||
. H 1 ; GIVE IT A BREAK
|
||||
I (C0CSTOP) S C0CDISP="KILLED"
|
||||
E S C0CDISP="FINISHED"
|
||||
S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP
|
||||
D UPDIE ; SET DISPOSITION FIELD
|
||||
K ^TMP("C0CBAT","RUNNING")
|
||||
Q
|
||||
;
|
||||
; PROCESSES THE SUBSCRIPTION FILE, EXTRACTING CCR VARIABLES FOR EACH
|
||||
; PATIENT WITH AN ACTIVE SUBSCRIPTION, AND IF CHECKSUMS INDICATE A CHANGE,
|
||||
; GENERATES A NEW CCR FOR THE PATIENT
|
||||
; UPDATES THE E2 CCR ELEMENTS FILE
|
||||
;
|
||||
S C0CQT=1 ; QUIET MODE
|
||||
I $D(^TMP("C0CBAT","RUNNING")) Q ; ONLY ONE AT A TIME
|
||||
S ^TMP("C0CBAT","RUNNING")="" ; RUNNING SIGNAL
|
||||
S C0CBDT=$$NOW^XLFDT ; DATE OF THIS RUN
|
||||
S C0CBF=177.301 ; FILE NUMBER OF C0C BATCH CONTROL FILE
|
||||
S C0CBFR=177.3013 ; FILE NUMBER OF UPDATE SUBFILE
|
||||
S C0CBB=$NA(^TMP("C0CBATCH",C0CBDT)) ; BATCH WORK AREA
|
||||
I $D(@C0CBB@(0)) D ; ERROR SHOULDN'T EXIST
|
||||
. W "WORK AREA ERROR",!
|
||||
. B
|
||||
S @C0CBB@(0)="V22" ; VERSION USED TO CREATE THIS WORK AREA
|
||||
S C0CBH=$NA(@C0CBB@("HOTLIST")) ; BASE FOR HOT LIST
|
||||
S C0CBS=$NA(^C0CS("B")) ; SUBSCRIPTION LIST BASE
|
||||
;I $D(^C0CB("B",C0CDT)) D ; BATCH RECORD EXISTS
|
||||
;. H 10 ; HANG 10 SECONDS
|
||||
;. S C0CBDT=$$NOW^XLFDT ; NEW DATE FOR THIS RUN
|
||||
;. I $D(^C0CB("B",C0CDT)) B ;DIDN'T WORK
|
||||
D BLDHOT(C0CBH) ; BUILD THE HOT LIST
|
||||
S C0CHN=$$COUNT(C0CBH) ;COUNT NUMBER IN HOT LIST
|
||||
S C0CSN=$$COUNT(C0CBS) ;COUNT NUMBER OF PATIENTS WITH SUBSCRIPTIONS
|
||||
S C0CFDA(C0CBF,"+1,",.01)=C0CBDT ; DATE KEY OF BATCH CONTROL
|
||||
S C0CFDA(C0CBF,"+1,",.02)=C0CBDT ; BATCH ID IS DATE IN STRING FORM
|
||||
S C0CFDA(C0CBF,"+1,",1)=C0CSN ; TOTAL SUBSCRIPTIONS
|
||||
S C0CFDA(C0CBF,"+1,",2)=C0CHN ; TOTAL HOT LIST
|
||||
D UPDIE ; CREATE THE BATCH RECORD
|
||||
S C0CIEN=$O(^C0CB("B",C0CBDT,""))
|
||||
S (C0CN,C0CNH)=0 ; COUNTERS FOR TOTAL AND HOT LIST
|
||||
S C0CBCUR="" ; CURRENT PATIENT
|
||||
S C0CSTOP=0 ; STOP FLAG FOR HALTING BATCH SET ^TMP("C0CBAT","STOP")=""
|
||||
;F S C0CBCUR=$O(@C0CBH@(C0CBCUR),-1) Q:C0CBCUR="" D ; HOT LIST LATEST FIRST
|
||||
F S C0CBCUR=$O(@C0CBH@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; HOT LIST FIRST
|
||||
. D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-900^VITLIMIT:T-900")
|
||||
. I $G(C0CCHK) D ;
|
||||
. . D PUTRIM^C0CFM2(C0CBCUR)
|
||||
. . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
|
||||
. . K C0CFDA
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
|
||||
. . D UPDIE ; CREATE UPDATE SUBFILE
|
||||
. S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
|
||||
. S C0CNH=C0CNH+1 ; INCREMENT HOT LIST TOTAL
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",2.1)=C0CNH ; UPDATE HOT LIST PROGRESS
|
||||
. S C0CNOW=$$NOW^XLFDT
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
|
||||
. S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
|
||||
. S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
|
||||
. S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
|
||||
. S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ; LAST RECORD PROCESSED
|
||||
. D UPDIE ;
|
||||
. I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED
|
||||
. . S C0CSTOP=1
|
||||
. . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
|
||||
. H 1 ; GIVE OTHERS A CHANCE
|
||||
F S C0CBCUR=$O(@C0CBS@(C0CBCUR)) Q:(C0CSTOP)!(C0CBCUR="") D ; SUBS LIST
|
||||
. I $D(@C0CBH@(C0CBCUR)) Q ; SKIP IF IN HOT LIST - ALREADY DONE
|
||||
. D ANALYZE^C0CRIMA(C0CBCUR,1,"LABLIMIT:T-760^VITLIMIT:T-760")
|
||||
. I $G(C0CCHK) D ; IF CHECKSUMS HAVE CHANGED
|
||||
. . D PUTRIM^C0CFM2(C0CBCUR)
|
||||
. . D XPAT^C0CCCR(C0CBCUR) ; IF VARIABLES HAVE CHANGED GENERATE CCR
|
||||
. . K C0CFDA
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",.01)=C0CBCUR
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",1)="Y"
|
||||
. . S C0CFDA(C0CBFR,"+1,"_C0CIEN_",",2)=$G(^TMP("C0CCCR","FNAME",C0CBCUR))
|
||||
. . D UPDIE ; CREATE UPDATE SUBFILE
|
||||
. S C0CN=C0CN+1 ; INCREMENT NUMBER IN TOTAL
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",1.1)=C0CN ;UPDATE TOTAL PROGRESS
|
||||
. S C0CNOW=$$NOW^XLFDT
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4)=C0CNOW ; LAST UPDATED FIELD
|
||||
. S C0CELPS=$$FMDIFF^XLFDT(C0CNOW,C0CBDT,2) ; DIFFERENCE IN SECONDS
|
||||
. S C0CAVG=C0CELPS/C0CN ; AVERAGE ELAPSED TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.1)=C0CAVG ; AVERAGE ELAPSED TIME
|
||||
. S C0CETOT=C0CAVG*C0CSN ; EST TOT ELASPSED TIME
|
||||
. S C0CEST=$$FMADD^XLFDT(C0CBDT,0,0,0,C0CETOT) ; ADD SECONDS TO BATCH START
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",4.2)=C0CEST ;ESTIMATED COMPLETION TIME
|
||||
. S C0CFDA(C0CBF,C0CIEN_",",5)=C0CBCUR ;
|
||||
. D UPDIE ;
|
||||
. I $D(^TMP("C0CBAT","STOP")) D ; IF STOP SIGNAL DETECTED
|
||||
. . S C0CSTOP=1
|
||||
. . K ^TMP("C0CBAT","STOP") ; SIGNAL RECEIVED
|
||||
. H 1 ; GIVE IT A BREAK
|
||||
I (C0CSTOP) S C0CDISP="KILLED"
|
||||
E S C0CDISP="FINISHED"
|
||||
S C0CFDA(C0CBF,C0CIEN_",",6)=C0CDISP
|
||||
D UPDIE ; SET DISPOSITION FIELD
|
||||
K ^TMP("C0CBAT","RUNNING")
|
||||
Q
|
||||
;
|
||||
BLDHOT(ZHB) ; BUILD HOT LIST AT GLOBAL ZHB, PASSED BY NAME
|
||||
; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
|
||||
N ZDFN
|
||||
S ZDFN=""
|
||||
F S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN="" D ; ALL PATIENTS IN THE AC INDX
|
||||
. S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("
|
||||
. I '$D(@C0CBS@(ZZDFN)) Q ; SKIP IF NOT IN SUBSCRIPTION LIST
|
||||
. S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST
|
||||
Q
|
||||
;
|
||||
; SEARCHS FOR PATIENTS IN THE "AC" INDEX OF THE ORDER FILE
|
||||
N ZDFN
|
||||
S ZDFN=""
|
||||
F S ZDFN=$O(^OR(100,"AC",ZDFN)) Q:ZDFN="" D ; ALL PATIENTS IN THE AC INDX
|
||||
. S ZZDFN=$P(ZDFN,";",1) ; FORMAT IS "N;DPT("
|
||||
. I '$D(@C0CBS@(ZZDFN)) Q ; SKIP IF NOT IN SUBSCRIPTION LIST
|
||||
. S @ZHB@(ZZDFN)="" ;ADD PATIENT TO THE HOT LIST
|
||||
Q
|
||||
;
|
||||
COUNT(ZB) ; EXTRINSIC THAT RETURNS THE NUMBER OF ARRAY ELEMENTS
|
||||
N ZI,ZN
|
||||
S ZN=0
|
||||
S ZI=""
|
||||
F S ZI=$O(@ZB@(ZI)) Q:ZI="" D ;
|
||||
. S ZN=ZN+1
|
||||
Q ZN
|
||||
;
|
||||
N ZI,ZN
|
||||
S ZN=0
|
||||
S ZI=""
|
||||
F S ZI=$O(@ZB@(ZI)) Q:ZI="" D ;
|
||||
. S ZN=ZN+1
|
||||
Q ZN
|
||||
;
|
||||
UPDIEVARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
|
|
520
p/C0CCCD.m
520
p/C0CCCD.m
|
@ -1,272 +1,272 @@
|
|||
C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
; EXPORT A CCR
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
; EXPORT A CCR
|
||||
;
|
||||
EXPORT ; EXPORT ENTRY POINT FOR CCR
|
||||
; Select a patient.
|
||||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||
I Y<1 Q ; EXIT
|
||||
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
||||
D XPAT(DFN,"","") ; EXPORT TO A FILE
|
||||
Q
|
||||
;
|
||||
; Select a patient.
|
||||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||
I Y<1 Q ; EXIT
|
||||
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
||||
D XPAT(DFN,"","") ; EXPORT TO A FILE
|
||||
Q
|
||||
;
|
||||
XPAT(DFN,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
|
||||
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
|
||||
; FN IS FILE NAME, DEFAULTS IF NULL
|
||||
; N CCDGLO
|
||||
D CCDRPC(.CCDGLO,DFN,"CCD","","","")
|
||||
S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
|
||||
S ONAM=FN
|
||||
I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
|
||||
S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
|
||||
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
||||
. S @ODIRGLB="/home/glilly/CCROUT"
|
||||
. ;S @ODIRGLB="/home/cedwards/"
|
||||
. ;S @ODIRGLB="/opt/wv/p/"
|
||||
S ODIR=DIR
|
||||
I DIR="" S ODIR=@ODIRGLB
|
||||
N ZY
|
||||
S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
|
||||
W $P(ZY,U,2)
|
||||
Q
|
||||
;
|
||||
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
|
||||
; FN IS FILE NAME, DEFAULTS IF NULL
|
||||
; N CCDGLO
|
||||
D CCDRPC(.CCDGLO,DFN,"CCD","","","")
|
||||
S OARY=$NA(^TMP("C0CCCR",$J,DFN,"CCD",1))
|
||||
S ONAM=FN
|
||||
I FN="" S ONAM="PAT_"_DFN_"_CCD_V1.xml"
|
||||
S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
|
||||
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
||||
. S @ODIRGLB="/home/glilly/CCROUT"
|
||||
. ;S @ODIRGLB="/home/cedwards/"
|
||||
. ;S @ODIRGLB="/opt/wv/p/"
|
||||
S ODIR=DIR
|
||||
I DIR="" S ODIR=@ODIRGLB
|
||||
N ZY
|
||||
S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
|
||||
W $P(ZY,U,2)
|
||||
Q
|
||||
;
|
||||
CCDRPC(CCRGRTN,DFN,CCRPART,TIME1,TIME2,HDRARY) ;RPC ENTRY POINT FOR CCR OUTPUT
|
||||
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
|
||||
; DFN IS PATIENT IEN
|
||||
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
||||
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
||||
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
|
||||
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
|
||||
; - NULL MEANS NOW
|
||||
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
|
||||
; "TO" VARIABLES
|
||||
; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
|
||||
I '$D(DEBUG) S DEBUG=0
|
||||
N CCD S CCD=0 ; FLAG FOR 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
|
||||
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
|
||||
S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
||||
; 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
|
||||
I CCD D LOAD^C0CCCD1(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
|
||||
N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
|
||||
S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
|
||||
S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
|
||||
S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
|
||||
S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
|
||||
S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
|
||||
S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
|
||||
;
|
||||
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
||||
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
||||
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
|
||||
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
|
||||
I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
|
||||
I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
|
||||
;
|
||||
I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
|
||||
; MAPPING THE PATIENT PORTION OF THE CDA HEADER
|
||||
S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
|
||||
D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
|
||||
D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
|
||||
I DEBUG D PARY^C0CXPATH("ACTT2")
|
||||
D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
|
||||
I DEBUG D PARY^C0CXPATH(CCDGLO)
|
||||
K ACTT1 K ACCT2
|
||||
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
|
||||
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
|
||||
D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
|
||||
D CP^C0CXPATH("ACTT2",CCDGLO)
|
||||
;
|
||||
K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
||||
S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
||||
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
||||
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
||||
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
||||
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
|
||||
. S RTN=$P(XI,";",2) ; NAME OF 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
|
||||
. D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
||||
. S IXML="INXML"
|
||||
. I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
|
||||
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
||||
. ; W OXML,!
|
||||
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
||||
. W "RUNNING ",CALL,!
|
||||
. X CALL
|
||||
. I @OXML@(0)'=0 D ; THERE IS A RESULT
|
||||
. . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
|
||||
. . I CCD D UNSHAVE("ITMP",OXML)
|
||||
. . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
|
||||
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
||||
. D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
|
||||
. I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
|
||||
; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
|
||||
; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
|
||||
; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
||||
; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
|
||||
; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
||||
N I,J,DONE S DONE=0
|
||||
F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
||||
. S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
|
||||
. W "TRIMMED",J,!
|
||||
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
||||
I CCD D ; TURN THE BODY INTO A CCD COMPONENT
|
||||
. N I
|
||||
. F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
|
||||
. . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP
|
||||
. . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
|
||||
. . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP
|
||||
. . . S @CCDGLO@(I)="</structuredBody></component>"
|
||||
S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
|
||||
S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
|
||||
Q
|
||||
;
|
||||
; CCRGRTN IS RETURN ARRAY PASSED BY NAME
|
||||
; DFN IS PATIENT IEN
|
||||
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
||||
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
||||
; TIME1 IS STARTING TIME TO INCLUDE - NULL MEANS ALL
|
||||
; TIME2 IS ENDING TIME TO INCLUDE TIME IS FILEMAN TIME
|
||||
; - NULL MEANS NOW
|
||||
; HDRARY IS THE HEADER ARRAY DEFINING THE "FROM" AND
|
||||
; "TO" VARIABLES
|
||||
; IF NULL WILL DEFAULT TO "FROM" ORGANIZATION AND "TO" DFN
|
||||
I '$D(DEBUG) S DEBUG=0
|
||||
N CCD S CCD=0 ; FLAG FOR 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
|
||||
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
|
||||
S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
||||
; 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
|
||||
I CCD D LOAD^C0CCCD1(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
|
||||
N CAPSAVE,CAPSAVE2 ; FOR HOLDING THE CCD ROOT LINES
|
||||
S CAPSAVE=@TGLOBAL@(3) ; SAVE THE CCD ROOT
|
||||
S CAPSAVE2=@TGLOBAL@(@TGLOBAL@(0)) ; SAVE LAST LINE OF CCD
|
||||
S @CCDGLO@(3)="<ContinuityOfCareRecord>" ; CAP WITH CCR ROOT
|
||||
S @TGLOBAL@(3)=@CCDGLO@(3) ; CAP THE TEMPLATE TOO
|
||||
S @CCDGLO@(@CCDGLO@(0))="</ContinuityOfCareRecord>" ; FINISH CAP
|
||||
S @TGLOBAL@(@TGLOBAL@(0))="</ContinuityOfCareRecord>" ; FINISH CAP TEMP
|
||||
;
|
||||
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
||||
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
||||
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Body")
|
||||
D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Actors")
|
||||
I 'CCD D REPLACE^C0CXPATH(CCDGLO,"","//ContinuityOfCareRecord/Signatures")
|
||||
I DEBUG F I=1:1:@CCDGLO@(0) W @CCDGLO@(I),!
|
||||
;
|
||||
I 'CCD D HDRMAP(CCDGLO,DFN,HDRARY) ; MAP HEADER VARIABLES
|
||||
; MAPPING THE PATIENT PORTION OF THE CDA HEADER
|
||||
S ZZX="//ContinuityOfCareRecord/recordTarget/patientRole/patient"
|
||||
D QUERY^C0CXPATH(CCDGLO,ZZX,"ACTT1")
|
||||
D PATIENT^C0CACTOR("ACTT1",DFN,"ACTORPATIENT_"_DFN,"ACTT2") ; MAP PATIENT
|
||||
I DEBUG D PARY^C0CXPATH("ACTT2")
|
||||
D REPLACE^C0CXPATH(CCDGLO,"ACTT2",ZZX)
|
||||
I DEBUG D PARY^C0CXPATH(CCDGLO)
|
||||
K ACTT1 K ACCT2
|
||||
; MAPPING THE PROVIDER ORGANIZATION,AUTHOR,INFORMANT,CUSTODIAN CDA HEADER
|
||||
; FOR NOW, THEY ARE ALL THE SAME AND RESOLVE TO ORGANIZATION
|
||||
D ORG^C0CACTOR(CCDGLO,DFN,"ACTORPATIENTORGANIZATION","ACTT2") ; MAP ORG
|
||||
D CP^C0CXPATH("ACTT2",CCDGLO)
|
||||
;
|
||||
K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
||||
S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
||||
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
||||
N I,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
||||
F I=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
||||
. S XI=@CCRXTAB@(I) ; CALL COPONENTS TO PARSE
|
||||
. S RTN=$P(XI,";",2) ; NAME OF 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
|
||||
. D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
||||
. S IXML="INXML"
|
||||
. I CCD D SHAVE(IXML) ; REMOVE ALL BUT REPEATING PARTS OF TEMPLATE SECTION
|
||||
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
||||
. ; W OXML,!
|
||||
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
||||
. W "RUNNING ",CALL,!
|
||||
. X CALL
|
||||
. I @OXML@(0)'=0 D ; THERE IS A RESULT
|
||||
. . I CCD D QUERY^C0CXPATH(TGLOBAL,XPATH,"ITMP") ; XML TO UNSHAVE WITH
|
||||
. . I CCD D UNSHAVE("ITMP",OXML)
|
||||
. . I CCD D UNMARK^C0CXPATH(OXML) ; REMOVE THE CCR MARKUP FROM SECTION
|
||||
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
||||
. D INSERT^C0CXPATH(CCDGLO,OXML,"//ContinuityOfCareRecord/Body")
|
||||
. I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
|
||||
; NEED TO ADD BACK IN ACTOR PROCESSING AFTER WE FIGURE OUT LINKAGE
|
||||
; D ACTLST^C0CCCR(CCDGLO,ACTGLO) ; GEN THE ACTOR LIST
|
||||
; D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
||||
; D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
|
||||
; D INSINNER^C0CXPATH(CCDGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
||||
N I,J,DONE S DONE=0
|
||||
F I=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
||||
. S J=$$TRIM^C0CXPATH(CCDGLO) ; DELETE EMPTY ELEMENTS
|
||||
. W "TRIMMED",J,!
|
||||
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
||||
I CCD D ; TURN THE BODY INTO A CCD COMPONENT
|
||||
. N I
|
||||
. F I=1:1:@CCDGLO@(0) D ; SEARCH THROUGH THE ENTIRE ARRAY
|
||||
. . I @CCDGLO@(I)["<Body>" D ; REPLACE BODY MARKUP
|
||||
. . . S @CCDGLO@(I)="<component><structuredBody>" ; WITH CCD EQ
|
||||
. . I @CCDGLO@(I)["</Body>" D ; REPLACE BODY MARKUP
|
||||
. . . S @CCDGLO@(I)="</structuredBody></component>"
|
||||
S @CCDGLO@(3)=CAPSAVE ; UNCAP - TURN IT BACK INTO A CCD
|
||||
S @CCDGLO@(@CCDGLO@(0))=CAPSAVE2 ; UNCAP LAST LINE
|
||||
Q
|
||||
;
|
||||
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
|
||||
; TAB IS PASSED BY NAME
|
||||
W "TAB= ",TAB,!
|
||||
; 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;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"")")
|
||||
Q
|
||||
;
|
||||
; TAB IS PASSED BY NAME
|
||||
W "TAB= ",TAB,!
|
||||
; 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;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"")")
|
||||
Q
|
||||
;
|
||||
SHAVE(SHXML) ; REMOVES THE 2-6 AND N-1 AND N-2 LINES FROM A COMPONENT
|
||||
; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
|
||||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||||
W SHXML,!
|
||||
W @SHXML@(1),!
|
||||
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,@SHXML@(0),@SHXML@(0)) ; LAST LINE
|
||||
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
||||
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||||
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||||
Q
|
||||
;
|
||||
; NEEDED TO EXPOSE THE REPEATING PARTS FOR GENERATION
|
||||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||||
W SHXML,!
|
||||
W @SHXML@(1),!
|
||||
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,@SHXML@(0),@SHXML@(0)) ; LAST LINE
|
||||
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
||||
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||||
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||||
Q
|
||||
;
|
||||
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
|
||||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||||
W SHXML,!
|
||||
W @SHXML@(1),!
|
||||
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",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
|
||||
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
||||
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||||
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||||
Q
|
||||
;
|
||||
; NEEDED TO RESTORM FIXED TOP AND BOTTOM OF THE COMPONENT XML
|
||||
N SHTMP,SHBLD ; TEMP ARRAY AND BUILD LIST
|
||||
W SHXML,!
|
||||
W @SHXML@(1),!
|
||||
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",ORIGXML,@ORIGXML@(0)-2,@ORIGXML@(0)) ; FROM TEMP
|
||||
D PARY^C0CXPATH("SHBLD") ; PRINT BUILD LIST
|
||||
D BUILD^C0CXPATH("SHBLD","SHTMP") ; BUILD EDITED SECTION
|
||||
D CP^C0CXPATH("SHTMP",SHXML) ; COPY RESULT TO PASSED ARRAY
|
||||
Q
|
||||
;
|
||||
HDRMAP(CXML,DFN,IHDR) ; MAP HEADER VARIABLES: FROM, TO ECT
|
||||
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
|
||||
; K @VMAP
|
||||
S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
|
||||
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
||||
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
||||
. S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
||||
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
||||
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
||||
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
||||
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
||||
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
||||
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
||||
. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
||||
N CTMP
|
||||
D MAP^C0CXPATH(CXML,VMAP,"CTMP")
|
||||
D CP^C0CXPATH("CTMP",CXML)
|
||||
Q
|
||||
;
|
||||
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
|
||||
; K @VMAP
|
||||
S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
|
||||
I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
||||
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
||||
. S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
||||
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
||||
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
||||
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
||||
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
||||
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
||||
I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
||||
. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
||||
N CTMP
|
||||
D MAP^C0CXPATH(CXML,VMAP,"CTMP")
|
||||
D CP^C0CXPATH("CTMP",CXML)
|
||||
Q
|
||||
;
|
||||
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
|
||||
; AXML AND ACTRTN ARE PASSED BY NAME
|
||||
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
||||
; P1= OBJECTID - ACTORPATIENT_2
|
||||
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
||||
;OR INSTITUTION
|
||||
; OR PERSON(IN PATIENT FILE IE NOK)
|
||||
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
||||
N I,J,K,L
|
||||
K @ACTRTN ; CLEAR RETURN ARRAY
|
||||
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
||||
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
||||
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
||||
. . W "<ActorID>=>",J,!
|
||||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||||
. . ; TO GET RID OF DUPLICATES
|
||||
S I="" ; GOING TO $O THROUGH THE HASH
|
||||
F J=0:0 D Q:$O(K(I))="" ;
|
||||
. 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,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
||||
. 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
|
||||
Q
|
||||
;
|
||||
; AXML AND ACTRTN ARE PASSED BY NAME
|
||||
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
||||
; P1= OBJECTID - ACTORPATIENT_2
|
||||
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
||||
;OR INSTITUTION
|
||||
; OR PERSON(IN PATIENT FILE IE NOK)
|
||||
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
||||
N I,J,K,L
|
||||
K @ACTRTN ; CLEAR RETURN ARRAY
|
||||
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
||||
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
||||
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
||||
. . W "<ActorID>=>",J,!
|
||||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||||
. . ; TO GET RID OF DUPLICATES
|
||||
S I="" ; GOING TO $O THROUGH THE HASH
|
||||
F J=0:0 D Q:$O(K(I))="" ;
|
||||
. 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,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
||||
. 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
|
||||
Q
|
||||
;
|
||||
TEST ; RUN ALL THE TEST CASES
|
||||
D TESTALL^C0CUNIT("C0CCCR")
|
||||
Q
|
||||
;
|
||||
D TESTALL^C0CUNIT("C0CCCR")
|
||||
Q
|
||||
;
|
||||
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D ZTEST^C0CUNIT(.ZTMP,WHICH)
|
||||
Q
|
||||
;
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D ZTEST^C0CUNIT(.ZTMP,WHICH)
|
||||
Q
|
||||
;
|
||||
TLIST ; LIST THE TESTS
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D TLIST^C0CUNIT(.ZTMP)
|
||||
Q
|
||||
;
|
||||
;;><TEST>
|
||||
;;><PROBLEMS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</Problems>"
|
||||
;;><VITALS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
|
||||
;;><CCR>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
|
||||
;;><ACTLST>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
|
||||
;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
|
||||
;;><ACTORS>
|
||||
;;>>>D ZTEST^C0CCCR("ACTLST")
|
||||
;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
|
||||
;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
|
||||
;;>>?G3(G3(0))["</Actors>"
|
||||
;;><TRIM>
|
||||
;;>>>D ZTEST^C0CCCR("CCR")
|
||||
;;>>>W $$TRIM^C0CXPATH(CCDGLO)
|
||||
;;><CCD>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
|
||||
;;></TEST>
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D TLIST^C0CUNIT(.ZTMP)
|
||||
Q
|
||||
;
|
||||
;;><TEST>
|
||||
;;><PROBLEMS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</Problems>"
|
||||
;;><VITALS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
|
||||
;;><CCR>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
|
||||
;;><ACTLST>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","","","")
|
||||
;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
|
||||
;;><ACTORS>
|
||||
;;>>>D ZTEST^C0CCCR("ACTLST")
|
||||
;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
|
||||
;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
|
||||
;;>>?G3(G3(0))["</Actors>"
|
||||
;;><TRIM>
|
||||
;;>>>D ZTEST^C0CCCR("CCR")
|
||||
;;>>>W $$TRIM^C0CXPATH(CCDGLO)
|
||||
;;><CCD>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCD","","","")
|
||||
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
|
||||
;;></TEST>
|
||||
|
|
524
p/C0CCCD1.m
524
p/C0CCCD1.m
|
@ -1,268 +1,268 @@
|
|||
C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is a CCD TEMPLATE with processing routines",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
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
|
||||
; ZARY IS PASSED BY NAME
|
||||
; BAT is a string identifying the section
|
||||
; LINE is a test which will evaluate to true or false
|
||||
; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
|
||||
; . S @ZARY@(0)=0 ; initially there are no elements
|
||||
; . W "GOT HERE LOADING "_LINE,!
|
||||
N CNT ; count of array elements
|
||||
S CNT=@ZARY@(0) ; contains array count
|
||||
S CNT=CNT+1 ; increment count
|
||||
S @ZARY@(CNT)=LINE ; put the line in the array
|
||||
; S @ZARY@(BAT,CNT)="" ; index the test by battery
|
||||
S @ZARY@(0)=CNT ; update the array counter
|
||||
Q
|
||||
;
|
||||
; ZARY IS PASSED BY NAME
|
||||
; BAT is a string identifying the section
|
||||
; LINE is a test which will evaluate to true or false
|
||||
; I '$G(@ZARY) D ; IF ZARY DOES NOT EXIST '
|
||||
; . S @ZARY@(0)=0 ; initially there are no elements
|
||||
; . W "GOT HERE LOADING "_LINE,!
|
||||
N CNT ; count of array elements
|
||||
S CNT=@ZARY@(0) ; contains array count
|
||||
S CNT=CNT+1 ; increment count
|
||||
S @ZARY@(CNT)=LINE ; put the line in the array
|
||||
; S @ZARY@(BAT,CNT)="" ; index the test by battery
|
||||
S @ZARY@(0)=CNT ; update the array counter
|
||||
Q
|
||||
;
|
||||
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
||||
; ZARY IS PASSED BY NAME
|
||||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||||
K @ZARY S @ZARY=""
|
||||
S @ZARY@(0)=0 ; initialize array count
|
||||
N LINE,LABEL,BODY
|
||||
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
|
||||
N SECTION S SECTION="[anonymous]" ; NO section LABEL
|
||||
;
|
||||
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=0 ; leaving section
|
||||
. I INTEST D ; within the section
|
||||
. . I LINE?." "1";><".E D ; sub-section name found
|
||||
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
|
||||
. . I LINE?." "1";;".E D ; line found
|
||||
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
|
||||
Q
|
||||
;
|
||||
; ZARY IS PASSED BY NAME
|
||||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||||
K @ZARY S @ZARY=""
|
||||
S @ZARY@(0)=0 ; initialize array count
|
||||
N LINE,LABEL,BODY
|
||||
N INTEST S INTEST=0 ; switch for in the TEMPLATE section
|
||||
N SECTION S SECTION="[anonymous]" ; NO section LABEL
|
||||
;
|
||||
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=0 ; leaving section
|
||||
. I INTEST D ; within the section
|
||||
. . I LINE?." "1";><".E D ; sub-section name found
|
||||
. . . S SECTION=$P($P(LINE,";><",2),">",1) ; pull out name
|
||||
. . I LINE?." "1";;".E D ; line found
|
||||
. . . D ZT(ZARY,SECTION,$P(LINE,";;",2)) ; put the line in the array
|
||||
Q
|
||||
;
|
||||
LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
|
||||
D ZLOAD(ARY,"C0CCCD1")
|
||||
; ZWR @ARY
|
||||
Q
|
||||
;
|
||||
D ZLOAD(ARY,"C0CCCD1")
|
||||
; ZWR @ARY
|
||||
Q
|
||||
;
|
||||
TRMCCD ; ROUTINE TO BE WRITTEN TO REMOVE CCR MARKUP FROM CCD
|
||||
Q
|
||||
Q
|
||||
MARKUP ;<MARKUP>
|
||||
;;<Body>
|
||||
;;<Problems>
|
||||
;;</Problems>
|
||||
;;<FamilyHistory>
|
||||
;;</FamilyHistory>
|
||||
;;<SocialHistory>
|
||||
;;</SocialHistory>
|
||||
;;<Alerts>
|
||||
;;</Alerts>
|
||||
;;<Medications>
|
||||
;;</Medications>
|
||||
;;<VitalSigns>
|
||||
;;</VitalSigns>
|
||||
;;<Results>
|
||||
;;</Results>
|
||||
;;</Body>
|
||||
;;</ContinuityOfCareRecord>
|
||||
;</MARKUP>
|
||||
;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
|
||||
;;</ClinicalDocument>
|
||||
Q
|
||||
;
|
||||
;<TEMPLATE>
|
||||
;;<?xml version="1.0"?>
|
||||
;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
|
||||
;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
|
||||
;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
|
||||
;;<templateId root="2.16.840.1.113883.10.20.1"/>
|
||||
;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
|
||||
;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
|
||||
;;<title>Continuity of Care Document</title>
|
||||
;;<effectiveTime value="20000407130000+0500"/>
|
||||
;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
|
||||
;;<languageCode code="en-US"/>
|
||||
;;<recordTarget>
|
||||
;;<patientRole>
|
||||
;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
|
||||
;;<patient>
|
||||
;;<name>
|
||||
;;<given>@@ACTORGIVENNAME@@</given>
|
||||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||||
;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
|
||||
;;</name>
|
||||
;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
|
||||
;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
|
||||
;;</patient>
|
||||
;;<providerOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</providerOrganization>
|
||||
;;</patientRole>
|
||||
;;</recordTarget>
|
||||
;;<author>
|
||||
;;<time value="20000407130000+0500"/>
|
||||
;;<assignedAuthor>
|
||||
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
|
||||
;;<assignedPerson>
|
||||
;;<name>
|
||||
;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
|
||||
;;<given>@@ACTORGIVENNAME@@</given>
|
||||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||||
;;</name>
|
||||
;;</assignedPerson>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedAuthor>
|
||||
;;</author>
|
||||
;;<informant>
|
||||
;;<assignedEntity>
|
||||
;;<id nullFlavor="NI"/>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedEntity>
|
||||
;;</informant>
|
||||
;;<custodian>
|
||||
;;<assignedCustodian>
|
||||
;;<representedCustodianOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedCustodianOrganization>
|
||||
;;</assignedCustodian>
|
||||
;;</custodian>
|
||||
;;<legalAuthenticator>
|
||||
;;<time value="20000407130000+0500"/>
|
||||
;;<signatureCode code="S"/>
|
||||
;;<assignedEntity>
|
||||
;;<id nullFlavor="NI"/>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedEntity>
|
||||
;;</legalAuthenticator>
|
||||
;;<Actors>
|
||||
;;<ACTOR-NOK>
|
||||
;;<participant typeCode="IND">
|
||||
;;<associatedEntity classCode="NOK">
|
||||
;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
|
||||
;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
|
||||
;;<telecom value="tel:(999)555-1212"/>
|
||||
;;<associatedPerson>
|
||||
;;<name>
|
||||
;;<given>Henrietta</given>
|
||||
;;<family>Levin</family>
|
||||
;;</name>
|
||||
;;</associatedPerson>
|
||||
;;</associatedEntity>
|
||||
;;</participant>
|
||||
;;</ACTOR-NOK>
|
||||
;;</Actors>
|
||||
;;<documentationOf>
|
||||
;;<serviceEvent classCode="PCPR">
|
||||
;;<effectiveTime>
|
||||
;;<high value="@@DATETIME@@"/>
|
||||
;;</effectiveTime>
|
||||
;;<performer typeCode="PRF">
|
||||
;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
|
||||
;;<time>
|
||||
;;<low value="1990"/>
|
||||
;;<high value='20000407'/>
|
||||
;;</time>
|
||||
;;<assignedEntity>
|
||||
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
|
||||
;;<assignedPerson>
|
||||
;;<name>
|
||||
;;<prefix>@@ACTORPREFIXNAME@@</prefix>
|
||||
;;<given>@@ACTORGIVENNAME@@</given>
|
||||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||||
;;</name>
|
||||
;;</assignedPerson>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedEntity>
|
||||
;;</performer>
|
||||
;;</serviceEvent>
|
||||
;;</documentationOf>
|
||||
;;<Body>
|
||||
;;<PROBLEMS-HTML>
|
||||
;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
|
||||
;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
|
||||
;;<td>@@PROBLEMDATEOFONSET@@</td>
|
||||
;;<td>Active</td></tr>
|
||||
;;</tbody></table></text>
|
||||
;;</PROBLEMS-HTML>
|
||||
;;<Problems>
|
||||
;;<component>
|
||||
;;<section>
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
|
||||
;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
|
||||
;;<title>Problems</title>
|
||||
;;<entry typeCode="DRIV">
|
||||
;;<act classCode="ACT" moodCode="EVN">
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
|
||||
;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
|
||||
;;<code nullFlavor="NA"/>
|
||||
;;<entryRelationship typeCode="SUBJ">
|
||||
;;<observation classCode="OBS" moodCode="EVN">
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
|
||||
;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
|
||||
;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
|
||||
;;<statusCode code="completed"/>
|
||||
;;<effectiveTime>
|
||||
;;<low value="@@PROBLEMDATEOFONSET@@"/>
|
||||
;;</effectiveTime>
|
||||
;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
|
||||
;;<entryRelationship typeCode="REFR">
|
||||
;;<observation classCode="OBS" moodCode="EVN">
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
|
||||
;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
|
||||
;;<statusCode code="completed"/>
|
||||
;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
|
||||
;;</observation>
|
||||
;;</entryRelationship>
|
||||
;;</observation>
|
||||
;;</entryRelationship>
|
||||
;;</act>
|
||||
;;</entry>
|
||||
;;</section>
|
||||
;;</component>
|
||||
;;</Problems>
|
||||
;;<FamilyHistory>
|
||||
;;</FamilyHistory>
|
||||
;;<SocialHistory>
|
||||
;;</SocialHistory>
|
||||
;;<Alerts>
|
||||
;;</Alerts>
|
||||
;;<Medications>
|
||||
;;</Medications>
|
||||
;;<VitalSigns>
|
||||
;;</VitalSigns>
|
||||
;;<Results>
|
||||
;;</Results>
|
||||
;;</Body>
|
||||
;;</ClinicalDocument>
|
||||
;</TEMPLATE>
|
||||
;;<Body>
|
||||
;;<Problems>
|
||||
;;</Problems>
|
||||
;;<FamilyHistory>
|
||||
;;</FamilyHistory>
|
||||
;;<SocialHistory>
|
||||
;;</SocialHistory>
|
||||
;;<Alerts>
|
||||
;;</Alerts>
|
||||
;;<Medications>
|
||||
;;</Medications>
|
||||
;;<VitalSigns>
|
||||
;;</VitalSigns>
|
||||
;;<Results>
|
||||
;;</Results>
|
||||
;;</Body>
|
||||
;;</ContinuityOfCareRecord>
|
||||
;</MARKUP>
|
||||
;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
|
||||
;;</ClinicalDocument>
|
||||
Q
|
||||
;
|
||||
;<TEMPLATE>
|
||||
;;<?xml version="1.0"?>
|
||||
;;<?xml-stylesheet type="text/xsl" href="CCD.xsl"?>
|
||||
;;<ClinicalDocument xmlns="urn:hl7-org:v3" xmlns:voc="urn:hl7-org:v3/voc" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="urn:hl7-org:v3 CDA.xsd">
|
||||
;;<typeId root="2.16.840.1.113883.1.3" extension="POCD_HD000040"/>
|
||||
;;<templateId root="2.16.840.1.113883.10.20.1"/>
|
||||
;;<id root="db734647-fc99-424c-a864-7e3cda82e703"/>
|
||||
;;<code code="34133-9" codeSystem="2.16.840.1.113883.6.1" displayName="Summarization of episode note"/>
|
||||
;;<title>Continuity of Care Document</title>
|
||||
;;<effectiveTime value="20000407130000+0500"/>
|
||||
;;<confidentialityCode code="N" codeSystem="2.16.840.1.113883.5.25"/>
|
||||
;;<languageCode code="en-US"/>
|
||||
;;<recordTarget>
|
||||
;;<patientRole>
|
||||
;;<id extension="@@ACTORIEN@@" root="2.16.840.1.113883.19.5"/>
|
||||
;;<patient>
|
||||
;;<name>
|
||||
;;<given>@@ACTORGIVENNAME@@</given>
|
||||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||||
;;<suffix>@@ACTORSUFFIXNAME@@</suffix>
|
||||
;;</name>
|
||||
;;<administrativeGenderCode code="@@ACTORGENDER@@" codeSystem="2.16.840.1.113883.5.1"/>
|
||||
;;<birthTime value="@@ACTORDATEOFBIRTH@@"/>
|
||||
;;</patient>
|
||||
;;<providerOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</providerOrganization>
|
||||
;;</patientRole>
|
||||
;;</recordTarget>
|
||||
;;<author>
|
||||
;;<time value="20000407130000+0500"/>
|
||||
;;<assignedAuthor>
|
||||
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
|
||||
;;<assignedPerson>
|
||||
;;<name>
|
||||
;;<prefix>@@ACTORNAMEPREFIX@@</prefix>
|
||||
;;<given>@@ACTORGIVENNAME@@</given>
|
||||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||||
;;</name>
|
||||
;;</assignedPerson>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedAuthor>
|
||||
;;</author>
|
||||
;;<informant>
|
||||
;;<assignedEntity>
|
||||
;;<id nullFlavor="NI"/>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedEntity>
|
||||
;;</informant>
|
||||
;;<custodian>
|
||||
;;<assignedCustodian>
|
||||
;;<representedCustodianOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedCustodianOrganization>
|
||||
;;</assignedCustodian>
|
||||
;;</custodian>
|
||||
;;<legalAuthenticator>
|
||||
;;<time value="20000407130000+0500"/>
|
||||
;;<signatureCode code="S"/>
|
||||
;;<assignedEntity>
|
||||
;;<id nullFlavor="NI"/>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedEntity>
|
||||
;;</legalAuthenticator>
|
||||
;;<Actors>
|
||||
;;<ACTOR-NOK>
|
||||
;;<participant typeCode="IND">
|
||||
;;<associatedEntity classCode="NOK">
|
||||
;;<id root="4ac71514-6a10-4164-9715-f8d96af48e6d"/>
|
||||
;;<code code="65656005" codeSystem="2.16.840.1.113883.6.96" displayName="Biiological mother"/>
|
||||
;;<telecom value="tel:(999)555-1212"/>
|
||||
;;<associatedPerson>
|
||||
;;<name>
|
||||
;;<given>Henrietta</given>
|
||||
;;<family>Levin</family>
|
||||
;;</name>
|
||||
;;</associatedPerson>
|
||||
;;</associatedEntity>
|
||||
;;</participant>
|
||||
;;</ACTOR-NOK>
|
||||
;;</Actors>
|
||||
;;<documentationOf>
|
||||
;;<serviceEvent classCode="PCPR">
|
||||
;;<effectiveTime>
|
||||
;;<high value="@@DATETIME@@"/>
|
||||
;;</effectiveTime>
|
||||
;;<performer typeCode="PRF">
|
||||
;;<functionCode code="PCP" codeSystem="2.16.840.1.113883.5.88"/>
|
||||
;;<time>
|
||||
;;<low value="1990"/>
|
||||
;;<high value='20000407'/>
|
||||
;;</time>
|
||||
;;<assignedEntity>
|
||||
;;<id root="20cf14fb-b65c-4c8c-a54d-b0cca834c18c"/>
|
||||
;;<assignedPerson>
|
||||
;;<name>
|
||||
;;<prefix>@@ACTORPREFIXNAME@@</prefix>
|
||||
;;<given>@@ACTORGIVENNAME@@</given>
|
||||
;;<family>@@ACTORFAMILYNAME@@</family>
|
||||
;;</name>
|
||||
;;</assignedPerson>
|
||||
;;<representedOrganization>
|
||||
;;<id root="2.16.840.1.113883.19.5"/>
|
||||
;;<name>@@ORGANIZATIONNAME@@</name>
|
||||
;;</representedOrganization>
|
||||
;;</assignedEntity>
|
||||
;;</performer>
|
||||
;;</serviceEvent>
|
||||
;;</documentationOf>
|
||||
;;<Body>
|
||||
;;<PROBLEMS-HTML>
|
||||
;;<text><table border="1" width="100%"><thead><tr><th>Condition</th><th>Effective Dates</th><th>Condition Status</th></tr></thead><tbody>
|
||||
;;<tr><td>@@PROBLEMDESCRIPTION@@</td>
|
||||
;;<td>@@PROBLEMDATEOFONSET@@</td>
|
||||
;;<td>Active</td></tr>
|
||||
;;</tbody></table></text>
|
||||
;;</PROBLEMS-HTML>
|
||||
;;<Problems>
|
||||
;;<component>
|
||||
;;<section>
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.11'/>
|
||||
;;<code code="11450-4" codeSystem="2.16.840.1.113883.6.1"/>
|
||||
;;<title>Problems</title>
|
||||
;;<entry typeCode="DRIV">
|
||||
;;<act classCode="ACT" moodCode="EVN">
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.27'/>
|
||||
;;<id root="6a2fa88d-4174-4909-aece-db44b60a3abb"/>
|
||||
;;<code nullFlavor="NA"/>
|
||||
;;<entryRelationship typeCode="SUBJ">
|
||||
;;<observation classCode="OBS" moodCode="EVN">
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.28'/>
|
||||
;;<id root="d11275e7-67ae-11db-bd13-0800200c9a66"/>
|
||||
;;<code code="ASSERTION" codeSystem="2.16.840.1.113883.5.4"/>
|
||||
;;<statusCode code="completed"/>
|
||||
;;<effectiveTime>
|
||||
;;<low value="@@PROBLEMDATEOFONSET@@"/>
|
||||
;;</effectiveTime>
|
||||
;;<value xsi:type="CD" code="@@PROBLEMCODEVALUE@@" codeSystem="2.16.840.1.113883.6.96" displayName="@@PROBLEMDESCRIPTION@@"/>
|
||||
;;<entryRelationship typeCode="REFR">
|
||||
;;<observation classCode="OBS" moodCode="EVN">
|
||||
;;<templateId root='2.16.840.1.113883.10.20.1.50'/>
|
||||
;;<code code="33999-4" codeSystem="2.16.840.1.113883.6.1" displayName="Status"/>
|
||||
;;<statusCode code="completed"/>
|
||||
;;<value xsi:type="CE" code="55561003" codeSystem="2.16.840.1.113883.6.96" displayName="Active"/>
|
||||
;;</observation>
|
||||
;;</entryRelationship>
|
||||
;;</observation>
|
||||
;;</entryRelationship>
|
||||
;;</act>
|
||||
;;</entry>
|
||||
;;</section>
|
||||
;;</component>
|
||||
;;</Problems>
|
||||
;;<FamilyHistory>
|
||||
;;</FamilyHistory>
|
||||
;;<SocialHistory>
|
||||
;;</SocialHistory>
|
||||
;;<Alerts>
|
||||
;;</Alerts>
|
||||
;;<Medications>
|
||||
;;</Medications>
|
||||
;;<VitalSigns>
|
||||
;;</VitalSigns>
|
||||
;;<Results>
|
||||
;;</Results>
|
||||
;;</Body>
|
||||
;;</ClinicalDocument>
|
||||
;</TEMPLATE>
|
||||
|
|
534
p/C0CCCR.m
534
p/C0CCCR.m
|
@ -1,277 +1,277 @@
|
|||
C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
; EXPORT A CCR
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
; EXPORT A CCR
|
||||
;
|
||||
EXPORT ; EXPORT ENTRY POINT FOR CCR
|
||||
; Select a patient.
|
||||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||
I Y<1 Q ; EXIT
|
||||
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
||||
D XPAT(DFN) ; EXPORT TO A FILE
|
||||
Q
|
||||
;
|
||||
XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
|
||||
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
|
||||
; FN IS FILE NAME, DEFAULTS IF NULL
|
||||
N CCRGLO,UDIR,UFN
|
||||
S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
|
||||
I '$D(DIR) S UDIR=""
|
||||
E S UDIR=DIR
|
||||
I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
|
||||
E S UFN=FN
|
||||
I '$D(XPARMS) S XPARMS=""
|
||||
N C0CRTN ; RETURN ARRAY
|
||||
D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
|
||||
S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1))
|
||||
S ONAM=UFN
|
||||
I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
|
||||
S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
|
||||
S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
|
||||
I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
|
||||
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
||||
. W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
|
||||
. ;S @ODIRGLB="/home/glilly/CCROUT"
|
||||
. ;S @ODIRGLB="/home/cedwards/"
|
||||
. S @ODIRGLB="/opt/wv/p/"
|
||||
S ODIR=UDIR
|
||||
I UDIR="" S ODIR=@ODIRGLB
|
||||
N ZY
|
||||
S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
|
||||
W !,$P(ZY,U,2),!
|
||||
Q
|
||||
;
|
||||
; Select a patient.
|
||||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||
I Y<1 Q ; EXIT
|
||||
S DFN=$P(Y,U,1) ; SET THE PATIENT
|
||||
D XPAT(DFN) ; EXPORT TO A FILE
|
||||
Q
|
||||
;
|
||||
XPAT(DFN,XPARMS,DIR,FN) ; EXPORT ONE PATIENT TO A FILE
|
||||
; DIR IS THE DIRECTORY, DEFAULTS IF NULL TO ^TMP("C0CCCR","ODIR")
|
||||
; FN IS FILE NAME, DEFAULTS IF NULL
|
||||
N CCRGLO,UDIR,UFN
|
||||
S C0CNRPC=1 ; FLAG FOR NOT AN RPC CALL - FOR DEBUGGING THE RPC
|
||||
I '$D(DIR) S UDIR=""
|
||||
E S UDIR=DIR
|
||||
I '$D(FN) S UFN="" ; IF FILENAME IS NOT PASSED
|
||||
E S UFN=FN
|
||||
I '$D(XPARMS) S XPARMS=""
|
||||
N C0CRTN ; RETURN ARRAY
|
||||
D CCRRPC(.C0CRTN,DFN,XPARMS,"CCR")
|
||||
S OARY=$NA(^TMP("C0CCUR",$J,DFN,"CCR",1))
|
||||
S ONAM=UFN
|
||||
I UFN="" S ONAM="PAT_"_DFN_"_CCR_V1_0_0.xml"
|
||||
S ODIRGLB=$NA(^TMP("C0CCCR","ODIR"))
|
||||
S ^TMP("C0CCCR","FNAME",DFN)=ONAM ; FILE NAME FOR BATCH USE
|
||||
I $D(^TMP("GPLCCR","ODIR")) S @ODIRGLB=^TMP("GPLCCR","ODIR")
|
||||
I '$D(@ODIRGLB) D ; IF NOT ODIR HAS BEEN SET
|
||||
. W "Warning.. please set ^TMP(""C0CCCR"",""ODIR"")=""output path""",! Q
|
||||
. ;S @ODIRGLB="/home/glilly/CCROUT"
|
||||
. ;S @ODIRGLB="/home/cedwards/"
|
||||
. S @ODIRGLB="/opt/wv/p/"
|
||||
S ODIR=UDIR
|
||||
I UDIR="" S ODIR=@ODIRGLB
|
||||
N ZY
|
||||
S ZY=$$OUTPUT^C0CXPATH(OARY,ONAM,ODIR)
|
||||
W !,$P(ZY,U,2),!
|
||||
Q
|
||||
;
|
||||
DCCR(DFN) ; DISPLAY A CCR THAT HAS JUST BEEN EXTRACTED
|
||||
;
|
||||
N G1
|
||||
S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR"))
|
||||
I $D(@G1@(0)) D ; CCR EXISTS
|
||||
. D PARY^C0CXPATH(G1)
|
||||
E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
|
||||
Q
|
||||
;
|
||||
;
|
||||
N G1
|
||||
S G1=$NA(^TMP("C0CCUR",$J,DFN,"CCR"))
|
||||
I $D(@G1@(0)) D ; CCR EXISTS
|
||||
. D PARY^C0CXPATH(G1)
|
||||
E W "CCR NOT CREATED, RUN D XPAT^C0CCCR(DFN,"""","""") FIRST",!
|
||||
Q
|
||||
;
|
||||
CCRRPC(CCRGRTN,DFN,CCRPARMS,CCRPART) ;RPC ENTRY POINT FOR CCR OUTPUT
|
||||
; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
|
||||
; DFN IS PATIENT IEN
|
||||
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
||||
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
||||
; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
|
||||
; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
|
||||
; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
|
||||
; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
|
||||
K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT
|
||||
M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS
|
||||
K ^TMP($J) ; START CLEAN
|
||||
I '$D(DEBUG) S DEBUG=0
|
||||
S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
|
||||
I '$D(CCRPARMS) S CCRPARMS=""
|
||||
I '$D(CCRPART) S CCRPART="CCR"
|
||||
I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
|
||||
D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
|
||||
I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS
|
||||
I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
|
||||
I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
|
||||
I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
|
||||
S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
|
||||
S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
|
||||
S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
||||
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
|
||||
;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
|
||||
D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
||||
D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
|
||||
;
|
||||
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
||||
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
||||
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
|
||||
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
|
||||
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
|
||||
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
|
||||
;
|
||||
D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
|
||||
;
|
||||
K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
||||
S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
||||
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
||||
N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
||||
F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
||||
. S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
|
||||
. S RTN=$P(XI,";",2) ; NAME OF 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
|
||||
. D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
||||
. S IXML="INXML"
|
||||
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
||||
. ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
|
||||
. ; W OXML,!
|
||||
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
||||
. W "RUNNING ",CALL,!
|
||||
. X CALL
|
||||
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
||||
. I $G(@OXML@(0))>0 D ; THERE IS A RESULT
|
||||
. . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
|
||||
. . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
|
||||
N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
|
||||
D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
|
||||
D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
||||
D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
|
||||
D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
||||
K ACTT,ACTT2
|
||||
D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
|
||||
D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
|
||||
D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
|
||||
K CMTT,CMTT2
|
||||
N TRIMI,J,DONE S DONE=0
|
||||
F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
||||
. S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
|
||||
. I DEBUG W "TRIMMED",J,!
|
||||
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
||||
;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
|
||||
I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
|
||||
E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
|
||||
I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
|
||||
K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
|
||||
K ^TMP($J) ; REALLY CLEAN UP
|
||||
M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
|
||||
Q
|
||||
;
|
||||
; CCRGRTN IS RETURN ARRAY PASSED BY REFERENCE
|
||||
; DFN IS PATIENT IEN
|
||||
; CCRPART IS "CCR" FOR ENTIRE CCR, OR SECTION NAME FOR A PART
|
||||
; OF THE CCR BODY.. PARTS INCLUDE "PROBLEMS" "VITALS" ETC
|
||||
; CCRPARMS ARE PARAMETERS THAT AFFECT THE EXTRACTION
|
||||
; IN THE FORM "PARM1:VALUE1^PARM2:VALUE2"
|
||||
; EXAMPLE: "LABLIMIT:T-60" TO LIMIT LAB EXTRACTION TO THE LAST 60 DAYS
|
||||
; SEE C0CPARMS FOR A COMPLETE LIST OF SUPPORTED PARAMETERS
|
||||
K ^TMP("C0CCCR",$J) ; CLEAN UP THE GLOBAL BEFORE WE USE IT
|
||||
M ^TMP("C0CSAV",$J)=^TMP($J) ; SAVING CALLER'S TMP SETTINGS
|
||||
K ^TMP($J) ; START CLEAN
|
||||
I '$D(DEBUG) S DEBUG=0
|
||||
S CCD=0 ; NEED THIS FLAG TO DISTINGUISH FROM CCD
|
||||
I '$D(CCRPARMS) S CCRPARMS=""
|
||||
I '$D(CCRPART) S CCRPART="CCR"
|
||||
I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"CALL",DFN)=""
|
||||
D SET^C0CPARMS(CCRPARMS) ;SET PARAMETERS WITH CCRPARMS AS OVERRIDES
|
||||
I '$D(TESTVIT) S TESTVIT=0 ; FLAG FOR TESTING VITALS
|
||||
I '$D(TESTLAB) S TESTLAB=0 ; FLAG FOR TESTING RESULTS SECTION
|
||||
I '$D(TESTALERT) S TESTALERT=1 ; FLAG FOR TESTING ALERTS SECTION
|
||||
I '$D(TESTMEDS) S TESTMEDS=0 ; FLAG FOR TESTING C0CMED SECTION
|
||||
S TGLOBAL=$NA(^TMP("C0CCCR",$J,"TEMPLATE")) ; GLOBAL FOR STORING TEMPLATE
|
||||
S CCRGLO=$NA(^TMP("C0CCUR",$J,DFN,"CCR")) ; GLOBAL FOR BUILDING THE CCR
|
||||
S ACTGLO=$NA(^TMP("C0CCCR",$J,DFN,"ACTORS")) ; GLOBAL FOR ALL ACTORS
|
||||
; TO GET PART OF THE CCR RETURNED, PASS CCRPART="PROBLEMS" ETC
|
||||
;M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART OR ALL
|
||||
D LOAD^C0CCCR0(TGLOBAL) ; LOAD THE CCR TEMPLATE
|
||||
D CP^C0CXPATH(TGLOBAL,CCRGLO) ; COPY THE TEMPLATE TO CCR GLOBAL
|
||||
;
|
||||
; DELETE THE BODY, ACTORS AND SIGNATURES SECTIONS FROM GLOBAL
|
||||
; THESE WILL BE POPULATED AFTER CALLS TO THE XPATH ROUTINES
|
||||
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Body")
|
||||
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Actors")
|
||||
D REPLACE^C0CXPATH(CCRGLO,"","//ContinuityOfCareRecord/Signatures")
|
||||
I DEBUG F I=1:1:@CCRGLO@(0) W @CCRGLO@(I),!
|
||||
;
|
||||
D HDRMAP(CCRGLO,DFN) ; MAP HEADER VARIABLES
|
||||
;
|
||||
K ^TMP("C0CCCR",$J,"CCRSTEP") ; KILL GLOBAL PRIOR TO ADDING TO IT
|
||||
S CCRXTAB=$NA(^TMP("C0CCCR",$J,"CCRSTEP")) ; GLOBAL TO STORE CCR STEPS
|
||||
D INITSTPS(CCRXTAB) ; INITIALIZED CCR PROCESSING STEPS
|
||||
N PROCI,XI,TAG,RTN,CALL,XPATH,IXML,OXML,INXML,CCRBLD
|
||||
F PROCI=1:1:@CCRXTAB@(0) D ; PROCESS THE CCR BODY SECTIONS
|
||||
. S XI=@CCRXTAB@(PROCI) ; CALL COPONENTS TO PARSE
|
||||
. S RTN=$P(XI,";",2) ; NAME OF 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
|
||||
. D QUERY^C0CXPATH(TGLOBAL,XPATH,"INXML") ; EXTRACT XML TO PASS
|
||||
. S IXML="INXML"
|
||||
. S OXML=$P(XI,";",4) ; ARRAY FOR SECTION VALUES
|
||||
. ; K @OXML ; KILL EXPECTED OUTPUT ARRAY
|
||||
. ; W OXML,!
|
||||
. S CALL="D "_TAG_"^"_RTN_"(IXML,DFN,OXML)" ; SETUP THE CALL
|
||||
. W "RUNNING ",CALL,!
|
||||
. X CALL
|
||||
. ; NOW INSERT THE RESULTS IN THE CCR BUFFER
|
||||
. I $G(@OXML@(0))>0 D ; THERE IS A RESULT
|
||||
. . D INSERT^C0CXPATH(CCRGLO,OXML,"//ContinuityOfCareRecord/Body")
|
||||
. . I DEBUG F C0CI=1:1:@OXML@(0) W @OXML@(C0CI),!
|
||||
N ACTT,ATMP,ACTT2,ATMP2 ; TEMPORARY ARRAY SYMBOLS FOR ACTOR PROCESSING
|
||||
D ACTLST^C0CCCR(CCRGLO,ACTGLO) ; GEN THE ACTOR LIST
|
||||
D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","ACTT")
|
||||
D EXTRACT^C0CACTOR("ACTT",ACTGLO,"ACTT2")
|
||||
D INSINNER^C0CXPATH(CCRGLO,"ACTT2","//ContinuityOfCareRecord/Actors")
|
||||
K ACTT,ACTT2
|
||||
D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Comments","CMTT")
|
||||
D EXTRACT^C0CCMT("CMTT",DFN,"CMTT2")
|
||||
D INSINNER^C0CXPATH(CCRGLO,"CMTT2","//ContinuityOfCareRecord/Comments")
|
||||
K CMTT,CMTT2
|
||||
N TRIMI,J,DONE S DONE=0
|
||||
F TRIMI=0:0 D Q:DONE ; DELETE UNTIL ALL EMPTY ELEMENTS ARE GONE
|
||||
. S J=$$TRIM^C0CXPATH(CCRGLO) ; DELETE EMPTY ELEMENTS
|
||||
. I DEBUG W "TRIMMED",J,!
|
||||
. I J=0 S DONE=1 ; DONE WHEN TRIM RETURNS FALSE
|
||||
;S CCRGRTN=$NA(^TMP("C0CCCR",$J,DFN,CCRPART)) ; RTN GLOBAL OF PART OR ALL
|
||||
I CCRPART="CCR" M CCRGRTN=@CCRGLO ; ENTIRE CCR
|
||||
E M CCRGRTN=^TMP("C0CCCR",$J,DFN,CCRPART) ; RTN GLOBAL OF PART
|
||||
I '$D(C0CNRPC) S ^TMP("C0CRPC",$H,"RESULT",CCRGRTN(0))=""
|
||||
K ^TMP("C0CCCR",$J) ; BEGIN TO CLEAN UP
|
||||
K ^TMP($J) ; REALLY CLEAN UP
|
||||
M ^TMP($J)=^TMP("C0CSAV",$J) ; RESTORE CALLER'S $J
|
||||
Q
|
||||
;
|
||||
INITSTPS(TAB) ; INITIALIZE CCR PROCESSING STEPS
|
||||
; TAB IS PASSED BY NAME
|
||||
I DEBUG W "TAB= ",TAB,!
|
||||
; 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"")")
|
||||
I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
|
||||
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
|
||||
D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
|
||||
I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
|
||||
E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
|
||||
D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
|
||||
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
|
||||
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
|
||||
Q
|
||||
;
|
||||
; TAB IS PASSED BY NAME
|
||||
I DEBUG W "TAB= ",TAB,!
|
||||
; 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"")")
|
||||
I TESTALERT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CALERT;//ContinuityOfCareRecord/Body/Alerts;^TMP(""C0CCCR"",$J,DFN,""ALERTS"")")
|
||||
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CMED;//ContinuityOfCareRecord/Body/Medications;^TMP(""C0CCCR"",$J,DFN,""MEDICATIONS"")")
|
||||
D PUSH^C0CXPATH(TAB,"MAP;C0CIMMU;//ContinuityOfCareRecord/Body/Immunizations;^TMP(""C0CCCR"",$J,DFN,""IMMUNE"")")
|
||||
I TESTVIT D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVIT2;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
|
||||
E D PUSH^C0CXPATH(TAB,"EXTRACT;C0CVITAL;//ContinuityOfCareRecord/Body/VitalSigns;^TMP(""C0CCCR"",$J,DFN,""VITALS"")")
|
||||
D PUSH^C0CXPATH(TAB,"MAP;C0CLABS;//ContinuityOfCareRecord/Body/Results;^TMP(""C0CCCR"",$J,DFN,""RESULTS"")")
|
||||
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CPROC;//ContinuityOfCareRecord/Body/Procedures;^TMP(""C0CCCR"",$J,DFN,""PROCEDURES"")")
|
||||
D PUSH^C0CXPATH(TAB,"EXTRACT;C0CENC;//ContinuityOfCareRecord/Body/Encounters;^TMP(""C0CCCR"",$J,DFN,""ENCOUNTERS"")")
|
||||
Q
|
||||
;
|
||||
HDRMAP(CXML,DFN) ; MAP HEADER VARIABLES: FROM, TO ECT
|
||||
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
|
||||
; K @VMAP
|
||||
S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
|
||||
; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
||||
D ; ALWAYS MAP THESE VARIABLES
|
||||
. S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
|
||||
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
||||
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
|
||||
. ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
||||
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
||||
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
||||
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
||||
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
||||
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
||||
;I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
||||
;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
||||
N CTMP
|
||||
D MAP^C0CXPATH(CXML,VMAP,"CTMP")
|
||||
D CP^C0CXPATH("CTMP",CXML)
|
||||
N HRIMVARS ;
|
||||
S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
|
||||
M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
|
||||
S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
|
||||
Q
|
||||
;
|
||||
N VMAP S VMAP=$NA(^TMP("C0CCCR",$J,DFN,"HEADER"))
|
||||
; K @VMAP
|
||||
S @VMAP@("DATETIME")=$$FMDTOUTC^C0CUTIL($$NOW^XLFDT,"DT")
|
||||
; I IHDR="" D ; HEADER ARRAY IS NOT PROVIDED, USE DEFAULTS
|
||||
D ; ALWAYS MAP THESE VARIABLES
|
||||
. S @VMAP@("CCRDOCOBJECTID")=$$UUID^C0CUTIL ; UUID FOR THIS CCR
|
||||
. S @VMAP@("ACTORPATIENT")="ACTORPATIENT_"_DFN
|
||||
. S @VMAP@("ACTORFROM")="ACTORPROVIDER_"_DUZ ; FROM DUZ - FROM PROVIDER
|
||||
. ;S @VMAP@("ACTORFROM")="ACTORORGANIZATION_"_DUZ ; FROM DUZ - ???
|
||||
. S @VMAP@("ACTORFROM2")="ACTORSYSTEM_1" ; SECOND FROM IS THE SYSTEM
|
||||
. S @VMAP@("ACTORTO")="ACTORPATIENT_"_DFN ; FOR TEST PURPOSES
|
||||
. S @VMAP@("PURPOSEDESCRIPTION")="CEND PHR" ; FOR TEST PURPOSES
|
||||
. S @VMAP@("ACTORTOTEXT")="Patient" ; FOR TEST PURPOSES
|
||||
. ; THIS IS THE USE CASE FOR THE PHR WHERE "TO" IS THE PATIENT
|
||||
;I IHDR'="" D ; HEADER VALUES ARE PROVIDED
|
||||
;. D CP^C0CXPATH(IHDR,VMAP) ; COPY HEADER VARIABLES TO MAP ARRAY
|
||||
N CTMP
|
||||
D MAP^C0CXPATH(CXML,VMAP,"CTMP")
|
||||
D CP^C0CXPATH("CTMP",CXML)
|
||||
N HRIMVARS ;
|
||||
S HRIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"HEADER")) ; TO PERSIST VARS
|
||||
M @HRIMVARS@(1)=@VMAP ; PERSIST THE HEADER VARIABLES IN RIM TABLE
|
||||
S @HRIMVARS@(0)=1 ; ONLY ONE SET OF HEADERS PER PATIENT
|
||||
Q
|
||||
;
|
||||
ACTLST(AXML,ACTRTN) ; RETURN THE ACTOR LIST FOR THE XML IN AXML
|
||||
; AXML AND ACTRTN ARE PASSED BY NAME
|
||||
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
||||
; P1= OBJECTID - ACTORPATIENT_2
|
||||
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
||||
;OR INSTITUTION
|
||||
; OR PERSON(IN PATIENT FILE IE NOK)
|
||||
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
||||
N I,J,K,L
|
||||
K @ACTRTN ; CLEAR RETURN ARRAY
|
||||
F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS
|
||||
. I @AXML@(I)?.E1"_<".E D ;
|
||||
. . N ZA,ZB
|
||||
. . S ZA=$P(@AXML@(I),">",1)_">"
|
||||
. . S ZB="<"_$P(@AXML@(I),"<",3)
|
||||
. . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
|
||||
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
||||
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
||||
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
||||
. . I $G(LINKDEBUG) W "<ActorID>=>",J,!
|
||||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||||
. I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE
|
||||
. . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
|
||||
. . I $G(LINKDEBUG) W "<LinkID>=>",J,!
|
||||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||||
. . ; TO GET RID OF DUPLICATES
|
||||
S I="" ; GOING TO $O THROUGH THE HASH
|
||||
F J=0:0 D Q:$O(K(I))=""
|
||||
. 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,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
||||
. 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
|
||||
Q
|
||||
;
|
||||
; AXML AND ACTRTN ARE PASSED BY NAME
|
||||
; EACH ACTOR RECORD HAS 3 PARTS - IE IF OBJECTID=ACTORPATIENT_2
|
||||
; P1= OBJECTID - ACTORPATIENT_2
|
||||
; P2= OBJECT TYPE - PATIENT OR PROVIDER OR SOFTWARE
|
||||
;OR INSTITUTION
|
||||
; OR PERSON(IN PATIENT FILE IE NOK)
|
||||
; P3= IEN RECORD NUMBER FOR ACTOR - 2
|
||||
N I,J,K,L
|
||||
K @ACTRTN ; CLEAR RETURN ARRAY
|
||||
F I=1:1:@AXML@(0) D ; FIRST FIX MISSING LINKS
|
||||
. I @AXML@(I)?.E1"_<".E D ;
|
||||
. . N ZA,ZB
|
||||
. . S ZA=$P(@AXML@(I),">",1)_">"
|
||||
. . S ZB="<"_$P(@AXML@(I),"<",3)
|
||||
. . S @AXML@(I)=ZA_"ACTORORGANIZATION_1"_ZB
|
||||
F I=1:1:@AXML@(0) D ; SCAN ALL LINES
|
||||
. I @AXML@(I)?.E1"<ActorID>".E D ; THERE IS AN ACTOR THIS LINE
|
||||
. . S J=$P($P(@AXML@(I),"<ActorID>",2),"</ActorID>",1)
|
||||
. . I $G(LINKDEBUG) W "<ActorID>=>",J,!
|
||||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||||
. I @AXML@(I)?.E1"<LinkID>".E D ; THERE IS AN ACTOR THIS LINE
|
||||
. . S J=$P($P(@AXML@(I),"<LinkID>",2),"</LinkID>",1)
|
||||
. . I $G(LINKDEBUG) W "<LinkID>=>",J,!
|
||||
. . I J'="" S K(J)="" ; HASHING ACTOR
|
||||
. . ; TO GET RID OF DUPLICATES
|
||||
S I="" ; GOING TO $O THROUGH THE HASH
|
||||
F J=0:0 D Q:$O(K(I))=""
|
||||
. 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,2)=$P($P(I,"ACTOR",2),"_",1) ; ACTOR TYPE
|
||||
. 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
|
||||
Q
|
||||
;
|
||||
TEST ; RUN ALL THE TEST CASES
|
||||
D TESTALL^C0CUNIT("C0CCCR")
|
||||
Q
|
||||
;
|
||||
D TESTALL^C0CUNIT("C0CCCR")
|
||||
Q
|
||||
;
|
||||
ZTEST(WHICH) ; RUN ONE SET OF TESTS
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D ZTEST^C0CUNIT(.ZTMP,WHICH)
|
||||
Q
|
||||
;
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D ZTEST^C0CUNIT(.ZTMP,WHICH)
|
||||
Q
|
||||
;
|
||||
TLIST ; LIST THE TESTS
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D TLIST^C0CUNIT(.ZTMP)
|
||||
Q
|
||||
;
|
||||
;;><TEST>
|
||||
;;><PROBLEMS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
|
||||
;;>>?@C0C@(@C0C@(0))["</Problems>"
|
||||
;;><VITALS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
|
||||
;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
|
||||
;;><CCR>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
|
||||
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
|
||||
;;><ACTLST>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
|
||||
;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
|
||||
;;><ACTORS>
|
||||
;;>>>D ZTEST^C0CCCR("ACTLST")
|
||||
;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
|
||||
;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
|
||||
;;>>?G3(G3(0))["</Actors>"
|
||||
;;><TRIM>
|
||||
;;>>>D ZTEST^C0CCCR("CCR")
|
||||
;;>>>W $$TRIM^C0CXPATH(CCRGLO)
|
||||
;;><ALERTS>
|
||||
;;>>>S TESTALERT=1
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
|
||||
;;>>?@C0C@(@C0C@(0))["</Alerts>"
|
||||
|
||||
|
||||
N ZTMP
|
||||
D ZLOAD^C0CUNIT("ZTMP","C0CCCR")
|
||||
D TLIST^C0CUNIT(.ZTMP)
|
||||
Q
|
||||
;
|
||||
;;><TEST>
|
||||
;;><PROBLEMS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","PROBLEMS","")
|
||||
;;>>?@C0C@(@C0C@(0))["</Problems>"
|
||||
;;><VITALS>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","VITALS","")
|
||||
;;>>?@C0C@(@C0C@(0))["</VitalSigns>"
|
||||
;;><CCR>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
|
||||
;;>>?@C0C@(@C0C@(0))["</ContinuityOfCareRecord>"
|
||||
;;><ACTLST>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","CCR","")
|
||||
;;>>>D ACTLST^C0CCCR(C0C,"ACTTEST")
|
||||
;;><ACTORS>
|
||||
;;>>>D ZTEST^C0CCCR("ACTLST")
|
||||
;;>>>D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Actors","G2")
|
||||
;;>>>D EXTRACT^C0CACTOR("G2","ACTTEST","G3")
|
||||
;;>>?G3(G3(0))["</Actors>"
|
||||
;;><TRIM>
|
||||
;;>>>D ZTEST^C0CCCR("CCR")
|
||||
;;>>>W $$TRIM^C0CXPATH(CCRGLO)
|
||||
;;><ALERTS>
|
||||
;;>>>S TESTALERT=1
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D CCRRPC^C0CCCR(.C0C,"2","ALERTS","")
|
||||
;;>>?@C0C@(@C0C@(0))["</Alerts>"
|
||||
|
||||
|
||||
|
|
1834
p/C0CCCR0.m
1834
p/C0CCCR0.m
File diff suppressed because it is too large
Load Diff
132
p/C0CCMT.m
132
p/C0CCMT.m
|
@ -1,66 +1,66 @@
|
|||
C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
|
||||
;;1.0;C0C;;May 21, 2010;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO XML TEMPLATE
|
||||
; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
|
||||
;I '$D(@C0CNTE) Q ; NO NOTES AVAILABLE
|
||||
D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES
|
||||
Q
|
||||
;
|
||||
MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CNTE@(ZI)) Q:ZI="" D ;FOR EACH NOTE
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML
|
||||
. S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
|
||||
. N ZNOTE,ZN
|
||||
. D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
|
||||
. M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
|
||||
. S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
|
||||
. D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))
|
||||
N ZZTMP
|
||||
D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD,@C0CNTE
|
||||
Q
|
||||
;
|
||||
CLEAN(INARY) ; INARY IS PASSED BY NAME
|
||||
; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
|
||||
N ZI,ZJ S ZI=""
|
||||
F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ;
|
||||
. S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
|
||||
. S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
|
||||
Q
|
||||
;
|
||||
C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
|
||||
;;1.0;C0C;;May 21, 2010;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(NOTEXML,DFN,NOTEOUT) ; EXTRACT NOTES INTO XML TEMPLATE
|
||||
; NOTEXML AND NOTEOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
|
||||
;I '$D(@C0CNTE) Q ; NO NOTES AVAILABLE
|
||||
D MAP(NOTEXML,C0CNTE,NOTEOUT) ;MAP RESULTS FOR NOTES
|
||||
Q
|
||||
;
|
||||
MAP(NOTEXML,C0CNTE,NOTEOUT) ; MAP PROCEDURES XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"NOTETEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"NOTEBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,NOTEXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
D QUERY^C0CXPATH(NOTEXML,"//Comments/Comment","ZINNER") ;ONE NOTE
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CNTE@(ZI)) Q:ZI="" D ;FOR EACH NOTE
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS NOTE XML
|
||||
. S ZVAR=$NA(@C0CNTE@(ZI)) ;THIS NOTE VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
|
||||
. N ZNOTE,ZN
|
||||
. D CLEAN($NA(@C0CNTE@(ZI,"TEXT"))) ;REMOVE CONTROL CHARS AND XML RESERVED
|
||||
. M ZNOTE=@C0CNTE@(ZI,"TEXT") ;THE NOTE TO ADD TO THE BUILD
|
||||
. S ZNOTE(0)=$O(ZNOTE(""),-1) ;LENGTH OF THE NOTE
|
||||
. D INSERT^C0CXPATH(ZTMP,"ZNOTE","//Comment/Description/Text")
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,NOTEXML,@NOTEXML@(0),@NOTEXML@(0))
|
||||
N ZZTMP
|
||||
D BUILD^C0CXPATH(ZBLD,NOTEOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD,@C0CNTE
|
||||
Q
|
||||
;
|
||||
CLEAN(INARY) ; INARY IS PASSED BY NAME
|
||||
; REMOVE CONTROL CHARACTERS AND XML RESERVED SYMBOLS FROM THE ARRAY
|
||||
N ZI,ZJ S ZI=""
|
||||
F S ZI=$O(@INARY@(ZI)) Q:ZI="" D ;
|
||||
. S @INARY@(ZI)=$$CLEAN^C0CXPATH(@INARY@(ZI)) ; CONTROL CHARS
|
||||
. S @INARY@(ZI)=$$SYMENC^MXMLUTL(@INARY@(ZI)) ; XML RESERVED SYMBOLS
|
||||
Q
|
||||
;
|
||||
|
|
42
p/C0CCPT.m
42
p/C0CCPT.m
|
@ -1,5 +1,5 @@
|
|||
C0CCPT ;;BSL;RETURN CPT DATA;
|
||||
;Sequence Managers Software GPL
|
||||
;Sequence Managers Software GPL;;;;;Build 38
|
||||
;Copied into C0C namespace from SQMCPT with permission from
|
||||
;Brian Lord - and with our thanks. gpl 01/20/2010
|
||||
ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
|
||||
|
@ -8,27 +8,27 @@ ENTRY(DFN,STDT,ENDDT,TXT) ;BUILD TOTAL ARRAY OF ALL IEN'S FOR TIU NOTES
|
|||
;ENDDT=END DATE IN 3100101 FORMAT
|
||||
;TXT=INCLUDE TEXT FROM ENCOUNTER NOTE
|
||||
;THAT FALL INSIDE DATA RANGE. IF NO STDT OR ENDDT ASSUME
|
||||
;ALL INCLUSIVE IN THAT DIRECTION
|
||||
;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
|
||||
;BUILD INTO NOTE(Y)=""
|
||||
S U="^",X=""
|
||||
F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D
|
||||
. S Y=""
|
||||
. F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D
|
||||
.. S NOTE(Y)=""
|
||||
;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
|
||||
;GET DATE OF NOTE
|
||||
S Z=""
|
||||
F S Z=$O(NOTE(Z)) Q:Z="" D
|
||||
. S DT=$P(^TIU(8925,Z,0),U,7)
|
||||
. I $G(STDT)]"" D
|
||||
.. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED
|
||||
. I $G(ENDDT)]"" D
|
||||
.. I ENDDT<DT S NOTE(Z)="D"
|
||||
. I NOTE(Z)="D" K NOTE(Z)
|
||||
;ALL INCLUSIVE IN THAT DIRECTION
|
||||
;LIST OF TIU DOCS IN ^TIU(8925,"ACLPT",3,DFN)
|
||||
;BUILD INTO NOTE(Y)=""
|
||||
S U="^",X=""
|
||||
F S X=$O(^TIU(8925,"ACLPT",3,DFN,X)) Q:X="" D
|
||||
. S Y=""
|
||||
. F S Y=$O(^TIU(8925,"ACLPT",3,DFN,X,Y)) Q:Y="" D
|
||||
.. S NOTE(Y)=""
|
||||
;NOW DELETE ANY NOTES THAT DON'T FALL INTO DATE RANGE
|
||||
;GET DATE OF NOTE
|
||||
S Z=""
|
||||
F S Z=$O(NOTE(Z)) Q:Z="" D
|
||||
. S DT=$P(^TIU(8925,Z,0),U,7)
|
||||
. I $G(STDT)]"" D
|
||||
.. I STDT>DT S NOTE(Z)="D" ;SET NOTE TO BE DELETED
|
||||
. I $G(ENDDT)]"" D
|
||||
.. I ENDDT<DT S NOTE(Z)="D"
|
||||
. I NOTE(Z)="D" K NOTE(Z)
|
||||
D VISIT
|
||||
Q
|
||||
VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
|
||||
Q
|
||||
VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
|
||||
S ILST=1,X0="",X12="",VISIT="",LST="",X811=""
|
||||
S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D
|
||||
. S X0=^TIU(8925,IEN,0),X12=$G(^(12))
|
||||
|
|
78
p/C0CDOM.m
78
p/C0CDOM.m
|
@ -125,10 +125,11 @@ DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
|
|||
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
|
||||
Q
|
||||
;
|
||||
OUTXML(ZRTN,INID) ; 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
|
||||
D START^C0CMXMLB($$TAG(1),,"G")
|
||||
I '$D(NO1ST) S NO1ST=0 ; DO NOT SURPRESS THE <?xml tag generation
|
||||
D START^C0CMXMLB($$TAG(1),,"G",NO1ST)
|
||||
D NDOUT($$FIRST(1))
|
||||
D END^C0CMXMLB ;END THE DOCUMENT
|
||||
M @ZRTN=^TMP("MXMLBLD",$J)
|
||||
|
@ -157,6 +158,14 @@ WNHIN(ZDFN) ; WRITES THE XML OUTPUT OF GET^NHINV TO AN XML FILE
|
|||
W $$OUTPUT^C0CXPATH(GN2,"nhin_"_ZDFN_".xml","/home/wvehr3-09/")
|
||||
Q
|
||||
;
|
||||
NARY2XML(ZGOUT,ZGIN) ; CREATE XML FROM AN NHIN ARRAY
|
||||
; ZGOUT AND ZGIN ARE PASSED BY NAME
|
||||
N C0CDOCID
|
||||
W !,ZGOUT," ",ZGIN
|
||||
S C0CDOCID=$$DOMI(ZGIN) ; PUT IT INTO THE DOM
|
||||
D OUTXML(ZGOUT,C0CDOCID)
|
||||
Q
|
||||
;
|
||||
; EXAMPLE OF NHIN ARRAY FORMAT - THIS IS AN OUTPUT OF DOMO ABOVE WHEN RUN
|
||||
; AGAINST THE OUTPUT OF THE GET^NHINV ROUTINE. (THIS IS NOT REAL PATIENT DATA)
|
||||
;
|
||||
|
@ -216,36 +225,43 @@ DOMI(INARY,HANDLE,PARENT) ; EXTRINSIC TO INSERT NHIN ARRAYS TO A DOM
|
|||
S (SUCCESS,LEVEL,LEVEL(0),NODE)=0
|
||||
I '$D(INARY) Q 0 ; NO ARRAY PASSED
|
||||
I '$D(HANDLE) S HANDLE=$$NEWDOM() ; MAKE A NEW DOM
|
||||
;I PARENT="" S PARENT="root"
|
||||
I +$G(PARENT)>0 S ZPARNODE=PARENT ; WE HAVE BEEN PASSED A PARENT NODE ID
|
||||
E I $L(PARENT)>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
|
||||
E I $L($G(PARENT))>0 D ; TBD FIND THE PARENT IN THE DOM AND SET LEVEL
|
||||
. D STARTELE^MXMLDOM(PARENT) ; INSERT THE PARENT NODE
|
||||
. S ZPARNODE=1 ;
|
||||
; WE NOW HAVE A HANDLE AND A PARENT NODE AND LEVEL HAS BEEN SET
|
||||
D MAJOR(INARY,"",0) ; PROCESS ALL THE NODES TO BE ADDED
|
||||
I $L(PARENT)>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
|
||||
Q 1 ; SUCCESS
|
||||
N ZEXARY
|
||||
D EXPAND("ZEXARY",INARY) ; EXPAND THE NHIN ARRAY
|
||||
D MAJOR("ZEXARY") ; PROCESS ALL THE NODES TO BE ADDED
|
||||
I $L($G(PARENT))>0 D ENDELE^MXMLDOM(PARENT) ; CLOSE OUT THE PARENT NODE
|
||||
Q HANDLE ; SUCCESS
|
||||
;
|
||||
MAJOR(ZARY,ZTAG,ZNUM) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
|
||||
MAJOR(ZARY) ; RECURSIVE ROUTINE FOR INTERMEDIATE NODES
|
||||
N ZI S ZI=""
|
||||
N ZTAG
|
||||
F S ZI=$O(@ZARY@(ZI)) Q:ZI="" D ; FOR EACH SECTION
|
||||
. N ZELEADD S ZELEADD=0
|
||||
. I ZI["@" D ; END NODE HAS NO VALUE, ONLY ATTRIBUTES
|
||||
. . S ZTAG=$P(ZI,"@",1) ; PULL OUT THE TAG
|
||||
. . K ZATT ; CLEAR OUT LAST ONE
|
||||
. . M ZATT=@ZARY@(ZI,1) ; GET ATTRIBUTE ARRAY
|
||||
. . D STARTELE^MXMLDOM(ZTAG,.ZATT) ; ADD THE NODE
|
||||
. . S ZELEADD=1 ; FLAG TO NOT ADD THE ELEMENT TWICE
|
||||
. I $O(@ZARY@(ZI,""))="" D ;END NODE
|
||||
. . S ZTAG=ZI ; USE ZI FOR THE TAG
|
||||
. . I 'ZELEADD D STARTELE^MXMLDOM(ZTAG) ; ADD ELEMENT IF NOT THERE
|
||||
. . S ZELEADD=1 ; ADDED AN ELEMENT
|
||||
. . D CHAR^MXMLDOM($G(@ZARY@(ZI))) ; INSERT THE VALUE
|
||||
. I ZELEADD D Q ; NO MORE TO DO ON THIS LEVEL
|
||||
. . D ENDELE^MXMLDOM(ZTAG) ; CLOSE THE ELEMENT BEFORE LEAVING
|
||||
. N NEWARY ; INDENTED ARRAY
|
||||
. N ZN S ZN=0
|
||||
. F S ZN=$O(@ZARY@(ZI,ZN)) Q:ZN="" D ; FOR EACH MULTIPLE
|
||||
. . N ZS S ZS=""
|
||||
. . I $O(@ZARY@(ZI,ZN,ZS))'["." D ; END NODES HERE
|
||||
. . . N NEWARY
|
||||
. . . S NEWARY=$NA(@ZARY@(ZI,ZN))
|
||||
. . . D MINOR("NEWARY") ; INSERT THE END NODES
|
||||
. . E F S ZS=$O(@ZARY@(ZI,ZN,ZS)) Q:ZS="" D ; FOR EACH STRING
|
||||
. . . I ZS["." D ; INTERMEDIATE NODE FOUND
|
||||
. . . . W !,"IM:",ZS
|
||||
. . . W !,ZI,":",ZN,":",ZS_" : ",@ZARY@(ZI,ZN,ZS)
|
||||
Q
|
||||
;
|
||||
MINOR(ZINARY) ; DOES THE WORK FOR END NODES, HANDLES ATTRIBUTES
|
||||
;
|
||||
N ZZI S ZZI=""
|
||||
F S ZZI=$O(@ZINARY@(ZZI)) Q:ZZI="" D ;
|
||||
. W !,"MINOR",ZZI,":",@ZINARY@(ZZI)
|
||||
. . D STARTELE^MXMLDOM(ZI) ; ADD THE INTERMEDIATE TAG
|
||||
. . S NEWARY=$NA(@ZARY@(ZI,ZN)) ; INDENT THE ARRAY
|
||||
. . D MAJOR(NEWARY) ; RECURSE FOR INDENTED ARRAY
|
||||
. . D ENDELE^MXMLDOM(ZI) ; END THE INTERMEDIATE TAG
|
||||
Q
|
||||
;
|
||||
EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
|
||||
|
@ -267,6 +283,7 @@ EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
|
|||
. . . D PUSH^C0CXPATH("GA",ZZI_"^"_ZZN) ; PUSH PARENT
|
||||
. . . N ZZV ; PLACE TO STASH THE VALUE
|
||||
. . . S ZZV=@ZZIN@(ZZI,ZZN,ZZS) ; VALUE
|
||||
. . . W !,"VALUE:",ZZV
|
||||
. . . N GK ; COUNTER
|
||||
. . . F GK=1:1:$L(ZZS,".") D ; FOR EACH INTERMEDIATE NODE
|
||||
. . . . N ZZN2 S ZZN2=1 ; DEFAULT IF NO [X]
|
||||
|
@ -291,19 +308,6 @@ EXPAND(ZZOUT,ZZIN) ; EXPANDS NHIN ARRAY FORMAT TO AN EXPANDED
|
|||
. . . S @GZI2=ZZV ; REMEMBER THE VALUE?
|
||||
Q
|
||||
;
|
||||
POP(OSTR,ISTR) ; EXTRINSIC WHICH RETURNS TRUE IF ISTR IS EMPTY
|
||||
; IF ISTR IS NOT EMPTY, LOOKS FOR "." AND "@" AND RETURNS
|
||||
; xxx,1,yyyetc for xxx.yyyetc and xx@,1,yyy for xxx@yyyetc
|
||||
; OSTR IS PASSED BY REFERENCE AND CONTAINS yyyetc
|
||||
I $L(ISTR)=0 Q 1 ; WE ARE DONE
|
||||
N ZG,ZN,ZR
|
||||
S ZN=1
|
||||
I ISTR["." D ;
|
||||
. S ZG=$P(ISTR,".",1)
|
||||
. S OSTR=$P(ISTR,".",2)
|
||||
. S ZR=ZG_","_ZN_","_OSTR
|
||||
Q ZR
|
||||
;
|
||||
NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
|
||||
N CBK,SUCCESS,LEVEL,NODE,HANDLE
|
||||
K ^TMP("MXMLERR",$J)
|
||||
|
@ -313,5 +317,3 @@ NEWDOM() ; extrinsic which creates a new DOM and returns the HANDLE
|
|||
L -^TMP("MXMLDOM",$J)
|
||||
Q HANDLE
|
||||
;
|
||||
|
||||
|
||||
|
|
412
p/C0CDPT.m
412
p/C0CDPT.m
|
@ -1,269 +1,269 @@
|
|||
C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;
|
||||
; 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
; FAMILY Family Name
|
||||
; GIVEN Given Name
|
||||
; MIDDLE Middle Name
|
||||
; SUFFIX Suffix Name
|
||||
; DISPNAME Display Name
|
||||
; DOB Date of Birth
|
||||
; GENDER Get Gender
|
||||
; SSN Get SSN for ID
|
||||
; ADDRTYPE Get Home Address
|
||||
; ADDR1 Get Home Address line 1
|
||||
; ADDR2 Get Home Address line 2
|
||||
; CITY Get City for Home Address
|
||||
; STATE Get State for Home Address
|
||||
; ZIP Get Zip code for Home Address
|
||||
; COUNTY Get County for our Address
|
||||
; COUNTRY Get Country for our Address
|
||||
; RESTEL Residential Telephone
|
||||
; WORKTEL Work Telephone
|
||||
; EMAIL Email Adddress
|
||||
; CELLTEL Cell Phone
|
||||
; NOK1FAM Next of Kin 1 (NOK1) Family Name
|
||||
; NOK1GIV NOK1 Given Name
|
||||
; NOK1MID NOK1 Middle Name
|
||||
; NOK1SUF NOK1 Suffi Name
|
||||
; NOK1DISP NOK1 Display Name
|
||||
; NOK1REL NOK1 Relationship to the patient
|
||||
; NOK1ADD1 NOK1 Address 1
|
||||
; NOK1ADD2 NOK1 Address 2
|
||||
; NOK1CITY NOK1 City
|
||||
; NOK1STAT NOK1 State
|
||||
; NOK1ZIP NOK1 Zip Code
|
||||
; NOK1HTEL NOK1 Home Telephone
|
||||
; NOK1WTEL NOK1 Work Telephone
|
||||
; NOK1SAME Is NOK1's Address the same the patient?
|
||||
; NOK2FAM NOK2 Family Name
|
||||
; NOK2GIV NOK2 Given Name
|
||||
; NOK2MID NOK2 Middle Name
|
||||
; NOK2SUF NOK2 Suffi Name
|
||||
; NOK2DISP NOK2 Display Name
|
||||
; NOK2REL NOK2 Relationship to the patient
|
||||
; NOK2ADD1 NOK2 Address 1
|
||||
; NOK2ADD2 NOK2 Address 2
|
||||
; NOK2CITY NOK2 City
|
||||
; NOK2STAT NOK2 State
|
||||
; NOK2ZIP NOK2 Zip Code
|
||||
; NOK2HTEL NOK2 Home Telephone
|
||||
; NOK2WTEL NOK2 Work Telephone
|
||||
; NOK2SAME Is NOK2's Address the same the patient?
|
||||
; EMERFAM Emergency Contact (EMER) Family Name
|
||||
; EMERGIV EMER Given Name
|
||||
; EMERMID EMER Middle Name
|
||||
; EMERSUF EMER Suffi Name
|
||||
; EMERDISP EMER Display Name
|
||||
; EMERREL EMER Relationship to the patient
|
||||
; EMERADD1 EMER Address 1
|
||||
; EMERADD2 EMER Address 2
|
||||
; EMERCITY EMER City
|
||||
; EMERSTAT EMER State
|
||||
; EMERZIP EMER Zip Code
|
||||
; EMERHTEL EMER Home Telephone
|
||||
; EMERWTEL EMER Work Telephone
|
||||
; EMERSAME Is EMER's Address the same the NOK?
|
||||
;
|
||||
W "No Entry at top!" Q
|
||||
;
|
||||
;**Revision History**
|
||||
; - June 15, 08: v0.1 using merged global
|
||||
; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
|
||||
;
|
||||
; All methods are Public and Extrinsic
|
||||
; All calls use Fileman file 2 (Patient).
|
||||
; You can obtain field numbers using the data dictionary
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;
|
||||
; 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
; FAMILY Family Name
|
||||
; GIVEN Given Name
|
||||
; MIDDLE Middle Name
|
||||
; SUFFIX Suffix Name
|
||||
; DISPNAME Display Name
|
||||
; DOB Date of Birth
|
||||
; GENDER Get Gender
|
||||
; SSN Get SSN for ID
|
||||
; ADDRTYPE Get Home Address
|
||||
; ADDR1 Get Home Address line 1
|
||||
; ADDR2 Get Home Address line 2
|
||||
; CITY Get City for Home Address
|
||||
; STATE Get State for Home Address
|
||||
; ZIP Get Zip code for Home Address
|
||||
; COUNTY Get County for our Address
|
||||
; COUNTRY Get Country for our Address
|
||||
; RESTEL Residential Telephone
|
||||
; WORKTEL Work Telephone
|
||||
; EMAIL Email Adddress
|
||||
; CELLTEL Cell Phone
|
||||
; NOK1FAM Next of Kin 1 (NOK1) Family Name
|
||||
; NOK1GIV NOK1 Given Name
|
||||
; NOK1MID NOK1 Middle Name
|
||||
; NOK1SUF NOK1 Suffi Name
|
||||
; NOK1DISP NOK1 Display Name
|
||||
; NOK1REL NOK1 Relationship to the patient
|
||||
; NOK1ADD1 NOK1 Address 1
|
||||
; NOK1ADD2 NOK1 Address 2
|
||||
; NOK1CITY NOK1 City
|
||||
; NOK1STAT NOK1 State
|
||||
; NOK1ZIP NOK1 Zip Code
|
||||
; NOK1HTEL NOK1 Home Telephone
|
||||
; NOK1WTEL NOK1 Work Telephone
|
||||
; NOK1SAME Is NOK1's Address the same the patient?
|
||||
; NOK2FAM NOK2 Family Name
|
||||
; NOK2GIV NOK2 Given Name
|
||||
; NOK2MID NOK2 Middle Name
|
||||
; NOK2SUF NOK2 Suffi Name
|
||||
; NOK2DISP NOK2 Display Name
|
||||
; NOK2REL NOK2 Relationship to the patient
|
||||
; NOK2ADD1 NOK2 Address 1
|
||||
; NOK2ADD2 NOK2 Address 2
|
||||
; NOK2CITY NOK2 City
|
||||
; NOK2STAT NOK2 State
|
||||
; NOK2ZIP NOK2 Zip Code
|
||||
; NOK2HTEL NOK2 Home Telephone
|
||||
; NOK2WTEL NOK2 Work Telephone
|
||||
; NOK2SAME Is NOK2's Address the same the patient?
|
||||
; EMERFAM Emergency Contact (EMER) Family Name
|
||||
; EMERGIV EMER Given Name
|
||||
; EMERMID EMER Middle Name
|
||||
; EMERSUF EMER Suffi Name
|
||||
; EMERDISP EMER Display Name
|
||||
; EMERREL EMER Relationship to the patient
|
||||
; EMERADD1 EMER Address 1
|
||||
; EMERADD2 EMER Address 2
|
||||
; EMERCITY EMER City
|
||||
; EMERSTAT EMER State
|
||||
; EMERZIP EMER Zip Code
|
||||
; EMERHTEL EMER Home Telephone
|
||||
; EMERWTEL EMER Work Telephone
|
||||
; EMERSAME Is EMER's Address the same the NOK?
|
||||
;
|
||||
W "No Entry at top!" Q
|
||||
;
|
||||
;**Revision History**
|
||||
; - June 15, 08: v0.1 using merged global
|
||||
; - Oct 3, 08: v0.2 using fileman calls, many formatting changes.
|
||||
;
|
||||
; All methods are Public and Extrinsic
|
||||
; All calls use Fileman file 2 (Patient).
|
||||
; You can obtain field numbers using the data dictionary
|
||||
;
|
||||
FAMILY(DFN) ; Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
GIVEN(DFN) ; Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
MIDDLE(DFN) ; Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
SUFFIX(DFN) ; Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
DISPNAME(DFN) ; Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.01)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
DOB(DFN) ; Date of Birth
|
||||
N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
|
||||
; Date in FM Date Format. Convert to UTC/ISO 8601.
|
||||
Q $$FMDTOUTC^C0CUTIL(DOB,"D")
|
||||
N DOB S DOB=$$GET1^DIQ(2,DFN,.03,"I")
|
||||
; Date in FM Date Format. Convert to UTC/ISO 8601.
|
||||
Q $$FMDTOUTC^C0CUTIL(DOB,"D")
|
||||
GENDER(DFN) ; Gender/Sex
|
||||
Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
|
||||
Q $$GET1^DIQ(2,DFN,.02,"I")_"^"_$$GET1^DIQ(2,DFN,.02,"E") ;
|
||||
SSN(DFN) ; SSN
|
||||
Q $$GET1^DIQ(2,DFN,.09)
|
||||
Q $$GET1^DIQ(2,DFN,.09)
|
||||
ADDRTYPE(DFN) ; Address Type
|
||||
; Vista only stores a home address for the patient.
|
||||
Q "Home"
|
||||
; Vista only stores a home address for the patient.
|
||||
Q "Home"
|
||||
ADDR1(DFN) ; Get Home Address line 1
|
||||
Q $$GET1^DIQ(2,DFN,.111)
|
||||
Q $$GET1^DIQ(2,DFN,.111)
|
||||
ADDR2(DFN) ; Get Home Address line 2
|
||||
; Vista has Lines 2,3; CCR has only line 1,2; so compromise
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
; Vista has Lines 2,3; CCR has only line 1,2; so compromise
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.112),ADDLN3=$$GET1^DIQ(2,DFN,.113)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
CITY(DFN) ; Get City for Home Address
|
||||
Q $$GET1^DIQ(2,DFN,.114)
|
||||
Q $$GET1^DIQ(2,DFN,.114)
|
||||
STATE(DFN) ; Get State for Home Address
|
||||
Q $$GET1^DIQ(2,DFN,.115)
|
||||
Q $$GET1^DIQ(2,DFN,.115)
|
||||
ZIP(DFN) ; Get Zip code for Home Address
|
||||
Q $$GET1^DIQ(2,DFN,.116)
|
||||
Q $$GET1^DIQ(2,DFN,.116)
|
||||
COUNTY(DFN) ; Get County for our Address
|
||||
Q $$GET1^DIQ(2,DFN,.117)
|
||||
Q $$GET1^DIQ(2,DFN,.117)
|
||||
COUNTRY(DFN) ; Get Country for our Address
|
||||
; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
|
||||
Q "USA"
|
||||
; Unfortunately, it's not stored anywhere in Vista, so the inevitable...
|
||||
Q "USA"
|
||||
RESTEL(DFN) ; Residential Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.131)
|
||||
Q $$GET1^DIQ(2,DFN,.131)
|
||||
WORKTEL(DFN) ; Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.132)
|
||||
Q $$GET1^DIQ(2,DFN,.132)
|
||||
EMAIL(DFN) ; Email Adddress
|
||||
Q $$GET1^DIQ(2,DFN,.133)
|
||||
Q $$GET1^DIQ(2,DFN,.133)
|
||||
CELLTEL(DFN) ; Cell Phone
|
||||
Q $$GET1^DIQ(2,DFN,.134)
|
||||
Q $$GET1^DIQ(2,DFN,.134)
|
||||
NOK1FAM(DFN) ; Next of Kin 1 (NOK1) Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
NOK1GIV(DFN) ; NOK1 Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
NOK1MID(DFN) ; NOK1 Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
NOK1SUF(DFN) ; NOK1 Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
NOK1DISP(DFN) ; NOK1 Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.211)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
NOK1REL(DFN) ; NOK1 Relationship to the patient
|
||||
Q $$GET1^DIQ(2,DFN,.212)
|
||||
Q $$GET1^DIQ(2,DFN,.212)
|
||||
NOK1ADD1(DFN) ; NOK1 Address 1
|
||||
Q $$GET1^DIQ(2,DFN,.213)
|
||||
Q $$GET1^DIQ(2,DFN,.213)
|
||||
NOK1ADD2(DFN) ; NOK1 Address 2
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.214),ADDLN3=$$GET1^DIQ(2,DFN,.215)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
NOK1CITY(DFN) ; NOK1 City
|
||||
Q $$GET1^DIQ(2,DFN,.216)
|
||||
Q $$GET1^DIQ(2,DFN,.216)
|
||||
NOK1STAT(DFN) ; NOK1 State
|
||||
Q $$GET1^DIQ(2,DFN,.217)
|
||||
Q $$GET1^DIQ(2,DFN,.217)
|
||||
NOK1ZIP(DFN) ; NOK1 Zip Code
|
||||
Q $$GET1^DIQ(2,DFN,.218)
|
||||
Q $$GET1^DIQ(2,DFN,.218)
|
||||
NOK1HTEL(DFN) ; NOK1 Home Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.219)
|
||||
Q $$GET1^DIQ(2,DFN,.219)
|
||||
NOK1WTEL(DFN) ; NOK1 Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.21011)
|
||||
Q $$GET1^DIQ(2,DFN,.21011)
|
||||
NOK1SAME(DFN) ; Is NOK1's Address the same the patient?
|
||||
Q $$GET1^DIQ(2,DFN,.2125)
|
||||
Q $$GET1^DIQ(2,DFN,.2125)
|
||||
NOK2FAM(DFN) ; NOK2 Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
NOK2GIV(DFN) ; NOK2 Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
NOK2MID(DFN) ; NOK2 Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
NOK2SUF(DFN) ; NOK2 Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
NOK2DISP(DFN) ; NOK2 Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.2191)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
NOK2REL(DFN) ; NOK2 Relationship to the patient
|
||||
Q $$GET1^DIQ(2,DFN,.2192)
|
||||
Q $$GET1^DIQ(2,DFN,.2192)
|
||||
NOK2ADD1(DFN) ; NOK2 Address 1
|
||||
Q $$GET1^DIQ(2,DFN,.2193)
|
||||
Q $$GET1^DIQ(2,DFN,.2193)
|
||||
NOK2ADD2(DFN) ; NOK2 Address 2
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.2194),ADDLN3=$$GET1^DIQ(2,DFN,.2195)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
NOK2CITY(DFN) ; NOK2 City
|
||||
Q $$GET1^DIQ(2,DFN,.2196)
|
||||
Q $$GET1^DIQ(2,DFN,.2196)
|
||||
NOK2STAT(DFN) ; NOK2 State
|
||||
Q $$GET1^DIQ(2,DFN,.2197)
|
||||
Q $$GET1^DIQ(2,DFN,.2197)
|
||||
NOK2ZIP(DFN) ; NOK2 Zip Code
|
||||
Q $$GET1^DIQ(2,DFN,.2198)
|
||||
Q $$GET1^DIQ(2,DFN,.2198)
|
||||
NOK2HTEL(DFN) ; NOK2 Home Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.2199)
|
||||
Q $$GET1^DIQ(2,DFN,.2199)
|
||||
NOK2WTEL(DFN) ; NOK2 Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.211011)
|
||||
Q $$GET1^DIQ(2,DFN,.211011)
|
||||
NOK2SAME(DFN) ; Is NOK2's Address the same the patient?
|
||||
Q $$GET1^DIQ(2,DFN,.21925)
|
||||
Q $$GET1^DIQ(2,DFN,.21925)
|
||||
EMERFAM(DFN) ; Emergency Contact (EMER) Family Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
EMERGIV(DFN) ; EMER Given Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
EMERMID(DFN) ; EMER Middle Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
EMERSUF(DFN) ; EMER Suffi Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
EMERDISP(DFN) ; EMER Display Name
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
N NAME S NAME=$$GET1^DIQ(2,DFN,.331)
|
||||
; "G" is Given Name First; "MXc" is Mixed Case, With Suffx Preceded by Comma
|
||||
Q $$NAMEFMT^XLFNAME(.NAME,"G","MXc")
|
||||
EMERREL(DFN) ; EMER Relationship to the patient
|
||||
Q $$GET1^DIQ(2,DFN,.331)
|
||||
Q $$GET1^DIQ(2,DFN,.331)
|
||||
EMERADD1(DFN) ; EMER Address 1
|
||||
Q $$GET1^DIQ(2,DFN,.333)
|
||||
Q $$GET1^DIQ(2,DFN,.333)
|
||||
EMERADD2(DFN) ; EMER Address 2
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
N ADDLN2,ADDLN3
|
||||
S ADDLN2=$$GET1^DIQ(2,DFN,.334),ADDLN3=$$GET1^DIQ(2,DFN,.335)
|
||||
Q:ADDLN3="" ADDLN2
|
||||
Q ADDLN2_", "_ADDLN3
|
||||
EMERCITY(DFN) ; EMER City
|
||||
Q $$GET1^DIQ(2,DFN,.336)
|
||||
Q $$GET1^DIQ(2,DFN,.336)
|
||||
EMERSTAT(DFN) ; EMER State
|
||||
Q $$GET1^DIQ(2,DFN,.337)
|
||||
Q $$GET1^DIQ(2,DFN,.337)
|
||||
EMERZIP(DFN) ; EMER Zip Code
|
||||
Q $$GET1^DIQ(2,DFN,.338)
|
||||
Q $$GET1^DIQ(2,DFN,.338)
|
||||
EMERHTEL(DFN) ; EMER Home Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.339)
|
||||
Q $$GET1^DIQ(2,DFN,.339)
|
||||
EMERWTEL(DFN) ; EMER Work Telephone
|
||||
Q $$GET1^DIQ(2,DFN,.33011)
|
||||
Q $$GET1^DIQ(2,DFN,.33011)
|
||||
EMERSAME(DFN) ; Is EMER's Address the same the NOK?
|
||||
Q $$GET1^DIQ(2,DFN,.3305)
|
||||
Q $$GET1^DIQ(2,DFN,.3305)
|
||||
|
|
378
p/C0CENC.m
378
p/C0CENC.m
|
@ -1,189 +1,189 @@
|
|||
C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
|
||||
;;1.0;C0C;;May 21, 2010;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO XML TEMPLATE
|
||||
; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
|
||||
;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
|
||||
K @C0CENC
|
||||
D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
|
||||
D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
|
||||
Q
|
||||
;
|
||||
TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
|
||||
; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
|
||||
; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
|
||||
;
|
||||
;K VISIT,LST,NOTE
|
||||
I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE
|
||||
I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE
|
||||
; NEED TO ADD START AND END DATES FROM PARAMETERS
|
||||
N ZI S ZI=""
|
||||
N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
|
||||
F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST
|
||||
. N ZDATE
|
||||
. S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
|
||||
. S ZPRVARY=$NA(VISIT(ZI,"PRV"))
|
||||
. N ZPRV
|
||||
. S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
|
||||
. ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
|
||||
. ; ENCOBJECTID - ENCOUNTER OBJECT ID
|
||||
. ; ENCDATETIME - ENCOUNTER DATE TIME
|
||||
. ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)
|
||||
. ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE
|
||||
. ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4
|
||||
. ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT
|
||||
. ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE
|
||||
. ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM
|
||||
. ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID
|
||||
. ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID
|
||||
. ; ENCINDTXT - ENCOUNTER INDICATION TEXT
|
||||
. ; ENCINDCODE - ENCOUNTER INDICATION CODE
|
||||
. ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM
|
||||
. ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID
|
||||
. ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION
|
||||
. S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI
|
||||
. S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME
|
||||
. S ZRNF("ENCTYPETXT")=""
|
||||
. S ZRNF("ENCTYPECODE")=""
|
||||
. S ZRNF("ENCTYPECODESYS")=""
|
||||
. S ZRNF("ENCDESCTXT")=""
|
||||
. S ZRNF("ENCDESCCODE")=""
|
||||
. S ZRNF("ENCDESCCODESYS")=""
|
||||
. N TYPTXT,TYPCDE,TYPSYS ; WILL BE UPDATED BY GETTYPE CALL
|
||||
. I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D ; RETURNS FALSE IF NO TYPE
|
||||
. . S ZRNF("ENCTYPETXT")=TYPTXT
|
||||
. . S ZRNF("ENCTYPECODE")=TYPCDE
|
||||
. . S ZRNF("ENCTYPECODESYS")=TYPSYS
|
||||
. . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE
|
||||
. . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)
|
||||
. . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA
|
||||
. S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"
|
||||
. S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER
|
||||
. S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE
|
||||
. S ZRNF("ENCINDCODE")=""
|
||||
. S ZRNF("ENCINDCODESYS")=""
|
||||
. S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER
|
||||
. S ZRNF("ENCCOMMENTID")=""
|
||||
. I $G(VISIT(ZI,"TEXT",1))'="" D ; THERE IS A NOTE
|
||||
. . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE
|
||||
. . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI
|
||||
. . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE
|
||||
. . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE
|
||||
. . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER
|
||||
. D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
|
||||
. ;S PREVCPT=ZCPT
|
||||
. ;S PREVDT=ZDATE
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))
|
||||
M @ZRIM=@C0CENC@("V")
|
||||
K VISIT,LST,NOTE
|
||||
Q
|
||||
;
|
||||
GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE
|
||||
; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE
|
||||
; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM
|
||||
; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE
|
||||
; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
|
||||
N ZS,ZC
|
||||
S ZC="" S ZS=""
|
||||
S (ZTXT,ZCDE,ZSYS)=""
|
||||
F S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC="" D ; TRY AND FIND A "99" CPT CODE
|
||||
. N ZT
|
||||
. S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
|
||||
. I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
|
||||
I ZS'="" D ; CODED ENCOUNTER TYPE FOUND
|
||||
. S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
|
||||
. S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
|
||||
. S ZSYS=""
|
||||
. I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
|
||||
I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
|
||||
I ZTXT="" Q 0 ; FAILED
|
||||
W !,ZTXT
|
||||
Q 1 ; SUCCESS
|
||||
;
|
||||
ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
|
||||
; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
|
||||
; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
|
||||
; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
|
||||
N ZK,ZL
|
||||
S ZK="" S ZL=""
|
||||
F S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK="" D ; LOOK FOR SOME TEXT TO USE
|
||||
. N ZT
|
||||
. S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE
|
||||
. I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3)
|
||||
. ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
|
||||
I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
|
||||
Q ZL
|
||||
;
|
||||
PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
|
||||
N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG
|
||||
. I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER
|
||||
. I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
|
||||
I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
|
||||
Q ZRTN
|
||||
;
|
||||
DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
|
||||
Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
|
||||
;
|
||||
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
||||
; CPT^CATEGORY^TEXT
|
||||
N Z1,Z2,Z3,ZRTN
|
||||
S Z1=$P(ISTR,U,1)
|
||||
I Z1="" D ;
|
||||
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
||||
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
||||
. ;S Z1=$P(ISTR,U,1)
|
||||
. S Z2=$P(ISTR,U,2)
|
||||
. S Z3=$P(ISTR,U,3)
|
||||
. S ZRTN=Z1_U_Z2_U_Z3
|
||||
E S ZRTN=""
|
||||
Q ZRTN
|
||||
;
|
||||
MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CENC@("V",ZI)) Q:ZI="" D ;FOR EACH ENCOUNTER
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML
|
||||
. S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))
|
||||
N ZZTMP
|
||||
D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD,@C0CENC
|
||||
Q
|
||||
;
|
||||
C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
|
||||
;;1.0;C0C;;May 21, 2010;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(ENCXML,DFN,ENCOUT) ; EXTRACT ENCOUNTERS INTO XML TEMPLATE
|
||||
; ENCXML AND ENCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
D SETVARS^C0CPROC ; SET UP VARIABLES FOR PROCEDUCRES, ENCOUNTERS, AND NOTES
|
||||
;I '$D(@C0CENC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
|
||||
K @C0CENC
|
||||
D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET ENCOUNTERS
|
||||
D MAP(ENCXML,C0CENC,ENCOUT) ;MAP RESULTS FOR ENCOUNTERS
|
||||
Q
|
||||
;
|
||||
TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
|
||||
; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
|
||||
; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
|
||||
;
|
||||
;K VISIT,LST,NOTE
|
||||
I '$D(C0CPRC) D SETVARS^C0CPROC ; INITIALIZE WORK AREAS IF NOT ALREADY THERE
|
||||
I '$D(VISIT) D ENTRY^C0CCPT(DFN,,,1) ; RETURNS VISIT LOCAL VARIABLE
|
||||
; NEED TO ADD START AND END DATES FROM PARAMETERS
|
||||
N ZI S ZI=""
|
||||
N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
|
||||
F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST
|
||||
. N ZDATE
|
||||
. S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
|
||||
. S ZPRVARY=$NA(VISIT(ZI,"PRV"))
|
||||
. N ZPRV
|
||||
. S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
|
||||
. ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
|
||||
. ; ENCOBJECTID - ENCOUNTER OBJECT ID
|
||||
. ; ENCDATETIME - ENCOUNTER DATE TIME
|
||||
. ; ENCTYPETXT - ENCOUNTER TYPE (PLANNING TO USE ADMINISTRATIVE CPT IF AVAIL)
|
||||
. ; ENCTYPECODE - CODE OF TYPE - PLANNING CPT CODE
|
||||
. ; ENCTYPECODESYS - CODING SYSTEM OF TYPE - CPT-4
|
||||
. ; ENCDESCTXT - ENCOUNTER DESCRIPTION TEXT
|
||||
. ; ENCDESCCODE - ENCOUNTER DESCRIPTION CODE
|
||||
. ; ENCDESCCODESYS - ENCOUNTER DESCRIPTION CODE SYSTEM
|
||||
. ; ENCLOCACTORID - ENCOUNTER LOCATION ACTOR ID
|
||||
. ; ENCPRVACTORID - ENCOUNTER PRACTIONER ACTOR ID
|
||||
. ; ENCINDTXT - ENCOUNTER INDICATION TEXT
|
||||
. ; ENCINDCODE - ENCOUNTER INDICATION CODE
|
||||
. ; ENCINDCODESYS - ENCOUNTER INDICATION CODE SYSTEM
|
||||
. ; ENCACTORID - ENCOUNTER SOURCE ACTOR ID
|
||||
. ; ENCCOMMENTID - ENCOUNTER COMMENT ID - POINTER TO NOTE IN COMMENT SECTION
|
||||
. S ZRNF("ENCOBJECTID")="ENCOUNTER_"_ZI
|
||||
. S ZRNF("ENCDATETIME")=ZDATE ; ENCOUNTER DATE TIME
|
||||
. S ZRNF("ENCTYPETXT")=""
|
||||
. S ZRNF("ENCTYPECODE")=""
|
||||
. S ZRNF("ENCTYPECODESYS")=""
|
||||
. S ZRNF("ENCDESCTXT")=""
|
||||
. S ZRNF("ENCDESCCODE")=""
|
||||
. S ZRNF("ENCDESCCODESYS")=""
|
||||
. N TYPTXT,TYPCDE,TYPSYS ; WILL BE UPDATED BY GETTYPE CALL
|
||||
. I $$GETTYPE("VISIT(ZI)",.TYPTXT,.TYPCDE,.TYPSYS) D ; RETURNS FALSE IF NO TYPE
|
||||
. . S ZRNF("ENCTYPETXT")=TYPTXT
|
||||
. . S ZRNF("ENCTYPECODE")=TYPCDE
|
||||
. . S ZRNF("ENCTYPECODESYS")=TYPSYS
|
||||
. . S ZRNF("ENCDESCTXT")=TYPTXT ; FOR NOW, DESCRIPTION IS SAME AS TYPE
|
||||
. . S ZRNF("ENCDESCCODE")=TYPCDE ; DESCRIPTION IS REQUIRED (TYPE IS NOT)
|
||||
. . S ZRNF("ENCDESCCODESYS")=TYPSYS ; NEED TO CLARIFY FOR VISTA
|
||||
. S ZRNF("ENCLOCACTORID")="ACTORORGANIZATION_1"
|
||||
. S ZRNF("ENCPRVACTORID")=ZPRV ; PRIMARY PROVIDER LISTED FOR THE ENCOUNTER
|
||||
. S ZRNF("ENCINDTXT")="" ; WE WILL PUT POINTERS TO PROBLEMS HERE
|
||||
. S ZRNF("ENCINDCODE")=""
|
||||
. S ZRNF("ENCINDCODESYS")=""
|
||||
. S ZRNF("ENCACTORID")=ZPRV ; SOURCE WILL BE PRIMARY PROVIDER
|
||||
. S ZRNF("ENCCOMMENTID")=""
|
||||
. I $G(VISIT(ZI,"TEXT",1))'="" D ; THERE IS A NOTE
|
||||
. . M @C0CNTE@(ZI,"TEXT")=VISIT(ZI,"TEXT") ; COPY THE TEXT OF THE NOTE
|
||||
. . S @C0CNTE@(ZI,"COMMENTOBJECTID")="NOTE_"_ZI
|
||||
. . S @C0CNTE@(ZI,"CMTDATETIME")=ZDATE ; DATE OF THE NOTE
|
||||
. . S @C0CNTE@(ZI,"ACTORSOURCEID")=ZPRV ; SOURCE OF THE NOTE
|
||||
. . S ZRNF("ENCCOMMENTID")="NOTE_"_ZI ; POINT TO THE NOTE FROM THE ENCOUNTER
|
||||
. D RNF1TO2^C0CRNF(C0CENC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
|
||||
. ;S PREVCPT=ZCPT
|
||||
. ;S PREVDT=ZDATE
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"ENCOUNTERS"))
|
||||
M @ZRIM=@C0CENC@("V")
|
||||
K VISIT,LST,NOTE
|
||||
Q
|
||||
;
|
||||
GETTYPE(ZARY,ZTXT,ZCDE,ZSYS) ; EXTRINSIC WHICH RETURNS FALSE IF NO ENCOUNTER TYPE
|
||||
; UPDATES ZTXT WITH ENCOUNTER TYPE TEXT, ZCDE WITH ENCOUNTER TYPE CODE
|
||||
; AND ZSYS WITH ENCOUNTER TYPE CODING SYSTEM
|
||||
; THIS ROUTINE SHOULD BE UPDATED TO SEARCH FOR AN ADMINISTRATIVE CPT CODE
|
||||
; INSTEAD OF JUST THE FIRST ONE IN THE LIST - GPL 1/23/10
|
||||
N ZS,ZC
|
||||
S ZC="" S ZS=""
|
||||
S (ZTXT,ZCDE,ZSYS)=""
|
||||
F S ZC=$O(@ZARY@("CPT",ZC)) Q:ZC="" D ; TRY AND FIND A "99" CPT CODE
|
||||
. N ZT
|
||||
. S ZT=$$CPT^C0CPROC(@ZARY@("CPT",ZC)) ; VALUES IN A CPT MULTIPLE
|
||||
. I $E($P(ZT,U,1),1,2)="99" S ZS=ZT ; IS IT AN ADMIN CPT CODE?
|
||||
I ZS'="" D ; CODED ENCOUNTER TYPE FOUND
|
||||
. S ZTXT=$P(ZS,U,2)_" "_$P(ZS,U,3) ; USE BOTH PIECES FOR THE TYPE
|
||||
. S ZCDE=$P($$CPT^C0CPROC(ZS),U,1) ; CPT CODE FOR ENCOUTER
|
||||
. S ZSYS=""
|
||||
. I ZCDE'="" S ZSYS="CPT-4" ; ONLY HAVE A CODING SYSTEM IF THERE IS A CODE
|
||||
I ZS="" S ZTXT=$$ANYTXT(ZARY) ; TRY AND GET FREE FORM TEXT FROM CPT MULTIPLES
|
||||
I ZTXT="" Q 0 ; FAILED
|
||||
W !,ZTXT
|
||||
Q 1 ; SUCCESS
|
||||
;
|
||||
ANYTXT(ZVST) ; EXTRINSIC WHICH RETURNS TEXT FROM THE CPT MULTIPLE
|
||||
; OF A VISIT ARRAY WITHOUT CHECKING THE CPT CODE (THAT HAVING FAILED)
|
||||
; ZVST IS THE VISIT ARRAY AND IS PASSED BY NAME
|
||||
; RETURNS TEXT TO USE AS ENCOUNTER TYPE IF ANY
|
||||
N ZK,ZL
|
||||
S ZK="" S ZL=""
|
||||
F S ZK=$O(@ZVST@("CPT",ZK)) Q:ZK="" D ; LOOK FOR SOME TEXT TO USE
|
||||
. N ZT
|
||||
. S ZT=$G(@ZVST@("CPT",ZK)) ; LOOK AT THIS CPT MULTIPLE
|
||||
. I $P(ZT,U,2)_" "_$P(ZT,U,3)'=" " S ZL=$P(ZT,U,2)_" "_$P(ZT,U,3)
|
||||
. ; CONCATENATE PIECE 2 AND 3 OF THE CPT MULTIPLE FOR A TYPE
|
||||
I ZL="" S ZL=$G(@ZVST@("CLASS")) ; USE THE NOTE DOCUMENT CLASS FOR ENCOUTNER TYPE
|
||||
Q ZL
|
||||
;
|
||||
PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
|
||||
N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG
|
||||
. I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER
|
||||
. I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
|
||||
I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
|
||||
Q ZRTN
|
||||
;
|
||||
DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
|
||||
Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
|
||||
;
|
||||
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
||||
; CPT^CATEGORY^TEXT
|
||||
N Z1,Z2,Z3,ZRTN
|
||||
S Z1=$P(ISTR,U,1)
|
||||
I Z1="" D ;
|
||||
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
||||
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
||||
. ;S Z1=$P(ISTR,U,1)
|
||||
. S Z2=$P(ISTR,U,2)
|
||||
. S Z3=$P(ISTR,U,3)
|
||||
. S ZRTN=Z1_U_Z2_U_Z3
|
||||
E S ZRTN=""
|
||||
Q ZRTN
|
||||
;
|
||||
MAP(ENCXML,C0CENC,ENCOUT) ; MAP PROCEDURES XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"ENCTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"ENCBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,ENCXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
D QUERY^C0CXPATH(ENCXML,"//Encounters/Encounter","ZINNER") ;ONE ENCOUNTER
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CENC@("V",ZI)) Q:ZI="" D ;FOR EACH ENCOUNTER
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS ENCOUNTER XML
|
||||
. S ZVAR=$NA(@C0CENC@("V",ZI)) ;THIS ENCOUNTER VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,ENCXML,@ENCXML@(0),@ENCXML@(0))
|
||||
N ZZTMP
|
||||
D BUILD^C0CXPATH(ZBLD,ENCOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD,@C0CENC
|
||||
Q
|
||||
;
|
||||
|
|
|
@ -0,0 +1,177 @@
|
|||
C0CEVC ; CCDCCR/GPL - SUPPORT FOR EWD VISTCOM PAGES ; 3/1/2010
|
||||
;;1.0;C0C;;Mar 1, 2010;
|
||||
gpltest2 ; experiment with sending a CCR to an ewd page
|
||||
N ZI
|
||||
S ZI=""
|
||||
D PSEUDO
|
||||
N ZIO
|
||||
S ZIO=IO
|
||||
S IO="/dev/null"
|
||||
OPEN IO
|
||||
U IO
|
||||
N G
|
||||
S G=$$URLTOKEN^C0CEWD
|
||||
D CCRRPC^C0CCCR(.GPL,2)
|
||||
S IO=ZIO
|
||||
OPEN IO
|
||||
U IO
|
||||
K GPL(0)
|
||||
F S ZI=$O(GPL(ZI)) Q:ZI="" W GPL(ZI),!
|
||||
Q
|
||||
;
|
||||
gpltest ; experiment with sending a CCR to an ewd page
|
||||
N ZI
|
||||
S ZI=""
|
||||
K ^GPL(0)
|
||||
S ^GPL(2)="<?xml-stylesheet type=""text/xsl"" href=""/resources/ccr.xsl""?>"
|
||||
F S ZI=$O(^GPL(ZI)) Q:ZI="" W ^GPL(ZI),!
|
||||
Q
|
||||
;
|
||||
TEST(sessid);
|
||||
d setSessionValue^%zewdAPI("person.Name","Rob",sessid)
|
||||
d setSessionValue^%zewdAPI("person.DateOfBirth","13/06/55",sessid)
|
||||
d setSessionValue^%zewdAPI("person.Address.PostCode","SW1 3QA",sessid)
|
||||
d setSessionValue^%zewdAPI("person.Address.Line1","1 The Street",sessid)
|
||||
d setSessionValue^%zewdAPI("person.Address.2.hello","world",sessid)
|
||||
d setJSONValue^%zewdAPI("json","person",sessid)
|
||||
Q ""
|
||||
|
||||
PARSE(INXML,INDOC) ;CALL THE EWD PARSER ON INXML, PASSED BY NAME
|
||||
; INDOC IS PASSED AS THE DOCUMENT NAME TO EWD
|
||||
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY EWD
|
||||
N ZR
|
||||
M ^CacheTempEWD($j)=@INXML ;
|
||||
S ZR=$$parseDocument^%zewdHTMLParser(INDOC)
|
||||
Q ZR
|
||||
;
|
||||
TEST2(sessid) ; try to put a ccr in the session
|
||||
S U="^"
|
||||
D PSEUDO ; FAKE LOGIN
|
||||
S ZIO=$IO
|
||||
S DEV="/dev/null"
|
||||
O DEV U DEV
|
||||
N G
|
||||
N ZDFN
|
||||
S ZDFN=$$getSessionValue^%zewdAPI("vista.dfn",sessid)
|
||||
I ZDFN="" S ZDFN=2
|
||||
;K ^TMP("GPL")
|
||||
;M ^TMP("GPL")=^%zewdSession("session",sessid)
|
||||
D CCRRPC^C0CCCR(.GPL,ZDFN)
|
||||
K GPL(0)
|
||||
S GPL(2)="<?xml-stylesheet type=""text/xsl"" href=""/resources/ccr.xsl""?>"
|
||||
C DEV U ZIO
|
||||
;M ^CacheTempEWD($j)=GPL
|
||||
S DOCNAME="CCR"
|
||||
;ZWR GPL
|
||||
;S ZR=$$parseDocument^%zewdHTMLParser(DOCNAME)
|
||||
;d setSessionValues^%zewdAPI(DOCNAME,GPL,sessid)
|
||||
d mergeArrayToSession^%zewdAPI(.GPL,DOCNAME,sessid)
|
||||
Q ""
|
||||
;
|
||||
INITSES(sessid) ;initialize an EWD/CPRS session
|
||||
K ^TMP("GPL")
|
||||
;M ^TMP("GPL")=^%zewdSession("session",sessid)
|
||||
N ZT,ZDFN
|
||||
S ZT=$$URLTOKEN^C0CEWD(sessid)
|
||||
;S ^TMP("GPL")=ZT
|
||||
d trace^%zewdAPI("*********************ZT="_ZT)
|
||||
S ZDFN=$$PRSEORTK(ZT) ; PARSE THE TOKEN AND LOOK UP THE DFN
|
||||
S ^TMP("GPL","DFN")=ZDFN
|
||||
I ZDFN=0 S DFN=2 ; DEFAULT TEST PATIENT
|
||||
D setSessionValue^%zewdAPI("vista.dfn",ZDFN,sessid)
|
||||
;M ^TMP("GPL","request")=requestArray
|
||||
;D PSEUDO
|
||||
;D ^%ZTER
|
||||
q ""
|
||||
;
|
||||
PRSEORTK(ZTOKEN) ;PARSES THE TOKEN SENT BY CPRS AND RETURNS THE DFN
|
||||
; OF THE PATIENT ; HERE'S WHAT THE TOKEN LOOKS LIKE:
|
||||
; ^TMP('ORWCHART',6547,'192.168.169.8',002E0FE6)
|
||||
N ZX,ZN1,ZIP,ZN2,ZDFN,ZG
|
||||
S ZDFN=0 ; DEFAULT RETURN
|
||||
S ZN1=$P(ZTOKEN,",",2) ; FIRST NUMBER
|
||||
S ZIP=$P(ZTOKEN,",",3) ; IP NUMBER
|
||||
S ZIP=$P(ZIP,"'",2) ; GET RID OF '
|
||||
S ZN2=$P(ZTOKEN,",",4) ; SECOND NUMBER
|
||||
S ZN2=$P(ZN2,")",1) ; GET RID OF )
|
||||
S ZG=$NA(^TMP("ORWCHART",ZN1,ZIP,ZN2)) ; BUILD THE GLOBAL NAME
|
||||
I $G(@ZG)'="" S ZDFN=@ZG ; ACCESS THE GLOBAL
|
||||
S ^TMP("GPL","FIRSTDFN")=ZDFN
|
||||
S ^TMP("GPL","FIRSTGLB")=ZG
|
||||
Q ZDFN
|
||||
;
|
||||
GETPATIENTLIST(sessid) ;
|
||||
D PSEUDO
|
||||
D LISTALL^ORWPT(.RTN,"NAME","1")
|
||||
N ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(RTN(ZI)) Q:ZI="" D ;
|
||||
. S data(ZI,"DFN")=$P(RTN(ZI),"^",1)
|
||||
. S data(ZI,"Name")=$P(RTN(ZI),"^",2)
|
||||
; ZWR data
|
||||
;S data(1,"DFN")=$P(RTN(1),"^",1)
|
||||
;S data(1,"Name")=$P(RTN(1),"^",2)
|
||||
d deleteFromSession^%zewdAPI("patients",sessid)
|
||||
d createDataTableStore^%zewdYUIRuntime(.data,"patients",sessid)
|
||||
;d mergeArrayToSession^%zewdAPI(.data,"patients",sessid)
|
||||
Q ""
|
||||
;
|
||||
PSEUDO
|
||||
S U="^"
|
||||
S DILOCKTM=3
|
||||
S DISYS=19
|
||||
S DT=3100219
|
||||
S DTIME=999
|
||||
S DUZ=10
|
||||
S DUZ(0)="@"
|
||||
S DUZ(1)=""
|
||||
S DUZ(2)=1
|
||||
S DUZ("AG")="V"
|
||||
S DUZ("BUF")=1
|
||||
S DUZ("LANG")=""
|
||||
;S IO="/dev/pts/2"
|
||||
;S IO(0)="/dev/pts/2"
|
||||
;S IO(1,"/dev/pts/2")=""
|
||||
;S IO("ERROR")=""
|
||||
;S IO("HOME")="41^/dev/pts/2"
|
||||
;S IO("ZIO")="/dev/pts/2"
|
||||
;S IOBS="$C(8)"
|
||||
;S IOF="#,$C(27,91,50,74,27,91,72)"
|
||||
;S SIOM=80
|
||||
Q
|
||||
;
|
||||
PSEUDO2 ; FAKE LOGIN SETS SOME LOCAL VARIABLE TO FOOL FILEMAN
|
||||
S DILOCKTM=3
|
||||
S DISYS=19
|
||||
S DT=3100112
|
||||
S DTIME=9999
|
||||
S DUZ=10000000020
|
||||
S DUZ(0)="@"
|
||||
S DUZ(1)=""
|
||||
S DUZ(2)=67
|
||||
S DUZ("AG")="E"
|
||||
S DUZ("BUF")=1
|
||||
S DUZ("LANG")=1
|
||||
S IO="/dev/pts/0"
|
||||
;S IO(0)="/dev/pts/0"
|
||||
;S IO(1,"/dev/pts/0")=""
|
||||
;S IO("ERROR")=""
|
||||
;S IO("HOME")="50^/dev/pts/0"
|
||||
;S IO("ZIO")="/dev/pts/0"
|
||||
;S IOBS="$C(8)"
|
||||
;S IOF="!!!!!!!!!!!!!!!!!!!!!!!!,#,$C(27,91,50,74,27,91,72)"
|
||||
;S IOM=80
|
||||
;S ION="GTM/UNIX TELNET"
|
||||
;S IOS=50
|
||||
;S IOSL=24
|
||||
;S IOST="C-VT100"
|
||||
;S IOST(0)=9
|
||||
;S IOT="VTRM"
|
||||
;S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
|
||||
S U="^"
|
||||
S X="1;DIC(4.2,"
|
||||
S XPARSYS="1;DIC(4.2,"
|
||||
S XQXFLG="^^XUP"
|
||||
S Y="DEV^VISTA^hollywood^VISTA:hollywood"
|
||||
Q
|
||||
;
|
142
p/C0CEWD.m
142
p/C0CEWD.m
|
@ -1,71 +1,71 @@
|
|||
C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
|
||||
;;0.1;CCDCCR;nopatch;noreleasedate
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
Q
|
||||
;
|
||||
TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN
|
||||
Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE
|
||||
;
|
||||
STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN
|
||||
; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION
|
||||
; RETURNS THE TOKEN. ZARY IS PASSED BY NAME
|
||||
N ZT
|
||||
S ZT=$$TOKEN ; GET A NEW TOKEN
|
||||
M ^TMP("C0E","TOKEN",ZT)=@ZARY ;
|
||||
Q ZT
|
||||
;
|
||||
GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN
|
||||
; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1
|
||||
; C0ERTN IS PASSED BY NAME
|
||||
I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D Q ; DOESN'T EXIST
|
||||
. S @C0ERTN="" ; PASS BACK NULL
|
||||
M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE
|
||||
I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE
|
||||
Q
|
||||
;
|
||||
URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL
|
||||
; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345"
|
||||
N token
|
||||
S token=""
|
||||
s token=$$getRequestValue^%zewdAPI("token",sessid)
|
||||
s token=$tr(token,"""") ; strip out quotes
|
||||
Q token
|
||||
;
|
||||
cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options)
|
||||
;
|
||||
n maxNo,noFound
|
||||
;
|
||||
s maxNo=50
|
||||
s noFound=0
|
||||
f s seedValue=$o(^DPT("B",seedValue)) q:seedValue="" q:noFound=maxNo d
|
||||
. s lastSeedValue=seedValue
|
||||
. i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
|
||||
. s optionNo=optionNo+1
|
||||
. s noFound=noFound+1
|
||||
. s options(optionNo)=seedValue
|
||||
QUIT
|
||||
;
|
||||
set1 ;
|
||||
s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
|
||||
q
|
||||
;
|
||||
test1(sessid) ;
|
||||
d setSessionValue^%zewdAPI("testing","ZZ",sessid)
|
||||
q 0
|
||||
;
|
||||
C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
|
||||
;;0.1;CCDCCR;nopatch;noreleasedate;Build 77
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
Q
|
||||
;
|
||||
TOKEN() ; EXTRINSIC WHICH RETURNS A NEW RANDOM TOKEN
|
||||
Q $$UUID^C0CUTIL ; USE THE UUID FUNCTION IN THE CCR PACKAGE
|
||||
;
|
||||
STORE(ZARY) ; STORE AN ARRAY OF VALUES INDEXED BY A NEW TOKEN
|
||||
; IN ^TMP("C0E","TOKEN") FOR LATER RETRIEVAL FROM INSIDE AN EWD SESSION
|
||||
; RETURNS THE TOKEN. ZARY IS PASSED BY NAME
|
||||
N ZT
|
||||
S ZT=$$TOKEN ; GET A NEW TOKEN
|
||||
M ^TMP("C0E","TOKEN",ZT)=@ZARY ;
|
||||
Q ZT
|
||||
;
|
||||
GET(C0ERTN,C0ETOKEN,NOKILL) ; RETRIEVE A STORED ARRAY INDEXED BY ZTOKEN
|
||||
; KILL THE ARRAY AFTER RETRIEVAL UNLESS NOKILL=1
|
||||
; C0ERTN IS PASSED BY NAME
|
||||
I '$D(^TMP("C0E","TOKEN",C0ETOKEN)) D Q ; DOESN'T EXIST
|
||||
. S @C0ERTN="" ; PASS BACK NULL
|
||||
M @C0ERTN=^TMP("C0E","TOKEN",C0ETOKEN) ; RETRIEVE
|
||||
I $G(NOKILL)'=1 K ^TMP("C0E","TOKEN",C0ETOKEN) ; DELETE
|
||||
Q
|
||||
;
|
||||
URLTOKEN(sessid) ; EXTRINSIC WHICH RETRIEVES THE TOKEN PASSED ON THE URL
|
||||
; IN EWD EXAMPLE: https://example.com/ewd/myApp/index.ewd?token="12345"
|
||||
N token
|
||||
S token=""
|
||||
s token=$$getRequestValue^%zewdAPI("token",sessid)
|
||||
s token=$tr(token,"""") ; strip out quotes
|
||||
Q token
|
||||
;
|
||||
cbTestMethod(prefix,seedValue,lastSeedValue,optionNo,options)
|
||||
;
|
||||
n maxNo,noFound
|
||||
;
|
||||
s maxNo=50
|
||||
s noFound=0
|
||||
f s seedValue=$o(^DPT("B",seedValue)) q:seedValue="" q:noFound=maxNo d
|
||||
. s lastSeedValue=seedValue
|
||||
. i prefix'="",$e(seedValue,1,$l(prefix))'=prefix q
|
||||
. s optionNo=optionNo+1
|
||||
. s noFound=noFound+1
|
||||
. s options(optionNo)=seedValue
|
||||
QUIT
|
||||
;
|
||||
set1 ;
|
||||
s ^zewd("comboPlus","methodMap","test")="cbTestMethod^C0PEREW"
|
||||
q
|
||||
;
|
||||
test1(sessid) ;
|
||||
d setSessionValue^%zewdAPI("testing","ZZ",sessid)
|
||||
q 0
|
||||
;
|
||||
|
|
332
p/C0CFM1.m
332
p/C0CFM1.m
|
@ -1,177 +1,177 @@
|
|||
C0CFM1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR FILEMAN Utility Library ",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR FILEMAN Utility Library ",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
|
||||
;
|
||||
S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
|
||||
I '$D(ZWHICH) S ZWHICH="ALL"
|
||||
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
|
||||
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
|
||||
. D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
|
||||
E D ; MULTIPLE SECTIONS
|
||||
. S C0CVARS=$NA(@C0CGLB)
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
|
||||
. . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
|
||||
. . D PUTRIM1(DFN,C0CI,C0CVARSN)
|
||||
Q
|
||||
;
|
||||
;
|
||||
S C0CGLB=$NA(^TMP("GPLRIM","VARS",DFN))
|
||||
I '$D(ZWHICH) S ZWHICH="ALL"
|
||||
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
|
||||
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
|
||||
. D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
|
||||
E D ; MULTIPLE SECTIONS
|
||||
. S C0CVARS=$NA(@C0CGLB)
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
|
||||
. . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
|
||||
. . D PUTRIM1(DFN,C0CI,C0CVARSN)
|
||||
Q
|
||||
;
|
||||
PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
|
||||
; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
|
||||
S C0CX=0
|
||||
F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
|
||||
. W "ZOCC=",C0CX,!
|
||||
. S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
|
||||
. D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
|
||||
Q
|
||||
;
|
||||
; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
|
||||
S C0CX=0
|
||||
F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
|
||||
. W "ZOCC=",C0CX,!
|
||||
. S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
|
||||
. D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
|
||||
Q
|
||||
;
|
||||
PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||
; ^C0C(171.201, DFN IS THE PATIENT IEN 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
|
||||
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
|
||||
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
|
||||
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
|
||||
;
|
||||
S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
|
||||
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
|
||||
N ZF,ZFV S ZF=171.201 S ZFV=171.2012
|
||||
S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
|
||||
N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
|
||||
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
|
||||
W "ZTYPE: ",ZTYPE," ",ZTYPN,!
|
||||
N ZVARN ; IEN OF VARIABLE BEING PROCESSED
|
||||
;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
|
||||
S C0CFDA(ZF,"?+1,",.01)=DFN
|
||||
S C0CFDA(ZF,"?+1,",.02)=ZSRC
|
||||
S C0CFDA(ZF,"?+1,",.03)=ZTYPN
|
||||
S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
|
||||
K ZERR
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
||||
I $D(ZERR) B ;OOPS
|
||||
K C0CFDA
|
||||
S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
||||
W "RECORD NUMBER: ",ZD0,!
|
||||
;B
|
||||
S ZCNT=0
|
||||
S ZC0CI="" ;
|
||||
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
||||
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
|
||||
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
|
||||
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
|
||||
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
|
||||
;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(170,"?+1,",12)="DIR"
|
||||
;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
Q
|
||||
;
|
||||
; ^C0C(171.201, DFN IS THE PATIENT IEN 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
|
||||
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
|
||||
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
|
||||
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
|
||||
;
|
||||
S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
|
||||
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
|
||||
N ZF,ZFV S ZF=171.201 S ZFV=171.2012
|
||||
S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
|
||||
N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
|
||||
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
|
||||
W "ZTYPE: ",ZTYPE," ",ZTYPN,!
|
||||
N ZVARN ; IEN OF VARIABLE BEING PROCESSED
|
||||
;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
|
||||
S C0CFDA(ZF,"?+1,",.01)=DFN
|
||||
S C0CFDA(ZF,"?+1,",.02)=ZSRC
|
||||
S C0CFDA(ZF,"?+1,",.03)=ZTYPN
|
||||
S C0CFDA(ZF,"?+1,",.04)=ZOCC ;CREATE OCCURANCE
|
||||
K ZERR
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
||||
I $D(ZERR) B ;OOPS
|
||||
K C0CFDA
|
||||
S ZD0=$O(^C0C(ZF,"C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
||||
W "RECORD NUMBER: ",ZD0,!
|
||||
;B
|
||||
S ZCNT=0
|
||||
S ZC0CI="" ;
|
||||
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
||||
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
|
||||
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
|
||||
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
|
||||
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
|
||||
;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(170,"?+1,",12)="DIR"
|
||||
;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
Q
|
||||
;
|
||||
VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
|
||||
; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
|
||||
;
|
||||
N C0CDIC,C0CNODE ;
|
||||
S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
|
||||
S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
|
||||
Q
|
||||
;
|
||||
; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
|
||||
;
|
||||
N C0CDIC,C0CNODE ;
|
||||
S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
|
||||
S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
|
||||
Q
|
||||
;
|
||||
FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
|
||||
; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
|
||||
; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
|
||||
; CONVERSION
|
||||
;N C0CC,C0CI,C0CJ,C0CN,C0CZX
|
||||
D FIELDS^C0CRNF("C0CC",170)
|
||||
S C0CI=""
|
||||
F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
|
||||
. S C0CZX=""
|
||||
. F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
|
||||
. . W "SECTION ",C0CI," VAR ",C0CZX
|
||||
. . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
|
||||
. . W " TYPE: ",C0CV,!
|
||||
. . D SETFDA("SECTION",C0CV)
|
||||
. . ;ZWR C0CFDA
|
||||
Q
|
||||
;
|
||||
; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
|
||||
; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
|
||||
; CONVERSION
|
||||
;N C0CC,C0CI,C0CJ,C0CN,C0CZX
|
||||
D FIELDS^C0CRNF("C0CC",170)
|
||||
S C0CI=""
|
||||
F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
|
||||
. S C0CZX=""
|
||||
. F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
|
||||
. . W "SECTION ",C0CI," VAR ",C0CZX
|
||||
. . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
|
||||
. . W " TYPE: ",C0CV,!
|
||||
. . D SETFDA("SECTION",C0CV)
|
||||
. . ;ZWR C0CFDA
|
||||
Q
|
||||
;
|
||||
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
|
|
688
p/C0CFM2.m
688
p/C0CFM2.m
|
@ -1,362 +1,362 @@
|
|||
C0CFM2 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR FILEMAN Utility Library ",!
|
||||
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
|
||||
; CCR ELEMENTS (^C0C(179.201,
|
||||
; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
|
||||
; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
|
||||
; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
|
||||
; ALL SUB-VARIABLES HAVE BEEN REMOVED
|
||||
W !
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR FILEMAN Utility Library ",!
|
||||
; THIS SET OF ROUTINES USE CCR E2 (^C0CE(, FILE 171.101) INSTEAD OF
|
||||
; CCR ELEMENTS (^C0C(179.201,
|
||||
; E2 IS A SIMPLIFICATION OF CCR ELEMENTS WHERE SUB-ELEMENTS ARE
|
||||
; AT THE TOP LEVEL. OCCURANCE, THE 4TH PART OF THE KEY IS NOW FREE TEXT
|
||||
; AND HAS THE FORM X;Y FOR SUB-ELEMENTS
|
||||
; ALL SUB-VARIABLES HAVE BEEN REMOVED
|
||||
W !
|
||||
Q
|
||||
;
|
||||
RIMTBL(ZWHICH) ; PUT ALL PATIENT IN RIMTBL ZWHICH INTO THE CCR ELEMENTS FILE
|
||||
;
|
||||
I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
|
||||
N ZI,ZJ,ZC,ZPATBASE
|
||||
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
|
||||
S ZI=""
|
||||
F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
|
||||
. S ZI=$O(@ZPATBASE@(ZI))
|
||||
. D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
|
||||
Q
|
||||
;
|
||||
;
|
||||
I '$D(RIMBASE) D ASETUP^C0CRIMA ; FOR COMMAND LINE CALLS
|
||||
N ZI,ZJ,ZC,ZPATBASE
|
||||
S ZPATBASE=$NA(@RIMBASE@("RIMTBL","PATS",ZWHICH))
|
||||
S ZI=""
|
||||
F ZJ=0:0 D Q:$O(@ZPATBASE@(ZI))="" ; TIL END
|
||||
. S ZI=$O(@ZPATBASE@(ZI))
|
||||
. D PUTRIM(ZI) ; EXPORT THE PATIENT TO A FILE
|
||||
Q
|
||||
;
|
||||
PUTRIM(DFN,ZWHICH) ;DFN IS PATIENT , WHICH IS ELEMENT TYPE
|
||||
;
|
||||
S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
|
||||
I '$D(ZWHICH) S ZWHICH="ALL"
|
||||
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
|
||||
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
|
||||
. D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
|
||||
E D ; MULTIPLE SECTIONS
|
||||
. S C0CVARS=$NA(@C0CGLB)
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
|
||||
. . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
|
||||
. . D PUTRIM1(DFN,C0CI,C0CVARSN)
|
||||
Q
|
||||
;
|
||||
;
|
||||
S C0CGLB=$NA(^TMP("C0CRIM","VARS",DFN))
|
||||
I '$D(ZWHICH) S ZWHICH="ALL"
|
||||
I ZWHICH'="ALL" D ; SINGLE SECTION REQUESTED
|
||||
. S C0CVARS=$NA(@C0CGLB@(ZWHICH))
|
||||
. D PUTRIM1(DFN,ZWHICH,C0CVARS) ; IF ONE SECTION
|
||||
E D ; MULTIPLE SECTIONS
|
||||
. S C0CVARS=$NA(@C0CGLB)
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@C0CVARS@(C0CI)) Q:C0CI="" D ;FOR EACH SECTION
|
||||
. . S C0CVARSN=$NA(@C0CVARS@(C0CI)) ; GRAB ONE SECTION
|
||||
. . D PUTRIM1(DFN,C0CI,C0CVARSN)
|
||||
Q
|
||||
;
|
||||
PUTRIM1(DFN,ZZTYP,ZVARS) ; PUT ONE SECTION OF VARIABLES INTO CCR ELEMENTS
|
||||
; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
|
||||
S C0CX=0
|
||||
F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
|
||||
. W "ZOCC=",C0CX,!
|
||||
. K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
|
||||
. S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
|
||||
. D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
|
||||
. I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
|
||||
. . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
|
||||
. . S ZZCNT=0
|
||||
. . S ZZC0CI=0
|
||||
. . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
|
||||
. . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
|
||||
. . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
|
||||
. . W "MULTIPLE:",ZZVALS,!
|
||||
. . ;B
|
||||
. . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
|
||||
. . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
|
||||
. . . W "COUNT:",ZZCNT,!
|
||||
. . . S ZV=$NA(@ZZVALS@(ZZC0CI))
|
||||
. . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
|
||||
Q
|
||||
;
|
||||
; ZVARS IS PASSED BY NAME AN HAS THE FORM @ZVARS@(1,"VAR1")="VAL1"
|
||||
S C0CX=0
|
||||
F S C0CX=$O(@ZVARS@(C0CX)) Q:C0CX="" D ; FOR EACH OCCURANCE
|
||||
. W "ZOCC=",C0CX,!
|
||||
. K C0CMDO ; MULTIPLE SUBELEMENTS FOR THIS OCCURANCE PASSED BY NAME
|
||||
. S C0CV=$NA(@ZVARS@(C0CX)) ; VARIABLES FOR THIS OCCURANCE
|
||||
. D PUTELS(DFN,ZZTYP,C0CX,C0CV) ; PUT THEM TO THE CCR ELEMENTS FILE
|
||||
. I $D(C0CMDO) D ; MULTIPLES TO HANDLE (THIS IS INSTEAD OF RECURSION :()
|
||||
. . N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
|
||||
. . S ZZCNT=0
|
||||
. . S ZZC0CI=0
|
||||
. . S ZZVALS=$NA(@C0CMDO@("M")) ; LOCATION OF THIS MULTILPE
|
||||
. . S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
|
||||
. . S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
|
||||
. . W "MULTIPLE:",ZZVALS,!
|
||||
. . ;B
|
||||
. . F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
|
||||
. . . S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
|
||||
. . . W "COUNT:",ZZCNT,!
|
||||
. . . S ZV=$NA(@ZZVALS@(ZZC0CI))
|
||||
. . . D PUTELS(DFN,ZT,C0CX_";"_ZZCNT,ZV)
|
||||
Q
|
||||
;
|
||||
PUTELS(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||
; 171.101, ^C0CE DFN IS THE PATIENT IEN 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
|
||||
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
|
||||
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
|
||||
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
|
||||
;
|
||||
N PATN,ZTYPN,XD0,ZTYP
|
||||
I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET
|
||||
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
|
||||
N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL
|
||||
N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL
|
||||
N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL
|
||||
N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL
|
||||
N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL
|
||||
;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ...
|
||||
; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK
|
||||
N C0CFDA
|
||||
S C0CFDA(C0CFPAT,"?+1,",.01)=DFN
|
||||
D UPDIE ; ADD THE PATIENT
|
||||
S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT
|
||||
S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC
|
||||
D UPDIE ; ADD THE CCR SOURCE
|
||||
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE
|
||||
S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN
|
||||
D UPDIE ; ADD THE ELEMENT TYPE
|
||||
S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE
|
||||
S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC
|
||||
; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE
|
||||
; STRING COLLATION ON THE INDEX
|
||||
D UPDIE ; ADD THE OCCURANCE
|
||||
S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,""))
|
||||
W "RECORD NUMBER: ",ZD0,!
|
||||
;I ZD0=32 B
|
||||
;I ZD0=31 B
|
||||
N ZCNT,ZC0CI,ZVARN,C0CZ1
|
||||
S ZCNT=0
|
||||
S ZC0CI="" ;
|
||||
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
||||
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
|
||||
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
|
||||
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
|
||||
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
||||
. . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
|
||||
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
|
||||
. . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
|
||||
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
|
||||
. E D ; THIS IS A SUBELEMENT
|
||||
. . ;PUT THE FOLLOWING BACK TO USE RECURSION
|
||||
. . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
|
||||
. . ;S ZZCNT=0
|
||||
. . ;S ZZC0CI=0
|
||||
. . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
|
||||
. . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
|
||||
. . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
|
||||
. . ;W "MULTIPLE:",ZZVALS,!
|
||||
. . ;B
|
||||
. . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
|
||||
. . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
|
||||
. . ;. W "COUNT:",ZZCNT,!
|
||||
. . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
|
||||
. . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
|
||||
. . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
|
||||
D UPDIE ; UPDATE
|
||||
Q
|
||||
;
|
||||
; 171.101, ^C0CE DFN IS THE PATIENT IEN 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
|
||||
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
|
||||
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
|
||||
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
|
||||
;
|
||||
N PATN,ZTYPN,XD0,ZTYP
|
||||
I '$D(ZSRC) S ZSRC=1 ; CCR SOURCE IS ASSUMED, 1 IF NOT SET
|
||||
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
|
||||
N C0CFPAT S C0CFPAT=171.101 ; FILE AT PATIENT LEVEL
|
||||
N C0CFSRC S C0CFSRC=171.111 ; FILE AT CCR SOURCE LVL
|
||||
N C0CFTYP S C0CFTYP=171.121 ; FILE AT ELEMENT TYPE LVL
|
||||
N C0CFOCC S C0CFOCC=171.131 ; FILE AT OCCURANCE LVL
|
||||
N C0CFVAR S C0CFVAR=171.1311 ; FILE AT VARIABLE LVL
|
||||
;FILE IS ^C0CE(PAT,1,SCR,1,TYP,1,OCC,1,VAR,1, ...
|
||||
; AND WE HAVE TO ADD THEM LEVEL AT A TIME I THINK
|
||||
N C0CFDA
|
||||
S C0CFDA(C0CFPAT,"?+1,",.01)=DFN
|
||||
D UPDIE ; ADD THE PATIENT
|
||||
S PATN=$O(^C0CE("B",DFN,"")) ; IEN FOR THE PATIENT
|
||||
S C0CFDA(C0CFSRC,"?+1,"_PATN_",",.01)=ZSRC
|
||||
D UPDIE ; ADD THE CCR SOURCE
|
||||
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,"")) ; FIND THE ELE TYPE
|
||||
S C0CFDA(C0CFTYP,"?+1,"_ZSRC_","_PATN_",",.01)=ZTYPN
|
||||
D UPDIE ; ADD THE ELEMENT TYPE
|
||||
S ZTYP=$O(^C0CE(PATN,1,ZSRC,1,"B",ZTYPN,"")) ; IEN OF ELEMENT TYPE
|
||||
S C0CFDA(C0CFOCC,"?+1,"_ZTYP_","_ZSRC_","_PATN_",",.01)=ZOCC ; STRING OCC
|
||||
; OCC IS PRECEDED BY " " TO FORCE STRING STORAGE AND PRESERVE
|
||||
; STRING COLLATION ON THE INDEX
|
||||
D UPDIE ; ADD THE OCCURANCE
|
||||
S ZD0=$O(^C0CE(PATN,1,ZSRC,1,ZTYP,1,"B",ZOCC,""))
|
||||
W "RECORD NUMBER: ",ZD0,!
|
||||
;I ZD0=32 B
|
||||
;I ZD0=31 B
|
||||
N ZCNT,ZC0CI,ZVARN,C0CZ1
|
||||
S ZCNT=0
|
||||
S ZC0CI="" ;
|
||||
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
||||
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
|
||||
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
|
||||
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
|
||||
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
||||
. . S C0CZ1=ZTYP_","_ZSRC_","_PATN_","
|
||||
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,.01)=ZVARN
|
||||
. . S ZZVAL=$TR(@ZVALS@(ZC0CI),"^","|")
|
||||
. . S C0CFDA(C0CFVAR,"?+"_ZCNT_","_ZD0_","_C0CZ1,1)=ZZVAL
|
||||
. E D ; THIS IS A SUBELEMENT
|
||||
. . ;PUT THE FOLLOWING BACK TO USE RECURSION
|
||||
. . ;N ZZCNT,ZZC0CI,ZZVALS,ZT,ZZCNT,ZV
|
||||
. . ;S ZZCNT=0
|
||||
. . ;S ZZC0CI=0
|
||||
. . ;S ZZVALS=$NA(@ZVALS@("M")) ; LOCATION OF THIS MULTILPE
|
||||
. . ;S ZT=$O(@ZZVALS@("")) ; ELEMENT TYPE OF MULTIPLE
|
||||
. . ;S ZZVALS=$NA(@ZZVALS@(ZT)) ; PAST MULTIPLE TYPE INDICATOR
|
||||
. . ;W "MULTIPLE:",ZZVALS,!
|
||||
. . ;B
|
||||
. . ;F S ZZC0CI=$O(@ZZVALS@(ZZC0CI)) Q:ZZC0CI="" D ; EACH MULTIPLE
|
||||
. . ;. S ZZCNT=ZZCNT+1 ;INCREMENT COUNT
|
||||
. . ;. W "COUNT:",ZZCNT,!
|
||||
. . ;. S ZV=$NA(@ZZVALS@(ZZC0CI))
|
||||
. . ;. D PUTELS(DFN,ZT,ZOCC_";"_ZZCNT,ZV) ; PUT THIS BACK TO DEBUG RECURSION
|
||||
. . S C0CMDO=ZVALS ; FLAG TO HANDLE MULTIPLES (INSTEAD OF RECURSION)
|
||||
D UPDIE ; UPDATE
|
||||
Q
|
||||
;
|
||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
CHECK ; CHECKSUM EXPERIMENTS
|
||||
;
|
||||
;B
|
||||
S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA))
|
||||
;S G2=$NA(^C0CE(8,1,1,1,2,1,6))
|
||||
S X=$$CHKSUM^XUSESIG1(ZG)
|
||||
W G1,!
|
||||
Q
|
||||
;
|
||||
;
|
||||
;B
|
||||
S ZG=$NA(^C0CE(DA(2),1,DA(1),1,DA))
|
||||
;S G2=$NA(^C0CE(8,1,1,1,2,1,6))
|
||||
S X=$$CHKSUM^XUSESIG1(ZG)
|
||||
W G1,!
|
||||
Q
|
||||
;
|
||||
CHKELS(DFN) ; CHECKSUM ALL ELEMENTS FOR A PATIENT
|
||||
;
|
||||
S ZGLB=$NA(^TMP("C0CCHK"))
|
||||
S ZPAT=$O(^C0CE("B",DFN,""))
|
||||
K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS
|
||||
S ZSRC=""
|
||||
F S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC="" D ;
|
||||
. W "PAT:",ZPAT," SRC:",ZSRC,!
|
||||
. S ZEL=""
|
||||
. F S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL="" D ;ELEMENTS
|
||||
. . W "ELEMENT:",ZEL," "
|
||||
. . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME
|
||||
. . W ZELE," "
|
||||
. . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,""))
|
||||
. . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI))
|
||||
. . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
|
||||
. . W ZCHK,!
|
||||
. . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
|
||||
ZWR ^TMP("C0CCHK",ZPAT,*)
|
||||
Q
|
||||
;
|
||||
;
|
||||
S ZGLB=$NA(^TMP("C0CCHK"))
|
||||
S ZPAT=$O(^C0CE("B",DFN,""))
|
||||
K @ZGLB@(ZPAT) ; CLEAR PREVIOUS CHECKSUMS
|
||||
S ZSRC=""
|
||||
F S ZSRC=$O(^C0CE(ZPAT,1,"B",ZSRC)) Q:ZSRC="" D ;
|
||||
. W "PAT:",ZPAT," SRC:",ZSRC,!
|
||||
. S ZEL=""
|
||||
. F S ZEL=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL)) Q:ZEL="" D ;ELEMENTS
|
||||
. . W "ELEMENT:",ZEL," "
|
||||
. . S ZELE=$$GET1^DIQ(170.101,ZEL,.01,"E") ;ELEMENT NAME
|
||||
. . W ZELE," "
|
||||
. . S ZELI=$O(^C0CE(ZPAT,1,ZSRC,1,"B",ZEL,""))
|
||||
. . S ZG=$NA(^C0CE(ZPAT,1,ZSRC,1,ZELI))
|
||||
. . S ZCHK=$$CHKSUM^XUSESIG1(ZG) ; CHECKSUM FOR THE ELEMENT
|
||||
. . W ZCHK,!
|
||||
. . S @ZGLB@(ZPAT,ZELE,ZSRC)=ZCHK
|
||||
ZWR ^TMP("C0CCHK",ZPAT,*)
|
||||
Q
|
||||
;
|
||||
DOIT(DFN) ; EXPERIMENT FOR TIMING CALLS USING mumps -dir DOIT^C0CFM2(DFN)
|
||||
D SETXUP
|
||||
D CHKELS(DFN)
|
||||
Q
|
||||
;
|
||||
D SETXUP
|
||||
D CHKELS(DFN)
|
||||
Q
|
||||
;
|
||||
SETXUP ; SET UP ENVIRONMENT
|
||||
S DISYS=19
|
||||
S DT=3090325
|
||||
S DTIME=300
|
||||
S DUZ=1
|
||||
S DUZ(0)="@"
|
||||
S DUZ(1)=""
|
||||
S DUZ(2)=7247
|
||||
S DUZ("AG")="I"
|
||||
S DUZ("BUF")=1
|
||||
S DUZ("LANG")=""
|
||||
S IO="/dev/pts/20"
|
||||
S IO(0)="/dev/pts/20"
|
||||
S IO(1,"/dev/pts/20")=""
|
||||
S IO("ERROR")=""
|
||||
S IO("HOME")="344^/dev/pts/20"
|
||||
S IO("ZIO")="/dev/pts/20"
|
||||
S IOBS="$C(8)"
|
||||
S IOF="#,$C(27,91,50,74,27,91,72)"
|
||||
S IOM=80
|
||||
S ION="TELNET"
|
||||
S IOS=344
|
||||
S IOSL=24
|
||||
S IOST="C-VT100"
|
||||
S IOST(0)=9
|
||||
S IOT="VTRM"
|
||||
S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
|
||||
S U="^"
|
||||
S X="216;DIC(4.2,"
|
||||
S XPARSYS="216;DIC(4.2,"
|
||||
S XQXFLG="^^XUP"
|
||||
Q
|
||||
;
|
||||
S DISYS=19
|
||||
S DT=3090325
|
||||
S DTIME=300
|
||||
S DUZ=1
|
||||
S DUZ(0)="@"
|
||||
S DUZ(1)=""
|
||||
S DUZ(2)=7247
|
||||
S DUZ("AG")="I"
|
||||
S DUZ("BUF")=1
|
||||
S DUZ("LANG")=""
|
||||
S IO="/dev/pts/20"
|
||||
S IO(0)="/dev/pts/20"
|
||||
S IO(1,"/dev/pts/20")=""
|
||||
S IO("ERROR")=""
|
||||
S IO("HOME")="344^/dev/pts/20"
|
||||
S IO("ZIO")="/dev/pts/20"
|
||||
S IOBS="$C(8)"
|
||||
S IOF="#,$C(27,91,50,74,27,91,72)"
|
||||
S IOM=80
|
||||
S ION="TELNET"
|
||||
S IOS=344
|
||||
S IOSL=24
|
||||
S IOST="C-VT100"
|
||||
S IOST(0)=9
|
||||
S IOT="VTRM"
|
||||
S IOXY="W $C(27,91)_((DY+1))_$C(59)_((DX+1))_$C(72)"
|
||||
S U="^"
|
||||
S X="216;DIC(4.2,"
|
||||
S XPARSYS="216;DIC(4.2,"
|
||||
S XQXFLG="^^XUP"
|
||||
Q
|
||||
;
|
||||
PUTELSOLD(DFN,ZTYPE,ZOCC,ZVALS) ; PUT CCR VALUES INTO THE CCR ELEMENTS FILE
|
||||
; 171.101, ^C0CE DFN IS THE PATIENT IEN 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
|
||||
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
|
||||
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
|
||||
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
|
||||
;
|
||||
S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
|
||||
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
|
||||
N ZF,ZFV S ZF=171.101 S ZFV=171.1011
|
||||
;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
|
||||
;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
|
||||
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
|
||||
W "ZTYPE: ",ZTYPE," ",ZTYPN,!
|
||||
N ZVARN ; IEN OF VARIABLE BEING PROCESSED
|
||||
;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
|
||||
K C0CFDA
|
||||
S C0CFDA(ZF,"?+1,",.01)=DFN
|
||||
S C0CFDA(ZF,"?+1,",.02)=ZSRC
|
||||
S C0CFDA(ZF,"?+1,",.03)=ZTYPN
|
||||
S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
|
||||
K ZERR
|
||||
;B
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
||||
I $D(ZERR) B ;OOPS
|
||||
K C0CFDA
|
||||
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
||||
W "RECORD NUMBER: ",ZD0,!
|
||||
;B
|
||||
S ZCNT=0
|
||||
S ZC0CI="" ;
|
||||
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
||||
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
|
||||
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
|
||||
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
|
||||
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
|
||||
;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(170,"?+1,",12)="DIR"
|
||||
;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
; 171.101, ^C0CE DFN IS THE PATIENT IEN 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
|
||||
; ZVALS ARE THE VARIABLES AND VALUES PASSED BY NAME AND IN THE FORM
|
||||
; @ZVALS@("VAR1")="VALUE1" FOR ALL VARIABLES IN THIS ELEMENT
|
||||
; AND @ZVALS@("M",SUBOCCUR,"VAR2")="VALUE2" FOR SUB VARIABLES
|
||||
;
|
||||
S ZSRC=1 ; CCR SOURCE IS ASSUMED TO BE THIS EHR, WHICH IS ALWAYS SOURCE 1
|
||||
; PUT THIS IN PARAMETERS - SO SOURCE NUMBER FOR PROCESSING IN CONFIGURABLE
|
||||
N ZF,ZFV S ZF=171.101 S ZFV=171.1011
|
||||
;S ZSUBF=171.20122 ;FILE AND SUBFILE NUMBERS
|
||||
;N ZSFV S ZSFV=171.201221 ; SUBFILE VARIABLE FILE NUMBER
|
||||
N ZTYPN S ZTYPN=$O(^C0CDIC(170.101,"B",ZTYPE,""))
|
||||
W "ZTYPE: ",ZTYPE," ",ZTYPN,!
|
||||
N ZVARN ; IEN OF VARIABLE BEING PROCESSED
|
||||
;N C0CFDA ; FDA FOR CCR ELEMENT UPDATE
|
||||
K C0CFDA
|
||||
S C0CFDA(ZF,"?+1,",.01)=DFN
|
||||
S C0CFDA(ZF,"?+1,",.02)=ZSRC
|
||||
S C0CFDA(ZF,"?+1,",.03)=ZTYPN
|
||||
S C0CFDA(ZF,"?+1,",.04)=" "_ZOCC ;CREATE OCCURANCE
|
||||
K ZERR
|
||||
;B
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR") ;ASSIGN RECORD NUMBER
|
||||
I $D(ZERR) B ;OOPS
|
||||
K C0CFDA
|
||||
S ZD0=$O(^C0CE("C",DFN,ZSRC,ZTYPN,ZOCC,""))
|
||||
W "RECORD NUMBER: ",ZD0,!
|
||||
;B
|
||||
S ZCNT=0
|
||||
S ZC0CI="" ;
|
||||
F S ZC0CI=$O(@ZVALS@(ZC0CI)) Q:ZC0CI="" D ;
|
||||
. I ZC0CI'="M" D ; NOT A SUBVARIABLE
|
||||
. . S ZCNT=ZCNT+1 ;INCREMENT COUNT
|
||||
. . S ZVARN=$$VARPTR(ZC0CI,ZTYPE) ;GET THE POINTER TO THE VAR IN THE CCR DICT
|
||||
. . ; WILL ALLOW FOR LAYGO IF THE VARIABLE IS NOT FOUND
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",.01)=ZVARN
|
||||
. . S C0CFDA(ZFV,"?+"_ZCNT_","_ZD0_",",1)=@ZVALS@(ZC0CI)
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",.01)=ZVARN
|
||||
. . ;S C0CFDA(ZSFV,"+1,"_DFN_","_ZSRC_","_ZTYPN_","_ZOCC_",",1)=@ZVALS@(ZC0CI)
|
||||
;S GT1(170,"?+1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(170,"?+1,",12)="DIR"
|
||||
;S GT1(171.201221,"?+1,1,5,1,",.01)="ZZZ NEW MEDVEHICLETEXT"
|
||||
;S GT1(171.201221,"+1,1,5,1,",1)="THIRD NEW MED DIRECTION TEXT"
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
BLDTYPS ; ROUTINE TO POPULATE THE CCR NODE TYPES FILE (^C0CDIC(170.101,)
|
||||
; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
|
||||
;
|
||||
N C0CDIC,C0CNODE ;
|
||||
S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
|
||||
S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
|
||||
Q
|
||||
;
|
||||
; THE CCR DICTIONARY (^C0CDIC(170, ) HAS MOST OF WHAT'S NEEDED
|
||||
;
|
||||
N C0CDIC,C0CNODE ;
|
||||
S C0CDIC=$$FILEREF^C0CRNF(170) ; CLOSED FILE REFERENCE TO THE CCR DICTIONARY
|
||||
S C0CNODE=$$FILEREF^C0CRNF(170.101) ; CLOSED REF TO CCR NODE TYPE FILE
|
||||
Q
|
||||
;
|
||||
FIXSEC ;FIX THE SECTION FIELD OF THE CCR DICTIONARY.. IT HAS BEEN REDEFINED
|
||||
; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
|
||||
; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
|
||||
; CONVERSION
|
||||
;N C0CC,C0CI,C0CJ,C0CN,C0CZX
|
||||
D FIELDS^C0CRNF("C0CC",170)
|
||||
S C0CI=""
|
||||
F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
|
||||
. S C0CZX=""
|
||||
. F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
|
||||
. . W "SECTION ",C0CI," VAR ",C0CZX
|
||||
. . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
|
||||
. . W " TYPE: ",C0CV,!
|
||||
. . D SETFDA("SECTION",C0CV)
|
||||
. . ;ZWR C0CFDA
|
||||
Q
|
||||
;
|
||||
; AS A POINTER TO CCR NODE TYPE INSTEAD OF BEING A SET
|
||||
; THE SET VALUES ARE PRESERVED IN ^KBAI("SECTION") TO FACILITATE THIS
|
||||
; CONVERSION
|
||||
;N C0CC,C0CI,C0CJ,C0CN,C0CZX
|
||||
D FIELDS^C0CRNF("C0CC",170)
|
||||
S C0CI=""
|
||||
F S C0CI=$O(^KBAI("SECTION",C0CI)) Q:C0CI="" D ; EACH SECTION
|
||||
. S C0CZX=""
|
||||
. F S C0CZX=$O(^KBAI("SECTION",C0CI,C0CZX)) Q:C0CZX="" D ; EACH VARIABLE
|
||||
. . W "SECTION ",C0CI," VAR ",C0CZX
|
||||
. . S C0CV=$O(^C0CDIC(170.101,"B",C0CI,""))
|
||||
. . W " TYPE: ",C0CV,!
|
||||
. . D SETFDA("SECTION",C0CV)
|
||||
. . ;ZWR C0CFDA
|
||||
Q
|
||||
;
|
||||
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
|
|
266
p/C0CIM2.m
266
p/C0CIM2.m
|
@ -1,133 +1,133 @@
|
|||
C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
|
||||
;;1.0;C0C;;Feb 16, 2010;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
|
||||
; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
|
||||
; THAT GET PASSED TO *GET ROUTINES
|
||||
;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
|
||||
N C0CIMM
|
||||
S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
|
||||
; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
|
||||
; THAT GET INSERTED INTO THE XML TEMPLATE
|
||||
; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
|
||||
D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
|
||||
; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
|
||||
; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
|
||||
D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
|
||||
Q
|
||||
;
|
||||
GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS.
|
||||
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CIMM: IMMUNIZATIONS
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CIMM
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST.
|
||||
;
|
||||
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
|
||||
;
|
||||
; SETUP RPC/API CALL HERE
|
||||
; USE START AND END DATES FROM PARAMETERS IF REQUIRED
|
||||
N IMMA
|
||||
D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
|
||||
; PREFORM SORT HERE IF NEEDED
|
||||
;
|
||||
; NO SORT REQUIRED FOR IMMUNIZATIONS
|
||||
;
|
||||
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
|
||||
; RNF1 ARRAY FORMAT:
|
||||
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
|
||||
;
|
||||
; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
|
||||
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
|
||||
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
|
||||
N C0CIM,C0CC,ZRNF
|
||||
S C0CIM="" ; INITIALIZE FOR $O
|
||||
F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
|
||||
. I DEBUG W @IMMA@(C0CIM),!
|
||||
. ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
|
||||
. D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
|
||||
. K ZRNF
|
||||
; SAVE RIM VARIABLES SEE C0CRIMA
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
|
||||
M @ZRIM=@C0CIMM@("V")
|
||||
Q
|
||||
;
|
||||
IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
|
||||
; RPC FORMAT
|
||||
; I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^
|
||||
; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
|
||||
; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
|
||||
; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
|
||||
D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
|
||||
; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
|
||||
D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
|
||||
S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
|
||||
S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
|
||||
S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
|
||||
S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
|
||||
S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
|
||||
S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
|
||||
I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
|
||||
E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
|
||||
;CLEANUP FROM C0CRNF CALLS
|
||||
K C0CZIM,C0CZVI
|
||||
Q
|
||||
FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
|
||||
; CURRENTLY DISABLED
|
||||
Q
|
||||
CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS
|
||||
; CURRENTLY DISABLED
|
||||
Q
|
||||
REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
|
||||
; CURRENTLY DISABLED
|
||||
Q
|
||||
;
|
||||
MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
; XPATH NEEDS TO MATCH YOUR SECTION
|
||||
D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
|
||||
. S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
|
||||
N ZZTMP ; IS THIS NEEDED?
|
||||
D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD
|
||||
Q
|
||||
;
|
||||
C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
|
||||
;;1.0;C0C;;Feb 16, 2010;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(IMMXML,DFN,IMMOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
|
||||
; IMMXML AND IMMOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
|
||||
; THAT GET PASSED TO *GET ROUTINES
|
||||
;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
|
||||
N C0CIMM
|
||||
S C0CIMM=$NA(^TMP("C0CCCR",$J,DFN,"C0CIMM"))
|
||||
; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
|
||||
; THAT GET INSERTED INTO THE XML TEMPLATE
|
||||
; I '$D(@C0CIMM) D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS IF NOT THERE
|
||||
D GETRPMS(DFN,C0CIMM) ; GET VARS IF NOT THERE
|
||||
; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
|
||||
; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
|
||||
D MAP(IMMXML,C0CIMM,IMMOUT) ;MAP RESULTS FOR PROCEDURES
|
||||
Q
|
||||
;
|
||||
GETRPMS(DFN,C0CIMM) ; CALLS GET^BGOVIMM TO GET IMMUNIZATIONS.
|
||||
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CIMM: IMMUNIZATIONS
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CIMM
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST.
|
||||
;
|
||||
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
|
||||
;
|
||||
; SETUP RPC/API CALL HERE
|
||||
; USE START AND END DATES FROM PARAMETERS IF REQUIRED
|
||||
N IMMA
|
||||
D GET^BGOVIMM(.IMMA,DFN) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
|
||||
; PREFORM SORT HERE IF NEEDED
|
||||
;
|
||||
; NO SORT REQUIRED FOR IMMUNIZATIONS
|
||||
;
|
||||
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
|
||||
; RNF1 ARRAY FORMAT:
|
||||
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
|
||||
;
|
||||
; IMMUNIZATIONS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF IMMUNIZATION RESULTS
|
||||
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
|
||||
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
|
||||
N C0CIM,C0CC,ZRNF
|
||||
S C0CIM="" ; INITIALIZE FOR $O
|
||||
F C0CC=1:1 S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
|
||||
. I DEBUG W @IMMA@(C0CIM),!
|
||||
. ; FIGURE OUT WHICH TYPE OF IMMUNIZATION IT IS (IMMUNIZATION, FORECAST, CONTRAINDICATIONS, REFUSALS)
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="I" IMMUN
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="F" FORECAST
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="C" CONTRA
|
||||
. D:$P(@IMMA@(C0CIM),U,1)="R" REFUSE
|
||||
. D RNF1TO2^C0CRNF(C0CIMM,"ZRNF") ;ADD THIS ROW TO THE ARRAY
|
||||
. K ZRNF
|
||||
; SAVE RIM VARIABLES SEE C0CRIMA
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
|
||||
M @ZRIM=@C0CIMM@("V")
|
||||
Q
|
||||
;
|
||||
IMMUN ; PARSES IMMUNIZATION TYPE ROWS FOR RPMS
|
||||
; RPC FORMAT
|
||||
; I ^ Imm Name [2] ^ Visit Date [3] ^ V File IEN [4] ^ Other Location [5] ^ Group [6] ^ Imm IEN [7] ^ Lot [8] ^
|
||||
; Reaction [9] ^ VIS Date [10] ^ Age [11] ^ Visit Date [12] ^ Provider IEN~Name [13] ^ Inj Site [14] ^
|
||||
; Volume [15] ^ Visit IEN [16] ^ Visit Category [17] ^ Full Name [18] ^ Location IEN~Name [19] ^ Visit Locked [20]
|
||||
; RETRIEVE IMMUNIZATION RECORD FROM IMMUNIZATION FILE (9999999.14) FOR THIS IMMUNIZATION
|
||||
D GETN^C0CRNF("C0CZIM",9999999.14,$P(@IMMA@(C0CIM),U,7)) ; GET IMMUNIZATION RECORD
|
||||
; RETIREVE IMMUNIZATION RECORD FROM V IMMUNIZATION FILE (9000010.11) FOR THIS IMMUNIZATION
|
||||
D GETN^C0CRNF("C0CZVI",9000010.11,$P(@IMMA@(C0CIM),U,4)) ; GET V IMMUNIZATION RECORD
|
||||
S ZRNF("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
|
||||
S ZRNF("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
|
||||
S ZRNF("IMMUNEDATETIME")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("EVENT DATE AND TIME","C0CZVI"),"DT")
|
||||
S ZRNF("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_$P($P(@IMMA@(C0CIM),U,13),"~",1)
|
||||
S ZRNF("IMMUNEPRODUCTNAMETEXT")=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
|
||||
S ZRNF("IMMUNEPRODUCTCODE")=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
|
||||
I $$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM")'="" S ZRNF("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code"
|
||||
E S ZRNF("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
|
||||
;CLEANUP FROM C0CRNF CALLS
|
||||
K C0CZIM,C0CZVI
|
||||
Q
|
||||
FORECAST ; PARSES FORECAST TYPE ROWS FOR RPMS
|
||||
; CURRENTLY DISABLED
|
||||
Q
|
||||
CONTRA ; PARSES FORECAST TYPE ROWS FOR RPMS
|
||||
; CURRENTLY DISABLED
|
||||
Q
|
||||
REFUSE ; PARSES FORECAST TYPE ROWS FOR RPMS
|
||||
; CURRENTLY DISABLED
|
||||
Q
|
||||
;
|
||||
MAP(IMMXML,C0CIMM,IMMOUT) ; MAP IMMUNIZATION XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"IMMTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"IMMBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,IMMXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
; XPATH NEEDS TO MATCH YOUR SECTION
|
||||
D QUERY^C0CXPATH(IMMXML,"//Immunizations/Immunization","ZINNER") ;ONE PROC
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CIMM@("V",ZI)) Q:ZI="" D ;FOR EACH IMMUNIZATION
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS IMMUNIZATION XML
|
||||
. S ZVAR=$NA(@C0CIMM@("V",ZI)) ;THIS IMMUNIZATION VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE IMMUNIZATION
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,IMMXML,@IMMXML@(0),@IMMXML@(0))
|
||||
N ZZTMP ; IS THIS NEEDED?
|
||||
D BUILD^C0CXPATH(ZBLD,IMMOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD
|
||||
Q
|
||||
;
|
||||
|
|
208
p/C0CIMMU.m
208
p/C0CIMMU.m
|
@ -1,107 +1,107 @@
|
|||
C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
;
|
||||
; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
;
|
||||
; PROCESS THE IMMUNIZATIONS SECTION OF THE CCR
|
||||
;
|
||||
MAP(IPXML,DFN,OUTXML) ; MAP IMMUNIZATIONS
|
||||
;
|
||||
N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
|
||||
N C0CZT ; TMP ARRAY OF MAPPED XML
|
||||
S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
|
||||
D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
|
||||
N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
|
||||
S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
|
||||
I C0CZIC>0 D ;IMMUNIZATIONS FOUND
|
||||
. F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION
|
||||
. . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
|
||||
. . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
|
||||
. . I C0CZI=1 D ; FIRST ONE
|
||||
. . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
|
||||
. . E D ;NOT THE FIRST
|
||||
. . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")
|
||||
E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
|
||||
N IMMUTMP,I
|
||||
D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W !,"IMMUNE Missing list: ",!
|
||||
. F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
|
||||
Q
|
||||
;
|
||||
;
|
||||
N C0CZV,C0CZVI ; TO STORE MAPPED VARIABLES
|
||||
N C0CZT ; TMP ARRAY OF MAPPED XML
|
||||
S C0CZV=$NA(^TMP("C0CCCR",$J,"IMMUNE")) ; TEMP STORAGE FOR VARIABLES
|
||||
D EXTRACT(IPXML,DFN,OUTXML) ;EXTRACT THE VARIABLES
|
||||
N C0CZI,C0CZIC ; COUNT OF IMMUNIZATIONS
|
||||
S C0CZIC=$G(@C0CZV@(0)) ; TOTAL FROM VARIABLE ARRAY
|
||||
I C0CZIC>0 D ;IMMUNIZATIONS FOUND
|
||||
. F C0CZI=1:1:C0CZIC D ;FOR EACH IMMUNIZATION
|
||||
. . S C0CZVI=$NA(@C0CZV@(C0CZI)) ;THIS IMMUNIZATION
|
||||
. . D MAP^C0CXPATH(IPXML,C0CZVI,"C0CZT") ;MAP THE VARIABLES TO XML
|
||||
. . I C0CZI=1 D ; FIRST ONE
|
||||
. . . D CP^C0CXPATH("C0CZT",OUTXML) ;JUST COPY RESULTS
|
||||
. . E D ;NOT THE FIRST
|
||||
. . . D INSINNER^C0CXPATH(OUTXML,"C0CZT")
|
||||
E S @OUTXML@(0)=0 ; SIGNAL NO IMMUNIZATIONS
|
||||
N IMMUTMP,I
|
||||
D MISSING^C0CXPATH(OUTXML,"IMMUTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I IMMUTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W !,"IMMUNE Missing list: ",!
|
||||
. F I=1:1:IMMUTMP(0) W IMMUTMP(I),!
|
||||
Q
|
||||
;
|
||||
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT IMMUNIZATIONS INTO VARIABLES
|
||||
;
|
||||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
|
||||
; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
|
||||
; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
|
||||
; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
|
||||
;
|
||||
N RPCRSLT,J,K,PTMP,X,VMAP,TBU
|
||||
S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))
|
||||
S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))
|
||||
S IMMA=$NA(^TMP("PXI",$J)) ;
|
||||
K @IMMA ; CLEAR OUT PREVIOUS RESULTS
|
||||
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
|
||||
D IMMUN^PXRHS03(DFN) ;
|
||||
I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL
|
||||
. W "NULL RESULT FROM IMMUN^PXRHS03 ",!
|
||||
. S @TVMAP@(0)=0
|
||||
N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
|
||||
S C0CIM=""
|
||||
S C0CC=0 ; COUNT
|
||||
F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
|
||||
. S C0CC=C0CC+1 ;INCREMENT COUNT
|
||||
. S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
|
||||
. S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
|
||||
. K @VMAP ; MAKE SURE IT IS CLEARED OUT
|
||||
. W C0CIM,!
|
||||
. S C0CIMD="" ; IMMUNE DATE
|
||||
. F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE
|
||||
. . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
|
||||
. . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
|
||||
. . W C0CIEN,"_",C0CIMD
|
||||
. . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
|
||||
. . W C0CT,!
|
||||
. . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
|
||||
. . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
|
||||
. . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
|
||||
. . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
|
||||
. . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
|
||||
. . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
|
||||
. . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS
|
||||
. . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
|
||||
. . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
|
||||
. . . ; FOR LOOKING UP THE CODE
|
||||
. . . ; GET IT FROM THE CODE FILE
|
||||
. . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
|
||||
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
|
||||
. . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
|
||||
. . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
|
||||
. . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
|
||||
. . E D ; NOT IN RPMS
|
||||
. . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
|
||||
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
|
||||
. . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
|
||||
. . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
|
||||
N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
|
||||
M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES
|
||||
Q
|
||||
;
|
||||
;
|
||||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
|
||||
; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
|
||||
; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
|
||||
; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
|
||||
;
|
||||
N RPCRSLT,J,K,PTMP,X,VMAP,TBU
|
||||
S TVMAP=$NA(^TMP("C0CCCR",$J,"IMMUNE"))
|
||||
S TARYTMP=$NA(^TMP("C0CCCR",$J,"IMMUARYTMP"))
|
||||
S IMMA=$NA(^TMP("PXI",$J)) ;
|
||||
K @IMMA ; CLEAR OUT PREVIOUS RESULTS
|
||||
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
|
||||
D IMMUN^PXRHS03(DFN) ;
|
||||
I $O(@IMMA@(""))="" D Q ; RPC RETURNS NULL
|
||||
. W "NULL RESULT FROM IMMUN^PXRHS03 ",!
|
||||
. S @TVMAP@(0)=0
|
||||
N C0CIM,C0CC,C0CIMD,C0CIEN,C0CT ;
|
||||
S C0CIM=""
|
||||
S C0CC=0 ; COUNT
|
||||
F S C0CIM=$O(@IMMA@(C0CIM)) Q:C0CIM="" D ; FOR EACH IMMUNE TYPE IN THE LIST
|
||||
. S C0CC=C0CC+1 ;INCREMENT COUNT
|
||||
. S @TVMAP@(0)=C0CC ; SAVE NEW COUNT TO ARRAY
|
||||
. S VMAP=$NA(@TVMAP@(C0CC)) ; THIS IMMUNE ELEMENT
|
||||
. K @VMAP ; MAKE SURE IT IS CLEARED OUT
|
||||
. W C0CIM,!
|
||||
. S C0CIMD="" ; IMMUNE DATE
|
||||
. F S C0CIMD=$O(@IMMA@(C0CIM,C0CIMD)) Q:C0CIMD="" D ; FOR EACH DATE
|
||||
. . S C0CIEN=$O(@IMMA@(C0CIM,C0CIMD,"")) ;IEN OF IMMUNE RECORD
|
||||
. . D GETN^C0CRNF("C0CI",9000010.11,C0CIEN) ; GET THE FILEMAN RECORD FOR IENS
|
||||
. . W C0CIEN,"_",C0CIMD
|
||||
. . S C0CT=$$FMDTOUTC^C0CUTIL(9999999-C0CIMD,"DT") ; FORMAT DATE/TIME
|
||||
. . W C0CT,!
|
||||
. . S @VMAP@("IMMUNEOBJECTID")="IMMUNIZATION_"_C0CC ;UNIQUE OBJECT ID
|
||||
. . S @VMAP@("IMMUNEDATETIMETYPETEXT")="Immunization Date" ; ALL ARE THE SAME
|
||||
. . S @VMAP@("IMMUNEDATETIME")=C0CT ;FORMATTED DATE/TIME
|
||||
. . S C0CIP=$$ZVALUEI^C0CRNF("ENCOUNTER PROVIDER","C0CI") ;IEN OF PROVIDER
|
||||
. . S @VMAP@("IMMUNESOURCEACTORID")="ACTORPROVIDER_"_C0CIP
|
||||
. . S C0CIIEN=$$ZVALUEI^C0CRNF("IMMUNIZATION","C0CI") ;IEN OF IMMUNIZATION
|
||||
. . I $G(DUZ("AG"))="I" D ; RUNNING IN RPMS
|
||||
. . . D GETN^C0CRNF("C0CZIM",9999999.14,C0CIIEN) ;GET IMMUNE RECORD
|
||||
. . . S C0CIN=$$ZVALUE^C0CRNF("NAME","C0CZIM") ; USE NAME IN IMMUNE RECORD
|
||||
. . . ; FOR LOOKING UP THE CODE
|
||||
. . . ; GET IT FROM THE CODE FILE
|
||||
. . . S C0CICD=$$ZVALUE^C0CRNF("HL7-CVX CODE","C0CZIM") ;CVX CODE
|
||||
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
|
||||
. . . S @VMAP@("IMMUNEPRODUCTCODE")=C0CICD ; CVX CODE
|
||||
. . . I C0CICD'="" S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="CDC Vaccine Code" ;
|
||||
. . . E S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NULL
|
||||
. . E D ; NOT IN RPMS
|
||||
. . . S C0CIN=$$ZVALUE^C0CRNF("IMMUNIZATION","C0CI") ;NAME OF IMMUNIZATION
|
||||
. . . S @VMAP@("IMMUNEPRODUCTNAMETEXT")=C0CIN ;NAME
|
||||
. . . S @VMAP@("IMMUNEPRODUCTCODE")="" ; CVX CODE
|
||||
. . . S @VMAP@("IMMUNEPRODUCTCODESYSTEM")="" ;NO CODE
|
||||
N C0CIRIM S C0CIRIM=$NA(^TMP("C0CRIM","VARS",DFN,"IMMUNE"))
|
||||
M @C0CIRIM=@TVMAP ; PERSIST RIM VARIABLES
|
||||
Q
|
||||
;
|
||||
|
|
382
p/C0CIN.m
382
p/C0CIN.m
|
@ -1,193 +1,193 @@
|
|||
C0CIN ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
|
||||
;;1.0;C0C;;Sep 20, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR Import Utility Library ",!
|
||||
Q
|
||||
;
|
||||
TEST ; TESTS BOTH ROUTINES AT ONCE
|
||||
N ZI,ZJ
|
||||
S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing /
|
||||
S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient
|
||||
D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI)
|
||||
Q
|
||||
;
|
||||
RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) ; ARRAY IN RPC - ACCEPT AN XML DOCUMENT
|
||||
; AND STORE IT IN THE INCOMING XML FILE
|
||||
; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR
|
||||
I $G(DFN)="" S RTN="DFN NOT DEFINED" Q ;
|
||||
N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE
|
||||
N C0CFDA,ZX
|
||||
S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT
|
||||
S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD
|
||||
S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE
|
||||
S C0CFDA(C0CXF,"+1,",2)=TYPE ;TYPE
|
||||
S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE
|
||||
S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED
|
||||
D UPDIE ; CREATE THE RECORD
|
||||
S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER
|
||||
D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR")
|
||||
;W "RECORD:",ZX,!
|
||||
S RTN=ZX ; RETURN IEN OF THE XML FILE
|
||||
Q
|
||||
;
|
||||
ADDSRC(ZSRC) ;EXTRISIC TO ADD A SOURCE TO THE CCR SOURCE FILE
|
||||
; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER
|
||||
;
|
||||
N ZX,ZF,C0CFDA
|
||||
S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE
|
||||
S C0CFDA(ZF,"?+1,",.01)=ZSRC
|
||||
D UPDIE
|
||||
Q $O(^C0C(171.401,"B",ZSRC,""))
|
||||
;
|
||||
RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT
|
||||
; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE
|
||||
N ZX,ZTMP
|
||||
I $E($RE(FP))'="/" S ZX=FP_"/"
|
||||
E S ZX=FP
|
||||
S ZX=ZX_FN
|
||||
D LOAD("ZTMP",ZX)
|
||||
I '$D(ZTMP) D Q ; NO LUCK
|
||||
. W "FILE NOT LOADED",!
|
||||
D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP")
|
||||
N C0CFDA
|
||||
S C0CFDA(175,RTN_",",5)=FN ; FILE NAME
|
||||
S C0CFDA(175,RTN_",",6)=FP ; FILE PATH
|
||||
D UPDIE ; UPDATE WITH FILE NAME AND PATH
|
||||
Q
|
||||
;
|
||||
RPCLIST(RTN,DFN) ; CCR LIST - LIST XML DOCUMENTS FOR PATIENT DFN
|
||||
; THAT ARE STORED IN THE INCOMING XML FILE
|
||||
; RETURNS AN ARRAY OF THE FORM
|
||||
; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE
|
||||
; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT
|
||||
; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE
|
||||
; TYPE IS "CCD" OR "CCR" OR "OTHER"
|
||||
; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE
|
||||
; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED)
|
||||
; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML
|
||||
N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE
|
||||
N ZI S ZI=""
|
||||
N ZN S ZN=0
|
||||
F S ZI=$O(^C0CIN("B",DFN,ZI),-1) Q:ZI="" D ; FOR EACH RECORD FOR THIS PATIENT
|
||||
. S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY
|
||||
. S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD
|
||||
. S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE
|
||||
. S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE
|
||||
. S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE
|
||||
. S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS
|
||||
. S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY
|
||||
Q
|
||||
;
|
||||
RPCDOC(RTN,IEN) ; RETRIEVE DOCUMENT NUMBER IEN FROM THE INCOMING XML FILE
|
||||
; RETURNED IN ARRAY RTN
|
||||
N ZI
|
||||
S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN")
|
||||
Q
|
||||
;
|
||||
EN(INXML,SOURCE,C0CDFN) ; IMPORT A CCR, PASSED BY NAME INXML
|
||||
; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE
|
||||
; FOR PATIENT C0CDFN
|
||||
;N C0CXP
|
||||
S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN))
|
||||
S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID
|
||||
;S REDUX="//ContinuityOfCareRecord/Body"
|
||||
S REDUX=""
|
||||
D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX)
|
||||
;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR
|
||||
;N ZI,ZJ,ZK
|
||||
S ZI=""
|
||||
F S ZI=$O(C0CXP(ZI)) Q:ZI="" D ; FOR EACH XPATH
|
||||
. D DEMUX^C0CMXP("ZJ",ZI) ;
|
||||
. W ZJ,!
|
||||
. S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH
|
||||
. S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE
|
||||
. S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE
|
||||
. S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,""))
|
||||
. I C0CDICN="" D Q ;
|
||||
. . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC
|
||||
. . S MISSING(ZK)=""
|
||||
. ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA")
|
||||
. S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME
|
||||
. S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE
|
||||
. W C0CSEC,":",C0CVAR,!
|
||||
Q
|
||||
;
|
||||
GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT
|
||||
;PASSED BY NAME
|
||||
N ZT
|
||||
D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000")
|
||||
M @AOUT=ZT
|
||||
Q
|
||||
;
|
||||
TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN
|
||||
W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1)
|
||||
S G=G64(1)
|
||||
S ZI=""
|
||||
F S ZI=$O(G64(1,"OVF",ZI)) Q:ZI="" D ; FOR EVERY OVERFLOW RECORD
|
||||
. S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG
|
||||
S G2=$$DECODE^RGUTUU(G)
|
||||
Q
|
||||
;
|
||||
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
|
||||
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
|
||||
;
|
||||
N ZI,ZN,ZTMP
|
||||
S ZN=1
|
||||
S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
|
||||
S ZN=ZN+1
|
||||
F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ;
|
||||
. S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
|
||||
. S ZN=ZN+1
|
||||
Q
|
||||
;
|
||||
CLEANCR(OUTXML,INXML) ; USE $C(10) TO SEPARATE THE STRING INXML INTO
|
||||
;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME
|
||||
N ZX,ZY,ZN
|
||||
S ZX=1,ZN=1
|
||||
F S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0 D ;
|
||||
. S @OUTXML@(ZN)=$E(G2,ZX,ZY-2)
|
||||
. I @OUTXML@(ZN)'="" S ZN=ZN+1
|
||||
. S ZX=ZY
|
||||
Q
|
||||
;
|
||||
LOAD(ZRTN,filepath) ; load an xml file into the ZRTN array, passed by name
|
||||
n i
|
||||
D ;
|
||||
. n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
|
||||
. s ztmp=$na(^TMP("C0CLOAD",$J))
|
||||
. k @ztmp
|
||||
. s zfile=$re($p($re(filepath),"/",1)) ;file name
|
||||
. s zpath=$p(filepath,zfile,1) ; file path
|
||||
. s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3
|
||||
. m @ZRTN=@ztmp
|
||||
. k @ztmp
|
||||
. s i=$o(@ZRTN@(""),-1) ; highest line number
|
||||
q
|
||||
;
|
||||
;;1.0;C0C;;Sep 20, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR Import Utility Library ",!
|
||||
Q
|
||||
;
|
||||
TEST ; TESTS BOTH ROUTINES AT ONCE
|
||||
N ZI,ZJ
|
||||
S ZI="/home/vademo2/CCR" ;directory purposely leaving off the trailing /
|
||||
S ZJ="PAT_358_CCR_V1_0_21.xml" ; random test patient
|
||||
D RPCFIN(.GPL,358,135,"GPLTEST","CCR",ZJ,ZI)
|
||||
Q
|
||||
;
|
||||
RPCAIN(RTN,DFN,DUZ,SOURCE,TYPE,ARY) ; ARRAY IN RPC - ACCEPT AN XML DOCUMENT
|
||||
; AND STORE IT IN THE INCOMING XML FILE
|
||||
; RETURNS THE IEN OF THE RECORD OR TEXT IF THERE IS AN ERROR
|
||||
I $G(DFN)="" S RTN="DFN NOT DEFINED" Q ;
|
||||
N C0CXF S C0CXF=175 ; FILE NUMBER FOR INCOMING XML FILE
|
||||
N C0CFDA,ZX
|
||||
S C0CFDA(C0CXF,"+1,",.01)=DFN ; PATIENT
|
||||
S C0CFDA(C0CXF,"+1,",.02)=DUZ ; PROVIDER CREATING THE RECORD
|
||||
S C0CFDA(C0CXF,"+1,",1)=$$NOW^XLFDT ;DATE
|
||||
S C0CFDA(C0CXF,"+1,",2)=TYPE ;TYPE
|
||||
S C0CFDA(C0CXF,"+1,",3)=$$ADDSRC(SOURCE) ;SOURCE
|
||||
S C0CFDA(C0CXF,"+1,",7)="NEW" ; STATUS OF NEW FOR NOT PROCESSED
|
||||
D UPDIE ; CREATE THE RECORD
|
||||
S ZX=C0CIEN(1) ; CAPTURE THE RECORD NUMBER
|
||||
D WP^DIE(C0CXF,ZX_",",4,,ARY,"ZERR")
|
||||
;W "RECORD:",ZX,!
|
||||
S RTN=ZX ; RETURN IEN OF THE XML FILE
|
||||
Q
|
||||
;
|
||||
ADDSRC(ZSRC) ;EXTRISIC TO ADD A SOURCE TO THE CCR SOURCE FILE
|
||||
; RETURNS RECORD NUMBER. IF SOURCE EXISTS, JUST RETURNS IT'S RECORD NUMBER
|
||||
;
|
||||
N ZX,ZF,C0CFDA
|
||||
S ZF=171.401 ; FILE NUMBER FOR CCR SOURCE FILE
|
||||
S C0CFDA(ZF,"?+1,",.01)=ZSRC
|
||||
D UPDIE
|
||||
Q $O(^C0C(171.401,"B",ZSRC,""))
|
||||
;
|
||||
RPCFIN(RTN,DFN,DUZ,SOURCE,TYPE,FN,FP) ; FILE IN RPC - READ AN XML DOCUMENT
|
||||
; FROM A HOST FILE AND STORE IT IN THE INCOMING XML FILE
|
||||
N ZX,ZTMP
|
||||
I $E($RE(FP))'="/" S ZX=FP_"/"
|
||||
E S ZX=FP
|
||||
S ZX=ZX_FN
|
||||
D LOAD("ZTMP",ZX)
|
||||
I '$D(ZTMP) D Q ; NO LUCK
|
||||
. W "FILE NOT LOADED",!
|
||||
D RPCAIN(.RTN,DFN,DUZ,SOURCE,TYPE,"ZTMP")
|
||||
N C0CFDA
|
||||
S C0CFDA(175,RTN_",",5)=FN ; FILE NAME
|
||||
S C0CFDA(175,RTN_",",6)=FP ; FILE PATH
|
||||
D UPDIE ; UPDATE WITH FILE NAME AND PATH
|
||||
Q
|
||||
;
|
||||
RPCLIST(RTN,DFN) ; CCR LIST - LIST XML DOCUMENTS FOR PATIENT DFN
|
||||
; THAT ARE STORED IN THE INCOMING XML FILE
|
||||
; RETURNS AN ARRAY OF THE FORM
|
||||
; RTN(x)="IEN^DATE^TYPE^SOURCE^STATUS^CREATEDBY" WHERE
|
||||
; IEN IS THE RECORD NUMBER OF THE XML DOCUMENT
|
||||
; DATE IS THE DATE THE DOCUMENT WAS STORED IN THE FILE
|
||||
; TYPE IS "CCD" OR "CCR" OR "OTHER"
|
||||
; SOURCE IS THE NAME OF THE DOCUMENT SOURCE FROM THE CCR SOURCE FILE
|
||||
; STATUS IS THE STATUS OF THE DOCUMENT (VALUES TO BE DEFINED)
|
||||
; CREATEDBY IS THE NAME OF THE PROVIDER WHO UPLOADED THE XML
|
||||
N ZF S ZF=175 ; FILE NUMBER OF INCOMING XML FILE
|
||||
N ZI S ZI=""
|
||||
N ZN S ZN=0
|
||||
F S ZI=$O(^C0CIN("B",DFN,ZI),-1) Q:ZI="" D ; FOR EACH RECORD FOR THIS PATIENT
|
||||
. S ZN=ZN+1 ;INCREMENT COUNT OF RETURN ARRAY
|
||||
. S $P(RTN(ZN),"^",1)=ZI ; IEN OF RECORD
|
||||
. S $P(RTN(ZN),"^",2)=$$GET1^DIQ(ZF,ZI_",",1,"E") ;DATE
|
||||
. S $P(RTN(ZN),"^",3)=$$GET1^DIQ(ZF,ZI_",",2,"E") ;TYPE
|
||||
. S $P(RTN(ZN),"^",4)=$$GET1^DIQ(ZF,ZI_",",3,"E") ;SOURCE
|
||||
. S $P(RTN(ZN),"^",5)=$$GET1^DIQ(ZF,ZI_",",7,"I") ; STATUS
|
||||
. S $P(RTN(ZN),"^",6)=$$GET1^DIQ(ZF,ZI_",",.02,"E") ; CREATED BY
|
||||
Q
|
||||
;
|
||||
RPCDOC(RTN,IEN) ; RETRIEVE DOCUMENT NUMBER IEN FROM THE INCOMING XML FILE
|
||||
; RETURNED IN ARRAY RTN
|
||||
N ZI
|
||||
S ZI=$$GET1^DIQ(175,IEN_",",4,,"RTN")
|
||||
Q
|
||||
;
|
||||
EN(INXML,SOURCE,C0CDFN) ; IMPORT A CCR, PASSED BY NAME INXML
|
||||
; FILE UNDER SOURCE, WHICH IS A POINTER TO THE CCR SOURCE FILE
|
||||
; FOR PATIENT C0CDFN
|
||||
;N C0CXP
|
||||
S C0CINB=$NA(^TMP("C0CIN",$J,"VARS",C0CDFN))
|
||||
S C0CDOCID=$$PARSE^C0CMXML(INXML) ;W !,"DocID: ",C0CDOCID
|
||||
;S REDUX="//ContinuityOfCareRecord/Body"
|
||||
S REDUX=""
|
||||
D XPATH^C0CMXML(1,"/","C0CIDX","C0CXP",,REDUX)
|
||||
;D INDEX^C0CXPATH(INXML,"C0CXP",-1) ; GENERATE XPATHS FROM THE CCR
|
||||
;N ZI,ZJ,ZK
|
||||
S ZI=""
|
||||
F S ZI=$O(C0CXP(ZI)) Q:ZI="" D ; FOR EACH XPATH
|
||||
. D DEMUX^C0CMXP("ZJ",ZI) ;
|
||||
. W ZJ,!
|
||||
. S ZK=$P(ZJ,"^",3) ; PULL OUT THE XPATH
|
||||
. S ZM=$P(ZJ,"^",1) ; PULL OUT THE MULTIPLE
|
||||
. S ZS=$P(ZJ,"^",2) ; PULL OUT THE SUBMULTIPLE
|
||||
. S C0CDICN=$O(^C0CDIC(170,"XPATH",ZK,""))
|
||||
. I C0CDICN="" D Q ;
|
||||
. . W "MISSING XPATH:",!,ZK,! ; OOPS, XPATH NOT IN C0CDIC
|
||||
. . S MISSING(ZK)=""
|
||||
. ;D GETS^DIQ(170,C0CDICN_",","*",,"C0CFDA")
|
||||
. S C0CVAR=$$GET1^DIQ(170,C0CDICN_",",.01) ; VARIABLE NAME
|
||||
. S C0CSEC=$$GET1^DIQ(170,C0CDICN_",",12) ;ELEMENT TYPE
|
||||
. W C0CSEC,":",C0CVAR,!
|
||||
Q
|
||||
;
|
||||
GETACCR(AOUT,C0CDFN) ; EXTRACT A CCR FOR PATIENT ADFN AND PUT IT IN ARRAY AOUT
|
||||
;PASSED BY NAME
|
||||
N ZT
|
||||
D CCRRPC^C0CCCR(.ZT,C0CDFN,"LABLIMIT:T-1000")
|
||||
M @AOUT=ZT
|
||||
Q
|
||||
;
|
||||
TEST64 ;TEST BASE64 DECODING FOR IMPORTING CCR FROM THE NHIN
|
||||
W $$FTG^%ZISH("/tmp/","base64_encoded_ccr.txt","G64(1)",1)
|
||||
S G=G64(1)
|
||||
S ZI=""
|
||||
F S ZI=$O(G64(1,"OVF",ZI)) Q:ZI="" D ; FOR EVERY OVERFLOW RECORD
|
||||
. S G=G_G64(1,"OVF",ZI) ;HOPE IT'S NOT TOO BIG
|
||||
S G2=$$DECODE^RGUTUU(G)
|
||||
Q
|
||||
;
|
||||
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
|
||||
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
|
||||
;
|
||||
N ZI,ZN,ZTMP
|
||||
S ZN=1
|
||||
S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
|
||||
S ZN=ZN+1
|
||||
F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ;
|
||||
. S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
|
||||
. S ZN=ZN+1
|
||||
Q
|
||||
;
|
||||
CLEANCR(OUTXML,INXML) ; USE $C(10) TO SEPARATE THE STRING INXML INTO
|
||||
;AN ARRAY OUTXML(n) OUTXML AND INXML PASSED BY NAME
|
||||
N ZX,ZY,ZN
|
||||
S ZX=1,ZN=1
|
||||
F S ZY=$F(@INXML,$C(10),ZX) Q:ZY=0 D ;
|
||||
. S @OUTXML@(ZN)=$E(G2,ZX,ZY-2)
|
||||
. I @OUTXML@(ZN)'="" S ZN=ZN+1
|
||||
. S ZX=ZY
|
||||
Q
|
||||
;
|
||||
LOAD(ZRTN,filepath) ; load an xml file into the ZRTN array, passed by name
|
||||
n i
|
||||
D ;
|
||||
. n zfile,zpath,ztmp,zok s (zfile,zpath,ztmp)=""
|
||||
. s ztmp=$na(^TMP("C0CLOAD",$J))
|
||||
. k @ztmp
|
||||
. s zfile=$re($p($re(filepath),"/",1)) ;file name
|
||||
. s zpath=$p(filepath,zfile,1) ; file path
|
||||
. s zok=$$FTG^%ZISH(zpath,zfile,$NA(@ztmp@(1)),3) ; import the file incr sub 3
|
||||
. m @ZRTN=@ztmp
|
||||
. k @ztmp
|
||||
. s i=$o(@ZRTN@(""),-1) ; highest line number
|
||||
q
|
||||
;
|
||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||
K ZERR,C0CIEN
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
K ZERR,C0CIEN
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","C0CIEN","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
C0CLA7Q ;WV/JMC - CCD/CCR Lab HL7 Query Utility ;Jul 6, 2009
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;
|
||||
;
|
||||
Q
|
||||
|
|
781
p/C0CLABS.m
781
p/C0CLABS.m
|
@ -1,390 +1,391 @@
|
|||
C0CALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
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
|
||||
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
||||
; MIXML IS THE TEMPLATE TO USE
|
||||
; MOXML IS THE OUTPUT XML ARRAY
|
||||
; DFN IS THE PATIENT RECORD NUMBER
|
||||
N C0COXML,C0CO,C0CV,C0CIXML
|
||||
I '$D(MIVAR) S C0CV="" ;DEFAULT
|
||||
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
|
||||
I '$D(MIXML) S C0CIXML="" ;DEFAULT
|
||||
E S C0CIXML=MIXML ;PASSED INPUT XML
|
||||
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
|
||||
E S C0CO=MOXML
|
||||
; ZWR C0COXML
|
||||
M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
|
||||
Q
|
||||
;
|
||||
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
||||
; RTN IS PASSED BY REFERENCE
|
||||
;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
|
||||
;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
|
||||
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
|
||||
I RMIXML="" D ; INPUT XML NOT PASSED
|
||||
. D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
|
||||
. D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
|
||||
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
|
||||
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
|
||||
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
|
||||
. S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
|
||||
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
|
||||
D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
|
||||
D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
|
||||
D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
|
||||
I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT
|
||||
I 'C0CQT D ; WE ARE DEBUGGING
|
||||
. W "I MAPPED",!
|
||||
. W "VARS:",C0CV,!
|
||||
. W "DFN:",DFN,!
|
||||
. ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE
|
||||
. ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR)
|
||||
. ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX)
|
||||
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
|
||||
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
||||
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
||||
I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
|
||||
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
||||
K @RIMVARS
|
||||
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
||||
N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP
|
||||
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
|
||||
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
|
||||
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
|
||||
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
|
||||
; TO IMPROVE PERFORMANCE
|
||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
|
||||
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
|
||||
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
|
||||
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
|
||||
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
|
||||
. I 'C0CQT W "MAPOBR:",C0CMAP,!
|
||||
. ;MAPPING FOR TEST REQUEST GOES HERE
|
||||
. D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
|
||||
. ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
|
||||
. D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
|
||||
. I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
|
||||
. . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
|
||||
. . K C0CTO ; CLEAR OUTPUT VARIABLE
|
||||
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
|
||||
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
|
||||
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
|
||||
. . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
|
||||
. . . I 'C0CQT W "MAPOBX:",C0CTMAP,!
|
||||
. . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
|
||||
. . . 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>
|
||||
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
|
||||
. . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
|
||||
. . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY
|
||||
. . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML
|
||||
. . . ;E D INSINNER^C0CXPATH("C0CTO","C0CTMP")
|
||||
. . . ;
|
||||
. . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER
|
||||
. . ; I 'C0CQT D PARY^C0CXPATH("C0CTO")
|
||||
. . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST
|
||||
. ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
|
||||
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
||||
. ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
|
||||
. . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;
|
||||
. ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
|
||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
||||
D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
|
||||
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
|
||||
Q
|
||||
;
|
||||
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
|
||||
;
|
||||
; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
;
|
||||
;
|
||||
N C0CNSSN ; IS THERE AN SSN FLAG
|
||||
S C0CNSSN=0
|
||||
S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||||
D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
|
||||
I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
|
||||
. S @C0CLB@(0)=0
|
||||
K @C0CLB ; CLEAR OUT OLD VARS IF ANY
|
||||
N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG
|
||||
S C0CQT=1 ; SURPRESS LISTING
|
||||
D LIST ; EXTRACT THE VARIABLES
|
||||
S C0CQT=QTSAV ; RESET SILENT FLAG
|
||||
K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
|
||||
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
|
||||
Q
|
||||
;
|
||||
GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
|
||||
; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
|
||||
; SET UP FOR LAB API CALL
|
||||
S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
|
||||
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
|
||||
;
|
||||
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
||||
;
|
||||
; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
|
||||
I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||||
I '$D(C0CQT) S C0CQT=0
|
||||
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
|
||||
I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE
|
||||
I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION
|
||||
I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
|
||||
S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
|
||||
S C0CHB=$NA(^TMP("HLS",$J))
|
||||
S C0CI=""
|
||||
S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
|
||||
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
|
||||
. K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
|
||||
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
|
||||
. D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
|
||||
. M XV=C0CVAR ;
|
||||
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
|
||||
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
|
||||
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
|
||||
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
|
||||
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
|
||||
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
|
||||
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
|
||||
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||||
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
||||
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
|
||||
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
|
||||
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3
|
||||
. . ; RESULTTESTCODEVALUE
|
||||
. . ; RESULTTESTDESCRIPTIONTEXT
|
||||
. . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESCRIPTION TEXT
|
||||
. . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
|
||||
. . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
|
||||
. . E D ; NO SECONDARY, USE PRIMARY
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
|
||||
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
|
||||
. . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
|
||||
. . ;S XV("RESULTTESTNORMALDESCTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
|
||||
. . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
|
||||
. . S C0CZG=XV("RESULTTESTVALUE")
|
||||
. . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
|
||||
. . ;S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
|
||||
. . S XV("RESULTTESTVALUE")=C0CZG
|
||||
. I C0CTYP="OBX" D ; PROCESS TEST RESULTS
|
||||
. . 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
|
||||
. . ; I 'C0CQT ZWR XV
|
||||
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
|
||||
. I 'C0CQT D ;
|
||||
. . W C0CI," ",C0CTYP,!
|
||||
. ; S C0CI=$O(@C0CHB@(C0CI))
|
||||
;K ^TMP("C0CRIM","VARS",DFN,"RESULTS")
|
||||
;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB
|
||||
Q
|
||||
LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
|
||||
S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
|
||||
I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
|
||||
E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
|
||||
I 1 D ; FOR HL7 SEGMENT TYPE
|
||||
. S OI="" ; INDEX INTO FIELDS IN SEG
|
||||
. F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
|
||||
. . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
|
||||
. . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
|
||||
. . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
|
||||
. . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
|
||||
. . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
|
||||
. . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
|
||||
. . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
|
||||
. . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE
|
||||
. . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
|
||||
Q
|
||||
LOBX ;
|
||||
Q
|
||||
;
|
||||
OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
|
||||
N GA,GF,GD
|
||||
S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
|
||||
S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
|
||||
S GD=^TMP("C0CCCR","ODIR")
|
||||
W $$OUTPUT^C0CXPATH(GA,GF,GD)
|
||||
Q
|
||||
;
|
||||
SETTBL ;
|
||||
K X ; CLEAR X
|
||||
S X("PID","PID1")="1^00104^Set ID - Patient ID"
|
||||
S X("PID","PID2")="2^00105^Patient ID (External ID)"
|
||||
S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
|
||||
S X("PID","PID4")="4^00107^Alternate Patient ID"
|
||||
S X("PID","PID5")="5^00108^Patient's Name"
|
||||
S X("PID","PID6")="6^00109^Mother's Maiden Name"
|
||||
S X("PID","PID7")="7^00110^Date of Birth"
|
||||
S X("PID","PID8")="8^00111^Sex"
|
||||
S X("PID","PID9")="9^00112^Patient Alias"
|
||||
S X("PID","PID10")="10^00113^Race"
|
||||
S X("PID","PID11")="11^00114^Patient Address"
|
||||
S X("PID","PID12")="12^00115^County Code"
|
||||
S X("PID","PID13")="13^00116^Phone Number - Home"
|
||||
S X("PID","PID14")="14^00117^Phone Number - Business"
|
||||
S X("PID","PID15")="15^00118^Language - Patient"
|
||||
S X("PID","PID16")="16^00119^Marital Status"
|
||||
S X("PID","PID17")="17^00120^Religion"
|
||||
S X("PID","PID18")="18^00121^Patient Account Number"
|
||||
S X("PID","PID19")="19^00122^SSN Number - Patient"
|
||||
S X("PID","PID20")="20^00123^Drivers License - Patient"
|
||||
S X("PID","PID21")="21^00124^Mother's Identifier"
|
||||
S X("PID","PID22")="22^00125^Ethnic Group"
|
||||
S X("PID","PID23")="23^00126^Birth Place"
|
||||
S X("PID","PID24")="24^00127^Multiple Birth Indicator"
|
||||
S X("PID","PID25")="25^00128^Birth Order"
|
||||
S X("PID","PID26")="26^00129^Citizenship"
|
||||
S X("PID","PID27")="27^00130^Veteran.s Military Status"
|
||||
S X("PID","PID28")="28^00739^Nationality"
|
||||
S X("PID","PID29")="29^00740^Patient Death Date/Time"
|
||||
S X("PID","PID30")="30^00741^Patient Death Indicator"
|
||||
S X("NTE","NTE1")="1^00573^Set ID - NTE"
|
||||
S X("NTE","NTE2")="2^00574^Source of Comment"
|
||||
S X("NTE","NTE3")="3^00575^Comment"
|
||||
S X("ORC","ORC1")="1^00215^Order Control"
|
||||
S X("ORC","ORC2")="2^00216^Placer Order Number"
|
||||
S X("ORC","ORC3")="3^00217^Filler Order Number"
|
||||
S X("ORC","ORC4")="4^00218^Placer Order Number"
|
||||
S X("ORC","ORC5")="5^00219^Order Status"
|
||||
S X("ORC","ORC6")="6^00220^Response Flag"
|
||||
S X("ORC","ORC7")="7^00221^Quantity/Timing"
|
||||
S X("ORC","ORC8")="8^00222^Parent"
|
||||
S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
|
||||
S X("ORC","ORC10")="10^00224^Entered By"
|
||||
S X("ORC","ORC11")="11^00225^Verified By"
|
||||
S X("ORC","ORC12")="12^00226^Ordering Provider"
|
||||
S X("ORC","ORC13")="13^00227^Enterer's Location"
|
||||
S X("ORC","ORC14")="14^00228^Call Back Phone Number"
|
||||
S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
|
||||
S X("ORC","ORC16")="16^00230^Order Control Code Reason"
|
||||
S X("ORC","ORC17")="17^00231^Entering Organization"
|
||||
S X("ORC","ORC18")="18^00232^Entering Device"
|
||||
S X("ORC","ORC19")="19^00233^Action By"
|
||||
S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
|
||||
S X("OBR","OBR2")="2^00216^Placer Order Number"
|
||||
S X("OBR","OBR3")="3^00217^Filler Order Number"
|
||||
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;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","OBR5")="5^00239^Priority"
|
||||
S X("OBR","OBR6")="6^00240^Requested Date/Time"
|
||||
S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
|
||||
S X("OBR","OBR8")="8^00242^Observation End Date/Time"
|
||||
S X("OBR","OBR9")="9^00243^Collection Volume"
|
||||
S X("OBR","OBR10")="10^00244^Collector Identifier"
|
||||
S X("OBR","OBR11")="11^00245^Specimen Action Code"
|
||||
S X("OBR","OBR12")="12^00246^Danger Code"
|
||||
S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
|
||||
S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
|
||||
S X("OBR","OBR15")="15^00249^Specimen Source"
|
||||
S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
|
||||
S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
|
||||
S X("OBR","OBR18")="18^00251^Placers Field 1"
|
||||
S X("OBR","OBR19")="19^00252^Placers Field 2"
|
||||
S X("OBR","OBR20")="20^00253^Filler Field 1"
|
||||
S X("OBR","OBR21")="21^00254^Filler Field 2"
|
||||
S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
|
||||
S X("OBR","OBR23")="23^00256^Charge to Practice"
|
||||
S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
|
||||
S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
|
||||
S X("OBR","OBR26")="26^00259^Parent Result"
|
||||
S X("OBR","OBR27")="27^00221^Quantity/Timing"
|
||||
S X("OBR","OBR28")="28^00260^Result Copies to"
|
||||
S X("OBR","OBR29")="29^00261^Parent Number"
|
||||
S X("OBR","OBR30")="30^00262^Transportation Mode"
|
||||
S X("OBR","OBR31")="31^00263^Reason for Study"
|
||||
S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
|
||||
S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
|
||||
S X("OBR","OBR34")="34^00266^Technician"
|
||||
S X("OBR","OBR35")="35^00267^Transcriptionist"
|
||||
S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
|
||||
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","OBR39")="39^01030^Collector.s Comment"
|
||||
S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
|
||||
S X("OBR","OBR41")="41^01032^Transport Arranged"
|
||||
S X("OBR","OBR42")="42^01033^Escort Required"
|
||||
S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
|
||||
S X("OBX","OBX1")="1^00559^Set ID - OBX"
|
||||
S X("OBX","OBX2")="2^00676^Value Type"
|
||||
S X("OBX","OBX3")="3^00560^Observation Identifier"
|
||||
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;C3")="3;3^00560^Observation Identifier^C3"
|
||||
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;C6")="3;6^00560^Observation Identifier^C6"
|
||||
S X("OBX","OBX4")="4^00769^Observation Sub-Id"
|
||||
S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
|
||||
S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
|
||||
S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
|
||||
S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
|
||||
S X("OBX","OBX9")="9^00639^Probability"
|
||||
S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
|
||||
S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
|
||||
S X("OBX","OBX12")="12^00567^Date Last Normal Value"
|
||||
S X("OBX","OBX13")="13^00581^User Defined Access Checks"
|
||||
S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
|
||||
S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
|
||||
S X("OBX","OBX16")="16^00584^Responsible Observer"
|
||||
S X("OBX","OBX17")="17^00936^Observation Method"
|
||||
K ^TMP("C0CCCR","LABTBL")
|
||||
M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
|
||||
S ^TMP("C0CCCR","LABTBL",0)="V3"
|
||||
Q
|
||||
;
|
||||
C0CALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
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
|
||||
; MIXML,MIVAR, AND MOXML ARE PASSED BY NAME
|
||||
; MIXML IS THE TEMPLATE TO USE
|
||||
; MOXML IS THE OUTPUT XML ARRAY
|
||||
; DFN IS THE PATIENT RECORD NUMBER
|
||||
N C0COXML,C0CO,C0CV,C0CIXML
|
||||
I '$D(MIVAR) S C0CV="" ;DEFAULT
|
||||
E S C0CV=MIVAR ;PASSED VARIABLE ARRAY
|
||||
I '$D(MIXML) S C0CIXML="" ;DEFAULT
|
||||
E S C0CIXML=MIXML ;PASSED INPUT XML
|
||||
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
|
||||
E S C0CO=MOXML
|
||||
; ZWR C0COXML
|
||||
M @C0CO=C0COXML ; COPY RESULTS TO OUTPUT
|
||||
Q
|
||||
;
|
||||
RPCMAP(RTN,DFN,RMIVAR,RMIXML) ; RPC ENTRY POINT FOR MAPPING RESULTS
|
||||
; RTN IS PASSED BY REFERENCE
|
||||
;N C0CT0,C0CT,C0CV ; CCR TEMPLATE, RESULTS SUBTEMPLATE, VARIABLES
|
||||
;N C0CRT,C0CTT ; TEST REQUEST TEMPLATE, TEST RESULT TEMPLATE
|
||||
I '$D(DEBUG) S DEBUG=0 ; DEFAULT NO DEBUGGING
|
||||
I RMIXML="" D ; INPUT XML NOT PASSED
|
||||
. D LOAD^C0CCCR0("C0CT0") ; LOAD ENTIRE CCR TEMPLATE
|
||||
. D QUERY^C0CXPATH("C0CT0","//ContinuityOfCareRecord/Body/Results","C0CT0R")
|
||||
. S C0CT="C0CT0R" ; NAME OF EXTRACTED RESULTS TEMPLATE
|
||||
E S C0CT=RMIXML ; WE ARE PASSED THE RESULTS PART OF THE TEMPLATE
|
||||
I RMIVAR="" D ; LOCATION OF VARIABLES NOT PASSED
|
||||
. S C0CV=$NA(^TMP("C0CCCR",$J,"RESULTS")) ;DEFAULT VARIABLE LOCATION
|
||||
E S C0CV=RMIVAR ; PASSED LOCATIONS OF VARS
|
||||
D CP^C0CXPATH(C0CT,"C0CRT") ; START MAKING TEST REQUEST TEMPLATE
|
||||
D REPLACE^C0CXPATH("C0CRT","","//Results/Result/Test") ; DELETE TEST FROM REQ
|
||||
D QUERY^C0CXPATH(C0CT,"//Results/Result/Test","C0CTT") ; MAKE TEST TEMPLATE
|
||||
I '$D(C0CQT) S C0CQT=0 ; DEFAULT NOT SILENT
|
||||
I 'C0CQT D ; WE ARE DEBUGGING
|
||||
. W "I MAPPED",!
|
||||
. W "VARS:",C0CV,!
|
||||
. W "DFN:",DFN,!
|
||||
. ;D PARY^C0CXPATH("C0CT") ; SECTION TEMPLATE
|
||||
. ;D PARY^C0CXPATH("C0CRT") ;REQUEST TEMPLATE (OCR)
|
||||
. ;D PARY^C0CXPATH("C0CTT") ;TEST TEMPLATE (OCX)
|
||||
D EXTRACT("C0CT",DFN,) ; FIRST CALL EXTRACT
|
||||
I '$D(@C0CV@(0)) D Q ; NO VARS THERE
|
||||
. S RTN(0)=0 ; PASS BACK NO RESULTS INDICATOR
|
||||
I @C0CV@(0)=0 S RTN(0)=0 Q ; NO RESULTS
|
||||
S RIMVARS=$NA(^TMP("C0CRIM","VARS",DFN,"RESULTS"))
|
||||
K @RIMVARS
|
||||
M @RIMVARS=@C0CV ; UPDATE RIMVARS SO THEY STAY IN SYNCH
|
||||
N C0CI,C0CJ,C0CMAP,C0CTMAP,C0CTMP
|
||||
S C0CIN=@C0CV@(0) ; COUNT OF RESULTS (OBR)
|
||||
N C0CRTMP ; AREA TO BUILD ONE RESULT REQUEST AND ALL TESTS FOR IT
|
||||
N C0CRBASE S C0CRBASE=$NA(^TMP($J,"TESTTMP")) ;WORK AREA
|
||||
N C0CRBLD ; BUILD LIST FOR XML - THE BUILD IS DELAYED UNTIL THE END
|
||||
; TO IMPROVE PERFORMANCE
|
||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",1,1) ;<Results>
|
||||
F C0CI=1:1:C0CIN D ; LOOP THROUGH VARIABLES
|
||||
. K C0CMAP,C0CTMP ;EMPTY OUT LAST BATCH OF VARIABLES
|
||||
. S C0CRTMP=$NA(@C0CRBASE@(C0CI)) ;PARTITION OF WORK AREA FOR EACH TEST
|
||||
. S C0CMAP=$NA(@C0CV@(C0CI)) ;
|
||||
. I 'C0CQT W "MAPOBR:",C0CMAP,!
|
||||
. ;MAPPING FOR TEST REQUEST GOES HERE
|
||||
. D MAP^C0CXPATH("C0CRT",C0CMAP,C0CRTMP) ; MAP OBR DATA
|
||||
. ;D QOPEN^C0CXPATH("C0CRBLD",C0CRTMP,C0CIS) ;1ST PART OF XML
|
||||
. D QUEUE^C0CXPATH("C0CRBLD",C0CRTMP,2,@C0CRTMP@(0)-4) ;UP TO <Test>
|
||||
. I $D(@C0CMAP@("M","TEST",0)) D ; TESTS EXIST
|
||||
. . S C0CJN=@C0CMAP@("M","TEST",0) ; NUMBER OF TESTS
|
||||
. . K C0CTO ; CLEAR OUTPUT VARIABLE
|
||||
. . F C0CJ=1:1:C0CJN D ;FOR EACH TEST RESULT
|
||||
. . . K C0CTMAP ; EMPTY MAPS FOR TEST RESULTS
|
||||
. . . S C0CTMP=$NA(@C0CRBASE@(C0CI,C0CJ)) ;WORK AREA FOR TEST RESULTS
|
||||
. . . S C0CTMAP=$NA(@C0CMAP@("M","TEST",C0CJ)) ;
|
||||
. . . I 'C0CQT W "MAPOBX:",C0CTMAP,!
|
||||
. . . D MAP^C0CXPATH("C0CTT",C0CTMAP,C0CTMP) ; MAP TO TMP
|
||||
. . . 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>
|
||||
. . . S C0CJS=1 S C0CJE=@C0CTMP@(0) ; INSERT ALL OF THE TEXT XML
|
||||
. . . D QUEUE^C0CXPATH("C0CRBLD",C0CTMP,C0CJS,C0CJE) ; ADD TO BUILD LIST
|
||||
. . . ;I C0CJ=1 D ; FIRST TIME, JUST COPY
|
||||
. . . ;. D CP^C0CXPATH("C0CTMP","C0CTO") ; START BUILDING TEST XML
|
||||
. . . ;E D INSINNER^C0CXPATH("C0CTO","C0CTMP")
|
||||
. . . ;
|
||||
. . . ;D PUSHA^C0CXPATH("C0CTO",C0CTMP) ;ADD THE TEST TO BUFFER
|
||||
. . ; I 'C0CQT D PARY^C0CXPATH("C0CTO")
|
||||
. . ;D INSINNER^C0CXPATH(C0CRTMP,"C0CTO","//Results/Result/Test") ;INSERT TST
|
||||
. ;D QCLOSE^C0CXPATH("C0CRBLD",C0CRTMP,"//Results/Result/Test") ;END OF XML
|
||||
. D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0)-1,C0CRT(0)-1) ;</Result>
|
||||
. ;I C0CI=1 D ; FIRST TIME, COPY INSTEAD OF INSERT
|
||||
. . ;D CP^C0CXPATH(C0CRTMP,"RTN") ;
|
||||
. ;E D INSINNER^C0CXPATH("RTN",C0CRTMP) ; INSERT THIS TEST REQUEST
|
||||
D QUEUE^C0CXPATH("C0CRBLD","C0CRT",C0CRT(0),C0CRT(0)) ;</Results>
|
||||
D BUILD^C0CXPATH("C0CRBLD","RTN") ;RENDER THE XML
|
||||
K @C0CRBASE ; CLEAR OUT TEMPORARY STURCTURE
|
||||
Q
|
||||
;
|
||||
EXTRACT(ILXML,DFN,OLXML) ; EXTRACT LABS INTO THE C0CLVAR GLOBAL
|
||||
;
|
||||
; LABXML AND LABOUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
;
|
||||
;
|
||||
N C0CNSSN ; IS THERE AN SSN FLAG
|
||||
S C0CNSSN=0
|
||||
S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||||
D GHL7 ; GET HL7 MESSAGE FOR THIS PATIENT
|
||||
I C0CNSSN=1 D Q ; NO SSN, CAN'T GET HL7 FOR THIS PATIENT
|
||||
. S @C0CLB@(0)=0
|
||||
K @C0CLB ; CLEAR OUT OLD VARS IF ANY
|
||||
N QTSAV S QTSAV=C0CQT ;SAVE QUIET FLAG
|
||||
S C0CQT=1 ; SURPRESS LISTING
|
||||
D LIST ; EXTRACT THE VARIABLES
|
||||
S C0CQT=QTSAV ; RESET SILENT FLAG
|
||||
K ^TMP("HLS",$J) ; KILL HL7 MESSAGE OUTPUT
|
||||
I $D(OLXML) S @OLXML@(0)=0 ; EXTRACT DOES NOT PRODUCE XML... SEE MAP^C0CLABS
|
||||
Q
|
||||
;
|
||||
GHL7 ; GET HL7 MESSAGE FOR LABS FOR THIS PATIENT
|
||||
; N C0CPTID,C0CSPC,C0CSDT,C0CEDT,C0CR
|
||||
; SET UP FOR LAB API CALL
|
||||
S C0CPTID=$$SSN^C0CDPT(DFN) ; GET THE SSN FOR THIS PATIENT
|
||||
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
|
||||
;
|
||||
LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
||||
;
|
||||
; N C0CI,C0CJ,C0COBT,C0CHB,C0CVAR
|
||||
I '$D(C0CLB) S C0CLB=$NA(^TMP("C0CCCR",$J,"RESULTS")) ; BASE GLB FOR LABS VARS
|
||||
I '$D(C0CQT) S C0CQT=0
|
||||
I '$D(DFN) S DFN=1 ; DEFAULT TEST PATIENT
|
||||
I '$D(^TMP("C0CCCR","LABTBL",0)) D SETTBL ;INITIALIZE LAB TABLE
|
||||
I ^TMP("C0CCCR","LABTBL",0)'="V3" D SETTBL ;NEED NEWEST VERSION
|
||||
I '$D(^TMP("HLS",$J,1)) D GHL7 ; GET HL7 MGS IF NOT ALREADY DONE
|
||||
S C0CTAB=$NA(^TMP("C0CCCR","LABTBL")) ; BASE OF OBX TABLE
|
||||
S C0CHB=$NA(^TMP("HLS",$J))
|
||||
S C0CI=""
|
||||
S @C0CLB@(0)=0 ; INITALIZE RESULTS VARS COUNT
|
||||
F S C0CI=$O(@C0CHB@(C0CI)) Q:C0CI="" D ; FOR ALL RECORDS IN HL7 MSG
|
||||
. K C0CVAR,XV ; CLEAR OUT VARIABLE VALUES
|
||||
. S C0CTYP=$P(@C0CHB@(C0CI),"|",1)
|
||||
. D LTYP(@C0CHB@(C0CI),C0CTYP,.C0CVAR,C0CQT)
|
||||
. M XV=C0CVAR ;
|
||||
. I C0CTYP="OBR" D ; BEGINNING OF NEW SECTION
|
||||
. . S @C0CLB@(0)=@C0CLB@(0)+1 ; INCREMENT COUNT
|
||||
. . S C0CLI=@C0CLB@(0) ; INDEX FOR THIS RESULT
|
||||
. . ;M @C0CLB@(C0CLI)=C0CVAR ; PERSIST THE OBR VARS
|
||||
. . S XV("RESULTOBJECTID")="RESULT_"_C0CLI
|
||||
. . S C0CX1=XV("RESULTSOURCEACTORID") ; SOURCE FROM OBR
|
||||
. . S XV("RESULTSOURCEACTORID")="ACTORPROVIDER_"_$P($P(C0CX1,"^",1),"-",1)
|
||||
. . S C0CX1=XV("RESULTASSESSMENTDATETIME") ;DATE TIME IN HL7 FORMAT
|
||||
. . S C0CX2=$$HL7TFM^XLFDT(C0CX1,"L") ;FM DT LOCAL
|
||||
. . S XV("RESULTASSESSMENTDATETIME")=$$FMDTOUTC^C0CUTIL(C0CX2,"DT") ;UTC TIME
|
||||
. . M @C0CLB@(C0CLI)=XV ; PERSIST THE OBR VARS
|
||||
. . S C0CLOBX=0 ; MARK THE BEGINNING OF A NEW SECTION
|
||||
. I C0CTYP="OBX" D ; SPECIAL CASE FOR OBX3
|
||||
. . ; RESULTTESTCODEVALUE
|
||||
. . ; RESULTTESTDESCRIPTIONTEXT
|
||||
. . I C0CVAR("C3")="LN" D ; PRIMARY CODE IS LOINC
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; THE LOINC CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||||
. . . ;S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; DESC TXT
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2")_" LOINC: "_C0CVAR("C1")
|
||||
. . E I C0CVAR("C6")="LN" D ; SECONDARY CODE IS LOINC
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; THE LOINC CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")="LOINC" ; DISPLAY NAME FOR LOINC
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; DESCRIPTION TEXT
|
||||
. . E I C0CVAR("C6")'="" D ; NO LOINC CODES, USE SECONDARY IF PRESENT
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C4") ; SECONDARY CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C6") ; SECONDARY CODE NAME
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C5") ; SECONDARY TEXT
|
||||
. . E D ; NO SECONDARY, USE PRIMARY
|
||||
. . . S XV("RESULTTESTCODEVALUE")=C0CVAR("C1") ; PRIMARY CODE VALUE
|
||||
. . . S XV("RESULTTESTCODINGSYSTEM")=C0CVAR("C3") ; PRIMARY DISPLAY NAME
|
||||
. . . S XV("RESULTTESTDESCRIPTIONTEXT")=C0CVAR("C2") ; USE PRIMARY TEXT
|
||||
. . N C0CZG S C0CZG=XV("RESULTTESTNORMALDESCTEXT") ;
|
||||
. . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
|
||||
. . ;S XV("RESULTTESTNORMALDESCTEXT")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
|
||||
. . S XV("RESULTTESTNORMALDESCTEXT")=C0CZG
|
||||
. . S C0CZG=XV("RESULTTESTVALUE")
|
||||
. . ; mod to remove local XML escaping rely upon MAP^C0CXPATH
|
||||
. . ;S XV("RESULTTESTVALUE")=$$SYMENC^MXMLUTL(C0CZG) ;ESCAPE
|
||||
. . S XV("RESULTTESTVALUE")=C0CZG
|
||||
. I C0CTYP="OBX" D ; PROCESS TEST RESULTS
|
||||
. . 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
|
||||
. . ; I 'C0CQT ZWR XV
|
||||
. . M @C0CLB2@(C0CLOBX)=XV ; PERSIST THE TEST RESULT VARIABLES
|
||||
. I 'C0CQT D ;
|
||||
. . W C0CI," ",C0CTYP,!
|
||||
. ; S C0CI=$O(@C0CHB@(C0CI))
|
||||
;K ^TMP("C0CRIM","VARS",DFN,"RESULTS")
|
||||
;M ^TMP("C0CRIM","VARS",DFN,"RESULTS")=@C0CLB
|
||||
Q
|
||||
LTYP(OSEG,OTYP,OVARA,OC0CQT) ;
|
||||
S OTAB=$NA(@C0CTAB@(OTYP)) ; TABLE FOR SEGMENT TYPE
|
||||
I '$D(OC0CQT) S C0CQT=0 ; NOT C0CQT IS DEFAULT
|
||||
E S C0CQT=OC0CQT ; ACCEPT C0CQT FLAG
|
||||
I 1 D ; FOR HL7 SEGMENT TYPE
|
||||
. S OI="" ; INDEX INTO FIELDS IN SEG
|
||||
. F S OI=$O(@OTAB@(OI)) Q:OI="" D ; FOR EACH FIELD OF THE SEGMENT
|
||||
. . S OTI=$P(@OTAB@(OI),"^",1) ; TABLE INDEX
|
||||
. . S OVAR=$P(@OTAB@(OI),"^",4) ; CCR VARIABLE IF DEFINED
|
||||
. . S OV=$P(OSEG,"|",OTI+1) ; PULL OUT VALUE
|
||||
. . I $P(OI,";",2)'="" D ; THIS IS DEFINING A SUB-VALUE
|
||||
. . . S OI2=$P(OTI,";",2) ; THE SUB-INDEX
|
||||
. . . S OV=$P(OV,"^",OI2) ; PULL OUT SUB-VALUE
|
||||
. . I OVAR'="" S OVARA(OVAR)=OV ; PASS BACK VARIABLE AND VALUE
|
||||
. . I 'C0CQT D ; PRINT OUTPUT IF C0CQT IS FALSE
|
||||
. . . I OV'="" W OI_": "_$P(@OTAB@(OI),"^",3),": ",OVAR,": ",OV,!
|
||||
Q
|
||||
LOBX ;
|
||||
Q
|
||||
;
|
||||
OUT(DFN) ; WRITE OUT A CCR THAT HAS JUST BEEN PROCESSED (FOR TESTING)
|
||||
N GA,GF,GD
|
||||
S GA=$NA(^TMP("C0CCCR",$J,DFN,"CCR",1))
|
||||
S GF="RPMS_CCR_"_DFN_"_"_DT_".xml"
|
||||
S GD=^TMP("C0CCCR","ODIR")
|
||||
W $$OUTPUT^C0CXPATH(GA,GF,GD)
|
||||
Q
|
||||
;
|
||||
SETTBL ;
|
||||
K X ; CLEAR X
|
||||
S X("PID","PID1")="1^00104^Set ID - Patient ID"
|
||||
S X("PID","PID2")="2^00105^Patient ID (External ID)"
|
||||
S X("PID","PID3")="3^00106^Patient ID (Internal ID)"
|
||||
S X("PID","PID4")="4^00107^Alternate Patient ID"
|
||||
S X("PID","PID5")="5^00108^Patient's Name"
|
||||
S X("PID","PID6")="6^00109^Mother's Maiden Name"
|
||||
S X("PID","PID7")="7^00110^Date of Birth"
|
||||
S X("PID","PID8")="8^00111^Sex"
|
||||
S X("PID","PID9")="9^00112^Patient Alias"
|
||||
S X("PID","PID10")="10^00113^Race"
|
||||
S X("PID","PID11")="11^00114^Patient Address"
|
||||
S X("PID","PID12")="12^00115^County Code"
|
||||
S X("PID","PID13")="13^00116^Phone Number - Home"
|
||||
S X("PID","PID14")="14^00117^Phone Number - Business"
|
||||
S X("PID","PID15")="15^00118^Language - Patient"
|
||||
S X("PID","PID16")="16^00119^Marital Status"
|
||||
S X("PID","PID17")="17^00120^Religion"
|
||||
S X("PID","PID18")="18^00121^Patient Account Number"
|
||||
S X("PID","PID19")="19^00122^SSN Number - Patient"
|
||||
S X("PID","PID20")="20^00123^Drivers License - Patient"
|
||||
S X("PID","PID21")="21^00124^Mother's Identifier"
|
||||
S X("PID","PID22")="22^00125^Ethnic Group"
|
||||
S X("PID","PID23")="23^00126^Birth Place"
|
||||
S X("PID","PID24")="24^00127^Multiple Birth Indicator"
|
||||
S X("PID","PID25")="25^00128^Birth Order"
|
||||
S X("PID","PID26")="26^00129^Citizenship"
|
||||
S X("PID","PID27")="27^00130^Veteran.s Military Status"
|
||||
S X("PID","PID28")="28^00739^Nationality"
|
||||
S X("PID","PID29")="29^00740^Patient Death Date/Time"
|
||||
S X("PID","PID30")="30^00741^Patient Death Indicator"
|
||||
S X("NTE","NTE1")="1^00573^Set ID - NTE"
|
||||
S X("NTE","NTE2")="2^00574^Source of Comment"
|
||||
S X("NTE","NTE3")="3^00575^Comment"
|
||||
S X("ORC","ORC1")="1^00215^Order Control"
|
||||
S X("ORC","ORC2")="2^00216^Placer Order Number"
|
||||
S X("ORC","ORC3")="3^00217^Filler Order Number"
|
||||
S X("ORC","ORC4")="4^00218^Placer Order Number"
|
||||
S X("ORC","ORC5")="5^00219^Order Status"
|
||||
S X("ORC","ORC6")="6^00220^Response Flag"
|
||||
S X("ORC","ORC7")="7^00221^Quantity/Timing"
|
||||
S X("ORC","ORC8")="8^00222^Parent"
|
||||
S X("ORC","ORC9")="9^00223^Date/Time of Transaction"
|
||||
S X("ORC","ORC10")="10^00224^Entered By"
|
||||
S X("ORC","ORC11")="11^00225^Verified By"
|
||||
S X("ORC","ORC12")="12^00226^Ordering Provider"
|
||||
S X("ORC","ORC13")="13^00227^Enterer's Location"
|
||||
S X("ORC","ORC14")="14^00228^Call Back Phone Number"
|
||||
S X("ORC","ORC15")="15^00229^Order Effective Date/Time"
|
||||
S X("ORC","ORC16")="16^00230^Order Control Code Reason"
|
||||
S X("ORC","ORC17")="17^00231^Entering Organization"
|
||||
S X("ORC","ORC18")="18^00232^Entering Device"
|
||||
S X("ORC","ORC19")="19^00233^Action By"
|
||||
S X("OBR","OBR1")="1^00237^Set ID - Observation Request"
|
||||
S X("OBR","OBR2")="2^00216^Placer Order Number"
|
||||
S X("OBR","OBR3")="3^00217^Filler Order Number"
|
||||
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;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","OBR5")="5^00239^Priority"
|
||||
S X("OBR","OBR6")="6^00240^Requested Date/Time"
|
||||
S X("OBR","OBR7")="7^00241^Observation Date/Time^RESULTASSESSMENTDATETIME"
|
||||
S X("OBR","OBR8")="8^00242^Observation End Date/Time"
|
||||
S X("OBR","OBR9")="9^00243^Collection Volume"
|
||||
S X("OBR","OBR10")="10^00244^Collector Identifier"
|
||||
S X("OBR","OBR11")="11^00245^Specimen Action Code"
|
||||
S X("OBR","OBR12")="12^00246^Danger Code"
|
||||
S X("OBR","OBR13")="13^00247^Relevant Clinical Info."
|
||||
S X("OBR","OBR14")="14^00248^Specimen Rcv'd. Date/Time"
|
||||
S X("OBR","OBR15")="15^00249^Specimen Source"
|
||||
S X("OBR","OBR16")="16^00226^Ordering Provider XCN^RESULTSOURCEACTORID"
|
||||
S X("OBR","OBR17")="17^00250^Order Callback Phone Number"
|
||||
S X("OBR","OBR18")="18^00251^Placers Field 1"
|
||||
S X("OBR","OBR19")="19^00252^Placers Field 2"
|
||||
S X("OBR","OBR20")="20^00253^Filler Field 1"
|
||||
S X("OBR","OBR21")="21^00254^Filler Field 2"
|
||||
S X("OBR","OBR22")="22^00255^Results Rpt./Status Change"
|
||||
S X("OBR","OBR23")="23^00256^Charge to Practice"
|
||||
S X("OBR","OBR24")="24^00257^Diagnostic Service Sect"
|
||||
S X("OBR","OBR25")="25^00258^Result Status^RESULTSTATUS"
|
||||
S X("OBR","OBR26")="26^00259^Parent Result"
|
||||
S X("OBR","OBR27")="27^00221^Quantity/Timing"
|
||||
S X("OBR","OBR28")="28^00260^Result Copies to"
|
||||
S X("OBR","OBR29")="29^00261^Parent Number"
|
||||
S X("OBR","OBR30")="30^00262^Transportation Mode"
|
||||
S X("OBR","OBR31")="31^00263^Reason for Study"
|
||||
S X("OBR","OBR32")="32^00264^Principal Result Interpreter"
|
||||
S X("OBR","OBR33")="33^00265^Assistant Result Interpreter"
|
||||
S X("OBR","OBR34")="34^00266^Technician"
|
||||
S X("OBR","OBR35")="35^00267^Transcriptionist"
|
||||
S X("OBR","OBR36")="36^00268^Scheduled Date/Time"
|
||||
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","OBR39")="39^01030^Collector.s Comment"
|
||||
S X("OBR","OBR40")="40^01031^Transport Arrangement Responsibility"
|
||||
S X("OBR","OBR41")="41^01032^Transport Arranged"
|
||||
S X("OBR","OBR42")="42^01033^Escort Required"
|
||||
S X("OBR","OBR43")="43^01034^Planned Patient Transport Comment"
|
||||
S X("OBX","OBX1")="1^00559^Set ID - OBX"
|
||||
S X("OBX","OBX2")="2^00676^Value Type"
|
||||
S X("OBX","OBX3")="3^00560^Observation Identifier"
|
||||
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;C3")="3;3^00560^Observation Identifier^C3"
|
||||
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;C6")="3;6^00560^Observation Identifier^C6"
|
||||
S X("OBX","OBX4")="4^00769^Observation Sub-Id"
|
||||
S X("OBX","OBX5")="5^00561^Observation Results^RESULTTESTVALUE"
|
||||
S X("OBX","OBX6")="6^00562^Units^RESULTTESTUNITS"
|
||||
S X("OBX","OBX7")="7^00563^Reference Range^RESULTTESTNORMALDESCTEXT"
|
||||
S X("OBX","OBX8")="8^00564^Abnormal Flags^RESULTTESTFLAG"
|
||||
S X("OBX","OBX9")="9^00639^Probability"
|
||||
S X("OBX","OBX10")="10^00565^Nature of Abnormal Test"
|
||||
S X("OBX","OBX11")="11^00566^Observ. Result Status^RESULTTESTSTATUSTEXT"
|
||||
S X("OBX","OBX12")="12^00567^Date Last Normal Value"
|
||||
S X("OBX","OBX13")="13^00581^User Defined Access Checks"
|
||||
S X("OBX","OBX14")="14^00582^Date/Time of Observation^RESULTTESTDATETIME"
|
||||
S X("OBX","OBX15")="15^00583^Producer.s ID^RESULTTESTSOURCEACTORID"
|
||||
S X("OBX","OBX16")="16^00584^Responsible Observer"
|
||||
S X("OBX","OBX17")="17^00936^Observation Method"
|
||||
K ^TMP("C0CCCR","LABTBL")
|
||||
M ^TMP("C0CCCR","LABTBL")=X ; SET VALUES IN LAB TBL
|
||||
S ^TMP("C0CCCR","LABTBL",0)="V3"
|
||||
Q
|
||||
;
|
||||
|
|
|
@ -0,0 +1,464 @@
|
|||
C0CMAIL ; Communications for MIME Documents and MultiMIME ; 3110420 ; rcr/rcr
|
||||
V ;;0.1;C0C;nopatch;noreleasedate
|
||||
;Copyright 2011 Chris Richardson, Richardson Computer Research
|
||||
; Modified 3110615@1040
|
||||
; 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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
; ------------------
|
||||
;Entry Points
|
||||
; DETAIL^C0CMAIL(.C0CDATA,IEN) --> Get details of the Mail Message and Attachments
|
||||
; GETMSG^C0CMAIL(.C0CDATA,.C0CINPUT)
|
||||
; Input:
|
||||
; C0CINPUT = "DUZ;MAILBOX_Name[or IEN for box (comma Separated);MALL
|
||||
; or "*" for all boxes, default is "IN" if missing]"
|
||||
; $P(C0CINPUT,";",3)=MALL, default=NUL means "New only",
|
||||
; "*" for All or 9,999 maximum
|
||||
; MALL?1.n = that number of the n most recent
|
||||
; Internally:
|
||||
; BNAM = Box Name
|
||||
; Output:
|
||||
; C0CDATA
|
||||
; = (BNAM,"NUMBER") = Number of NEW Emails in Basket
|
||||
; (BNAM,"MSG",C0CIEN,"FROM")=Name
|
||||
; (BNAM,"MSG",C0CIEN,"TO",n)=DUZ, or EMAIL Address
|
||||
; (BNAM,"MSG",C0CIEN,"TO NAME",n)=Names or EMAIL Address
|
||||
; (BNAM,"MSG",C0CIEN,"TITLE")=EMAIL Title
|
||||
; (BNAM,"MSG",C0CIEN[for File 3.9])=Number of Attachments
|
||||
; (BNAM,"MSG",C0CIEN,num,"CONT") = Free Text
|
||||
; (BNAM,"MSG",C0CIEN,num,"LINES") = Number of Lines of Text
|
||||
; (BNAM,"MSG",C0CIEN,num,"SIZE") = Size of the Message in Bytes
|
||||
; (BNAM,"MSG",C0CIEN,num,"TXT",LINE#) = Message Data (No Attachment)
|
||||
; (BNAM,"MSG",C0CIEN,"SEG",NUM) = First Line^Last Line
|
||||
; (BNAM,"MSG",C0CIEN,"SEG",NUM,"CONT",type) = Message Details
|
||||
; (BNAM,"MSG",C0CIEN,"SEG",NUM,LINE#) = Message Data
|
||||
;
|
||||
; DO DETAIL^C0CMAIL(.OUTBF,D0) ; For each Email Message and Attachments
|
||||
; Input;
|
||||
; D0 - The IEN for the message in file 3.9, MESSAGE global
|
||||
; Output
|
||||
; OUTBF - The array of your choice to save the expanded and decoded message.
|
||||
;
|
||||
GETMSG(C0CDATA,C0CINPUT) ; Common Entry Point for Mailbox Data
|
||||
K:'$G(C0CDATA("KEEP")) C0CDATA
|
||||
N U
|
||||
S U="^"
|
||||
D:$G(C0CINPUT)
|
||||
. N BF,DUZ,I,INPUT,J,L,LST,MBLST,MALL
|
||||
. S INPUT=C0CINPUT
|
||||
. S DUZ=+INPUT
|
||||
. I $D(^VA(200,DUZ))=0!('$D(^VA(200,DUZ,0))) D ERROR("ER06") Q
|
||||
. ;
|
||||
. D:$D(^XMB(3.7,DUZ,0))#2
|
||||
. . S MBLST=$P(INPUT,";",2)
|
||||
. . S MALL=$P(INPUT,";",3) ; New or All Mail Flag
|
||||
. . S:MALL["*" MALL=99999
|
||||
. . ; Only one of these can be correct
|
||||
. . D
|
||||
. . . ; If nul, make it "IN" only
|
||||
. . . I MBLST="" D QUIT
|
||||
. . . . S MBLST("IN")=0,I=0
|
||||
. . . . D GATHER(DUZ,"IN",.LST)
|
||||
. . . .QUIT
|
||||
. . . ;
|
||||
. . . ; If "*", Get all Mailboxes and look for New Messages
|
||||
. . . I MBLST["*" D QUIT
|
||||
. . . . N NAM,NUM
|
||||
. . . . S NUM=0
|
||||
. . . . F S NUM=$O(^XMB(3.7,DUZ,2,NUM)) Q:'NUM D
|
||||
. . . . . S NAM=$P(^XMB(3.7,DUZ,2,NUM,0),U)
|
||||
. . . . . D GATHER(DUZ,NAM,.LST)
|
||||
. . . . .QUIT
|
||||
. . . .QUIT
|
||||
. . . ;
|
||||
. . . ; If comma separated, look for mailboxes with new messages
|
||||
. . . I $L(MBLST,",")>1 D QUIT
|
||||
. . . . S NAM=""
|
||||
. . . . N TN,V
|
||||
. . . . F TN=1:1:$L(MBLST,",") S V=$P(MBLST,",",TN) D
|
||||
. . . . . I $L(V) D QUIT
|
||||
. . . . . . I V S NAM=$P($G(^XMB(3.7,DUZ,2,V,0)),U)
|
||||
. . . . . . S:NAM="" NAM=V
|
||||
. . . . . . D GATHER(DUZ,NAM,.LST)
|
||||
. . . . . .QUIT
|
||||
. . . . . ;
|
||||
. . . . . D ERROR("ER08")
|
||||
. . . . .QUIT
|
||||
. . . .QUIT
|
||||
. . . ;
|
||||
. . . ; If only 1 mailbox named, go get it
|
||||
. . . I $L(MBLST) D QUIT
|
||||
. . . . I $D(^XMB(3.7,DUZ,2,"B",MBLST)) D GATHER(DUZ,MBLST,.LST) QUIT
|
||||
. . . . ;
|
||||
. . . . D ERROR("ER07")
|
||||
. . .QUIT
|
||||
. . MERGE C0CDATA=LST
|
||||
. .QUIT
|
||||
.QUIT
|
||||
QUIT
|
||||
; ===================
|
||||
GATHER(DUZ,NAM,LST) ; Gather Data about the Baskets and their mail
|
||||
N I,J,K,L
|
||||
S (I,K)=0
|
||||
S J=$O(^XMB(3.7,DUZ,2,"B",NAM,""))
|
||||
F S I=$O(^XMB(3.7,DUZ,2,J,1,I)) Q:'I D
|
||||
. S L=$P(^XMB(3.7,DUZ,2,J,1,I,0),U,3)
|
||||
. D ; :L
|
||||
. . S:L K=K+1,LST(NAM,"MSG",I,"NEW")="" ; Flag NEW emails
|
||||
. . S LST(NAM,"MSG",I)=L
|
||||
. . D GETTYP(I)
|
||||
. .QUIT
|
||||
.QUIT
|
||||
S LST(NAM,"NUMBER")=K
|
||||
QUIT
|
||||
; ===================
|
||||
; D0 is the IEN into the Message Global ^XMB(3.9,D0)
|
||||
; The products of these emails are scanned to identify
|
||||
; the number of documents stored in the MIME package.
|
||||
; The protocol runs like this;
|
||||
; Line 1 is the --separator
|
||||
; Line 2 thru n >Look for Content-[detail type:]Description ; Next CMD
|
||||
; Line n+2 thru t-1 where t does NOT have "Content-"
|
||||
; Line t is Next Section Terminator, or Message Terminator, --separator
|
||||
; Line t+1 should not exist in the data set if Message Terminator
|
||||
; CON = "Content-"
|
||||
; FLG = "--"
|
||||
; SEP = FLG+7 or more characters ; Separator
|
||||
; END = SEP+FLG
|
||||
; SGC = Segment Count
|
||||
; Note: separator is a string of specific characters of
|
||||
; indeterminate length
|
||||
; LST() the transfer array
|
||||
; LST(NAM,"MSG",C0CIEN,"SEG",SGN)=Starting Line^Ending Line
|
||||
; LST(NAM,"MSG",C0CIEN,"SEG",SGN,1:n)=Decoded Message Data
|
||||
;
|
||||
GETTYP(D0) ; Look for the goodies in the Mail
|
||||
N I,J,N,BCN,CON,CNT,D1,END,FLG,SEP,SGC,XX,XXNM
|
||||
S CON="Content-"
|
||||
S FLG="--"
|
||||
S SEP="" ; Start SEP as null, so we can use this to help identify the type
|
||||
S (BCN,CNT,D1,END,SGC)=0
|
||||
S XX=$G(^XMB(3.9,D0,0))
|
||||
S LST(NAM,"MSG",D0,"TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
|
||||
S LST(NAM,"MSG",D0,"CREATED")=$G(^XMB(3.9,D0,.6))
|
||||
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
|
||||
S LST(NAM,"MSG",D0,"FROM")=$$NAME(XXNM)
|
||||
S LST(NAM,"MSG",D0,"SENT")=$$TIME($P(XX,U,3))
|
||||
; Get the folks the email is sent to.
|
||||
S D1=0
|
||||
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D
|
||||
. N T
|
||||
. S T=+$G(^XMB(3.9,D0,1,D1,0))
|
||||
. S:T T=$P($G(^VA(200,+T,0)),"^")
|
||||
. S LST("TO",D1)=T
|
||||
. S T=$G(^XMB(3.9,D0,6,D1,0))
|
||||
. S:T T=$P($G(^VA(200,+T,0)),"^")
|
||||
. S:T="" T="<Unknown>"
|
||||
. S LST("TO NAME",D1)=T
|
||||
.QUIT
|
||||
; Preload first Segment (0) with beginning on Line 1
|
||||
; if not a 64bit
|
||||
S LST(NAM,"MSG",D0,"SEG",0)=1
|
||||
S D1=.9999,SEP="@@"
|
||||
F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
|
||||
. ; Clear any control characters (cr/lf/ff) off
|
||||
. S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
|
||||
. ; Enter once to set the SEP to capture the separator
|
||||
. I SEP=FLG&($E(X,1,2)=FLG)&($L(X,FLG)=2)&($L($P(X,FLG,2)>5)) D Q
|
||||
. . S SEP=X,END=X_FLG
|
||||
. . S (CNT,SGC)=1,BCN=0
|
||||
. . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
|
||||
. .QUIT
|
||||
. ;
|
||||
. ; A new separator is set, process original
|
||||
. I X=SEP D QUIT
|
||||
. . S LST(NAM,"MSG",D0,SGC,"SIZE")=BCN+$L(BF)
|
||||
. . S LST(NAM,"MSG",D0,"SEG",SGC)=$G(LST(NAM,"MSG",D0,"SEG",SGC))_"^"_(D1-1)
|
||||
. . S SGC=SGC+1,BCN=0
|
||||
. . S LST(NAM,"MSG",D0,"SEG",SGC)=D1
|
||||
. .QUIT
|
||||
. ;
|
||||
. S BCN=BCN+$L(X)
|
||||
. I X[CON D Q
|
||||
. . S J=$P($P(X,";"),CON,2)
|
||||
. . S LST(NAM,"MSG",D0,"SEG",SGC,"CONT",CNT,$P(J,":"))=$P(J,":",2)
|
||||
. .QUIT
|
||||
. ;
|
||||
. ; S LST(NAM,"MSG",D0,"SEG",D1)=X
|
||||
.QUIT
|
||||
QUIT
|
||||
; ===================
|
||||
NAME(NM) ; Return the name of the Sender
|
||||
N NAME
|
||||
S NAME="<Unknown Sender>"
|
||||
D
|
||||
. ; Look first for a value to use with the NEW PERSON file
|
||||
. ;
|
||||
. I NM=+NM S NAME=$P(^VA(200,NM,0),U,1) Q
|
||||
. ;
|
||||
. I $L(NM) S NAME=NM Q
|
||||
. ;
|
||||
. ; Else, pull the data from the message and display the foreign source
|
||||
. ; of the message.
|
||||
. N T
|
||||
. S VAL=$G(^XMB(3.9,D0,.7))
|
||||
. S:VAL T=$P(^VA(200,VAL,0),U)
|
||||
. I $L($G(T)) S NAME=T Q
|
||||
. ;
|
||||
.QUIT
|
||||
QUIT NAME
|
||||
; ===================
|
||||
TIME(Y) ; The time and date of the sending
|
||||
X ^DD("DD")
|
||||
QUIT Y
|
||||
; ===================
|
||||
; Segments in Message need to be identified and decoded properly
|
||||
; D DETAIL^C0CMAIL(.ARRAY,D0) ; Call One for each message
|
||||
; ARRAY will have the details of this one call
|
||||
;
|
||||
; Inputs;
|
||||
; C0CINPUT - The IEN of the message to expand
|
||||
; Outputs;
|
||||
; C0CDATA - Carrier for the returned structure of the Message
|
||||
; C0CDATA(D0,"SEG")=number of SEGMENTS
|
||||
; C0CDATA(D0,"SEG",0:n)=SEGMENT n details; First;Last;Type
|
||||
; C0CDATA(D0,"SEG",0:n,"CONTENT",type)=Content details
|
||||
; C0CDATA(D0,"SEG",0:n,"MSG",D3)=Content details
|
||||
; C0CDATA(D0,"SEG",0:n,"HTML",D3)=Content details
|
||||
;
|
||||
DETAIL(C0CDATA,C0CINPUT) ; Message Detail Delivery
|
||||
N LST,D0,D1,U
|
||||
S U="^"
|
||||
S D0=+$G(C0CINPUT)
|
||||
I D0 D QUIT
|
||||
. I $D(^XMB(3.9,D0))<10 D ERROR("ER01") QUIT
|
||||
. ;
|
||||
. D GETTYP2(D0)
|
||||
. I $D(LST) M C0CDATA(D0)=LST Q
|
||||
. ;
|
||||
. D ERROR("ER02")
|
||||
.QUIT
|
||||
QUIT
|
||||
; ===================
|
||||
; End note if needed
|
||||
; MSK - Set of characters that do not exist in 64 bit encoding
|
||||
GETTYP2(D0) ; Try to get the types and MSK for the
|
||||
N I,J,K,N,BCN,BF,CON,CNT,D1,END,FLG,MSK,SEP,SGC,U,XX,ZN,XXNM
|
||||
S CON="Content-",U="^"
|
||||
S FLG="--"
|
||||
S MSK=" !""#$%&'()*,-.:;<>?@[\]^_`{|}~"
|
||||
S (BF,SEP)="" ; Start SEP as null, so we can use this to help identify the type
|
||||
S (BCN,CNT,D1,END,SGC)=0
|
||||
S XX=$G(^XMB(3.9,D0,0))
|
||||
; S K=$P(^XMB(3.9,D0,2,0),U,3)
|
||||
S LST("TITLE")=$P($G(^XMB(3.9,D0,0)),U,1)
|
||||
S LST("CREATED")=$$TIME($P(XX,U,3))
|
||||
F I=4,2 S XXNM=$P(XX,U,I) Q:$L(XXNM)
|
||||
S LST("FROM")=$$NAME(XXNM)
|
||||
; Get the folks the email is sent to.
|
||||
S D1=0
|
||||
F S D1=$O(^XMB(3.9,D0,1,D1)) Q:'D1 D Q:D1=""
|
||||
. N I,T
|
||||
. S T=$P($G(^XMB(3.9,D0,1,D1,0)),U)
|
||||
. S:T T=$P($G(^VA(200,T,0)),"^")
|
||||
. S LST("TO",+D1)=T
|
||||
. S T=$G(^XMB(3.9,D0,6,+D1,0))
|
||||
. S:T="" T=$P($G(^VA(200,+T,0)),"^")
|
||||
. S:T="" T="<Unknown>"
|
||||
. S LST("TO NAME",D1)=T
|
||||
.QUIT
|
||||
; Get the Header for the message
|
||||
S D1=0
|
||||
F I=1:1 S D1=$O(^XMB(3.9,D0,2,D1)) Q:D1="" Q:(D1>.99999) D
|
||||
. S LST("HDR",I)=$G(^XMB(3.9,D0,2,D1,0))
|
||||
.QUIT
|
||||
; Start walking the different sections
|
||||
S D1=.99999,SEP="@@",SGC=0
|
||||
F S D1=$O(^XMB(3.9,D0,2,D1)) Q:'D1 D
|
||||
. ; Clear any control characters (cr/lf/ff) off
|
||||
. S X=$TR($G(^XMB(3.9,D0,2,D1,0)),$C(10,12,13))
|
||||
. ; Enter once to set the SEP to capture the separator
|
||||
. I (SEP="@@")&(X?2."--"5.AN.E) D Q
|
||||
. . I $L(X,FLG)>2 D ERROR("ER10")
|
||||
. . S SEP=X,END=X_FLG
|
||||
. . S (CNT,SGC)=1,BCN=0
|
||||
. . S LST("SEG",SGC)=D1
|
||||
. .QUIT
|
||||
. ;
|
||||
. ; A new SEGMENT separator is set, process original
|
||||
. I X=SEP D QUIT
|
||||
. . ; Save Current Values
|
||||
. . S LST("SEG",SGC,"SIZE")=BCN+$L(BF)
|
||||
. . ; Close this Segment and prepare to start a New Segment
|
||||
. . S $P(LST("SEG",SGC),"^",1,2)=$P($G(LST("SEG",SGC)),"^",1)_"^"_(D1-1)
|
||||
. . ; Put the result in LST("SEG",SGC,"XML")
|
||||
. . I $L(BF) D
|
||||
. . . S ZN=1
|
||||
. . . N I,T,TBF
|
||||
. . . S TBF=BF
|
||||
. . . F I=1:1:($L(TBF,"=")) D
|
||||
. . . . S BF=$P(TBF,"=",I)_"="
|
||||
. . . . I BF'="=" D DECODER
|
||||
. . . .QUIT
|
||||
. . . S BF=""
|
||||
. . .QUIT
|
||||
. . S SGC=SGC+1,BCN=0
|
||||
. . ; Incriment SGC to start a new Segment
|
||||
. . S LST("SEG",SGC)=D1
|
||||
. .QUIT
|
||||
. ;
|
||||
. ; Accumulate the 64 bit encoding
|
||||
. I X=$TR(X,MSK)&$L(X) S BF=BF_X QUIT
|
||||
. ;
|
||||
. ; Ending Condition, close out the Segment
|
||||
. I X=END D QUIT
|
||||
. . S LST("SEG",SGC)=$G(LST("SEG",SGC))_"^"_(D1-1)
|
||||
. . I $L(BF) S ZN=1 D DECODER S BF="" Q
|
||||
. .QUIT
|
||||
. ;
|
||||
. ; Accumulate the lengths of other lines of the message
|
||||
. S BCN=BCN+$L(X)
|
||||
. ; Split out the Content Info
|
||||
. I X[CON D Q
|
||||
. . S J=$P(X,CON,2)
|
||||
. . I J[" boundary=" D
|
||||
. . . S SEP=$P($P(J," boundary=",2),"""",2),END=SEP_FLG
|
||||
. . . Q:SEP?2"-"5.ANP
|
||||
. . . ;
|
||||
. . . D ERROR("ER11")
|
||||
. . . Q:SEP'[" "
|
||||
. . . ;
|
||||
. . . D ERROR("ER12")
|
||||
. . .QUIT
|
||||
. . S LST("SEG",SGC,"CONTENT",$P(J,":"))=$P(J,":",2,9)
|
||||
. .QUIT
|
||||
. ;
|
||||
. ; Everything else is Text, Check for CCR/CCD.
|
||||
. N KK,UBF
|
||||
. D
|
||||
. . S UBF=$$UPPER(X)
|
||||
. . I UBF["<CONTINUITYOFCARERECORD" S $P(LST("SEG",SGC),U,3)="CCR" Q
|
||||
. . ;
|
||||
. . I UBF["<CLINICALDOCUMENT" S $P(LST("SEG",SGC),U,3)="CCD" Q
|
||||
. .QUIT
|
||||
. ; Look for directives in the text before it gets published
|
||||
. ; Look for "=3D" and replace it with a single "=". I can do more parsing
|
||||
. ; but there may be situations where the line has been wrapped.
|
||||
. D:X["=3D"
|
||||
. . F KK=1:1 S X=$P(X,"=3D",1)_"="_$P(X,"=3D",2,999) Q:X'["=3D"
|
||||
. .QUIT
|
||||
. S LST("SEG",SGC,"TXT",D1)=X
|
||||
.QUIT
|
||||
QUIT
|
||||
; ===================
|
||||
; Break down the Buffer Array so it can be saved.
|
||||
; BF is passed in.
|
||||
DECODER ;
|
||||
N RCNT,TBF,UBF,ZBF,ZI,ZJ,ZK,ZSIZE
|
||||
S ZBF=BF
|
||||
; Full Buffer, BF, now check for Encryption and Unpack
|
||||
F RCNT=1:1:$L(ZBF,"=") D
|
||||
. N BF
|
||||
. S BF=$P(ZBF,"=",RCNT)
|
||||
. ; Unpacking the 64 bit encoding
|
||||
. S TBF=$TR($$DECODE^RGUTUU(BF),$C(10,12,13))
|
||||
. D:$L(TBF)
|
||||
. . N C,OK,OKCNT,KK,XBF,UBF
|
||||
. . D
|
||||
. . . S UBF=$$UPPER(TBF)
|
||||
. . . I UBF["<CONTINUITYOFCARERECORD XMLNS=" S $P(LST("SEG",SGC),U,3)="CCR" Q
|
||||
. . . ;
|
||||
. . . I UBF["<CLINICALDOCUMENT XMLNS=" S $P(LST("SEG",SGC),U,3)="CCD" Q
|
||||
. . .QUIT
|
||||
. . ; Check for Bad Signature Decoding, after 100 bad characters
|
||||
. . S OK=1,OKCNT=0
|
||||
. . F KK=1:1:$L(UBF) S C=$A(UBF,KK) S:C>126 OKCNT=OKCNT+1 I OKCNT>100 S OK=0 Q
|
||||
. . ;
|
||||
. . D
|
||||
. . . I 'OK S (BF,UBF,TBF,XBF)="<Crypto-Signature redacted>" Q
|
||||
. . . ;
|
||||
. . . S BF=BF_"="
|
||||
. . . D NORMAL(.XBF,.TBF)
|
||||
. . .QUIT
|
||||
. . M LST("SEG",SGC,"XML",RCNT)=XBF
|
||||
. .QUIT
|
||||
.QUIT
|
||||
QUIT
|
||||
; ===================
|
||||
; OUTXML = OUTBF = OUT = OUTPUT ARRAY TO BE BUILT
|
||||
; BF = INXML = INPUT ARRAY TO PROVIDE INPUT
|
||||
; >D NORMAL^C0CMAIL(.OUT,BF)
|
||||
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
|
||||
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
|
||||
;
|
||||
N ZN,OUTBF,XX,ZSEP
|
||||
S INXML=$TR(INXML,$C(10,12,13))
|
||||
S ZN=1,ZSEP=">"
|
||||
S OUTBF(1)=$P(INXML,"><",1)_ZSEP,XX="<"_$P(INXML,"><",2)_ZSEP,ZN=2,ZL=1
|
||||
F ZN=ZN+1:1:$L(INXML,"><") D Q:XX=""
|
||||
. S XX=$P(INXML,"><",ZN)
|
||||
. S:$E($RE(XX))=">" ZSEP=""
|
||||
. Q:XX=""
|
||||
. ;
|
||||
. S XX="<"_XX_ZSEP
|
||||
. D
|
||||
. . I $L(XX)<4000 S OUTBF(ZL)=XX,XX=$P(INXML,"><",ZN),ZL=ZL+1 Q
|
||||
. . ;
|
||||
. . D ERROR("ER05")
|
||||
. . F ZL=ZL+1:1 D Q:XX=""
|
||||
. . . N XL
|
||||
. . . S XL=$E(XX,1,4000)
|
||||
. . . S $E(XX,1,4000)="" ; S XX=$E(XX,4001,999999) ; Remove 4K characters
|
||||
. . . S OUTBF(ZL)=XL
|
||||
. . .QUIT
|
||||
. .QUIT
|
||||
.QUIT
|
||||
M OUTXML=OUTBF
|
||||
QUIT
|
||||
; ===================
|
||||
UPPER(X) ; Convert any lowercase letters to Uppercase letters
|
||||
QUIT $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
; ===================
|
||||
; EN is a counter that remains between error events
|
||||
ERROR(ER) ; Error Handler
|
||||
N TXXQ,XXXQ
|
||||
S XXXQ="Unknown Error Encountered = "_ER
|
||||
S TXXQ=$P($T(@(ER_"^"_$T(+0))),";;",2,99)
|
||||
I TXXQ'="" D
|
||||
. I TXXQ["_" X "S TXXQ="_TXXQ
|
||||
. S XXXQ=TXXQ
|
||||
.QUIT
|
||||
S EN(ER)=$G(EN(ER))+1
|
||||
S LST("ERR",ER,EN(ER))=XXXQ
|
||||
QUIT
|
||||
; ===================
|
||||
ER01 ;;Message Missing
|
||||
ER02 ;;Message Text Missing
|
||||
ER03 ;;Message Not Identifiable
|
||||
ER04 ;;Segment is too large
|
||||
ER05 ;;Mailbox Missing
|
||||
ER06 ;;"User Missing = "_$G(DUZ)
|
||||
ER07 ;;"Bad DUZ = "_DUZ
|
||||
ER08 ;;"Bad Basket ID = "_MBLST_" >> "_$G(TN)
|
||||
ER10 ;;"Bad Separator found = "_X
|
||||
ER11 ;;"Non-Standard Separator Found:>"_$G(J)
|
||||
ER12 ;;"Spaces are not allowed in Separators:>"_$G(J)
|
||||
; vvvvvvvvvvvvvvv Not Needed vvvvvvvvvvvvvvvvvvvvvvvvvv
|
||||
; End note if needed
|
||||
QUIT
|
||||
; ===================
|
215
p/C0CMED.m
215
p/C0CMED.m
|
@ -1,105 +1,114 @@
|
|||
C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
; 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
; --Revision History
|
||||
; July 2008 - Initial Version/GPL
|
||||
; July 2008 - March 2009 various revisions
|
||||
; March 2009 - Reconstruction of routine as driver for other med routines/SMH
|
||||
;
|
||||
Q
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
; 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
; --Revision History
|
||||
; July 2008 - Initial Version/GPL
|
||||
; July 2008 - March 2009 various revisions
|
||||
; March 2009 - Reconstruction of routine as driver for other med routines/SMH
|
||||
;
|
||||
Q
|
||||
EXTRACT(MEDXML,DFN,MEDOUTXML) ; Private; Extract medications into provided XML template
|
||||
; DFN passed by reference
|
||||
; MEDXML and MEDOUTXML are passed by Name
|
||||
; MEDXML is the input template
|
||||
; MEDOUTXML is the output template
|
||||
; Both of them refer to ^TMP globals where the XML documents are stored
|
||||
;
|
||||
; -- This ep is the driver for extracting medications into the provided XML template
|
||||
; 1. VA Outpatient Meds are in C0CMED1
|
||||
; 2. VA Pending Meds are in C0CMED2
|
||||
; 3. VA non-VA Meds are in C0CMED3
|
||||
; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
|
||||
; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
|
||||
; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
|
||||
;
|
||||
; --Get parameters for meds
|
||||
S @MEDOUTXML@(0)=0 ; By default, empty.
|
||||
N C0CMFLAG
|
||||
S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
|
||||
W:$G(DEBUG) "Med Parameters: ",!
|
||||
W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
|
||||
W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
|
||||
W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
|
||||
W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
|
||||
; --Find out what system we are on and branch out...
|
||||
W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
|
||||
I $$RPMS^C0CUTIL() D RPMS QUIT
|
||||
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
|
||||
RPMS
|
||||
;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
|
||||
N MEDCOUNT S MEDCOUNT=0
|
||||
K ^TMP($J,"MED")
|
||||
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
||||
N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
|
||||
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:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
||||
I @HIST@(0)>0 D
|
||||
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
||||
I @NVA@(0)>0 D
|
||||
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
||||
. ;E D CP^C0CXPATH(NVA,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
||||
Q
|
||||
VISTA
|
||||
N MEDCOUNT S MEDCOUNT=0
|
||||
K ^TMP($J,"MED")
|
||||
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
||||
N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
|
||||
N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
|
||||
K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY
|
||||
S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
|
||||
; N IPIV ; Inpatient IV Meds
|
||||
; N IPUD ; Inpatient UD Meds
|
||||
D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
|
||||
D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending Meds
|
||||
;D:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
||||
D EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds GPL
|
||||
I @HIST@(0)>0 D
|
||||
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
||||
I @PEND@(0)>0 D
|
||||
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
|
||||
. E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
|
||||
. W:$G(DEBUG) "HAS OP PENDING MEDS",!
|
||||
I @NVA@(0)>0 D
|
||||
. I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
||||
. E D CP^C0CXPATH(NVA,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
||||
N ZI
|
||||
S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
||||
M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES
|
||||
K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10
|
||||
K @PEND
|
||||
K @HIST
|
||||
K @NVA
|
||||
Q
|
||||
|
||||
; DFN passed by reference
|
||||
; MEDXML and MEDOUTXML are passed by Name
|
||||
; MEDXML is the input template
|
||||
; MEDOUTXML is the output template
|
||||
; Both of them refer to ^TMP globals where the XML documents are stored
|
||||
;
|
||||
; -- This ep is the driver for extracting medications into the provided XML template
|
||||
; 1. VA Outpatient Meds are in C0CMED1
|
||||
; 2. VA Pending Meds are in C0CMED2
|
||||
; 3. VA non-VA Meds are in C0CMED3
|
||||
; 4. VA Inpatient IV Meds are in C0CMED4 (not functional)
|
||||
; 5. VA Inpatient UD Meds are in C0CMED5 (doesn't exist yet)--March 2009
|
||||
; 6. RPMS Meds are in C0CMED6. Need to create other routines for subdivisions of RPMS Meds is not known at this time.
|
||||
;
|
||||
; --Get parameters for meds
|
||||
S @MEDOUTXML@(0)=0 ; By default, empty.
|
||||
N C0CMFLAG
|
||||
S C0CMFLAG=$$GET^C0CPARMS("MEDALL")_"^"_$$GET^C0CPARMS("MEDLIMIT")_"^"_$$GET^C0CPARMS("MEDACTIVE")_"^"_$$GET^C0CPARMS("MEDPENDING")
|
||||
W:$G(DEBUG) "Med Parameters: ",!
|
||||
W:$G(DEBUG) "ALL: ",+C0CMFLAG,!
|
||||
W:$G(DEBUG) "LIMIT: ",$P(C0CMFLAG,U,2),!
|
||||
W:$G(DEBUG) "ACTIVE: ",$P(C0CMFLAG,U,3),!
|
||||
W:$G(DEBUG) "PEND: ",$P(C0CMFLAG,U,4),!
|
||||
; --Find out what system we are on and branch out...
|
||||
W:$G(DEBUG) "Agenecy: ",$G(DUZ("AG"))
|
||||
I $$RPMS^C0CUTIL() D RPMS QUIT
|
||||
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
|
||||
RPMS
|
||||
;D EXTRACT^C0CMED6(MEDXML,DFN,MEDOUTXML,C0CMFLAG) QUIT
|
||||
N MEDCOUNT S MEDCOUNT=0
|
||||
K ^TMP($J,"MED")
|
||||
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
||||
N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
|
||||
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:+C0CMFLAG EXTRACT^C0CMED3(MEDXML,DFN,NVA,.MEDCOUNT) ; non-VA Meds
|
||||
I @HIST@(0)>0 D
|
||||
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
||||
I @NVA@(0)>0 D
|
||||
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
||||
. ;E D CP^C0CXPATH(NVA,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
||||
Q
|
||||
VISTA
|
||||
N MEDCOUNT S MEDCOUNT=0
|
||||
K ^TMP($J,"MED")
|
||||
N HIST S HIST=$NA(^TMP($J,"MED","HIST")) ; Meds already dispensed
|
||||
N PEND S PEND=$NA(^TMP($J,"MED","PEND")) ; Pending Meds
|
||||
N NVA S NVA=$NA(^TMP($J,"MED","NVA")) ; non-VA Meds
|
||||
K @HIST K @PEND K @NVA ; MAKE SURE THEY ARE EMPTY
|
||||
S @HIST@(0)=0,@PEND@(0)=0,@NVA@(0)=0 ; At first, they are all empty... (prevent undefined errors)
|
||||
; N IPIV ; Inpatient IV Meds
|
||||
N IPUD S IPUD=$NA(^TMP($J,"MED","IPUD")) ; Inpatient UD Meds
|
||||
K @IPUD
|
||||
S @IPUD@(0)=0
|
||||
;
|
||||
D EXTRACT^C0CMED1(MEDXML,DFN,HIST,.MEDCOUNT,C0CMFLAG) ; Historical OP Meds
|
||||
D:$P(C0CMFLAG,U,4) EXTRACT^C0CMED2(MEDXML,DFN,PEND,.MEDCOUNT) ; Pending 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^C0CNMED4(MEDXML,DFN,IPUD,.MEDCOUNT) ; inpatient gpl
|
||||
I @HIST@(0)>0 D
|
||||
. D CP^C0CXPATH(HIST,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS ACTIVE OP MEDS",!
|
||||
I @PEND@(0)>0 D
|
||||
. I @HIST@(0)>0 D INSINNER^C0CXPATH(MEDOUTXML,PEND) ;Add Pending to Historical
|
||||
. E D CP^C0CXPATH(PEND,MEDOUTXML) ; No historical, just copy
|
||||
. W:$G(DEBUG) "HAS OP PENDING MEDS",!
|
||||
I @NVA@(0)>0 D
|
||||
. I @HIST@(0)>0!(@PEND@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,NVA)
|
||||
. E D CP^C0CXPATH(NVA,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS NON-VA MEDS",!
|
||||
I @IPUD@(0)>0 D
|
||||
. I @HIST@(0)>0!(@PEND@(0)>0)!(@NVA@(0)>0) D INSINNER^C0CXPATH(MEDOUTXML,IPUD)
|
||||
. E D CP^C0CXPATH(IPUD,MEDOUTXML)
|
||||
. W:$G(DEBUG) "HAS INPATIENT MEDS",!
|
||||
N ZI
|
||||
S ZI=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
||||
M ^TMP("C0CRIM","VARS",DFN,"MEDS")=@ZI ; PERSIST MEDS VARIABLES
|
||||
K @ZI ; CLEAN UP MED MAP AFTER - GPL 10/10
|
||||
K @PEND
|
||||
K @HIST
|
||||
K @NVA
|
||||
K @IPUD
|
||||
Q
|
||||
|
||||
|
|
472
p/C0CMED1.m
472
p/C0CMED1.m
|
@ -1,238 +1,238 @@
|
|||
C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;Last modified Sat Jan 10 21:42:27 PST 2009
|
||||
; Copyright 2009 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;;Last modified Sat Jan 10 21:42:27 PST 2009
|
||||
; Copyright 2009 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
|
||||
;
|
||||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
|
||||
;
|
||||
; MEDS is return array from RPC.
|
||||
; MAP is a mapping variable map (store result) for each med
|
||||
; MED is holds each array element from MEDS(J), one medicine
|
||||
; MEDCOUNT is a counter passed by Reference.
|
||||
; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
|
||||
; FLAGS are set-up in C0CMED.
|
||||
;
|
||||
; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
|
||||
; med data available.
|
||||
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
|
||||
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
|
||||
; D PARY^C0CXPATH(MINXML)
|
||||
N MEDS,MAP
|
||||
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
|
||||
N ALL S ALL=+FLAGS
|
||||
N ACTIVE S ACTIVE=$P(FLAGS,U,3)
|
||||
; Below, X1 is today; X2 is the number of days we want to go back
|
||||
; X is the result of this calculation using C^%DTC.
|
||||
N X,X1,X2
|
||||
S X1=DT
|
||||
S X2=-$P($P(FLAGS,U,2),"-",2)
|
||||
D C^%DTC
|
||||
; I discovered that I shouldn't put an ending date (last parameter)
|
||||
; because it seems that it will get meds whose beginning is after X but
|
||||
; whose exipriation is before the ending date.
|
||||
D RX^PSO52API(DFN,"CCDCCR","","","",X,"")
|
||||
M MEDS=^TMP($J,"CCDCCR",DFN)
|
||||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||||
; If it is -1, we quit.
|
||||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
||||
ZWRITE:$G(DEBUG) MEDS
|
||||
N RXIEN S RXIEN=0
|
||||
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST
|
||||
. N MED M MED=MEDS(RXIEN)
|
||||
. I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
|
||||
. S MEDCOUNT=MEDCOUNT+1
|
||||
. W:$G(DEBUG) "RXIEN IS ",RXIEN,!
|
||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||
. ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
|
||||
. W:$G(DEBUG) "MAP= ",MAP,!
|
||||
. S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
|
||||
. ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
|
||||
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
|
||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
|
||||
. S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
|
||||
. S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P(MED(101),U))
|
||||
. S @MAP@("MEDRXNOTXT")="Prescription Number"
|
||||
. S @MAP@("MEDRXNO")=MED(.01)
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||
. S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
|
||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
|
||||
. ; 12/30/08: I will be using RxNorm for coding...
|
||||
. ; 176.001 is the file for Concepts; 176.003 is the file for
|
||||
. ; sources (i.e. for RxNorm Version)
|
||||
. ;
|
||||
. ; We need the VUID first for the National Drug File entry first
|
||||
. ; We get the VUID of the drug, by looking up the VA Product entry
|
||||
. ; (file 50.68) using the call NDF^PSS50, returned in node 22.
|
||||
. ; Field 99.99 is the VUID.
|
||||
. ;
|
||||
. ; We use the VUID to look up the RxNorm in file 176.001; same idea.
|
||||
. ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
|
||||
. ; $$GET1^DIQ.
|
||||
. ;
|
||||
. ; I get the RxNorm name and version from the RxNorm Sources (file
|
||||
. ; 176.003), by searching for "RXNORM", then get the data.
|
||||
. N MEDIEN S MEDIEN=$P(MED(6),U)
|
||||
. D NDF^PSS50(MEDIEN,,,,,"NDF")
|
||||
. N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||||
. N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||||
. ;
|
||||
. ; NDFIEN is not necessarily defined; it won't be if the drug
|
||||
. ; is not matched to the national drug file (e.g. if the drug is
|
||||
. ; new on the market, compounded, or is a fake drug [blue pill].
|
||||
. ; To protect against failure, I will put an if/else block
|
||||
. ;
|
||||
. N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
|
||||
. I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
|
||||
. . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
|
||||
. . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
|
||||
. . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
|
||||
. . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
|
||||
. . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
|
||||
. . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
|
||||
. ;
|
||||
. E S (RXNORM,RXNNAME,RXNVER)=""
|
||||
. ; End if/else block
|
||||
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
|
||||
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
|
||||
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
|
||||
. ;
|
||||
. S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
|
||||
. D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||||
. N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||||
. S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||||
. S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||||
. ; Units, concentration, etc, come from another call
|
||||
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||||
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||||
. ; NDF Entry IEN, and VA Product IEN
|
||||
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||||
. ; These have been collected above.
|
||||
. N CONCDATA
|
||||
. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||||
. ; and this will crash the call. So...
|
||||
. I NDFIEN="" S CONCDATA=""
|
||||
. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||||
. S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||||
. S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||||
. S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||||
. S @MAP@("MEDQUANTITYVALUE")=MED(7)
|
||||
. ; Oddly, there is no easy place to find the dispense unit.
|
||||
. ; It's not included in the original call, so we have to go to the drug file.
|
||||
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||||
. ; Node 14.5 is the Dispense Unit
|
||||
. D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||
. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||
. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||
. ;
|
||||
. ; --- START OF DIRECTIONS ---
|
||||
. ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...
|
||||
. ; we want the compoenents.
|
||||
. ; It's in node 6 of ^PSRX(IEN)
|
||||
. ; So, here we go again
|
||||
. ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
|
||||
. ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
|
||||
. ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
|
||||
. ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
|
||||
. ;
|
||||
. N DIRNUM S DIRNUM=0 ; Sigline number
|
||||
. S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
|
||||
. F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D
|
||||
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
|
||||
. . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
|
||||
. . ; Invervals... again another call.
|
||||
. . ; In the wisdom of the original programmers, the schedule is a free text field
|
||||
. . ; However, it gets translated by a call to the administration schedule file
|
||||
. . ; to see if that schedule exists.
|
||||
. . ; That's the same thing I am going to do.
|
||||
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
|
||||
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
|
||||
. . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
|
||||
. . ; So...
|
||||
. . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
|
||||
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
|
||||
. . N INTERVAL
|
||||
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
|
||||
. . E D
|
||||
. . . N SUB S SUB=$O(SCHEDATA(0))
|
||||
. . . S INTERVAL=SCHEDATA(SUB,2)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
|
||||
. . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
|
||||
. ;
|
||||
. ; --- END OF DIRECTIONS ---
|
||||
. ;
|
||||
. ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
|
||||
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
|
||||
. ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
|
||||
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
|
||||
. S @MAP@("MEDRFNO")=MED(9)
|
||||
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
|
||||
. K @RESULT
|
||||
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
|
||||
. ; MAPPING DIRECTIONS
|
||||
. N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
|
||||
. ; N MDZ1,MDZNA
|
||||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||||
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
|
||||
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||||
. I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. E D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
|
||||
N MEDTMP,MEDI
|
||||
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||||
. W "MEDICATION MISSING ",!
|
||||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||||
Q
|
||||
;
|
||||
;
|
||||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
; INXML WILL CONTAIN ONLY THE MEDICATIONS SECTION OF THE OVERALL TEMPLATE
|
||||
;
|
||||
; MEDS is return array from RPC.
|
||||
; MAP is a mapping variable map (store result) for each med
|
||||
; MED is holds each array element from MEDS(J), one medicine
|
||||
; MEDCOUNT is a counter passed by Reference.
|
||||
; FLAGS are: MEDALL(bool)^MEDLIMIT(int)^MEDACTIVE(bool)^MEDPENDING(bool)
|
||||
; FLAGS are set-up in C0CMED.
|
||||
;
|
||||
; RX^PSO52API is a Pharmacy Re-Enginnering (PRE) API to get all
|
||||
; med data available.
|
||||
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
|
||||
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
|
||||
; D PARY^C0CXPATH(MINXML)
|
||||
N MEDS,MAP
|
||||
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
|
||||
N ALL S ALL=+FLAGS
|
||||
N ACTIVE S ACTIVE=$P(FLAGS,U,3)
|
||||
; Below, X1 is today; X2 is the number of days we want to go back
|
||||
; X is the result of this calculation using C^%DTC.
|
||||
N X,X1,X2
|
||||
S X1=DT
|
||||
S X2=-$P($P(FLAGS,U,2),"-",2)
|
||||
D C^%DTC
|
||||
; I discovered that I shouldn't put an ending date (last parameter)
|
||||
; because it seems that it will get meds whose beginning is after X but
|
||||
; whose exipriation is before the ending date.
|
||||
D RX^PSO52API(DFN,"CCDCCR","","","",X,"")
|
||||
M MEDS=^TMP($J,"CCDCCR",DFN)
|
||||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||||
; If it is -1, we quit.
|
||||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
||||
ZWRITE:$G(DEBUG) MEDS
|
||||
N RXIEN S RXIEN=0
|
||||
F S RXIEN=$O(MEDS(RXIEN)) Q:RXIEN="" D ; FOR EACH MEDICATION IN THE LIST
|
||||
. N MED M MED=MEDS(RXIEN)
|
||||
. I 'ALL,ACTIVE,$P(MED(100),U,2)'="ACTIVE" QUIT
|
||||
. S MEDCOUNT=MEDCOUNT+1
|
||||
. W:$G(DEBUG) "RXIEN IS ",RXIEN,!
|
||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||
. ; K @MAP DO NOT KILL HERE, WAS CLEARED IN C0CMED
|
||||
. W:$G(DEBUG) "MAP= ",MAP,!
|
||||
. S @MAP@("MEDOBJECTID")="MED"_MEDCOUNT ; MEDCOUNT FOR ID
|
||||
. ; S @MAP@("MEDOBJECTID")="MED"_MED(.01) ;Rx Number
|
||||
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
|
||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(1),U))
|
||||
. S @MAP@("MEDLASTFILLDATETXT")="Last Fill Date"
|
||||
. S @MAP@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U))
|
||||
. S @MAP@("MEDRXNOTXT")="Prescription Number"
|
||||
. S @MAP@("MEDRXNO")=MED(.01)
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||
. S @MAP@("MEDSTATUSTEXT")=$P(MED(100),U,2)
|
||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(4),U)
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(6),U,2)
|
||||
. ; 12/30/08: I will be using RxNorm for coding...
|
||||
. ; 176.001 is the file for Concepts; 176.003 is the file for
|
||||
. ; sources (i.e. for RxNorm Version)
|
||||
. ;
|
||||
. ; We need the VUID first for the National Drug File entry first
|
||||
. ; We get the VUID of the drug, by looking up the VA Product entry
|
||||
. ; (file 50.68) using the call NDF^PSS50, returned in node 22.
|
||||
. ; Field 99.99 is the VUID.
|
||||
. ;
|
||||
. ; We use the VUID to look up the RxNorm in file 176.001; same idea.
|
||||
. ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
|
||||
. ; $$GET1^DIQ.
|
||||
. ;
|
||||
. ; I get the RxNorm name and version from the RxNorm Sources (file
|
||||
. ; 176.003), by searching for "RXNORM", then get the data.
|
||||
. N MEDIEN S MEDIEN=$P(MED(6),U)
|
||||
. D NDF^PSS50(MEDIEN,,,,,"NDF")
|
||||
. N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||||
. N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||||
. ;
|
||||
. ; NDFIEN is not necessarily defined; it won't be if the drug
|
||||
. ; is not matched to the national drug file (e.g. if the drug is
|
||||
. ; new on the market, compounded, or is a fake drug [blue pill].
|
||||
. ; To protect against failure, I will put an if/else block
|
||||
. ;
|
||||
. N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
|
||||
. I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
|
||||
. . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
|
||||
. . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
|
||||
. . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
|
||||
. . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
|
||||
. . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
|
||||
. . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
|
||||
. ;
|
||||
. E S (RXNORM,RXNNAME,RXNVER)=""
|
||||
. ; End if/else block
|
||||
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
|
||||
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
|
||||
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
|
||||
. ;
|
||||
. S @MAP@("MEDBRANDNAMETEXT")=MED(6.5)
|
||||
. D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||||
. N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||||
. S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||||
. S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||||
. ; Units, concentration, etc, come from another call
|
||||
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||||
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||||
. ; NDF Entry IEN, and VA Product IEN
|
||||
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||||
. ; These have been collected above.
|
||||
. N CONCDATA
|
||||
. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||||
. ; and this will crash the call. So...
|
||||
. I NDFIEN="" S CONCDATA=""
|
||||
. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||||
. S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||||
. S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||||
. S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||||
. S @MAP@("MEDQUANTITYVALUE")=MED(7)
|
||||
. ; Oddly, there is no easy place to find the dispense unit.
|
||||
. ; It's not included in the original call, so we have to go to the drug file.
|
||||
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||||
. ; Node 14.5 is the Dispense Unit
|
||||
. D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||
. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||
. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||
. ;
|
||||
. ; --- START OF DIRECTIONS ---
|
||||
. ; Sig data not in any API :-( Oh yes, you can get the whole thing, but...
|
||||
. ; we want the compoenents.
|
||||
. ; It's in node 6 of ^PSRX(IEN)
|
||||
. ; So, here we go again
|
||||
. ; ^PSRX(D0,6,D1,0)= (#.01) DOSAGE ORDERED [1F] ^ (#1) DISPENSE UNITS PER DOSE
|
||||
. ; ==>[2N] ^ (#2) UNITS [3P:50.607] ^ (#3) NOUN [4F] ^ (#4)
|
||||
. ; ==>DURATION [5F] ^ (#5) CONJUNCTION [6S] ^ (#6) ROUTE
|
||||
. ; ==>[7P:51.2] ^ (#7) SCHEDULE [8F] ^ (#8) VERB [9F] ^
|
||||
. ;
|
||||
. N DIRNUM S DIRNUM=0 ; Sigline number
|
||||
. S DIRCNT=0 ; COUNT OF MULTIPLE DIRECTIONS
|
||||
. F S DIRNUM=$O(^PSRX(RXIEN,6,DIRNUM)) Q:DIRNUM="" D
|
||||
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
|
||||
. . N SIGDATA S SIGDATA=^PSRX(RXIEN,6,DIRNUM,0)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=$P(SIGDATA,U,9)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=$P(SIGDATA,U,1)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=$$GET1^DIQ(51.2,$P(SIGDATA,U,7),.01)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=$P(SIGDATA,U,8)
|
||||
. . ; Invervals... again another call.
|
||||
. . ; In the wisdom of the original programmers, the schedule is a free text field
|
||||
. . ; However, it gets translated by a call to the administration schedule file
|
||||
. . ; to see if that schedule exists.
|
||||
. . ; That's the same thing I am going to do.
|
||||
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
|
||||
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
|
||||
. . ; I looked), PSSFT is the name, and list is the ^TMP name to store the data in.
|
||||
. . ; So...
|
||||
. . D AP^PSS51P1("PSJ",$P(SIGDATA,U,8),,,"SCHEDULE")
|
||||
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
|
||||
. . N INTERVAL
|
||||
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
|
||||
. . E D
|
||||
. . . N SUB S SUB=$O(SCHEDATA(0))
|
||||
. . . S INTERVAL=SCHEDATA(SUB,2)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$P(SIGDATA,U,5)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=$P(SIGDATA,U,8)["PRN"
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
|
||||
. . N DIRMOD S DIRMOD=$P(SIGDATA,U,6)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=$S(DIRMOD="T":"THEN",DIRMOD="A":"AND",DIRMOD="X":"EXCEPT",1:"")
|
||||
. ;
|
||||
. ; --- END OF DIRECTIONS ---
|
||||
. ;
|
||||
. ; ^PSRX(22,"INS1",1,0)="FOR BLOOD PRESSURE"
|
||||
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"INS1",1,0))
|
||||
. ; ^PSRX(22,"PRC",1,0)="Pharmacist: you must obey my command"
|
||||
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PRC",1,0))
|
||||
. S @MAP@("MEDRFNO")=MED(9)
|
||||
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
|
||||
. K @RESULT
|
||||
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
|
||||
. ; MAPPING DIRECTIONS
|
||||
. N DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
|
||||
. ; N MDZ1,MDZNA
|
||||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||||
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
|
||||
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||||
. I MEDCOUNT=1 D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. E D INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
|
||||
N MEDTMP,MEDI
|
||||
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||||
. W "MEDICATION MISSING ",!
|
||||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||||
Q
|
||||
;
|
||||
|
|
530
p/C0CMED2.m
530
p/C0CMED2.m
|
@ -1,267 +1,267 @@
|
|||
C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;Last Modified Sat Jan 10 21:41:14 PST 2009
|
||||
; Copyright 2008 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;;Last Modified Sat Jan 10 21:41:14 PST 2009
|
||||
; Copyright 2008 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
|
||||
;
|
||||
; MINXML is the Input XML Template, passed by name
|
||||
; DFN is Patient IEN (by Value)
|
||||
; OUTXML is the resultant XML (by Name)
|
||||
; MEDCOUNT is the current count of extracted meds, passed by Reference
|
||||
;
|
||||
; MEDS is return array from RPC.
|
||||
; MAP is a mapping variable map (store result) for each med
|
||||
; MED is holds each array element from MEDS, one medicine
|
||||
;
|
||||
; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
|
||||
; meds data available.
|
||||
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
|
||||
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
|
||||
; File for pending meds is 52.41
|
||||
; Unfortuantely, API does not supply us with any useful info beyond
|
||||
; the IEN in 52.41, and the Med Name, and route.
|
||||
; So, most of the info is going to get pulled from 52.41.
|
||||
N MEDS,MAP
|
||||
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
|
||||
D PEN^PSO5241(DFN,"CCDCCR")
|
||||
M MEDS=^TMP($J,"CCDCCR",DFN)
|
||||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||||
; If it is -1, we quit.
|
||||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
||||
ZWRITE:$G(DEBUG) MEDS
|
||||
N RXIEN S RXIEN=0
|
||||
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
|
||||
. I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order
|
||||
. S MEDCOUNT=MEDCOUNT+1
|
||||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||
. ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
|
||||
. I DEBUG W "MAP= ",MAP,!
|
||||
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
|
||||
. S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
|
||||
. ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
|
||||
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
|
||||
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
|
||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
|
||||
. ; Med never filled; next 4 fields are not applicable.
|
||||
. S @MAP@("MEDLASTFILLDATETXT")=""
|
||||
. S @MAP@("MEDLASTFILLDATE")=""
|
||||
. S @MAP@("MEDRXNOTXT")=""
|
||||
. S @MAP@("MEDRXNO")=""
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||
. S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
|
||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
|
||||
. ; NDC not supplied in API, but is rather trivial to obtain
|
||||
. ; MED(11) piece 1 has the IEN of the drug (file 50)
|
||||
. ; IEN is field 31 in the drug file.
|
||||
. ;
|
||||
. ; MEDIEN (node 11 in the returned output) might not necessarily be defined
|
||||
. ; It is not defined when a dose in not chosen in CPRS. There is a long
|
||||
. ; series of fields that depend on it. We will use If and Else to deal
|
||||
. ; with that
|
||||
. N MEDIEN S MEDIEN=$P(MED(11),U)
|
||||
. I +MEDIEN>0 D ; start of if/else block
|
||||
. . ; 12/30/08: I will be using RxNorm for coding...
|
||||
. . ; 176.001 is the file for Concepts; 176.003 is the file for
|
||||
. . ; sources (i.e. for RxNorm Version)
|
||||
. . ;
|
||||
. . ; We need the VUID first for the National Drug File entry first
|
||||
. . ; We get the VUID of the drug, by looking up the VA Product entry
|
||||
. . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
|
||||
. . ; Field 99.99 is the VUID.
|
||||
. . ;
|
||||
. . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
|
||||
. . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
|
||||
. . ; $$GET1^DIQ.
|
||||
. . ;
|
||||
. . ; I get the RxNorm name and version from the RxNorm Sources (file
|
||||
. . ; 176.003), by searching for "RXNORM", then get the data.
|
||||
. . D NDF^PSS50(MEDIEN,,,,,"NDF")
|
||||
. . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||||
. . N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||||
. . ;
|
||||
. . ; NDFIEN is not necessarily defined; it won't be if the drug
|
||||
. . ; is not matched to the national drug file (e.g. if the drug is
|
||||
. . ; new on the market, compounded, or is a fake drug [blue pill].
|
||||
. . ; To protect against failure, I will put an if/else block
|
||||
. . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
|
||||
. . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
|
||||
. . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
|
||||
. . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
|
||||
. . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
|
||||
. . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
|
||||
. . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
|
||||
. . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
|
||||
. . ;
|
||||
. . E S (RXNORM,RXNNAME,RXNVER)=""
|
||||
. . ; End if/else block
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
|
||||
. . ;
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||||
. . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||||
. . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||||
. . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||||
. . ; Units, concentration, etc, come from another call
|
||||
. . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||||
. . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||||
. . ; NDF Entry IEN, and VA Product Name
|
||||
. . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Documented in the same manual; executed above.
|
||||
. . N CONCDATA
|
||||
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||||
. . ; and this will crash the call. So...
|
||||
. . I NDFIEN="" S CONCDATA=""
|
||||
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||||
. . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||||
. . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||||
. . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||||
. . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
|
||||
. . ; Oddly, there is no easy place to find the dispense unit.
|
||||
. . ; It's not included in the original call, so we have to go to the drug file.
|
||||
. . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Node 14.5 is the Dispense Unit
|
||||
. . D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||
. . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||
. . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||
. E D
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . S @MAP@("MEDSTRENGTHVALUE")=""
|
||||
. . S @MAP@("MEDSTRENGTHUNIT")=""
|
||||
. . S @MAP@("MEDFORMTEXT")=""
|
||||
. . S @MAP@("MEDCONCVALUE")=""
|
||||
. . S @MAP@("MEDCONCUNIT")=""
|
||||
. . S @MAP@("MEDSIZETEXT")=""
|
||||
. . S @MAP@("MEDQUANTITYVALUE")=""
|
||||
. . S @MAP@("MEDQUANTITYUNIT")=""
|
||||
. ; end of if/else block
|
||||
. ;
|
||||
. ; --- START OF DIRECTIONS ---
|
||||
. ; Sig data is not in any API. We obtain it using the IEN from
|
||||
. ; the PEN API to file 52.41. It's in field 3, which is a multiple.
|
||||
. ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
|
||||
. K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
|
||||
. D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
|
||||
. N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
|
||||
. ; FMSIGNUM gets outputted as "IEN,RXIEN,".
|
||||
. ; DIRNUM will be first piece for IEN.
|
||||
. ; DIRNUM is the proper Sigline numer.
|
||||
. ; SIGDATA is the simplfied array. Subscripts are really field numbers
|
||||
. ; in subfile 52.413.
|
||||
. N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
|
||||
. F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D
|
||||
. . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
|
||||
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
|
||||
. . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
|
||||
. . ; If this is an order for a refill; it's not really a new order; move on to next
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
|
||||
. . ; Invervals... again another call.
|
||||
. . ; The schedule is a free text field
|
||||
. . ; However, it gets translated by a call to the administration
|
||||
. . ; schedule file to see if that schedule exists.
|
||||
. . ; That's the same thing I am going to do.
|
||||
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
|
||||
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
|
||||
. . ; I looked), PSSFT is the name,
|
||||
. . ; and list is the ^TMP name to store the data in.
|
||||
. . ; Also, freqency may have "PRN" in it, so strip that out
|
||||
. . N FREQ S FREQ=SIGDATA(1)
|
||||
. . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
|
||||
. . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
|
||||
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
|
||||
. . N INTERVAL
|
||||
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
|
||||
. . E D
|
||||
. . . N SUB S SUB=$O(SCHEDATA(0))
|
||||
. . . S INTERVAL=SCHEDATA(SUB,2)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
||||
. . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
|
||||
. . N DUR S DUR=SIGDATA(2)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
|
||||
. . N DURUNIT S DURUNIT=$E(DUR)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
|
||||
. ;
|
||||
. ; --- END OF DIRECTIONS ---
|
||||
. ;
|
||||
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
|
||||
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
|
||||
. ; W @MAP@("MEDPTINSTRUCTIONS"),!
|
||||
. ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
|
||||
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
|
||||
. ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
|
||||
. S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
|
||||
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
|
||||
. K @RESULT
|
||||
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
|
||||
. ; D PARY^C0CXPATH(RESULT)
|
||||
. ; MAPPING DIRECTIONS
|
||||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
|
||||
. ; N MDZ1,MDZNA
|
||||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||||
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
|
||||
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||||
. I MEDFIRST D ;
|
||||
. . S MEDFIRST=0 ; RESET FIRST FLAG
|
||||
. . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER
|
||||
N MEDTMP,MEDI
|
||||
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||||
. W "Pending Medication MISSING ",!
|
||||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||||
Q
|
||||
;
|
||||
;
|
||||
; MINXML is the Input XML Template, passed by name
|
||||
; DFN is Patient IEN (by Value)
|
||||
; OUTXML is the resultant XML (by Name)
|
||||
; MEDCOUNT is the current count of extracted meds, passed by Reference
|
||||
;
|
||||
; MEDS is return array from RPC.
|
||||
; MAP is a mapping variable map (store result) for each med
|
||||
; MED is holds each array element from MEDS, one medicine
|
||||
;
|
||||
; PEN^PSO5241 is a Pharmacy Re-Enginnering (PRE) API to get Pending
|
||||
; meds data available.
|
||||
; http://www.va.gov/vdl/documents/Clinical/Pharm-Outpatient_Pharmacy/phar_1_api_r0807.pdf
|
||||
; Output of API is ^TMP($J,"SUBSCRIPT",DFN,RXIENS).
|
||||
; File for pending meds is 52.41
|
||||
; Unfortuantely, API does not supply us with any useful info beyond
|
||||
; the IEN in 52.41, and the Med Name, and route.
|
||||
; So, most of the info is going to get pulled from 52.41.
|
||||
N MEDS,MAP
|
||||
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
|
||||
D PEN^PSO5241(DFN,"CCDCCR")
|
||||
M MEDS=^TMP($J,"CCDCCR",DFN)
|
||||
; @(0) contains the number of meds or -1^NO DATA FOUND
|
||||
; If it is -1, we quit.
|
||||
I $P(MEDS(0),U)=-1 S @OUTXML@(0)=0 QUIT
|
||||
ZWRITE:$G(DEBUG) MEDS
|
||||
N RXIEN S RXIEN=0
|
||||
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
|
||||
. I $$GET1^DIQ(52.41,RXIEN,2,"I")="RF" QUIT ; Dont' want refill request as a "pending" order
|
||||
. S MEDCOUNT=MEDCOUNT+1
|
||||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||
. ; K @MAP DON'T KILL MAP HERE, IT IS DONE IN C0CMED
|
||||
. I DEBUG W "MAP= ",MAP,!
|
||||
. N MED M MED=MEDS(RXIEN) ; PULL OUT MEDICATION FROM
|
||||
. S @MAP@("MEDOBJECTID")="MED_PENDING"_MEDCOUNT ; MEDCOUNT FOR ID
|
||||
. ; S @MAP@("MEDOBJECTID")="MED_PENDING"_MED(.01) ;Pending IEN
|
||||
. S @MAP@("MEDISSUEDATETXT")="Issue Date"
|
||||
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
|
||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($$GET1^DIQ(52.41,RXIEN,6,"I"),"DT")
|
||||
. ; Med never filled; next 4 fields are not applicable.
|
||||
. S @MAP@("MEDLASTFILLDATETXT")=""
|
||||
. S @MAP@("MEDLASTFILLDATE")=""
|
||||
. S @MAP@("MEDRXNOTXT")=""
|
||||
. S @MAP@("MEDRXNO")=""
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||
. S @MAP@("MEDSTATUSTEXT")="On Hold" ; nearest status for pending meds
|
||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$$GET1^DIQ(52.41,RXIEN,5,"I")
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=$P(MED(11),U,2)
|
||||
. ; NDC not supplied in API, but is rather trivial to obtain
|
||||
. ; MED(11) piece 1 has the IEN of the drug (file 50)
|
||||
. ; IEN is field 31 in the drug file.
|
||||
. ;
|
||||
. ; MEDIEN (node 11 in the returned output) might not necessarily be defined
|
||||
. ; It is not defined when a dose in not chosen in CPRS. There is a long
|
||||
. ; series of fields that depend on it. We will use If and Else to deal
|
||||
. ; with that
|
||||
. N MEDIEN S MEDIEN=$P(MED(11),U)
|
||||
. I +MEDIEN>0 D ; start of if/else block
|
||||
. . ; 12/30/08: I will be using RxNorm for coding...
|
||||
. . ; 176.001 is the file for Concepts; 176.003 is the file for
|
||||
. . ; sources (i.e. for RxNorm Version)
|
||||
. . ;
|
||||
. . ; We need the VUID first for the National Drug File entry first
|
||||
. . ; We get the VUID of the drug, by looking up the VA Product entry
|
||||
. . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
|
||||
. . ; Field 99.99 is the VUID.
|
||||
. . ;
|
||||
. . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
|
||||
. . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
|
||||
. . ; $$GET1^DIQ.
|
||||
. . ;
|
||||
. . ; I get the RxNorm name and version from the RxNorm Sources (file
|
||||
. . ; 176.003), by searching for "RXNORM", then get the data.
|
||||
. . D NDF^PSS50(MEDIEN,,,,,"NDF")
|
||||
. . N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. . N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||||
. . N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||||
. . ;
|
||||
. . ; NDFIEN is not necessarily defined; it won't be if the drug
|
||||
. . ; is not matched to the national drug file (e.g. if the drug is
|
||||
. . ; new on the market, compounded, or is a fake drug [blue pill].
|
||||
. . ; To protect against failure, I will put an if/else block
|
||||
. . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
|
||||
. . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
|
||||
. . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
|
||||
. . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
|
||||
. . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
|
||||
. . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
|
||||
. . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
|
||||
. . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
|
||||
. . ;
|
||||
. . E S (RXNORM,RXNNAME,RXNVER)=""
|
||||
. . ; End if/else block
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
|
||||
. . ;
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||||
. . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||||
. . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||||
. . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||||
. . ; Units, concentration, etc, come from another call
|
||||
. . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||||
. . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||||
. . ; NDF Entry IEN, and VA Product Name
|
||||
. . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Documented in the same manual; executed above.
|
||||
. . N CONCDATA
|
||||
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||||
. . ; and this will crash the call. So...
|
||||
. . I NDFIEN="" S CONCDATA=""
|
||||
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||||
. . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||||
. . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||||
. . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||||
. . S @MAP@("MEDQUANTITYVALUE")=$$GET1^DIQ(52.41,RXIEN,12)
|
||||
. . ; Oddly, there is no easy place to find the dispense unit.
|
||||
. . ; It's not included in the original call, so we have to go to the drug file.
|
||||
. . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Node 14.5 is the Dispense Unit
|
||||
. . D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||
. . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||
. . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||
. E D
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . S @MAP@("MEDSTRENGTHVALUE")=""
|
||||
. . S @MAP@("MEDSTRENGTHUNIT")=""
|
||||
. . S @MAP@("MEDFORMTEXT")=""
|
||||
. . S @MAP@("MEDCONCVALUE")=""
|
||||
. . S @MAP@("MEDCONCUNIT")=""
|
||||
. . S @MAP@("MEDSIZETEXT")=""
|
||||
. . S @MAP@("MEDQUANTITYVALUE")=""
|
||||
. . S @MAP@("MEDQUANTITYUNIT")=""
|
||||
. ; end of if/else block
|
||||
. ;
|
||||
. ; --- START OF DIRECTIONS ---
|
||||
. ; Sig data is not in any API. We obtain it using the IEN from
|
||||
. ; the PEN API to file 52.41. It's in field 3, which is a multiple.
|
||||
. ; I will be using FM call GETS^DIQ(FILE,IENS,FIELD,FLAGS,TARGET_ROOT)
|
||||
. K FMSIG ; it's passed via the symbol table, so remove any leftovers from last call
|
||||
. D GETS^DIQ(52.41,RXIEN,"3*",,"FMSIG")
|
||||
. N FMSIGNUM S FMSIGNUM=0 ; Sigline number in fileman.
|
||||
. ; FMSIGNUM gets outputted as "IEN,RXIEN,".
|
||||
. ; DIRNUM will be first piece for IEN.
|
||||
. ; DIRNUM is the proper Sigline numer.
|
||||
. ; SIGDATA is the simplfied array. Subscripts are really field numbers
|
||||
. ; in subfile 52.413.
|
||||
. N DIRCNT S DIRCNT=0 ; COUNT OF DIRECTIONS
|
||||
. F S FMSIGNUM=$O(FMSIG(52.413,FMSIGNUM)) Q:FMSIGNUM="" D
|
||||
. . N DIRNUM S DIRNUM=$P(FMSIGNUM,",")
|
||||
. . S DIRCNT=DIRCNT+1 ; INCREMENT DIRECTIONS COUNT
|
||||
. . N SIGDATA M SIGDATA=FMSIG(52.413,FMSIGNUM)
|
||||
. . ; If this is an order for a refill; it's not really a new order; move on to next
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONDESCRIPTIONTEXT")="" ; This is reserved for systems not able to generate the sig in components.
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEINDICATOR")="1" ; means that we are specifying it. See E2369-05.
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDELIVERYMETHOD")=SIGDATA(13)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEVALUE")=SIGDATA(8)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDOSEUNIT")=@MAP@("MEDCONCUNIT")
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEVALUE")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDRATEUNIT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDVEHICLETEXT")="" ; For inpatient
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRECTIONROUTETEXT")=SIGDATA(10)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDFREQUENCYVALUE")=SIGDATA(1)
|
||||
. . ; Invervals... again another call.
|
||||
. . ; The schedule is a free text field
|
||||
. . ; However, it gets translated by a call to the administration
|
||||
. . ; schedule file to see if that schedule exists.
|
||||
. . ; That's the same thing I am going to do.
|
||||
. . ; The call is AP^PSS51P1(PSSPP,PSSFT,PSSWDIEN,PSSSTPY,LIST,PSSFREQ).
|
||||
. . ; PSSPP is "PSJ" (for some reason, schedules are stored as PSJ, not PSO--
|
||||
. . ; I looked), PSSFT is the name,
|
||||
. . ; and list is the ^TMP name to store the data in.
|
||||
. . ; Also, freqency may have "PRN" in it, so strip that out
|
||||
. . N FREQ S FREQ=SIGDATA(1)
|
||||
. . I FREQ["PRN" S FREQ=$E(FREQ,1,$F(FREQ,"PRN")-5) ; 5 for $L("PRN") + 1 + sp
|
||||
. . D AP^PSS51P1("PSJ",FREQ,,,"SCHEDULE")
|
||||
. . N SCHEDATA M SCHEDATA=^TMP($J,"SCHEDULE")
|
||||
. . N INTERVAL
|
||||
. . I $P(SCHEDATA(0),U)=-1 S INTERVAL=""
|
||||
. . E D
|
||||
. . . N SUB S SUB=$O(SCHEDATA(0))
|
||||
. . . S INTERVAL=SCHEDATA(SUB,2)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALVALUE")=INTERVAL
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDINTERVALUNIT")="Minute"
|
||||
. . ; Duration comes as M2,H2,D2,W2,L2 for 2 minutes,hours,days,weeks,months
|
||||
. . N DUR S DUR=SIGDATA(2)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONVALUE")=$E(DUR,2,$L(DUR))
|
||||
. . N DURUNIT S DURUNIT=$E(DUR)
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDURATIONUNIT")=$S(DURUNIT="M":"Minutes",DURUNIT="H":"Hours",DURUNIT="D":"Days",DURUNIT="W":"Weeks",DURUNIT="L":"Months",1:"")
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPRNFLAG")=SIGDATA(1)["PRN"
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMOBJECTID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMTYPETXT")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMDESCRIPTION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODEVALUE")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGSYSTEM")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMCODINGVERSION")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDPROBLEMSOURCEACTORID")=""
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDSTOPINDICATOR")="" ; Vista doesn't have that field
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDDIRSEQ")=DIRNUM
|
||||
. . S @MAP@("M","DIRECTIONS",DIRCNT,"MEDMULDIRMOD")=SIGDATA(6)
|
||||
. ;
|
||||
. ; --- END OF DIRECTIONS ---
|
||||
. ;
|
||||
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
|
||||
. S @MAP@("MEDPTINSTRUCTIONS")=$G(^PSRX(RXIEN,"PI",1,0)) ;GPL
|
||||
. ; W @MAP@("MEDPTINSTRUCTIONS"),!
|
||||
. ; S @MAP@("MEDFULLFILLMENTINSTRUCTIONS","F")="52.41^9"
|
||||
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=$G(^PSRX(RXIEN,"SIG1",1,0)) ;GPL
|
||||
. ; W @MAP@("MEDFULLFILLMENTINSTRUCTIONS"),!
|
||||
. S @MAP@("MEDRFNO")=$$GET1^DIQ(52.41,RXIEN,13)
|
||||
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
|
||||
. K @RESULT
|
||||
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
|
||||
. ; D PARY^C0CXPATH(RESULT)
|
||||
. ; MAPPING DIRECTIONS
|
||||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
|
||||
. ; N MDZ1,MDZNA
|
||||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||||
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
|
||||
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||||
. I MEDFIRST D ;
|
||||
. . S MEDFIRST=0 ; RESET FIRST FLAG
|
||||
. . D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER
|
||||
N MEDTMP,MEDI
|
||||
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||||
. W "Pending Medication MISSING ",!
|
||||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||||
Q
|
||||
;
|
||||
|
|
520
p/C0CMED3.m
520
p/C0CMED3.m
|
@ -1,262 +1,262 @@
|
|||
C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
|
||||
; Copyright 2009 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;;Last Modified: Sun Jan 11 05:45:03 UTC 2009
|
||||
; Copyright 2009 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; Extract medications into provided xml template
|
||||
;
|
||||
; MINXML is the Input XML Template, (passed by name)
|
||||
; DFN is Patient IEN (passed by value)
|
||||
; OUTXML is the resultant XML (passed by name)
|
||||
; MEDCOUNT is the number of Meds extracted so far (passed by reference)
|
||||
;
|
||||
; MEDS is return array from RPC.
|
||||
; MAP is a mapping variable map (store result) for each med
|
||||
; MED is holds each array element from MEDS, one medicine
|
||||
;
|
||||
; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
|
||||
; Discontinued meds are indicated by the presence of a value in fields
|
||||
; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
|
||||
; Will use Fileman API GETS^DIQ
|
||||
;
|
||||
N MEDS,MAP
|
||||
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
|
||||
N NVA
|
||||
D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
|
||||
; If NVA does not exist, then patient has no non-VA meds
|
||||
I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
|
||||
; Otherwise, we go on...
|
||||
M MEDS=NVA(55.05)
|
||||
; We are done with NVA
|
||||
K NVA
|
||||
;
|
||||
I DEBUG ZWRITE MEDS
|
||||
N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
|
||||
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
|
||||
. N MED M MED=MEDS(FDAIEN)
|
||||
. I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it.
|
||||
. S MEDCOUNT=MEDCOUNT+1
|
||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||
. N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
|
||||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||||
. I DEBUG W "MAP= ",MAP,!
|
||||
. S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
|
||||
. S @MAP@("MEDISSUEDATETXT")="Documented Date"
|
||||
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
|
||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
|
||||
. ; Med never filled; next 4 fields are not applicable.
|
||||
. S @MAP@("MEDLASTFILLDATETXT")=""
|
||||
. S @MAP@("MEDLASTFILLDATE")=""
|
||||
. S @MAP@("MEDRXNOTXT")=""
|
||||
. S @MAP@("MEDRXNO")=""
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||
. S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
|
||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
|
||||
. ; NDC is field 31 in the drug file.
|
||||
. ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
|
||||
. ; It' node 1, internal form.
|
||||
. N MEDIEN S MEDIEN=MED(1,"I")
|
||||
. I +MEDIEN D ; start of if/else block
|
||||
. . ; 12/30/08: I will be using RxNorm for coding...
|
||||
. . ; 176.001 is the file for Concepts; 176.003 is the file for
|
||||
. . ; sources (i.e. for RxNorm Version)
|
||||
. . ;
|
||||
. . ; We need the VUID first for the National Drug File entry first
|
||||
. . ; We get the VUID of the drug, by looking up the VA Product entry
|
||||
. . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
|
||||
. . ; Field 99.99 is the VUID.
|
||||
. . ;
|
||||
. . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
|
||||
. . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
|
||||
. . ; $$GET1^DIQ.
|
||||
. . ;
|
||||
. . ; I get the RxNorm name and version from the RxNorm Sources (file
|
||||
. . ; 176.003), by searching for "RXNORM", then get the data.
|
||||
. . ; NDF^PSS50 ONLY EXISTS ON VISTA
|
||||
. . N NDFDATA,NDFIEN,VAPROD
|
||||
. . S NDFIEN=""
|
||||
. . I '$$RPMS^C0CUTIL() D
|
||||
. . . D NDF^PSS50(MEDIEN,,,,,"NDF")
|
||||
. . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||||
. . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||||
. . . M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. . . S NDFIEN=$P(NDFDATA(20),U)
|
||||
. . . S VAPROD=$P(NDFDATA(22),U)
|
||||
. . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ;
|
||||
. . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE
|
||||
. . ; HAVE IT.
|
||||
. . ;
|
||||
. . ; NDFIEN is not necessarily defined; it won't be if the drug
|
||||
. . ; is not matched to the national drug file (e.g. if the drug is
|
||||
. . ; new on the market, compounded, or is a fake drug [blue pill].
|
||||
. . ; To protect against failure, I will put an if/else block
|
||||
. . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
|
||||
. . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
|
||||
. . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
|
||||
. . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
|
||||
. . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
|
||||
. . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
|
||||
. . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
|
||||
. . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
|
||||
. . ;
|
||||
. . E S (RXNORM,RXNNAME,RXNVER)=""
|
||||
. . ; End if/else block
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
|
||||
. . ;
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . ; DOSE^PSS50 ONLY ESISTS ON VISTA
|
||||
. . I '$$RPMS^C0CUTIL() D
|
||||
. . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||||
. . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||||
. . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||||
. . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||||
. . E S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
|
||||
. . ; Units, concentration, etc, come from another call
|
||||
. . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||||
. . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||||
. . ; NDF Entry IEN, and VA Product Name
|
||||
. . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Documented in the same manual; executed above.
|
||||
. . ;
|
||||
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||||
. . ; and this will crash the call. So...
|
||||
. . I NDFIEN="" S CONCDATA=""
|
||||
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||||
. . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||||
. . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||||
. . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||||
. . S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.
|
||||
. . ; Oddly, there is no easy place to find the dispense unit.
|
||||
. . ; It's not included in the original call, so we have to go to the drug file.
|
||||
. . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Node 14.5 is the Dispense Unit
|
||||
. . ; PSS50 ONLY EXISTS ON VISTA
|
||||
. . I '$$RPMS^C0CUTIL() D
|
||||
. . . D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||
. . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||
. . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||
. . E S @MAP@("MEDQUANTITYUNIT")=""
|
||||
. E D
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . S @MAP@("MEDSTRENGTHVALUE")=""
|
||||
. . S @MAP@("MEDSTRENGTHUNIT")=""
|
||||
. . S @MAP@("MEDFORMTEXT")=""
|
||||
. . S @MAP@("MEDCONCVALUE")=""
|
||||
. . S @MAP@("MEDCONCUNIT")=""
|
||||
. . S @MAP@("MEDSIZETEXT")=""
|
||||
. . S @MAP@("MEDQUANTITYVALUE")=""
|
||||
. . S @MAP@("MEDQUANTITYUNIT")=""
|
||||
. ; End If/Else
|
||||
. ; --- START OF DIRECTIONS ---
|
||||
. ; Dosage is field 2, route is 3, schedule is 4
|
||||
. ; These are all free text fields, and don't point to any files
|
||||
. ; For that reason, I will use the field I never used before:
|
||||
. ; MEDDIRECTIONDESCRIPTIONTEXT
|
||||
. S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
||||
. ;
|
||||
. ; --- END OF DIRECTIONS ---
|
||||
. ;
|
||||
. S @MAP@("MEDRFNO")=""
|
||||
. I $D(MED(14,1)) D ;
|
||||
. . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
|
||||
. E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
|
||||
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
|
||||
. K @RESULT
|
||||
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
|
||||
. ; D PARY^C0CXPATH(RESULT)
|
||||
. ; MAPPING DIRECTIONS
|
||||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
|
||||
. N MDZ1,MDZNA
|
||||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||||
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
|
||||
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||||
. ;
|
||||
. ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
|
||||
. N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
|
||||
. ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010
|
||||
. ;S MDI1=$NA(@MAP@("I"))
|
||||
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
|
||||
. I $D(MED(10,1)) D ;
|
||||
. . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field
|
||||
. . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field
|
||||
. E S @MAP@("MEDPTINSTRUCTIONS")=""
|
||||
. ;E S @MAP@("I","MEDPTINSTRUCTIONS")=""
|
||||
. ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
|
||||
. D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL
|
||||
. D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
|
||||
. ;
|
||||
. ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
|
||||
. ;I MEDFIRST D ;
|
||||
. ;. S MEDFIRST=0 ; RESET FIRST FLAG
|
||||
. ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
|
||||
. D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
|
||||
. I MEDFIRST S MEDFIRST=0
|
||||
N MEDTMP,MEDI
|
||||
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||||
. W "MEDICATION MISSING ",!
|
||||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||||
Q
|
||||
;
|
||||
;
|
||||
; MINXML is the Input XML Template, (passed by name)
|
||||
; DFN is Patient IEN (passed by value)
|
||||
; OUTXML is the resultant XML (passed by name)
|
||||
; MEDCOUNT is the number of Meds extracted so far (passed by reference)
|
||||
;
|
||||
; MEDS is return array from RPC.
|
||||
; MAP is a mapping variable map (store result) for each med
|
||||
; MED is holds each array element from MEDS, one medicine
|
||||
;
|
||||
; Non-VA meds don't have an API. They are stored in file 55, subfile 52.2
|
||||
; Discontinued meds are indicated by the presence of a value in fields
|
||||
; 5 or 6 (STATUS 1 or 2, and DISCONTINUED DATE)
|
||||
; Will use Fileman API GETS^DIQ
|
||||
;
|
||||
N MEDS,MAP
|
||||
K ^TMP($J,"CCDCCR") ; PLEASE DON'T KILL ALL OF ^TMP($J) HERE!!!!
|
||||
N NVA
|
||||
D GETS^DIQ(55,DFN,"52.2*","IE","NVA") ; Output in NVA in FDA array format.
|
||||
; If NVA does not exist, then patient has no non-VA meds
|
||||
I $D(NVA)=0 S @OUTXML@(0)=0 QUIT
|
||||
; Otherwise, we go on...
|
||||
M MEDS=NVA(55.05)
|
||||
; We are done with NVA
|
||||
K NVA
|
||||
;
|
||||
I DEBUG ZWRITE MEDS
|
||||
N FDAIEN S FDAIEN=0 ; For use in $Order in the MEDS array.
|
||||
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
|
||||
. N MED M MED=MEDS(FDAIEN)
|
||||
. I MED(5,"I")!MED(6,"I") QUIT ; If disconinued, we don't want to pull it.
|
||||
. S MEDCOUNT=MEDCOUNT+1
|
||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||
. N RXIEN S RXIEN=$P(FDAIEN,",") ; First piece of FDAIEN is the number of the med for this patient
|
||||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||||
. I DEBUG W "MAP= ",MAP,!
|
||||
. S @MAP@("MEDOBJECTID")="MED_OUTSIDE"_MEDCOUNT ; MEDCOUNT FOR ID
|
||||
. S @MAP@("MEDISSUEDATETXT")="Documented Date"
|
||||
. ; Field 6 is "Effective date", and we pull it in timson format w/ I
|
||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL(MED(11,"I"),"DT")
|
||||
. ; Med never filled; next 4 fields are not applicable.
|
||||
. S @MAP@("MEDLASTFILLDATETXT")=""
|
||||
. S @MAP@("MEDLASTFILLDATE")=""
|
||||
. S @MAP@("MEDRXNOTXT")=""
|
||||
. S @MAP@("MEDRXNO")=""
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||
. S @MAP@("MEDSTATUSTEXT")="ACTIVE" ; nearest status for pending meds
|
||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_MED(12,"I")
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=MED(.01,"E")
|
||||
. ; NDC is field 31 in the drug file.
|
||||
. ; The actual drug entry in the drug file (MEDIEN) is not necessarily supplied.
|
||||
. ; It' node 1, internal form.
|
||||
. N MEDIEN S MEDIEN=MED(1,"I")
|
||||
. I +MEDIEN D ; start of if/else block
|
||||
. . ; 12/30/08: I will be using RxNorm for coding...
|
||||
. . ; 176.001 is the file for Concepts; 176.003 is the file for
|
||||
. . ; sources (i.e. for RxNorm Version)
|
||||
. . ;
|
||||
. . ; We need the VUID first for the National Drug File entry first
|
||||
. . ; We get the VUID of the drug, by looking up the VA Product entry
|
||||
. . ; (file 50.68) using the call NDF^PSS50, returned in node 22.
|
||||
. . ; Field 99.99 is the VUID.
|
||||
. . ;
|
||||
. . ; We use the VUID to look up the RxNorm in file 176.001; same idea.
|
||||
. . ; Get IEN first using $$FIND1^DIC, then get the RxNorm number by
|
||||
. . ; $$GET1^DIQ.
|
||||
. . ;
|
||||
. . ; I get the RxNorm name and version from the RxNorm Sources (file
|
||||
. . ; 176.003), by searching for "RXNORM", then get the data.
|
||||
. . ; NDF^PSS50 ONLY EXISTS ON VISTA
|
||||
. . N NDFDATA,NDFIEN,VAPROD
|
||||
. . S NDFIEN=""
|
||||
. . I '$$RPMS^C0CUTIL() D
|
||||
. . . D NDF^PSS50(MEDIEN,,,,,"NDF")
|
||||
. . . ;N NDFDATA M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. . . ;N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||||
. . . ;N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||||
. . . M NDFDATA=^TMP($J,"NDF",MEDIEN)
|
||||
. . . S NDFIEN=$P(NDFDATA(20),U)
|
||||
. . . S VAPROD=$P(NDFDATA(22),U)
|
||||
. . . S @MAP@("MEDPRODUCTNAMETEXT")=$$GET1^DIQ(50.68,VAPROD,.01) ;
|
||||
. . ; GPL - RESET THE NAME TO THE REAL NAME OF THE DRUG NOW THAT WE
|
||||
. . ; HAVE IT.
|
||||
. . ;
|
||||
. . ; NDFIEN is not necessarily defined; it won't be if the drug
|
||||
. . ; is not matched to the national drug file (e.g. if the drug is
|
||||
. . ; new on the market, compounded, or is a fake drug [blue pill].
|
||||
. . ; To protect against failure, I will put an if/else block
|
||||
. . N VUID,RXNIEN,RXNORM,SRCIEN,RXNNAME,RXNVER
|
||||
. . I NDFIEN,$D(^C0CRXN) D ; $Data is for Systems that don't have our RxNorm file yet.
|
||||
. . . S VUID=$$GET1^DIQ(50.68,VAPROD,99.99)
|
||||
. . . S RXNIEN=$$FIND1^DIC(176.001,,,VUID,"VUID")
|
||||
. . . S RXNORM=$$GET1^DIQ(176.001,RXNIEN,.01)
|
||||
. . . S SRCIEN=$$FIND1^DIC(176.003,,"B","RXNORM")
|
||||
. . . S RXNNAME=$$GET1^DIQ(176.003,SRCIEN,6)
|
||||
. . . S RXNVER=$$GET1^DIQ(176.003,SRCIEN,7)
|
||||
. . ;
|
||||
. . E S (RXNORM,RXNNAME,RXNVER)=""
|
||||
. . ; End if/else block
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=RXNORM
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=RXNNAME
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=RXNVER
|
||||
. . ;
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . ; DOSE^PSS50 ONLY ESISTS ON VISTA
|
||||
. . I '$$RPMS^C0CUTIL() D
|
||||
. . . D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||||
. . . N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||||
. . . S @MAP@("MEDSTRENGTHVALUE")=DOSEDATA(901)
|
||||
. . . S @MAP@("MEDSTRENGTHUNIT")=$P(DOSEDATA(902),U,2)
|
||||
. . E S @MAP@("MEDSTRENGTHVALUE")="" S @MAP@("MEDSTRENGTHUNIT")=""
|
||||
. . ; Units, concentration, etc, come from another call
|
||||
. . ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||||
. . ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||||
. . ; NDF Entry IEN, and VA Product Name
|
||||
. . ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Documented in the same manual; executed above.
|
||||
. . ;
|
||||
. . ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||||
. . ; and this will crash the call. So...
|
||||
. . I NDFIEN="" S CONCDATA=""
|
||||
. . E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||||
. . S @MAP@("MEDFORMTEXT")=$P(CONCDATA,U,1)
|
||||
. . S @MAP@("MEDCONCVALUE")=$P(CONCDATA,U,3)
|
||||
. . S @MAP@("MEDCONCUNIT")=$P(CONCDATA,U,4)
|
||||
. . S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.
|
||||
. . ; Oddly, there is no easy place to find the dispense unit.
|
||||
. . ; It's not included in the original call, so we have to go to the drug file.
|
||||
. . ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||||
. . ; Node 14.5 is the Dispense Unit
|
||||
. . ; PSS50 ONLY EXISTS ON VISTA
|
||||
. . I '$$RPMS^C0CUTIL() D
|
||||
. . . D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||
. . . N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||
. . . S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||
. . E S @MAP@("MEDQUANTITYUNIT")=""
|
||||
. E D
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVALUE")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=""
|
||||
. . S @MAP@("MEDPRODUCTNAMECODEVERSION")=""
|
||||
. . S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. . S @MAP@("MEDSTRENGTHVALUE")=""
|
||||
. . S @MAP@("MEDSTRENGTHUNIT")=""
|
||||
. . S @MAP@("MEDFORMTEXT")=""
|
||||
. . S @MAP@("MEDCONCVALUE")=""
|
||||
. . S @MAP@("MEDCONCUNIT")=""
|
||||
. . S @MAP@("MEDSIZETEXT")=""
|
||||
. . S @MAP@("MEDQUANTITYVALUE")=""
|
||||
. . S @MAP@("MEDQUANTITYUNIT")=""
|
||||
. ; End If/Else
|
||||
. ; --- START OF DIRECTIONS ---
|
||||
. ; Dosage is field 2, route is 3, schedule is 4
|
||||
. ; These are all free text fields, and don't point to any files
|
||||
. ; For that reason, I will use the field I never used before:
|
||||
. ; MEDDIRECTIONDESCRIPTIONTEXT
|
||||
. S DIRCNT=1 ; THERE IS ONLY ONE DIRECTION FOR OUTSIDE MEDS
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
||||
. ;
|
||||
. ; --- END OF DIRECTIONS ---
|
||||
. ;
|
||||
. S @MAP@("MEDRFNO")=""
|
||||
. I $D(MED(14,1)) D ;
|
||||
. . S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
|
||||
. E S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
|
||||
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
|
||||
. K @RESULT
|
||||
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
|
||||
. ; D PARY^C0CXPATH(RESULT)
|
||||
. ; MAPPING DIRECTIONS
|
||||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
|
||||
. N MDZ1,MDZNA
|
||||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||||
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
|
||||
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||||
. ;
|
||||
. ; MAP PATIENT INSTRUCTIONS - HAVE TO DO THIS AFTER MAPPING DIRECTIONS DUE TO XML SCHEMA VALIDATION
|
||||
. N MEDINT1,INTXML1 S INTXML1="MENINT1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N MEDINT2,INTXML2 S INTXML2="MEDINT2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/PatientInstructions",INTXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/PatientInstructions")
|
||||
. ;N MDI1 ; removing the "I" which is not in the protocol gpl 1/2010
|
||||
. ;S MDI1=$NA(@MAP@("I"))
|
||||
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
|
||||
. I $D(MED(10,1)) D ;
|
||||
. . ;S @MAP@("I","MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field
|
||||
. . S @MAP@("MEDPTINSTRUCTIONS")=$P(MED(10,1)," ",1) ; WP Field
|
||||
. E S @MAP@("MEDPTINSTRUCTIONS")=""
|
||||
. ;E S @MAP@("I","MEDPTINSTRUCTIONS")=""
|
||||
. ;D MAP^C0CXPATH(INTXML1,MDI1,INTXML2)
|
||||
. D MAP^C0CXPATH(INTXML1,MAP,INTXML2) ; JUST MAP WORKS.. GPL
|
||||
. D INSERT^C0CXPATH(RESULT,INTXML2,"//Medications/Medication")
|
||||
. ;
|
||||
. ; FLAG HAS TO BE RESET OUTSIDE THE IF STATMENT.
|
||||
. ;I MEDFIRST D ;
|
||||
. ;. S MEDFIRST=0 ; RESET FIRST FLAG
|
||||
. ;. D CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. ;D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER FIRST, INSERT INNER XML
|
||||
. D:MEDFIRST CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. D:'MEDFIRST INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
|
||||
. I MEDFIRST S MEDFIRST=0
|
||||
N MEDTMP,MEDI
|
||||
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||||
. W "MEDICATION MISSING ",!
|
||||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||||
Q
|
||||
;
|
||||
|
|
88
p/C0CMIME.m
88
p/C0CMIME.m
|
@ -1,4 +1,4 @@
|
|||
C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11
|
||||
C0CMIME ; CCDCCR/GPL - MIME manipulation utilities; 3/8/11 ; 5/16/11 2:32pm
|
||||
;;1.0;C0C;;Mar 8, 2011;
|
||||
;Copyright 2008 George Lilly. Licensed under the terms of the GNU
|
||||
;General Public License See attached copy of the License.
|
||||
|
@ -80,23 +80,49 @@ TESTMAIL2 ;
|
|||
S C0CGM(3)="It contains no Protected Health Information (PHI)"
|
||||
S C0CGM(4)="It is purely test data used for software development"
|
||||
S C0CGM(5)="It does not represent information about any person living or dead"
|
||||
S ZTO("glilly@glilly.net")=""
|
||||
S ZTO("LILLY.GEORGE@mdc-crew.net")=""
|
||||
;S ZTO("glilly@glilly.net")=""
|
||||
;S ZTO("george.lilly@pobox.com")=""
|
||||
;S ZTO("george@nhin.openforum.opensourcevista.net")=""
|
||||
;S ZTO("mish@nhin.openforum.opensourcevista.net")=""
|
||||
S ZTO("brooks.richard@securemail.opensourcevista.net")=""
|
||||
;S ZTO("LILLY.GEORGE@mdc-crew.net")=""
|
||||
;S ZTO("ncoal@live.com")=""
|
||||
;S ZTO("martijn@djigzo.com")=""
|
||||
;S ZTO("profmish@gmail.com")=""
|
||||
;S ZTO("nanthracite@earthlink.net")=""
|
||||
S ZFROM="ANTHRACITE.NANCY"
|
||||
S ZTO("gpl.doctortest@gmail.com")=""
|
||||
S ZFROM="LILLY.GEORGE"
|
||||
S ZATTACH=$NA(^GPL("CCR"))
|
||||
I $G(@ZATTACH@(1))="" D ; NO CCR THERE
|
||||
. D CCRRPC^C0CCCR(.GPL,2) ; GET ONE FROM PATIENT 2
|
||||
. M @ZATTACH=GPL ; PUT IT IN THERE FOR NEXT TIME
|
||||
S ZSUBJECT="TEST OF THE NEW MAILSEND ROUTINE"
|
||||
D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH)
|
||||
D MAILSEND(.GR,ZFROM,"ZTO",,ZSUBJECT,"C0CGM",ZATTACH,"CCR.xml")
|
||||
ZWR GR
|
||||
Q
|
||||
;
|
||||
MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FLAGS) ; MAIL SENDING INTERFACE
|
||||
LINE(C0CFILE,C0CTO) ; read a file name passed in C0CFILE and send it to
|
||||
; the email address in C0CTO
|
||||
; the directory and the "from" are all hard coded
|
||||
;
|
||||
N ZZFROM S ZZFROM="LILLY.GEORGE"
|
||||
N GN S GN=$NA(^TMP("C0CMIME2",$J))
|
||||
N GN1 S GN1=$NA(@GN@(1))
|
||||
K @GN
|
||||
I '$D(C0CFILE) Q ; NO FILENAME PASSED
|
||||
I '$D(C0CTO) S C0CTO="brooks.richard@securemail.opensourcevista.net"
|
||||
S ZZTO(C0CTO)=""
|
||||
N ZMESS S ZMESS(1)="file transmission from wvehr3-09"
|
||||
N GD S GD="/home/wvehr3-09/EHR/" ; directory
|
||||
I '$$FTG^%ZISH(GD,C0CFILE,GN1,3) Q D ;
|
||||
. W !,"error reading file",C0CFILE
|
||||
D MAILSEND(.ZRTN,ZZFROM,"ZZTO",,"file transmission","ZMESS",GN,C0CFILE)
|
||||
K @GN ; CLEAN UP
|
||||
;ZWR ZRTN
|
||||
W !,$G(ZRTN(1))
|
||||
Q
|
||||
;
|
||||
MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FNAME,FLAGS) ; MAIL SENDING INTERFACE
|
||||
; RTN IS THE RETURN ARRAY PASSED BY REFERENCE
|
||||
; FROM IS PASSED BY VALUE AND IS THE EMAIL ADDRESS OF THE SENDER
|
||||
; IF NULL, WILL SEND FROM THE CURRENT DUZ
|
||||
|
@ -106,45 +132,47 @@ MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FLAGS) ; MAIL SENDING INTERFACE
|
|||
; SUBJECT IS PASSED BY VALUE AND WILL GO IN THE SUBJECT LINE
|
||||
; MESSAGE IS PASSED BY NAME AND IS AN ARRAY OF TEXT
|
||||
; ATTACH IS PASSED BY NAME AND IS AN XML OR HTML FILE TO BE ATTACHED
|
||||
; FNAME IS THE FILENAME OF THE ATTACHMENT, DEFAULT IS ccr.xml
|
||||
;
|
||||
I '$D(FNAME) S FNAME="ccr.xml" ; default filename
|
||||
N GN
|
||||
S GN=$NA(^TMP($J,"C0CMIME"))
|
||||
K @GN
|
||||
S GM(1)="MIME-Version: 1.0"
|
||||
S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
|
||||
S GM(3)=" "
|
||||
S GM(4)=" "
|
||||
S GM(3)=""
|
||||
S GM(4)=""
|
||||
;S GM(5)="--123456788888"
|
||||
;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
|
||||
S GM(5)="--123456899999"
|
||||
S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
|
||||
S GM(6)="Content-Type: text/xml; name="_FNAME
|
||||
S GM(7)="Content-Transfer-Encoding: base64"
|
||||
S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
|
||||
S GM(9)=" "
|
||||
S GM(10)=" " ; FOR THE END
|
||||
S GM(8)="Content-Disposition: attachment; filename="_FNAME
|
||||
S GM(9)=""
|
||||
S GM(10)="" ; FOR THE END
|
||||
;S GM(11)="--123456788888--"
|
||||
S GM(11)="--123456899999--"
|
||||
S GM(12)=" "
|
||||
S GM(13)=" "
|
||||
S GM(12)=""
|
||||
S GM(13)=""
|
||||
S GG(1)="--123456899999"
|
||||
S GG(2)="Content-Type: text/plain; charset=ISO-8859-1; format=flowed"
|
||||
S GG(3)="Content-Transfer-Encoding: 7bit"
|
||||
S GG(4)=" "
|
||||
S GG(4)=""
|
||||
S GG(5)="This is a test message."
|
||||
S GG(6)="A Continuity of Care record is attached"
|
||||
S GG(7)="It contains no Protected Health Information (PHI)"
|
||||
S GG(8)="It is purely test data used for software development"
|
||||
S GG(9)="It does not represent information about any person living or dead"
|
||||
S GG(10)=" "
|
||||
S GG(10)=""
|
||||
S GG(11)="--123456899999--"
|
||||
;S GG(11)="Content-Type: text/plain; charset=""us-ascii"""
|
||||
S GG(12)=" "
|
||||
S GG(12)=""
|
||||
;S GG(13)="This is a test message."
|
||||
S GG(14)="A Continuity of Care record is attached"
|
||||
S GG(15)="It contains no Protected Health Information (PHI)"
|
||||
S GG(16)="It is purely test data used for software development"
|
||||
S GG(17)="It does not represent information about any person living or dead"
|
||||
S GG(18)=" "
|
||||
S GG(18)=""
|
||||
S GG(19)="--123456899999"
|
||||
S GG(20)="--987654321--"
|
||||
K GBLD
|
||||
|
@ -182,19 +210,19 @@ MAILSEND0(LRMSUBJ) ; Send extract back to requestor.
|
|||
;M @GN=G2
|
||||
S GM(1)="MIME-Version: 1.0"
|
||||
S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
|
||||
S GM(3)=" "
|
||||
S GM(4)=" "
|
||||
S GM(3)=""
|
||||
S GM(4)=""
|
||||
S GM(5)="--1234567"
|
||||
;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
|
||||
S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
|
||||
S GM(7)="Content-Transfer-Encoding: base64"
|
||||
S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
|
||||
;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
|
||||
S GM(9)=" "
|
||||
S GM(10)=" " ; FOR THE END
|
||||
S GM(9)=""
|
||||
S GM(10)="" ; FOR THE END
|
||||
S GM(11)="--frontier--"
|
||||
S GM(12)="."
|
||||
S GM(13)=" "
|
||||
S GM(13)=""
|
||||
K GBLD
|
||||
;D QUEUE^C0CXPATH("GBLD","GM",1,9)
|
||||
;D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
|
||||
|
@ -231,19 +259,19 @@ MAILSEND2(UDFN,ADDR) ; Send extract back to requestor.
|
|||
;M @GN=G2
|
||||
S GM(1)="MIME-Version: 1.0"
|
||||
S GM(2)="Content-Type: multipart/mixed; boudary=""1234567"""
|
||||
S GM(3)=" "
|
||||
S GM(4)=" "
|
||||
S GM(3)=""
|
||||
S GM(4)=""
|
||||
S GM(5)="--1234567"
|
||||
;S GM(5)=$$REPEAT^XLFSTR("-",$L(X))
|
||||
S GM(6)="Content-Type: text/xml; name=""ccr.xml"""
|
||||
S GM(7)="Content-Transfer-Encoding: base64"
|
||||
S GM(8)="Content-Disposition: attachment; filename=""ccr.xml"""
|
||||
;S GM(6)=$$UUBEGFN^LRSRVR2A("CCR.xml")
|
||||
S GM(9)=" "
|
||||
S GM(10)=" " ; FOR THE END
|
||||
S GM(9)=""
|
||||
S GM(10)="" ; FOR THE END
|
||||
S GM(11)="--1234567--"
|
||||
S GM(12)=" "
|
||||
S GM(13)=" "
|
||||
S GM(12)=""
|
||||
S GM(13)=""
|
||||
K GBLD
|
||||
D QUEUE^C0CXPATH("GBLD","GM",5,9)
|
||||
D QUEUE^C0CXPATH("GBLD","G2",1,$O(G2(""),-1))
|
||||
|
@ -308,4 +336,4 @@ CLEAN(IARY) ; RUNS THROUGH AN ARRAY PASSED BY NAME AND STRIPS OUT $C(13)
|
|||
. S @IARY@(ZI)=$TR(@IARY@(ZI),$C(13)) ;
|
||||
. I $F(@IARY@(ZI)," <") S @IARY@(ZI)="<"_$P(@IARY@(ZI)," <",2) ; RM BLNKS
|
||||
Q
|
||||
;
|
||||
;
|
||||
|
|
540
p/C0CMXML.m
540
p/C0CMXML.m
|
@ -1,286 +1,254 @@
|
|||
C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05
|
||||
;;0.1;C0C;nopatch;noreleasedate
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
Q
|
||||
; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
|
||||
; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM
|
||||
; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD
|
||||
; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP
|
||||
;
|
||||
TEST ; TEST DRIVER ASSUMES A CCR IN ^GPL("CCR")
|
||||
; LOOK FOR TEST RESULTS IN VARIABLE G
|
||||
; ACTUALLY, IF NO CCR IS THERE, IT WILL PUT ONE THERE FOR PAT DFN 2
|
||||
;
|
||||
N GPLCCR S GPLCCR=$NA(^GPL("CCR"))
|
||||
I '$D(@GPLCCR@(1)) D ; NO CCR THERE
|
||||
. N TGPL
|
||||
. D CCRRPC^C0CCCR(.TGPL,2) ; GET A CCR FOR PAT 2
|
||||
. M @GPLCCR=TGPL ; PUT IT IN THE TEST GLOBAL
|
||||
. K @GPLCCR@(0) ; KILL THE LINE COUNT FOR THE PARSER
|
||||
D EN(.G,GPLCCR)
|
||||
Q
|
||||
;
|
||||
EN(ZRTN,C0CIN) ; PARSE THE CCR PASSED BY NAME IN C0CIN
|
||||
; AND RETURN THE XPATH ARRAY THAT RESULTS IN ZRTN, PASSED BY REFERENCE
|
||||
I '$D(@C0CIN@(1)) Q ;NOTHING PASSED IN
|
||||
K ZRTN
|
||||
N C0CDOCID,REDUX,GARY,GARY2,GARY3
|
||||
S C0CDOCID=$$PARSE(C0CIN)
|
||||
S REDUX="//ContinuityOfCareRecord/Body"
|
||||
D XPATH(1,"/","GIDX","GARY",,REDUX)
|
||||
D SEPARATE^C0CMCCD("GARY2","GARY")
|
||||
S ZI=""
|
||||
F S ZI=$O(GARY2(ZI)) Q:ZI="" D ;
|
||||
. N GTMP,G2
|
||||
. M G2=GARY2(ZI)
|
||||
. D DEMUX2^C0CMXP("GTMP","G2",2)
|
||||
. M GARY3(ZI)=GTMP
|
||||
M ZRTN=GARY3
|
||||
Q
|
||||
;
|
||||
TEST0 ;
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY
|
||||
M @C0CXMLIN=^GPL("CCR")
|
||||
;W $$FTG^%ZISH("/home/vademo2/CCR/","PAT_774_CCR_V1_0_0.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
|
||||
S REDUX="//ContinuityOfCareRecord/Body"
|
||||
D XPATH(1,"/","GIDX","GARY",,REDUX)
|
||||
D SEPARATE^C0CMCCD("GARY2","GARY")
|
||||
S ZI=""
|
||||
F S ZI=$O(GARY2(ZI)) Q:ZI="" D ;
|
||||
. N GTMP,G2
|
||||
. M G2=GARY2(ZI)
|
||||
. D DEMUX2^C0CMXP("GTMP","G2",2)
|
||||
. M GARY3(ZI)=GTMP
|
||||
Q
|
||||
;
|
||||
TEST2 ;
|
||||
S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
|
||||
D XPATH(1,"/","GIDX","GARY","",REDUX)
|
||||
Q
|
||||
;
|
||||
TEST3
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY,GTMP,GIDX
|
||||
K @C0CXMLIN
|
||||
W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
|
||||
S REDUX="//ClinicalDocument/component/structuredBody"
|
||||
D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
|
||||
D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
|
||||
D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
|
||||
D XPATH(1,"/","GIDX","GARY",,REDUX)
|
||||
K C0CCBK("TAG")
|
||||
D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
|
||||
D TEST3A
|
||||
Q
|
||||
;
|
||||
TEST3A ; INTERNAL ROUTINE
|
||||
S ZI=""
|
||||
F S ZI=$O(GARY2(ZI)) Q:ZI="" D ;
|
||||
. N GTMP,G2
|
||||
. M G2=GARY2(ZI)
|
||||
. D DEMUX2^C0CMXP("GTMP","G2",2)
|
||||
. M GARY4(ZI)=GTMP
|
||||
Q
|
||||
;
|
||||
TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY,GTMP,GIDX
|
||||
K @C0CXMLIN
|
||||
W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
|
||||
K @C0CXMLIN
|
||||
S GTMP(1)="<"_$P(GTMP(1),"<",2)
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
D TESTQ2
|
||||
Q
|
||||
;
|
||||
TESTQ2 ; SECOND PART OF TESTQ
|
||||
D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
|
||||
S REDUX="//ClinicalDocument/component/structuredBody"
|
||||
D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
|
||||
D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
|
||||
D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
|
||||
D XPATH(1,"/","GIDX","GARY",,REDUX)
|
||||
K C0CCBK("TAG")
|
||||
D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
|
||||
D TEST3A
|
||||
Q
|
||||
;
|
||||
TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
|
||||
;
|
||||
D TEST ; SET UP THE DOM
|
||||
D START^C0CMXMLB($$TAG(1),,"G")
|
||||
D NDOUT($$FIRST(1))
|
||||
D END^C0CMXMLB ;END THE DOCUMENT
|
||||
M ZCCR=^TMP("MXMLBLD",$J)
|
||||
ZWR ZCCR
|
||||
Q
|
||||
;
|
||||
TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY,GTMP,GIDX
|
||||
K @C0CXMLIN
|
||||
W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER
|
||||
;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
|
||||
D OUTXML("ZCCD",C0CDOCID)
|
||||
;D START^C0CMXMLB($$TAG(1),,"G")
|
||||
;D NDOUT($$FIRST(1))
|
||||
;D END^C0CMXMLB ;EOND THE DOCUMENT
|
||||
;M ZCCD=^TMP("MXMLBLD",$J)
|
||||
ZWR ZCCD(1:30)
|
||||
Q
|
||||
;
|
||||
XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
||||
; THE XPATH INDEX ZXIDX, PASSED BY NAME
|
||||
; THE XPATH ARRAY XPARY, PASSED BY NAME
|
||||
; ZOID IS THE STARTING OID
|
||||
; ZPATH IS THE STARTING XPATH, USUALLY "/"
|
||||
; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
|
||||
; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
|
||||
I $G(ZREDUX)="" S ZREDUX=""
|
||||
N NEWPATH
|
||||
N NEWNUM S NEWNUM=""
|
||||
I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
|
||||
S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
|
||||
I $G(ZREDUX)'="" D ; REDUX PROVIDED?
|
||||
. N GT S GT=$P(NEWPATH,ZREDUX,2)
|
||||
. I GT'="" S NEWPATH=GT
|
||||
S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
|
||||
N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
|
||||
I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
|
||||
E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
|
||||
N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
|
||||
I ZFRST'=0 D ; THERE IS A CHILD
|
||||
. N ZNUM
|
||||
. N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
|
||||
. D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
|
||||
N GNXT S GNXT=$$NXTSIB(ZOID)
|
||||
I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
|
||||
I GNXT'=0 D ;
|
||||
. N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
|
||||
. I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
|
||||
. . N ZNUM S ZNUM=1 ;
|
||||
. . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
|
||||
. E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
|
||||
Q
|
||||
;
|
||||
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
|
||||
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
|
||||
;Q $$EN^MXMLDOM(INXML)
|
||||
Q $$EN^MXMLDOM(INXML,"W")
|
||||
;
|
||||
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
|
||||
N ZN
|
||||
;I $$TAG(ZOID)["entry" B
|
||||
S ZN=$$NXTSIB(ZOID)
|
||||
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
|
||||
Q 0
|
||||
;
|
||||
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
|
||||
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
|
||||
;
|
||||
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
|
||||
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
|
||||
;
|
||||
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
|
||||
S HANDLE=C0CDOCID
|
||||
K @RTN
|
||||
D GETTXT^MXMLDOM("A")
|
||||
Q
|
||||
;
|
||||
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
||||
;I ZOID=149 B ;GPLTEST
|
||||
N X,Y
|
||||
S Y=""
|
||||
S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
|
||||
I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
|
||||
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
|
||||
Q Y
|
||||
;
|
||||
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
|
||||
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
|
||||
;
|
||||
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
|
||||
;N ZT,ZN S ZT=""
|
||||
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
||||
;Q $G(@C0CDOM@(ZOID,"T",1))
|
||||
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
|
||||
Q
|
||||
;
|
||||
OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
||||
;
|
||||
S C0CDOCID=INID
|
||||
D START^C0CMXMLB($$TAG(1),,"G")
|
||||
D NDOUT($$FIRST(1))
|
||||
D END^C0CMXMLB ;END THE DOCUMENT
|
||||
M @ZRTN=^TMP("MXMLBLD",$J)
|
||||
K ^TMP("MXMLBLD",$J)
|
||||
Q
|
||||
;
|
||||
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
|
||||
N ZI S ZI=$$FIRST(ZOID)
|
||||
I ZI'=0 D ; THERE IS A CHILD
|
||||
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
|
||||
. D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
|
||||
E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
|
||||
. ;W "DOING",ZOID,!
|
||||
. N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
|
||||
. N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
|
||||
. D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
|
||||
I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
|
||||
. D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
|
||||
Q
|
||||
;
|
||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05
|
||||
;;0.1;C0C;nopatch;noreleasedate;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
Q
|
||||
; THIS FILE CONTAINS THE XPATH CREATOR, THE PARSE CALL TO THE MXML PARSER
|
||||
; AND THE OUTXML XML GENERATOR THAT OUTPUTS XML FROM AN MXML DOM
|
||||
; FOR CCD SPECIFIC ROUTINES, SEE C0CMCCD
|
||||
; FOR TEMPLATE FILE RELATED ROUTINES, SEE C0CMXP
|
||||
;
|
||||
TEST ;
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY
|
||||
W $$FTG^%ZISH("/home/vademo2/EHR/p/","mxml-test.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DocID: ",C0CDOCID
|
||||
S REDUX="//ContinuityOfCareRecord/Body"
|
||||
D XPATH(1,"/","GIDX","GARY",,REDUX)
|
||||
D SEPARATE^C0CMCCD("GARY2","GARY")
|
||||
S ZI=""
|
||||
F S ZI=$O(GARY2(ZI)) Q:ZI="" D ;
|
||||
. N GTMP,G2
|
||||
. M G2=GARY2(ZI)
|
||||
. D DEMUX2^C0CMXP("GTMP","G2",2)
|
||||
. M GARY3(ZI)=GTMP
|
||||
Q
|
||||
;
|
||||
TEST2 ;
|
||||
S REDUX="//soap:Envelope/soap:Body/GetPatientFullMedicationHistory5Response/GetPatientFullMedicationHistory5Result/patientDrugDetail"
|
||||
D XPATH(1,"/","GIDX","GARY","",REDUX)
|
||||
Q
|
||||
;
|
||||
TEST3
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY,GTMP,GIDX
|
||||
K @C0CXMLIN
|
||||
W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
|
||||
S REDUX="//ClinicalDocument/component/structuredBody"
|
||||
D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
|
||||
D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
|
||||
D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
|
||||
D XPATH(1,"/","GIDX","GARY",,REDUX)
|
||||
K C0CCBK("TAG")
|
||||
D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
|
||||
D TEST3A
|
||||
Q
|
||||
;
|
||||
TEST3A ; INTERNAL ROUTINE
|
||||
S ZI=""
|
||||
F S ZI=$O(GARY2(ZI)) Q:ZI="" D ;
|
||||
. N GTMP,G2
|
||||
. M G2=GARY2(ZI)
|
||||
. D DEMUX2^C0CMXP("GTMP","G2",2)
|
||||
. M GARY4(ZI)=GTMP
|
||||
Q
|
||||
;
|
||||
TESTQ ; TEST OF THE QRDA TEMPLATE GPL 7/8/2010
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY,GTMP,GIDX
|
||||
K @C0CXMLIN
|
||||
W $$FTG^%ZISH("/home/vademo2/","QRDA_CategoryI_WorldVistA1.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
|
||||
K @C0CXMLIN
|
||||
S GTMP(1)="<"_$P(GTMP(1),"<",2)
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
D TESTQ2
|
||||
Q
|
||||
;
|
||||
TESTQ2 ; SECOND PART OF TESTQ
|
||||
D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
S C0CDOCID=$$PARSCCD^C0CMCCD(C0CXMLIN,"W") W !,"DocID: ",C0CDOCID
|
||||
S REDUX="//ClinicalDocument/component/structuredBody"
|
||||
D FINDTID^C0CMCCD ; FIND THE TEMPLATE IDS
|
||||
D FINDALT^C0CMCCD ; FIND ALTERNATE TAGS
|
||||
D SETCBK^C0CMCCD ; SET THE CALLBACK ROUTINE FOR TAGS
|
||||
D XPATH(1,"/","GIDX","GARY",,REDUX)
|
||||
K C0CCBK("TAG")
|
||||
D SEPARATE^C0CMCCD("GARY2","GARY") ; SEPARATE FOR EASIER BROWSING
|
||||
D TEST3A
|
||||
Q
|
||||
;
|
||||
TEST4 ; TEST OF OUTPUTING AN XML FILE FROM THE DOM .. this one is the CCR
|
||||
;
|
||||
D TEST ; SET UP THE DOM
|
||||
D START^C0CMXMLB($$TAG(1),,"G")
|
||||
D NDOUT($$FIRST(1))
|
||||
D END^C0CMXMLB ;END THE DOCUMENT
|
||||
M ZCCR=^TMP("MXMLBLD",$J)
|
||||
ZWR ZCCR
|
||||
Q
|
||||
;
|
||||
TEST5 ; SAME AS TEST4, BUT THIS TIME THE CCD
|
||||
S C0CXMLIN=$NA(^TMP("C0CMXML",$J))
|
||||
K GARY,GTMP,GIDX
|
||||
K @C0CXMLIN
|
||||
W $$FTG^%ZISH("/home/vademo2/CCR/","SampleCCDDocument.xml",$NA(@C0CXMLIN@(1)),3)
|
||||
D CLEANARY^C0CMCCD("GTMP",C0CXMLIN) ; REMOVE CONTROL CHARACTERS
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
D STRIPTXT^C0CMCCD("GTMP",C0CXMLIN)
|
||||
K @C0CXMLIN
|
||||
M @C0CXMLIN=GTMP
|
||||
K GTMP
|
||||
S C0CDOCID=$$PARSE(C0CXMLIN) W !,"DOCID: ",C0CDOCID ;CALL REGULAR PARSER
|
||||
;D XPATH(1,"/","GIDX2","GARY2",,REDUX)
|
||||
D OUTXML("ZCCD",C0CDOCID)
|
||||
;D START^C0CMXMLB($$TAG(1),,"G")
|
||||
;D NDOUT($$FIRST(1))
|
||||
;D END^C0CMXMLB ;EOND THE DOCUMENT
|
||||
;M ZCCD=^TMP("MXMLBLD",$J)
|
||||
ZWR ZCCD(1:30)
|
||||
Q
|
||||
;
|
||||
XPATH(ZOID,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; RECURSIVE ROUTINE TO POPULATE
|
||||
; THE XPATH INDEX ZXIDX, PASSED BY NAME
|
||||
; THE XPATH ARRAY XPARY, PASSED BY NAME
|
||||
; ZOID IS THE STARTING OID
|
||||
; ZPATH IS THE STARTING XPATH, USUALLY "/"
|
||||
; ZNUM IS THE MULTIPLE NUMBER [x], USUALLY NULL WHEN ON THE TOP NODE
|
||||
; ZREDUX IS THE XPATH REDUCTION STRING, TAKEN OUT OF EACH XPATH IF PRESENT
|
||||
I $G(ZREDUX)="" S ZREDUX=""
|
||||
N NEWPATH
|
||||
N NEWNUM S NEWNUM=""
|
||||
I $G(ZNUM)>0 S NEWNUM="["_ZNUM_"]"
|
||||
S NEWPATH=ZPATH_"/"_$$TAG(ZOID)_NEWNUM ; CREATE THE XPATH FOR THIS NODE
|
||||
I $G(ZREDUX)'="" D ; REDUX PROVIDED?
|
||||
. N GT S GT=$P(NEWPATH,ZREDUX,2)
|
||||
. I GT'="" S NEWPATH=GT
|
||||
S @ZXIDX@(NEWPATH)=ZOID ; ADD THE XPATH FOR THIS NODE TO THE XPATH INDEX
|
||||
N GD D DATA("GD",ZOID) ; SEE IF THERE IS DATA FOR THIS NODE
|
||||
I $D(GD(2)) M @ZXPARY@(NEWPATH)=GD ; IF MULITPLE DATA MERGE TO THE ARRAY
|
||||
E I $D(GD(1)) S @ZXPARY@(NEWPATH)=GD(1) ; IF SINGLE VALUE, ADD TO ARRAY
|
||||
N ZFRST S ZFRST=$$FIRST(ZOID) ; SET FIRST CHILD
|
||||
I ZFRST'=0 D ; THERE IS A CHILD
|
||||
. N ZNUM
|
||||
. N ZMULT S ZMULT=$$ISMULT(ZFRST) ; IS FIRST CHILD A MULTIPLE
|
||||
. D XPATH(ZFRST,NEWPATH,ZXIDX,ZXPARY,$S(ZMULT:1,1:""),ZREDUX) ; DO THE CHILD
|
||||
N GNXT S GNXT=$$NXTSIB(ZOID)
|
||||
I $$TAG(GNXT)'=$$TAG(ZOID) S ZNUM="" ; RESET COUNTING AFTER MULTIPLES
|
||||
I GNXT'=0 D ;
|
||||
. N ZMULT S ZMULT=$$ISMULT(GNXT) ; IS THE SIBLING A MULTIPLE?
|
||||
. I (ZNUM="")&(ZMULT) D ; SIBLING IS FIRST OF MULTIPLES
|
||||
. . N ZNUM S ZNUM=1 ;
|
||||
. . D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,ZNUM,ZREDUX) ; DO NEXT SIB
|
||||
. E D XPATH(GNXT,ZPATH,ZXIDX,ZXPARY,$S(ZNUM>0:ZNUM+1,1:""),ZREDUX) ; DO NEXT SIB
|
||||
Q
|
||||
;
|
||||
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
|
||||
; EXTRINSIC WHICH RETURNS THE DOCID ASSIGNED BY MXML
|
||||
;Q $$EN^MXMLDOM(INXML)
|
||||
Q $$EN^MXMLDOM(INXML,"W")
|
||||
;
|
||||
ISMULT(ZOID) ; RETURN TRUE IF ZOID IS ONE OF A MULTIPLE
|
||||
N ZN
|
||||
;I $$TAG(ZOID)["entry" B
|
||||
S ZN=$$NXTSIB(ZOID)
|
||||
I ZN'="" Q $$TAG(ZOID)=$$TAG(ZN) ; IF TAG IS THE SAME AS NEXT SIB TAG
|
||||
Q 0
|
||||
;
|
||||
FIRST(ZOID) ;RETURNS THE OID OF THE FIRST CHILD OF ZOID
|
||||
Q $$CHILD^MXMLDOM(C0CDOCID,ZOID)
|
||||
;
|
||||
PARENT(ZOID) ;RETURNS THE OID OF THE PARENT OF ZOID
|
||||
Q $$PARENT^MXMLDOM(C0CDOCID,ZOID)
|
||||
;
|
||||
ATT(RTN,NODE) ;GET ATTRIBUTES FOR ZOID
|
||||
S HANDLE=C0CDOCID
|
||||
K @RTN
|
||||
D GETTXT^MXMLDOM("A")
|
||||
Q
|
||||
;
|
||||
TAG(ZOID) ; RETURNS THE XML TAG FOR THE NODE
|
||||
;I ZOID=149 B ;GPLTEST
|
||||
N X,Y
|
||||
S Y=""
|
||||
S X=$G(C0CCBK("TAG")) ;IS THERE A CALLBACK FOR THIS ROUTINE
|
||||
I X'="" X X ; EXECUTE THE CALLBACK, SHOULD SET Y
|
||||
I Y="" S Y=$$NAME^MXMLDOM(C0CDOCID,ZOID)
|
||||
Q Y
|
||||
;
|
||||
NXTSIB(ZOID) ; RETURNS THE NEXT SIBLING
|
||||
Q $$SIBLING^MXMLDOM(C0CDOCID,ZOID)
|
||||
;
|
||||
DATA(ZT,ZOID) ; RETURNS DATA FOR THE NODE
|
||||
;N ZT,ZN S ZT=""
|
||||
;S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
||||
;Q $G(@C0CDOM@(ZOID,"T",1))
|
||||
S ZN=$$TEXT^MXMLDOM(C0CDOCID,ZOID,ZT)
|
||||
Q
|
||||
;
|
||||
OUTXML(ZRTN,INID) ; USES C0CMXMLB (MXMLBLD) TO OUTPUT XML FROM AN MXMLDOM
|
||||
;
|
||||
S C0CDOCID=INID
|
||||
D START^C0CMXMLB($$TAG(1),,"G")
|
||||
D NDOUT($$FIRST(1))
|
||||
D END^C0CMXMLB ;END THE DOCUMENT
|
||||
M @ZRTN=^TMP("MXMLBLD",$J)
|
||||
K ^TMP("MXMLBLD",$J)
|
||||
Q
|
||||
;
|
||||
NDOUT(ZOID) ;CALLBACK ROUTINE - IT IS RECURSIVE
|
||||
N ZI S ZI=$$FIRST(ZOID)
|
||||
I ZI'=0 D ; THERE IS A CHILD
|
||||
. N ZATT D ATT("ZATT",ZOID) ; THESE ARE THE ATTRIBUTES MOVED TO ZATT
|
||||
. D MULTI^C0CMXMLB("",$$TAG(ZOID),.ZATT,"NDOUT^C0CMXML(ZI)") ;HAVE CHILDREN
|
||||
E D ; NO CHILD - IF NO CHILDREN, A NODE HAS DATA, IS AN ENDPOINT
|
||||
. ;W "DOING",ZOID,!
|
||||
. N ZD D DATA("ZD",ZOID) ;NODES WITHOUT CHILDREN HAVE DATA
|
||||
. N ZATT D ATT("ZATT",ZOID) ;ATTRIBUTES
|
||||
. D ITEM^C0CMXMLB("",$$TAG(ZOID),.ZATT,$G(ZD(1))) ;NO CHILDREN
|
||||
I $$NXTSIB(ZOID)'=0 D ; THERE IS A SIBLING
|
||||
. D NDOUT($$NXTSIB(ZOID)) ;RECURSE FOR SIBLINGS
|
||||
Q
|
||||
;
|
||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
|
|
16
p/C0CMXMLB.m
16
p/C0CMXMLB.m
|
@ -5,11 +5,12 @@ MXMLBLD ;;ISF/RWF - Tool to build XML ;07/09/09 16:55
|
|||
;DOC - The top level tag
|
||||
;DOCTYPE - Want to include a DOCTYPE node
|
||||
;FLAG - Set to 'G' to store the output in the global ^TMP("MXMLBLD",$J,
|
||||
START(DOC,DOCTYPE,FLAG) ;Call this once at the begining.
|
||||
START(DOC,DOCTYPE,FLAG,NO1ST) ;Call this once at the begining.
|
||||
K ^TMP("MXMLBLD",$J)
|
||||
S ^TMP("MXMLBLD",$J,"DOC")=DOC,^TMP("MXMLBLD",$J,"STK")=0
|
||||
I $G(FLAG)["G" S ^TMP("MXMLBLD",$J,"CNT")=1
|
||||
D OUTPUT($$XMLHDR) D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
|
||||
I $G(NO1ST)'=1 D OUTPUT($$XMLHDR)
|
||||
D:$L($G(DOCTYPE)) OUTPUT("<!DOCTYPE "_DOCTYPE_">") D OUTPUT("<"_DOC_">")
|
||||
Q
|
||||
;
|
||||
END ;Call this once to close out the document
|
||||
|
@ -40,12 +41,15 @@ ATT(ATT) ;Output a string of attributes
|
|||
F S I=$O(ATT(I)) Q:I="" S S=S_" "_I_"="_$$Q(ATT(I))
|
||||
Q S
|
||||
;
|
||||
Q(X) ;Add Quotes
|
||||
I X'[$C(34) Q $C(34)_X_$C(34)
|
||||
N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
|
||||
Q(X) ;Add Quotes - Changed by gpl to use single instead of double quotes 6/11
|
||||
;I X'[$C(34) Q $C(34)_X_$C(34)
|
||||
I X'[$C(39) Q $C(39)_X_$C(39)
|
||||
;N Q,Y,I,Z S Q=$C(34),(Y,Z)=""
|
||||
N Q,Y,I,Z S Q=$C(39),(Y,Z)=""
|
||||
F I=1:1:$L(X,Q)-1 S Y=Y_$P(X,Q,I)_Q_Q
|
||||
S Y=Y_$P(X,Q,$L(X,Q))
|
||||
Q $C(34)_Y_$C(34)
|
||||
;Q $C(34)_Y_$C(34)
|
||||
Q $C(39)_Y_$C(39)
|
||||
;
|
||||
XMLHDR() ; -- provides current XML standard header
|
||||
Q "<?xml version=""1.0"" encoding=""utf-8"" ?>"
|
||||
|
|
580
p/C0CMXP.m
580
p/C0CMXP.m
|
@ -1,292 +1,292 @@
|
|||
C0CMXP ; GPL - MXML based XPath utilities;12/04/09 17:05
|
||||
;;0.1;C0C;nopatch;noreleasedate
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
Q
|
||||
;
|
||||
INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
|
||||
; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD
|
||||
D INITFARY^C0CSOAP(ARY) ;
|
||||
Q
|
||||
S @ARY@("XML FILE NUMBER")=178.101
|
||||
S @ARY@("XML SOURCE FIELD")=2.1
|
||||
S @ARY@("XML TEMPLATE FIELD")=3
|
||||
S @ARY@("XPATH BINDING SUBFILE")=178.1014
|
||||
S @ARY@("REDUX FIELD")=2.5
|
||||
Q
|
||||
;
|
||||
SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY
|
||||
;
|
||||
S C0CXPF=@ARY@("XML FILE NUMBER")
|
||||
S C0CXFLD=@ARY@("XML")
|
||||
S C0CXTFLD=@ARY@("TEMPLATE XML")
|
||||
S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")
|
||||
S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")
|
||||
Q
|
||||
;
|
||||
ADDXP(INARY,TID,FARY) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
|
||||
I '$D(FARY) D ;
|
||||
. S FARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
D SETXPF(FARY) ;SET FILE VARIABLES
|
||||
N C0CA,C0CB
|
||||
S C0CA="" S C0CB=0
|
||||
F S C0CA=$O(@INARY@(C0CA)) Q:C0CA="" D ; FOR EACH XPATH
|
||||
. S C0CB=C0CB+1 ; COUNT OF XPATHS
|
||||
. S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA
|
||||
. D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH
|
||||
Q
|
||||
;
|
||||
FIXICD9 ; FIX THE ICD9RESULT XML
|
||||
D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE
|
||||
S ZI=""
|
||||
S G=""
|
||||
F S ZI=$O(GPL(ZI)) Q:ZI="" D ; FOR EACH LINE
|
||||
. S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML
|
||||
D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY
|
||||
D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK
|
||||
Q
|
||||
ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID
|
||||
; INXML IS PASSED BY NAME
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
|
||||
D SETXPF(INFARY) ;SET FILE VARIABLES
|
||||
D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML)
|
||||
Q
|
||||
;
|
||||
ADDTEMP(INXML,TEMPID,INFARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID
|
||||
;
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
|
||||
D SETXPF(INFARY) ;SET FILE VARIABLES
|
||||
D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML)
|
||||
Q
|
||||
;
|
||||
GETXML(OUTXML,TEMPID,INFARY) ;GET THE XML FROM TEMPLATE TEMPID
|
||||
;
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
D SETXPF(INFARY) ;SET FILE VARIABLES
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
|
||||
I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D Q ;
|
||||
. W "ERROR RETRIEVING TEMPLATE",!
|
||||
Q
|
||||
;
|
||||
GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
|
||||
;
|
||||
I '$D(FARY) D ;
|
||||
. S FARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
D SETXPF(FARY) ;SET FILE VARIABLES
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME
|
||||
I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D Q ;
|
||||
. W "ERROR RETRIEVING TEMPLATE",!
|
||||
Q
|
||||
;
|
||||
COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF) ; COPIES A WORD PROCESSING FIELD
|
||||
; FROM ONE RECORD TO ANOTHER RECORD
|
||||
; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF
|
||||
; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT
|
||||
; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED
|
||||
; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME
|
||||
; A ZSRCF
|
||||
I '$D(ZSRCF) D ;
|
||||
. S ZSRCF="ZSRCF"
|
||||
. D INITFARY^C0CSOAP(ZSRCF)
|
||||
I '$D(ZDESTF) D ;
|
||||
. S ZDESTF="ZDESTF"
|
||||
. M @ZDESTF=@ZSRCF
|
||||
N ZSF,ZDF,ZSFREF,ZDFREF
|
||||
S ZSF=@ZSRCF@("XML FILE NUMBER")
|
||||
S ZSFREF=$$FILEREF^C0CRNF(ZSF)
|
||||
S ZDF=@ZDESTF@("XML FILE NUMBER")
|
||||
S ZDFREF=$$FILEREF^C0CRNF(ZDF)
|
||||
N ZSIEN,ZDIEN
|
||||
S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))
|
||||
I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q ;
|
||||
S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))
|
||||
I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q ;
|
||||
N ZFLDNUM
|
||||
I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME
|
||||
E S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER
|
||||
N ZWP,ZWPN
|
||||
S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE
|
||||
I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q ;
|
||||
D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST
|
||||
Q
|
||||
;
|
||||
COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS
|
||||
; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE
|
||||
; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE
|
||||
; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT
|
||||
; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE
|
||||
; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01
|
||||
I '$D(UFARY) D ;
|
||||
. S UFARY="DEFFARY" ; FILE ARRAY
|
||||
. ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
. D INITFARY^C0CSOAP(UFARY)
|
||||
D SETXPF(UFARY) ;SET FILE VARIABLES
|
||||
I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)
|
||||
E S INTID=TID
|
||||
;B
|
||||
;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX
|
||||
D GETXML("C0CXML",INTID,UFARY)
|
||||
S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING
|
||||
D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX
|
||||
D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE
|
||||
D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH
|
||||
Q
|
||||
;
|
||||
MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
|
||||
; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED
|
||||
; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE
|
||||
;
|
||||
S C0CXLOC=$NA(^TMP("C0CXML",$J))
|
||||
K @C0CXLOC
|
||||
M @C0CXLOC=@INXML
|
||||
S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
|
||||
K @C0CXLOC
|
||||
S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
||||
;N GIDX,GIDX2,GARY,GARY2
|
||||
I '$D(REDUX) S REDUX=""
|
||||
D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
|
||||
D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE
|
||||
N ZI,ZD S ZI=""
|
||||
F S ZI=$O(@C0CDOM@(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE DOM
|
||||
. K ZD ;FOR DATA
|
||||
. D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE
|
||||
. ;I $D(ZD(1)) D ; IF YES
|
||||
. I $$FIRST^C0CMXML(ZI)=0 D ; IF THERE ARE NO CHILDREN TO THIS NODE
|
||||
. . ;I ZI<3 B ;W !,ZD(1)
|
||||
. . K @C0CDOM@(ZI,"T") ; KILL THE DATA
|
||||
. . N ZXPATH
|
||||
. . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE
|
||||
. . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"
|
||||
. . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX
|
||||
D OUTXML^C0CMXML(OUTT,C0CDOCID)
|
||||
Q
|
||||
;
|
||||
INVERT(OUTX,INX) ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from
|
||||
; @INX@(XPath)=x
|
||||
N ZI S ZI=""
|
||||
F S ZI=$O(@INX@(ZI)) Q:ZI="" D ;FOR EACH XPATH IN THE INPUT
|
||||
. S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY
|
||||
Q
|
||||
;
|
||||
DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES
|
||||
; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH
|
||||
N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB
|
||||
S (ZMULT,ZSUB)=""
|
||||
S ZX=$P(INX,"[",2)
|
||||
I ZX'="" D ; THERE IS A [x] MULTIPLE
|
||||
. S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH
|
||||
. S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE
|
||||
. S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH
|
||||
. I $P(ZX,"[",2)'="" D ; A SUB MULTIPLE EXISTS
|
||||
. . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH
|
||||
. . S ZX=$P(ZX,"[",2) ; DELETE THE [
|
||||
. . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE
|
||||
. . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH
|
||||
E S ZX=INX ;NO MULTIPLE HERE
|
||||
S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH
|
||||
Q
|
||||
;
|
||||
DEMUXARY(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
|
||||
; FORMAT @OARY@(x,variablename) where x is the first multiple
|
||||
; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
|
||||
N ZI,ZJ,ZK,ZL,ZM S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3)
|
||||
. S ZM=$RE($P($RE(ZK),"/",1))
|
||||
. I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
|
||||
. . S ZM=$RE($P($RE(ZK),"/",2))_ZM
|
||||
. S ZL=$P(ZJ,"^",1)
|
||||
. I ZL="" S ZL=1
|
||||
. I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP
|
||||
. . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
|
||||
. E S @OARY@(ZL,ZM)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
|
||||
; FORMAT @OARY@(x,variablename) where x is the first multiple
|
||||
; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
|
||||
N ZI,ZJ,ZK,ZL,ZM S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3)
|
||||
. S ZM=$RE($P($RE(ZK),"/",1))
|
||||
. I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
|
||||
. . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM
|
||||
. S ZL=$P(ZJ,"^",1)
|
||||
. I ZL="" S ZL=1
|
||||
. I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP
|
||||
. . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
|
||||
. E S @OARY@(ZL,ZM)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
DEMUXXP1(OARY,IARY) ;IARY IS INCOMING XPATH ARRAY
|
||||
; BOTH IARY AND OARY ARE PASSED BY NAME
|
||||
; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED
|
||||
N ZI,ZJ,ZK
|
||||
S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH XPATH IN IARY
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3) ;THE XPATH
|
||||
. S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW
|
||||
. ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST
|
||||
. ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE
|
||||
. ; COMMON XPATH
|
||||
Q
|
||||
;
|
||||
DEMUXXP2(OARY,IARY) ; IARY AND OARY ARE PASSED BY NAME
|
||||
; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES
|
||||
; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM
|
||||
; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE
|
||||
; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]
|
||||
;
|
||||
N ZI,ZJ,ZK,ZX,ZY,ZP
|
||||
S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH INPUT XPATH
|
||||
. D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES
|
||||
. S ZX=$P(ZJ,"^",1) ;x
|
||||
. S ZY=$P(ZJ,"^",2) ;y
|
||||
. S ZP=$P(ZJ,"^",3) ;Xpath
|
||||
. I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1
|
||||
. I ZY'="" D ;IS THERE A y?
|
||||
. . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)
|
||||
. E D ;NO y
|
||||
. . S @OARY@(ZX,ZP)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
;;0.1;C0C;nopatch;noreleasedate;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
Q
|
||||
;
|
||||
INITXPF(ARY) ;INITIAL XML/XPATH FILE ARRAY
|
||||
; DON'T USE THIS ONE ... USE INITFARY^C0CSOAP("FARY") INSTEAD
|
||||
D INITFARY^C0CSOAP(ARY) ;
|
||||
Q
|
||||
S @ARY@("XML FILE NUMBER")=178.101
|
||||
S @ARY@("XML SOURCE FIELD")=2.1
|
||||
S @ARY@("XML TEMPLATE FIELD")=3
|
||||
S @ARY@("XPATH BINDING SUBFILE")=178.1014
|
||||
S @ARY@("REDUX FIELD")=2.5
|
||||
Q
|
||||
;
|
||||
SETXPF(ARY) ; SET FILE AND FIELD VARIABLES FROM XPF ARRAY
|
||||
;
|
||||
S C0CXPF=@ARY@("XML FILE NUMBER")
|
||||
S C0CXFLD=@ARY@("XML")
|
||||
S C0CXTFLD=@ARY@("TEMPLATE XML")
|
||||
S C0CXPBF=@ARY@("BINDING SUBFILE NUMBER")
|
||||
S C0CRDUXF=@ARY@("XPATH REDUCTION STRING")
|
||||
Q
|
||||
;
|
||||
ADDXP(INARY,TID,FARY) ;ADD XPATH .01 FIELD TO BINDING SUBFILE OF TEMPLATE TID
|
||||
I '$D(FARY) D ;
|
||||
. S FARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
D SETXPF(FARY) ;SET FILE VARIABLES
|
||||
N C0CA,C0CB
|
||||
S C0CA="" S C0CB=0
|
||||
F S C0CA=$O(@INARY@(C0CA)) Q:C0CA="" D ; FOR EACH XPATH
|
||||
. S C0CB=C0CB+1 ; COUNT OF XPATHS
|
||||
. S C0CFDA(C0CXPBF,"?+"_C0CB_","_TID_",",.01)=C0CA
|
||||
. D UPDIE ; CREATE THE BINDING SUBFILE FOR THIS XPATH
|
||||
Q
|
||||
;
|
||||
FIXICD9 ; FIX THE ICD9RESULT XML
|
||||
D GETXML("GPL","ICD9RESULT") ; GET SOME BAD XML OUT OF THE FILE
|
||||
S ZI=""
|
||||
S G=""
|
||||
F S ZI=$O(GPL(ZI)) Q:ZI="" D ; FOR EACH LINE
|
||||
. S G=G_GPL(ZI) ; MAKE ONE BIG STRING OF XML
|
||||
D NORMAL^C0CSOAP("G2","G") ;NO NORMALIZE IT BACK INTO AN ARRAY
|
||||
D ADDXML("G2","ICD9RESULT") ; AND PUT IT BACK
|
||||
Q
|
||||
ADDXML(INXML,TEMPID,INFARY) ;ADD XML TO A TEMPLATE ID TEMPID
|
||||
; INXML IS PASSED BY NAME
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
|
||||
D SETXPF(INFARY) ;SET FILE VARIABLES
|
||||
D WP^DIE(C0CXPF,TEMPID_",",C0CXFLD,,INXML)
|
||||
Q
|
||||
;
|
||||
ADDTEMP(INXML,TEMPID,INFARY) ;ADD XML TEMPLATE TO TEMPLATE RECORD TEMPID
|
||||
;
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
|
||||
D SETXPF(INFARY) ;SET FILE VARIABLES
|
||||
D WP^DIE(C0CXPF,TEMPID_",",C0CXTFLD,,INXML)
|
||||
Q
|
||||
;
|
||||
GETXML(OUTXML,TEMPID,INFARY) ;GET THE XML FROM TEMPLATE TEMPID
|
||||
;
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
D SETXPF(INFARY) ;SET FILE VARIABLES
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,INFARY) ;RESOLVE TEMPLATE NAME
|
||||
I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXFLD,,OUTXML)'=OUTXML D Q ;
|
||||
. W "ERROR RETRIEVING TEMPLATE",!
|
||||
Q
|
||||
;
|
||||
GETTEMP(OUTXML,TEMPID,FARY) ;GET THE TEMPLATE XML FROM TEMPLATE TEMPID
|
||||
;
|
||||
I '$D(FARY) D ;
|
||||
. S FARY="FARY" ; FILE ARRAY
|
||||
. D INITXPF("FARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
D SETXPF(FARY) ;SET FILE VARIABLES
|
||||
I +TEMPID=0 S TEMPID=$$RESTID^C0CSOAP(TEMPID,FARY) ;RESOLVE TEMPLATE NAME
|
||||
I $$GET1^DIQ(C0CXPF,TEMPID_",",C0CXTFLD,,OUTXML)'=OUTXML D Q ;
|
||||
. W "ERROR RETRIEVING TEMPLATE",!
|
||||
Q
|
||||
;
|
||||
COPYWP(ZFLD,ZSRCREC,ZDESTREC,ZSRCF,ZDESTF) ; COPIES A WORD PROCESSING FIELD
|
||||
; FROM ONE RECORD TO ANOTHER RECORD
|
||||
; ZFLD IS EITHER A NUMBERIC FIELD OR A NAME IN ZSRCF
|
||||
; ZSRCF IS THE SOURCE FILE, IN FILE REDIRECT FORMAT
|
||||
; IF ZSRCF IS OMMITED, THE DEFAULT C0C XML MISC FILE WILL BE ASSUMED
|
||||
; ZDESTF IS DESTINATION FILE. IF OMMITED, IS ASSUMED TO BE THE SAME
|
||||
; A ZSRCF
|
||||
I '$D(ZSRCF) D ;
|
||||
. S ZSRCF="ZSRCF"
|
||||
. D INITFARY^C0CSOAP(ZSRCF)
|
||||
I '$D(ZDESTF) D ;
|
||||
. S ZDESTF="ZDESTF"
|
||||
. M @ZDESTF=@ZSRCF
|
||||
N ZSF,ZDF,ZSFREF,ZDFREF
|
||||
S ZSF=@ZSRCF@("XML FILE NUMBER")
|
||||
S ZSFREF=$$FILEREF^C0CRNF(ZSF)
|
||||
S ZDF=@ZDESTF@("XML FILE NUMBER")
|
||||
S ZDFREF=$$FILEREF^C0CRNF(ZDF)
|
||||
N ZSIEN,ZDIEN
|
||||
S ZSIEN=$O(@ZSFREF@("B",ZSRCREC,""))
|
||||
I ZSIEN="" W !,"ERROR SOURCE RECORD NOT FOUND" Q ;
|
||||
S ZDIEN=$O(@ZDFREF@("B",ZDESTREC,""))
|
||||
I ZDIEN="" W !,"ERROR DESTINATION RECORD NOT FOUND" Q ;
|
||||
N ZFLDNUM
|
||||
I +ZFLD=0 S ZFLDNUM=@ZSRCF@(ZFLD) ; IF FIELD IS PASSED BY NAME
|
||||
E S ZFLDNUM=ZFLD ; IF FIELD IS PASSED BY NUMBER
|
||||
N ZWP,ZWPN
|
||||
S ZWPN=$$GET1^DIQ(ZSF,ZSIEN_",",ZFLDNUM,,"ZWP") ; GET WP FROM SOURCE
|
||||
I ZWPN'="ZWP" W !,"ERROR SOURCE FIELD EMPTY" Q ;
|
||||
D WP^DIE(ZDF,ZDIEN_",",ZFLDNUM,,"ZWP") ; PUT WP FIELD TO DEST
|
||||
Q
|
||||
;
|
||||
COMPILE(TID,UFARY) ; COMPILES AN XML TEMPLATE AND GENERATES XPATH BINDINGS
|
||||
; UFARY IF SPECIFIED WILL REDIRECT THE XML FILE TO USE
|
||||
; INTID IS THE IEN OF THE RECORD TO USE IN THE XML FILE
|
||||
; XML IS PULLED FROM THE "XML" FIELD AND THE COMPILED RESULT PUT
|
||||
; IN THE "XML TEMPLATE" FIELD. ALL XPATHS USED IN THE TEMPLATE
|
||||
; WILL BE POPULATED TO THE XPATH BINDINGS SUBFILE AS .01
|
||||
I '$D(UFARY) D ;
|
||||
. S UFARY="DEFFARY" ; FILE ARRAY
|
||||
. ;D INITXPF("UFARY") ;IF FILE ARRAY NOT PASSED, INITIALIZE
|
||||
. D INITFARY^C0CSOAP(UFARY)
|
||||
D SETXPF(UFARY) ;SET FILE VARIABLES
|
||||
I +TID=0 S INTID=$$RESTID^C0CSOAP(TID,UFARY)
|
||||
E S INTID=TID
|
||||
;B
|
||||
;N C0CXML,C0CREDUX,C0CTEMP,C0CIDX
|
||||
D GETXML("C0CXML",INTID,UFARY)
|
||||
S C0CREDUX=$$GET1^DIQ(C0CXPF,INTID_",",C0CRDUXF,"E") ;XPATH REDUCTION STRING
|
||||
D MKTPLATE("C0CTEMP","C0CIDX","C0CXML",C0CREDUX) ; CREATE TEMPLATE AND IDX
|
||||
D ADDTEMP("C0CTEMP",INTID,UFARY) ; WRITE THE TEMPLATE TO FILE
|
||||
D ADDXP("C0CIDX",INTID,UFARY) ;CREATE XPATH SUBFILE ENTRIES FOR EVERY XPATH
|
||||
Q
|
||||
;
|
||||
MKTPLATE(OUTT,OUTIDX,INXML,REDUX) ;MAKE A TEMPLATE FROM INXML, RETURNED IN OUTT
|
||||
; BOTH PASSED BY NAME. THE REDUX XPATH REDUCTION STRING IS USED IF PASSED
|
||||
; OUTIDX IS AN ARRAY OF THE XPATHS USED IN MAKING THE TEMPLATE
|
||||
;
|
||||
S C0CXLOC=$NA(^TMP("C0CXML",$J))
|
||||
K @C0CXLOC
|
||||
M @C0CXLOC=@INXML
|
||||
S C0CDOCID=$$PARSE^C0CMXML(C0CXLOC,"C0CMKT")
|
||||
K @C0CXLOC
|
||||
S C0CDOM=$NA(^TMP("MXMLDOM",$J,C0CDOCID))
|
||||
;N GIDX,GIDX2,GARY,GARY2
|
||||
I '$D(REDUX) S REDUX=""
|
||||
D XPATH^C0CMXML(1,"/","GIDX","GARY",,REDUX)
|
||||
D INVERT("GIDX2","GIDX") ;MAKE ARRAY TO LOOK UP XPATH BY NODE
|
||||
N ZI,ZD S ZI=""
|
||||
F S ZI=$O(@C0CDOM@(ZI)) Q:ZI="" D ; FOR EACH NODE IN THE DOM
|
||||
. K ZD ;FOR DATA
|
||||
. D DATA^C0CMXML("ZD",ZI) ;SEE IF THERE IS DATA FOR THIS NODE
|
||||
. ;I $D(ZD(1)) D ; IF YES
|
||||
. I $$FIRST^C0CMXML(ZI)=0 D ; IF THERE ARE NO CHILDREN TO THIS NODE
|
||||
. . ;I ZI<3 B ;W !,ZD(1)
|
||||
. . K @C0CDOM@(ZI,"T") ; KILL THE DATA
|
||||
. . N ZXPATH
|
||||
. . S ZXPATH=$G(GIDX2(ZI)) ;FIND AN XPATH FOR THIS NODE
|
||||
. . S @C0CDOM@(ZI,"T",1)="@@"_ZXPATH_"@@"
|
||||
. . I ZXPATH'="" S @OUTIDX@(ZXPATH)="" ; PASS BACK XPATH USED IN IDX
|
||||
D OUTXML^C0CMXML(OUTT,C0CDOCID)
|
||||
Q
|
||||
;
|
||||
INVERT(OUTX,INX) ;INVERTS AN XPATH INDEX RETURNING @OUTX@(x)=XPath from
|
||||
; @INX@(XPath)=x
|
||||
N ZI S ZI=""
|
||||
F S ZI=$O(@INX@(ZI)) Q:ZI="" D ;FOR EACH XPATH IN THE INPUT
|
||||
. S @OUTX@(@INX@(ZI))=ZI ; SET INVERTED ENTRY
|
||||
Q
|
||||
;
|
||||
DEMUX(OUTX,INX) ;PARSES XPATH PASSED BY VALUE IN INX TO REMOVE [x] MULTIPLES
|
||||
; RETURNS OUTX: MULTIPLE^SUBMULTIPLE^XPATH
|
||||
N ZX,ZY,ZZ,ZZ1,ZMULT,ZSUB
|
||||
S (ZMULT,ZSUB)=""
|
||||
S ZX=$P(INX,"[",2)
|
||||
I ZX'="" D ; THERE IS A [x] MULTIPLE
|
||||
. S ZY=$P(INX,"[",1) ;FIRST PART OF XPATH
|
||||
. S ZMULT=$P(ZX,"]",1) ; NUMBER OF THE MULTIPLE
|
||||
. S ZX=ZY_$P(ZX,"]",2) ; REST OF THE XPATH
|
||||
. I $P(ZX,"[",2)'="" D ; A SUB MULTIPLE EXISTS
|
||||
. . S ZZ=$P(ZX,"[",1) ; FIRST PART OF XPATH
|
||||
. . S ZX=$P(ZX,"[",2) ; DELETE THE [
|
||||
. . S ZSUB=$P(ZX,"]",1) ; NUMBER OF THE SUBMULTIPLE
|
||||
. . S ZX=ZZ_$P(ZX,"]",2) ; REST OF THE XPATH
|
||||
E S ZX=INX ;NO MULTIPLE HERE
|
||||
S @OUTX=ZMULT_"^"_ZSUB_"^"_ZX ;RETURN MULTIPLE^SUBMULTIPLE^XPATH
|
||||
Q
|
||||
;
|
||||
DEMUXARY(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
|
||||
; FORMAT @OARY@(x,variablename) where x is the first multiple
|
||||
; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
|
||||
N ZI,ZJ,ZK,ZL,ZM S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3)
|
||||
. S ZM=$RE($P($RE(ZK),"/",1))
|
||||
. I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
|
||||
. . S ZM=$RE($P($RE(ZK),"/",2))_ZM
|
||||
. S ZL=$P(ZJ,"^",1)
|
||||
. I ZL="" S ZL=1
|
||||
. I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP
|
||||
. . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
|
||||
. E S @OARY@(ZL,ZM)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
DEMUX2(OARY,IARY,DEPTH) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
|
||||
; FORMAT @OARY@(x,variablename) where x is the first multiple
|
||||
; IF DEPTH=2, THE LAST 2 PARTS OF THE XPATH WILL BE USED
|
||||
N ZI,ZJ,ZK,ZL,ZM S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3)
|
||||
. S ZM=$RE($P($RE(ZK),"/",1))
|
||||
. I $G(DEPTH)=2 D ;LAST TWO PARTS OF XPATH USED FOR THE VARIABLE NAME
|
||||
. . S ZM=$RE($P($RE(ZK),"/",2))_"."_ZM
|
||||
. S ZL=$P(ZJ,"^",1)
|
||||
. I ZL="" S ZL=1
|
||||
. I $D(@OARY@(ZL,ZM)) D ;IT'S A DUP
|
||||
. . S @OARY@(ZL,ZM_"[2]")=@IARY@(ZI)
|
||||
. E S @OARY@(ZL,ZM)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
DEMUXXP1(OARY,IARY) ;IARY IS INCOMING XPATH ARRAY
|
||||
; BOTH IARY AND OARY ARE PASSED BY NAME
|
||||
; RETURNS A SIMPLE XPATH ARRAY WITHOUT MULTIPLES. DUPLICATES ARE REMOVED
|
||||
N ZI,ZJ,ZK
|
||||
S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH XPATH IN IARY
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3) ;THE XPATH
|
||||
. S @OARY@(ZK)=@IARY@(ZI) ;THE RESULT. DUPLICATES WILL NOT SHOW
|
||||
. ; CAUTION, IF THERE ARE MULTIPLES, ONLY THE DATA FOR THE LAST
|
||||
. ; MULTIPLE WILL BE INCLUDED IN THE OUTPUT ARRAY, ASSIGNED TO THE
|
||||
. ; COMMON XPATH
|
||||
Q
|
||||
;
|
||||
DEMUXXP2(OARY,IARY) ; IARY AND OARY ARE PASSED BY NAME
|
||||
; IARY IS AN XPATH ARRAY THAT MAY CONTAIN MULTIPLES
|
||||
; OARY IS THE OUTPUT ARRAY WHERE MULTIPLES ARE RETURNED IN THE FORM
|
||||
; @OARY@(x,Xpath)=data or @OARY@(x,y,Xpath)=data WHERE x AND y ARE
|
||||
; THE MULTIPLES AND Xpath IS THE BASE XPATH WITHOUT [x] AND [y]
|
||||
;
|
||||
N ZI,ZJ,ZK,ZX,ZY,ZP
|
||||
S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH INPUT XPATH
|
||||
. D DEMUX("ZJ",ZI) ; PULL OUT THE MULTIPLES
|
||||
. S ZX=$P(ZJ,"^",1) ;x
|
||||
. S ZY=$P(ZJ,"^",2) ;y
|
||||
. S ZP=$P(ZJ,"^",3) ;Xpath
|
||||
. I ZX="" S ZX=1 ; NO MULTIPLE WILL STORE IN x=1
|
||||
. I ZY'="" D ;IS THERE A y?
|
||||
. . S @OARY@(ZX,ZY,ZP)=@IARY@(ZI)
|
||||
. E D ;NO y
|
||||
. . S @OARY@(ZX,ZP)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
|
|
72
p/C0CNHIN.m
72
p/C0CNHIN.m
|
@ -18,17 +18,53 @@ C0CNHIN ; GPL - PROCESSING FOR OUTPUT OF NHINV ROUTINES;6/3/11 17:05
|
|||
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
||||
;
|
||||
Q
|
||||
EN(ZRTN,ZDFN) ; GENERATE AN NHIN ARRAY FOR A PATIENT
|
||||
EN(ZRTN,ZDFN,ZPART,KEEP) ; GENERATE AN NHIN ARRAY FOR A PATIENT
|
||||
;
|
||||
K GARY,GNARY,GIDX,C0CDOCID
|
||||
N GN
|
||||
K ^TMP("NHINV",$J) ; CLEAN UP FROM LAST CALL
|
||||
K ^TMP("MXMLDOM",$J) ; CLEAN UP DOM
|
||||
K ^TMP("MXMLERR",$J) ; CLEAN UP MXML ERRORS
|
||||
D GET^NHINV(.GN,ZDFN) ; CALL NHINV ROUTINES TO PULL XML
|
||||
D GET^NHINV(.GN,ZDFN,ZPART) ; CALL NHINV ROUTINES TO PULL XML
|
||||
S GN=$P(GN,")",1)_")" ; CUT OFF THE REST OF LINE PROTOCOL
|
||||
S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
|
||||
D DOMO^C0CDOM(C0CDOCID,"/","ZRTN","GIDX","GARY",,"/results/") ; BLD ARRAYS
|
||||
I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
|
||||
;D PROCESS("ZRTN",GN,"/result/",$G(KEEP))
|
||||
Q
|
||||
;
|
||||
PQRI(ZOUT,KEEP) ; RETURN THE NHIN ARRAY FOR THE PQRI XML TEMPLATE
|
||||
;
|
||||
N ZG
|
||||
S ZG=$NA(^TMP("PQRIXML",$J))
|
||||
K @ZG
|
||||
D GETXML^C0CMXP(ZG,"PQRIXML") ; GET THE XML FROM C0C MISC XML
|
||||
N C0CDOCID
|
||||
S C0CDOCID=$$PARSE^C0CDOM(ZG,"PQRIXML") ; PARSE THE XML
|
||||
D DOMO^C0CDOM(C0CDOCID,"/","ZOUT","GIDX","GARY",,"//submission") ; BLD ARRAYS
|
||||
I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
|
||||
Q
|
||||
;
|
||||
PQRI2(ZRTN) ; RETURN THE NHIN ARRAY FOR PQRI ONE MEASURE
|
||||
;
|
||||
;N GG
|
||||
D GETXML^C0CMXP("GG","PQRI ONE MEASURE")
|
||||
D PROCESS(ZRTN,"GG","root",1)
|
||||
Q
|
||||
;
|
||||
PROCESS(ZRSLT,ZXML,ZREDUCE,KEEP) ; PARSE AND RUN DOMO ON XML
|
||||
; ZRTN IS PASSED BY REFERENCE
|
||||
; ZXML IS PASSED BY NAME
|
||||
; IF KEEP IS 1, GARY AND GIDX ARE NOT KILLED
|
||||
;
|
||||
N GN
|
||||
S GN=$NA(^TMP("C0CPROCESS",$J))
|
||||
K @GN
|
||||
M @GN=@ZXML
|
||||
S C0CDOCID=$$PARSE(GN,"NHINARRAY") ; PARSE WITH MXML
|
||||
K @GN
|
||||
D DOMO^C0CDOM(C0CDOCID,"/","ZRSLT","GIDX","GARY",,$G(ZREDUCE)) ; BLD ARRAYS
|
||||
I '$G(KEEP) K GIDX,GARY ; GET RID OF THE ARRAYS UNLESS KEEP=1
|
||||
Q
|
||||
;
|
||||
LOADSMRT ;
|
||||
|
@ -58,6 +94,16 @@ CCR ; TRY IT WITH A CCR
|
|||
;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
|
||||
Q
|
||||
;
|
||||
MED ; TRY IT WITH A CCR MED SECTION
|
||||
;
|
||||
S GN=$NA(^GPL("MED"))
|
||||
K ^TMP("MXMLDOM",$J)
|
||||
K ^TMP("MXMLERR",$J)
|
||||
S C0CDOCID=$$PARSE(GN,"MED")
|
||||
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"//Medications/")
|
||||
;K ^TMP("MXMLDOM",$J) ;CLEAN UP... IT'S BIG
|
||||
Q
|
||||
;
|
||||
CCD ; TRY IT WITH A CCD
|
||||
;
|
||||
S GN=$NA(^GPL("CCD"))
|
||||
|
@ -73,6 +119,28 @@ TEST1 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
|
|||
; RUN THROUGH XPATH
|
||||
K GARY,GIDX,C0CDOCID
|
||||
S GN=$NA(^GPL("NHIN"))
|
||||
;S GN=$NA(^GPL("DOMI"))
|
||||
S C0CDOCID=$$PARSE(GN,"GPLTEST")
|
||||
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
|
||||
K ^GPL("GNARY")
|
||||
M ^GPL("GNARY")=GNARY
|
||||
Q
|
||||
;
|
||||
TEST2 ; PUT GNARY THROUGH DOMI AND STORE XML IN ^GPL("DOMI")
|
||||
;
|
||||
S GN=$NA(^GPL("GNARY"))
|
||||
S C0CDOCID=$$DOMI^C0CDOM(GN,,"results")
|
||||
D OUTXML^C0CDOM("G",C0CDOCID)
|
||||
K ^GPL("DOMI")
|
||||
M ^GPL("DOMI")=G
|
||||
Q
|
||||
;
|
||||
TEST3 ; TEST NHINV OUTPUT IN ^GPL("NIHIN")
|
||||
; PARSED WITH MXML
|
||||
; RUN THROUGH XPATH
|
||||
K GARY,GIDX,C0CDOCID
|
||||
;S GN=$NA(^GPL("NHIN"))
|
||||
S GN=$NA(^GPL("DOMI"))
|
||||
S C0CDOCID=$$PARSE(GN,"GPLTEST")
|
||||
D DOMO^C0CDOM(C0CDOCID,"/","GNARY","GIDX","GARY",,"/results/")
|
||||
Q
|
||||
|
|
|
@ -0,0 +1,218 @@
|
|||
C0CMED4 ; WV/CCDCCR/SMH/gpl - CCR/CCD PROCESSING FOR MEDICATIONS - Inpatient Meds/Unit Dose ;10/13/08
|
||||
;;0.1;CCDCCR;;;
|
||||
; Copyright 2008 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT) ; EXTRACT MEDICATIONS INTO PROVIDED XML TEMPLATE
|
||||
;
|
||||
; this routine has be adapted to retrieve meds from GET^NHINV by gpl 6/2011
|
||||
;
|
||||
; MINXML is the Input XML Template, passed by name
|
||||
; DFN is Patient IEN
|
||||
; OUTXML is the resultant XML.
|
||||
;
|
||||
; MEDS is return array from API.
|
||||
; MED is holds each array element from MEDS, one medicine
|
||||
; MAP is a mapping variable map (store result) for each med
|
||||
;
|
||||
; Inpatient Meds will be extracted using this routine and and the one following.
|
||||
; Inpatient Meds Unit Dose is going to be C0CMED4
|
||||
; Inpatient Meds IVs is going to be C0CMED5
|
||||
;
|
||||
; We will use two Pharmacy ReEnginnering API's:
|
||||
; PSS431^PSS55(DFN,PO,PSDATE,PEDATE,LIST) - provides most info
|
||||
; PSS432^PSS55(DFN,PO,LIST) - provides schedule info
|
||||
; For more information, see the PRE documentation at:
|
||||
; http://www.va.gov/vdl/documents/Clinical/Pharm-Inpatient_Med/phar_1_api_r0807.pdf
|
||||
;
|
||||
; Med data is stored in Unit Dose multiple of file 55, pharmacy patient
|
||||
;
|
||||
N MEDS,MAP
|
||||
;K ^TMP($J)
|
||||
;D PSS431^PSS55(DFN,,,,"UD") ; Output is in ^TMP($J,"UD",*)
|
||||
;I ^TMP($J,"UD",0)'>0 S @OUTXML@(0)=0 QUIT ; No Meds - Quit
|
||||
;; Otherwise, we go on...
|
||||
D EN^C0CNHIN(.MEDS,DFN,"MED;") ; gpl get the NHIN Array of meds
|
||||
I '$D(MEDS) Q ; no meds
|
||||
N ZI S ZI=""
|
||||
N ZCOUNT S ZCOUNT=0
|
||||
F S ZI=$O(MEDS("med",ZI)) Q:ZI="" D ; for each returned med
|
||||
. I $G(MEDS("med",ZI,"vaType@value"))="I" S ZCOUNT=ZCOUNT+1
|
||||
IF ZCOUNT=0 Q ; no inpatient meds
|
||||
;M MEDS=^TMP($J,"UD")
|
||||
I DEBUG ZWR MEDS
|
||||
S MEDMAP=$NA(^TMP("C0CCCR",$J,"MEDMAP"))
|
||||
;N MEDCOUNT S MEDCOUNT=@MEDMAP@(0) ; We already have meds in the array
|
||||
N I S I=0
|
||||
F S I=$O(MEDS("med",I)) Q:'I D ; For each medication
|
||||
. N MED M MED=MEDS("med",I)
|
||||
. I $G(MED("vaType@value"))'="I" Q ; not inpatient
|
||||
. S MEDCOUNT=MEDCOUNT+1
|
||||
. S @MEDMAP@(0)=MEDCOUNT ; Update MedMap array counter
|
||||
. S MAP=$NA(^TMP("C0CCCR",$J,"MEDMAP",MEDCOUNT))
|
||||
. ;N RXIEN S RXIEN=MED(.01) ; Order Number
|
||||
. N RXIEN S RXIEN=$G(MED("orderID@value")) ; ien of the med
|
||||
. I DEBUG W "RXIEN IS ",RXIEN,!
|
||||
. I DEBUG W "MAP= ",MAP,!
|
||||
. S @MAP@("MEDOBJECTID")="MED_INPATIENT_UD"_RXIEN
|
||||
. S @MAP@("MEDISSUEDATETXT")="Order Date"
|
||||
. ;S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($P(MED(27),U),"DT")
|
||||
. S @MAP@("MEDISSUEDATE")=$$FMDTOUTC^C0CUTIL($G(MED("start@value")),"DT")
|
||||
. S @MAP@("MEDLASTFILLDATETXT")="" ; For Outpatient
|
||||
. S @MAP@("MEDLASTFILLDATE")="" ; For Outpatient
|
||||
. S @MAP@("MEDRXNOTXT")="" ; For Outpatient
|
||||
. S @MAP@("MEDRXNO")="" ; For Outpatient
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
. S @MAP@("MEDDETAILUNADORNED")="" ; Leave blank, field has its uses
|
||||
. ;S @MAP@("MEDSTATUSTEXT")="ACTIVE"
|
||||
. S @MAP@("MEDSTATUSTEXT")=$G(MED("vaStatus@value")) ; need to filter status
|
||||
. ;S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$P(MED(1),U)
|
||||
. S @MAP@("MEDSOURCEACTORID")="ACTORPROVIDER_"_$G(MED("orderingProvider@code"))
|
||||
. ;S @MAP@("MEDPRODUCTNAMETEXT")=MED("DDRUG",1,.01)
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))
|
||||
. ; NDC is field 31 in the drug file.
|
||||
. ; The actual drug entry in the drug file is not necessarily supplied.
|
||||
. ; It' node 1, internal form.
|
||||
. ;N MEDIEN S MEDIEN=MED(1,"I")
|
||||
. ;S @MAP@("MEDPRODUCTNAMECODEVALUE")=$S($L(MEDIEN):$$GET1^DIQ(50,MEDIEN,31,"E"),1:"")
|
||||
. N ZVUID S ZVUID=$G(MED("products.product.vaProduct@vuid")) ; VUID
|
||||
. N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
|
||||
. D ;
|
||||
. . S ZC=$$CODE^C0CUTIL(ZVUID)
|
||||
. . S ZCD=$P(ZC,"^",1) ; CODE TO USE
|
||||
. . S ZCDS=$P(ZC,"^",2) ; CODING SYSTEM - RXNORM OR VUID
|
||||
. . S ZCDSV=$P(ZC,"^",3) ; CODING SYSTEM VERSION
|
||||
. ;N ZRXNORM S ZRXNORM=""
|
||||
. ;S ZRXNORM=$$RXNCUI3^C0PLKUP(ZVUID)
|
||||
. S @MAP@("MEDPRODUCTNAMECODEVALUE")=ZCD
|
||||
. ;S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=$S($L(MEDIEN):"NDC",1:"")
|
||||
. S @MAP@("MEDPRODUCTNAMECODINGINGSYSTEM")=ZCDS
|
||||
. ;S @MAP@("MEDPRODUCTNAMECODEVERSION")=$S($L(MEDIEN):"none",1:"")
|
||||
. S @MAP@("MEDPRODUCTNAMECODEVERSION")=ZCDSV
|
||||
. S @MAP@("MEDBRANDNAMETEXT")=""
|
||||
. S @MAP@("MEDPRODUCTNAMETEXT")=$G(MED("name@value"))_" "_ZCDS_": "_ZCD
|
||||
. ;I $L(MEDIEN) D DOSE^PSS50(MEDIEN,,,,,"DOSE")
|
||||
. ;I $L(MEDIEN) N DOSEDATA M DOSEDATA=^TMP($J,"DOSE",MEDIEN)
|
||||
. ;S @MAP@("MEDSTRENGTHVALUE")=$S($L(MEDIEN):DOSEDATA(901),1:"")
|
||||
. S @MAP@("MEDSTRENGTHVALUE")=$G(MED("dose.dose@dose"))
|
||||
. ;S @MAP@("MEDSTRENGTHUNIT")=$S($P(DOSEDATA(902),U,2),1:"")
|
||||
. S @MAP@("MEDSTRENGTHUNIT")=$G(MED("dose.dose@units"))
|
||||
. ; Units, concentration, etc, come from another call
|
||||
. ; $$CPRS^PSNAPIS which returns dosage-form^va class^strengh^unit
|
||||
. ; This call takes nodes 1 and 3 of ^PSDRUG(D0,"ND") as parameters
|
||||
. ; NDF Entry IEN, and VA Product Name
|
||||
. ; These can be obtained using NDF^PSS50 (IEN,,,,,"SUBSCRIPT")
|
||||
. ; Documented in the same manual.
|
||||
. ;N NDFDATA,CONCDATA
|
||||
. ;I $L(MEDIEN) D
|
||||
. ;. D NDF^PSS50(MEDIEN,,,,,"CONC")
|
||||
. ;. M NDFDATA=^TMP($J,"CONC",MEDIEN)
|
||||
. ;. N NDFIEN S NDFIEN=$P(NDFDATA(20),U)
|
||||
. ;. N VAPROD S VAPROD=$P(NDFDATA(22),U)
|
||||
. ;. ; If a drug was not matched to NDF, then the NDFIEN is gonna be ""
|
||||
. ;. ; and this will crash the call. So...
|
||||
. ;. I NDFIEN="" S CONCDATA=""
|
||||
. ;. E S CONCDATA=$$CPRS^PSNAPIS(NDFIEN,VAPROD)
|
||||
. ;E S (NDFDATA,CONCDATA)="" ; This line is defensive programming to prevent undef errors.
|
||||
. ;S @MAP@("MEDFORMTEXT")=$S($L(MEDIEN):$P(CONCDATA,U,1),1:"")
|
||||
. S @MAP@("MEDFORMTEXT")=$G(MED("form@value"))
|
||||
. ;S @MAP@("MEDCONCVALUE")=$S($L(MEDIEN):$P(CONCDATA,U,3),1:"")
|
||||
. S @MAP@("MEDCONCVALUE")=$G(MED("dose.dose@dose"))
|
||||
. ;S @MAP@("MEDCONCUNIT")=$S($L(MEDIEN):$P(CONCDATA,U,4),1:"")
|
||||
. S @MAP@("MEDCONCUNIT")=$G(MED("dose.does@units"))
|
||||
. ;S @MAP@("MEDQUANTITYVALUE")="" ; not provided for in Non-VA meds.
|
||||
. S @MAP@("MEDQUANTITYVALUE")=""
|
||||
. ; Oddly, there is no easy place to find the dispense unit.
|
||||
. ; It's not included in the original call, so we have to go to the drug file.
|
||||
. ; That would be DATA^PSS50(IEN,,,,,"SUBSCRIPT")
|
||||
. ; Node 14.5 is the Dispense Unit
|
||||
. ;I $L(MEDIEN) D
|
||||
. ;. D DATA^PSS50(MEDIEN,,,,,"QTY")
|
||||
. ;. N QTYDATA M QTYDATA=^TMP($J,"QTY",MEDIEN)
|
||||
. ;. S @MAP@("MEDQUANTITYUNIT")=QTYDATA(14.5)
|
||||
. ;E S @MAP@("MEDQUANTITYUNIT")=""
|
||||
. S @MAP@("MEDQUANTITYUNIT")=$G(MED("dose.dose@unitsPerDose"))
|
||||
. ;
|
||||
. ; --- START OF DIRECTIONS ---
|
||||
. ; Dosage is field 2, route is 3, schedule is 4
|
||||
. ; These are all free text fields, and don't point to any files
|
||||
. ; For that reason, I will use the field I never used before:
|
||||
. ; MEDDIRECTIONDESCRIPTIONTEXT
|
||||
. ;S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=MED(2,"E")_" "_MED(3,"E")_" "_MED(4,"E")
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONDESCRIPTIONTEXT")=$G(MED("sig"))
|
||||
. ; $G(MED("products.product.vaProduct@name"))
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEINDICATOR")="4" ; means look in description text. See E2369-05.
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDELIVERYMETHOD")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDOSEUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDRATEUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDVEHICLETEXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRECTIONROUTETEXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDFREQUENCYVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDINTERVALUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDURATIONUNIT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPRNFLAG")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMOBJECTID")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMTYPETXT")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMDESCRIPTION")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODEVALUE")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGSYSTEM")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMCODINGVERSION")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDPROBLEMSOURCEACTORID")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDSTOPINDICATOR")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDDIRSEQ")=""
|
||||
. S @MAP@("M","DIRECTIONS",1,"MEDMULDIRMOD")=""
|
||||
. ;
|
||||
. ; --- END OF DIRECTIONS ---
|
||||
. ;
|
||||
. ; S @MAP@("MEDPTINSTRUCTIONS","F")="52.41^105"
|
||||
. ;S @MAP@("MEDPTINSTRUCTIONS")=MED(10,1) ; WP Field
|
||||
. S @MAP@("MEDPTINSTRUCTIONS")=""
|
||||
. ;S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=MED(14,1) ; WP Field
|
||||
. S @MAP@("MEDFULLFILLMENTINSTRUCTIONS")=""
|
||||
. S @MAP@("MEDRFNO")=""
|
||||
. N RESULT S RESULT=$NA(^TMP("C0CCCR",$J,"MAPPED"))
|
||||
. K @RESULT
|
||||
. D MAP^C0CXPATH(MINXML,MAP,RESULT)
|
||||
. ; D PARY^C0CXPATH(RESULT)
|
||||
. ; MAPPING DIRECTIONS
|
||||
. N MEDDIR1,DIRXML1 S DIRXML1="MEDDIR1" ; VARIABLE AND NAME VARIABLE TEMPLATE
|
||||
. N MEDDIR2,DIRXML2 S DIRXML2="MEDDIR2" ; VARIABLE AND NAME VARIABLE RESULT
|
||||
. D QUERY^C0CXPATH(MINXML,"//Medications/Medication/Directions",DIRXML1)
|
||||
. D REPLACE^C0CXPATH(RESULT,"","//Medications/Medication/Directions")
|
||||
. ; N MDZ1,MDZNA
|
||||
. N DIRCNT S DIRCNT=1 ; THERE ARE ALWAYS DIRECTIONS
|
||||
. I DIRCNT>0 D ; IF THERE ARE DIRCTIONS
|
||||
. . F MDZ1=1:1:DIRCNT D ; FOR EACH DIRECTION
|
||||
. . . S MDZNA=$NA(@MAP@("M","DIRECTIONS",MDZ1))
|
||||
. . . D MAP^C0CXPATH(DIRXML1,MDZNA,DIRXML2)
|
||||
. . . D INSERT^C0CXPATH(RESULT,DIRXML2,"//Medications/Medication")
|
||||
. D:MEDCOUNT=1 CP^C0CXPATH(RESULT,OUTXML) ; First one is a copy
|
||||
. D:MEDCOUNT>1 INSINNER^C0CXPATH(OUTXML,RESULT) ; AFTER THE FIRST, INSERT INNER XML
|
||||
N MEDTMP,MEDI
|
||||
D MISSING^C0CXPATH(OUTXML,"MEDTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I MEDTMP(0)>0 D ; IF THERE ARE MISSING VARS - MARKED AS @@X@@
|
||||
. W "MEDICATION MISSING ",!
|
||||
. F MEDI=1:1:MEDTMP(0) W MEDTMP(MEDI),!
|
||||
Q
|
||||
;
|
116
p/C0CPARMS.m
116
p/C0CPARMS.m
|
@ -1,62 +1,62 @@
|
|||
C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;Copyright 2008 WorldVistA. 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 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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;Copyright 2008 WorldVistA. 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 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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
SET(INPARMS) ;INITIALIZE RUNTIME PARMS USING INPARMS TO OVERRIDE DEFAULTS
|
||||
; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"
|
||||
; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS
|
||||
;
|
||||
N PTMP ;
|
||||
S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN
|
||||
K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL
|
||||
I $G(INPARMS)'="" D ; OVERRIDES PROVIDED
|
||||
. N C0CI S C0CI=""
|
||||
. N C0CN S C0CN=1
|
||||
. F S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI="" D ;
|
||||
. . S C0CN=C0CN+1 ;NEXT PARM
|
||||
. . N C1,C2
|
||||
. . S C1=$P(C0CI,":",1) ; PARAMETER
|
||||
. . S C2=$P(C0CI,":",2) ; VALUE
|
||||
. . I C2="" S C2=1
|
||||
. . S @C0CPARMS@(C1)=C2
|
||||
. I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE
|
||||
; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS
|
||||
; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS
|
||||
I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH
|
||||
I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY
|
||||
I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS
|
||||
I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY
|
||||
I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY
|
||||
I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS
|
||||
I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES
|
||||
I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO
|
||||
I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE
|
||||
Q
|
||||
;
|
||||
; PARAMETERS ARE PASSED AS A STRING: "PARM1:VALUE1^PARM2:VALUE2^ETC"
|
||||
; THE SAME FORMAT IS USED BY RPC AND COMMAND LINE ENTRY POINTS
|
||||
;
|
||||
N PTMP ;
|
||||
S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;BASE FOR THIS RUN
|
||||
K @C0CPARMS ;START WITH EMPTY PARMS; MAY NOT WANT TO DO THIS KILL
|
||||
I $G(INPARMS)'="" D ; OVERRIDES PROVIDED
|
||||
. N C0CI S C0CI=""
|
||||
. N C0CN S C0CN=1
|
||||
. F S C0CI=$P(INPARMS,"^",C0CN) Q:C0CI="" D ;
|
||||
. . S C0CN=C0CN+1 ;NEXT PARM
|
||||
. . N C1,C2
|
||||
. . S C1=$P(C0CI,":",1) ; PARAMETER
|
||||
. . S C2=$P(C0CI,":",2) ; VALUE
|
||||
. . I C2="" S C2=1
|
||||
. . S @C0CPARMS@(C1)=C2
|
||||
. I C0CN=1 S @C0CPARMS@($P(INPARMS,":",1))=$P(C0CI,":",2) ; ONLY ONE
|
||||
; THIS IS WHERE WE WILL INSERT CALLS TO THE PARAMETER FILE FOR DEFAULTS
|
||||
; IF THEY FAIL, THE FOLLOWING WILL BE HARDCODED DEFAULTS
|
||||
I '$D(@C0CPARMS@("LABLIMIT")) S @C0CPARMS@("LABLIMIT")="T-360" ;ONE YR WORTH
|
||||
I '$D(@C0CPARMS@("LABSTART")) S @C0CPARMS@("LABSTART")="T" ;TODAY
|
||||
I '$D(@C0CPARMS@("VITLIMIT")) S @C0CPARMS@("VITLIMIT")="T-360" ;ONE YR VITALS
|
||||
I '$D(@C0CPARMS@("VITSTART")) S @C0CPARMS@("VITSTART")="T" ;TODAY
|
||||
I '$D(@C0CPARMS@("MEDSTART")) S @C0CPARMS@("MEDSTART")="T" ; TODAY
|
||||
I '$D(@C0CPARMS@("MEDSLIMIT")) S @C0CPARMS@("MEDLIMIT")="T-360" ; ONE YR MEDS
|
||||
I '$D(@C0CPARMS@("MEDACTIVE")) S @C0CPARMS@("MEDACTIVE")=1 ; YES
|
||||
I '$D(@C0CPARMS@("MEDPENDING")) S @C0CPARMS@("MEDPENDING")=0 ; NO
|
||||
I '$D(@C0CPARMS@("MEDALL")) S @C0CPARMS@("MEDALL")=0 ; NON-PENDING NON-ACTIVE
|
||||
Q
|
||||
;
|
||||
CHECK ; CHECK TO SEE IF PARMS ARE PRESENT, ELSE RUN SET
|
||||
;
|
||||
I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN
|
||||
I '$D(@C0CPARMS) D SET("SETWITHCHECK:1")
|
||||
Q
|
||||
;
|
||||
;
|
||||
I '$D(C0CPARMS) S C0CPARMS=$NA(^TMP("C0CPARMS",$J)) ;SHOULDN'T HAPPEN
|
||||
I '$D(@C0CPARMS) D SET("SETWITHCHECK:1")
|
||||
Q
|
||||
;
|
||||
GET(WHICHP) ;EXTRINSIC TO RETURN THE VALUE OF PARAMETER WHICHP
|
||||
;
|
||||
D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE
|
||||
N GTMP
|
||||
Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE
|
||||
;
|
||||
;
|
||||
D CHECK ; SHOULDN'T HAPPEN BUT TO BE SAFE
|
||||
N GTMP
|
||||
Q $G(@C0CPARMS@(WHICHP)) ;PULL THE PARM FROM THE TABLE
|
||||
;
|
||||
|
|
360
p/C0CPROBS.m
360
p/C0CPROBS.m
|
@ -1,180 +1,180 @@
|
|||
C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
;
|
||||
; PROCESS THE PROBLEMS SECTION OF THE CCR
|
||||
;
|
||||
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
|
||||
;
|
||||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
|
||||
; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
|
||||
; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
|
||||
; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
|
||||
;
|
||||
N RPCRSLT,J,K,PTMP,X,VMAP,TBU
|
||||
S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS"))
|
||||
S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP"))
|
||||
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
|
||||
I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS)
|
||||
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
|
||||
Q
|
||||
;
|
||||
RPMS ; GETS THE PROBLEM LIST FOR RPMS
|
||||
S RPCGLO=$NA(^TMP("BGO",$J))
|
||||
D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC
|
||||
; FORMAT OF RPC:
|
||||
; Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^
|
||||
; Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^
|
||||
; ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16]
|
||||
I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q
|
||||
S J=""
|
||||
F S J=$O(@RPCGLO@(J)) Q:J="" D ; FOR EACH PROBLEM IN THE LIST
|
||||
. S VMAP=$NA(@TVMAP@(J))
|
||||
. K @VMAP
|
||||
. I DEBUG W "VMAP= ",VMAP,!
|
||||
. S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
|
||||
. N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
|
||||
. D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME
|
||||
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
|
||||
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10)
|
||||
. S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"")
|
||||
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6)
|
||||
. S @VMAP@("PROBLEMCODINGVERSION")=""
|
||||
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3)
|
||||
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")
|
||||
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")
|
||||
. ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
|
||||
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1")
|
||||
. ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0
|
||||
. S ARYTMP=$NA(@TARYTMP@(J))
|
||||
. ; W "ARYTMP= ",ARYTMP,!
|
||||
. K @ARYTMP
|
||||
. D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
|
||||
. I J=1 D ; FIRST ONE IS JUST A COPY
|
||||
. . ; W "FIRST ONE",!
|
||||
. . D CP^C0CXPATH(ARYTMP,OUTXML)
|
||||
. . ; W "OUTXML ",OUTXML,!
|
||||
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
|
||||
. . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
|
||||
; ZWR @OUTXML
|
||||
; $$HTML^DILF(
|
||||
; GENERATE THE NARITIVE HTML FOR THE CCD
|
||||
I CCD D CCD ; IF THIS IS FOR A CCD
|
||||
D MISSINGVARS
|
||||
Q
|
||||
;
|
||||
VISTA ; GETS THE PROBLEM LIST FOR VISTA
|
||||
D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
|
||||
I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL
|
||||
. W "NULL RESULT FROM LIST^ORQQPL3 ",!
|
||||
. S @OUTXML@(0)=0
|
||||
. ; Q
|
||||
; I DEBUG ZWR RPCRSLT
|
||||
S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
|
||||
F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
|
||||
. S VMAP=$NA(@TVMAP@(J))
|
||||
. K @VMAP
|
||||
. I DEBUG W "VMAP= ",VMAP,!
|
||||
. S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
|
||||
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
|
||||
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
|
||||
. S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")
|
||||
. N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG
|
||||
. S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
|
||||
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
|
||||
. S @VMAP@("PROBLEMCODINGVERSION")=""
|
||||
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
|
||||
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
|
||||
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")
|
||||
. S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
|
||||
. S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
|
||||
. S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
|
||||
. S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
|
||||
. S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
|
||||
. S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
|
||||
. S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
|
||||
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
|
||||
. S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
|
||||
. S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
|
||||
. S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT")
|
||||
. S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT")
|
||||
. S ARYTMP=$NA(@TARYTMP@(J))
|
||||
. ; W "ARYTMP= ",ARYTMP,!
|
||||
. K @ARYTMP
|
||||
. D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
|
||||
. I J=1 D ; FIRST ONE IS JUST A COPY
|
||||
. . ; W "FIRST ONE",!
|
||||
. . D CP^C0CXPATH(ARYTMP,OUTXML)
|
||||
. . ; W "OUTXML ",OUTXML,!
|
||||
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
|
||||
. . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
|
||||
; ZWR @OUTXML
|
||||
; $$HTML^DILF(
|
||||
; GENERATE THE NARITIVE HTML FOR THE CCD
|
||||
I CCD D CCD ; IF THIS IS FOR A CCD
|
||||
D MISSINGVARS
|
||||
Q
|
||||
CCD
|
||||
N HTMP,HOUT,HTMLO,C0CPROBI,ZX
|
||||
F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
|
||||
. S VMAP=$NA(@TVMAP@(C0CPROBI))
|
||||
. I DEBUG W "VMAP =",VMAP,!
|
||||
. D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
|
||||
. D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
|
||||
. ; D PARY^C0CXPATH("HTMP") ; PRINT IT
|
||||
. D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
|
||||
. ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN
|
||||
. I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY
|
||||
. . D CP^C0CXPATH("HOUT","HTMLO")
|
||||
. I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML
|
||||
. . I DEBUG W "DOING INNER",!
|
||||
. . N HTMLBLD,HTMLTMP
|
||||
. . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
|
||||
. . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
|
||||
. . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
|
||||
. . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP")
|
||||
. . D CP^C0CXPATH("HTMLTMP","HTMLO")
|
||||
. . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//")
|
||||
I DEBUG D PARY^C0CXPATH("HTMLO")
|
||||
D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
|
||||
Q
|
||||
MISSINGVARS
|
||||
N PROBSTMP,I
|
||||
D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W !,"PROBLEMS Missing list: ",!
|
||||
. F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
|
||||
Q
|
||||
;
|
||||
C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
;
|
||||
; PROCESS THE PROBLEMS SECTION OF THE CCR
|
||||
;
|
||||
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
|
||||
;
|
||||
; INXML AND OUTXML ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
; INXML WILL CONTAIN ONLY THE PROBLEM SECTION OF THE OVERALL TEMPLATE
|
||||
; ONLY THE XML FOR ONE PROBLEM WILL BE PASSED. THIS ROUTINE WILL MAKE
|
||||
; COPIES AS NECESSARY TO REPRESENT MULTIPLE PROBLEMS
|
||||
; INSERT^C0CXPATH IS USED TO APPEND THE PROBLEMS TO THE OUTPUT
|
||||
;
|
||||
N RPCRSLT,J,K,PTMP,X,VMAP,TBU
|
||||
S TVMAP=$NA(^TMP("C0CCCR",$J,"PROBVALS"))
|
||||
S TARYTMP=$NA(^TMP("C0CCCR",$J,"PROBARYTMP"))
|
||||
K @TVMAP,@TARYTMP ; KILL OLD ARRAY VALUES
|
||||
I $$RPMS^C0CUTIL() D RPMS ; IF BGOPRB ROUTINE IS MISSING (IE RPMS)
|
||||
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D VISTA QUIT
|
||||
Q
|
||||
;
|
||||
RPMS ; GETS THE PROBLEM LIST FOR RPMS
|
||||
S RPCGLO=$NA(^TMP("BGO",$J))
|
||||
D GET^BGOPROB(.RPCRSLT,DFN) ; CALL THE PROBLEM LIST RPC
|
||||
; FORMAT OF RPC:
|
||||
; Number Code [1] ^ Patient IEN [2] ^ ICD Code [3] ^ Modify Date [4] ^ Class [5] ^ Provider Narrative [6] ^
|
||||
; Date Entered [7] ^ Status [8] ^ Date Onset [9] ^ Problem IEN [10] ^ Notes [11] ^ ICD9 IEN [12] ^
|
||||
; ICD9 Short Name [13] ^ Provider [14] ^ Facility IEN [15] ^ Priority [16]
|
||||
I '$D(@RPCGLO) W "NULL RESULT FROM GET^BGOPROB ",! S @OUTXML@(0)=0 Q
|
||||
S J=""
|
||||
F S J=$O(@RPCGLO@(J)) Q:J="" D ; FOR EACH PROBLEM IN THE LIST
|
||||
. S VMAP=$NA(@TVMAP@(J))
|
||||
. K @VMAP
|
||||
. I DEBUG W "VMAP= ",VMAP,!
|
||||
. S PTMP=@RPCRSLT@(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
|
||||
. N C0CG1,C0CT ; ARRAY FOR VALUES FROM GLOBAL
|
||||
. D GETN1^C0CRNF("C0CG1",9000011,$P(PTMP,U,10),"") ;GET VALUES BY NAME
|
||||
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
|
||||
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,10)
|
||||
. S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,8)="A":"Active",$P(PTMP,U,8)="I":"Inactive",1:"")
|
||||
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,6)
|
||||
. S @VMAP@("PROBLEMCODINGVERSION")=""
|
||||
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,3)
|
||||
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE OF ONSET","C0CG1"),"DT")
|
||||
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($$ZVALUEI^C0CRNF("DATE LAST MODIFIED","C0CG1"),"DT")
|
||||
. ;S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) ;UNKNOWN NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) ;UNKNOWN NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
|
||||
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$$ZVALUEI^C0CRNF("RECORDING PROVIDER","C0CG1")
|
||||
. ;S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT") ;NOT MAPPED IN C0CCCR0
|
||||
. ;S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT") ;NOT MAPPED IN C0CCCR0
|
||||
. S ARYTMP=$NA(@TARYTMP@(J))
|
||||
. ; W "ARYTMP= ",ARYTMP,!
|
||||
. K @ARYTMP
|
||||
. D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
|
||||
. I J=1 D ; FIRST ONE IS JUST A COPY
|
||||
. . ; W "FIRST ONE",!
|
||||
. . D CP^C0CXPATH(ARYTMP,OUTXML)
|
||||
. . ; W "OUTXML ",OUTXML,!
|
||||
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
|
||||
. . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
|
||||
; ZWR @OUTXML
|
||||
; $$HTML^DILF(
|
||||
; GENERATE THE NARITIVE HTML FOR THE CCD
|
||||
I CCD D CCD ; IF THIS IS FOR A CCD
|
||||
D MISSINGVARS
|
||||
Q
|
||||
;
|
||||
VISTA ; GETS THE PROBLEM LIST FOR VISTA
|
||||
D LIST^ORQQPL3(.RPCRSLT,DFN,"") ; CALL THE PROBLEM LIST RPC
|
||||
I '$D(RPCRSLT(1)) D Q ; RPC RETURNS NULL
|
||||
. W "NULL RESULT FROM LIST^ORQQPL3 ",!
|
||||
. S @OUTXML@(0)=0
|
||||
. ; Q
|
||||
; I DEBUG ZWR RPCRSLT
|
||||
S @TVMAP@(0)=RPCRSLT(0) ; SAVE NUMBER OF PROBLEMS
|
||||
F J=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM IN THE LIST
|
||||
. S VMAP=$NA(@TVMAP@(J))
|
||||
. K @VMAP
|
||||
. I DEBUG W "VMAP= ",VMAP,!
|
||||
. S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
|
||||
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
|
||||
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
|
||||
. S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",$P(PTMP,U,2)="I":"Inactive",1:"")
|
||||
. N ZPRIOR S ZPRIOR=$P(PTMP,U,14) ;PRIORITY FLAG
|
||||
. S @VMAP@("PROBLEMSTATUS")=@VMAP@("PROBLEMSTATUS")_$S(ZPRIOR="A":"/Acute",ZPRIOR="C":"/Chronic",1:"") ; append Chronic and Accute to Status
|
||||
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
|
||||
. S @VMAP@("PROBLEMCODINGVERSION")=""
|
||||
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
|
||||
. S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,5),"DT")
|
||||
. S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,6),"DT")
|
||||
. S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
|
||||
. S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
|
||||
. S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
|
||||
. S @VMAP@("PROBLEMLOC")=$P(PTMP,U,10)
|
||||
. S @VMAP@("PROBLEMLOCTYPE")=$P(PTMP,U,11)
|
||||
. S @VMAP@("PROBLEMPROVIDER")=$P(PTMP,U,12)
|
||||
. S X=@VMAP@("PROBLEMPROVIDER") ; FORMAT Y;NAME Y IS IEN OF PROVIDER
|
||||
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
|
||||
. S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
|
||||
. S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
|
||||
. S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,15),"DT")
|
||||
. S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^C0CUTIL($P(PTMP,U,16),"DT")
|
||||
. S ARYTMP=$NA(@TARYTMP@(J))
|
||||
. ; W "ARYTMP= ",ARYTMP,!
|
||||
. K @ARYTMP
|
||||
. D MAP^C0CXPATH(IPXML,VMAP,ARYTMP) ;
|
||||
. I J=1 D ; FIRST ONE IS JUST A COPY
|
||||
. . ; W "FIRST ONE",!
|
||||
. . D CP^C0CXPATH(ARYTMP,OUTXML)
|
||||
. . ; W "OUTXML ",OUTXML,!
|
||||
. I J>1 D ; AFTER THE FIRST, INSERT INNER XML
|
||||
. . D INSINNER^C0CXPATH(OUTXML,ARYTMP)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBVALS",*)
|
||||
; ZWR ^TMP("C0CCCR",$J,"PROBARYTMP",*) ; SHOW THE RESULTS
|
||||
; ZWR @OUTXML
|
||||
; $$HTML^DILF(
|
||||
; GENERATE THE NARITIVE HTML FOR THE CCD
|
||||
I CCD D CCD ; IF THIS IS FOR A CCD
|
||||
D MISSINGVARS
|
||||
Q
|
||||
CCD
|
||||
N HTMP,HOUT,HTMLO,C0CPROBI,ZX
|
||||
F C0CPROBI=1:1:RPCRSLT(0) D ; FOR EACH PROBLEM
|
||||
. S VMAP=$NA(@TVMAP@(C0CPROBI))
|
||||
. I DEBUG W "VMAP =",VMAP,!
|
||||
. D QUERY^C0CXPATH(TGLOBAL,"//ContinuityOfCareRecord/Body/PROBLEMS-HTML","HTMP") ; GET THE HTML FROM THE TEMPLATE
|
||||
. D UNMARK^C0CXPATH("HTMP") ; REMOVE <PROBLEMS-HTML> MARKUP
|
||||
. ; D PARY^C0CXPATH("HTMP") ; PRINT IT
|
||||
. D MAP^C0CXPATH("HTMP",VMAP,"HOUT") ; MAP THE VARIABLES
|
||||
. ; D PARY^C0CXPATH("HOUT") ; PRINT IT AGAIN
|
||||
. I C0CPROBI=1 D ; FIRST ONE IS JUST A COPY
|
||||
. . D CP^C0CXPATH("HOUT","HTMLO")
|
||||
. I C0CPROBI>1 D ; AFTER THE FIRST, INSERT INNER HTML
|
||||
. . I DEBUG W "DOING INNER",!
|
||||
. . N HTMLBLD,HTMLTMP
|
||||
. . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",1,HTMLO(0)-1)
|
||||
. . D QUEUE^C0CXPATH("HTMLBLD","HOUT",2,HOUT(0)-1)
|
||||
. . D QUEUE^C0CXPATH("HTMLBLD","HTMLO",HTMLO(0),HTMLO(0))
|
||||
. . D BUILD^C0CXPATH("HTMLBLD","HTMLTMP")
|
||||
. . D CP^C0CXPATH("HTMLTMP","HTMLO")
|
||||
. . ; D INSINNER^C0CXPATH("HOUT","HTMLO","//")
|
||||
I DEBUG D PARY^C0CXPATH("HTMLO")
|
||||
D INSB4^C0CXPATH(OUTXML,"HTMLO") ; INSERT AT TOP OF SECTION
|
||||
Q
|
||||
MISSINGVARS
|
||||
N PROBSTMP,I
|
||||
D MISSING^C0CXPATH(ARYTMP,"PROBSTMP") ; SEARCH XML FOR MISSING VARS
|
||||
I PROBSTMP(0)>0 D ; IF THERE ARE MISSING VARS -
|
||||
. ; STRINGS MARKED AS @@X@@
|
||||
. W !,"PROBLEMS Missing list: ",!
|
||||
. F I=1:1:PROBSTMP(0) W PROBSTMP(I),!
|
||||
Q
|
||||
;
|
||||
|
|
274
p/C0CPROC.m
274
p/C0CPROC.m
|
@ -1,137 +1,137 @@
|
|||
C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
|
||||
;;1.0;C0C;;Jan 21, 2010;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES
|
||||
S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))
|
||||
S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
|
||||
S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
|
||||
Q
|
||||
;
|
||||
EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
|
||||
; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
D SETVARS ; SET UP VARIABLES
|
||||
I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
|
||||
D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
|
||||
Q
|
||||
;
|
||||
TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
|
||||
; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
|
||||
; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
|
||||
;
|
||||
K VISIT,LST,NOTE,C0CLPRC
|
||||
; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS
|
||||
; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES
|
||||
D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
|
||||
; NEED TO ADD START AND END DATES FROM PARAMETERS
|
||||
N ZI S ZI=""
|
||||
N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
|
||||
F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST
|
||||
. N ZDATE
|
||||
. S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
|
||||
. S ZPRVARY=$NA(VISIT(ZI,"PRV"))
|
||||
. N ZPRV
|
||||
. S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
|
||||
. ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
|
||||
. N ZJ S ZJ=""
|
||||
. F S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ="" D ;FOR EACH CPT SEG
|
||||
. . N ZRNF
|
||||
. . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
|
||||
. . I ZCPT'="" D ;IF CPT CODE IS PRESENT
|
||||
. . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q ; NO DUPS ALLOWED
|
||||
. . . W !,ZCPT," ",ZDATE," ",ZPRV
|
||||
. . . S ZRNF("PROCACTOROBJID")=ZPRV
|
||||
. . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)
|
||||
. . . S ZRNF("PROCCODE")=PROCCODE
|
||||
. . . S ZRNF("PROCCODESYS")="CPT-4"
|
||||
. . . S ZRNF("PROCDATETEXT")="Procedure Date"
|
||||
. . . S ZRNF("PROCDATETIME")=ZDATE
|
||||
. . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
|
||||
. . . S ZRNF("PROCDESCOBJATTR")=""
|
||||
. . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
|
||||
. . . S ZRNF("PROCDESCOBJATTRVAL")=""
|
||||
. . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
|
||||
. . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
|
||||
. . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
|
||||
. . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
|
||||
. . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
|
||||
. . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
|
||||
. . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
|
||||
. . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
|
||||
. . . S PREVCPT=ZCPT
|
||||
. . . S PREVDT=ZDATE
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
|
||||
M @ZRIM=@C0CPRC@("V")
|
||||
Q
|
||||
;
|
||||
PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
|
||||
N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG
|
||||
. I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER
|
||||
. I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
|
||||
I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
|
||||
Q ZRTN
|
||||
;
|
||||
DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
|
||||
Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
|
||||
;
|
||||
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
||||
; CPT^CATEGORY^TEXT
|
||||
N Z1,Z2,Z3,ZRTN
|
||||
S Z1=$P(ISTR,U,1)
|
||||
I Z1="" D ;
|
||||
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
||||
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
||||
. ;S Z1=$P(ISTR,U,1)
|
||||
. S Z2=$P(ISTR,U,2)
|
||||
. S Z3=$P(ISTR,U,3)
|
||||
. S ZRTN=Z1_U_Z2_U_Z3
|
||||
E S ZRTN=""
|
||||
Q ZRTN
|
||||
;
|
||||
MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI="" D ;FOR EACH PROCEDURE
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
|
||||
. S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
|
||||
N ZZTMP
|
||||
D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD,@C0CPRC
|
||||
Q
|
||||
;
|
||||
C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
|
||||
;;1.0;C0C;;Jan 21, 2010;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
SETVARS ; SET UP VARIABLES FOR PROCEDURES, ENCOUNTERS, AND NOTES
|
||||
S C0CENC=$NA(^TMP("C0CCCR",$J,"C0CENC",DFN))
|
||||
S C0CPRC=$NA(^TMP("C0CCCR",$J,"C0CPRC",DFN))
|
||||
S C0CNTE=$NA(^TMP("C0CCCR",$J,"C0CNTE",DFN))
|
||||
Q
|
||||
;
|
||||
EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
|
||||
; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
D SETVARS ; SET UP VARIABLES
|
||||
I '$D(@C0CPRC) D TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; GET VARS IF NOT THERE
|
||||
D MAP(PROCXML,C0CPRC,PROCOUT) ;MAP RESULTS FOR PROCEDURES
|
||||
Q
|
||||
;
|
||||
TIUGET(DFN,C0CENC,C0CPRC,C0CNTE) ; CALLS ENTRY^C0CCPT TO GET PROCEDURES,
|
||||
; ENCOUNTERS AND NOTES. RETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CENC: ENCOUNTERS, C0CPRC: PROCEDURES, C0CNTE: NOTES
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CENC, MAP^C0CPROC, AND MAP^C0CCMT
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST. THIS IS SO THAT ADDITIONAL PROCEDURES CAN BE OBTAINED FROM
|
||||
; THE SURGERY PACKGE AND ADDITIONAL COMMENTS FROM OTHER CCR SECTIONS
|
||||
;
|
||||
K VISIT,LST,NOTE,C0CLPRC
|
||||
; C0CLPRC IS A LOOKUP TABLE FOR USE IN BUILDING ENCOUNTERS
|
||||
; FORMAT C0CLPRC(VISITIEN,CPT)=PROCOBJECTID FOR BUILDING LINKS TO PROCEDURES
|
||||
D ENTRY^C0CCPT(DFN,,,1) ; RETURNS ALL RESULTS IN VISIT LOCAL VARIABLE
|
||||
; NEED TO ADD START AND END DATES FROM PARAMETERS
|
||||
N ZI S ZI=""
|
||||
N PREVCPT,PREVDT S (PREVCPT,PREVDT)=""
|
||||
F S ZI=$O(VISIT(ZI),-1) Q:ZI="" D ; REVERSE TIME ORDER - MOST RECENT FIRST
|
||||
. N ZDATE
|
||||
. S ZDATE=$$DATE(VISIT(ZI,"DATE",0))
|
||||
. S ZPRVARY=$NA(VISIT(ZI,"PRV"))
|
||||
. N ZPRV
|
||||
. S ZPRV=$$PRV(ZPRVARY) ; THE PRIMARY PROVIDER OBJECT IN THE FORM
|
||||
. ; ACTORPROVIDER_IEN WHERE IEN IS THE PROVIDER IEN IN NEW PERSON
|
||||
. N ZJ S ZJ=""
|
||||
. F S ZJ=$O(VISIT(ZI,"CPT",ZJ)) Q:ZJ="" D ;FOR EACH CPT SEG
|
||||
. . N ZRNF
|
||||
. . N ZCPT S ZCPT=$$CPT(VISIT(ZI,"CPT",ZJ)) ;GET CPT CODE AND TEXT
|
||||
. . I ZCPT'="" D ;IF CPT CODE IS PRESENT
|
||||
. . . I (ZCPT=PREVCPT)&(ZDATE=PREVDT) Q ; NO DUPS ALLOWED
|
||||
. . . W !,ZCPT," ",ZDATE," ",ZPRV
|
||||
. . . S ZRNF("PROCACTOROBJID")=ZPRV
|
||||
. . . N PROCCODE S PROCCODE=$P(ZCPT,U,1)
|
||||
. . . S ZRNF("PROCCODE")=PROCCODE
|
||||
. . . S ZRNF("PROCCODESYS")="CPT-4"
|
||||
. . . S ZRNF("PROCDATETEXT")="Procedure Date"
|
||||
. . . S ZRNF("PROCDATETIME")=ZDATE
|
||||
. . . S ZRNF("PROCDESCOBJATTRCODE")="" ;NO PROC ATTRIBUTES YET
|
||||
. . . S ZRNF("PROCDESCOBJATTR")=""
|
||||
. . . S ZRNF("PROCDESCOBJATTRCODESYS")="" ;WE DON'T HAVE PROC ATTRIBUTES
|
||||
. . . S ZRNF("PROCDESCOBJATTRVAL")=""
|
||||
. . . S ZRNF("PROCDESCTEXT")=$P(ZCPT,U,3)
|
||||
. . . S ZRNF("PROCLINKID")="" ; NO LINKS YET
|
||||
. . . S ZRNF("PROCLINKREL")="" ; NO LINKS YET
|
||||
. . . S ZRNF("PROCOBJECTID")="PROCEDURE_"_ZI_"_"_ZJ
|
||||
. . . S C0CLPRC(ZI,PROCCODE)=ZRNF("PROCOBJECTID") ; LOOKUP TABLE FOR ENCOUNTERS
|
||||
. . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
|
||||
. . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
|
||||
. . . D RNF1TO2^C0CRNF(C0CPRC,"ZRNF") ; ADD THIS ROW TO THE ARRAY
|
||||
. . . S PREVCPT=ZCPT
|
||||
. . . S PREVDT=ZDATE
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"PROCEDURES"))
|
||||
M @ZRIM=@C0CPRC@("V")
|
||||
Q
|
||||
;
|
||||
PRV(IARY) ; RETURNS THE PRIMARY PROVIDER FROM THE "PRV" ARRAY PASSED BY NAME
|
||||
N ZI,ZR,ZRTN S ZI="" S ZR="" S ZRTN=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ; FOR EACH PRV SEG
|
||||
. I ZR'="" Q ;ONLY WANT THE FIRST PRIMARY PROVIDER
|
||||
. I $P(@IARY@(ZI),U,5)=1 S ZR=$P(@IARY@(ZI),U,1)
|
||||
I ZR'="" S ZRTN="ACTORPROVIDER_"_ZR
|
||||
Q ZRTN
|
||||
;
|
||||
DATE(ISTR) ; EXTRINSIC TO RETURN THE DATE IN CCR FORMAT
|
||||
Q $$FMDTOUTC^C0CUTIL(ISTR,"DT")
|
||||
;
|
||||
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
||||
; CPT^CATEGORY^TEXT
|
||||
N Z1,Z2,Z3,ZRTN
|
||||
S Z1=$P(ISTR,U,1)
|
||||
I Z1="" D ;
|
||||
. I ISTR["(CPT-4 " S Z1=$P($P(ISTR,"(CPT-4 ",2),")",1)
|
||||
I Z1'="" D ; IF THERE IS A CPT CODE IN THERE
|
||||
. ;S Z1=$P(ISTR,U,1)
|
||||
. S Z2=$P(ISTR,U,2)
|
||||
. S Z3=$P(ISTR,U,3)
|
||||
. S ZRTN=Z1_U_Z2_U_Z3
|
||||
E S ZRTN=""
|
||||
Q ZRTN
|
||||
;
|
||||
MAP(PROCXML,C0CPRC,PROCOUT) ; MAP PROCEDURES XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"PROCTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"PROCBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,PROCXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
D QUERY^C0CXPATH(PROCXML,"//Procedures/Procedure","ZINNER") ;ONE PROC
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CPRC@("V",ZI)) Q:ZI="" D ;FOR EACH PROCEDURE
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS PROCEDURE XML
|
||||
. S ZVAR=$NA(@C0CPRC@("V",ZI)) ;THIS PROCEDURE VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE PROCEDURE
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,PROCXML,@PROCXML@(0),@PROCXML@(0))
|
||||
N ZZTMP
|
||||
D BUILD^C0CXPATH(ZBLD,PROCOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD,@C0CPRC
|
||||
Q
|
||||
;
|
||||
|
|
1011
p/C0CRIMA.m
1011
p/C0CRIMA.m
File diff suppressed because it is too large
Load Diff
888
p/C0CRNF.m
888
p/C0CRNF.m
|
@ -1,462 +1,462 @@
|
|||
C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the Reference Name Format (RNF) Utility Library ",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the Reference Name Format (RNF) Utility Library ",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
FIELDS(C0CFRTN,C0CF) ; RETURNS AN ARRAY OF THE FIELDS IN FILE C0CF,
|
||||
; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
|
||||
;
|
||||
N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
|
||||
N C0CFN ; FIELD NAME
|
||||
S C0CFI=0 S C0CFJ=C0CF
|
||||
K @C0CFRTN ; CLEAR THE RETURN ARRAY
|
||||
F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
|
||||
. ;W "1: "_C0CFJ," ",C0CFI,!
|
||||
. F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD
|
||||
. . ;W "2: "_C0CFJ," ",C0CFI,!
|
||||
. . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
|
||||
. . ;W "N: ",C0CFN,!
|
||||
. . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
|
||||
. . I $D(@C0CFRTN@(C0CFN)) D ; IS THIS A DUPLICATE?
|
||||
. . . I $G(DEBUG) D ;
|
||||
. . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
|
||||
. . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
|
||||
. . E S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
|
||||
. S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
|
||||
Q
|
||||
;
|
||||
TESTRNF ; TEST THE RNF1TO2 ROUTINE
|
||||
S G1("ONE")=1
|
||||
S G1("TWO")=2
|
||||
S G1("THREE")=3
|
||||
D RNF1TO2("GPL","G1")
|
||||
S G1("ONE")="NOT1"
|
||||
S G1("TWO")="STILL2"
|
||||
S G1("THREE")=3
|
||||
D RNF1TO2("GPL","G1")
|
||||
ZWR GPL
|
||||
Q
|
||||
;
|
||||
RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
|
||||
; (ZOUT) BOTH ARE PASSED BY NAME
|
||||
; RNF1 IS OF THE FORM:
|
||||
; @ZIN@("VAR1")=VAL1
|
||||
; @ZIN@("VAR2")=VAL2
|
||||
; RNF2 IS OF THE FORM:
|
||||
; @ZOUT@("F","VAR1")=""
|
||||
; @ZOUT@("F","VAR2")=""
|
||||
; @ZOUT@("V",n,"VAR1")=VAL1
|
||||
; @ZOUT@("V",n,"VAR2")=VAL2
|
||||
; WHERE n IS THE "ROW" OF THE ARRAY
|
||||
N ZI S ZI=""
|
||||
N ZN
|
||||
I '$D(@ZOUT@("V",1)) S ZN=1
|
||||
E S ZN=$O(@ZOUT@("V",""),-1)+1
|
||||
F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
|
||||
. S @ZOUT@("F",ZI)=""
|
||||
. S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
|
||||
Q
|
||||
;
|
||||
RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
|
||||
; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
|
||||
; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
|
||||
; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
|
||||
; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV
|
||||
; WITH RNF2CSV
|
||||
; (ZOUT) BOTH ARE PASSED BY NAME
|
||||
; RNF1 IS OF THE FORM:
|
||||
; @ZIN@("VAR1")=VAL1
|
||||
; @ZIN@("VAR2")=VAL2
|
||||
; RNF2 IS OF THE FORM:
|
||||
; @ZOUT@("F","VAR1")=""
|
||||
; @ZOUT@("F","VAR2")=""
|
||||
; @ZOUT@("V",n,"VAR1",1)=VAL1
|
||||
; @ZOUT@("V",n,"VAR2",1)=VAL2
|
||||
; WHERE n IS THE "ROW" OF THE ARRAY
|
||||
N ZI S ZI=""
|
||||
N ZN
|
||||
I '$D(@ZOUT@("V",1)) S ZN=1
|
||||
E S ZN=$O(@ZOUT@("V",""),-1)+1
|
||||
F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
|
||||
. S @ZOUT@("F",ZI)=""
|
||||
. S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
|
||||
Q
|
||||
;
|
||||
; C0CFRTN IS PASSED BY NAME, C0CF IS PASSED BY VALUE
|
||||
;
|
||||
N C0CFI,C0CFJ ;INNER LOOP, OUTER LOOP
|
||||
N C0CFN ; FIELD NAME
|
||||
S C0CFI=0 S C0CFJ=C0CF
|
||||
K @C0CFRTN ; CLEAR THE RETURN ARRAY
|
||||
F Q:C0CFJ'[C0CF D ; FOR THE C0CF FILE AND ALL SUBFILES INCLUSIVE
|
||||
. ;W "1: "_C0CFJ," ",C0CFI,!
|
||||
. F S C0CFI=$O(^DD(C0CFJ,C0CFI)) Q:+C0CFI=0 D ; EVERY FIELD
|
||||
. . ;W "2: "_C0CFJ," ",C0CFI,!
|
||||
. . S C0CFN=$P($G(^DD(C0CFJ,C0CFI,0)),"^",1) ;PULL FIELD NAME FROM ^DD
|
||||
. . ;W "N: ",C0CFN,!
|
||||
. . ;I C0CFN="STR" W C0CFN," ",C0CFJ,!
|
||||
. . I $D(@C0CFRTN@(C0CFN)) D ; IS THIS A DUPLICATE?
|
||||
. . . I $G(DEBUG) D ;
|
||||
. . . . W "DUPLICATE FOUND! ",C0CFJ," ",C0CFI," ",C0CFN,!,@C0CFRTN@(C0CFN),!
|
||||
. . . S @C0CFRTN@(C0CFN_"_"_C0CFJ)=C0CFJ_"^"_C0CFI
|
||||
. . E S @C0CFRTN@(C0CFN)=C0CFJ_"^"_C0CFI
|
||||
. S C0CFJ=$O(^DD(C0CFJ)) ; NEXT SUBFILE
|
||||
Q
|
||||
;
|
||||
TESTRNF ; TEST THE RNF1TO2 ROUTINE
|
||||
S G1("ONE")=1
|
||||
S G1("TWO")=2
|
||||
S G1("THREE")=3
|
||||
D RNF1TO2("GPL","G1")
|
||||
S G1("ONE")="NOT1"
|
||||
S G1("TWO")="STILL2"
|
||||
S G1("THREE")=3
|
||||
D RNF1TO2("GPL","G1")
|
||||
ZWR GPL
|
||||
Q
|
||||
;
|
||||
RNF1TO2(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
|
||||
; (ZOUT) BOTH ARE PASSED BY NAME
|
||||
; RNF1 IS OF THE FORM:
|
||||
; @ZIN@("VAR1")=VAL1
|
||||
; @ZIN@("VAR2")=VAL2
|
||||
; RNF2 IS OF THE FORM:
|
||||
; @ZOUT@("F","VAR1")=""
|
||||
; @ZOUT@("F","VAR2")=""
|
||||
; @ZOUT@("V",n,"VAR1")=VAL1
|
||||
; @ZOUT@("V",n,"VAR2")=VAL2
|
||||
; WHERE n IS THE "ROW" OF THE ARRAY
|
||||
N ZI S ZI=""
|
||||
N ZN
|
||||
I '$D(@ZOUT@("V",1)) S ZN=1
|
||||
E S ZN=$O(@ZOUT@("V",""),-1)+1
|
||||
F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
|
||||
. S @ZOUT@("F",ZI)=""
|
||||
. S @ZOUT@("V",ZN,ZI)=@ZIN@(ZI)
|
||||
Q
|
||||
;
|
||||
RNF1TO2B(ZOUT,ZIN) ; ADDS AN RNF1 ARRAY (ZIN) TO THE END OF AN RNF2 ARRAY
|
||||
; THE "B" ROUTINE SUPPORTS WP FIELDS IN THE ARRAY
|
||||
; EVERY "V" VARIABLE IS FOLLOWED BY A "1"
|
||||
; FOR EXAMPLE @G@("V",n,"VAR1",1)="VALUE1"
|
||||
; USE THIS ROUTINE IF YOU WANT TO CONVERT THE RESULT TO A CSV
|
||||
; WITH RNF2CSV
|
||||
; (ZOUT) BOTH ARE PASSED BY NAME
|
||||
; RNF1 IS OF THE FORM:
|
||||
; @ZIN@("VAR1")=VAL1
|
||||
; @ZIN@("VAR2")=VAL2
|
||||
; RNF2 IS OF THE FORM:
|
||||
; @ZOUT@("F","VAR1")=""
|
||||
; @ZOUT@("F","VAR2")=""
|
||||
; @ZOUT@("V",n,"VAR1",1)=VAL1
|
||||
; @ZOUT@("V",n,"VAR2",1)=VAL2
|
||||
; WHERE n IS THE "ROW" OF THE ARRAY
|
||||
N ZI S ZI=""
|
||||
N ZN
|
||||
I '$D(@ZOUT@("V",1)) S ZN=1
|
||||
E S ZN=$O(@ZOUT@("V",""),-1)+1
|
||||
F S ZI=$O(@ZIN@(ZI)) Q:ZI="" D ;
|
||||
. S @ZOUT@("F",ZI)=""
|
||||
. S @ZOUT@("V",ZN,ZI,1)=@ZIN@(ZI)
|
||||
Q
|
||||
;
|
||||
GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
|
||||
; GRTN IS PASSED BY NAME
|
||||
;
|
||||
N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
|
||||
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
|
||||
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
|
||||
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
|
||||
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
|
||||
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
|
||||
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
|
||||
S (C0CI,C0CJ)=""
|
||||
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
|
||||
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
|
||||
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
|
||||
. . ;W C0CJ," ",C0CI,!
|
||||
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
|
||||
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
|
||||
. . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
|
||||
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
|
||||
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
|
||||
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
|
||||
Q
|
||||
;
|
||||
; GRTN IS PASSED BY NAME
|
||||
;
|
||||
N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
|
||||
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
|
||||
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
|
||||
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
|
||||
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
|
||||
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
|
||||
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
|
||||
S (C0CI,C0CJ)=""
|
||||
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
|
||||
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
|
||||
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
|
||||
. . ;W C0CJ," ",C0CI,!
|
||||
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
|
||||
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ;
|
||||
. . I C0CVALUE["C0CTMP" S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,1) ;1ST LINE OF WP
|
||||
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
|
||||
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
|
||||
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
|
||||
Q
|
||||
;
|
||||
GETN(GRTN,GFILE,GREF,GNDX,GNN) ; GET BY NAME ; RETURN A FIELD VALUE MAP
|
||||
; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
|
||||
; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
|
||||
; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
|
||||
; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
|
||||
; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
|
||||
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
|
||||
; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
|
||||
; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
|
||||
; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
|
||||
; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
|
||||
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
|
||||
; IF GREF IS "" THE FIRST RECORD IS OBTAINED
|
||||
; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
|
||||
; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
|
||||
; GREF IS THE VALUE FOR THE INDEX
|
||||
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
|
||||
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
|
||||
;
|
||||
;
|
||||
N GIEN,GF
|
||||
S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
|
||||
I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
|
||||
E D ; WE ARE USING AN INDEX
|
||||
. ;N ZG
|
||||
. S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
|
||||
. I ZG'="" D ;
|
||||
. . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
|
||||
. . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
|
||||
. . E S GIEN="" ; NOT FOUND IN INDEX
|
||||
. E S GIEN="" ;
|
||||
;W "IEN: ",GIEN,!
|
||||
;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
|
||||
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
|
||||
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
|
||||
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
|
||||
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
K C0CTMP
|
||||
D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
|
||||
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
|
||||
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
|
||||
S (C0CI,C0CJ)=""
|
||||
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
|
||||
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
|
||||
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
|
||||
. . ;W C0CJ," ",C0CI,!
|
||||
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
|
||||
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
|
||||
. . I C0CVALUE["C0CTMP" D ; WP FIELD
|
||||
. . . N ZT,ZWP S ZWP=0 ;ITERATOR
|
||||
. . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
|
||||
. . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
|
||||
. . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
|
||||
. . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
|
||||
. . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
|
||||
. . . . S C0CVALUE=C0CVALUE_ZT ;
|
||||
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
|
||||
. . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
|
||||
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
|
||||
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
|
||||
Q
|
||||
;
|
||||
; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
|
||||
; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
|
||||
; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
|
||||
; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
|
||||
; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
|
||||
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
|
||||
; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
|
||||
; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
|
||||
; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
|
||||
; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
|
||||
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
|
||||
; IF GREF IS "" THE FIRST RECORD IS OBTAINED
|
||||
; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
|
||||
; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
|
||||
; GREF IS THE VALUE FOR THE INDEX
|
||||
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
|
||||
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
|
||||
;
|
||||
;
|
||||
N GIEN,GF
|
||||
S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
|
||||
I ('$D(GNDX))!($G(GNDX)="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
|
||||
E D ; WE ARE USING AN INDEX
|
||||
. ;N ZG
|
||||
. S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
|
||||
. I ZG'="" D ;
|
||||
. . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
|
||||
. . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
|
||||
. . E S GIEN="" ; NOT FOUND IN INDEX
|
||||
. E S GIEN="" ;
|
||||
;W "IEN: ",GIEN,!
|
||||
;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
|
||||
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
|
||||
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
|
||||
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
|
||||
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
K C0CTMP
|
||||
D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
|
||||
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
|
||||
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
|
||||
S (C0CI,C0CJ)=""
|
||||
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
|
||||
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
|
||||
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
|
||||
. . ;W C0CJ," ",C0CI,!
|
||||
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
|
||||
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
|
||||
. . I C0CVALUE["C0CTMP" D ; WP FIELD
|
||||
. . . N ZT,ZWP S ZWP=0 ;ITERATOR
|
||||
. . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
|
||||
. . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
|
||||
. . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
|
||||
. . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
|
||||
. . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
|
||||
. . . . S C0CVALUE=C0CVALUE_ZT ;
|
||||
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
|
||||
. . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
|
||||
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
|
||||
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
|
||||
Q
|
||||
;
|
||||
GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
|
||||
; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
|
||||
; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
|
||||
; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
|
||||
; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
|
||||
; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
|
||||
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
|
||||
; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
|
||||
; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
|
||||
; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
|
||||
; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
|
||||
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
|
||||
; IF GREF IS "" THE FIRST RECORD IS OBTAINED
|
||||
; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
|
||||
; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
|
||||
; GREF IS THE VALUE FOR THE INDEX
|
||||
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
|
||||
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
|
||||
;
|
||||
;
|
||||
N GIEN,GF
|
||||
S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
|
||||
I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
|
||||
E D ; WE ARE USING AN INDEX
|
||||
. ;N ZG
|
||||
. S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
|
||||
. I ZG'="" D ;
|
||||
. . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
|
||||
. . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
|
||||
. . E S GIEN="" ; NOT FOUND IN INDEX
|
||||
. E S GIEN="" ;
|
||||
;W "IEN: ",GIEN,!
|
||||
;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
|
||||
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
|
||||
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
|
||||
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
|
||||
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
K C0CTMP
|
||||
D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
|
||||
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
|
||||
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
|
||||
S (C0CI,C0CJ)=""
|
||||
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
|
||||
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
|
||||
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
|
||||
. . ;W C0CJ," ",C0CI,!
|
||||
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
|
||||
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
|
||||
. . I C0CVALUE["C0CTMP" D ; WP FIELD
|
||||
. . . N ZT,ZWP S ZWP=0 ;ITERATOR
|
||||
. . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
|
||||
. . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
|
||||
. . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
|
||||
. . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
|
||||
. . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
|
||||
. . . . S C0CVALUE=C0CVALUE_ZT ;
|
||||
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
|
||||
. . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
|
||||
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
|
||||
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
|
||||
Q
|
||||
;
|
||||
; THE FOLLOWING COMMENTS ARE WRONG.. THIS ROUTINE STILL RETURNS AN RNF1
|
||||
; FORMAT ARRAY @GRTN@("FIELD NAME")="FILE^FIELD#^VALUE" ;GPL
|
||||
; GETN IS AN EXTRINSIC WHICH RETURNS THE NEXT IEN AFTER THE CURRENT GIEN
|
||||
; GRTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
|
||||
; .. FIELD MAP @GRTN@("F","FIELDNAME^FILE^FIELD#")=""
|
||||
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
|
||||
; .. VALUE MAP @GRTN@("V","IEN","FIELDNAME")=VALUE
|
||||
; .. GRTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
|
||||
; .. IF GNN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
|
||||
; .. EVEN IF GNN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
|
||||
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
|
||||
; IF GREF IS "" THE FIRST RECORD IS OBTAINED
|
||||
; IF GNDX IS NULL, GREF IS AN IEN FOR THE FILE
|
||||
; GNDX IS THE INDEX TO USE TO OBTAIN THE IEN
|
||||
; GREF IS THE VALUE FOR THE INDEX
|
||||
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
|
||||
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GRTN
|
||||
;
|
||||
;
|
||||
N GIEN,GF
|
||||
S GF=$$FILEREF(GFILE) ;CLOSED FILE REFERENCE FOR FILE NUMBER GFILE
|
||||
I ('$D(GNDX))!(GNDX="") S GIEN=GREF ; IF NO INDEX USED, GREF IS THE IEN
|
||||
E D ; WE ARE USING AN INDEX
|
||||
. ;N ZG
|
||||
. S ZG=$Q(@GF@(GNDX,GREF)) ;ACCESS INDEX
|
||||
. I ZG'="" D ;
|
||||
. . I $QS(ZG,3)=GREF D ; IS GREF IN INDEX?
|
||||
. . . S GIEN=$QS(ZG,4) ; PULL OUT THE IEN
|
||||
. . E S GIEN="" ; NOT FOUND IN INDEX
|
||||
. E S GIEN="" ;
|
||||
;W "IEN: ",GIEN,!
|
||||
;N C0CTMP,C0CI,C0CJ,C0CREF,C0CNAME
|
||||
I $D(GNN) I GNN="ALL" S C0CNN=0 ; NOT NON-NULL (ALL FIELDS TO BE RETURNED)
|
||||
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
|
||||
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
|
||||
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
K C0CTMP
|
||||
D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
|
||||
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
|
||||
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
|
||||
S (C0CI,C0CJ)=""
|
||||
F S C0CJ=$O(C0CTMP(C0CJ)) Q:C0CJ="" D ; FOR ALL SUBFILES
|
||||
. S C0CREF=$O(C0CTMP(C0CJ,"")) ; RECORD REFERENCE
|
||||
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
|
||||
. . ;W C0CJ," ",C0CI,!
|
||||
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
|
||||
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
|
||||
. . I C0CVALUE["C0CTMP" D ; WP FIELD
|
||||
. . . N ZT,ZWP S ZWP=0 ;ITERATOR
|
||||
. . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
|
||||
. . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ; INIT TO FIRST LINE
|
||||
. . . F S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) Q:'ZWP D ;
|
||||
. . . . S ZT=" "_C0CTMP(C0CJ,C0CREF,C0CI,ZWP) ;LINE OF WP
|
||||
. . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
|
||||
. . . . S C0CVALUE=C0CVALUE_ZT ;
|
||||
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3
|
||||
. . S $P(@GRTN@(C0CNAME,"I"),"^",3)=$G(C0CTMP(C0CJ,C0CREF,C0CI,"I"))
|
||||
I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
|
||||
. S C0CI=""
|
||||
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
|
||||
. . I $P(@GRTN@(C0CI),"^",3)="" K @GRTN@(C0CI) ; KILL THE NULL ENTRIES
|
||||
Q
|
||||
;
|
||||
GETN2(GARTN,GAFILE,GAIDX,GACNT,GASTRT,GANN) ; RETURN FIELD MAP AND VALUES
|
||||
; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
|
||||
; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
|
||||
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
|
||||
; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
|
||||
; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
|
||||
; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
|
||||
; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
|
||||
; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
|
||||
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
|
||||
; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
|
||||
; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
|
||||
; .. OF THE FILE WILL BE USED
|
||||
; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
|
||||
; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
|
||||
; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
|
||||
; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
|
||||
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
|
||||
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
|
||||
;N GATMP,GAI,GAF
|
||||
S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
|
||||
I '$D(GAIDX) S GAIDX="" ;DEFAULT
|
||||
I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
|
||||
I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
|
||||
W GAF,!
|
||||
W $O(@GAF@(0)) ;
|
||||
S GAI=0 ;ITERATOR
|
||||
F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;
|
||||
. D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
|
||||
. N GAX S GAX=0
|
||||
. F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS
|
||||
. . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
|
||||
Q
|
||||
;
|
||||
; GARTN, PASSED BY NAME, RETURNS A FIELD MAP AND A VALUE MAP
|
||||
; .. FIELD MAP @GARTN@("F","FIELDNAME")="FILE;FIELD#"
|
||||
; ... ANY FIELD USED BY ANY RECORD PROCESSED IS IN THE FIELD MAP
|
||||
; .. VALUE MAP @GARTN@("V","IEN","FIELDNAME","N")=VALUE
|
||||
; .. WHERE N IS THE INDEX FOR MULTIPLES.. 1 FOR SINGLE VALUES
|
||||
; .. GARTN IS NOT INITIALIZED, SO MULTIPLE CALLS ARE CUMULATIVE
|
||||
; .. IF GANN="ALL" THEN ALL FIELDS FOR THE FILE ARE IN THE FIELD MAP
|
||||
; .. EVEN IF GANN="ALL" ONLY POPULATED FIELDS ARE RETURNED IN THE VALUE MAP
|
||||
; .. NUL FIELDS CAN BE DETERMINED BY CHECKING FIELD MAP - THIS SAVES SPACE
|
||||
; GAFILE IS THE FILE NUMBER TO BE PROCESSED. IT IS PASSED BY VALUE
|
||||
; GAIDX IS THE OPTIONAL INDEX TO USE IN THE FILE. IF GAIDX IS "" THE IEN
|
||||
; .. OF THE FILE WILL BE USED
|
||||
; GACNT IS THE NUMBER OF RECORDS TO PROCESS. IT IS PASSED BY VALUE
|
||||
; .. IF GARCNT IS NULL, ALL RECORDS ARE PROCESSED
|
||||
; GASTRT IS THE IEN OF THE FIRST RECORD TO PROCESS. IT IS PASSED BY VALUE
|
||||
; .. IF GARSTART IS NULL, PROCESSING STARTS AT THE FIRST RECORD
|
||||
; GANN= NOT NULL - IF GANN IS "ALL" THEN EVEN NULL FIELDS WILL BE RETURNED
|
||||
; OTHERWISE, ONLY POPULATED FIELDS ARE RETURNED IN GARFLD AND GARVAL
|
||||
;N GATMP,GAI,GAF
|
||||
S GAF=$$FILEREF(GAFILE) ; GET CLOSED ROOT FOR THE FILE NUMBER GAFILE
|
||||
I '$D(GAIDX) S GAIDX="" ;DEFAULT
|
||||
I '$D(GANN) S GANN="" ;DEFAULT ONLY POPULATED FIELDS RETURNED
|
||||
I GAIDX'="" S GAF=$NA(@GAF@(GAIDX)) ; IF WE ARE USING AN INDEX
|
||||
W GAF,!
|
||||
W $O(@GAF@(0)) ;
|
||||
S GAI=0 ;ITERATOR
|
||||
F S GAI=$O(@GAF@(GAI)) Q:GAI="" D ;
|
||||
. D GETN1("GATMP",GAFILE,GAI,GAIDX,GANN) ;GET ONE RECORD
|
||||
. N GAX S GAX=0
|
||||
. F S GAX=$O(GATMP(GAX)) Q:GAX="" D ;PULL OUT THE FIELDS
|
||||
. . D ADDNV(GARTN,GAI,GAX,GATMP(GAX)) ;INSERT THE NAME/VALUE INTO GARTN
|
||||
Q
|
||||
;
|
||||
ADDNV(GNV,GNVN,GNVF,GNVV) ; CREATE AN ELEMENT OF THE MATRIX
|
||||
;
|
||||
S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
|
||||
S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
|
||||
Q
|
||||
;
|
||||
;
|
||||
S @GNV@("F",GNVF)=$P(GNVV,"^",1)_"^"_$P(GNVV,"^",2) ;NAME=FILE^FIELD#
|
||||
S @GNV@("V",GNVN,GNVF,1)=$P(GNVV,"^",3) ;SET THE VALUE
|
||||
Q
|
||||
;
|
||||
RNF2CSV(RNRTN,RNIN,RNSTY) ;CONVERTS AN RFN2 GLOBAL TO A CSV FORMAT
|
||||
; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
|
||||
; RNSTY IS STYLE OF THE OUTPUT -
|
||||
; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
|
||||
; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
|
||||
; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
|
||||
N RNR,RNC ;ROW ROOT,COL ROOT
|
||||
N RNI,RNJ,RNX
|
||||
I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
|
||||
I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
|
||||
E D VN(RNRTN,RNIN) ;
|
||||
Q
|
||||
;
|
||||
; READY TO WRITE FOR USE WITH EXCEL @RNRTN@(0) IS NUMBER OF LINES
|
||||
; RNSTY IS STYLE OF THE OUTPUT -
|
||||
; .. "NV"= ROWS ARE NAMES, COLUMNS ARE VALUES
|
||||
; .. "VN"= ROWS ARE VALUES, COLUMNS ARE NAMES
|
||||
; .. DEFAULT IS "NV" BECAUSE MANY MATRICES HAVE MORE FIELDS THAN VALUES
|
||||
N RNR,RNC ;ROW ROOT,COL ROOT
|
||||
N RNI,RNJ,RNX
|
||||
I '$D(RNSTY) S RNSTY="NV" ;DEFAULT
|
||||
I RNSTY="NV" D NV(RNRTN,RNIN) ; INTERNAL SUBROUTINES DEPENDING ON ORIENTATION
|
||||
E D VN(RNRTN,RNIN) ;
|
||||
Q
|
||||
;
|
||||
NV(RNRTN,RNIN) ;
|
||||
S RNR=$NA(@RNIN@("F"))
|
||||
S RNC=$NA(@RNIN@("V"))
|
||||
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
|
||||
S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
|
||||
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
|
||||
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
|
||||
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
|
||||
. S RNJ=""
|
||||
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
|
||||
. . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN
|
||||
. . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
|
||||
. . E S RNX=RNX_"," ; NUL COLUMN
|
||||
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
. D PUSH^C0CXPATH(RNRTN,RNX)
|
||||
Q
|
||||
;
|
||||
S RNR=$NA(@RNIN@("F"))
|
||||
S RNC=$NA(@RNIN@("V"))
|
||||
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
|
||||
S RNX="""FILE"""_"," ; FIRST COLUMN NAME IS "FIELD"
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
|
||||
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
|
||||
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
|
||||
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
|
||||
. S RNJ=""
|
||||
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
|
||||
. . I $D(@RNC@(RNJ,RNI,1)) D ; THIS ROW HAS THIS COLUMN
|
||||
. . . S RNX=RNX_""""_@RNC@(RNJ,RNI,1)_""""_"," ; ADD THE ELEMENT PLUS A COMMA
|
||||
. . E S RNX=RNX_"," ; NUL COLUMN
|
||||
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
. D PUSH^C0CXPATH(RNRTN,RNX)
|
||||
Q
|
||||
;
|
||||
VN(RNRTN,RNIN) ;
|
||||
S RNR=$NA(@RNIN@("V"))
|
||||
S RNC=$NA(@RNIN@("F"))
|
||||
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
|
||||
S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
|
||||
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
|
||||
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
|
||||
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
|
||||
. S RNJ=""
|
||||
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
|
||||
. . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN
|
||||
. . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
|
||||
. . . S RNV=$TR(RNV,",","")
|
||||
. . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
|
||||
. . E S RNX=RNX_"," ; NUL COLUMN
|
||||
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
. D PUSH^C0CXPATH(RNRTN,RNX)
|
||||
Q
|
||||
;
|
||||
READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
|
||||
;
|
||||
Q $$FTG^%ZISH(PATH,NAME,GLB,1)
|
||||
;
|
||||
S RNR=$NA(@RNIN@("V"))
|
||||
S RNC=$NA(@RNIN@("F"))
|
||||
;S RNY=$P(@RNIN@(0),"^",1) ; FILE NUMBER
|
||||
S RNX="""ROW"""_"," ; FIRST COLUMN NAME IS "ROW"
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNC@(RNI)) Q:RNI="" D ; FOR EACH COLUMN
|
||||
. S RNX=RNX_RNI_"," ;ADD THE COLUMM ELEMENT AND A COMMA
|
||||
S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
D PUSH^C0CXPATH(RNRTN,RNX) ; FIRST LINE CONTAINS COLUMN HEADINGS
|
||||
S RNI=""
|
||||
F S RNI=$O(@RNR@(RNI)) Q:RNI="" D ; FOR EACH ROW
|
||||
. S RNX=""""_RNI_""""_"," ; FIRST ELEMENT ON ROW IS THE FIELD
|
||||
. S RNJ=""
|
||||
. F S RNJ=$O(@RNC@(RNJ)) Q:RNJ="" D ; FOR EACH COL
|
||||
. . I $D(@RNR@(RNI,RNJ,1)) D ; THIS ROW HAS THIS COLUMN
|
||||
. . . S RNV=$TR(@RNR@(RNI,RNJ,1),"""","")
|
||||
. . . S RNV=$TR(RNV,",","")
|
||||
. . . S RNX=RNX_""""_RNV_""""_"," ; ADD THE ELEMENT PLUS A COMMA
|
||||
. . E S RNX=RNX_"," ; NUL COLUMN
|
||||
. S RNX=$E(RNX,1,$L(RNX)-1) ; STRIP OFF THE LAST COMMA
|
||||
. D PUSH^C0CXPATH(RNRTN,RNX)
|
||||
Q
|
||||
;
|
||||
READCSV(PATH,NAME,GLB) ; READ A CSV FILE IN FROM UNIX TO GLB, PASSED BY NAME
|
||||
;
|
||||
Q $$FTG^%ZISH(PATH,NAME,GLB,1)
|
||||
;
|
||||
FILE2CSV(FNUM,FVN) ; WRITES OUT A FILEMAN FILE TO CSV
|
||||
;
|
||||
;N G1,G2
|
||||
I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
|
||||
S G1=$NA(^TMP($J,"C0CCSV",1))
|
||||
S G2=$NA(^TMP($J,"C0CCSV",2))
|
||||
D GETN2(G1,FNUM) ; GET THE MATRIX
|
||||
D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
|
||||
K @G1
|
||||
D FILEOUT(G2,"FILE_"_FNUM_".csv")
|
||||
K @G2
|
||||
Q
|
||||
;
|
||||
;
|
||||
;N G1,G2
|
||||
I '$D(FVN) S FVN="NV" ; DEFAULT ORIENTATION OF CVS FILE
|
||||
S G1=$NA(^TMP($J,"C0CCSV",1))
|
||||
S G2=$NA(^TMP($J,"C0CCSV",2))
|
||||
D GETN2(G1,FNUM) ; GET THE MATRIX
|
||||
D RNF2CSV(G2,G1,FVN) ; PREPARE THE CVS FILE
|
||||
K @G1
|
||||
D FILEOUT(G2,"FILE_"_FNUM_".csv")
|
||||
K @G2
|
||||
Q
|
||||
;
|
||||
FILEOUT(FOARY,FONAM) ; WRITE OUT A FILE
|
||||
;
|
||||
W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))
|
||||
Q
|
||||
;
|
||||
;
|
||||
W $$OUTPUT^C0CXPATH($NA(@FOARY@(1)),FONAM,^TMP("C0CCCR","ODIR"))
|
||||
Q
|
||||
;
|
||||
FILEREF(FNUM) ; EXTRINSIC THAT RETURNS A CLOSED ROOT FOR FILE NUMBER FNUM
|
||||
;
|
||||
N C0CF
|
||||
S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
|
||||
S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
|
||||
I C0CF["()" S C0CF=$P(C0CF,"()",1)
|
||||
Q C0CF
|
||||
;
|
||||
;
|
||||
N C0CF
|
||||
S C0CF=^DIC(FNUM,0,"GL") ;OPEN ROOT TO FILE
|
||||
S C0CF=$P(C0CF,",",1)_")" ; CLOSE THE ROOT
|
||||
I C0CF["()" S C0CF=$P(C0CF,"()",1)
|
||||
Q C0CF
|
||||
;
|
||||
SKIP ;
|
||||
N TXT,DIERR
|
||||
S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
|
||||
I $D(DIERR) D CLEAN^DILF Q
|
||||
W " report_text:",! ;Progress Note Text
|
||||
N LN S LN=0
|
||||
F S LN=$O(TXT(LN)) Q:'LN D
|
||||
. W " text"_LN_": "_TXT(LN),!
|
||||
. Q
|
||||
Q
|
||||
;
|
||||
RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
|
||||
; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
|
||||
; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
|
||||
; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES
|
||||
D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
|
||||
N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
|
||||
D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
|
||||
F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
|
||||
. S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
|
||||
. D PUSH^C0CXPATH(ZOUT,ZV)
|
||||
D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
|
||||
S ZI=""
|
||||
F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
|
||||
. S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
|
||||
. D PUSH^C0CXPATH(ZOUT,ZN)
|
||||
. S ZJ=0 ;RESET TO DO IT AGAIN
|
||||
. F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
|
||||
. . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
|
||||
. . D PUSH^C0CXPATH(ZOUT,ZV)
|
||||
. D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
|
||||
D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
|
||||
Q
|
||||
;
|
||||
RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
|
||||
; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
|
||||
; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
|
||||
; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES
|
||||
D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
|
||||
N ZI,ZJ S ZI="" S ZJ=0
|
||||
D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
|
||||
F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
|
||||
. S ZV="<td>"_ZI_"</td>"
|
||||
. D PUSH^C0CXPATH(ZOUT,ZV) ; name
|
||||
D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
|
||||
S ZI="" ;RESET TO DO AGAIN
|
||||
F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH ROW OF VARIABLES
|
||||
. D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
|
||||
. F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
|
||||
. . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
|
||||
. . D PUSH^C0CXPATH(ZOUT,ZV) ; value
|
||||
. D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
|
||||
D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
|
||||
Q
|
||||
;
|
||||
N TXT,DIERR
|
||||
S TXT=$$GET1^DIQ(8925,TIUIEN,"2","","TXT")
|
||||
I $D(DIERR) D CLEAN^DILF Q
|
||||
W " report_text:",! ;Progress Note Text
|
||||
N LN S LN=0
|
||||
F S LN=$O(TXT(LN)) Q:'LN D
|
||||
. W " text"_LN_": "_TXT(LN),!
|
||||
. Q
|
||||
Q
|
||||
;
|
||||
RNF2HNV(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
|
||||
; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
|
||||
; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
|
||||
; THE TABLE WILL BE IN NV FORMAT, ROWS ARE NAMES COLUMNS ARE VALUES
|
||||
D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
|
||||
N ZI,ZJ,ZV,ZN S ZI="" S ZJ=0
|
||||
D PUSH^C0CXPATH(ZOUT,"<tr><td></td>") ;begin row and leave a blank col
|
||||
F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
|
||||
. S ZV="<td>"_ZJ_"</td>" ; OCCURANCE AS COLUMNS HEADER
|
||||
. D PUSH^C0CXPATH(ZOUT,ZV)
|
||||
D PUSH^C0CXPATH(ZOUT,"</tr>") ;end of first row
|
||||
S ZI=""
|
||||
F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
|
||||
. S ZN="<tr><td>"_ZI_"</td>" ; VARIABLE NAME IN FIRST COLUMN
|
||||
. D PUSH^C0CXPATH(ZOUT,ZN)
|
||||
. S ZJ=0 ;RESET TO DO IT AGAIN
|
||||
. F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH OCCURANCE
|
||||
. . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>"
|
||||
. . D PUSH^C0CXPATH(ZOUT,ZV)
|
||||
. D PUSH^C0CXPATH(ZOUT,"</tr>") ;END OF ROW
|
||||
D PUSH^C0CXPATH(ZOUT,"</table>") ; end of table
|
||||
Q
|
||||
;
|
||||
RNF2HVN(ZOUT,ZIN) ;RETURN AN HTML TABLE IN ZOUT, PASSED BY NAME
|
||||
; OF ZIN, WHICH IS PASSED BY NAME AND IS IN RNF2 FORMAT
|
||||
; ZOUT IS NOT INITIALIZED, SO THE TABLE WILL GO AT THE END
|
||||
; THE TABLE WILL BE IN VN FORMAT, ROWS ARE VALUES COLUMNS ARE NAMES
|
||||
D PUSH^C0CXPATH(ZOUT,"<table border=""1"">")
|
||||
N ZI,ZJ S ZI="" S ZJ=0
|
||||
D PUSH^C0CXPATH(ZOUT,"<tr>") ;new row for column headers
|
||||
F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
|
||||
. S ZV="<td>"_ZI_"</td>"
|
||||
. D PUSH^C0CXPATH(ZOUT,ZV) ; name
|
||||
D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header row
|
||||
S ZI="" ;RESET TO DO AGAIN
|
||||
F S ZJ=$O(@ZIN@("V",ZJ)) Q:+ZJ=0 D ; FOR EACH ROW OF VARIABLES
|
||||
. D PUSH^C0CXPATH(ZOUT,"<tr>") ;begin row
|
||||
. F S ZI=$O(@ZIN@("F",ZI)) Q:ZI="" D ; FOR EACH VARIABLE
|
||||
. . S ZV="<td>"_$G(@ZIN@("V",ZJ,ZI,1))_"</td>" ; value
|
||||
. . D PUSH^C0CXPATH(ZOUT,ZV) ; value
|
||||
. D PUSH^C0CXPATH(ZOUT,"</tr>") ; end header
|
||||
D PUSH^C0CXPATH(ZOUT,"</table>") ;end of table
|
||||
Q
|
||||
;
|
||||
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P(@ZTAB@(ZFN),"^",1)
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P(@ZTAB@(ZFN),"^",1)
|
||||
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P(@ZTAB@(ZFN),"^",2)
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P(@ZTAB@(ZFN),"^",2)
|
||||
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P($G(@ZTAB@(ZFN)),"^",3)
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P($G(@ZTAB@(ZFN)),"^",3)
|
||||
;
|
||||
ZVALUEI(ZFN,ZTAB) ;EXTRINSIC TO RETURN INTERNAL VALUE FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF @ZTAB@(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
Q $P($G(@ZTAB@(ZFN,"I")),"^",3)
|
||||
;
|
||||
|
|
564
p/C0CRXN.m
564
p/C0CRXN.m
|
@ -1,290 +1,290 @@
|
|||
C0CRXN ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR RXNORM Utility Library ",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR RXNORM Utility Library ",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
EXPAND ; MAIN ROUTINE TO CREATE THE C0C RXNORM VUID EXPANSION FILE (176.112)
|
||||
; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM
|
||||
; CODE FROM 176.001 (RXNORM CONCEPTS)
|
||||
; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT
|
||||
; ALREADY HAVE AN RXNORM CODE.
|
||||
; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111)
|
||||
; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE
|
||||
; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES
|
||||
; USES SUPPORT ROUTINES FROM C0CRNF.m
|
||||
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
|
||||
N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
|
||||
N C0CF ; CLOSED ROOT FOR DESTINATION FILE
|
||||
S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
|
||||
S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
|
||||
S C0CF=$$FILEREF^C0CRNF(176.112) ; C0C RXNORM VUID MAPPING EXPANSION FILE
|
||||
W C0CVA,C0CFRXN,C0CF,!
|
||||
S C0CZX=0
|
||||
S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS
|
||||
F S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0 D ; FOR EVERY RECORD
|
||||
. K C0CA,C0CB,C0CC ; CLEAR ARRAYS
|
||||
. D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE
|
||||
. D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS
|
||||
. I $$ZVALUE("MEDIATION CODE")="" D
|
||||
. . S NORXN=NORXN+1 ;
|
||||
. E D ; PROCESS MEDIATION CODE
|
||||
. . S HASRXN=HASRXN+1
|
||||
. . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
|
||||
. I $$ZVALUE("VUID")="" D ; BAD RECORD
|
||||
. . S NOVUID=NOVUID+1
|
||||
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
||||
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
||||
. . ;ZWR C0CA
|
||||
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
||||
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
||||
. . S RXFOUND=RXFOUND+1
|
||||
. . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
|
||||
. . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
|
||||
. . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
|
||||
. . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
|
||||
. . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
|
||||
. . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
|
||||
. . E D ;
|
||||
. . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB")
|
||||
. . . D PUSH^GPLXPATH("NOMATCH",ZZ)
|
||||
. . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
|
||||
. . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
|
||||
. I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;
|
||||
. . S RXMATCH=RXMATCH+1
|
||||
. . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
|
||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
||||
. D UPDATE^DIE("","C0CFDA")
|
||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
||||
W "HAS RXN=",HASRXN,!
|
||||
W "NO RXN=",NORXN,!
|
||||
W "NO VUID=",NOVUID,!
|
||||
W "RXNORM FOUND=",RXFOUND,!
|
||||
W "RXNORM MATCHES:",RXMATCH,!
|
||||
W "TEXT MATCHES:",TXTMATCH,!
|
||||
Q
|
||||
;
|
||||
; READ EACH RECORD FROM 176.111 AND USE THE VUID TO LOOK UP THE RXNORM
|
||||
; CODE FROM 176.001 (RXNORM CONCEPTS)
|
||||
; POPULATE ALL FIELDS IN 176.112 AND SET "NEW" TO "Y" IF 176.111 DOES NOT
|
||||
; ALREADY HAVE AN RXNORM CODE.
|
||||
; ADD THE RXNORM TEXT FIELD TO EVERY RECORD (NOT PRESENT IN 176.111)
|
||||
; AND COMPARE THE RXNORM TEXT FIELD WITH THE VUID TEXT FIELD, SETTING THE
|
||||
; "DIFFERENT TEXT" FIELD TO "Y" IF THERE ARE DIFFERENCES
|
||||
; USES SUPPORT ROUTINES FROM C0CRNF.m
|
||||
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
|
||||
N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
|
||||
N C0CF ; CLOSED ROOT FOR DESTINATION FILE
|
||||
S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
|
||||
S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
|
||||
S C0CF=$$FILEREF^C0CRNF(176.112) ; C0C RXNORM VUID MAPPING EXPANSION FILE
|
||||
W C0CVA,C0CFRXN,C0CF,!
|
||||
S C0CZX=0
|
||||
S (HASRXN,NORXN,NOVUID,RXFOUND,RXMATCH,TXTMATCH)=0 ; INITIALIZE COUNTERS
|
||||
F S C0CZX=$O(^C0CCODES(176.111,C0CZX)) Q:+C0CZX=0 D ; FOR EVERY RECORD
|
||||
. K C0CA,C0CB,C0CC ; CLEAR ARRAYS
|
||||
. D FIELDS^C0CRNF("C0CC",176.112) ;GET FIELD NAMES FOR OUTPUT FILE
|
||||
. D GETN1^C0CRNF("C0CA",176.111,C0CZX,"","ALL") ;GET THE FIELDS
|
||||
. I $$ZVALUE("MEDIATION CODE")="" D
|
||||
. . S NORXN=NORXN+1 ;
|
||||
. E D ; PROCESS MEDIATION CODE
|
||||
. . S HASRXN=HASRXN+1
|
||||
. . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
|
||||
. I $$ZVALUE("VUID")="" D ; BAD RECORD
|
||||
. . S NOVUID=NOVUID+1
|
||||
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
||||
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
||||
. . ;ZWR C0CA
|
||||
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
||||
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
||||
. . S RXFOUND=RXFOUND+1
|
||||
. . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
|
||||
. . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
|
||||
. . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
|
||||
. . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
|
||||
. . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
|
||||
. . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
|
||||
. . E D ;
|
||||
. . . S ZZ=$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB")
|
||||
. . . D PUSH^GPLXPATH("NOMATCH",ZZ)
|
||||
. . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
|
||||
. . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
|
||||
. I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;
|
||||
. . S RXMATCH=RXMATCH+1
|
||||
. . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
|
||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
||||
. D UPDATE^DIE("","C0CFDA")
|
||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
||||
W "HAS RXN=",HASRXN,!
|
||||
W "NO RXN=",NORXN,!
|
||||
W "NO VUID=",NOVUID,!
|
||||
W "RXNORM FOUND=",RXFOUND,!
|
||||
W "RXNORM MATCHES:",RXMATCH,!
|
||||
W "TEXT MATCHES:",TXTMATCH,!
|
||||
Q
|
||||
;
|
||||
EXP2 ; ROUTINE TO CREATE 176.113 C0C RXNORM VUID MAPPING DISCREPANCIES FILE
|
||||
; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST
|
||||
; THE UMLS RXNORM DATABASE
|
||||
; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT
|
||||
; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF
|
||||
; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN
|
||||
; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED
|
||||
; IN THE FILE BUT NO FLAGS ARE SET
|
||||
; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N
|
||||
; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT
|
||||
; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE
|
||||
; DRUG INGREDIENT FILE IS USED FOR COMPARISONS)
|
||||
; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N
|
||||
; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM
|
||||
; CODE IS MISSING IN THAT FILE, VARXN=N
|
||||
; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS
|
||||
; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING
|
||||
; RXNORM TEXT=RXNORM TEXT STRING
|
||||
; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID
|
||||
; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE
|
||||
; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE
|
||||
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
|
||||
N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
|
||||
N C0CF ; CLOSED ROOT FOR DESTINATION FILE
|
||||
S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
|
||||
S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
|
||||
;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
|
||||
W C0CVA,C0CFRXN,! ;C0CF,!
|
||||
S C0CZX=0
|
||||
S (NDFVCNT,NDFTCNT,NDFNO)=0 ; COUNTERS FOR NDF TESTS
|
||||
S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS
|
||||
F S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
|
||||
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
|
||||
. D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
|
||||
. D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE
|
||||
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE
|
||||
. D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF
|
||||
. D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS
|
||||
. ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE
|
||||
. D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE
|
||||
. D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT
|
||||
. ;VA MAPPING FILE TESTS
|
||||
. I $$ZVALUE("VUID","C0CB")=C0CZX D ; VUID FOUND
|
||||
. . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT
|
||||
. . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D ;TEXT MISMATCH
|
||||
. . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT
|
||||
. . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH
|
||||
. . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT
|
||||
. E D ; VUID NOT FOUND
|
||||
. . S VANO=VANO+1
|
||||
. . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE
|
||||
. ; NATIONAL DRUG FILE TESTS
|
||||
. I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D ;
|
||||
. . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE
|
||||
. . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT
|
||||
. . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D ;NDF TEXT DOESN'T MATCH
|
||||
. . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D ;DRUG ING FILE ALSO
|
||||
. . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT
|
||||
. . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N
|
||||
. . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT
|
||||
. . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT
|
||||
. E D ;
|
||||
. . D SETFDA("NDF","N") ;MARK AS MISSING
|
||||
. . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT
|
||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
. S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
|
||||
. D UPDATE^DIE("","C0CFDA")
|
||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
||||
W "VA MAPPING VUID COUNT: ",VAVCNT,!
|
||||
W "VA MAPPING MISSING: ",VANO,!
|
||||
W "VA MAPPING TEXT MISMATCH: ",VATCNT,!
|
||||
W "NDF VUID COUNT: ",NDFVCNT,!
|
||||
W "NDF MISSING: ",NDFNO,!
|
||||
W "NDF TEXT MISMATCH: ",NDFTCNT,!
|
||||
Q
|
||||
; CROSS CHECKS THE NATIONAL DRUG FILE AND THE VA MAPPING FILE AGAINST
|
||||
; THE UMLS RXNORM DATABASE
|
||||
; THIS ROUTINE HAS BEEN ENHANCED TO ALSO CHECK THE 50.416 DRUG INGREDIENT
|
||||
; FILE AND TREAT VUIDS FOUND THERE LIKE THE ONES BEING FOUND IN THE NDF
|
||||
; IF THE VUID EXISISTS IN ALL THREE FILES, THE RXNORM CODE MATCHES IN
|
||||
; THE VA MAPPING FILE AND THE TEXT STRINGS ARE THE SAME, THE VUID IS INCLUDED
|
||||
; IN THE FILE BUT NO FLAGS ARE SET
|
||||
; IF THE VUID IS MISSING FROM THE NATIONAL DRUG FILE NDF=N
|
||||
; (IF THE VUID IS MISSING FROM THE NDF, IT IS CHECKED IN THE DRUG INGREDIENT
|
||||
; FILE, AND IF FOUND, THE FLAG IS NOT SET. IN THIS CASE THE TEXT FROM THE
|
||||
; DRUG INGREDIENT FILE IS USED FOR COMPARISONS)
|
||||
; IF THE VUID IS MISSING FROM THE VA MAPPING FILE VAMAP=N
|
||||
; IF THE VUID IS PRESENT IN THE VA MAPPING FILE, BUT THE RXNORM
|
||||
; CODE IS MISSING IN THAT FILE, VARXN=N
|
||||
; IF THE TEXT STRINGS DO NOT MATCH EXACTLY, TXTM=N AND ALL THREE STRINGS
|
||||
; ARE SHOWN; NDF TEXT=NDF TEXT STRING, VA MAP TEXT=VA MAPPING TEXT STRING
|
||||
; RXNORM TEXT=RXNORM TEXT STRING
|
||||
; THE FILE IS KEYED ON VUID AND WOULD USUALLY BE SORTED BY VUID
|
||||
; THE OBJECTIVE IS TO SEE IF NDF (50.68) AND VA MAPPING (176.111) HAVE
|
||||
; ALL THE VUID CODES THAT ARE IN THE UMLS RXNORM DATABASE
|
||||
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
|
||||
N C0CFVA,C0CFRXN ; CLOSED ROOTS FOR SOURCE FILES
|
||||
N C0CF ; CLOSED ROOT FOR DESTINATION FILE
|
||||
S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
|
||||
S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
|
||||
;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
|
||||
W C0CVA,C0CFRXN,! ;C0CF,!
|
||||
S C0CZX=0
|
||||
S (NDFVCNT,NDFTCNT,NDFNO)=0 ; COUNTERS FOR NDF TESTS
|
||||
S (VAVCNT,VATCNT,VARCNT,VANO)=0 ; COUNTERS FOR VA MAPPING FILE TESTS
|
||||
F S C0CZX=$O(^C0CRXN(176.001,"VUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
|
||||
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
|
||||
. D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
|
||||
. D GETN1^C0CRNF("C0CA",176.001,C0CZX,"VUID","ALL") ;GET FROM RXNORM FILE
|
||||
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;GET FROM VA MAPPING FILE
|
||||
. D GETN1^C0CRNF("C0CD",50.68,C0CZX,"AVUID","ALL") ;GET FROM NDF
|
||||
. D GETN1^C0CRNF("C0CE",50.416,C0CZX,"AVUID","ALL") ;GET FROM DRUG INGREDIENTS
|
||||
. ;D SETFDA("VUID",$$ZVALUE("CODE")) ;SET THE VUID CODE
|
||||
. D SETFDA("RXNORM",$$ZVALUE("RXCUI")) ;SET THE RXNORM CODE
|
||||
. D SETFDA("RXNORM TEXT",$$ZVALUE("STR")) ;SET THE RXNORM TEXT
|
||||
. ;VA MAPPING FILE TESTS
|
||||
. I $$ZVALUE("VUID","C0CB")=C0CZX D ; VUID FOUND
|
||||
. . S VAVCNT=VAVCNT+1 ;INCREMENT COUNT
|
||||
. . I $$ZVALUE("STR")'=$$ZVALUE("VUID TEXT","C0CB") D ;TEXT MISMATCH
|
||||
. . . S VATCNT=VATCNT+1 ; INCREMENT VA TEXT MISMATCH COUNT
|
||||
. . . D SETFDA("TXTM","N") ;MARK THAT TEXT DOESN'T MATCH
|
||||
. . . D SETFDA("VA MAP TEXT",$$ZVALUE("VUID TEXT","C0CB")) ; SET VA MAP TEXT
|
||||
. E D ; VUID NOT FOUND
|
||||
. . S VANO=VANO+1
|
||||
. . D SETFDA("VAMAP","N") ;MARK AS MISSING FROM VA MAPPING FILE
|
||||
. ; NATIONAL DRUG FILE TESTS
|
||||
. I ($$ZVALUE("VUID","C0CD")=C0CZX)!($$ZVALUE("VUID","C0CE")=C0CZX) D ;
|
||||
. . ;FOUND IN NATIONAL DRUG FILE OR DRUG INGREDIENT FILE
|
||||
. . S NDFVCNT=NDFVCNT+1 ;INCREMENT VUID FOUND COUNT
|
||||
. . I $$ZVALUE("NAME","C0CD")'=$$ZVALUE("STR") D ;NDF TEXT DOESN'T MATCH
|
||||
. . . I $$ZVALUE("NAME","C0CE")'=$$ZVALUE("STR") D ;DRUG ING FILE ALSO
|
||||
. . . . S NDFTCNT=NDFTCNT+1 ; INCREMENT MISMATCHED NDF TEXT COUNT
|
||||
. . . . D SETFDA("TXTM","N") ; SET TEXT MATCH FLAG TO N
|
||||
. . . . D SETFDA("NDF TEXT",$$ZVALUE("NAME","C0CD")) ;POST THE TEXT
|
||||
. . . . D SETFDA("NAT DRUG TEXT",$$ZVALUE("NAME","C0CE")) ;POST TEXT
|
||||
. E D ;
|
||||
. . D SETFDA("NDF","N") ;MARK AS MISSING
|
||||
. . S NDFNO=NDFNO+1 ;INCREMENT MISSING COUNT
|
||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
. S C0CFDA(176.113,"+"_C0CZX_",",.01)=C0CZX ; NEW VUID RECORD
|
||||
. D UPDATE^DIE("","C0CFDA")
|
||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
||||
W "VA MAPPING VUID COUNT: ",VAVCNT,!
|
||||
W "VA MAPPING MISSING: ",VANO,!
|
||||
W "VA MAPPING TEXT MISMATCH: ",VATCNT,!
|
||||
W "NDF VUID COUNT: ",NDFVCNT,!
|
||||
W "NDF MISSING: ",NDFNO,!
|
||||
W "NDF TEXT MISMATCH: ",NDFTCNT,!
|
||||
Q
|
||||
CHKNDF ; ROUTINE TO CHECK THE NATIONAL DRUG FILE WITH THE UMLS RXNORM DB
|
||||
; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),
|
||||
; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD
|
||||
; IN 176.114
|
||||
; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE
|
||||
; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH
|
||||
; ALSO CAPTURES THE RXNORM CODE MAPPING
|
||||
; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX
|
||||
; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT
|
||||
; SETS NOTMAPPED=Y
|
||||
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
|
||||
N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES
|
||||
N C0CF ; CLOSED ROOT FOR DESTINATION FILE
|
||||
S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE
|
||||
S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
|
||||
S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
|
||||
;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
|
||||
W C0CVA,C0CFRXN,! ;C0CF,!
|
||||
S C0CZX=0
|
||||
S (FOUND,MISSING)=0
|
||||
S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS
|
||||
F S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
|
||||
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
|
||||
. ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
|
||||
. D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS
|
||||
. I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN
|
||||
. . S NOVUID=NOVUID+1 ; FLAG THE ERROR
|
||||
. . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID
|
||||
. D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB
|
||||
. I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM
|
||||
. . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM
|
||||
. . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D ;TEXT MATCHES
|
||||
. . . S TXTMATCH=TXTMATCH+1 ; COUNT IT
|
||||
. . E D ; TEXT DOESN'T MATCH
|
||||
. . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER
|
||||
. . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD")
|
||||
. . . W ZV,!
|
||||
. . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH
|
||||
. E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM
|
||||
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111
|
||||
. I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND
|
||||
. . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),!
|
||||
. . S MISSING=MISSING+1
|
||||
. . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE
|
||||
. E D ; FOUND IN VA MAPPING FILE
|
||||
. . S FOUND=FOUND+1
|
||||
. . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D ; TEXT DOESN'T MATCH
|
||||
. . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF
|
||||
. . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS
|
||||
. . . W "VA: ",ZY,!
|
||||
. . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT
|
||||
W "MISSING IN MAPPING FILE: ",MISSING,!
|
||||
W "FOUND IN MAPPING FILE: ",FOUND,!
|
||||
W "FOUND IN RXNORM: ",VMATCH,!
|
||||
W "NOT FOUND IN RXNORM: ",NOMATCH,!
|
||||
W "ERRORS: ",NOVUID,!
|
||||
Q
|
||||
;
|
||||
. I $$ZVALUE("MEDIATION CODE")="" D
|
||||
. . S NORXN=NORXN+1 ;
|
||||
. E D ; PROCESS MEDIATION CODE
|
||||
. . S HASRXN=HASRXN+1
|
||||
. . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
|
||||
. I $$ZVALUE("VUID")="" D ; BAD RECORD
|
||||
. . S NOVUID=NOVUID+1
|
||||
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
||||
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
||||
. . ;ZWR C0CA
|
||||
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
||||
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
||||
. . S RXFOUND=RXFOUND+1
|
||||
. . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
|
||||
. . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
|
||||
. . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
|
||||
. . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
|
||||
. . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
|
||||
. . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
|
||||
. . E D ;
|
||||
. . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB"))
|
||||
. . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
|
||||
. . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
|
||||
. I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;
|
||||
. . S RXMATCH=RXMATCH+1
|
||||
. . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
|
||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
||||
. D UPDATE^DIE("","C0CFDA")
|
||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
||||
W "HAS RXN=",HASRXN,!
|
||||
W "NO RXN=",NORXN,!
|
||||
W "NO VUID=",NOVUID,!
|
||||
W "RXNORM FOUND=",RXFOUND,!
|
||||
W "RXNORM MATCHES:",RXMATCH,!
|
||||
W "TEXT MATCHES:",TXTMATCH,!
|
||||
Q
|
||||
; USING THE AVUID INDEX, READS ALL VUID CODES IN ^PSNDF(50.68),
|
||||
; CHECKS TO SEE IF THE CODE IS IN 176.001, AND CREATES A RECORD
|
||||
; IN 176.114
|
||||
; THE OBJECTIVE IS TO SEE IF ^PSNDF(50.68) HAS ALL THE VUID CODES IN THE
|
||||
; UMLS RXNORM DATABASE AND IF THE TEXT FIELDS MATCH
|
||||
; ALSO CAPTURES THE RXNORM CODE MAPPING
|
||||
; CHKNDF2 WILL CHECK THE OTHER DIRECTION, STARTING WITH THE 176.001 VUID INDEX
|
||||
; THIS ROUTINE ALSO CHECKS IF THE VUID CODE IS IN 176.111 AND IF NOT
|
||||
; SETS NOTMAPPED=Y
|
||||
N C0CFDA,C0CA,C0CB,C0CC,C0CZX ;FDA WORK ARRAY, RNF ARRAYS, AND IEN ITERATOR
|
||||
N C0CFVA,C0CFRXN,C0CPSNDF ; CLOSED ROOTS FOR SOURCE FILES
|
||||
N C0CF ; CLOSED ROOT FOR DESTINATION FILE
|
||||
S C0CPSNDF=$$FILEREF^C0CRNF(50.68) ; NDF CLOSED ROOT REFERENCE
|
||||
S C0CVA=$$FILEREF^C0CRNF(176.111) ; C0C PHARMACY VA RXNORM MAPPING FILE
|
||||
S C0CFRXN=$$FILEREF^C0CRNF(176.001) ; CLOSED ROOT FOR RXNORM CONCEPT FILE
|
||||
;S C0CF=$$FILEREF^C0CRNF(176.113) ; C0C RXNORM VUID MAPPING ADDITIONAL FILE
|
||||
W C0CVA,C0CFRXN,! ;C0CF,!
|
||||
S C0CZX=0
|
||||
S (FOUND,MISSING)=0
|
||||
S (NOVUID,VMATCH,NOMATCH,MISSING,FOUND,TXTMATCH,NOTM,NVAM)=0 ; COUNTERS
|
||||
F S C0CZX=$O(^PSNDF(50.68,"AVUID",C0CZX)) Q:+C0CZX=0 D ; FOR EVERY VUID
|
||||
. K C0CA,C0CB,C0CC,C0CD ; CLEAR ARRAYS
|
||||
. ;D FIELDS^C0CRNF("C0CC",176.113) ;GET FIELD NAMES FOR OUTPUT FILE
|
||||
. D GETN1^C0CRNF("C0CA",50.68,C0CZX,"AVUID","ALL") ;GET THE FIELDS
|
||||
. I $$ZVALUE("VUID")="" D ; ERROR, SHOULD NOT HAPPEN
|
||||
. . S NOVUID=NOVUID+1 ; FLAG THE ERROR
|
||||
. . D PUSH^GPLXPATH("NOVUID",C0CZX) ; RECORD THE VUID
|
||||
. D GETN1^C0CRNF("C0CD",176.001,C0CZX,"VUID","ALL") ;TRY RXNORM DB
|
||||
. I $$ZVALUE("CODE","C0CD")=C0CZX D ; FOUND IN RXNORM
|
||||
. . S VMATCH=VMATCH+1 ; COUNT OF PSNDF VUIDS FOUND IN RXNORM
|
||||
. . I $$ZVALUE("NAME")=$$ZVALUE("STR","C0CD") D ;TEXT MATCHES
|
||||
. . . S TXTMATCH=TXTMATCH+1 ; COUNT IT
|
||||
. . E D ; TEXT DOESN'T MATCH
|
||||
. . . S NOTM=NOTM+1 ;NO TEXT MATCH COUNTER
|
||||
. . . S ZV=$$ZVALUE("NAME")_"^"_$$ZVALUE("STR","C0CD")
|
||||
. . . W ZV,!
|
||||
. . . D PUSH^GPLXPATH("TXTNM",ZV) ; RECORD THE TXT MISMATCH
|
||||
. E S NOMATCH=NOMATCH+1 ; NOT FOUND IN RXNORM
|
||||
. D GETN1^C0CRNF("C0CB",176.111,C0CZX,"B","ALL") ;TRY TO GET FROM 176.111
|
||||
. I $$ZVALUE("VUID","C0CB")="" D ; VUID NOT FOUND
|
||||
. . ;W "NOT FOUND: ",C0CZX," ",$$ZVALUE("STR")," ",$$ZVALUE("RXCUI"),!
|
||||
. . S MISSING=MISSING+1
|
||||
. . D PUSH^GPLXPATH("MISSING",C0CZX) ;MISSING FROM MAPPING FILE
|
||||
. E D ; FOUND IN VA MAPPING FILE
|
||||
. . S FOUND=FOUND+1
|
||||
. . I $$ZVALUE("VUID TEXT","C0CB")'=$$ZVALUE("NAME") D ; TEXT DOESN'T MATCH
|
||||
. . . S NVAM=NVAM+1 ; MAPPING FILE TEXT IS DIFFERENT THAN NDF
|
||||
. . . S ZY=$$ZVALUE("VUID TEXT","C0CB")_"^"_$$ZVALUE("NAME") ;BOTH STRINGS
|
||||
. . . W "VA: ",ZY,!
|
||||
. . . D PUSH^GPLXPATH("NVAM",ZY) ;SAVE IT
|
||||
W "MISSING IN MAPPING FILE: ",MISSING,!
|
||||
W "FOUND IN MAPPING FILE: ",FOUND,!
|
||||
W "FOUND IN RXNORM: ",VMATCH,!
|
||||
W "NOT FOUND IN RXNORM: ",NOMATCH,!
|
||||
W "ERRORS: ",NOVUID,!
|
||||
Q
|
||||
;
|
||||
. I $$ZVALUE("MEDIATION CODE")="" D
|
||||
. . S NORXN=NORXN+1 ;
|
||||
. E D ; PROCESS MEDIATION CODE
|
||||
. . S HASRXN=HASRXN+1
|
||||
. . D SETFDA("MEDIATION CODE",$$ZVALUE("MEDIATION CODE")) ;
|
||||
. I $$ZVALUE("VUID")="" D ; BAD RECORD
|
||||
. . S NOVUID=NOVUID+1
|
||||
. . ;D SETFDA("VUID",$$ZVALUE("VUID"))
|
||||
. E D SETFDA("VUID TEXT",$$ZVALUE("VUID TEXT"))
|
||||
. . ;ZWR C0CA
|
||||
. D GETN1^C0CRNF("C0CB",176.001,$$ZVALUE("VUID"),"VUID","ALL")
|
||||
. I $$ZVALUE("RXCUI","C0CB")'="" D ; RXNORM FOUND
|
||||
. . S RXFOUND=RXFOUND+1
|
||||
. . I $$ZVALUE("MEDIATION CODE")="" D ; THIS IS A NEW CODE
|
||||
. . . D SETFDA("MEDIATION CODE",$$ZVALUE("RXCUI","C0CB"))
|
||||
. . . D SETFDA("NEW","Y") ;FLAG RECORD HAS HAVING NEW RXNORM
|
||||
. . W "RXNORM=",$$ZVALUE("RXCUI","C0CB")," ",$$ZVALUE("STR","C0CB"),!
|
||||
. . W "VUID TEXT: ",$$ZVALUE("VUID TEXT"),!
|
||||
. . I $$ZVALUE("VUID TEXT")=$$ZVALUE("STR","C0CB") S TXTMATCH=TXTMATCH+1
|
||||
. . E D ;
|
||||
. . . D PUSH^GPLXPATH("NOMATCH",$$ZVALUE("VUID TEXT")_"^"_$$ZVALUE("STR","C0CB"))
|
||||
. . . D SETFDA("RXNORM TEXT",$$ZVALUE("STR","C0CB")) ;
|
||||
. . . D SETFDA("DIFFERENT TEXT","Y") ;FLAG RECORD FOR DIFFERENT TEXT
|
||||
. I $$ZVALUE("MEDIATION CODE")=$$ZVALUE("RXCUI","C0CB") D ;
|
||||
. . S RXMATCH=RXMATCH+1
|
||||
. . W "VUID=",$$ZVALUE("VUID")," MATCH RXNORM=",$$ZVALUE("MEDIATION CODE"),!
|
||||
. D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
|
||||
. S C0CFDA(176.112,"+"_C0CZX_",",.01)=$$ZVALUE("VUID") ; NEW VUID RECORD
|
||||
. D UPDATE^DIE("","C0CFDA")
|
||||
. I $D(^TMP("DIERR",$J)) U $P BREAK
|
||||
W "HAS RXN=",HASRXN,!
|
||||
W "NO RXN=",NORXN,!
|
||||
W "NO VUID=",NOVUID,!
|
||||
W "RXNORM FOUND=",RXFOUND,!
|
||||
W "RXNORM MATCHES:",RXMATCH,!
|
||||
W "TEXT MATCHES:",TXTMATCH,!
|
||||
Q
|
||||
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CA,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,"+"_C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
|
|
544
p/C0CSOAP.m
544
p/C0CSOAP.m
|
@ -1,273 +1,273 @@
|
|||
C0CSOAP ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is an SOAP utility library",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
TEST1
|
||||
S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl"
|
||||
D GET1URL^C0CEWD2(url)
|
||||
Q
|
||||
;
|
||||
INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing
|
||||
; ARY is passed by name
|
||||
S @ARY@("XML FILE NUMBER")="178.301"
|
||||
S @ARY@("BINDING SUBFILE NUMBER")="178.3014"
|
||||
S @ARY@("MIME TYPE")="2.3"
|
||||
S @ARY@("PROXY SERVER")="2.4"
|
||||
S @ARY@("REPLY TEMPLATE")=".03"
|
||||
S @ARY@("TEMPLATE NAME")=".01"
|
||||
S @ARY@("TEMPLATE XML")="3"
|
||||
S @ARY@("URL")="1"
|
||||
S @ARY@("WSDL URL")="2"
|
||||
S @ARY@("XML")="2.1"
|
||||
S @ARY@("XML HEADER")="2.2"
|
||||
S @ARY@("XPATH REDUCTION STRING")="2.5"
|
||||
S @ARY@("CCR VARIABLE")="4"
|
||||
S @ARY@("FILEMAN FIELD NAME")="1"
|
||||
S @ARY@("FILEMAN FIELD NUMBER")="1.2"
|
||||
S @ARY@("FILEMAN FILE POINTER")="1.1"
|
||||
S @ARY@("INDEXED BY")=".05"
|
||||
S @ARY@("SQLI FIELD NAME")="3"
|
||||
S @ARY@("VARIABLE NAME")="2"
|
||||
Q
|
||||
;
|
||||
RESTID(INNAM,INFARY) ;EXTRINSIC TO RESOLVE TEMPLATE PASSED BY NAME
|
||||
; FILE IS IDENTIFIED IN FARY, PASSED BY NAME
|
||||
I '$D(INFARY) D ; NO FILE ARRAY PASSED
|
||||
. S INFARY="FARY"
|
||||
. D INITFARY(INFARY)
|
||||
N ZN,ZREF,ZR
|
||||
S ZN=@INFARY@("XML FILE NUMBER")
|
||||
S ZREF=$$FILEREF^C0CRNF(ZN)
|
||||
S ZR=$O(@ZREF@("B",INNAM,""))
|
||||
Q ZR
|
||||
;
|
||||
TESTSOAP ;
|
||||
; USING ICD9 WEB SERVICE TO TEST SOAP
|
||||
S G("CODE")="E*"
|
||||
S G("CODELN")=3
|
||||
D SOAP("GPL","ICD9","G")
|
||||
Q
|
||||
;
|
||||
SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) ; MAKES A SOAP CALL FOR
|
||||
; TEMPLATE ID C0CTID
|
||||
; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME
|
||||
; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND
|
||||
; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED
|
||||
; BEFORE MAPPING
|
||||
; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND
|
||||
; ALTXML WILL BE USED INSTEAD
|
||||
;
|
||||
; ARTIFACTS SECTION
|
||||
; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
|
||||
; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
|
||||
; WILL NOT BE NEWED.
|
||||
I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
|
||||
S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")=""
|
||||
S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")=""
|
||||
S C0CV(300,"HEADER","SOAP HEADER")=""
|
||||
S C0CV(400,"C0CMIME","MIME TYPE")=""
|
||||
S C0CV(500,"C0CURL","WS URL")=""
|
||||
S C0CV(550,"C0CPURL","PROXY URL")=""
|
||||
S C0CV(600,"C0CXML","XML VARIABLE NAME")=""
|
||||
S C0CV(700,"XML","OUTBOUND XML")=""
|
||||
S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
|
||||
S C0CV(900,"C0CRHDR","RETURNED HEADER")=""
|
||||
S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")=""
|
||||
S C0CV(1100,"C0CR","REPLY TEMPLATE")=""
|
||||
S C0CV(1200,"C0CREDUX","REDUX STRING")=""
|
||||
S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")=""
|
||||
S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")=""
|
||||
S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")=""
|
||||
S C0CV(1600,"C0CID","RESULT DOM ID")=""
|
||||
I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
|
||||
N ZI,ZJ S ZI=""
|
||||
NEW
|
||||
S ZI=$O(C0CV(ZI))
|
||||
S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND
|
||||
;W ZJ,!
|
||||
N @ZJ ; NEW THE VARIABLE
|
||||
I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
|
||||
NOTNEW
|
||||
; END ARTIFACTS
|
||||
;
|
||||
I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS
|
||||
E D ;
|
||||
. K C0CF
|
||||
. M C0CF=@IFARY
|
||||
S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE
|
||||
I +C0CTID=0 D ; A STRING WAS PASSED FOR THE TEMPLATE NAME
|
||||
. S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME
|
||||
E S C0CUTID=C0CTID ; AN IEN WAS PASSED
|
||||
N XML,TEMPLATE,HEADER
|
||||
N C0CFH S C0CFH=C0CF("XML HEADER")
|
||||
S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER")
|
||||
N C0CFM S C0CFM=C0CF("MIME TYPE")
|
||||
S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM)
|
||||
N C0CFP S C0CFP=C0CF("PROXY SERVER")
|
||||
S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP)
|
||||
N C0CFU S C0CFU=C0CF("URL")
|
||||
S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU)
|
||||
N C0CFX S C0CFX=C0CF("XML")
|
||||
S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML")
|
||||
N C0CFT S C0CFT=C0CF("TEMPLATE XML")
|
||||
S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE")
|
||||
I C0CTMPL="TEMPLATE" D ; there is a template to process
|
||||
. K XML ; going to replace the xml array
|
||||
. N VARS
|
||||
. I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides
|
||||
. I '$D(ALTXML) D ; if ALTXML is passed in, don't bind
|
||||
. . D BIND("VARS",C0CVA,C0CUTID,"C0CF")
|
||||
. . D MAP("XML","VARS",TPTR,"C0CF")
|
||||
. . K XML(0)
|
||||
. E M XML=@ALTXML ; use ALTXML instead
|
||||
I $G(C0CPROXY) S C0CURL=C0CPURL
|
||||
K C0CRSLT,C0CRHDR
|
||||
B
|
||||
S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR)
|
||||
K C0CRXML
|
||||
D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY
|
||||
N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE"))
|
||||
S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE
|
||||
; reply templates are optional and are specified by populating a
|
||||
; template pointer in field 2.5 of the request template
|
||||
; if specified, the reply template is the source of the REDUX string
|
||||
; used for XPath on the reply, and for UNBIND processing
|
||||
; if no reply template is specified, REDUX is obtained from the request
|
||||
; template and no UNBIND processing is performed. The XPath array is
|
||||
; returned without variable bindings
|
||||
I C0CR'="" D ; REPLY TEMPLATE EXISTS
|
||||
. I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,!
|
||||
. S C0CTID=C0CR ;
|
||||
N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING")
|
||||
S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING
|
||||
K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS
|
||||
S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM
|
||||
S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER
|
||||
S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE
|
||||
D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR
|
||||
; Next, call UNBIND to map the reply XPath array to variables
|
||||
; This is only done if a Reply Template is provided
|
||||
D DEMUXARY(C0CRTN,"C0CARY")
|
||||
; M @C0CRTN=C0CARY
|
||||
Q
|
||||
;
|
||||
DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
|
||||
; FORMAT @OARY@(x,xpath) where x is the first multiple
|
||||
N ZI,ZJ,ZK,ZL S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3)
|
||||
. S ZK=$RE($P($RE(ZK),"/",1))
|
||||
. S ZL=$P(ZJ,"^",1)
|
||||
. I ZL="" S ZL=1
|
||||
. S @OARY@(ZL,ZK)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
|
||||
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
|
||||
;
|
||||
N ZI,ZN,ZTMP
|
||||
S ZN=1
|
||||
S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
|
||||
S ZN=ZN+1
|
||||
F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ;
|
||||
. S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
|
||||
. S ZN=ZN+1
|
||||
Q
|
||||
;
|
||||
MAP(RARY,IVARS,TPTR,INFARY) ;RETURNS MAPPED XML IN RARY PASSED BY NAME
|
||||
; IVARS IS AN XPATH ARRAY PASSED BY NAME
|
||||
; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE
|
||||
;
|
||||
N ZT ;THE TEMPLATE
|
||||
K ZT,@RARY
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY"
|
||||
. D INITFARY(INFARY)
|
||||
N ZF,ZFT
|
||||
S ZF=@INFARY@("XML FILE NUMBER")
|
||||
S ZFT=@INFARY@("TEMPLATE XML")
|
||||
I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D Q ; ERROR GETTING TEMPLATE
|
||||
. W "ERROR RETRIEVING TEMPLATE",!
|
||||
D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING
|
||||
Q
|
||||
;
|
||||
TESTBIND ;
|
||||
S G1("TESTONE")=1
|
||||
S G1("TESTTWO")=2
|
||||
D BIND("G","G1","TEST")
|
||||
W !
|
||||
ZWR G
|
||||
Q
|
||||
;
|
||||
BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP
|
||||
; TO BUILD AN INSTANTIATED TEMPLATE
|
||||
; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE
|
||||
; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND
|
||||
; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES
|
||||
; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY"
|
||||
. D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED
|
||||
I +INTPTR>0 S TPTR=INTPTR
|
||||
E S TPTR=$$RESTID(INTPTR,INFARY)
|
||||
N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF
|
||||
S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file
|
||||
S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file
|
||||
S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER
|
||||
S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings
|
||||
I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index
|
||||
; this needs to be a whole file index on the XPath subfile with
|
||||
; the Template IEN perceding the XPath in the index
|
||||
N ZI
|
||||
S ZI=""
|
||||
S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is
|
||||
;F S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI="" D ; FOR EACH XPATH
|
||||
F S ZI=$O(@C0CXREF@(ZI)) Q:ZI="" D ; for each XPath in this template
|
||||
. ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,""))
|
||||
. N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;
|
||||
. S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD
|
||||
. N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER")
|
||||
. S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I")
|
||||
. N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER")
|
||||
. S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I")
|
||||
. N ZFV S ZFV=@INFARY@("VARIABLE NAME")
|
||||
. S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E")
|
||||
. N ZFX S ZFX=("INDEXED BY")
|
||||
. S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I")
|
||||
. S ZINDEX=""
|
||||
. I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ
|
||||
. I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN
|
||||
. E I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable
|
||||
. ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT
|
||||
. ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION
|
||||
. I ZVAR'="" D ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS
|
||||
. . S @RARY@(ZI)=@IVARS@(ZVAR) ;
|
||||
. E D ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN
|
||||
. . I (ZFILE="")!(ZFIELD="") Q ;QUIT IF FILE OR FIELD NOT THERE
|
||||
. . D CLEAN^DILF
|
||||
. . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE
|
||||
. . I $D(^TMP("DIERR",$J,1)) D B ;
|
||||
. . . W "ERROR!",!
|
||||
. . . ZWR ^TMP("DIERR",$J,*)
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is an SOAP utility library",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
TEST1
|
||||
S url="https://ec2-75-101-247-83.compute-1.amazonaws.com:8181/ccr/CCRService?wsdl"
|
||||
D GET1URL^C0CEWD2(url)
|
||||
Q
|
||||
;
|
||||
INITFARY(ARY) ;initialize the Fileman Field array for SOAP processing
|
||||
; ARY is passed by name
|
||||
S @ARY@("XML FILE NUMBER")="178.301"
|
||||
S @ARY@("BINDING SUBFILE NUMBER")="178.3014"
|
||||
S @ARY@("MIME TYPE")="2.3"
|
||||
S @ARY@("PROXY SERVER")="2.4"
|
||||
S @ARY@("REPLY TEMPLATE")=".03"
|
||||
S @ARY@("TEMPLATE NAME")=".01"
|
||||
S @ARY@("TEMPLATE XML")="3"
|
||||
S @ARY@("URL")="1"
|
||||
S @ARY@("WSDL URL")="2"
|
||||
S @ARY@("XML")="2.1"
|
||||
S @ARY@("XML HEADER")="2.2"
|
||||
S @ARY@("XPATH REDUCTION STRING")="2.5"
|
||||
S @ARY@("CCR VARIABLE")="4"
|
||||
S @ARY@("FILEMAN FIELD NAME")="1"
|
||||
S @ARY@("FILEMAN FIELD NUMBER")="1.2"
|
||||
S @ARY@("FILEMAN FILE POINTER")="1.1"
|
||||
S @ARY@("INDEXED BY")=".05"
|
||||
S @ARY@("SQLI FIELD NAME")="3"
|
||||
S @ARY@("VARIABLE NAME")="2"
|
||||
Q
|
||||
;
|
||||
RESTID(INNAM,INFARY) ;EXTRINSIC TO RESOLVE TEMPLATE PASSED BY NAME
|
||||
; FILE IS IDENTIFIED IN FARY, PASSED BY NAME
|
||||
I '$D(INFARY) D ; NO FILE ARRAY PASSED
|
||||
. S INFARY="FARY"
|
||||
. D INITFARY(INFARY)
|
||||
N ZN,ZREF,ZR
|
||||
S ZN=@INFARY@("XML FILE NUMBER")
|
||||
S ZREF=$$FILEREF^C0CRNF(ZN)
|
||||
S ZR=$O(@ZREF@("B",INNAM,""))
|
||||
Q ZR
|
||||
;
|
||||
TESTSOAP ;
|
||||
; USING ICD9 WEB SERVICE TO TEST SOAP
|
||||
S G("CODE")="E*"
|
||||
S G("CODELN")=3
|
||||
D SOAP("GPL","ICD9","G")
|
||||
Q
|
||||
;
|
||||
SOAP(C0CRTN,C0CTID,C0CVA,C0CVOR,ALTXML,IFARY) ; MAKES A SOAP CALL FOR
|
||||
; TEMPLATE ID C0CTID
|
||||
; RETURNS THE XML RESULT IN C0CRTN, PASSED BY NAME
|
||||
; C0CVA IS PASSED BY NAME AND IS THE VARIABLE ARRAY TO PASS TO BIND
|
||||
; C0CVOR IS THE NAME OF A VARIABLE OVERRIDE ARRAY, WHICH IS APPLIED
|
||||
; BEFORE MAPPING
|
||||
; IF ALTXML IS PASSED, BIND AND MAP WILL BE SKIPPED AND
|
||||
; ALTXML WILL BE USED INSTEAD
|
||||
;
|
||||
; ARTIFACTS SECTION
|
||||
; THE FOLLOWING WILL SET UP DEBUGGING ARTIFACTS FOR A POSSIBLE FUTURE
|
||||
; ONLINE DEBUGGER. IF DEBUG=1, VARIABLES CONTAINING INTERMEDIATE RESULTS
|
||||
; WILL NOT BE NEWED.
|
||||
I $G(WSDEBUG)="" N C0CV ; CATALOG OF ARTIFACT VARIABLES AND ARRAYS
|
||||
S C0CV(100,"C0CXF","XML TEMPLATE FILE NUMBER")=""
|
||||
S C0CV(200,"C0CHEAD","SOAP HEADER VARIABLE NAME")=""
|
||||
S C0CV(300,"HEADER","SOAP HEADER")=""
|
||||
S C0CV(400,"C0CMIME","MIME TYPE")=""
|
||||
S C0CV(500,"C0CURL","WS URL")=""
|
||||
S C0CV(550,"C0CPURL","PROXY URL")=""
|
||||
S C0CV(600,"C0CXML","XML VARIABLE NAME")=""
|
||||
S C0CV(700,"XML","OUTBOUND XML")=""
|
||||
S C0CV(800,"C0CRSLT","RAW XML RESULT RETURNED FROM WEB SERVICE")=""
|
||||
S C0CV(900,"C0CRHDR","RETURNED HEADER")=""
|
||||
S C0CV(1000,"C0CRXML","XML RESULT NORMALIZED")=""
|
||||
S C0CV(1100,"C0CR","REPLY TEMPLATE")=""
|
||||
S C0CV(1200,"C0CREDUX","REDUX STRING")=""
|
||||
S C0CV(1300,"C0CIDX","RESULT XPATH INDEX")=""
|
||||
S C0CV(1400,"C0CARY","RESULT XPATH ARRAY")=""
|
||||
S C0CV(1500,"C0CNOM","RESULT DOM DOCUMENT NAME")=""
|
||||
S C0CV(1600,"C0CID","RESULT DOM ID")=""
|
||||
I $G(DEBUG)'="" G NOTNEW ; SKIP NEWING THE VARIABLES IF IN DEBUG
|
||||
N ZI,ZJ S ZI=""
|
||||
NEW
|
||||
S ZI=$O(C0CV(ZI))
|
||||
S ZJ=$O(C0CV(ZI,"")) ; SET UP NEW COMMAND
|
||||
;W ZJ,!
|
||||
N @ZJ ; NEW THE VARIABLE
|
||||
I $O(C0CV(ZI))'="" G NEW ;LOOP TO GET NEW IN CONTEXT
|
||||
NOTNEW
|
||||
; END ARTIFACTS
|
||||
;
|
||||
I '$D(IFARY) D INITFARY("C0CF") ; SET FILE NUMBER AND PARAMATERS
|
||||
E D ;
|
||||
. K C0CF
|
||||
. M C0CF=@IFARY
|
||||
S C0CXF=C0CF("XML FILE NUMBER") ; FILE NUMBER FOR THE XML TEMPLATE FILE
|
||||
I +C0CTID=0 D ; A STRING WAS PASSED FOR THE TEMPLATE NAME
|
||||
. S C0CUTID=$$RESTID(C0CTID,"C0CF") ;RESOLVE TEMPLATE IEN FROM NAME
|
||||
E S C0CUTID=C0CTID ; AN IEN WAS PASSED
|
||||
N XML,TEMPLATE,HEADER
|
||||
N C0CFH S C0CFH=C0CF("XML HEADER")
|
||||
S C0CHEAD=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFH,,"HEADER")
|
||||
N C0CFM S C0CFM=C0CF("MIME TYPE")
|
||||
S C0CMIME=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFM)
|
||||
N C0CFP S C0CFP=C0CF("PROXY SERVER")
|
||||
S C0CPURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFP)
|
||||
N C0CFU S C0CFU=C0CF("URL")
|
||||
S C0CURL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFU)
|
||||
N C0CFX S C0CFX=C0CF("XML")
|
||||
S C0CXML=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFX,,"XML")
|
||||
N C0CFT S C0CFT=C0CF("TEMPLATE XML")
|
||||
S C0CTMPL=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFT,,"TEMPLATE")
|
||||
I C0CTMPL="TEMPLATE" D ; there is a template to process
|
||||
. K XML ; going to replace the xml array
|
||||
. N VARS
|
||||
. I $D(C0CVOR) M @C0CVA=@C0CVOR ; merge in varible overrides
|
||||
. I '$D(ALTXML) D ; if ALTXML is passed in, don't bind
|
||||
. . D BIND("VARS",C0CVA,C0CUTID,"C0CF")
|
||||
. . D MAP("XML","VARS",TPTR,"C0CF")
|
||||
. . K XML(0)
|
||||
. E M XML=@ALTXML ; use ALTXML instead
|
||||
I $G(C0CPROXY) S C0CURL=C0CPURL
|
||||
K C0CRSLT,C0CRHDR
|
||||
B
|
||||
S ok=$$httpPOST^%zewdGTM(C0CURL,.XML,C0CMIME,.C0CRSLT,.HEADER,"",.gpl5,.C0CRHDR)
|
||||
K C0CRXML
|
||||
D NORMAL("C0CRXML","C0CRSLT(1)") ;RETURN XML IN AN ARRAY
|
||||
N C0CFR S C0CFR=$G(C0CF("REPLY TEMPLATE"))
|
||||
S C0CR=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFR,"I") ; REPLY TEMPLATE
|
||||
; reply templates are optional and are specified by populating a
|
||||
; template pointer in field 2.5 of the request template
|
||||
; if specified, the reply template is the source of the REDUX string
|
||||
; used for XPath on the reply, and for UNBIND processing
|
||||
; if no reply template is specified, REDUX is obtained from the request
|
||||
; template and no UNBIND processing is performed. The XPath array is
|
||||
; returned without variable bindings
|
||||
I C0CR'="" D ; REPLY TEMPLATE EXISTS
|
||||
. I +$G(DEBUG)'=0 W "REPLY TEMPLATE:",C0CR,!
|
||||
. S C0CTID=C0CR ;
|
||||
N C0CFRDX S C0CFRDX=C0CF("XPATH REDUCTION STRING")
|
||||
S C0CREDUX=$$GET1^DIQ(C0CXF,C0CUTID_",",C0CFRDX) ;XPATH REDUCTION STRING
|
||||
K C0CIDX,C0CARY ; XPATH INDEX AND ARRAY VARS
|
||||
S C0CNOM="C0CWS"_$J ; DOCUMENT NAME FOR THE DOM
|
||||
S C0CID=$$PARSE^C0CXEWD("C0CRXML",C0CNOM) ;CALL THE PARSER
|
||||
S C0CID=$$FIRST^C0CXEWD($$ID^C0CXEWD(C0CNOM)) ;ID OF FIRST NODE
|
||||
D XPATH^C0CXEWD(C0CID,"/","C0CIDX","C0CARY","",C0CREDUX) ;XPATH GENERATOR
|
||||
; Next, call UNBIND to map the reply XPath array to variables
|
||||
; This is only done if a Reply Template is provided
|
||||
D DEMUXARY(C0CRTN,"C0CARY")
|
||||
; M @C0CRTN=C0CARY
|
||||
Q
|
||||
;
|
||||
DEMUXARY(OARY,IARY) ;CONVERT AN XPATH ARRAY PASSED AS IARY TO
|
||||
; FORMAT @OARY@(x,xpath) where x is the first multiple
|
||||
N ZI,ZJ,ZK,ZL S ZI=""
|
||||
F S ZI=$O(@IARY@(ZI)) Q:ZI="" D ;
|
||||
. D DEMUX^C0CMXP("ZJ",ZI)
|
||||
. S ZK=$P(ZJ,"^",3)
|
||||
. S ZK=$RE($P($RE(ZK),"/",1))
|
||||
. S ZL=$P(ZJ,"^",1)
|
||||
. I ZL="" S ZL=1
|
||||
. S @OARY@(ZL,ZK)=@IARY@(ZI)
|
||||
Q
|
||||
;
|
||||
NORMAL(OUTXML,INXML) ;NORMALIZES AN XML STRING PASSED BY NAME IN INXML
|
||||
; INTO AN XML ARRAY RETURNED IN OUTXML, ALSO PASSED BY NAME
|
||||
;
|
||||
N ZI,ZN,ZTMP
|
||||
S ZN=1
|
||||
S @OUTXML@(ZN)=$P(@INXML,"><",ZN)_">"
|
||||
S ZN=ZN+1
|
||||
F S @OUTXML@(ZN)="<"_$P(@INXML,"><",ZN) Q:$P(@INXML,"><",ZN+1)="" D ;
|
||||
. S @OUTXML@(ZN)=@OUTXML@(ZN)_">"
|
||||
. S ZN=ZN+1
|
||||
Q
|
||||
;
|
||||
MAP(RARY,IVARS,TPTR,INFARY) ;RETURNS MAPPED XML IN RARY PASSED BY NAME
|
||||
; IVARS IS AN XPATH ARRAY PASSED BY NAME
|
||||
; TPTR IS A POINT TO THE C0C XML TEMPLATE FILE USED TO RETRIEVE THE TEMPLATE
|
||||
;
|
||||
N ZT ;THE TEMPLATE
|
||||
K ZT,@RARY
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY"
|
||||
. D INITFARY(INFARY)
|
||||
N ZF,ZFT
|
||||
S ZF=@INFARY@("XML FILE NUMBER")
|
||||
S ZFT=@INFARY@("TEMPLATE XML")
|
||||
I $$GET1^DIQ(ZF,TPTR_",",ZFT,,"ZT")'="ZT" D Q ; ERROR GETTING TEMPLATE
|
||||
. W "ERROR RETRIEVING TEMPLATE",!
|
||||
D MAP^C0CXPATH("ZT",IVARS,RARY) ;DO THE MAPPING
|
||||
Q
|
||||
;
|
||||
TESTBIND ;
|
||||
S G1("TESTONE")=1
|
||||
S G1("TESTTWO")=2
|
||||
D BIND("G","G1","TEST")
|
||||
W !
|
||||
ZWR G
|
||||
Q
|
||||
;
|
||||
BIND(RARY,IVARS,INTPTR,INFARY) ;RETURNS AN XPATH ARRAY IN RARY FOR USE WITH MAP
|
||||
; TO BUILD AN INSTANTIATED TEMPLATE
|
||||
; TPTR IS THE IEN OF THE XML TEMPATE IN THE C0C XML TEMPLATE FILE
|
||||
; LOOPS THROUGHT THE BINDING SUBFILE TO PULL OUT XPATHS AND
|
||||
; EITHER ASSIGNS VARIABLES OR DOES A FILEMAN CALL TO GET VALUES
|
||||
; VARIABLES ARE IN IVARS WHICH IS PASSED BY NAME
|
||||
I '$D(INFARY) D ;
|
||||
. S INFARY="FARY"
|
||||
. D INITFARY(INFARY) ;INITIALIZE FILE ARRAY IF NOT PASSED
|
||||
I +INTPTR>0 S TPTR=INTPTR
|
||||
E S TPTR=$$RESTID(INTPTR,INFARY)
|
||||
N C0CFF,C0CBF,C0CXI,C0CFREF,C0CXREF
|
||||
S C0CFF=@INFARY@("XML FILE NUMBER") ;fileman file number of XML file
|
||||
S C0CFREF=$$FILEREF^C0CRNF(C0CFF) ; closed file reference to the file
|
||||
S C0CBF=@INFARY@("BINDING SUBFILE NUMBER") ; BINDING SUBFILE NUMBER
|
||||
S C0CXI=$G(@INFARY@("XPATH INDEX")) ; index to the XPath bindings
|
||||
I C0CXI="" S C0CXI="XPATH" ; default is the XPATH index
|
||||
; this needs to be a whole file index on the XPath subfile with
|
||||
; the Template IEN perceding the XPath in the index
|
||||
N ZI
|
||||
S ZI=""
|
||||
S C0CXREF=$NA(@C0CFREF@(C0CXI,TPTR)) ; where the xref is
|
||||
;F S ZI=$O(^C0CX(TPTR,5,"B",ZI)) Q:ZI="" D ; FOR EACH XPATH
|
||||
F S ZI=$O(@C0CXREF@(ZI)) Q:ZI="" D ; for each XPath in this template
|
||||
. ;W !,ZI," ",$O(@C0CXREF@(ZI,TPTR,""))
|
||||
. N ZIEN,ZFILE,ZFIELD,ZVAR,ZIDX,ZINDEX ;
|
||||
. S ZIEN=$O(@C0CXREF@(ZI,TPTR,"")) ; IEN OF THE BINDING RECORD
|
||||
. N ZFF S ZFF=@INFARY@("FILEMAN FILE POINTER")
|
||||
. S ZFILE=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFF,"I")
|
||||
. N ZFFLD S ZFFLD=@INFARY@("FILEMAN FIELD NUMBER")
|
||||
. S ZFIELD=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFFLD,"I")
|
||||
. N ZFV S ZFV=@INFARY@("VARIABLE NAME")
|
||||
. S ZVAR=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFV,"E")
|
||||
. N ZFX S ZFX=("INDEXED BY")
|
||||
. S ZIDX=$$GET1^DIQ(C0CBF,ZIEN_","_TPTR_",",ZFX,"I")
|
||||
. S ZINDEX=""
|
||||
. I ZIDX="DUZ" S ZINDEX=$G(DUZ) ; FILE IS INDEXED BY DUZ
|
||||
. I ZIDX="DFN" S ZINDEX=$G(DFN) ; BY DFN
|
||||
. E I ZIDX'="" S ZINDEX=$G(@ZIDX) ; index variable
|
||||
. ;I ZIDX="ACCT" S ZINDEX=C0CACCT ; BY ACCOUNT RECORD POINT TO C0C WS ACCT
|
||||
. ;I ZIDX="LOC" S ZINDEX=C0CLOC ; BY LOCATION
|
||||
. I ZVAR'="" D ; VARIABLES TAKE PRESCIDENCE OVER FILEMAN FIELDS
|
||||
. . S @RARY@(ZI)=@IVARS@(ZVAR) ;
|
||||
. E D ; IF NO VARIABLE, TRY ACCESSING FROM FILEMAN
|
||||
. . I (ZFILE="")!(ZFIELD="") Q ;QUIT IF FILE OR FIELD NOT THERE
|
||||
. . D CLEAN^DILF
|
||||
. . S @RARY@(ZI)=$$GET1^DIQ(ZFILE,ZINDEX_",",ZFIELD) ;GET THE VALUE
|
||||
. . I $D(^TMP("DIERR",$J,1)) D B ;
|
||||
. . . W "ERROR!",!
|
||||
. . . ZWR ^TMP("DIERR",$J,*)
|
||||
Q
|
||||
;
|
||||
|
|
252
p/C0CSUB1.m
252
p/C0CSUB1.m
|
@ -1,136 +1,136 @@
|
|||
C0CSUB1 ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR SUBSCRIPTIONN Utility Library ",!
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is the CCR SUBSCRIPTIONN Utility Library ",!
|
||||
Q
|
||||
;
|
||||
CHK1(DFN) ; ADD THE CHECKSUM FOR ONE PATIENT
|
||||
;
|
||||
S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM"))
|
||||
S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
|
||||
S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
|
||||
S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
|
||||
S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
|
||||
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
|
||||
K C0CFDA
|
||||
S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
|
||||
I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
|
||||
E Q ; NO CHECKSUMS FOR THISPATIENT
|
||||
D UPDIE
|
||||
N C0CJ S C0CJ=""
|
||||
F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN
|
||||
. S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
|
||||
. W C0CJ," ",C0CD,!
|
||||
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
|
||||
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
|
||||
. D UPDIE
|
||||
Q
|
||||
;
|
||||
;
|
||||
S C0CCHK=$NA(^TMP("C0CRIM","CHKSUM"))
|
||||
S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
|
||||
S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
|
||||
S C0CSFC=177.1012 ; FILE NUMBER FOR CHECKSUM SUBFILE
|
||||
S C0CSFDC=177.10121 ; FILE NUMBER FOR DOMAIN CHECKSUMS
|
||||
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
|
||||
K C0CFDA
|
||||
S C0CALL=$G(@C0CCHK@(DFN,"ALL"))
|
||||
I C0CALL'="" S C0CFDA(C0CSFC,"?+1,"_C0CPAT_",",.01)=C0CALL
|
||||
E Q ; NO CHECKSUMS FOR THISPATIENT
|
||||
D UPDIE
|
||||
N C0CJ S C0CJ=""
|
||||
F S C0CJ=$O(@C0CCHK@(DFN,"DOMAIN",C0CJ)) Q:C0CJ="" D ; FOR EACH DOMAIN
|
||||
. S C0CD=$O(^C0CDIC(170.101,"B",C0CJ,""))
|
||||
. W C0CJ," ",C0CD,!
|
||||
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",.01)=C0CD
|
||||
. S C0CFDA(C0CSFDC,"?+1,1,"_C0CPAT_",",1)=@C0CCHK@(DFN,"DOMAIN",C0CJ)
|
||||
. D UPDIE
|
||||
Q
|
||||
;
|
||||
SUBALL ; SUBSCRIBE ALL PATIENTS IN CCR GLOBALS TO SUBCRIBER 1
|
||||
;
|
||||
S C0CGLB=$NA(^TMP("C0CRIM","VARS"))
|
||||
S C0CI=""
|
||||
F S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI="" D ; FOR EACH PATIENT
|
||||
. D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN
|
||||
Q
|
||||
;
|
||||
;
|
||||
S C0CGLB=$NA(^TMP("C0CRIM","VARS"))
|
||||
S C0CI=""
|
||||
F S C0CI=$O(@C0CGLB@(C0CI)) Q:C0CI="" D ; FOR EACH PATIENT
|
||||
. D SUB1(C0CI,1) ;SUBSCIRBE THEM TO EPCRN
|
||||
Q
|
||||
;
|
||||
SUB1(DFN,C0CSS) ; SUBSCRIBE ONE PATIENT TO SUBSCRIBER C0CSS
|
||||
;
|
||||
S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
|
||||
S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
|
||||
S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS
|
||||
S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE
|
||||
K C0CFDA
|
||||
S C0CFDA(C0CSF,"+1,",.01)=DFN
|
||||
D UPDIE ; ADD THE PATIENT
|
||||
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
|
||||
S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER
|
||||
D UPDIE ; ADD THE SUBSCRIPTION
|
||||
D CHK1(DFN) ; ADD THE CHECKSUMS
|
||||
Q
|
||||
;
|
||||
;
|
||||
S C0CSF=177.101 ; FILE NUMBER FOR SUBSCRIPTION FILE
|
||||
S C0CSFS=177.1011 ; FILE NUMBER FOR SUBSCRIPTION SUBFILE
|
||||
S C0CSFC=177.10121 ; FILE NUMBER FOR CHECKSUMS
|
||||
S C0CSSF=177.201 ; FILE NUMBER FOR SUBSCRIBER FILE
|
||||
K C0CFDA
|
||||
S C0CFDA(C0CSF,"+1,",.01)=DFN
|
||||
D UPDIE ; ADD THE PATIENT
|
||||
S C0CPAT=$O(^C0CS("B",DFN,"")) ; IEN OF PAT
|
||||
S C0CFDA(C0CSFS,"+1,"_C0CPAT_",",.01)=C0CSS ; C0CSS IS A POINTER
|
||||
D UPDIE ; ADD THE SUBSCRIPTION
|
||||
D CHK1(DFN) ; ADD THE CHECKSUMS
|
||||
Q
|
||||
;
|
||||
UPDIE ; INTERNAL ROUTINE TO CALL UPDATE^DIE AND CHECK FOR ERRORS
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
K ZERR
|
||||
D CLEAN^DILF
|
||||
D UPDATE^DIE("","C0CFDA","","ZERR")
|
||||
I $D(ZERR) D ;
|
||||
. W "ERROR",!
|
||||
. ZWR ZERR
|
||||
. B
|
||||
K C0CFDA
|
||||
Q
|
||||
;
|
||||
VARPTR(ZVAR,ZTYP) ;EXTRINSIC WHICH RETURNS THE POINTER TO ZVAR IN THE
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
; 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
|
||||
;
|
||||
N ZCCRD,ZVARN,C0CFDA2
|
||||
S ZCCRD=170 ; FILE NUMBER FOR CCR DICTIONARY
|
||||
S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
I ZVARN="" D ; VARIABLE NOT IN CCR DICTIONARY - ADD IT
|
||||
. I '$D(ZTYP) D Q ; WON'T ADD A VARIABLE WITHOUT A TYPE
|
||||
. . W "CANNOT ADD VARIABLE WITHOUT A TYPE: ",ZVAR,!
|
||||
. S C0CFDA2(ZCCRD,"?+1,",.01)=ZVAR ; NAME OF NEW VARIABLE
|
||||
. S C0CFDA2(ZCCRD,"?+1,",12)=ZTYP ; TYPE EXTERNAL OF NEW VARIABLE
|
||||
. D CLEAN^DILF ;MAKE SURE ERRORS ARE CLEAN
|
||||
. D UPDATE^DIE("E","C0CFDA2","","ZERR") ;ADD VAR TO CCR DICTIONARY
|
||||
. I $D(ZERR) D ; LAYGO ERROR
|
||||
. . W "ERROR ADDING "_ZC0CI_" TO CCR DICTIONARY",!
|
||||
. E D ;
|
||||
. . D CLEAN^DILF ; CLEAN UP
|
||||
. . S ZVARN=$O(^C0CDIC(170,"B",ZVAR,"")) ;FIND IEN OF VARIABLE
|
||||
. . W "ADDED ",ZVAR," TO CCR DICTIONARY, IEN:",ZVARN,!
|
||||
Q ZVARN
|
||||
;
|
||||
SETFDA(C0CSN,C0CSV) ; INTERNAL ROUTINE TO MAKE AN FDA ENTRY FOR FIELD C0CSN
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
; TO SET TO VALUE C0CSV.
|
||||
; C0CFDA,C0CC,C0CZX ARE ASSUMED FROM THE CALLING ROUTINE
|
||||
; C0CSN,C0CSV ARE PASSED BY VALUE
|
||||
;
|
||||
N C0CSI,C0CSJ
|
||||
S C0CSI=$$ZFILE(C0CSN,"C0CC") ; FILE NUMBER
|
||||
S C0CSJ=$$ZFIELD(C0CSN,"C0CC") ; FIELD NUMBER
|
||||
S C0CFDA(C0CSI,C0CZX_",",C0CSJ)=C0CSV
|
||||
Q
|
||||
ZFILE(ZFN,ZTAB) ; EXTRINSIC TO RETURN FILE NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 1 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",1)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
ZFIELD(ZFN,ZTAB) ;EXTRINSIC TO RETURN FIELD NUMBER FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 2 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",2)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
; BY VALUE IN ZFN. FILE NUMBER IS PIECE 3 OF C0CA(ZFN)
|
||||
; IF ZTAB IS NULL, IT DEFAULTS TO C0CA
|
||||
I '$D(ZTAB) S ZTAB="C0CA"
|
||||
N ZR
|
||||
I $D(@ZTAB@(ZFN)) S ZR=$P(@ZTAB@(ZFN),"^",3)
|
||||
E S ZR=""
|
||||
Q ZR
|
||||
;
|
||||
|
|
110
p/C0CSYS.m
110
p/C0CSYS.m
|
@ -1,59 +1,59 @@
|
|||
C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
; Copyright 2008 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "Enter at appropriate points." Q
|
||||
;
|
||||
; Originally, I was going to use VEPERVER, but VEPERVER
|
||||
; actually kills ^TMP($J), outputs it to the screen in a user-friendly
|
||||
; manner (press any key to continue),
|
||||
; and is really a very half finished routine
|
||||
;
|
||||
; So for now, I am hard-coding the values.
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
; Copyright 2008 WorldVistA. 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 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,
|
||||
; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
; GNU 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.
|
||||
;
|
||||
W "Enter at appropriate points." Q
|
||||
;
|
||||
; Originally, I was going to use VEPERVER, but VEPERVER
|
||||
; actually kills ^TMP($J), outputs it to the screen in a user-friendly
|
||||
; manner (press any key to continue),
|
||||
; and is really a very half finished routine
|
||||
;
|
||||
; So for now, I am hard-coding the values.
|
||||
;
|
||||
SYSNAME() ;Get EHR System Name; PUBLIC; Extrinsic
|
||||
Q:$G(DUZ("AG"))="I" "RPMS"
|
||||
Q "WorldVistA EHR/VOE"
|
||||
;
|
||||
Q:$G(DUZ("AG"))="I" "RPMS"
|
||||
Q "WorldVistA EHR/VOE"
|
||||
;
|
||||
SYSVER() ;Get EHR System Version; PUBLIC; Extrinsic
|
||||
Q "1.0"
|
||||
;
|
||||
Q "1.0"
|
||||
;
|
||||
PTST(DFN) ;TEST TO SEE IF PATIENT MERGED OR A TEST PATIENT
|
||||
; DFN = IEN of the Patient to be tested
|
||||
; 1 = Merged or Test Patient
|
||||
; 0 = Non-test Patient
|
||||
;
|
||||
I DFN="" Q 0 ; BAD DFN PASSED
|
||||
I $D(^DPT(DFN,-9)) Q 1 ;This patient has been merged
|
||||
I $G(^DPT(DFN,0))="" Q 1 ;Missing zeroth node <---add
|
||||
;
|
||||
I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
|
||||
I CCRTEST Q 0 ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
|
||||
N DIERR,DATA
|
||||
I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
|
||||
S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
|
||||
; 1 = Test Patient
|
||||
; 0 = Non-test Patient
|
||||
I DATA Q DATA
|
||||
S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
|
||||
D CLEAN^DILF
|
||||
I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0 ;Allow Pseudo SSN
|
||||
I $E(DATA,1,3)="000" Q 1
|
||||
I $E(DATA,1,3)="666" Q 1
|
||||
Q 0
|
||||
;
|
||||
; DFN = IEN of the Patient to be tested
|
||||
; 1 = Merged or Test Patient
|
||||
; 0 = Non-test Patient
|
||||
;
|
||||
I DFN="" Q 0 ; BAD DFN PASSED
|
||||
I $D(^DPT(DFN,-9)) Q 1 ;This patient has been merged
|
||||
I $G(^DPT(DFN,0))="" Q 1 ;Missing zeroth node <---add
|
||||
;
|
||||
I '$D(CCRTEST) S CCRTEST=1 ; DEFAULT IS THAT WE ARE TESTING
|
||||
I CCRTEST Q 0 ; IF WE ARE TESTING, DON'T REJECT TEST PATIENTS
|
||||
N DIERR,DATA
|
||||
I $$TESTPAT^VADPT(DFN) Q 1 ; QUIT IF IT'S A VA TEST PATIENT
|
||||
S DATA=+$$GET1^DIQ(2,DFN_",",.6,"I") ;Test Patient Indicator
|
||||
; 1 = Test Patient
|
||||
; 0 = Non-test Patient
|
||||
I DATA Q DATA
|
||||
S DATA=$$GET1^DIQ(2,DFN_",",.09,"I") ;SSN test
|
||||
D CLEAN^DILF
|
||||
I "Pp"[$E(DATA,$L(DATA),$L(DATA)) Q 0 ;Allow Pseudo SSN
|
||||
I $E(DATA,1,3)="000" Q 1
|
||||
I $E(DATA,1,3)="666" Q 1
|
||||
Q 0
|
||||
;
|
||||
|
|
352
p/C0CUNIT.m
352
p/C0CUNIT.m
|
@ -1,186 +1,186 @@
|
|||
C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is a unit testing library",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "This is a unit testing library",!
|
||||
W !
|
||||
Q
|
||||
;
|
||||
ZT(ZARY,BAT,TST) ; private routine to add a test case to the ZARY array
|
||||
; ZARY IS PASSED BY REFERENCE
|
||||
; BAT is a string identifying the test battery
|
||||
; TST is a test which will evaluate to true or false
|
||||
; I '$G(ZARY) D
|
||||
; . S ZARY(0)=0 ; initially there are no elements
|
||||
; W "GOT HERE LOADING "_TST,!
|
||||
N CNT ; count of array elements
|
||||
S CNT=ZARY(0) ; contains array count
|
||||
S CNT=CNT+1 ; increment count
|
||||
S ZARY(CNT)=TST ; put the test in the array
|
||||
I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
|
||||
. N II,TN ; TEMP FOR ENDING TEST IN BATTERY
|
||||
. S II=$P(ZARY(BAT),"^",2)
|
||||
. S $P(ZARY(BAT),"^",2)=II+1
|
||||
I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
|
||||
. S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
|
||||
. S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
|
||||
. ; S TN=$NA(ZARY("TESTS"))
|
||||
. ; D PUSH^C0CXPATH(TN,BAT)
|
||||
S ZARY(0)=CNT ; update the array counter
|
||||
Q
|
||||
;
|
||||
; ZARY IS PASSED BY REFERENCE
|
||||
; BAT is a string identifying the test battery
|
||||
; TST is a test which will evaluate to true or false
|
||||
; I '$G(ZARY) D
|
||||
; . S ZARY(0)=0 ; initially there are no elements
|
||||
; W "GOT HERE LOADING "_TST,!
|
||||
N CNT ; count of array elements
|
||||
S CNT=ZARY(0) ; contains array count
|
||||
S CNT=CNT+1 ; increment count
|
||||
S ZARY(CNT)=TST ; put the test in the array
|
||||
I $D(ZARY(BAT)) D ; NOT THE FIRST TEST IN BATTERY
|
||||
. N II,TN ; TEMP FOR ENDING TEST IN BATTERY
|
||||
. S II=$P(ZARY(BAT),"^",2)
|
||||
. S $P(ZARY(BAT),"^",2)=II+1
|
||||
I '$D(ZARY(BAT)) D ; FIRST TEST IN THIS BATTERY
|
||||
. S ZARY(BAT)=CNT_"^"_CNT ; FIRST AND LAST TESTS IN BATTERY
|
||||
. S ZARY("TESTS",BAT)="" ; PUT THE BATTERY IN THE TESTS INDEX
|
||||
. ; S TN=$NA(ZARY("TESTS"))
|
||||
. ; D PUSH^C0CXPATH(TN,BAT)
|
||||
S ZARY(0)=CNT ; update the array counter
|
||||
Q
|
||||
;
|
||||
ZLOAD(ZARY,ROUTINE) ; load tests into ZARY which is passed by reference
|
||||
; ZARY IS PASSED BY NAME
|
||||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||||
K @ZARY
|
||||
S @ZARY@(0)=0 ; initialize array count
|
||||
N LINE,LABEL,BODY
|
||||
N INTEST S INTEST=0 ; switch for in the 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
|
||||
. 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";;></TEST>".E S INTEST=0 ; leaving test section
|
||||
. I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
|
||||
. I INTEST D ; within the testing section
|
||||
. . I LINE?." "1";;><".E D ; section name found
|
||||
. . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
|
||||
. . I LINE?." "1";;>>".E D ; test case found
|
||||
. . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
|
||||
S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
|
||||
Q
|
||||
;
|
||||
; ZARY IS PASSED BY NAME
|
||||
; ZARY = name of the root, closed array format (e.g., "^TMP($J)")
|
||||
; ROUTINE = NAME OF THE ROUTINE - PASSED BY VALUE
|
||||
K @ZARY
|
||||
S @ZARY@(0)=0 ; initialize array count
|
||||
N LINE,LABEL,BODY
|
||||
N INTEST S INTEST=0 ; switch for in the 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
|
||||
. 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";;></TEST>".E S INTEST=0 ; leaving test section
|
||||
. I LINE?." "1";;></TEMPLATE>".E S INTEST=0 ; leaving TEMPLATE section
|
||||
. I INTEST D ; within the testing section
|
||||
. . I LINE?." "1";;><".E D ; section name found
|
||||
. . . S SECTION=$P($P(LINE,";;><",2),">",1) ; pull out name
|
||||
. . I LINE?." "1";;>>".E D ; test case found
|
||||
. . . D ZT(.@ZARY,SECTION,$P(LINE,";;>>",2)) ; put the test in the array
|
||||
S @ZARY@("ALL")="1"_"^"_@ZARY@(0) ; MAKE A BATTERY FOR ALL
|
||||
Q
|
||||
;
|
||||
ZTEST(ZARY,WHICH) ; try out the tests using a passed array ZTEST
|
||||
N ZI,ZX,ZR,ZP
|
||||
S DEBUG=0
|
||||
; I WHICH="ALL" D Q ; RUN ALL THE TESTS
|
||||
; . W "DOING ALL",!
|
||||
; . N J,NT
|
||||
; . S NT=$NA(ZARY("TESTS"))
|
||||
; . W NT,@NT@(0),!
|
||||
; . F J=1:1:@NT@(0) D ;
|
||||
; . . W @NT@(J),!
|
||||
; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
|
||||
I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST
|
||||
. W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
|
||||
N FIRST,LAST
|
||||
S FIRST=$P(ZARY(WHICH),"^",1)
|
||||
S LAST=$P(ZARY(WHICH),"^",2)
|
||||
F ZI=FIRST:1:LAST D
|
||||
. I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
|
||||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||||
. . ; W ZP,!
|
||||
. . S ZX=ZP
|
||||
. . W "RUNNING: "_ZP
|
||||
. . X ZX
|
||||
. . W "..SUCCESS: ",WHICH,!
|
||||
. I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST
|
||||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||||
. . S ZX="S ZR="_ZP
|
||||
. . W "TRYING: "_ZP
|
||||
. . X ZX
|
||||
. . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
|
||||
. . I '$D(TPASSED) D ; NOT INITIALIZED YET
|
||||
. . . S TPASSED=0 S TFAILED=0
|
||||
. . I ZR S TPASSED=TPASSED+1
|
||||
. . I 'ZR S TFAILED=TFAILED+1
|
||||
Q
|
||||
;
|
||||
N ZI,ZX,ZR,ZP
|
||||
S DEBUG=0
|
||||
; I WHICH="ALL" D Q ; RUN ALL THE TESTS
|
||||
; . W "DOING ALL",!
|
||||
; . N J,NT
|
||||
; . S NT=$NA(ZARY("TESTS"))
|
||||
; . W NT,@NT@(0),!
|
||||
; . F J=1:1:@NT@(0) D ;
|
||||
; . . W @NT@(J),!
|
||||
; . . D ZTEST^C0CUNIT(@ZARY,@NT@(J))
|
||||
I '$D(ZARY(WHICH)) D Q ; TEST SECTION DOESN'T EXIST
|
||||
. W "ERROR -- TEST SECTION DOESN'T EXIST -> ",WHICH,!
|
||||
N FIRST,LAST
|
||||
S FIRST=$P(ZARY(WHICH),"^",1)
|
||||
S LAST=$P(ZARY(WHICH),"^",2)
|
||||
F ZI=FIRST:1:LAST D
|
||||
. I ZARY(ZI)?1">"1.E D ; NOT A TEST, JUST RUN THE STATEMENT
|
||||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||||
. . ; W ZP,!
|
||||
. . S ZX=ZP
|
||||
. . W "RUNNING: "_ZP
|
||||
. . X ZX
|
||||
. . W "..SUCCESS: ",WHICH,!
|
||||
. I ZARY(ZI)?1"?"1.E D ; THIS IS A TEST
|
||||
. . S ZP=$E(ZARY(ZI),2,$L(ZARY(ZI)))
|
||||
. . S ZX="S ZR="_ZP
|
||||
. . W "TRYING: "_ZP
|
||||
. . X ZX
|
||||
. . W $S(ZR=1:"..PASSED ",1:"..FAILED "),!
|
||||
. . I '$D(TPASSED) D ; NOT INITIALIZED YET
|
||||
. . . S TPASSED=0 S TFAILED=0
|
||||
. . I ZR S TPASSED=TPASSED+1
|
||||
. . I 'ZR S TFAILED=TFAILED+1
|
||||
Q
|
||||
;
|
||||
TEST ; RUN ALL THE TEST CASES
|
||||
N ZTMP
|
||||
D ZLOAD(.ZTMP)
|
||||
D ZTEST(.ZTMP,"ALL")
|
||||
W "PASSED: ",TPASSED,!
|
||||
W "FAILED: ",TFAILED,!
|
||||
W !
|
||||
W "THE TESTS!",!
|
||||
; I DEBUG ZWR ZTMP
|
||||
Q
|
||||
;
|
||||
N ZTMP
|
||||
D ZLOAD(.ZTMP)
|
||||
D ZTEST(.ZTMP,"ALL")
|
||||
W "PASSED: ",TPASSED,!
|
||||
W "FAILED: ",TFAILED,!
|
||||
W !
|
||||
W "THE TESTS!",!
|
||||
; I DEBUG ZWR ZTMP
|
||||
Q
|
||||
;
|
||||
GTSTS(GTZARY,RTN) ; return an array of test names
|
||||
N I,J S I="" S I=$O(GTZARY("TESTS",I))
|
||||
F J=0:0 Q:I="" D
|
||||
. D PUSH^C0CXPATH(RTN,I)
|
||||
. S I=$O(GTZARY("TESTS",I))
|
||||
Q
|
||||
;
|
||||
N I,J S I="" S I=$O(GTZARY("TESTS",I))
|
||||
F J=0:0 Q:I="" D
|
||||
. D PUSH^C0CXPATH(RTN,I)
|
||||
. S I=$O(GTZARY("TESTS",I))
|
||||
Q
|
||||
;
|
||||
TESTALL(RNM) ; RUN ALL THE TESTS
|
||||
N ZI,J,TZTMP,TSTS,TOTP,TOTF
|
||||
S TOTP=0 S TOTF=0
|
||||
D ZLOAD^C0CUNIT("TZTMP",RNM)
|
||||
D GTSTS(.TZTMP,"TSTS")
|
||||
F ZI=1:1:TSTS(0) D ;
|
||||
. S TPASSED=0 S TFAILED=0
|
||||
. D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
|
||||
. S TOTP=TOTP+TPASSED
|
||||
. S TOTF=TOTF+TFAILED
|
||||
. S $P(TSTS(ZI),"^",2)=TPASSED
|
||||
. S $P(TSTS(ZI),"^",3)=TFAILED
|
||||
F ZI=1:1:TSTS(0) D ;
|
||||
. W "TEST=> ",$P(TSTS(ZI),"^",1)
|
||||
. W " PASSED=>",$P(TSTS(ZI),"^",2)
|
||||
. W " FAILED=>",$P(TSTS(ZI),"^",3),!
|
||||
W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
|
||||
Q
|
||||
;
|
||||
N ZI,J,TZTMP,TSTS,TOTP,TOTF
|
||||
S TOTP=0 S TOTF=0
|
||||
D ZLOAD^C0CUNIT("TZTMP",RNM)
|
||||
D GTSTS(.TZTMP,"TSTS")
|
||||
F ZI=1:1:TSTS(0) D ;
|
||||
. S TPASSED=0 S TFAILED=0
|
||||
. D ZTEST^C0CUNIT(.TZTMP,TSTS(ZI))
|
||||
. S TOTP=TOTP+TPASSED
|
||||
. S TOTF=TOTF+TFAILED
|
||||
. S $P(TSTS(ZI),"^",2)=TPASSED
|
||||
. S $P(TSTS(ZI),"^",3)=TFAILED
|
||||
F ZI=1:1:TSTS(0) D ;
|
||||
. W "TEST=> ",$P(TSTS(ZI),"^",1)
|
||||
. W " PASSED=>",$P(TSTS(ZI),"^",2)
|
||||
. W " FAILED=>",$P(TSTS(ZI),"^",3),!
|
||||
W "TOTAL=> PASSED:",TOTP," FAILED:",TOTF,!
|
||||
Q
|
||||
;
|
||||
TLIST(ZARY) ; LIST ALL THE TESTS
|
||||
; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
|
||||
; ZARY IS PASSED BY REFERENCE
|
||||
N I,J,K S I="" S I=$O(ZARY("TESTS",I))
|
||||
S K=1
|
||||
F J=0:0 Q:I="" D
|
||||
. ; W "I IS NOW=",I,!
|
||||
. W I," "
|
||||
. S I=$O(ZARY("TESTS",I))
|
||||
. S K=K+1 I K=6 D
|
||||
. . W !
|
||||
. . S K=1
|
||||
Q
|
||||
;
|
||||
; THEY ARE MARKED AS ;;><TESTNAME> IN THE TEST CASES
|
||||
; ZARY IS PASSED BY REFERENCE
|
||||
N I,J,K S I="" S I=$O(ZARY("TESTS",I))
|
||||
S K=1
|
||||
F J=0:0 Q:I="" D
|
||||
. ; W "I IS NOW=",I,!
|
||||
. W I," "
|
||||
. S I=$O(ZARY("TESTS",I))
|
||||
. S K=K+1 I K=6 D
|
||||
. . W !
|
||||
. . S K=1
|
||||
Q
|
||||
;
|
||||
MEDS
|
||||
N DEBUG S DEBUG=0
|
||||
N DFN S DFN=5685
|
||||
K ^TMP($J)
|
||||
W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
|
||||
N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T)
|
||||
N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
|
||||
W "XPATH is: "_XPATH,!
|
||||
W "Getting Med Template into INXML using",!
|
||||
W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
|
||||
D QUERY^GPLXPATH(T,XPATH,"INXML")
|
||||
W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!
|
||||
W "OUTXML will be ^TMP($J,""OUT"")",!
|
||||
N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
|
||||
D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
|
||||
D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
|
||||
Q
|
||||
N DEBUG S DEBUG=0
|
||||
N DFN S DFN=5685
|
||||
K ^TMP($J)
|
||||
W "Loading CCR Template into T using LOAD^GPLCCR0($NA(^TMP($J,""CCR"")))",!!
|
||||
N T S T=$NA(^TMP($J,"CCR")) D LOAD^GPLCCR0(T)
|
||||
N XPATH S XPATH="//ContinuityOfCareRecord/Body/Medications"
|
||||
W "XPATH is: "_XPATH,!
|
||||
W "Getting Med Template into INXML using",!
|
||||
W "QUERY^GPLXPATH(T,XPATH,""INXML"")",!!
|
||||
D QUERY^GPLXPATH(T,XPATH,"INXML")
|
||||
W "Executing EXTRACT^C0CMED(INXML,DFN,OUTXML)",!
|
||||
W "OUTXML will be ^TMP($J,""OUT"")",!
|
||||
N OUTXML S OUTXML=$NA(^TMP($J,"OUT"))
|
||||
D EXTRACT^C0CMED6("INXML",DFN,OUTXML)
|
||||
D FILEOUT^C0CRNF(OUTXML,"TESTMEDS.xml")
|
||||
Q
|
||||
PAT
|
||||
D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
|
||||
N X,Y
|
||||
; Select Patient
|
||||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||
;
|
||||
W "You have selected patient "_Y,!!
|
||||
N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D
|
||||
. W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
|
||||
. W "valued at "
|
||||
. W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"C0CDPT"_"("_$P(Y,"^")_")")
|
||||
. W !
|
||||
Q
|
||||
D ANALYZE^ARJTXRD("C0CDPT",.OUT) ; Analyze a routine in the directory
|
||||
N X,Y
|
||||
; Select Patient
|
||||
S DIC=2,DIC(0)="AEMQ" D ^DIC
|
||||
;
|
||||
W "You have selected patient "_Y,!!
|
||||
N I S I=89 F S I=$O(OUT(I)) Q:I="ALINE" D
|
||||
. W "OUT("_I_",0)"_" is "_$P(OUT(I,0)," ")_" "
|
||||
. W "valued at "
|
||||
. W @("$$"_$P(OUT(I,0),"(DFN)")_"^"_"C0CDPT"_"("_$P(Y,"^")_")")
|
||||
. W !
|
||||
Q
|
||||
|
|
300
p/C0CUTIL.m
300
p/C0CUTIL.m
|
@ -1,145 +1,161 @@
|
|||
C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
|
||||
;;0.1;C0C;;Jun 15, 2008;Build 29
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "No Entry at Top!"
|
||||
Q
|
||||
;
|
||||
UUID() ; thanks to Wally for this.
|
||||
N R,I,J,N
|
||||
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))
|
||||
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)
|
||||
C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
|
||||
;;0.1;C0C;;Jun 15, 2008;Build 38
|
||||
;Copyright 2008-2009 Sam Habiel & George Lilly.
|
||||
;Licensed under the terms of the GNU
|
||||
;General Public License See attached copy of the License.
|
||||
;
|
||||
OLDUUID() ; GENERATE A RANDOM UUID (Version 4)
|
||||
N I,J,ZS
|
||||
S ZS="0123456789abcdef" S J=""
|
||||
F I=1:1:36 S J=J_$S((I=9)!(I=14)!(I=19)!(I=24):"-",I=15:4,I=20:"a",1:$E(ZS,$R(16)+1))
|
||||
Q J
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "No Entry at Top!"
|
||||
Q
|
||||
;
|
||||
UUID() ; thanks to Wally for this.
|
||||
N R,I,J,N
|
||||
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))
|
||||
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)
|
||||
N I,J,ZS
|
||||
S ZS="0123456789abcdef" S J=""
|
||||
F I=1:1:36 S J=J_$S((I=9)!(I=14)!(I=19)!(I=24):"-",I=15:4,I=20:"a",1:$E(ZS,$R(16)+1))
|
||||
Q J
|
||||
;
|
||||
FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
|
||||
; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
|
||||
; If not passed, or passed incorrectly, it's assumed that it is D.
|
||||
; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
|
||||
; 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)
|
||||
N UTC,Y,M,D,H,MM,S,OFF
|
||||
S Y=1700+$E(DATE,1,3)
|
||||
S M=$E(DATE,4,5)
|
||||
S D=$E(DATE,6,7)
|
||||
S H=$E(DATE,9,10)
|
||||
I $L(H)=1 S H="0"_H
|
||||
S MM=$E(DATE,11,12)
|
||||
I $L(MM)=1 S MM="0"_MM
|
||||
S S=$E(DATE,13,14)
|
||||
I $L(S)=1 S S="0"_S
|
||||
S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
|
||||
S OFFS=$E(OFF,1,1)
|
||||
S OFF0=$TR(OFF,"+-")
|
||||
S OFF1=$E(OFF0+10000,2,3)
|
||||
S OFF2=$E(OFF0+10000,4,5)
|
||||
S OFF=OFFS_OFF1_":"_OFF2
|
||||
;S OFF2=$E(OFF,1,2) ;
|
||||
;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
|
||||
;S OFF3=$E(OFF,3,4) ;MINUTES
|
||||
;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
|
||||
; If H, MM and S are empty, it means that the FM date didn't supply the time.
|
||||
; In this case, set H, MM and S to "00"
|
||||
; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
|
||||
S:'$L(H) H="00"
|
||||
S:'$L(MM) MM="00"
|
||||
S:'$L(S) S="00"
|
||||
S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
|
||||
I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
|
||||
E Q $P(UTC,"T")
|
||||
;
|
||||
SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
|
||||
; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
|
||||
; DATE AND TIME ORDER. DEFAULT IS FORWARD
|
||||
; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
|
||||
; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
|
||||
; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
|
||||
; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
|
||||
; BOTH V1 AND V2 ARE PASSED BY REFERENCE
|
||||
N VSRT ; TEMP FOR HASHING DATES
|
||||
N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
|
||||
S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
|
||||
F ZI=1:1:ZCNT D ; FOR EACH DATE IN THE ARRAY
|
||||
. I $D(V2(ZI)) D ; IF THE DATE EXISTS
|
||||
. . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
|
||||
. . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
|
||||
. . ; W "DATE: ",ZP1," TIME: ",ZP2,!
|
||||
. . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
|
||||
N ZG
|
||||
S ZG=$Q(VSRT(""))
|
||||
F D Q:ZG="" ;
|
||||
. ; W ZG,!
|
||||
. D PUSH^C0CXPATH("V1",@ZG)
|
||||
. S ZG=$Q(@ZG)
|
||||
I ORDR=-1 D ; HAVE TO REVERSE ORDER
|
||||
. N ZG2
|
||||
. F ZI=1:1:V1(0) D ; FOR EACH ELELMENT
|
||||
. . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
|
||||
. S ZG2(0)=V1(0)
|
||||
. D CP^C0CXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
|
||||
Q ZCNT
|
||||
;
|
||||
DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
|
||||
; RETURNS AN ARRAY RTN PASSED BY REFERENCE
|
||||
; THIS ROUTINE CAN BE USED AS AN RPC
|
||||
; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
|
||||
; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
|
||||
;
|
||||
N LEXIEN
|
||||
I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D ; IEN FOUND FOR THIS DRUG
|
||||
. S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
|
||||
. W LEXIEN,!
|
||||
. S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
|
||||
. S RTN(0)=1 ; ONE THING RETURNED
|
||||
E S RTN(0)=0 ; NOT FOUND
|
||||
Q
|
||||
;
|
||||
DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
|
||||
;
|
||||
N DARTN
|
||||
D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
|
||||
I DARTN(0)>0 D ; GOT RESULTS
|
||||
. W !,DARTN(1) ;PRINT THE SNOMED CODE
|
||||
E W !,"NOT FOUND",!
|
||||
Q
|
||||
;
|
||||
DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
|
||||
; ASSOCIATED SNOMED CODES
|
||||
N DASTMP,DASIEN,DASNO
|
||||
S DASTMP=""
|
||||
F S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP="" D ; NAME OF MED
|
||||
. S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
|
||||
. S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
|
||||
. W DASTMP,"=",DASNO,! ; PRINT IT OUT
|
||||
Q
|
||||
;
|
||||
RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
|
||||
;
|
||||
FMDTOUTC(DATE,FORMAT) ; Convert Fileman Date to UTC Date Format; PUBLIC; Extrinsic
|
||||
; FORMAT is Format of Date. Can be either D (Day) or DT (Date and Time)
|
||||
; If not passed, or passed incorrectly, it's assumed that it is D.
|
||||
; FM Date format is "YYYMMDD.HHMMSS" HHMMSS may not be supplied.
|
||||
; 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)
|
||||
N UTC,Y,M,D,H,MM,S,OFF
|
||||
S Y=1700+$E(DATE,1,3)
|
||||
S M=$E(DATE,4,5)
|
||||
S D=$E(DATE,6,7)
|
||||
S H=$E(DATE,9,10)
|
||||
I $L(H)=1 S H="0"_H
|
||||
S MM=$E(DATE,11,12)
|
||||
I $L(MM)=1 S MM="0"_MM
|
||||
S S=$E(DATE,13,14)
|
||||
I $L(S)=1 S S="0"_S
|
||||
S OFF=$$TZ^XLFDT ; See Kernel Manual for documentation.
|
||||
S OFFS=$E(OFF,1,1)
|
||||
S OFF0=$TR(OFF,"+-")
|
||||
S OFF1=$E(OFF0+10000,2,3)
|
||||
S OFF2=$E(OFF0+10000,4,5)
|
||||
S OFF=OFFS_OFF1_":"_OFF2
|
||||
;S OFF2=$E(OFF,1,2) ;
|
||||
;S OFF2=$E(100+OFF2,2,3) ; GPL 11/08 CHANGED TO -05:00 FORMAT
|
||||
;S OFF3=$E(OFF,3,4) ;MINUTES
|
||||
;S OFF=$S(OFF2="":"00",0:"00",1:OFF2)_"."_$S(OFF3="":"00",1:OFF3)
|
||||
; If H, MM and S are empty, it means that the FM date didn't supply the time.
|
||||
; In this case, set H, MM and S to "00"
|
||||
; S:('$L(H)&'$L(MM)&'$L(S)) (H,MM,S)="00" ; IF ONLY SOME ARE MISSING?
|
||||
S:'$L(H) H="00"
|
||||
S:'$L(MM) MM="00"
|
||||
S:'$L(S) S="00"
|
||||
S UTC=Y_"-"_M_"-"_D_"T"_H_":"_MM_$S(S="":":00",1:":"_S)_OFF ; Skip's code to fix hanging colon if no seconds
|
||||
I $L($G(FORMAT)),FORMAT="DT" Q UTC ; Date with time.
|
||||
E Q $P(UTC,"T")
|
||||
CODE(ZVUID) ; EXTRINSIC WHICH RETURNS THE RXNORM CODE IF KNOWN OF
|
||||
; THE VUID - RETURNS CODE^SYSTEM^VERSION TO USE IN THE CCR
|
||||
N ZRSLT S ZRSLT=ZVUID_"^"_"VUID"_"^" ; DEFAULT
|
||||
I $G(ZVUID)="" Q ""
|
||||
I '$D(^C0P("RXN")) Q ZRSLT ; ERX NOT INSTALLED
|
||||
N C0PIEN ; S C0PIEN=$$FIND1^DIC($$RXNFN,"","QX",ZVUID,"VUID")
|
||||
S C0PIEN=$O(^C0P("RXN","VUID",ZVUID,"")) ;GPL FIX FOR MULTIPLES
|
||||
N ZRXN S ZRXN=$$GET1^DIQ($$RXNFN,C0PIEN,.01)
|
||||
I ZRXN=309362 S ZRXN=213169
|
||||
I ZRXN=855318 S ZRXN=855320
|
||||
I ZRXN=197361 S ZRXN=212549
|
||||
I ZRXN'="" S ZRSLT=ZRXN_"^RXNORM^08AB_081201F"
|
||||
Q ZRSLT
|
||||
;
|
||||
SORTDT(V1,V2,ORDR) ; DATE SORT ARRAY AND RETURN INDEX IN V1 AND COUNT
|
||||
; AS EXTRINSIC ORDR IS 1 OR -1 FOR FORWARD OR REVERSE
|
||||
; DATE AND TIME ORDER. DEFAULT IS FORWARD
|
||||
; V2 IS AN ARRAY OF DATES IN FILEMAN FORMAT
|
||||
; V1 IS RETURNS INDIRECT INDEXES OF V2 IN REVERSE DATE ORDER
|
||||
; SO V2(V1(X)) WILL RETURN THE DATES IN DATE/TIME ORDER
|
||||
; THE COUNT OF THE DATES IS RETURNED AS AN EXTRINSIC
|
||||
; BOTH V1 AND V2 ARE PASSED BY REFERENCE
|
||||
N VSRT ; TEMP FOR HASHING DATES
|
||||
N ZI,ZJ,ZTMP,ZCNT,ZP1,ZP2
|
||||
S ZCNT=V2(0) ; COUNTING NUMBER OF DATES
|
||||
F ZI=1:1:ZCNT D ; FOR EACH DATE IN THE ARRAY
|
||||
. I $D(V2(ZI)) D ; IF THE DATE EXISTS
|
||||
. . S ZP1=$P(V2(ZI),".",1) ; THE DATE PIECE
|
||||
. . S ZP2=$P(V2(ZI),".",2) ; THE TIME PIECE
|
||||
. . ; W "DATE: ",ZP1," TIME: ",ZP2,!
|
||||
. . S VSRT(ZP1,ZP2,ZI)=ZI ; INDEX OF DATE, TIME AND COUNT
|
||||
N ZG
|
||||
S ZG=$Q(VSRT(""))
|
||||
F D Q:ZG="" ;
|
||||
. ; W ZG,!
|
||||
. D PUSH^C0CXPATH("V1",@ZG)
|
||||
. S ZG=$Q(@ZG)
|
||||
I ORDR=-1 D ; HAVE TO REVERSE ORDER
|
||||
. N ZG2
|
||||
. F ZI=1:1:V1(0) D ; FOR EACH ELELMENT
|
||||
. . S ZG2(V1(0)-ZI+1)=V1(ZI) ; SET IN REVERSE ORDER
|
||||
. S ZG2(0)=V1(0)
|
||||
. D CP^C0CXPATH("ZG2","V1") ; COPY OVER THE NEW ARRAY
|
||||
Q ZCNT
|
||||
;
|
||||
DA2SNO(RTN,DNAME) ; LOOK UP DRUG ALLERGY CODE IN ^LEX
|
||||
; RETURNS AN ARRAY RTN PASSED BY REFERENCE
|
||||
; THIS ROUTINE CAN BE USED AS AN RPC
|
||||
; RTN(0) IS THE NUMBER OF ELEMENTS IN THE ARRAY
|
||||
; RTN(1) IS THE SNOMED CODE FOR THE DRUG ALLERGY
|
||||
;
|
||||
N LEXIEN
|
||||
I $O(^LEX(757.21,"ADIS",DNAME,""))'="" D ; IEN FOUND FOR THIS DRUG
|
||||
. S LEXIEN=$O(^LEX(757.21,"ADIS",DNAME,"")) ; GET THE IEN IN THE LEXICON
|
||||
. W LEXIEN,!
|
||||
. S RTN(1)=$P(^LEX(757.02,LEXIEN,0),"^",2) ; SNOMED CODE IN P2
|
||||
. S RTN(0)=1 ; ONE THING RETURNED
|
||||
E S RTN(0)=0 ; NOT FOUND
|
||||
Q
|
||||
;
|
||||
DASNO(DANAME) ; PRINTS THE SNOMED CODE FOR ALLERGY TO DRUG DANAME
|
||||
;
|
||||
N DARTN
|
||||
D DA2SNO(.DARTN,DANAME) ; CALL THE LOOKUP ROUTINE
|
||||
I DARTN(0)>0 D ; GOT RESULTS
|
||||
. W !,DARTN(1) ;PRINT THE SNOMED CODE
|
||||
E W !,"NOT FOUND",!
|
||||
Q
|
||||
;
|
||||
DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
|
||||
; ASSOCIATED SNOMED CODES
|
||||
N DASTMP,DASIEN,DASNO
|
||||
S DASTMP=""
|
||||
F S DASTMP=$O(^LEX(757.21,WHICH,DASTMP)) Q:DASTMP="" D ; NAME OF MED
|
||||
. S DASIEN=$O(^LEX(757.21,WHICH,DASTMP,"")) ; IEN OF MED
|
||||
. S DASNO=$P(^LEX(757.02,DASIEN,0),"^",2) ; SNOMED CODE FOR ENTRY
|
||||
. W DASTMP,"=",DASNO,! ; PRINT IT OUT
|
||||
Q
|
||||
;
|
||||
RPMS() ; Are we running on an RPMS system rather than Vista?
|
||||
Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
|
||||
VISTA() ; Are we running on Vanilla Vista?
|
||||
Q $G(DUZ("AG"))="V" ; If User Agency is VA
|
||||
WV() ; Are we running on WorldVista?
|
||||
Q $G(DUZ("AG"))="E" ; Code for WV.
|
||||
OV() ; Are we running on OpenVista?
|
||||
Q $G(DUZ("AG"))="O" ; Code for OpenVista
|
||||
|
||||
RPMS() ; Are we running on an RPMS system rather than Vista?
|
||||
Q $G(DUZ("AG"))="I" ; If User Agency is Indian Health Service
|
||||
VISTA() ; Are we running on Vanilla Vista?
|
||||
Q $G(DUZ("AG"))="V" ; If User Agency is VA
|
||||
WV() ; Are we running on WorldVista?
|
||||
Q $G(DUZ("AG"))="E" ; Code for WV.
|
||||
OV() ; Are we running on OpenVista?
|
||||
Q $G(DUZ("AG"))="O" ; Code for OpenVista
|
||||
|
||||
|
|
304
p/C0CVA200.m
304
p/C0CVA200.m
|
@ -1,168 +1,168 @@
|
|||
C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;Copyright 2008 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 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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
Q
|
||||
; This routine uses Kernel APIs and Direct Global Access to get
|
||||
; Proivder Data from File 200.
|
||||
;
|
||||
; The Global is VA(200,*)
|
||||
;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;Copyright 2008 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 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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
Q
|
||||
; This routine uses Kernel APIs and Direct Global Access to get
|
||||
; Proivder Data from File 200.
|
||||
;
|
||||
; The Global is VA(200,*)
|
||||
;
|
||||
FAMILY(DUZ) ; Get Family Name; PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ (i.e. File 200 IEN) ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
;
|
||||
; INPUT: DUZ (i.e. File 200 IEN) ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("FAMILY")
|
||||
;
|
||||
GIVEN(DUZ) ; Get Given Name; PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("GIVEN")
|
||||
;
|
||||
MIDDLE(DUZ) ; Get Middle Name, PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("MIDDLE")
|
||||
;
|
||||
SUFFIX(DUZ) ; Get Suffix Name, PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
N NAME S NAME=$P(^VA(200,DUZ,0),U)
|
||||
D NAMECOMP^XLFNAME(.NAME)
|
||||
Q NAME("SUFFIX")
|
||||
;
|
||||
TITLE(DUZ) ; Get Title for Proivder, PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
; Gets External Value of Title field in New Person File.
|
||||
; It's actually a pointer to file 3.1
|
||||
; 200=New Person File; 8 is Title Field
|
||||
Q $$GET1^DIQ(200,DUZ_",",8)
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
; Gets External Value of Title field in New Person File.
|
||||
; It's actually a pointer to file 3.1
|
||||
; 200=New Person File; 8 is Title Field
|
||||
Q $$GET1^DIQ(200,DUZ_",",8)
|
||||
;
|
||||
NPI(DUZ) ; Get NPI Number, PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: Delimited String in format:
|
||||
; IDType^ID^IDDescription
|
||||
; If the NPI doesn't exist, "" is returned.
|
||||
; This routine uses a call documented in the Kernel dev guide
|
||||
; This call returns as "NPI^TimeEntered^ActiveInactive"
|
||||
; It returns -1 for NPI if NPI doesn't exist.
|
||||
N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
|
||||
Q:NPI=-1 ""
|
||||
Q "NPI^"_NPI_"^HHS"
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: Delimited String in format:
|
||||
; IDType^ID^IDDescription
|
||||
; If the NPI doesn't exist, "" is returned.
|
||||
; This routine uses a call documented in the Kernel dev guide
|
||||
; This call returns as "NPI^TimeEntered^ActiveInactive"
|
||||
; It returns -1 for NPI if NPI doesn't exist.
|
||||
N NPI S NPI=$P($$NPI^XUSNPI("Individual_ID",DUZ),U)
|
||||
Q:NPI=-1 ""
|
||||
Q "NPI^"_NPI_"^HHS"
|
||||
;
|
||||
SPEC(DUZ) ; Get Provider Specialty, PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
|
||||
; Uses a Kernel API. Returns -1 if a specialty is not specified
|
||||
; in file 200.
|
||||
; Otherwise, returns IEN^Profession^Specialty^Subspecialty^Effect date^Expired date^VA code
|
||||
N STR S STR=$$GET^XUA4A72(DUZ)
|
||||
Q:+STR<0 ""
|
||||
; Sometimes we have 3 pieces, or 2. Deal with that.
|
||||
Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
|
||||
Q $P(STR,U,2)_"-"_$P(STR,U,3)
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String: ProviderType/Specialty/Subspecialty OR ""
|
||||
; Uses a Kernel API. Returns -1 if a specialty is not specified
|
||||
; in file 200.
|
||||
; Otherwise, returns IEN^Profession^Specialty^Subspecialty^Effect date^Expired date^VA code
|
||||
N STR S STR=$$GET^XUA4A72(DUZ)
|
||||
Q:+STR<0 ""
|
||||
; Sometimes we have 3 pieces, or 2. Deal with that.
|
||||
Q:$L($P(STR,U,4)) $P(STR,U,2)_"-"_$P(STR,U,3)_"-"_$P(STR,U,4)
|
||||
Q $P(STR,U,2)_"-"_$P(STR,U,3)
|
||||
;
|
||||
ADDTYPE(DUZ) ; Get Address Type, PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ, but not needed really... here for future expansion
|
||||
; OUTPUT: At this point "Work"
|
||||
Q "Work"
|
||||
;
|
||||
; INPUT: DUZ, but not needed really... here for future expansion
|
||||
; OUTPUT: At this point "Work"
|
||||
Q "Work"
|
||||
;
|
||||
ADDLINE1(ADUZ) ; Get Address associated with this instituation; PUBLIC; EXTRINSIC ; CHANGED PARAMETER TO ADUZ TO KEEP FROM CRASHING GPL 1/09
|
||||
; INPUT: DUZ ByVal
|
||||
; Output: String.
|
||||
;
|
||||
; First, get site number from the institution file.
|
||||
; 1st piece returned by $$SITE^VASITE, which gets the system institution
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
;
|
||||
; Second, get mailing address
|
||||
; There are two APIs to get the address, one for physical and one for
|
||||
; mailing. We will check if mailing exists first, since that's the
|
||||
; one we want to use; then check for physical. If neither exists,
|
||||
; then we return nothing. We check for the existence of an address
|
||||
; by the length of the returned string.
|
||||
; NOTE: API doesn't support Address 2, so I won't even include it
|
||||
; in the template.
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U)
|
||||
Q ""
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; Output: String.
|
||||
;
|
||||
; First, get site number from the institution file.
|
||||
; 1st piece returned by $$SITE^VASITE, which gets the system institution
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
;
|
||||
; Second, get mailing address
|
||||
; There are two APIs to get the address, one for physical and one for
|
||||
; mailing. We will check if mailing exists first, since that's the
|
||||
; one we want to use; then check for physical. If neither exists,
|
||||
; then we return nothing. We check for the existence of an address
|
||||
; by the length of the returned string.
|
||||
; NOTE: API doesn't support Address 2, so I won't even include it
|
||||
; in the template.
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U)
|
||||
Q ""
|
||||
;
|
||||
CITY(ADUZ) ; Get City for Institution. PUBLIC; EXTRINSIC
|
||||
;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING
|
||||
; INPUT: DUZ ByVal
|
||||
; Output: String.
|
||||
; See ADD1 for comments
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U,2)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U,2)
|
||||
Q ""
|
||||
;
|
||||
;GPL CHANGED PARAMETER TO ADUZ TO KEEP $$SITE^VASITE FROM CRASHING
|
||||
; INPUT: DUZ ByVal
|
||||
; Output: String.
|
||||
; See ADD1 for comments
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U,2)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U,2)
|
||||
Q ""
|
||||
;
|
||||
STATE(ADUZ) ; Get State for Institution. PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; Output: String.
|
||||
; See ADD1 for comments
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U,3)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U,3)
|
||||
Q ""
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; Output: String.
|
||||
; See ADD1 for comments
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U,3)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U,3)
|
||||
Q ""
|
||||
;
|
||||
POSTCODE(ADUZ) ; Get Postal Code for Institution. PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String.
|
||||
; See ADD1 for comments
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U,4)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U,4)
|
||||
Q ""
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String.
|
||||
; See ADD1 for comments
|
||||
N INST S INST=$P($$SITE^VASITE(),U)
|
||||
N ADD
|
||||
S ADD=$$MADD^XUAF4(INST) ; mailing address
|
||||
Q:$L(ADD) $P(ADD,U,4)
|
||||
S ADD=$$PADD^XUAF4(INST) ; physical address
|
||||
Q:$L(ADD) $P(ADD,U,4)
|
||||
Q ""
|
||||
;
|
||||
TEL(DUZ) ; Get Office Phone number. PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String.
|
||||
; Direct global access
|
||||
N TEL S TEL=$G(^VA(200,DUZ,.13))
|
||||
Q $P(TEL,U,2)
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String.
|
||||
; Direct global access
|
||||
N TEL S TEL=$G(^VA(200,DUZ,.13))
|
||||
Q $P(TEL,U,2)
|
||||
;
|
||||
TELTYPE(DUZ) ; Get Telephone Type. PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String.
|
||||
Q "Office"
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String.
|
||||
Q "Office"
|
||||
;
|
||||
EMAIL(DUZ) ; Get Provider's Email. PUBLIC; EXTRINSIC
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
; Direct global access
|
||||
N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
|
||||
Q $P(EMAIL,U)
|
||||
;
|
||||
; INPUT: DUZ ByVal
|
||||
; OUTPUT: String
|
||||
; Direct global access
|
||||
N EMAIL S EMAIL=$G(^VA(200,DUZ,.15))
|
||||
Q $P(EMAIL,U)
|
||||
;
|
||||
|
|
956
p/C0CVIT2.m
956
p/C0CVIT2.m
|
@ -1,478 +1,478 @@
|
|||
C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
||||
;;1.0;C0C;;Feb 16, 2010;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(VITXML,DFN,VITOUT) ; EXTRACT VITAL SIGNS INTO XML TEMPLATE
|
||||
; VITXML AND VITOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
|
||||
; THAT GET PASSED TO *GET ROUTINES
|
||||
;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
|
||||
N C0CVIT
|
||||
S C0CVIT=$NA(^TMP("C0CCCR",$J,DFN,"C0CVIT"))
|
||||
; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
|
||||
; THAT GET INSERTED INTO THE XML TEMPLATE
|
||||
; D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS
|
||||
I $$RPMS^C0CUTIL() D GETRPMS(DFN,C0CVIT) ; GET VARS
|
||||
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D GETVISTA(DFN,C0CVIT)
|
||||
; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
|
||||
; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
|
||||
D MAP(VITXML,C0CVIT,VITOUT) ;MAP RESULTS FOR PROCEDURES
|
||||
Q
|
||||
;
|
||||
GETVISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVI TO GET VITAL SIGNS.
|
||||
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CVIT: VITAL SIGNS
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST.
|
||||
;
|
||||
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
|
||||
;
|
||||
; SETUP RPC/API CALL HERE
|
||||
; USE START AND END DATES FROM PARAMETERS IF REQUIRED
|
||||
;
|
||||
N VIT,DATA,START,END
|
||||
; RPC REQUIRES FM DATES NOT T-* DATES
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
|
||||
; RPC CALL (ORY,DFN,ORSDT,OREDT):
|
||||
;ORY: return variable
|
||||
;DFN: patient identifier from Patient File [#2]
|
||||
;ORSDT: start date/time in Fileman format
|
||||
;OREDT: end date/time in Fileman format
|
||||
; OUTPUT FORMAT:
|
||||
;vital measurement ien^vital type^rate^date/time taken
|
||||
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 $P(VIT(1),U,2)="No vitals found." D Q ; signal no vitals and quit
|
||||
. I $D(VITOUT) S @VITOUT@(0)=0
|
||||
. K VIT
|
||||
;
|
||||
; PREFORM SORT HERE IF NEEDED
|
||||
;
|
||||
; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
|
||||
; COPIED SORT LOGIC:
|
||||
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
||||
D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
||||
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
||||
; VSORT IS VITALS IN REVERSE ORDER
|
||||
;
|
||||
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
|
||||
; RNF1 ARRAY FORMAT:
|
||||
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
|
||||
;
|
||||
; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
|
||||
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
|
||||
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
|
||||
N C0CVI,C0CC,ZRNF
|
||||
;S C0CVI="" ; INITIALIZE FOR $O
|
||||
F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D ; FOR EACH VITAL SIGN IN THE LIST
|
||||
. I DEBUG W VIT(C0CVI),!
|
||||
. ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
|
||||
. D:$P(VIT(C0CVI),U,3)="HT" HEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"in")
|
||||
. D:$P(VIT(C0CVI),U,3)="WT" WEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"lbs")
|
||||
. D:$P(VIT(C0CVI),U,3)="BP" BP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:$P(VIT(C0CVI),U,3)="T" TMP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"F")
|
||||
. D:$P(VIT(C0CVI),U,3)="R" RESP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:$P(VIT(C0CVI),U,3)="P" PULSE1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:$P(VIT(C0CVI),U,3)="PN" PAIN1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:'$D(ZRNF) OTHER1($$FMDTOUTC^C0CUTIL($P(C0CVI,U,4),"DT"),"OTHER VITAL",$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"UNKNOWN") ;IF THE VITAL ISN'T DEFINED IT IS OTHER
|
||||
. D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
|
||||
. K ZRNF
|
||||
; SAVE RIM VARIABLES SEE C0CRIMA
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
|
||||
M @ZRIM=@C0CVIT@("V")
|
||||
Q
|
||||
;
|
||||
GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS.
|
||||
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CVIT: VITAL SIGNS
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST.
|
||||
;
|
||||
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
|
||||
;
|
||||
; SETUP RPC/API CALL HERE
|
||||
; USE START AND END DATES FROM PARAMETERS IF REQUIRED
|
||||
;
|
||||
; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE
|
||||
; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE
|
||||
N C0CEDT,C0CSDT,VIT,DATA,START,END
|
||||
; RPC REQUIRES FM DATES NOT T-* DATES
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
|
||||
; RPC OUTPUT FORMAT:
|
||||
; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
|
||||
D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
|
||||
I '$D(^TMP("CIAVMRPC",$J)) S @VITOUT@(0)=0 K ^TMP("CIAVMRPC",$J) Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT
|
||||
; MOVE THE ARRAY TO LOCAL VARIABLE
|
||||
M VIT=^TMP("CIAVMRPC",$J,0)
|
||||
; RPC CLEANUP
|
||||
K ^TMP("CIAVMRPC",$J),VITS,RMAX,START,END,DATA,METRIC,VSTR,VUNT
|
||||
;
|
||||
; PREFORM SORT HERE IF NEEDED
|
||||
;
|
||||
; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
|
||||
; COPIED SORT LOGIC:
|
||||
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
||||
D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
||||
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
||||
; VSORT IS VITALS IN REVERSE ORDER
|
||||
;
|
||||
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
|
||||
; RNF1 ARRAY FORMAT:
|
||||
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
|
||||
;
|
||||
; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
|
||||
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
|
||||
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
|
||||
N C0CVI,C0CC,ZRNF
|
||||
;S C0CVI="" ; INITIALIZE FOR $O
|
||||
F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D ; FOR EACH VITAL SIGN IN THE LIST
|
||||
. I DEBUG W VIT(C0CVI),!
|
||||
. ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
|
||||
. D:$P(VIT(C0CVI),U,3)="HT" HEIGHT
|
||||
. D:$P(VIT(C0CVI),U,3)="WT" WEIGHT
|
||||
. D:$P(VIT(C0CVI),U,3)="BP" BP
|
||||
. D:$P(VIT(C0CVI),U,3)="TMP" TMP
|
||||
. D:$P(VIT(C0CVI),U,3)="RS" RESP
|
||||
. D:$P(VIT(C0CVI),U,3)="PU" PULSE
|
||||
. D:$P(VIT(C0CVI),U,3)="PA" PAIN
|
||||
. D:'$D(ZRNF) OTHER ;IF THE VITAL ISN'T DEFINED IT IS OTHER
|
||||
. D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
|
||||
. K ZRNF
|
||||
; SAVE RIM VARIABLES SEE C0CRIMA
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
|
||||
M @ZRIM=@C0CVIT@("V")
|
||||
Q
|
||||
;
|
||||
HEIGHT
|
||||
I DEBUG W "IN VITAL: HEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
WEIGHT
|
||||
I DEBUG W "IN VITAL: WEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
BP
|
||||
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
TMP
|
||||
I DEBUG W "IN VITAL: TEMPERATURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
RESP
|
||||
I DEBUG W "IN VITAL: RESPIRATION",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
PULSE
|
||||
I DEBUG W "IN VITAL: PULSE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
PAIN
|
||||
I DEBUG W "IN VITAL: PAIN",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
OTHER
|
||||
I DEBUG W "IN VITAL: OTHER",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=$P(VIT(C0CVI),U,2)
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")=""
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
|
||||
HEIGHT1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: HEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
WEIGHT1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: WEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
BP1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
TMP1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: TEMPERATURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
RESP1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: RESPIRATION",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
PULSE1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: PULSE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
PAIN1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: PAIN",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: OTHER",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=TEXT
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")=""
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
VITSORT(VDT) ; RUN DATE SORTING ALGORITHM
|
||||
; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
|
||||
; OF DATES IN THE VITALS RESULTS
|
||||
N VDTI,VDTJ,VTDCNT
|
||||
S VTDCNT=0 ; COUNT TO BUILD ARRAY
|
||||
S VDTJ="" ; USED TO VISIT THE RESULTS
|
||||
F VDTI=0:0 D Q:$O(VIT(VDTJ))="" ; VISIT ALL RESULTS
|
||||
. S VDTJ=$O(VIT(VDTJ)) ; NEXT RESULT
|
||||
. S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
|
||||
. S VDT(VTDCNT)=$P(VIT(VDTJ),U,4) ; PULL OUT THE DATE
|
||||
S VDT(0)=VTDCNT
|
||||
Q
|
||||
;
|
||||
MAP(VITXML,C0CVIT,VITOUT) ; MAP VITAL SIGNS XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"VITTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"VITBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,VITXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
; XPATH NEEDS TO MATCH YOUR SECTION
|
||||
D QUERY^C0CXPATH(VITXML,"//VitalSigns/Result","ZINNER") ;ONE VITAL SIGN
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CVIT@("V",ZI)) Q:ZI="" D ;FOR EACH VITAL SIGN
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS VITAL SIGN XML
|
||||
. S ZVAR=$NA(@C0CVIT@("V",ZI)) ;THIS VITAL SIGN VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE VITAL SIGN
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,VITXML,@VITXML@(0),@VITXML@(0))
|
||||
N ZZTMP ; IS THIS NEEDED?
|
||||
D BUILD^C0CXPATH(ZBLD,VITOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD
|
||||
Q
|
||||
;
|
||||
C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
||||
;;1.0;C0C;;Feb 16, 2010;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY FROM TOP",!
|
||||
Q
|
||||
;
|
||||
EXTRACT(VITXML,DFN,VITOUT) ; EXTRACT VITAL SIGNS INTO XML TEMPLATE
|
||||
; VITXML AND VITOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
; USE THE FOLLOWING TEMPLATE FOR THE RNF2 ARRAYS
|
||||
; THAT GET PASSED TO *GET ROUTINES
|
||||
;C0C[NAME]=$NA(^TMP("C0CCCR",$J,DFN,"C0C(NAME))
|
||||
N C0CVIT
|
||||
S C0CVIT=$NA(^TMP("C0CCCR",$J,DFN,"C0CVIT"))
|
||||
; USE THE FOLLOWING TEMPLATE FOR GETTING/GENERATING THE RNF2 ARRAYS
|
||||
; THAT GET INSERTED INTO THE XML TEMPLATE
|
||||
; D GET[VISTA/RPMS](DFN,C0CIMM) ; GET VARS
|
||||
I $$RPMS^C0CUTIL() D GETRPMS(DFN,C0CVIT) ; GET VARS
|
||||
I ($$VISTA^C0CUTIL())!($$WV^C0CUTIL())!($$OV^C0CUTIL()) D GETVISTA(DFN,C0CVIT)
|
||||
; USE THE FOLLOWING TEMPATE FOR MAPPING RNF2 ARRAYS TO XML TEMPLATE
|
||||
; D MAP([NAME]XML,C0C[NAME],[NAME]OUT) ;MAP RESULTS FOR PROCEDURES
|
||||
D MAP(VITXML,C0CVIT,VITOUT) ;MAP RESULTS FOR PROCEDURES
|
||||
Q
|
||||
;
|
||||
GETVISTA(DFN,C0CVIT) ; CALLS VITALS^ORQQVI TO GET VITAL SIGNS.
|
||||
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CVIT: VITAL SIGNS
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST.
|
||||
;
|
||||
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
|
||||
;
|
||||
; SETUP RPC/API CALL HERE
|
||||
; USE START AND END DATES FROM PARAMETERS IF REQUIRED
|
||||
;
|
||||
N VIT,DATA,START,END
|
||||
; RPC REQUIRES FM DATES NOT T-* DATES
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
|
||||
; RPC CALL (ORY,DFN,ORSDT,OREDT):
|
||||
;ORY: return variable
|
||||
;DFN: patient identifier from Patient File [#2]
|
||||
;ORSDT: start date/time in Fileman format
|
||||
;OREDT: end date/time in Fileman format
|
||||
; OUTPUT FORMAT:
|
||||
;vital measurement ien^vital type^rate^date/time taken
|
||||
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 $P(VIT(1),U,2)="No vitals found." D Q ; signal no vitals and quit
|
||||
. I $D(VITOUT) S @VITOUT@(0)=0
|
||||
. K VIT
|
||||
;
|
||||
; PREFORM SORT HERE IF NEEDED
|
||||
;
|
||||
; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
|
||||
; COPIED SORT LOGIC:
|
||||
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
||||
D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
||||
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
||||
; VSORT IS VITALS IN REVERSE ORDER
|
||||
;
|
||||
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
|
||||
; RNF1 ARRAY FORMAT:
|
||||
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
|
||||
;
|
||||
; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
|
||||
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
|
||||
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
|
||||
N C0CVI,C0CC,ZRNF
|
||||
;S C0CVI="" ; INITIALIZE FOR $O
|
||||
F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D ; FOR EACH VITAL SIGN IN THE LIST
|
||||
. I DEBUG W VIT(C0CVI),!
|
||||
. ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
|
||||
. D:$P(VIT(C0CVI),U,3)="HT" HEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"in")
|
||||
. D:$P(VIT(C0CVI),U,3)="WT" WEIGHT1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"lbs")
|
||||
. D:$P(VIT(C0CVI),U,3)="BP" BP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:$P(VIT(C0CVI),U,3)="T" TMP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"F")
|
||||
. D:$P(VIT(C0CVI),U,3)="R" RESP1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:$P(VIT(C0CVI),U,3)="P" PULSE1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:$P(VIT(C0CVI),U,3)="PN" PAIN1($$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT"),$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"")
|
||||
. D:'$D(ZRNF) OTHER1($$FMDTOUTC^C0CUTIL($P(C0CVI,U,4),"DT"),"OTHER VITAL",$P(^GMR(120.5,$P(VIT(C0CVI),U,1),0),U,6),$P(VIT(C0CVI),U,3),"UNKNOWN") ;IF THE VITAL ISN'T DEFINED IT IS OTHER
|
||||
. D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
|
||||
. K ZRNF
|
||||
; SAVE RIM VARIABLES SEE C0CRIMA
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
|
||||
M @ZRIM=@C0CVIT@("V")
|
||||
Q
|
||||
;
|
||||
GETRPMS(DFN,C0CVIT) ; CALLS QUERY^BEHOVM TO GET VITAL SIGNS.
|
||||
; ERETURNS THEM IN RNF2 ARRAYS PASSED BY NAME
|
||||
; C0CVIT: VITAL SIGNS
|
||||
; READY TO BE MAPPED TO XML BY MAP^C0CVIT2
|
||||
; THESE RETURN ARRAYS ARE NOT INITIALIZED, BUT ARE ADDED TO IF THEY
|
||||
; EXIST.
|
||||
;
|
||||
; KILL OF ARRAYS IS TAKEN CARE OF IN ^C0CCCR (K ^TMP("C0CCCR",$J))
|
||||
;
|
||||
; SETUP RPC/API CALL HERE
|
||||
; USE START AND END DATES FROM PARAMETERS IF REQUIRED
|
||||
;
|
||||
; RPMS VITAL RPC ONLY RETURNS LATEST VITAL IN SPECIFIED DATE RANGE NOT ALL VITALS IN DATE RANGE
|
||||
; WE NEED TO SETUP THE VARIABLES THE INTERNAL CALL NEEDS TO BYPASS A HARD CODE OF ONE VITAL FOR DATE RANGE
|
||||
N C0CEDT,C0CSDT,VIT,DATA,START,END
|
||||
; RPC REQUIRES FM DATES NOT T-* DATES
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITLIMIT"),.END) ; GET THE LIMIT PARM
|
||||
D DT^DILF(,$$GET^C0CPARMS("VITSTART"),.START) ; GET START PARM
|
||||
; RPC OUTPUT FORMAT:
|
||||
; vfile ien^vital name^vital abbr^date/time taken(FM FORMAT)^value+units (US & metric)
|
||||
D QUERY^BEHOVM("LISTX") ; RUN QUERY VITALS CALL
|
||||
I '$D(^TMP("CIAVMRPC",$J)) S @VITOUT@(0)=0 K ^TMP("CIAVMRPC",$J) Q ; RETURN NOT FOUND, KILL ARRAY AND QUIT
|
||||
; MOVE THE ARRAY TO LOCAL VARIABLE
|
||||
M VIT=^TMP("CIAVMRPC",$J,0)
|
||||
; RPC CLEANUP
|
||||
K ^TMP("CIAVMRPC",$J),VITS,RMAX,START,END,DATA,METRIC,VSTR,VUNT
|
||||
;
|
||||
; PREFORM SORT HERE IF NEEDED
|
||||
;
|
||||
; SORT IS REQUIRED FOR VITAL SIGNS - LATEST VITALS NEED TO BE LISTED FIRST
|
||||
; COPIED SORT LOGIC:
|
||||
N VSORT,VDATES,VCNT ; ARRAY FOR DATE SORTED VITALS INDEX
|
||||
D VITSORT(.VDATES) ; PULL OUT THE DATES INTO AN ARRAY
|
||||
S VCNT=$$SORTDT^C0CUTIL(.VSORT,.VDATES,-1) ; PUT VITALS IN REVERSE
|
||||
; VSORT IS VITALS IN REVERSE ORDER
|
||||
;
|
||||
; MAP EACH ROW OF RPC/API TO RNF1 ARRAY
|
||||
; RNF1 ARRAY FORMAT:
|
||||
; VAR("NAME_OF_RIM_VARIABLE")=VALUE
|
||||
;
|
||||
; VITAL SIGNS ARE DONE DIFFERENTLY DUE TO THE DIFFERENT TYPES OF VITAL SIGNS
|
||||
; THIS LOOP WILL GET EACH ROW, DETERMINE THE TYPE, AND CALL THE RESPECTIVE PROCESSING METHOD
|
||||
; THAT WILL DO THE MAPPING TO RNF1 STYLE ARRAYS
|
||||
N C0CVI,C0CC,ZRNF
|
||||
;S C0CVI="" ; INITIALIZE FOR $O
|
||||
F C0CC=1:1:VSORT(0) S C0CVI=VSORT(C0CC) D ; FOR EACH VITAL SIGN IN THE LIST
|
||||
. I DEBUG W VIT(C0CVI),!
|
||||
. ; FIGURE OUT WHICH TYPE OF VITAL SIGN IT IS (HEIGHT, WEIGHT, BLOOD PRESSURE, TEMPERATURE, RESPIRATION, PULSE, PAIN, OTHER)
|
||||
. D:$P(VIT(C0CVI),U,3)="HT" HEIGHT
|
||||
. D:$P(VIT(C0CVI),U,3)="WT" WEIGHT
|
||||
. D:$P(VIT(C0CVI),U,3)="BP" BP
|
||||
. D:$P(VIT(C0CVI),U,3)="TMP" TMP
|
||||
. D:$P(VIT(C0CVI),U,3)="RS" RESP
|
||||
. D:$P(VIT(C0CVI),U,3)="PU" PULSE
|
||||
. D:$P(VIT(C0CVI),U,3)="PA" PAIN
|
||||
. D:'$D(ZRNF) OTHER ;IF THE VITAL ISN'T DEFINED IT IS OTHER
|
||||
. D RNF1TO2^C0CRNF(C0CVIT,"ZRNF") ;ADD THIS ROW TO THE ARRAY
|
||||
. K ZRNF
|
||||
; SAVE RIM VARIABLES SEE C0CRIMA
|
||||
N ZRIM S ZRIM=$NA(^TMP("C0CRIM","VARS",DFN,"VITALS"))
|
||||
M @ZRIM=@C0CVIT@("V")
|
||||
Q
|
||||
;
|
||||
HEIGHT
|
||||
I DEBUG W "IN VITAL: HEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
WEIGHT
|
||||
I DEBUG W "IN VITAL: WEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
BP
|
||||
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
TMP
|
||||
I DEBUG W "IN VITAL: TEMPERATURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
RESP
|
||||
I DEBUG W "IN VITAL: RESPIRATION",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
PULSE
|
||||
I DEBUG W "IN VITAL: PULSE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
PAIN
|
||||
I DEBUG W "IN VITAL: PAIN",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
OTHER
|
||||
I DEBUG W "IN VITAL: OTHER",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=$$FMDTOUTC^C0CUTIL($P(VIT(C0CVI),U,4),"DT")
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=$P(VIT(C0CVI),U,2)
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")=""
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_$P($G(^AUPNVMSR($P(VIT(C0CVI),U,1),12)),U,4)
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=$P($P(VIT(C0CVI),U,5)," ",1)
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=$P($P(VIT(C0CVI),U,5)," ",2)
|
||||
Q
|
||||
;
|
||||
;TEMPORARY, THINKING ON HOW TO REFACTOR (CJE)
|
||||
HEIGHT1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: HEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC ; UNIQUE OBJID
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="HEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="248327008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
WEIGHT1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: WEIGHT",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="WEIGHT"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="107647005"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
BP1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: BLOOD PRESSURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="BLOOD PRESSURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="392570002"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
TMP1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: TEMPERATURE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="TEMPERATURE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="309646008"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
RESP1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: RESPIRATION",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="RESPIRATION"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366147009"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
PULSE1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: PULSE",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PULSE"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="366199006"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
PAIN1(DT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: PAIN",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")="PAIN"
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")="22253000"
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")="SNOMED"
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
OTHER1(DT,TEXT,ACTOR,VALUE,UNIT)
|
||||
I DEBUG W "IN VITAL: OTHER",!
|
||||
S ZRNF("VITALSIGNSDATAOBJECTID")="VITAL"_C0CC
|
||||
S ZRNF("VITALSIGNSDATETIMETYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSEXACTDATETIME")=DT
|
||||
S ZRNF("VITALSIGNSDESCRIPTIONTEXT")=TEXT
|
||||
S ZRNF("VITALSIGNSSOURCEACTORID")="ACTORSYSTEM_1"
|
||||
S ZRNF("VITALSIGNSTESTOBJECTID")="VITALTEST"_C0CC
|
||||
S ZRNF("VITALSIGNSTESTTYPETEXT")="OBSERVED"
|
||||
S ZRNF("VITALSIGNSDESCCODEVALUE")=""
|
||||
S ZRNF("VITALSIGNSDESCCODINGSYSTEM")=""
|
||||
S ZRNF("VITALSIGNSCODEVERSION")=""
|
||||
S ZRNF("VITALSIGNSTESTSOURCEACTORID")="ACTORPROVIDER_"_ACTOR
|
||||
S ZRNF("VITALSIGNSTESTRESULTVALUE")=VALUE
|
||||
S ZRNF("VITALSIGNSTESTRESULTUNIT")=UNIT
|
||||
Q
|
||||
;
|
||||
VITSORT(VDT) ; RUN DATE SORTING ALGORITHM
|
||||
; VDT IS PASSED BY REFERENCE AND WILL CONTAIN THE ARRAY
|
||||
; OF DATES IN THE VITALS RESULTS
|
||||
N VDTI,VDTJ,VTDCNT
|
||||
S VTDCNT=0 ; COUNT TO BUILD ARRAY
|
||||
S VDTJ="" ; USED TO VISIT THE RESULTS
|
||||
F VDTI=0:0 D Q:$O(VIT(VDTJ))="" ; VISIT ALL RESULTS
|
||||
. S VDTJ=$O(VIT(VDTJ)) ; NEXT RESULT
|
||||
. S VTDCNT=VTDCNT+1 ; INCREMENT COUNTER
|
||||
. S VDT(VTDCNT)=$P(VIT(VDTJ),U,4) ; PULL OUT THE DATE
|
||||
S VDT(0)=VTDCNT
|
||||
Q
|
||||
;
|
||||
MAP(VITXML,C0CVIT,VITOUT) ; MAP VITAL SIGNS XML
|
||||
;
|
||||
N ZTEMP S ZTEMP=$NA(^TMP("C0CCCR",$J,DFN,"VITTEMP")) ;WORK AREA FOR TEMPLATE
|
||||
K @ZTEMP
|
||||
N ZBLD
|
||||
S ZBLD=$NA(^TMP("C0CCCR",$J,DFN,"VITBLD")) ; BUILD LIST AREA
|
||||
D QUEUE^C0CXPATH(ZBLD,VITXML,1,1) ; FIRST LINE
|
||||
N ZINNER
|
||||
; XPATH NEEDS TO MATCH YOUR SECTION
|
||||
D QUERY^C0CXPATH(VITXML,"//VitalSigns/Result","ZINNER") ;ONE VITAL SIGN
|
||||
N ZTMP,ZVAR,ZI
|
||||
S ZI=""
|
||||
F S ZI=$O(@C0CVIT@("V",ZI)) Q:ZI="" D ;FOR EACH VITAL SIGN
|
||||
. S ZTMP=$NA(@ZTEMP@(ZI)) ;THIS VITAL SIGN XML
|
||||
. S ZVAR=$NA(@C0CVIT@("V",ZI)) ;THIS VITAL SIGN VARIABLES
|
||||
. D MAP^C0CXPATH("ZINNER",ZVAR,ZTMP) ; MAP THE VITAL SIGN
|
||||
. D QUEUE^C0CXPATH(ZBLD,ZTMP,1,@ZTMP@(0)) ;QUEUE FOR BUILD
|
||||
D QUEUE^C0CXPATH(ZBLD,VITXML,@VITXML@(0),@VITXML@(0))
|
||||
N ZZTMP ; IS THIS NEEDED?
|
||||
D BUILD^C0CXPATH(ZBLD,VITOUT) ;BUILD FINAL XML
|
||||
K @ZTEMP,@ZBLD
|
||||
Q
|
||||
;
|
||||
|
|
422
p/C0CXPAT0.m
422
p/C0CXPAT0.m
|
@ -1,212 +1,212 @@
|
|||
C0CXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY",!
|
||||
Q
|
||||
;
|
||||
;;><TEST>
|
||||
;;><INIT>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D PUSH^C0CXPATH("C0C","FIRST")
|
||||
;;>>>D PUSH^C0CXPATH("C0C","SECOND")
|
||||
;;>>>D PUSH^C0CXPATH("C0C","THIRD")
|
||||
;;>>>D PUSH^C0CXPATH("C0C","FOURTH")
|
||||
;;>>?C0C(0)=4
|
||||
;;><INITXML>
|
||||
;;>>>K GXML S GXML=""
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FIFTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FIFTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SIXTH ID=""SELF"" />")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
|
||||
;;><INITXML2>
|
||||
;;>>>K GXML S GXML=""
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA1</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","DATA2")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA3</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</_SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
|
||||
;;><PUSHPOP>
|
||||
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
||||
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
|
||||
;;>>?C0C(C0C(0))="FOURTH"
|
||||
;;>>>D POP^C0CXPATH("C0C",.GX)
|
||||
;;>>?GX="FOURTH"
|
||||
;;>>?C0C(C0C(0))="THIRD"
|
||||
;;>>>D POP^C0CXPATH("C0C",.GX)
|
||||
;;>>?GX="THIRD"
|
||||
;;>>?C0C(C0C(0))="SECOND"
|
||||
;;><MKMDX>
|
||||
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
||||
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
|
||||
;;>>>S GX=""
|
||||
;;>>>D MKMDX^C0CXPATH("C0C",.GX)
|
||||
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
|
||||
;;><XNAME>
|
||||
;;>>?$$XNAME^C0CXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
|
||||
;;>>?$$XNAME^C0CXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
|
||||
;;>>?$$XNAME^C0CXPATH("</THIRD>")="THIRD"
|
||||
;;><INDEX>
|
||||
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
||||
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INITXML")
|
||||
;;>>>D INDEX^C0CXPATH("GXML")
|
||||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4^@@DATA1@@"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8^"
|
||||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||||
;;>>?GXML("//FIRST")="1^13"
|
||||
;;><INDEX2>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML2")
|
||||
;;>>>D INDEX^C0CXPATH("GXML")
|
||||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||||
;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
|
||||
;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10^DATA3"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH[1]")="4^4^DATA1"
|
||||
;;>>?GXML("//FIRST")="1^13"
|
||||
;;><MISSING>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
|
||||
;;>>>D MISSING^C0CXPATH("GXML",OUTARY)
|
||||
;;>>?@OUTARY@(1)="DATA1"
|
||||
;;>>?@OUTARY@(2)="DATA2"
|
||||
;;><MAP>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
|
||||
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
|
||||
;;>>>S @MAPARY@("DATA2")="VALUE2"
|
||||
;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
|
||||
;;>>?@OUTARY@(6)="VALUE2"
|
||||
;;><MAP2>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
|
||||
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
|
||||
;;>>>S @MAPARY@("DATA1")="VALUE1"
|
||||
;;>>>S @MAPARY@("DATA2")="VALUE2"
|
||||
;;>>>S @MAPARY@("DATA3")="VALUE3"
|
||||
;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
|
||||
;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
|
||||
;;>>>D PARY^C0CXPATH(OUTARY)
|
||||
;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
|
||||
;;><QUEUE>
|
||||
;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3)
|
||||
;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5)
|
||||
;;>>?$P(BTLIST(2),";",2)=4
|
||||
;;><BUILD>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
|
||||
;;>>>D ZTEST^C0CXPATH("QUEUE")
|
||||
;;>>>D BUILD^C0CXPATH("BTLIST","G3")
|
||||
;;><CP>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D CP^C0CXPATH("GXML","G2")
|
||||
;;>>?G2(0)=13
|
||||
;;><QOPEN>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QOPEN^C0CXPATH("GBL","GXML")
|
||||
;;>>?$P(GBL(1),";",3)=12
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</SECOND>"
|
||||
;;><QOPEN2>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QOPEN^C0CXPATH("GBL","GXML","//FIRST/SECOND")
|
||||
;;>>?$P(GBL(1),";",3)=11
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</SECOND>"
|
||||
;;><QCLOSE>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QCLOSE^C0CXPATH("GBL","GXML")
|
||||
;;>>?$P(GBL(1),";",3)=13
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</FIRST>"
|
||||
;;><QCLOSE2>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QCLOSE^C0CXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
|
||||
;;>>?$P(GBL(1),";",3)=13
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</FIRST>"
|
||||
;;>>?G2(1)="</THIRD>"
|
||||
;;><INSERT>
|
||||
;;>>>K G2,GBL,G3,G4
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
||||
;;>>>D INSERT^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
||||
;;>>>D INSERT^C0CXPATH("G3","G2","//")
|
||||
;;>>?G2(1)=GXML(9)
|
||||
;;><REPLACE>
|
||||
;;>>>K G2,GBL,G3
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
||||
;;>>>D REPLACE^C0CXPATH("GXML","G2","//FIRST/SECOND")
|
||||
;;>>?GXML(2)="<FIFTH>"
|
||||
;;><INSINNER>
|
||||
;;>>>K GXML,G2,GBL,G3
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
||||
;;>>>D INSINNER^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
||||
;;>>?GXML(10)="<FIFTH>"
|
||||
;;><INSINNER2>
|
||||
;;>>>K GXML,G2,GBL,G3
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
||||
;;>>>D INSINNER^C0CXPATH("G2","G2")
|
||||
;;>>?G2(8)="<FIFTH>"
|
||||
;;><PUSHA>
|
||||
;;>>>K GTMP,GTMP2
|
||||
;;>>>N GTMP,GTMP2
|
||||
;;>>>D PUSH^C0CXPATH("GTMP","A")
|
||||
;;>>>D PUSH^C0CXPATH("GTMP2","B")
|
||||
;;>>>D PUSH^C0CXPATH("GTMP2","C")
|
||||
;;>>>D PUSHA^C0CXPATH("GTMP","GTMP2")
|
||||
;;>>?GTMP(3)="C"
|
||||
;;>>?GTMP(0)=3
|
||||
;;><H2ARY>
|
||||
;;>>>K GTMP,GTMP2
|
||||
;;>>>S GTMP("TEST1")=1
|
||||
;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP")
|
||||
;;>>?GTMP2(0)=1
|
||||
;;>>?GTMP2(1)="^TEST1^1"
|
||||
;;><XVARS>
|
||||
;;>>>K GTMP,GTMP2
|
||||
;;>>>D PUSH^C0CXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
|
||||
;;>>>D XVARS^C0CXPATH("GTMP2","GTMP")
|
||||
;;>>?GTMP2(1)="^VAR1^1"
|
||||
;;></TEST>
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;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
|
||||
;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,
|
||||
;but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;GNU 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.
|
||||
;
|
||||
W "NO ENTRY",!
|
||||
Q
|
||||
;
|
||||
;;><TEST>
|
||||
;;><INIT>
|
||||
;;>>>K C0C S C0C=""
|
||||
;;>>>D PUSH^C0CXPATH("C0C","FIRST")
|
||||
;;>>>D PUSH^C0CXPATH("C0C","SECOND")
|
||||
;;>>>D PUSH^C0CXPATH("C0C","THIRD")
|
||||
;;>>>D PUSH^C0CXPATH("C0C","FOURTH")
|
||||
;;>>?C0C(0)=4
|
||||
;;><INITXML>
|
||||
;;>>>K GXML S GXML=""
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>@@DATA1@@</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FIFTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","@@DATA2@@")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FIFTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SIXTH ID=""SELF"" />")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
|
||||
;;><INITXML2>
|
||||
;;>>>K GXML S GXML=""
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FIRST>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA1</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","DATA2")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</THIRD>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<_SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","<FOURTH>DATA3</FOURTH>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</_SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</SECOND>")
|
||||
;;>>>D PUSH^C0CXPATH("GXML","</FIRST>")
|
||||
;;><PUSHPOP>
|
||||
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
||||
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
|
||||
;;>>?C0C(C0C(0))="FOURTH"
|
||||
;;>>>D POP^C0CXPATH("C0C",.GX)
|
||||
;;>>?GX="FOURTH"
|
||||
;;>>?C0C(C0C(0))="THIRD"
|
||||
;;>>>D POP^C0CXPATH("C0C",.GX)
|
||||
;;>>?GX="THIRD"
|
||||
;;>>?C0C(C0C(0))="SECOND"
|
||||
;;><MKMDX>
|
||||
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
||||
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INIT")
|
||||
;;>>>S GX=""
|
||||
;;>>>D MKMDX^C0CXPATH("C0C",.GX)
|
||||
;;>>?GX="//FIRST/SECOND/THIRD/FOURTH"
|
||||
;;><XNAME>
|
||||
;;>>?$$XNAME^C0CXPATH("<FOURTH>DATA1</FOURTH>")="FOURTH"
|
||||
;;>>?$$XNAME^C0CXPATH("<SIXTH ID=""SELF"" />")="SIXTH"
|
||||
;;>>?$$XNAME^C0CXPATH("</THIRD>")="THIRD"
|
||||
;;><INDEX>
|
||||
;;>>>D ZLOAD^C0CUNIT("ZTMP","C0CXPAT0")
|
||||
;;>>>D ZTEST^C0CUNIT(.ZTMP,"INITXML")
|
||||
;;>>>D INDEX^C0CXPATH("GXML")
|
||||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD")="3^9"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/FIFTH")="5^7"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH")="4^4^@@DATA1@@"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/SIXTH")="8^8^"
|
||||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||||
;;>>?GXML("//FIRST")="1^13"
|
||||
;;><INDEX2>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML2")
|
||||
;;>>>D INDEX^C0CXPATH("GXML")
|
||||
;;>>?GXML("//FIRST/SECOND")="2^12"
|
||||
;;>>?GXML("//FIRST/SECOND/_SECOND")="9^11"
|
||||
;;>>?GXML("//FIRST/SECOND/_SECOND/FOURTH")="10^10^DATA3"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD")="3^8"
|
||||
;;>>?GXML("//FIRST/SECOND/THIRD/FOURTH[1]")="4^4^DATA1"
|
||||
;;>>?GXML("//FIRST")="1^13"
|
||||
;;><MISSING>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>S OUTARY="^TMP($J,""MISSINGTEST"")"
|
||||
;;>>>D MISSING^C0CXPATH("GXML",OUTARY)
|
||||
;;>>?@OUTARY@(1)="DATA1"
|
||||
;;>>?@OUTARY@(2)="DATA2"
|
||||
;;><MAP>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
|
||||
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
|
||||
;;>>>S @MAPARY@("DATA2")="VALUE2"
|
||||
;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
|
||||
;;>>?@OUTARY@(6)="VALUE2"
|
||||
;;><MAP2>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>S MAPARY="^TMP($J,""MAPVALUES"")"
|
||||
;;>>>S OUTARY="^TMP($J,""MAPTEST"")"
|
||||
;;>>>S @MAPARY@("DATA1")="VALUE1"
|
||||
;;>>>S @MAPARY@("DATA2")="VALUE2"
|
||||
;;>>>S @MAPARY@("DATA3")="VALUE3"
|
||||
;;>>>S GXML(4)="<FOURTH>@@DATA1@@ AND @@DATA3@@</FOURTH>"
|
||||
;;>>>D MAP^C0CXPATH("GXML",MAPARY,OUTARY)
|
||||
;;>>>D PARY^C0CXPATH(OUTARY)
|
||||
;;>>?@OUTARY@(4)="<FOURTH>VALUE1 AND VALUE3</FOURTH>"
|
||||
;;><QUEUE>
|
||||
;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",2,3)
|
||||
;;>>>D QUEUE^C0CXPATH("BTLIST","GXML",4,5)
|
||||
;;>>?$P(BTLIST(2),";",2)=4
|
||||
;;><BUILD>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FOURTH","G2")
|
||||
;;>>>D ZTEST^C0CXPATH("QUEUE")
|
||||
;;>>>D BUILD^C0CXPATH("BTLIST","G3")
|
||||
;;><CP>
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D CP^C0CXPATH("GXML","G2")
|
||||
;;>>?G2(0)=13
|
||||
;;><QOPEN>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QOPEN^C0CXPATH("GBL","GXML")
|
||||
;;>>?$P(GBL(1),";",3)=12
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</SECOND>"
|
||||
;;><QOPEN2>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QOPEN^C0CXPATH("GBL","GXML","//FIRST/SECOND")
|
||||
;;>>?$P(GBL(1),";",3)=11
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</SECOND>"
|
||||
;;><QCLOSE>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QCLOSE^C0CXPATH("GBL","GXML")
|
||||
;;>>?$P(GBL(1),";",3)=13
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</FIRST>"
|
||||
;;><QCLOSE2>
|
||||
;;>>>K G2,GBL
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QCLOSE^C0CXPATH("GBL","GXML","//FIRST/SECOND/THIRD")
|
||||
;;>>?$P(GBL(1),";",3)=13
|
||||
;;>>>D BUILD^C0CXPATH("GBL","G2")
|
||||
;;>>?G2(G2(0))="</FIRST>"
|
||||
;;>>?G2(1)="</THIRD>"
|
||||
;;><INSERT>
|
||||
;;>>>K G2,GBL,G3,G4
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
||||
;;>>>D INSERT^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
||||
;;>>>D INSERT^C0CXPATH("G3","G2","//")
|
||||
;;>>?G2(1)=GXML(9)
|
||||
;;><REPLACE>
|
||||
;;>>>K G2,GBL,G3
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD/FIFTH","G2")
|
||||
;;>>>D REPLACE^C0CXPATH("GXML","G2","//FIRST/SECOND")
|
||||
;;>>?GXML(2)="<FIFTH>"
|
||||
;;><INSINNER>
|
||||
;;>>>K GXML,G2,GBL,G3
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
||||
;;>>>D INSINNER^C0CXPATH("GXML","G2","//FIRST/SECOND/THIRD")
|
||||
;;>>?GXML(10)="<FIFTH>"
|
||||
;;><INSINNER2>
|
||||
;;>>>K GXML,G2,GBL,G3
|
||||
;;>>>D ZTEST^C0CXPATH("INITXML")
|
||||
;;>>>D QUERY^C0CXPATH("GXML","//FIRST/SECOND/THIRD","G2")
|
||||
;;>>>D INSINNER^C0CXPATH("G2","G2")
|
||||
;;>>?G2(8)="<FIFTH>"
|
||||
;;><PUSHA>
|
||||
;;>>>K GTMP,GTMP2
|
||||
;;>>>N GTMP,GTMP2
|
||||
;;>>>D PUSH^C0CXPATH("GTMP","A")
|
||||
;;>>>D PUSH^C0CXPATH("GTMP2","B")
|
||||
;;>>>D PUSH^C0CXPATH("GTMP2","C")
|
||||
;;>>>D PUSHA^C0CXPATH("GTMP","GTMP2")
|
||||
;;>>?GTMP(3)="C"
|
||||
;;>>?GTMP(0)=3
|
||||
;;><H2ARY>
|
||||
;;>>>K GTMP,GTMP2
|
||||
;;>>>S GTMP("TEST1")=1
|
||||
;;>>>D H2ARY^C0CXPATH("GTMP2","GTMP")
|
||||
;;>>?GTMP2(0)=1
|
||||
;;>>?GTMP2(1)="^TEST1^1"
|
||||
;;><XVARS>
|
||||
;;>>>K GTMP,GTMP2
|
||||
;;>>>D PUSH^C0CXPATH("GTMP","<VALUE>@@VAR1@@</VALUE>")
|
||||
;;>>>D XVARS^C0CXPATH("GTMP2","GTMP")
|
||||
;;>>?GTMP2(1)="^VAR1^1"
|
||||
;;></TEST>
|
||||
|
|
1384
p/C0CXPATH.m
1384
p/C0CXPATH.m
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue