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

BTPWPWRK.m

Go to the documentation of this file. 
  1. BTPWPWRK ;VNGT/HS/ALA-CMET Worksheet Update ; 16 Dec 2009  5:45 PM
  1.  ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
  1.  ;
  1.  ;
  1. EN(DATA,BTPWDEF,BTPWTYP,CMIEN,PARMS) ; EP - BTPW UPDATE CMET WORKSHEET
  1.  ; Input parameters
  1.  ;   BTPWDEF - Register or sub-register name
  1.  ;   BTPWTYP - What is to happen to the record (A=Add, E=Edit, D=Delete)
  1.  ;   PARMS  - Parameters and their values
  1.  ;   CMIEN  - Tracked Record IEN
  1.  ;
  1.  NEW UID,II,DTTM,ERROR,BTWP
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPWRK",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPWRK D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024MSG^I00010HIDE_CMET_IEN"_$C(30)
  1.  ;
  1.  ;Pull current date/time
  1.  S DTTM=$$NOW^XLFDT()
  1.  ;
  1.  S CMIEN=$G(CMIEN,""),IENS=""
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . S LIST="",BN=""
  1.  . F  S BN=$O(PARMS(BN)) Q:BN=""  S LIST=LIST_PARMS(BN)
  1.  . K PARMS
  1.  . S PARMS=LIST
  1.  . K LIST
  1.  ;
  1.  I $G(PARMS)="",BTPWTYP'="D" Q
  1.  I BTPWDEF="" S BMXSEC="RPC Call Failed: VDEF Type not passed in." Q
  1.  S VFIEN=$O(^BQI(90506.3,"B",BTPWDEF,""))
  1.  I VFIEN="" S BMXSEC="RPC Call Failed: "_BTPWDEF_" does not exist." Q
  1.  S FILE=$P(^BQI(90506.3,VFIEN,0),U,2)
  1.  I CMIEN'="",CMIEN'["," S IENS=CMIEN_","
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
  1.  . I VALUE="" S VALUE="@"
  1.  . ;I VALUE="" Q
  1.  . S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
  1.  . I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
  1.  . I PTYP="C" D
  1.  .. S CHIEN=$O(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
  1.  .. S VALUE=$P(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
  1.  . S @NAME=VALUE
  1.  ;
  1.  F BQ=1:1:$L(PARMS,$C(28)) D  Q:$G(BMXSEC)'=""
  1.  . S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1.  . S NAME=$P(PDATA,"=",1)
  1.  . S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
  1.  . I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
  1.  . S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1),PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
  1.  . ;Word Processing Field
  1.  . I PTYP="W" D  Q
  1.  .. N FIELD,LN,I,P
  1.  .. S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1) Q:FIELD=""
  1.  .. I @NAME="@" S BTPWDTA(FILE,IENS,FIELD)="@" Q
  1.  .. F LN=1:1:$L(@NAME,$C(10)) S P=$P(@NAME,$C(10),LN) S BTWP(FILE,FIELD,LN)=P
  1.  . S EXEC=$G(^BQI(90506.3,VFIEN,10,PFIEN,7))
  1.  . I EXEC'="" X EXEC Q
  1.  . I FIELD="" Q
  1.  . I IENS'="" S BTPWDTA(FILE,IENS,FIELD)=@NAME
  1.  ;
  1.  I BTPWTYP="E" D  G DONE
  1.  . ;
  1.  . ;Log History Entry
  1.  . I $D(BTPWDTA)>0 D RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Worksheet Update")
  1.  . ;
  1.  . ;File the Information
  1.  . S BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT(),BTPWDTA(90620,CMIEN_",",1.1)=DUZ
  1.  . D FILE^DIE("","BTPWDTA","ERROR")
  1.  . ;
  1.  . ;Save comments
  1.  . I $D(BTWP(FILE)) D
  1.  .. S FIELD="" F  S FIELD=$O(BTWP(FILE,FIELD)) Q:FIELD=""  D
  1.  ... N CMTVAR,COM S CMTVAR="BTWP("_FILE_","_FIELD_")"
  1.  ... M COM=BTWP(FILE,FIELD)
  1.  ... ;
  1.  ... ;Log History Entry
  1.  ... D WLOG^BTPWHIST(.COM,FILE_":"_FIELD,CMIEN_",",DUZ,DTTM,"Worksheet Update")
  1.  ... ; 
  1.  ... ;Save Comments
  1.  ... D WP^DIE(90620,CMIEN_",",FIELD,"",CMTVAR)
  1.  ;
  1. DONE ;
  1.  S RESULT=1_U
  1.  I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))_U
  1.  I $P(RESULT,U,1)'=-1 S RESULT=1_U_U_$G(CMIEN)
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  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.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q