starting Procedures
This commit is contained in:
george
parent
d547323774
commit
660c736f20
68
p/C0CCCR0.m
68
p/C0CCCR0.m
|
|
@ -578,6 +578,74 @@ LOAD(ARY) ; LOAD A CCR TEMPLATE INTO ARY PASSED BY NAME
|
|||
;;</Test>
|
||||
;;</Result>
|
||||
;;</Results>
|
||||
;;<Procedures>
|
||||
;;<Procedure>
|
||||
;;<CCRDataObjectID>@@PROCOBJECTID@@</CCRDataObjectID>
|
||||
;;<DateTime>
|
||||
;;<Type>
|
||||
;;<Text>@@PROCDATETEXT@@</Text>
|
||||
;;</Type>
|
||||
;;<ExactDateTime>@@PROCDATETIME@@</ExactDateTime>
|
||||
;;</DateTime>
|
||||
;;<Description>
|
||||
;;<Text>@@PROCDESCTEXT@@</Text>
|
||||
;;<ObjectAttribute>
|
||||
;;<Attribute>@@PROCDESCOBJATTR@@</Attribute>
|
||||
;;<AttributeValue>
|
||||
;;<Value>@@PROCDESCOBJATTRVAL@@</Value>
|
||||
;;<Code>
|
||||
;;<Value>@@PROCDESCOBJATTRCODE@@</Value>
|
||||
;;<CodingSystem>@@PROCDESCOBJATTRCODESYS@@</CodingSystem>
|
||||
;;</Code>
|
||||
;;</AttributeValue>
|
||||
;;</ObjectAttribute>
|
||||
;;<Code>
|
||||
;;<Value>@@PROCCODE@@</Value>
|
||||
;;<CodingSystem>@@PROCCODESYS@@</CodingSystem>
|
||||
;;</Code>
|
||||
;;</Description>
|
||||
;;<Status>
|
||||
;;<Text>@@PROCSTATUS@@</Text>
|
||||
;;</Status>
|
||||
;;<Source>
|
||||
;;<Actor>
|
||||
;;<ActorID>@@PROCACTOROBJID@@</ActorID>
|
||||
;;</Actor>
|
||||
;;</Source>
|
||||
;;<InternalCCRLink>
|
||||
;;<LinkID>@@PROCLINKID@@</LinkID>
|
||||
;;<LinkRelationship>@@PROCLINKREL@@</LinkRelationship>
|
||||
;;</InternalCCRLink>
|
||||
;;</Procedure>
|
||||
;;</Procedures>
|
||||
;;<Encounters>
|
||||
;;<Encounter>
|
||||
;;<CCRDataObjectID>@@ENCOBJECTID@@</CCRDataObjectID>
|
||||
;;<DateTime>
|
||||
;;<ExactDateTime>@@ENCDATETIME@@</ExactDateTime>
|
||||
;;</DateTime>
|
||||
;;<Type>
|
||||
;;<Text>@@ENCTYPE@@</Text>
|
||||
;;<Code>
|
||||
;;<Value>@@ENCCODE@@</Value>
|
||||
;;<CodingSystem>@@ENCCODESYS@@</CodingSystem>
|
||||
;;</Code>
|
||||
;;</Type>
|
||||
;;<Source>
|
||||
;;<Actor>
|
||||
;;<ActorID>@@ENCACTORID@@</ActorID>
|
||||
;;</Actor>
|
||||
;;</Source>
|
||||
;;<Locations>
|
||||
;;<Location>
|
||||
;;<Actor>
|
||||
;;<ActorID>@@ENCLOCACTORID@@</ActorID>
|
||||
;;</Actor>
|
||||
;;</Location>
|
||||
;;</Locations>
|
||||
;;<CommentID>@@ENCCOMMENTID@@</CommentID>
|
||||
;;</Encounter>
|
||||
;;</Encounters>
|
||||
;;<HealthCareProviders>
|
||||
;;<Provider>
|
||||
;;<ActorID>AA0005</ActorID>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,96 @@
|
|||
C0CCPT ;;BSL;RETURN CPT DATA;
|
||||
;Sequence Managers Software GPL
|
||||
;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
|
||||
;DFN=PATIENT IEN
|
||||
;STDT=START DATE IN 3100101 FORMAT (VA YEAR YYYMMDD)
|
||||
;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)
|
||||
D VISIT
|
||||
Q
|
||||
VISIT ;GET VISIT INFO FOR A GIVEN NOTE. BUILD INTO RETURN ARRAY .VISIT
|
||||
S ILST=1
|
||||
S IEN="" F S IEN=$O(NOTE(IEN)) Q:IEN="" D
|
||||
. S X0=^TIU(8925,IEN,0),X12=$G(^(12))
|
||||
. S VISIT=$P(X12,U,7)
|
||||
. I 'VISIT S VISIT=$P(X0,U,3)
|
||||
. K ^TMP("PXKENC",$J)
|
||||
. Q:VISIT=""!(VISIT'>0)
|
||||
. D ENCEVENT^PXKENC(VISIT,1)
|
||||
. I '$D(^TMP("PXKENC",$J,VISIT,"VST",VISIT,0)) Q
|
||||
. S IPRV=0 F S IPRV=$O(^TMP("PXKENC",$J,VISIT,"PRV",IPRV)) Q:'IPRV D
|
||||
.. S X0=^TMP("PXKENC",$J,VISIT,"PRV",IPRV,0)
|
||||
.. ;Q:$P(X0,U,4)'="P"
|
||||
.. S CODE=$P(X0,U),NARR=$P($G(^VA(200,CODE,0)),U)
|
||||
.. S PRIM=($P(X0,U,4)="P")
|
||||
.. S ILST=ILST+1
|
||||
.. S LST(ILST)="PRV"_U_CODE_"^^^"_NARR_"^"_PRIM
|
||||
.. S VISIT(IEN,"PRV",ILST)=CODE_"^^^"_NARR_"^"_PRIM
|
||||
. S IPOV=0 F S IPOV=$O(^TMP("PXKENC",$J,VISIT,"POV",IPOV)) Q:'IPOV D
|
||||
.. S X0=^TMP("PXKENC",$J,VISIT,"POV",IPOV,0),X802=$G(^(802)),X811=$G(^(811))
|
||||
.. S CODE=$P(X0,U)
|
||||
.. S:CODE CODE=$P(^ICD9(CODE,0),U)
|
||||
.. S CAT=$P(X802,U)
|
||||
.. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
|
||||
.. S NARR=$P(X0,U,4)
|
||||
.. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
|
||||
.. S PRIM=($P(X0,U,12)="P")
|
||||
.. S PRV=$P(X12,U,4)
|
||||
.. S ILST=ILST+1
|
||||
.. S LST(ILST)="POV"_U_CODE_U_CAT_U_NARR_U_PRIM_U_PRV
|
||||
.. S VISIT(IEN,"POV",ILST)=CODE_U_CAT_U_NARR_U_PRIM_U_PRV
|
||||
.. I X811]"" D
|
||||
... S ICOM=ICOM+1
|
||||
... S $P(LST(ILST),U,10)=ICOM
|
||||
... S ILST=ILST+1
|
||||
... S LST(ILST)="COM"_U_ICOM_U_X811
|
||||
. S ICPT=0 F S ICPT=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT)) Q:'ICPT D
|
||||
.. S X0=^TMP("PXKENC",$J,VISIT,"CPT",ICPT,0),X802=$G(^(802)),X12=$G(^(12)),X811=$G(^(811))
|
||||
.. ;S CODE=$P(X0,U)
|
||||
.. S CODE=$O(^ICPT("B",$P(X0,U),0))
|
||||
.. S:CODE CODE=$P(^ICPT(CODE,0),U)
|
||||
.. S CAT=$P(X802,U)
|
||||
.. S:CAT CAT=$P(^AUTNPOV(CAT,0),U)
|
||||
.. S NARR=$P(X0,U,4)
|
||||
.. S:NARR NARR=$P(^AUTNPOV(NARR,0),U)
|
||||
.. S QTY=$P(X0,U,16)
|
||||
.. S PRV=$P(X12,U,4)
|
||||
.. S MCNT=0,MIDX=0,MODS=""
|
||||
.. F S MIDX=$O(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX)) Q:'MIDX D
|
||||
... S MIEN=$G(^TMP("PXKENC",$J,VISIT,"CPT",ICPT,1,MIDX,0))
|
||||
... I +MIEN S MCNT=MCNT+1,MODS=MODS_";/"_MIEN
|
||||
.. I +MCNT S MODS=MCNT_MODS
|
||||
.. S ILST=ILST+1
|
||||
.. S LST(ILST)="CPT"_U_CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
|
||||
.. S VISIT(IEN,"CPT",ILST)=CODE_U_CAT_U_NARR_U_QTY_U_PRV_U_U_U_MODS
|
||||
. S VISIT(IEN,"DATE",0)=$P($P(^TIU(8925,IEN,0),U,7),".")
|
||||
. I $G(TXT)=1 D GETNOTE(IEN)
|
||||
Q
|
||||
GETNOTE(IEN) ;GET THE TEXT THAT GOES WITH VISIT
|
||||
;EXTRACT NOTE TEXT FROM ^TIU(8925,IEN,"TEXT"
|
||||
;Q:'$D(VISIT(IEN,"CPT"))
|
||||
S TXTCNT=0
|
||||
F S TXTCNT=TXTCNT+1 Q:'$D(^TIU(8925,IEN,"TEXT",TXTCNT,0)) D
|
||||
. S VISIT(IEN,"TEXT",TXTCNT)=^TIU(8925,IEN,"TEXT",TXTCNT,0)
|
||||
Q
|
||||
|
||||
|
|
@ -0,0 +1,100 @@
|
|||
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
|
||||
;
|
||||
EXTRACT(PROCXML,DFN,PROCOUT) ; EXTRACT PROCEDURES INTO XML TEMPLATE
|
||||
; PROCXML AND PROCOUT ARE PASSED BY NAME SO GLOBALS CAN BE USED
|
||||
;
|
||||
S C0CENC=$NA(^TMP("C0CENC",$J,DFN))
|
||||
S C0CPRC=$NA(^TMP("C0CPRC",$J,DFN))
|
||||
S C0CNTE=$NA(^TMP("C0CNTE",$J,DFN))
|
||||
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
|
||||
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=""
|
||||
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
|
||||
. . . W !,ZCPT," ",ZDATE," ",ZPRV
|
||||
. . . S ZRNF("PROCACTOROBJID")=ZPRV
|
||||
. . . S ZRNF("PROCCODE")=$P(ZCPT,U,1)
|
||||
. . . S ZRNF("PROCCODESYS")="CPT-4"
|
||||
. . . S ZRNF("PROCDATETEXT")="Procedure Date"
|
||||
. . . S ZRNF("PROCDATETIME")=ZDATE
|
||||
. . . 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
|
||||
. . . S ZRNF("PROCSTATUS")="Completed" ; Is this right?
|
||||
. . . S ZRNF("PROCTYPE")=$P(ZCPT,U,2) ; NEED TO ADD THIS TO TEMPLATE
|
||||
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,"D")
|
||||
;
|
||||
CPT(ISTR) ; EXTRINSIC THAT SEARCHES FOR CPT CODES AND RETURNS
|
||||
; CPT^CATEGORY^TEXT
|
||||
N Z1,Z2,Z3,ZRTN
|
||||
I ISTR["(CPT-4 " D ; IF THERE IS A CPT CODE IN THERE
|
||||
. S Z1=$P($P(ISTR,"(CPT-4 ",2),")",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
|
||||
;
|
||||
Q
|
||||
;
|
||||
Loading…
Reference in New Issue