updates for MU Certification
This commit is contained in:
george
parent
ac1f7a441b
commit
07194d2d80
|
|
@ -1,5 +1,5 @@
|
|||
C0CACTOR ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ACTORS ; 7/3/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
15
p/C0CALERT.m
15
p/C0CALERT.m
|
|
@ -1,5 +1,5 @@
|
|||
C0CALERT ; CCDCCR/CKU/GPL - CCR/CCD PROCESSING FOR ALERTS ; 09/11/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
@ -55,7 +55,7 @@ EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE
|
|||
. 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 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
|
||||
|
|
@ -80,15 +80,22 @@ EXTRACT(ALTXML,DFN,ALTOUTXML,CALLBK) ; EXTRACT ALERTS INTO XML TEMPLATE
|
|||
. S @ALTVMAP@("ALERTAGENTPRODUCTSOURCEID")="" ; WHERE DO WE GET THIS?
|
||||
. S ACNM=$P(@ALTG@(ALTTMP),U,2) ; REACTANT
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTNAMETEXT")=ACNM
|
||||
. S @ALTVMAP@("ALERTAGENTPRODUCTCODEVALUE")=ACVUID
|
||||
. N ZC,ZCD,ZCDS,ZCDSV ; CODE,CODE SYSTEM,CODE VERSION
|
||||
. I ACVUID'="" D ; IF VUID IS NOT NULL
|
||||
. . S @ALTVMAP@("ALERTAGENTPRODUCTCODESYSTEM")="VUID"
|
||||
. . 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)=""
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CBAT ; CCDCCR/GPL - CCR Batch utilities; 4/21/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CCCD ; CCDCCR/GPL - CCD MAIN PROCESSING; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CCCD1 ; CCDCCR/GPL - CCD TEMPLATE AND ACCESS ROUTINES; 6/7/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CCCR ; CCDCCR/GPL - CCR MAIN PROCESSING; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CCCR0 ; CCDCCR/GPL - CCR TEMPLATE AND ACCESS ROUTINES; 5/31/08
|
||||
;;1.0;C0C;;May 19, 2009;Build 32
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CCMT ; CCDCCR/GPL - CCR/CCD PROCESSING FOR COMMENTS ; 05/21/10
|
||||
;;1.0;C0C;;May 21, 2010;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
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
|
||||
;
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CDPT ;WV/CCRCCD/SMH - Routines to Extract Patient Data for CCDCCR; 6/15/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;1.0;C0C;;May 19, 2009;Build 38
|
||||
;
|
||||
; Copyright 2008 WorldVistA. Licensed under the terms of the GNU
|
||||
; General Public License.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CENC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR ENCOUNTERS ; 05/21/10
|
||||
;;1.0;C0C;;May 21, 2010;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
;
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
C0CEWD ; CCDCCR/GPL - CCR EWD utilities; 1/6/11
|
||||
;;0.1;CCDCCR;nopatch;noreleasedate
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CFM1 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CFM2 ; CCDCCR/GPL - CCR FILEMAN utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CIM2 ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 01/27/10
|
||||
;;1.0;C0C;;Feb 16, 2010;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CIMMU ; CCDCCR/GPL - CCR/CCD PROCESSING FOR IMMUNIZATIONS ; 2/2/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CIN ; CCDCCR/GPL - CCR IMPORT utilities; 9/20/08
|
||||
;;1.0;C0C;;Sep 20, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CALABS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR LAB RESULTS ; 10/01/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
@ -190,7 +190,8 @@ LIST ; LIST THE HL7 MESSAGE; ALSO, EXTRACT THE RESULT VARIABLES TO C0CLB
|
|||
. . 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
|
||||
. . . ;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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
; ===================
|
||||
13
p/C0CMED.m
13
p/C0CMED.m
|
|
@ -1,5 +1,5 @@
|
|||
C0CMED ; WV/CCDCCR/GPL/SMH - CCR/CCD Medications Driver; Mar 23 2009
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
@ -78,11 +78,15 @@ VISTA
|
|||
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
|
||||
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",!
|
||||
|
|
@ -94,6 +98,10 @@ VISTA
|
|||
. 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
|
||||
|
|
@ -101,5 +109,6 @@ VISTA
|
|||
K @PEND
|
||||
K @HIST
|
||||
K @NVA
|
||||
K @IPUD
|
||||
Q
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CMED1 ; WV/CCDCCR/SMH - CCR/CCD PROCESSING FOR MEDICATIONS ;01/10/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
@ -71,7 +71,7 @@ EXTRACT(MINXML,DFN,OUTXML,MEDCOUNT,FLAGS) ; EXTRACT MEDICATIONS INTO PROVIDED XM
|
|||
. 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@("MEDLASTFILLDATE")=$$FMDTOUTC^C0CUTIL($P($G(MED(101)),U))
|
||||
. S @MAP@("MEDRXNOTXT")="Prescription Number"
|
||||
. S @MAP@("MEDRXNO")=MED(.01)
|
||||
. S @MAP@("MEDTYPETEXT")="Medication"
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CMED2 ; WV/CCDCCR/SMH - CCR/CCD Meds - Pending for Vista
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CMED3 ; WV/CCDCCR/SMH - Meds: Non-VA/Outside Meds for Vista
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
44
p/C0CMIME.m
44
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,7 +132,9 @@ 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
|
||||
|
|
@ -117,9 +145,9 @@ MAILSEND(RTN,FROM,TO,CC,SUBJECT,MESSAGE,ATTACH,FLAGS) ; MAIL SENDING INTERFACE
|
|||
;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(8)="Content-Disposition: attachment; filename="_FNAME
|
||||
S GM(9)=""
|
||||
S GM(10)="" ; FOR THE END
|
||||
;S GM(11)="--123456788888--"
|
||||
|
|
|
|||
38
p/C0CMXML.m
38
p/C0CMXML.m
|
|
@ -1,5 +1,5 @@
|
|||
C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05
|
||||
;;0.1;C0C;nopatch;noreleasedate
|
||||
;;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.
|
||||
;
|
||||
|
|
@ -23,42 +23,10 @@ C0CMXML ; GPL - MXML based XPath utilities;10/13/09 17:05
|
|||
; 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 ;
|
||||
TEST ;
|
||||
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)
|
||||
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)
|
||||
|
|
|
|||
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"" ?>"
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CMXP ; GPL - MXML based XPath utilities;12/04/09 17:05
|
||||
;;0.1;C0C;nopatch;noreleasedate
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
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
|
||||
;
|
||||
|
|
@ -1,5 +1,5 @@
|
|||
C0CPARMS ; CCDCCR/GPL - CCR/CCD PARAMETER PROCESSING ; 1/29/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CPROBS ; CCDCCR/GPL/CJE - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CPROC ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROCEDURES ; 01/21/10
|
||||
;;1.0;C0C;;Jan 21, 2010;
|
||||
;;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.
|
||||
|
|
|
|||
17
p/C0CRIMA.m
17
p/C0CRIMA.m
|
|
@ -1,5 +1,5 @@
|
|||
C0CRIMA ; CCDCCR/GPL - RIM REPORT ROUTINES; 6/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
|
|
@ -414,7 +414,7 @@ PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
|
|||
;
|
||||
I '$D(RIMBASE) D AINIT ; INITIALIZE GLOBAL NAMES AND TABLES
|
||||
N ZLST
|
||||
S LSTRTN(0)=0 ; DEFAULT RETURN NONE
|
||||
S @LSTRTN@(0)=0 ; DEFAULT RETURN NONE
|
||||
S ZCBASE=$NA(@RIMBASE@("RIMTBL","CATS")) ; BASE OF CATEGORIES
|
||||
S ZPBASE=$NA(@RIMBASE@("RIMTBL","PATS")) ; BASE OF PATIENTS
|
||||
N ZNC ; ZNC IS NUMBER OF CATEGORIES
|
||||
|
|
@ -429,7 +429,7 @@ PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
|
|||
. . S ZCATTBL=$P(@ZCBASE@(ZATBL),"^",1) ; NAME OF TBL
|
||||
. . M @LSTRTN=@ZPBASE@(ZCATTBL) ; MERGE PATS FROM CAT
|
||||
S ZCNT=0 ; INITIALIZE COUNT OF PATIENTS
|
||||
S ZPAT="" ; START AT FIRST PATIENT IN LIST
|
||||
S ZPAT=0 ; START AT FIRST PATIENT IN LIST
|
||||
F S ZPAT=$O(@LSTRTN@(ZPAT)) Q:ZPAT="" D ;
|
||||
. S ZCNT=ZCNT+1
|
||||
S @LSTRTN@(0)=ZCNT ; COUNT OF PATIENTS IN ARRAY
|
||||
|
|
@ -437,13 +437,16 @@ PCLST(LSTRTN,IATTR) ; RETURNS ARRAY OF PATIENTS WITH ATTRIBUTE IATTR
|
|||
;
|
||||
DCPAT(CATTR) ; DISPLAY LIST OF PATIENTS WITH ATTRIBUTE CATTR
|
||||
;
|
||||
N ZR
|
||||
D PCLST(.ZR,CATTR)
|
||||
;N ZR
|
||||
D PCLST("ZR",CATTR)
|
||||
I ZR(0)=0 D Q ;
|
||||
. W "NO PATIENTS RETURNED",!
|
||||
E D ;
|
||||
. D PARY^C0CXPATH("ZR") ; PRINT ARRAY
|
||||
. W "COUNT=",ZR(0),!
|
||||
. N ZI S ZI=0
|
||||
. F S ZI=$O(ZR(ZI)) Q:ZI="" D ;
|
||||
. . W !,ZI
|
||||
. ;D PARY^C0CXPATH("ZR") ; PRINT ARRAY
|
||||
. W !,"COUNT=",ZR(0)
|
||||
Q
|
||||
;
|
||||
RPCGV(RTN,DFN,WHICH) ; RPC GET VARS
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CRNF ; CCDCCR/GPL - Reference Name Format (RNF) utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CRXN ; CCDCCR/GPL - CCR RXN utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CSOAP ; CCDCCR/GPL - SOAP WEB SERVICE utilities; 8/25/09
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CSUB1 ; CCDCCR/GPL - CCR SUBSCRIPTION utilities; 12/6/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CSYS ;WV/C0C/SMH - Routine to Get EHR System Information;6JUL2008
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CUNIT ; CCDCCR/GPL - Unit Testing Library; 5/07/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
18
p/C0CUTIL.m
18
p/C0CUTIL.m
|
|
@ -1,5 +1,5 @@
|
|||
C0CUTIL ;WV/C0C/SMH - Various Utilites for generating the CCR/CCD;06/15/08
|
||||
;;0.1;C0C;;Jun 15, 2008;Build 29
|
||||
;;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.
|
||||
|
|
@ -134,6 +134,22 @@ DASNALL(WHICH) ; ROUTINE TO EXAMINE THE ADIS INDEX IN LEX AND RETRIEVE ALL
|
|||
. W DASTMP,"=",DASNO,! ; PRINT IT OUT
|
||||
Q
|
||||
;
|
||||
RXNFN() Q 1130590011.001 ; RxNorm Concepts file number
|
||||
;
|
||||
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
|
||||
;
|
||||
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?
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CVA200 ;WV/C0C/SMH - Routine to get Provider Data;07/13/2008
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CVIT2 ; CCDCCR/CJE/GPL - CCR/CCD PROCESSING FOR VITALS ; 07/16/08
|
||||
;;1.0;C0C;;Feb 16, 2010;
|
||||
;;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.
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CXPAT0 ; CCDCCR/GPL - XPATH TEST CASES ; 6/1/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
C0CXPATH ; CCDCCR/GPL - XPATH XML manipulation utilities; 6/1/08
|
||||
;;1.0;C0C;;May 19, 2009;
|
||||
;;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.
|
||||
;
|
||||
|
|
|
|||
Loading…
Reference in New Issue