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

BTPWBTAD.m

Go to the documentation of this file. 
  1. BTPWBTAD ;VNGT/HS/ALA-Update Batch Processing ; 05 Nov 2009  3:18 PM
  1.  ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
  1.  ;
  1.  ;
  1. UPD(DATA,TYPE,RIEN,PARMS) ; EP -- BTPW UPDATE BATCH PROCESS
  1.  ; Input
  1.  ;  TYPE  = "Q" from Queued list, "T" from Tracked List
  1.  ;  RIEN  = Record IEN
  1.  ;  PARMS = Filing parameters
  1.  ;
  1.  NEW UID,II,RESULT,BTPWPRC,BTPWSTGE,CHIEN,CMIEN,NAME,VALUE,VFIEN,PDATA,BQ,BTPWWP
  1.  NEW BTPWDFN,BTPWFNTR,BTPWINFD,BTPWPCLR,BTPWPFLD,BTPWPFND,BTPWPFOL,BTPWPNOT
  1.  NEW BTPFLND,BTPFNDTM,BTPWPNTD,BTPWDTA,FDUE,NDUE,RDUE,STAT,OTYPE
  1.  NEW EXEC,FIELD,FILE,IENS,NAME,PDATA,PFIEN,PIEN,PTYP,VALUE,X,Y,DTTM
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BTPWPTMP",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S @DATA@(II)="I00010RESULT^T01024MSG^I00010CMET_IEN"_$C(30)
  1.  ;
  1.  ;Pull current date/time
  1.  S DTTM=$$NOW^XLFDT()
  1.  ;
  1.  S PARMS=$G(PARMS,"")
  1.  I PARMS="" D
  1.  . N BN,LIST
  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.  ;
  1.  ; If from queued list, need to move over into Tracked Event file
  1.  S OTYPE=TYPE
  1.  I TYPE="Q" D
  1.  . S STAT="T"
  1.  . ; Queue history record
  1.  . D QHIS^BTPWPTMP
  1.  . ;
  1.  . ; File update
  1.  . D FL^BTPWPTMP
  1.  . ; Move record into Tracked Event file
  1.  . S RDUE="",FDUE="",NDUE=""
  1.  . D MV^BTPWPTMP
  1.  . ;
  1.  . ;Make sure CMIEN is defined
  1.  . S CMIEN=$P($G(^BTPWQ(RIEN,0)),U,14)
  1.  ;
  1.  I TYPE="T" D
  1.  . ; If batch processing from tracked events, move the history
  1.  . S CMIEN=RIEN,RIEN=$P(^BTPWP(CMIEN,0),U,14)
  1.  . NEW PIEN
  1.  . S PIEN=CMIEN
  1.  ;
  1.  S VFIEN=$O(^BQI(90506.3,"B","CMET Batch Process",""))
  1.  I VFIEN="" S BMXSEC="RPC Call Failed: CMET Batch Process Definition does not exist." Q
  1.  S FILE=$P(^BQI(90506.3,VFIEN,0),U,2),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.  . ;
  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 VALUE="@" S BTPWDTA(FILE,IENS,FIELD)="@" Q
  1.  .. F LN=1:1:$L(VALUE,$C(10)) S P=$P(VALUE,$C(10),LN) S BTPWWP(FIELD,LN)=P
  1.  . ;
  1.  . S @NAME=VALUE
  1.  ;
  1.  S BTPWPRC=$P(^BTPWP(CMIEN,0),U,1),BTPWINFD=$G(BTPWPFLD)
  1.  D PREP(BTPWPRC)
  1.  I BTPWINFD="" S BTPWPFLD=$P(^BTPWP(CMIEN,0),U,3),BTPWPFLD=$$FLDUE^BTPWPUTL(BTPWPRC,BTPWPFLD,"")
  1.  I BTPWINFD'="" S BTPWPFLD=$P(^BTPWP(CMIEN,0),U,3),BTPWPFLD=$$FLDUE^BTPWPUTL(BTPWPRC,BTPWPFLD,"",BTPWINFD)
  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)
  1.  . S PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1) Q:PTYP="W"
  1.  . S EXEC=$G(^BQI(90506.3,VFIEN,10,PFIEN,7))
  1.  . I EXEC'="" X EXEC Q
  1.  . I FIELD="" Q
  1.  . S BTPWDTA(FILE,IENS,FIELD)=@NAME
  1.  ;
  1.  ; Set the due by dates
  1.  S BTPWDTA(90620,CMIEN_",",1.05)=DT,BTPWDTA(90620,CMIEN_",",1.06)=DT,BTPWDTA(90620,CMIEN_",",1.07)=DT
  1.  ;
  1.  ; Set the Follow-up Needed field
  1.  S BTPWDTA(90620,CMIEN_",",1.11)="Y"
  1.  ;
  1.  ;S BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT(),BTPWDTA(90620,CMIEN_",",1.1)=DUZ
  1.  ;
  1.  D FND
  1.  D NOT
  1.  D FOL
  1.  ;
  1.  ;File WP fields
  1.  I $D(BTPWWP) D
  1.  . N FIELD,WPVAR
  1.  . S WPVAR="COM"
  1.  . S FIELD="" F  S FIELD=$O(BTPWWP(FIELD)) Q:FIELD=""  D
  1.  .. N COM
  1.  .. M COM=BTPWWP(FIELD)
  1.  .. ;
  1.  .. ;Log History Entry
  1.  .. D WLOG^BTPWHIST(.COM,"90620:"_FIELD,IENS,DUZ,DTTM,"Event Update")
  1.  .. ;
  1.  .. ;Save WP field
  1.  .. D WP^DIE(90620,IENS,FIELD,"",WPVAR)
  1.  ;
  1.  S RESULT=1_U
  1.  I $D(ERROR)>0 S RESULT=-1_U
  1.  K ERROR
  1.  ;
  1.  ;Log History Entry
  1.  I $D(BTPWDTA)>0 D RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Event Update")
  1.  ;
  1.  ;File information
  1.  I $D(BTPWDTA)>0 D FILE^DIE("","BTPWDTA","ERROR")
  1.  I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))
  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.  ;
  1. DONE ;
  1.  D UNL^BTPWLOCK(OTYPE,RIEN)
  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
  1.  ;
  1. FND ; Create Finding record
  1.  NEW DA,DIC,DLAYGO,IENS,BTUPD,X,DIC,DA,DLAYGO
  1.  I $G(BTPFNDTM)="" S BTPFNDTM=$$NOW^XLFDT()
  1.  I $G(BTPFLND)="" S BTPFLND="Y"
  1.  S DA(1)=CMIEN,X=BTPFNDTM
  1.  S DIC="^BTPWP("_DA(1)_",10,",DIC(0)="LMNZ",DLAYGO=90620.01,DIC("P")=DLAYGO
  1.  K DO,DD D FILE^DICN
  1.  S DA=+Y
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BTUPD(90620.01,IENS,.02)=BTPWPFND
  1.  S BTUPD(90620.01,IENS,.03)=BTPWFNTR
  1.  S BTUPD(90620.01,IENS,.04)=$$NOW^XLFDT()
  1.  S BTUPD(90620.01,IENS,.05)=DUZ
  1.  S BTUPD(90620.01,IENS,.07)=BTPWPFOL
  1.  ;
  1.  ;Log History Entry
  1.  I $D(BTUPD)>0 D RLOG^BTPWHIST(.BTUPD,DUZ,DTTM,"Event Update")
  1.  ;
  1.  ;File information
  1.  D FILE^DIE("","BTUPD","ERROR")
  1.  Q
  1.  ;
  1. FOL ; Create Followup record
  1.  NEW X,DIC,DA,Y,DIE,IENS
  1.  I $G(BTPWPFOL)=""!($G(BTPWPFLD)="") Q
  1.  I $G(BTPWPFLD)="" S X=$$NOW^XLFDT()
  1.  I $G(BTPWPFLD)'="" S X=BTPWPFLD
  1.  S DA(1)=CMIEN
  1.  S DIC(0)="L",DIC="^BTPWP("_DA(1)_",12,",DIE=DIC
  1.  I $G(^BTPWP(DA(1),2,0))="" S ^BTPWP(DA(1),12,0)="^90620.012D^^"
  1.  K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
  1.  S IENS=$$IENS^DILF(.DA)
  1.  ;
  1.  S BTPWDTA(90620.012,IENS,.02)=BTPWPFOL
  1.  S BTPWDTA(90620.012,IENS,.03)=$$NOW^XLFDT()
  1.  S BTPWDTA(90620.012,IENS,.04)=DUZ
  1.  S BTPWDTA(90620.012,IENS,.05)=$$DATE^BQIUL1(BTPWPFLD)
  1.  S BTPWDTA(90620.012,IENS,.06)=$$FUT(BTPWPFOL,BTPWPFLD)
  1.  Q
  1.  ;
  1. NOT ; Create Notification record
  1.  NEW X,DA,DIC,IENS,DIE,Y,ABR
  1.  ;
  1.  I BTPWPNOT="" Q
  1.  ;
  1.  I $G(BTPWPNTD)="" S BTPWPNTD=$$DT^XLFDT()
  1.  S X=BTPWPNTD,DA(1)=CMIEN
  1.  S DIC(0)="L",DIC="^BTPWP("_DA(1)_",11,",DIE=DIC
  1.  I $G(^BTPWP(DA(1),2,0))="" S ^BTPWP(DA(1),11,0)="^90620.011D^^"
  1.  K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
  1.  S IENS=$$IENS^DILF(.DA)
  1.  ;
  1.  S BTPWDTA(90620.011,IENS,.02)=BTPWPNOT
  1.  S BTPWDTA(90620.011,IENS,.03)=$$NOW^XLFDT()
  1.  S BTPWDTA(90620.011,IENS,.04)=DUZ
  1.  S BTPWDTA(90620.011,IENS,.05)=$G(TIUDA)
  1.  S BTPWDTA(90620.011,IENS,.11)=$G(BTPWVIEN)
  1.  Q
  1.  ;
  1. FUT(BTPWPFOL,BTPWPFLD) ;EP - Create future followup record
  1.  N BTPWDFN,PIEN,BTUPD
  1.  S BTPWDFN=$P(^BTPWP(CMIEN,0),U,2)
  1.  S PIEN=$$REC^BTPWPTMP(BTPWPFOL)
  1.  S BTUPD(90620,PIEN_",",.02)=BTPWDFN,BTUPD(90620,PIEN_",",.11)=CMIEN
  1.  S BTUPD(90620,PIEN_",",1.03)=DUZ,BTUPD(90620,PIEN_",",.13)=BTPWPFLD
  1.  S BTUPD(90620,PIEN_",",1.01)="F",BTUPD(90620,PIEN_",",1.02)=$$NOW^XLFDT()
  1.  S BTUPD(90620,PIEN_",",1.1)=DUZ,BTUPD(90620,PIEN_",",1.09)=BTUPD(90620,PIEN_",",1.02)
  1.  S BTUPD(90620,PIEN_",",.12)=$$GET1^DIQ(90620,CMIEN_",",.12,"I")
  1.  S BTUPD(90620,PIEN_",",.16)=$$GET1^DIQ(9000001,BTPWDFN_",",1117,"I")
  1.  ;
  1.  ;Log History Entry
  1.  I $D(BTUPD)>0 D RLOG^BTPWHIST(.BTUPD,DUZ,DTTM,"Event Update")
  1.  ;
  1.  ;File information
  1.  D FILE^DIE("","BTUPD","ERROR")
  1.  Q PIEN
  1.  ;
  1. PREP(BTPWPRC) ;EP -- Prepare variables
  1.  NEW IEN,VALUE,SOURCE
  1.  S IEN="",VALUE=""
  1.  S IEN=$O(^BTPW(90628,1,2,"B",BTPWPRC,IEN))
  1.  I IEN="" S BMXSEC="RPC Failed: This procedure is not on file for batch events" Q
  1.  S SOURCE="BTPWPFND",TYPE="T",VALUE=$P($G(^BTPW(90628,1,2,IEN,1)),U,1) D
  1.  . S @SOURCE=VALUE D ARAY(SOURCE)
  1.  S SOURCE="BTPWFNTR" D
  1.  . NEW IIEN
  1.  . S IIEN=$O(^BTPW(90621,BTPWPRC,6,"B",BTPWPFND,"")) I IIEN="" Q
  1.  . S VALUE=$P(^BTPW(90621,BTPWPRC,6,IIEN,0),U,2)
  1.  . S @SOURCE=VALUE D ARAY(SOURCE)
  1.  ; For followup event, same as selected event
  1.  S SOURCE="BTPWPFOL",VALUE=BTPWPRC,@SOURCE=VALUE D ARAY(SOURCE)
  1.  ; For close reason, Event Complete = 1
  1.  S SOURCE="BTPWPCLR",VALUE=1,@SOURCE=VALUE D ARAY(SOURCE)
  1.  S SOURCE="BTPWSTGE",VALUE="C",@SOURCE=VALUE D ARAY(SOURCE)
  1.  Q
  1.  ;
  1. ARAY(NAME) ; EP
  1.  NEW PFIEN,FIELD,EXEC
  1.  S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
  1.  I PFIEN="" Q
  1.  S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
  1.  S EXEC=$G(^BQI(90506.3,VFIEN,10,PFIEN,7))
  1.  I EXEC'="" X EXEC Q
  1.  I FIELD="" Q
  1.  S BTPWDTA(FILE,IENS,FIELD)=@NAME
  1.  Q