BTPWPSNP ;VNGT/HS/BEE-Get the Patient CMET Snapshot Events ; 21 Sep 2009 12:00 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
GET(DATA,CNT,SRC,DFNLST) ; EP - BTPW GET PATIENT SNAPSHOT
; Input parameters
; CNT - Count of # of records to return
; SRC - Values to continue search on
; DFN - Patient DFN
;
NEW UID,II,CMIEN,RESULT,HDR,QFL,CT,DFN,DP,DSTRT,DFND
;
;NEW COMM,BJ,CIN,RESULT,QFL,CT,VALUE,WHEN,WHO,TRN,STAGE,HDR,CLOSE,STATE,CATLST
;NEW FDUE,NDUE,PCOM,PREV,PRVIEN,RDUE,OSTATE,CMIEN,TMFRAME,BDT,EDT,CAT,COMM,COMMTX
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPSNP",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPEVT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
;Convert from possible DFN list array
I DFNLST="" D
. N LIST,BN
. S LIST="",BN=""
. F S BN=$O(DFNLST(BN)) Q:BN="" S LIST=LIST_DFNLST(BN)
. S DFNLST=LIST
;
;Initialize/save original values
S SRC=$G(SRC,"")
S CNT=+$G(CNT)
;
;Define Header
D HDR
S @DATA@(0)=HDR_$C(30)
;
S QFL=0
;
;Pull the last record info
S DSTRT=1,DFN=$P(SRC,$C(29),2) I DFN]"" F DFND=1:1:$L(DFNLST,$C(29)) I $P(DFNLST,$C(29),DFND)=DFN S DSTRT=DFND
S CMIEN=$P(SRC,$C(29),1)
;
S CT=0,QFL=0
;
;Loop through index (at selected point) and retrieve records
I DFNLST]"" F DP=DSTRT:1:$L(DFNLST,$C(28)) S DFN=$P(DFNLST,$C(28),DP) D Q:QFL
. F S CMIEN=$O(^BTPWP("AE",DFN,"O",CMIEN)) Q:CMIEN="" D Q:QFL
.. ;
.. ;Get Event Information
.. D SNG(CMIEN,.RESULT) I RESULT="" Q
.. S SRC=CMIEN_$C(29)_DFN
.. S CT=CT+1 I CNT'=0,CT=CNT S QFL=1
.. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
;
DONE ;
I II=0,'$D(@DATA@(II)) S:$E(HDR,$L(HDR))="^" HDR=$E(HDR,1,$L(HDR)-1) S @DATA@(II)=HDR_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
HDR ;
S HDR="I00010HIDE_CMIEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^I00010HIDE_DFN^D00030PROC_DATE^T00060PROCEDURE^T01024FINDINGS"
S HDR=HDR_"^T01024FOLLOW_UPS^T01024NOTIFICATIONS^T01024HIDE_SEARCH"
Q
;
SNG(CMIEN,RESULT) ; Get the basic record information for a single record
NEW DFN,PNAM,PCOM,TDATA,PROC,PROCNM,CAT,STATUS,HRN,DOB,AGE,SEX,PRCDT,RES,PEV,FND,FUP,NOT,STATE,WHO,WHEN,VISIT
NEW FNDT,FLDT,NODT
;
S TDATA=$G(^BTPWP(CMIEN,0)),DFN=$P(TDATA,U,2),PCOM="",PNAM=$P(^DPT(DFN,0),"^",1)
;
;Community check
S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
I PCOM'="" S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E") ;Community
;
S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1) ;Procedure/Name (Event)
S CAT=$$CAT^BTPWPDSP(PROC) ;Category
S HRN=$$HRNL^BQIULPT(DFN) ;HRN
S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I")) ;DOB
S AGE=$$AGE^BQIAGE(DFN,,1) ;Age
S SEX=$$GET1^DIQ(2,DFN_",",.02,"I") ;Sex
S PRCDT=$$FMTE^BQIUL1($P(TDATA,U,3)) ;Event Date
S VISIT=$P(TDATA,U,4)
;
S RES=$$LNK^BTPWPTRG(CMIEN,.06) ;Result
;
S PEV=$P(TDATA,U,11) S:'PEV PEV="" ;Preceding Event
;
;Findings
S FND="",FNDT=$$GET1^DIQ(90620,CMIEN_",",1.05,"I") D
. N FIEN,FNODE,FVAL,FFLG,FSTR
. ;
. ;Look for findings
. S (FFLG,FIEN)=0,FSTR="" F S FIEN=$O(^BTPWP(CMIEN,10,FIEN)) Q:'FIEN D
.. ;
.. ;Skip ENTERED IN ERROR
.. I $$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.08,"I")="Y" Q
.. ;
.. S FNODE=$G(^BTPWP(CMIEN,10,FIEN,0))
.. S FVAL=$P($$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.01,"E"),"@")_" "_$$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.02,"E"),FFLG=1
.. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
. I FFLG=1 S FND="CHECK"_$C(28)_"FINDING DATE FINDING VALUE"_$C(13)_$C(10)_FSTR Q
. ;
. ;If no findings, check for past due
. I FFLG=0 D
.. I FNDT]"",FNDT<DT S FND="TICKLER"_$C(28)_"DUE DATE"_$C(13)_$C(10)_$P($$GET1^DIQ(90620,CMIEN_",",1.05,"E"),"@")
;
;Follow Ups
S FUP="",FNDT=$$GET1^DIQ(90620,CMIEN_",",1.06,"I") D
. N FIEN,FNODE,FVAL,FFLG,FSTR,FLUN
. ;
. ;Look for follow-up needed
. S FLUN=$$GET1^DIQ(90620,CMIEN_",",1.11,"I") I FLUN="N" S FUP="N/A"_$C(28)_"Follow-up Not Recommended" Q
. ;
. ;Look for follow ups
. S (FFLG,FIEN)=0,FSTR="" F S FIEN=$O(^BTPWP(CMIEN,12,FIEN)) Q:'FIEN D
.. ;
.. ;Skip ENTERED IN ERROR
.. I $$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.07,"I")="Y" Q
.. ;
.. S FNODE=$G(^BTPWP(CMIEN,12,FIEN,0))
.. S FVAL=$P($$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.01,"E"),"@")_" "_$$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.02,"E"),FFLG=1
.. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
. I FFLG=1 S FUP="CHECK"_$C(28)_"FOLLOWUP DATE FOLLOW UP"_$C(13)_$C(10)_FSTR Q
. ;
. ;If no follow ups, check for past due
. I FFLG=0 D
.. I FNDT]"",FNDT<DT S FUP="TICKLER"_$C(28)_"DUE DATE"_$C(13)_$C(10)_$P($$GET1^DIQ(90620,CMIEN_",",1.06,"E"),"@")
;
S NOT="",FNDT=$$GET1^DIQ(90620,CMIEN_",",1.07,"I") D
. N FIEN,FNODE,FVAL,FFLG,FSTR
. ;
. ;Look for notifications
. S (FFLG,FIEN)=0,FSTR="" F S FIEN=$O(^BTPWP(CMIEN,11,FIEN)) Q:'FIEN D
.. ;
.. ;Skip ENTERED IN ERROR
.. I $$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.09,"I")="Y" Q
.. ;
.. S FNODE=$G(^BTPWP(CMIEN,11,FIEN,0))
.. S FVAL=$P($$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.01,"E"),"@")_" "_$$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.02,"E"),FFLG=1
.. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
. I FFLG=1 S NOT="CHECK"_$C(28)_"NOTIFICATION DT NOTIFICATION"_$C(13)_$C(10)_FSTR Q
. ;
. ;If no notifications, check for past due
. I FFLG=0 D
.. I FNDT]"",FNDT<DT S NOT="TICKLER"_$C(28)_"DUE DATE"_$C(13)_$C(10)_$P($$GET1^DIQ(90620,CMIEN_",",1.07,"E"),"@")
;
S STATE=$$GET1^DIQ(90620,CMIEN_",",1.01,"E") ;STATE
S WHO=$$GET1^DIQ(90620,CMIEN_",",1.1,"E") ;LAST MODIFIED BY
S WHEN=$$FMTE^BQIUL1($$GET1^DIQ(90620,CMIEN_",",1.09,"I")) ;LAST MODIFIED DATE
;
S RESULT=CMIEN_U_VISIT_U_CAT_U_DFN_U_PRCDT_U_PROCNM_U_FND_U_FUP_U_NOT
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
S II=II+1,@DATA@(II)=$C(31)
Q
BTPWPSNP ;VNGT/HS/BEE-Get the Patient CMET Snapshot Events ; 21 Sep 2009 12:00 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
GET(DATA,CNT,SRC,DFNLST) ; EP - BTPW GET PATIENT SNAPSHOT
+1 ; Input parameters
+2 ; CNT - Count of # of records to return
+3 ; SRC - Values to continue search on
+4 ; DFN - Patient DFN
+5 ;
+6 NEW UID,II,CMIEN,RESULT,HDR,QFL,CT,DFN,DP,DSTRT,DFND
+7 ;
+8 ;NEW COMM,BJ,CIN,RESULT,QFL,CT,VALUE,WHEN,WHO,TRN,STAGE,HDR,CLOSE,STATE,CATLST
+9 ;NEW FDUE,NDUE,PCOM,PREV,PRVIEN,RDUE,OSTATE,CMIEN,TMFRAME,BDT,EDT,CAT,COMM,COMMTX
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BTPWPSNP",UID))
+12 KILL @DATA
+13 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+14 ;
+15 SET II=0
+16 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPEVT D UNWIND^%ZTER"
+17 ;
+18 ;Convert from possible DFN list array
+19 IF DFNLST=""
Begin DoDot:1
+20 NEW LIST,BN
+21 SET LIST=""
SET BN=""
+22 FOR
SET BN=$ORDER(DFNLST(BN))
IF BN=""
QUIT
SET LIST=LIST_DFNLST(BN)
+23 SET DFNLST=LIST
End DoDot:1
+24 ;
+25 ;Initialize/save original values
+26 SET SRC=$GET(SRC,"")
+27 SET CNT=+$GET(CNT)
+28 ;
+29 ;Define Header
+30 DO HDR
+31 SET @DATA@(0)=HDR_$CHAR(30)
+32 ;
+33 SET QFL=0
+34 ;
+35 ;Pull the last record info
+36 SET DSTRT=1
SET DFN=$PIECE(SRC,$CHAR(29),2)
IF DFN]""
FOR DFND=1:1:$LENGTH(DFNLST,$CHAR(29))
IF $PIECE(DFNLST,$CHAR(29),DFND)=DFN
SET DSTRT=DFND
+37 SET CMIEN=$PIECE(SRC,$CHAR(29),1)
+38 ;
+39 SET CT=0
SET QFL=0
+40 ;
+41 ;Loop through index (at selected point) and retrieve records
+42 IF DFNLST]""
FOR DP=DSTRT:1:$LENGTH(DFNLST,$CHAR(28))
SET DFN=$PIECE(DFNLST,$CHAR(28),DP)
Begin DoDot:1
+43 FOR
SET CMIEN=$ORDER(^BTPWP("AE",DFN,"O",CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:2
+44 ;
+45 ;Get Event Information
+46 DO SNG(CMIEN,.RESULT)
IF RESULT=""
QUIT
+47 SET SRC=CMIEN_$CHAR(29)_DFN
+48 SET CT=CT+1
IF CNT'=0
IF CT=CNT
SET QFL=1
+49 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+50 ;
DONE ;
+1 IF II=0
IF '$DATA(@DATA@(II))
IF $EXTRACT(HDR,$LENGTH(HDR))="^"
SET HDR=$EXTRACT(HDR,1,$LENGTH(HDR)-1)
SET @DATA@(II)=HDR_$CHAR(30)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
HDR ;
+1 SET HDR="I00010HIDE_CMIEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^I00010HIDE_DFN^D00030PROC_DATE^T00060PROCEDURE^T01024FINDINGS"
+2 SET HDR=HDR_"^T01024FOLLOW_UPS^T01024NOTIFICATIONS^T01024HIDE_SEARCH"
+3 QUIT
+4 ;
SNG(CMIEN,RESULT) ; Get the basic record information for a single record
+1 NEW DFN,PNAM,PCOM,TDATA,PROC,PROCNM,CAT,STATUS,HRN,DOB,AGE,SEX,PRCDT,RES,PEV,FND,FUP,NOT,STATE,WHO,WHEN,VISIT
+2 NEW FNDT,FLDT,NODT
+3 ;
+4 SET TDATA=$GET(^BTPWP(CMIEN,0))
SET DFN=$PIECE(TDATA,U,2)
SET PCOM=""
SET PNAM=$PIECE(^DPT(DFN,0),"^",1)
+5 ;
+6 ;Community check
+7 SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
+8 ;Community
IF PCOM'=""
SET PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E")
+9 ;
+10 ;Procedure/Name (Event)
SET PROC=$PIECE(TDATA,U,1)
SET PROCNM=$PIECE(^BTPW(90621,PROC,0),U,1)
+11 ;Category
SET CAT=$$CAT^BTPWPDSP(PROC)
+12 ;HRN
SET HRN=$$HRNL^BQIULPT(DFN)
+13 ;DOB
SET DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I"))
+14 ;Age
SET AGE=$$AGE^BQIAGE(DFN,,1)
+15 ;Sex
SET SEX=$$GET1^DIQ(2,DFN_",",.02,"I")
+16 ;Event Date
SET PRCDT=$$FMTE^BQIUL1($PIECE(TDATA,U,3))
+17 SET VISIT=$PIECE(TDATA,U,4)
+18 ;
+19 ;Result
SET RES=$$LNK^BTPWPTRG(CMIEN,.06)
+20 ;
+21 ;Preceding Event
SET PEV=$PIECE(TDATA,U,11)
IF 'PEV
SET PEV=""
+22 ;
+23 ;Findings
+24 SET FND=""
SET FNDT=$$GET1^DIQ(90620,CMIEN_",",1.05,"I")
Begin DoDot:1
+25 NEW FIEN,FNODE,FVAL,FFLG,FSTR
+26 ;
+27 ;Look for findings
+28 SET (FFLG,FIEN)=0
SET FSTR=""
FOR
SET FIEN=$ORDER(^BTPWP(CMIEN,10,FIEN))
IF 'FIEN
QUIT
Begin DoDot:2
+29 ;
+30 ;Skip ENTERED IN ERROR
+31 IF $$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.08,"I")="Y"
QUIT
+32 ;
+33 SET FNODE=$GET(^BTPWP(CMIEN,10,FIEN,0))
+34 SET FVAL=$PIECE($$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.01,"E"),"@")_" "_$$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.02,"E")
SET FFLG=1
+35 SET FSTR=FSTR_$SELECT(FSTR]"":$CHAR(13)_$CHAR(10),1:"")_FVAL
End DoDot:2
+36 IF FFLG=1
SET FND="CHECK"_$CHAR(28)_"FINDING DATE FINDING VALUE"_$CHAR(13)_$CHAR(10)_FSTR
QUIT
+37 ;
+38 ;If no findings, check for past due
+39 IF FFLG=0
Begin DoDot:2
+40 IF FNDT]""
IF FNDT<DT
SET FND="TICKLER"_$CHAR(28)_"DUE DATE"_$CHAR(13)_$CHAR(10)_$PIECE($$GET1^DIQ(90620,CMIEN_",",1.05,"E"),"@")
End DoDot:2
End DoDot:1
+41 ;
+42 ;Follow Ups
+43 SET FUP=""
SET FNDT=$$GET1^DIQ(90620,CMIEN_",",1.06,"I")
Begin DoDot:1
+44 NEW FIEN,FNODE,FVAL,FFLG,FSTR,FLUN
+45 ;
+46 ;Look for follow-up needed
+47 SET FLUN=$$GET1^DIQ(90620,CMIEN_",",1.11,"I")
IF FLUN="N"
SET FUP="N/A"_$CHAR(28)_"Follow-up Not Recommended"
QUIT
+48 ;
+49 ;Look for follow ups
+50 SET (FFLG,FIEN)=0
SET FSTR=""
FOR
SET FIEN=$ORDER(^BTPWP(CMIEN,12,FIEN))
IF 'FIEN
QUIT
Begin DoDot:2
+51 ;
+52 ;Skip ENTERED IN ERROR
+53 IF $$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.07,"I")="Y"
QUIT
+54 ;
+55 SET FNODE=$GET(^BTPWP(CMIEN,12,FIEN,0))
+56 SET FVAL=$PIECE($$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.01,"E"),"@")_" "_$$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.02,"E")
SET FFLG=1
+57 SET FSTR=FSTR_$SELECT(FSTR]"":$CHAR(13)_$CHAR(10),1:"")_FVAL
End DoDot:2
+58 IF FFLG=1
SET FUP="CHECK"_$CHAR(28)_"FOLLOWUP DATE FOLLOW UP"_$CHAR(13)_$CHAR(10)_FSTR
QUIT
+59 ;
+60 ;If no follow ups, check for past due
+61 IF FFLG=0
Begin DoDot:2
+62 IF FNDT]""
IF FNDT<DT
SET FUP="TICKLER"_$CHAR(28)_"DUE DATE"_$CHAR(13)_$CHAR(10)_$PIECE($$GET1^DIQ(90620,CMIEN_",",1.06,"E"),"@")
End DoDot:2
End DoDot:1
+63 ;
+64 SET NOT=""
SET FNDT=$$GET1^DIQ(90620,CMIEN_",",1.07,"I")
Begin DoDot:1
+65 NEW FIEN,FNODE,FVAL,FFLG,FSTR
+66 ;
+67 ;Look for notifications
+68 SET (FFLG,FIEN)=0
SET FSTR=""
FOR
SET FIEN=$ORDER(^BTPWP(CMIEN,11,FIEN))
IF 'FIEN
QUIT
Begin DoDot:2
+69 ;
+70 ;Skip ENTERED IN ERROR
+71 IF $$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.09,"I")="Y"
QUIT
+72 ;
+73 SET FNODE=$GET(^BTPWP(CMIEN,11,FIEN,0))
+74 SET FVAL=$PIECE($$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.01,"E"),"@")_" "_$$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.02,"E")
SET FFLG=1
+75 SET FSTR=FSTR_$SELECT(FSTR]"":$CHAR(13)_$CHAR(10),1:"")_FVAL
End DoDot:2
+76 IF FFLG=1
SET NOT="CHECK"_$CHAR(28)_"NOTIFICATION DT NOTIFICATION"_$CHAR(13)_$CHAR(10)_FSTR
QUIT
+77 ;
+78 ;If no notifications, check for past due
+79 IF FFLG=0
Begin DoDot:2
+80 IF FNDT]""
IF FNDT<DT
SET NOT="TICKLER"_$CHAR(28)_"DUE DATE"_$CHAR(13)_$CHAR(10)_$PIECE($$GET1^DIQ(90620,CMIEN_",",1.07,"E"),"@")
End DoDot:2
End DoDot:1
+81 ;
+82 ;STATE
SET STATE=$$GET1^DIQ(90620,CMIEN_",",1.01,"E")
+83 ;LAST MODIFIED BY
SET WHO=$$GET1^DIQ(90620,CMIEN_",",1.1,"E")
+84 ;LAST MODIFIED DATE
SET WHEN=$$FMTE^BQIUL1($$GET1^DIQ(90620,CMIEN_",",1.09,"I"))
+85 ;
+86 SET RESULT=CMIEN_U_VISIT_U_CAT_U_DFN_U_PRCDT_U_PROCNM_U_FND_U_FUP_U_NOT
+87 QUIT
+88 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
