From 7c4cbf2eb7dbd333babb1c0e53b13a7047a6e24d Mon Sep 17 00:00:00 2001 From: george Date: Sun, 25 Jan 2009 20:29:07 +0000 Subject: [PATCH] improvements to Problems and Alerts, added dates, type --- p/C0CRNF.m | 13 ++++++++++--- p/GPLALERT.m | 7 +++++++ p/GPLCCR0.m | 12 ++++++++++++ p/GPLPROBS.m | 14 +++++++------- 4 files changed, 36 insertions(+), 10 deletions(-) diff --git a/p/C0CRNF.m b/p/C0CRNF.m index e07c91b..daa6101 100644 --- a/p/C0CRNF.m +++ b/p/C0CRNF.m @@ -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) S C0CREF=GIEN_"," ; OPEN ROOT REFERENCE INTO FILE 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 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J ; STRUCTURE SIGNATURE 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 D CLEAN^DILF ; MAKE SURE WE ARE CLEANED UP 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 S @GRTN@(0)=GFILE_"^RNF1^"_GIEN_"^"_DT_"^"_$J_"^"_DUZ ; STRUCTURE SIGNATURE 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 . . ;W C0CJ," ",C0CI,! . . 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 . . . N ZT,ZWP S ZWP=0 ;ITERATOR . . . 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 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 @@ -279,3 +280,9 @@ ZVALUE(ZFN,ZTAB) ;EXTRINSIC TO RETURN VALUE FOR FIELD NAME PASSED I '$D(ZTAB) S ZTAB="C0CA" 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) + ; diff --git a/p/GPLALERT.m b/p/GPLALERT.m index 516a7bf..10c9bb2 100644 --- a/p/GPLALERT.m +++ b/p/GPLALERT.m @@ -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_" 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 ; @@ -98,6 +100,11 @@ EXTRACT(ALTXML,DFN,ALTOUTXML) ; EXTRACT ALERTS INTO PROVIDED XML TEMPLATE . . 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,DFN,"B") ;GET VALUES BY NAME + . S C0CT=$$ZVALUEI^C0CRNF("ORIGINATION DATE/TIME","C0CG1") + . S @ALTVMAP@("ALERTDATETIME")=$$FMDTOUTC^CCRUTIL(C0CT) . K @ALTARYTMP . D MAP^GPLXPATH(ALTXML,ALTVMAP,ALTARYTMP) . I ALTCNT=1 D CP^GPLXPATH(ALTARYTMP,ALTOUTXML) diff --git a/p/GPLCCR0.m b/p/GPLCCR0.m index 42a9a92..ec05447 100644 --- a/p/GPLCCR0.m +++ b/p/GPLCCR0.m @@ -104,6 +104,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME ;; ;;Problem ;; + ;; + ;;@@PROBLEMSTATUS@@ + ;; ;; ;;@@PROBLEMDESCRIPTION@@ ;; @@ -112,6 +115,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME ;;@@PROBLEMCODINGVERSION@@ ;; ;; + ;; + ;;@@PROBLEMDATEMOD@@ + ;; ;; ;; ;;@@PROBLEMSOURCEACTORID@@ @@ -219,6 +225,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME ;; ;; ;;@@ALERTOBJECTID@@ + ;; + ;;@@ALERTTYPE@@ + ;; ;; ;;@@ALERTDESCRIPTIONTEXT@@ ;; @@ -229,6 +238,9 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME ;; ;;@@ALERTSTATUSTEXT@@ ;; + ;; + ;;@@ALERTDATETIME@@ + ;; ;; ;; ;;@@ALERTSOURCEID@@ diff --git a/p/GPLPROBS.m b/p/GPLPROBS.m index 2e27271..6f30bf2 100644 --- a/p/GPLPROBS.m +++ b/p/GPLPROBS.m @@ -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 ;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 @@ -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 @VMAP@("PROBLEMOBJECTID")="PROBLEM"_J ; UNIQUE OBJID FOR PROBLEM . 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@("PROBLEMCODINGVERSION")="" . S @VMAP@("PROBLEMCODEVALUE")=$P(PTMP,U,4) - . S @VMAP@("PROBLEMDATEOFONSET")=$P(PTMP,U,5) - . S @VMAP@("PROBLEMDATEMOD")=$P(PTMP,U,6) + . S @VMAP@("PROBLEMDATEOFONSET")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,5),"DT") + . S @VMAP@("PROBLEMDATEMOD")=$$FMDTOUTC^CCRUTIL($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) @@ -64,8 +64,8 @@ EXTRACT(IPXML,DFN,OUTXML) ; EXTRACT PROBLEMS INTO PROVIDED XML TEMPLATE . S @VMAP@("PROBLEMSOURCEACTORID")="ACTORPROVIDER_"_$P(X,";",1) . S @VMAP@("PROBLEMSERVICE")=$P(PTMP,U,13) . S @VMAP@("PROBLEMHASCMT")=$P(PTMP,U,14) - . S @VMAP@("PROBLEMDTREC")=$P(PTMP,U,15) - . S @VMAP@("PROBLEMINACT")=$P(PTMP,U,16) + . S @VMAP@("PROBLEMDTREC")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,15),"DT") + . S @VMAP@("PROBLEMINACT")=$$FMDTOUTC^CCRUTIL($P(PTMP,U,16),"DT") . S ARYTMP=$NA(@TARYTMP@(J)) . ; W "ARYTMP= ",ARYTMP,! . K @ARYTMP