Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BTPWPSNP

BTPWPSNP.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. GET(DATA,CNT,SRC,DFNLST) ; EP - BTPW GET PATIENT SNAPSHOT
  1.  ; Input parameters
  1.  ;   CNT   - Count of # of records to return
  1.  ;   SRC   - Values to continue search on
  1.  ;   DFN   - Patient DFN
  1.  ;
  1.  NEW UID,II,CMIEN,RESULT,HDR,QFL,CT,DFN,DP,DSTRT,DFND
  1.  ;
  1.  ;NEW COMM,BJ,CIN,RESULT,QFL,CT,VALUE,WHEN,WHO,TRN,STAGE,HDR,CLOSE,STATE,CATLST
  1.  ;NEW FDUE,NDUE,PCOM,PREV,PRVIEN,RDUE,OSTATE,CMIEN,TMFRAME,BDT,EDT,CAT,COMM,COMMTX
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPSNP",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPEVT D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  ;Convert from possible DFN list array
  1.  I DFNLST="" D
  1.  . N LIST,BN
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(DFNLST(BN)) Q:BN=""  S LIST=LIST_DFNLST(BN)
  1.  . S DFNLST=LIST
  1.  ;
  1.  ;Initialize/save original values
  1.  S SRC=$G(SRC,"")
  1.  S CNT=+$G(CNT)
  1.  ;
  1.  ;Define Header
  1.  D HDR
  1.  S @DATA@(0)=HDR_$C(30)
  1.  ;
  1.  S QFL=0
  1.  ;
  1.  ;Pull the last record info
  1.  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
  1.  S CMIEN=$P(SRC,$C(29),1)
  1.  ;
  1.  S CT=0,QFL=0
  1.  ;
  1.  ;Loop through index (at selected point) and retrieve records
  1.  I DFNLST]"" F DP=DSTRT:1:$L(DFNLST,$C(28)) S DFN=$P(DFNLST,$C(28),DP) D  Q:QFL
  1.  . F  S CMIEN=$O(^BTPWP("AE",DFN,"O",CMIEN)) Q:CMIEN=""  D  Q:QFL
  1.  .. ;
  1.  .. ;Get Event Information
  1.  .. D SNG(CMIEN,.RESULT) I RESULT="" Q
  1.  .. S SRC=CMIEN_$C(29)_DFN
  1.  .. S CT=CT+1 I CNT'=0,CT=CNT S QFL=1
  1.  .. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
  1.  ;
  1. DONE ;
  1.  I II=0,'$D(@DATA@(II)) S:$E(HDR,$L(HDR))="^" HDR=$E(HDR,1,$L(HDR)-1) S @DATA@(II)=HDR_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. HDR ;
  1.  S HDR="I00010HIDE_CMIEN^I00010HIDE_VISIT_IEN^T00040CATEGORY^I00010HIDE_DFN^D00030PROC_DATE^T00060PROCEDURE^T01024FINDINGS"
  1.  S HDR=HDR_"^T01024FOLLOW_UPS^T01024NOTIFICATIONS^T01024HIDE_SEARCH"
  1.  Q
  1.  ;
  1. 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
  1.  NEW FNDT,FLDT,NODT
  1.  ;
  1.  S TDATA=$G(^BTPWP(CMIEN,0)),DFN=$P(TDATA,U,2),PCOM="",PNAM=$P(^DPT(DFN,0),"^",1)
  1.  ;
  1.  ;Community check
  1.  S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"I")
  1.  I PCOM'="" S PCOM=$$GET1^DIQ(9000001,DFN_",",1117,"E")  ;Community
  1.  ;
  1.  S PROC=$P(TDATA,U,1),PROCNM=$P(^BTPW(90621,PROC,0),U,1)  ;Procedure/Name (Event)
  1.  S CAT=$$CAT^BTPWPDSP(PROC)  ;Category
  1.  S HRN=$$HRNL^BQIULPT(DFN)   ;HRN
  1.  S DOB=$$FMTE^BQIUL1($$GET1^DIQ(2,DFN_",",.03,"I")) ;DOB
  1.  S AGE=$$AGE^BQIAGE(DFN,,1)  ;Age
  1.  S SEX=$$GET1^DIQ(2,DFN_",",.02,"I")  ;Sex
  1.  S PRCDT=$$FMTE^BQIUL1($P(TDATA,U,3))  ;Event Date
  1.  S VISIT=$P(TDATA,U,4)
  1.  ;
  1.  S RES=$$LNK^BTPWPTRG(CMIEN,.06)  ;Result
  1.  ;
  1.  S PEV=$P(TDATA,U,11) S:'PEV PEV=""  ;Preceding Event
  1.  ;
  1.  ;Findings
  1.  S FND="",FNDT=$$GET1^DIQ(90620,CMIEN_",",1.05,"I") D
  1.  . N FIEN,FNODE,FVAL,FFLG,FSTR
  1.  . ;
  1.  . ;Look for findings
  1.  . S (FFLG,FIEN)=0,FSTR="" F  S FIEN=$O(^BTPWP(CMIEN,10,FIEN)) Q:'FIEN  D
  1.  .. ;
  1.  .. ;Skip ENTERED IN ERROR
  1.  .. I $$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.08,"I")="Y" Q
  1.  .. ;
  1.  .. S FNODE=$G(^BTPWP(CMIEN,10,FIEN,0))
  1.  .. S FVAL=$P($$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.01,"E"),"@")_"   "_$$GET1^DIQ(90620.01,FIEN_","_CMIEN_",",.02,"E"),FFLG=1
  1.  .. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
  1.  . I FFLG=1 S FND="CHECK"_$C(28)_"FINDING DATE   FINDING VALUE"_$C(13)_$C(10)_FSTR Q
  1.  . ;
  1.  . ;If no findings, check for past due
  1.  . I FFLG=0 D
  1.  .. I FNDT]"",FNDT<DT S FND="TICKLER"_$C(28)_"DUE DATE"_$C(13)_$C(10)_$P($$GET1^DIQ(90620,CMIEN_",",1.05,"E"),"@")
  1.  ;
  1.  ;Follow Ups
  1.  S FUP="",FNDT=$$GET1^DIQ(90620,CMIEN_",",1.06,"I") D
  1.  . N FIEN,FNODE,FVAL,FFLG,FSTR,FLUN
  1.  . ;
  1.  . ;Look for follow-up needed
  1.  . S FLUN=$$GET1^DIQ(90620,CMIEN_",",1.11,"I") I FLUN="N" S FUP="N/A"_$C(28)_"Follow-up Not Recommended" Q
  1.  . ;
  1.  . ;Look for follow ups
  1.  . S (FFLG,FIEN)=0,FSTR="" F  S FIEN=$O(^BTPWP(CMIEN,12,FIEN)) Q:'FIEN  D
  1.  .. ;
  1.  .. ;Skip ENTERED IN ERROR
  1.  .. I $$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.07,"I")="Y" Q
  1.  .. ;
  1.  .. S FNODE=$G(^BTPWP(CMIEN,12,FIEN,0))
  1.  .. S FVAL=$P($$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.01,"E"),"@")_"    "_$$GET1^DIQ(90620.012,FIEN_","_CMIEN_",",.02,"E"),FFLG=1
  1.  .. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
  1.  . I FFLG=1 S FUP="CHECK"_$C(28)_"FOLLOWUP DATE   FOLLOW UP"_$C(13)_$C(10)_FSTR Q
  1.  . ;
  1.  . ;If no follow ups, check for past due
  1.  . I FFLG=0 D
  1.  .. I FNDT]"",FNDT<DT S FUP="TICKLER"_$C(28)_"DUE DATE"_$C(13)_$C(10)_$P($$GET1^DIQ(90620,CMIEN_",",1.06,"E"),"@")
  1.  ;
  1.  S NOT="",FNDT=$$GET1^DIQ(90620,CMIEN_",",1.07,"I") D
  1.  . N FIEN,FNODE,FVAL,FFLG,FSTR
  1.  . ;
  1.  . ;Look for notifications
  1.  . S (FFLG,FIEN)=0,FSTR="" F  S FIEN=$O(^BTPWP(CMIEN,11,FIEN)) Q:'FIEN  D
  1.  .. ;
  1.  .. ;Skip ENTERED IN ERROR
  1.  .. I $$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.09,"I")="Y" Q
  1.  .. ;
  1.  .. S FNODE=$G(^BTPWP(CMIEN,11,FIEN,0))
  1.  .. S FVAL=$P($$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.01,"E"),"@")_"      "_$$GET1^DIQ(90620.011,FIEN_","_CMIEN_",",.02,"E"),FFLG=1
  1.  .. S FSTR=FSTR_$S(FSTR]"":$C(13)_$C(10),1:"")_FVAL
  1.  . I FFLG=1 S NOT="CHECK"_$C(28)_"NOTIFICATION DT   NOTIFICATION"_$C(13)_$C(10)_FSTR Q
  1.  . ;
  1.  . ;If no notifications, check for past due
  1.  . I FFLG=0 D
  1.  .. I FNDT]"",FNDT<DT S NOT="TICKLER"_$C(28)_"DUE DATE"_$C(13)_$C(10)_$P($$GET1^DIQ(90620,CMIEN_",",1.07,"E"),"@")
  1.  ;
  1.  S STATE=$$GET1^DIQ(90620,CMIEN_",",1.01,"E")  ;STATE
  1.  S WHO=$$GET1^DIQ(90620,CMIEN_",",1.1,"E")  ;LAST MODIFIED BY
  1.  S WHEN=$$FMTE^BQIUL1($$GET1^DIQ(90620,CMIEN_",",1.09,"I"))  ;LAST MODIFIED DATE
  1.  ;
  1.  S RESULT=CMIEN_U_VISIT_U_CAT_U_DFN_U_PRCDT_U_PROCNM_U_FND_U_FUP_U_NOT
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q