iSharkFly-Open
/
VistA-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improvements to Problems and Alerts, added dates, type

This commit is contained in:
george 2009-01-25 20:29:07 +00:00
parent 04b65dcbfb
commit 7c4cbf2eb7
4 changed files with 36 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
p/C0CRNF.m
View File

@ -50,7 +50,7 @@ GETNOLD(GRTN,GFILE,GIEN,GNN) ; GET FIELDS FOR ACCESS BY NAME
E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED) E S C0CNN=1 ; NON-NULL IS TRUE (ONLY POPULATED FIELDS RETURNED)
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
D GETS^DIQ(GFILE,C0CREF,"**","","C0CTMP") D GETS^DIQ(GFILE,C0CREF,"**","I","C0CTMP")
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE
S (C0CI,C0CJ)="" S (C0CI,C0CJ)=""
@ -104,7 +104,7 @@ GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE
D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP
K C0CTMP K C0CTMP
D GETS^DIQ(GFILE,C0CREF,"**","","C0CTMP") D GETS^DIQ(GFILE,C0CREF,"**","IE","C0CTMP")
D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE D FIELDS(GRTN,GFILE) ;GET ALL THE FIELD NAMES FOR THE FILE
S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE
S (C0CI,C0CJ)="" S (C0CI,C0CJ)=""
@ -113,7 +113,7 @@ GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
. F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS . F S C0CI=$O(C0CTMP(C0CJ,C0CREF,C0CI)) Q:C0CI="" D ; ARRAY OF FIELDS
. . ;W C0CJ," ",C0CI,! . . ;W C0CJ," ",C0CI,!
. . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME . . S C0CNAME=$P(^DD(C0CJ,C0CI,0),"^",1) ;PULL THE FIELD NAME
. . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI) ; . . S C0CVALUE=C0CTMP(C0CJ,C0CREF,C0CI,"E") ;
. . I C0CVALUE["C0CTMP" D ; WP FIELD . . I C0CVALUE["C0CTMP" D ; WP FIELD
. . . N ZT,ZWP S ZWP=0 ;ITERATOR . . . N ZT,ZWP S ZWP=0 ;ITERATOR
. . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE . . . S ZWP=$O(C0CTMP(C0CJ,C0CREF,C0CI,ZWP)) ; INIT TO FIRST LINE
@ -123,6 +123,7 @@ GETN1(GRTN,GFILE,GREF,GNDX,GNN) ; NEW GET ;GPL ; RETURN A FIELD VALUE MAP
. . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT " . . . . S ZT=$TR(ZT,"^""","|'") ;HACK TO GET RID OF ^ AND " IN TEXT "
. . . . S C0CVALUE=C0CVALUE_ZT ; . . . . S C0CVALUE=C0CVALUE_ZT ;
. . S $P(@GRTN@(C0CNAME),"^",3)=C0CVALUE ;RETURN VALUE IN P3 . . 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 I C0CNN D ; IF ONLY NON-NULL VALUES ARE TO BE RETURNED
. S C0CI="" . S C0CI=""
. F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY . F S C0CI=$O(@GRTN@(C0CI)) Q:C0CI="" D ; GO THROUGH THE WHOLE ARRAY
@ -279,3 +280,9 @@ ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED
I '$D(ZTAB) S ZTAB="C0CA" I '$D(ZTAB) S ZTAB="C0CA"
Q $P(@ZTAB@(ZFN),"^",3) Q $P(@ZTAB@(ZFN),"^",3)
; ;
ZVALUEI(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(@ZTAB@(ZFN,"I"),"^",3)
;

7
p/GPLALERT.m
View File

@ -50,6 +50,8 @@ EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
. S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN") . S ADT=ADT_$S(A2="P":"ADVERSE",A2="A":"ALLERGIC",1:"UNKNOWN")
. S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"." . S ADT=ADT_" reaction to "_$P(@ALTG@(ALTTMP),U,2)_"."
. S @ALTVMAP@("ALERTDESCRIPTIONTEXT")=ADT . 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 . 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":"418634005",1:"") ; IF NOT ADVERSE, IT IS ALLERGIC
. S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ; . S @ALTVMAP@("ALERTCODEVALUE")=ALTCDE ;
@ -98,6 +100,11 @@ EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE
. . S @ALTVMAP@("ALERTREACTIONCODEVALUE")="" . . S @ALTVMAP@("ALERTREACTIONCODEVALUE")=""
. . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")="" . . S @ALTVMAP@("ALERTREACTIONCODESYSTEM")=""
. S ALTARYTMP=$NA(@ALTTARYTMP@(ALTCNT)) . 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,DFN,"B") ;GET VALUES BY NAME
. S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1")
. S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CT)
. K @ALTARYTMP . K @ALTARYTMP
. D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP) . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP)
. I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML) . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML)

12
p/GPLCCR0.m
View File

@ -104,6 +104,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Type> ;;<Type>
;;<Text>Problem</Text> ;;<Text>Problem</Text>
;;</Type> ;;</Type>
;;<Status>
;;<Text>@@PROBLEMSTATUS@@</Text>
;;</Status>
;;<Description> ;;<Description>
;;<Text>@@PROBLEMDESCRIPTION@@</Text> ;;<Text>@@PROBLEMDESCRIPTION@@</Text>
;;<Code> ;;<Code>
@ -112,6 +115,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Version>@@PROBLEMCODINGVERSION@@</Version> ;;<Version>@@PROBLEMCODINGVERSION@@</Version>
;;</Code> ;;</Code>
;;</Description> ;;</Description>
;;<DateTime>
;;<ExactDateTime>@@PROBLEMDATEMOD@@</ExactDateTime>
;;</DateTime>
;;<Source> ;;<Source>
;;<Actor> ;;<Actor>
;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID> ;;<ActorID>@@PROBLEMSOURCEACTORID@@</ActorID>
@ -219,6 +225,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Alerts> ;;<Alerts>
;;<Alert> ;;<Alert>
;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID> ;;<CCRDataObjectID>@@ALERTOBJECTID@@</CCRDataObjectID>
;;<Type>
;;<Text>@@ALERTTYPE@@</Text>
;;</Type>
;;<Description> ;;<Description>
;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text> ;;<Text>@@ALERTDESCRIPTIONTEXT@@</Text>
;;<Code> ;;<Code>
@ -229,6 +238,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
;;<Status> ;;<Status>
;;<Text>@@ALERTSTATUSTEXT@@</Text> ;;<Text>@@ALERTSTATUSTEXT@@</Text>
;;</Status> ;;</Status>
;;<DateTime>
;;<ExactDateTime>@@ALERTDATETIME@@</ExactDateTime>
;;</DateTime>
;;<Source> ;;<Source>
;;<Actor> ;;<Actor>
;;<ActorID>@@ALERTSOURCEID@@</ActorID> ;;<ActorID>@@ALERTSOURCEID@@</ActorID>

14
p/GPLPROBS.m
View File

@ -16,8 +16,8 @@ GPLPROBS ; CCDCCR/GPL - CCR/CCD PROCESSING FOR PROBLEMS ; 6/6/08
;You should have received a copy of the GNU General Public License along ;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., ;with this program; if not, write to the Free Software Foundation, Inc.,
;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
; ;
; ;
; PROCESS THE PROBLEMS SECTION OF THE CCR ; PROCESS THE PROBLEMS SECTION OF THE CCR
; ;
EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
@ -48,12 +48,12 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
. S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY . S PTMP=RPCRSLT(J) ; PULL OUT PROBLEM FROM RPC RETURN ARRAY
. S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM . S @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM
. S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1) . S @VMAP@("PROBLEMIEN")=$P(PTMP,U,1)
. S @VMAP@("PROBLEMSTATUS")=$P(PTMP,U,2) . S @VMAP@("PROBLEMSTATUS")=$S($P(PTMP,U,2)="A":"Active",1:"")
. S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3) . S @VMAP@("PROBLEMDESCRIPTION")=$P(PTMP,U,3)
. S @VMAP@("PROBLEMCODINGVERSION")="" . S @VMAP@("PROBLEMCODINGVERSION")=""
. S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4) . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4)
. S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5) . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,5),"DT")
. S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6) . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,6),"DT")
. S @VMAP@("PROBLEMSC")=$P(PTMP,U,7) . S @VMAP@("PROBLEMSC")=$P(PTMP,U,7)
. S @VMAP@("PROBLEMSE")=$P(PTMP,U,8) . S @VMAP@("PROBLEMSE")=$P(PTMP,U,8)
. S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9) . S @VMAP@("PROBLEMCONDITION")=$P(PTMP,U,9)
@ -64,8 +64,8 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE
. S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1) . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1)
. S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13)
. S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14)
. S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15) . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,15),"DT")
. S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16) . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,16),"DT")
. S ARYTMP=$NA(@TARYTMP@(J)) . S ARYTMP=$NA(@TARYTMP@(J))
. ; W "ARYTMP= ",ARYTMP,! . ; W "ARYTMP= ",ARYTMP,!
. K @ARYTMP . K @ARYTMP