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

BTPWPTRG.m

Go to the documentation of this file. 
  1. BTPWPTRG ;VNGT/HS/ALA-Event Worksheet Trigger ; 24 Nov 2009  11:13 AM
  1.  ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
  1.  ;
  1.  ;
  1. INIT(DATA,CMIEN) ;EP -- BTPW EVENT WORKSHEET INITIAL
  1.  NEW UID,II,VALUE,SOURCE,IEN,TYPE,BTPWX,VFIEN,FLD,ACT,FDATA,ABLE,CLFLAG
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPTRG",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPTRG D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="T00008SOURCE^T00001CODE_TYPE^T00001ABLE_FLAG^T00001CLEAR_FLAG^T01024PARMS"_$C(30)
  1.  D SRC
  1.  S SOURCE=""
  1.  F  S SOURCE=$O(BTPWX(SOURCE)) Q:SOURCE=""  D
  1.  . S VALUE=$P(BTPWX(SOURCE),U,1),TYPE=$P(BTPWX(SOURCE),U,2),ABLE=$P(BTPWX(SOURCE),U,3),CLFLAG=$P(BTPWX(SOURCE),U,4)
  1.  . D UP
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  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.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. UP ; Update
  1.  S II=II+1,@DATA@(II)=SOURCE_U_TYPE_U_ABLE_U_CLFLAG_U_VALUE_$C(30)
  1.  Q
  1.  ;
  1. SRC ;
  1.  NEW TDATA,TDATA1,EXEC,FNDDT,CLFLAG,FOLYN
  1.  S TDATA=^BTPWP(CMIEN,0)
  1.  S TDATA1=$G(^BTPWP(CMIEN,1))
  1.  S VFIEN=$$FIND1^DIC(90506.3,"","MX","CMET Worksheet","","","ERROR")
  1.  S ORD=""
  1.  F  S ORD=$O(^BQI(90506.3,VFIEN,10,"C",ORD)) Q:ORD=""  D
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BQI(90506.3,VFIEN,10,"C",ORD,IEN)) Q:IEN=""  D
  1.  .. S CLFLAG=""
  1.  .. I $P(^BQI(90506.3,VFIEN,10,IEN,0),"^",11)'="" Q
  1.  .. S FLD=$P($G(^BQI(90506.3,VFIEN,10,IEN,3)),"^",1),TYPE=$P($G(^BQI(90506.3,VFIEN,10,IEN,1)),U,1)
  1.  .. S SOURCE=$P(^BQI(90506.3,VFIEN,10,IEN,0),"^",7)
  1.  .. S EXEC=$G(^BQI(90506.3,VFIEN,10,IEN,8))
  1.  .. S ACT=$P($G(^BQI(90506.3,VFIEN,10,IEN,1)),U,5),VALUE="",ABLE="Y"
  1.  .. I ACT="L" D
  1.  ... ;S RCNN=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")
  1.  ... ;S WHR=$P(^BTPWP(CMIEN,0),U,9),RDR=$P(^(0),U,10),VISIT=$P(^(0),U,4)
  1.  ... S VALUE=$$LNK(CMIEN,FLD)
  1.  .. I TYPE="T"!(TYPE="C") D
  1.  ... ;I VALUE="" Q
  1.  ... I ACT="D" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
  1.  ... I ACT'="D" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")
  1.  ... ;S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I")_$C(28)_$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
  1.  .. I TYPE="W" D
  1.  ... N VAL,CN
  1.  ... D GETS^DIQ(90620,CMIEN_",",FLD,"E","VAL")
  1.  ... S VALUE="",CN=0 F  S CN=$O(VAL(CN)) Q:'CN  S VALUE=VALUE_$S(VALUE]"":$C(10),1:"")_$G(VAL(CN))
  1.  .. I TYPE'="T",TYPE'="C",TYPE'="W" D
  1.  ... I VALUE'="" Q
  1.  ... I TYPE="D" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"I") S:VALUE]"" VALUE=$$FMTE^BQIUL1(VALUE) Q
  1.  ... I TYPE="M" S VALUE=$$GET1^DIQ(90620,CMIEN_",",FLD,"E")
  1.  .. ;
  1.  .. ;Look for executable code
  1.  .. I EXEC'="" X EXEC
  1.  .. ;
  1.  .. ;Special Handling
  1.  .. ;
  1.  .. I SOURCE="BTPWPREV" S VALUE=$P(TDATA,U,11),VALUE=$S(VALUE'="":"Y"_$C(28)_"YES",1:"N"_$C(28)_"NONE")
  1.  .. I SOURCE="EVIEN" S VALUE=CMIEN
  1.  .. ;
  1.  .. ;Follow-up Recommended
  1.  .. I SOURCE="BTPWFLUN" D
  1.  ... I $P($$FND^BTPWPCLO(CMIEN),U,1)=-1 S ABLE="N",VALUE="" Q
  1.  ... S ABLE="Y"
  1.  .. ;
  1.  .. ;Follow-ups
  1.  .. I SOURCE="BTPWFU"!(SOURCE="BTPWFDUE") S FOLYN=$P(TDATA1,U,11) S ABLE=$S(FOLYN["Y":"Y",1:"N"),VALUE=$S(FOLYN["Y":VALUE,1:"")
  1.  .. I SOURCE="BTPWNTY",$P($$FND^BTPWPCLO(CMIEN),U,1)=-1 S ABLE="N",$P(BTPWX("BTPWNDUE"),U,3)="N"
  1.  .. S BTPWX(SOURCE)=VALUE_U_TYPE_U_ABLE_U_CLFLAG
  1.  ;
  1.  ;Disable necessary field if in an open state
  1.  I $P($G(BTPWX("BTPWSTGE")),U)="O" D
  1.  . ;
  1.  . ;Disable Close Reason
  1.  . S $P(BTPWX("BTPCLREA"),U,3)="N"
  1.  . ;
  1.  . I $P($$FND^BTPWPCLO(CMIEN),U)=-1 D
  1.  .. S $P(BTPWX("BTPWFU"),U,3)="N"
  1.  .. S $P(BTPWX("BTPWFLUN"),U,3)="N",$P(BTPWX("BTPWFLUN"),U,4)="Y"
  1.  .. S $P(BTPWX("BTPWFDUE"),U,3)="N",$P(BTPWX("BTPWFDUE"),U,4)="Y"
  1.  .. S $P(BTPWX("BTPWNDUE"),U,3)="N",$P(BTPWX("BTPWNDUE"),U,4)="Y"
  1.  ;
  1.  ;Disable Fields if in Closed State
  1.  I $P($G(BTPWX("BTPWSTGE")),U)="C" D
  1.  . S $P(BTPWX("BTPWFIND"),U,3)="N"
  1.  . S $P(BTPWX("BTPWFU"),U,3)="N"
  1.  . S $P(BTPWX("BTPWNTY"),U,3)="N"
  1.  . S $P(BTPWX("BTPWRDUE"),U,3)="N",$P(BTPWX("BTPWRDUE"),U,4)="N"
  1.  . S $P(BTPWX("BTPWFLUN"),U,3)="N",$P(BTPWX("BTPWFLUN"),U,4)="N"
  1.  . S $P(BTPWX("BTPWFDUE"),U,3)="N",$P(BTPWX("BTPWFDUE"),U,4)="N"
  1.  . S $P(BTPWX("BTPWNDUE"),U,3)="N",$P(BTPWX("BTPWNDUE"),U,4)="N"
  1.  Q
  1.  ;
  1. LNK(TRIEN,FLD) ; EP - Get links for a tracked event
  1.  NEW RCNN,RCTP,WHR,RDR,VISIT,PRCDT,LINK,RIEN,ACCN,TDATA
  1.  S RCNN=$$GET1^DIQ(90620,TRIEN_",",FLD,"I")
  1.  S RCTP=$$GET1^DIQ(90620,TRIEN_",",FLD,"E")
  1.  S PRCDT=$$GET1^DIQ(90620,TRIEN_",",.03,"I")
  1.  S PRCDT=$$FMTE^BQIUL1(PRCDT)
  1.  S TDATA=^BTPWP(TRIEN,0)
  1.  S WHR=$P(TDATA,U,9),RDR=$P(TDATA,U,10),VISIT=$P(TDATA,U,4)
  1.  S ACCN=$P(TDATA,U,15),RIEN=$P(TDATA,U,5),PREVT=$P(TDATA,U,14)
  1.  I RIEN="" S RIEN=$P($G(^BTPWQ(PREVT,0)),"^",5)
  1.  S LINK=""
  1.  I WHR'="",$P($G(^BWPCD(WHR,0)),U,5)="" S WHR=""
  1.  I WHR'="" S LINK=PRCDT_$C(28)_"WH RECORD"_$C(28)_"W:"_WHR
  1.  I RDR'="" S LINK=PRCDT_$C(28)_RCTP_$C(28)_"R:"_RDR
  1.  I ACCN'="" D
  1.  . I $E(ACCN,1,2)="WH" Q
  1.  . NEW RES
  1.  . S RES=$P($G(^AUPNVLAB(RIEN,0)),U,4)
  1.  . I RES="",$P($G(^AUPNVLAB(RIEN,11)),U,9)'="R" Q
  1.  . S LINK=PRCDT_$C(28)_RCTP_$C(28)_"L:"_RIEN
  1.  ;Q PRCDT_$C(28)_RCTP_$C(28)_"V:"_VISIT
  1.  Q LINK
  1.  ;
  1. QLNK(QRIEN,FLD) ; EP - Get links for a queued event
  1.  NEW RCNN,RCTP,WHR,RDR,VISIT,PRCDT,LINK,QDATA,ACCN,RIEN,DFN
  1.  S RCNN=$$GET1^DIQ(90629,QRIEN_",",FLD,"I")
  1.  S RCTP=$$GET1^DIQ(90629,QRIEN_",",FLD,"E")
  1.  S PRCDT=$$GET1^DIQ(90629,QRIEN_",",.03,"I")
  1.  S DFN=$P(^BTPWQ(QRIEN,0),"^",2)
  1.  S PRCDT=$$FMTE^BQIUL1(PRCDT)
  1.  S QDATA=^BTPWQ(QRIEN,0),FULLR=""
  1.  S WHR=$P(QDATA,U,9),RDR=$P(QDATA,U,10),VISIT=$P(QDATA,U,4),ACCN=$P(QDATA,U,15),RIEN=$P(QDATA,U,5)
  1.  S LINK=""
  1.  I WHR'="",$P($G(^BWPCD(WHR,0)),U,5)="" S WHR=""
  1.  I WHR'="" D
  1.  . NEW DATA
  1.  . D EN^BTPWRWHP(.DATA,WHR)
  1.  . F I=1:1 Q:@DATA@(I)=$C(30)  S FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
  1.  . S LINK=PRCDT_$C(28)_"WH RECORD"_$C(28)_"W:"_WHR_$C(28)_FULLR
  1.  I RDR'="" D
  1.  . NEW DATA
  1.  . D EN^BTPWRRAD(.DATA,DFN,RDR)
  1.  . F I=1:1 Q:@DATA@(I)=$C(30)  S FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
  1.  . S LINK=PRCDT_$C(28)_RCTP_$C(28)_"R:"_RDR_$C(28)_FULLR
  1.  I ACCN'="" D
  1.  . I $E(ACCN,1,2)="WH" Q
  1.  . I $G(^AUPNVLAB(RIEN,0))="" Q
  1.  . NEW RES
  1.  . S RES=$P($G(^AUPNVLAB(RIEN,0)),U,4)
  1.  . NEW DATA
  1.  . D EN^BTPWRLAB(.DATA,DFN,RIEN)
  1.  . F I=1:1 Q:@DATA@(I)=$C(30)  S FULLR=FULLR_$$STRIP^XLFSTR(@DATA@(I),"^")
  1.  . ;I RES="",$P($G(^AUPNVLAB(RIEN,11)),U,9)'="R" 
  1.  . S LINK=PRCDT_$C(28)_RCTP_$C(28)_"L:"_RIEN_$C(28)_FULLR
  1.  Q LINK
  1.  ;
  1. EXEV(QIEN) ;EP - Expanded Event
  1.  NEW TDATA,TIEN,FULLE,RCIEN,RCFILE,FIL,FLD,TAB,LIEN
  1.  S TDATA=^BTPWQ(QIEN,0)
  1.  S TIEN=$P(TDATA,U,14)
  1.  S FULLE="Event obtained from: "_$C(13)_$C(10) D
  1.  . S RCIEN=$P(TDATA,U,5),RCFILE=$P(TDATA,U,6)
  1.  . S FULLE=FULLE_$P(^BTPW(90621.1,RCFILE,0),"^",1)_" - "
  1.  . NEW FIL,FLD
  1.  . S FIL=$P(^BTPW(90621.1,RCFILE,0),"^",2),FLD=$P(^(0),"^",3),TAB=$P(^(0),"^",8)
  1.  . S FULLE=FULLE_$$GET1^DIQ(FIL,RCIEN_",",FLD,"E")
  1.  . S LIEN=$$GET1^DIQ(FIL,RCIEN_",",FLD,"I")
  1.  . I TAB=80!(TAB=80.1)!(TAB=81) D
  1.  . I TAB=80 S FULLE=FULLE_" "_$$ICD9^BQIUL3(LIEN,,4)_$C(13)_$C(10) Q
  1.  . I TAB=80.1 S FULLE=FULLE_" "_$$ICD0^BQIUL3(LIEN,,5)_$C(13)_$C(10) Q
  1.  . I TAB=81 S FULLE=FULLE_" "_$$ICPT^BQIUL3(LIEN,"",3)
  1.  Q FULLE
  1.  ;
  1. FCOMM(QIEN) ;EP - Get Findings Comments
  1.  NEW FIEN,FCOMM
  1.  S FCOMM=""
  1.  S FIEN=0
  1.  F  S FIEN=$O(^BTPWQ(QIEN,4,FIEN)) Q:'FIEN  D
  1.  . S FCOMM=FCOMM_$S(FCOMM]"":" ",1:"")_$G(^BTPWQ(QIEN,4,FIEN,0))
  1.  Q FCOMM