BTPWBTAD ;VNGT/HS/ALA-Update Batch Processing ; 05 Nov 2009 3:18 PM
;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
;
;
UPD(DATA,TYPE,RIEN,PARMS) ; EP -- BTPW UPDATE BATCH PROCESS
; Input
; TYPE = "Q" from Queued list, "T" from Tracked List
; RIEN = Record IEN
; PARMS = Filing parameters
;
NEW UID,II,RESULT,BTPWPRC,BTPWSTGE,CHIEN,CMIEN,NAME,VALUE,VFIEN,PDATA,BQ,BTPWWP
NEW BTPWDFN,BTPWFNTR,BTPWINFD,BTPWPCLR,BTPWPFLD,BTPWPFND,BTPWPFOL,BTPWPNOT
NEW BTPFLND,BTPFNDTM,BTPWPNTD,BTPWDTA,FDUE,NDUE,RDUE,STAT,OTYPE
NEW EXEC,FIELD,FILE,IENS,NAME,PDATA,PFIEN,PIEN,PTYP,VALUE,X,Y,DTTM
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPTMP",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPTMP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
S @DATA@(II)="I00010RESULT^T01024MSG^I00010CMET_IEN"_$C(30)
;
;Pull current date/time
S DTTM=$$NOW^XLFDT()
;
S PARMS=$G(PARMS,"")
I PARMS="" D
. N BN,LIST
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
;
; If from queued list, need to move over into Tracked Event file
S OTYPE=TYPE
I TYPE="Q" D
. S STAT="T"
. ; Queue history record
. D QHIS^BTPWPTMP
. ;
. ; File update
. D FL^BTPWPTMP
. ; Move record into Tracked Event file
. S RDUE="",FDUE="",NDUE=""
. D MV^BTPWPTMP
. ;
. ;Make sure CMIEN is defined
. S CMIEN=$P($G(^BTPWQ(RIEN,0)),U,14)
;
I TYPE="T" D
. ; If batch processing from tracked events, move the history
. S CMIEN=RIEN,RIEN=$P(^BTPWP(CMIEN,0),U,14)
. NEW PIEN
. S PIEN=CMIEN
;
S VFIEN=$O(^BQI(90506.3,"B","CMET Batch Process",""))
I VFIEN="" S BMXSEC="RPC Call Failed: CMET Batch Process Definition does not exist." Q
S FILE=$P(^BQI(90506.3,VFIEN,0),U,2),IENS=CMIEN_","
;
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1),VALUE=$P(PDATA,"=",2,99)
. I VALUE="" S VALUE="@"
. ;I VALUE="" Q
. S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
. I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. S PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
. I PTYP="D" S VALUE=$$DATE^BQIUL1(VALUE)
. I PTYP="C" D
.. S CHIEN=$O(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,"")) I CHIEN="" Q
.. S VALUE=$P(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
. ;
. ;Word Processing Field
. I PTYP="W" D Q
.. N FIELD,LN,I,P
.. S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1) Q:FIELD=""
.. I VALUE="@" S BTPWDTA(FILE,IENS,FIELD)="@" Q
.. F LN=1:1:$L(VALUE,$C(10)) S P=$P(VALUE,$C(10),LN) S BTPWWP(FIELD,LN)=P
. ;
. S @NAME=VALUE
;
S BTPWPRC=$P(^BTPWP(CMIEN,0),U,1),BTPWINFD=$G(BTPWPFLD)
D PREP(BTPWPRC)
I BTPWINFD="" S BTPWPFLD=$P(^BTPWP(CMIEN,0),U,3),BTPWPFLD=$$FLDUE^BTPWPUTL(BTPWPRC,BTPWPFLD,"")
I BTPWINFD'="" S BTPWPFLD=$P(^BTPWP(CMIEN,0),U,3),BTPWPFLD=$$FLDUE^BTPWPUTL(BTPWPRC,BTPWPFLD,"",BTPWINFD)
;
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
. S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
. S NAME=$P(PDATA,"=",1)
. S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
. I PFIEN="" S BMXSEC=NAME_" not a valid parameter for this update" Q
. S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
. S PTYP=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1) Q:PTYP="W"
. S EXEC=$G(^BQI(90506.3,VFIEN,10,PFIEN,7))
. I EXEC'="" X EXEC Q
. I FIELD="" Q
. S BTPWDTA(FILE,IENS,FIELD)=@NAME
;
; Set the due by dates
S BTPWDTA(90620,CMIEN_",",1.05)=DT,BTPWDTA(90620,CMIEN_",",1.06)=DT,BTPWDTA(90620,CMIEN_",",1.07)=DT
;
; Set the Follow-up Needed field
S BTPWDTA(90620,CMIEN_",",1.11)="Y"
;
;S BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT(),BTPWDTA(90620,CMIEN_",",1.1)=DUZ
;
D FND
D NOT
D FOL
;
;File WP fields
I $D(BTPWWP) D
. N FIELD,WPVAR
. S WPVAR="COM"
. S FIELD="" F S FIELD=$O(BTPWWP(FIELD)) Q:FIELD="" D
.. N COM
.. M COM=BTPWWP(FIELD)
.. ;
.. ;Log History Entry
.. D WLOG^BTPWHIST(.COM,"90620:"_FIELD,IENS,DUZ,DTTM,"Event Update")
.. ;
.. ;Save WP field
.. D WP^DIE(90620,IENS,FIELD,"",WPVAR)
;
S RESULT=1_U
I $D(ERROR)>0 S RESULT=-1_U
K ERROR
;
;Log History Entry
I $D(BTPWDTA)>0 D RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Event Update")
;
;File information
I $D(BTPWDTA)>0 D FILE^DIE("","BTPWDTA","ERROR")
I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))
I $P(RESULT,U,1)'=-1 S RESULT=1_U_U_$G(CMIEN)
S II=II+1,@DATA@(II)=RESULT_$C(30)
;
DONE ;
D UNL^BTPWLOCK(OTYPE,RIEN)
S II=II+1,@DATA@(II)=$C(31)
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
;
FND ; Create Finding record
NEW DA,DIC,DLAYGO,IENS,BTUPD,X,DIC,DA,DLAYGO
I $G(BTPFNDTM)="" S BTPFNDTM=$$NOW^XLFDT()
I $G(BTPFLND)="" S BTPFLND="Y"
S DA(1)=CMIEN,X=BTPFNDTM
S DIC="^BTPWP("_DA(1)_",10,",DIC(0)="LMNZ",DLAYGO=90620.01,DIC("P")=DLAYGO
K DO,DD D FILE^DICN
S DA=+Y
S IENS=$$IENS^DILF(.DA)
S BTUPD(90620.01,IENS,.02)=BTPWPFND
S BTUPD(90620.01,IENS,.03)=BTPWFNTR
S BTUPD(90620.01,IENS,.04)=$$NOW^XLFDT()
S BTUPD(90620.01,IENS,.05)=DUZ
S BTUPD(90620.01,IENS,.07)=BTPWPFOL
;
;Log History Entry
I $D(BTUPD)>0 D RLOG^BTPWHIST(.BTUPD,DUZ,DTTM,"Event Update")
;
;File information
D FILE^DIE("","BTUPD","ERROR")
Q
;
FOL ; Create Followup record
NEW X,DIC,DA,Y,DIE,IENS
I $G(BTPWPFOL)=""!($G(BTPWPFLD)="") Q
I $G(BTPWPFLD)="" S X=$$NOW^XLFDT()
I $G(BTPWPFLD)'="" S X=BTPWPFLD
S DA(1)=CMIEN
S DIC(0)="L",DIC="^BTPWP("_DA(1)_",12,",DIE=DIC
I $G(^BTPWP(DA(1),2,0))="" S ^BTPWP(DA(1),12,0)="^90620.012D^^"
K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
S IENS=$$IENS^DILF(.DA)
;
S BTPWDTA(90620.012,IENS,.02)=BTPWPFOL
S BTPWDTA(90620.012,IENS,.03)=$$NOW^XLFDT()
S BTPWDTA(90620.012,IENS,.04)=DUZ
S BTPWDTA(90620.012,IENS,.05)=$$DATE^BQIUL1(BTPWPFLD)
S BTPWDTA(90620.012,IENS,.06)=$$FUT(BTPWPFOL,BTPWPFLD)
Q
;
NOT ; Create Notification record
NEW X,DA,DIC,IENS,DIE,Y,ABR
;
I BTPWPNOT="" Q
;
I $G(BTPWPNTD)="" S BTPWPNTD=$$DT^XLFDT()
S X=BTPWPNTD,DA(1)=CMIEN
S DIC(0)="L",DIC="^BTPWP("_DA(1)_",11,",DIE=DIC
I $G(^BTPWP(DA(1),2,0))="" S ^BTPWP(DA(1),11,0)="^90620.011D^^"
K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
S IENS=$$IENS^DILF(.DA)
;
S BTPWDTA(90620.011,IENS,.02)=BTPWPNOT
S BTPWDTA(90620.011,IENS,.03)=$$NOW^XLFDT()
S BTPWDTA(90620.011,IENS,.04)=DUZ
S BTPWDTA(90620.011,IENS,.05)=$G(TIUDA)
S BTPWDTA(90620.011,IENS,.11)=$G(BTPWVIEN)
Q
;
FUT(BTPWPFOL,BTPWPFLD) ;EP - Create future followup record
N BTPWDFN,PIEN,BTUPD
S BTPWDFN=$P(^BTPWP(CMIEN,0),U,2)
S PIEN=$$REC^BTPWPTMP(BTPWPFOL)
S BTUPD(90620,PIEN_",",.02)=BTPWDFN,BTUPD(90620,PIEN_",",.11)=CMIEN
S BTUPD(90620,PIEN_",",1.03)=DUZ,BTUPD(90620,PIEN_",",.13)=BTPWPFLD
S BTUPD(90620,PIEN_",",1.01)="F",BTUPD(90620,PIEN_",",1.02)=$$NOW^XLFDT()
S BTUPD(90620,PIEN_",",1.1)=DUZ,BTUPD(90620,PIEN_",",1.09)=BTUPD(90620,PIEN_",",1.02)
S BTUPD(90620,PIEN_",",.12)=$$GET1^DIQ(90620,CMIEN_",",.12,"I")
S BTUPD(90620,PIEN_",",.16)=$$GET1^DIQ(9000001,BTPWDFN_",",1117,"I")
;
;Log History Entry
I $D(BTUPD)>0 D RLOG^BTPWHIST(.BTUPD,DUZ,DTTM,"Event Update")
;
;File information
D FILE^DIE("","BTUPD","ERROR")
Q PIEN
;
PREP(BTPWPRC) ;EP -- Prepare variables
NEW IEN,VALUE,SOURCE
S IEN="",VALUE=""
S IEN=$O(^BTPW(90628,1,2,"B",BTPWPRC,IEN))
I IEN="" S BMXSEC="RPC Failed: This procedure is not on file for batch events" Q
S SOURCE="BTPWPFND",TYPE="T",VALUE=$P($G(^BTPW(90628,1,2,IEN,1)),U,1) D
. S @SOURCE=VALUE D ARAY(SOURCE)
S SOURCE="BTPWFNTR" D
. NEW IIEN
. S IIEN=$O(^BTPW(90621,BTPWPRC,6,"B",BTPWPFND,"")) I IIEN="" Q
. S VALUE=$P(^BTPW(90621,BTPWPRC,6,IIEN,0),U,2)
. S @SOURCE=VALUE D ARAY(SOURCE)
; For followup event, same as selected event
S SOURCE="BTPWPFOL",VALUE=BTPWPRC,@SOURCE=VALUE D ARAY(SOURCE)
; For close reason, Event Complete = 1
S SOURCE="BTPWPCLR",VALUE=1,@SOURCE=VALUE D ARAY(SOURCE)
S SOURCE="BTPWSTGE",VALUE="C",@SOURCE=VALUE D ARAY(SOURCE)
Q
;
ARAY(NAME) ; EP
NEW PFIEN,FIELD,EXEC
S PFIEN=$O(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
I PFIEN="" Q
S FIELD=$P($G(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
S EXEC=$G(^BQI(90506.3,VFIEN,10,PFIEN,7))
I EXEC'="" X EXEC Q
I FIELD="" Q
S BTPWDTA(FILE,IENS,FIELD)=@NAME
Q
BTPWBTAD ;VNGT/HS/ALA-Update Batch Processing ; 05 Nov 2009 3:18 PM
+1 ;;1.0;CARE MANAGEMENT EVENT TRACKING;;Feb 07, 2011
+2 ;
+3 ;
UPD(DATA,TYPE,RIEN,PARMS) ; EP -- BTPW UPDATE BATCH PROCESS
+1 ; Input
+2 ; TYPE = "Q" from Queued list, "T" from Tracked List
+3 ; RIEN = Record IEN
+4 ; PARMS = Filing parameters
+5 ;
+6 NEW UID,II,RESULT,BTPWPRC,BTPWSTGE,CHIEN,CMIEN,NAME,VALUE,VFIEN,PDATA,BQ,BTPWWP
+7 NEW BTPWDFN,BTPWFNTR,BTPWINFD,BTPWPCLR,BTPWPFLD,BTPWPFND,BTPWPFOL,BTPWPNOT
+8 NEW BTPFLND,BTPFNDTM,BTPWPNTD,BTPWDTA,FDUE,NDUE,RDUE,STAT,OTYPE
+9 NEW EXEC,FIELD,FILE,IENS,NAME,PDATA,PFIEN,PIEN,PTYP,VALUE,X,Y,DTTM
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BTPWPTMP",UID))
+12 KILL @DATA
+13 ;
+14 SET II=0
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPTMP D UNWIND^%ZTER"
+16 SET @DATA@(II)="I00010RESULT^T01024MSG^I00010CMET_IEN"_$CHAR(30)
+17 ;
+18 ;Pull current date/time
+19 SET DTTM=$$NOW^XLFDT()
+20 ;
+21 SET PARMS=$GET(PARMS,"")
+22 IF PARMS=""
Begin DoDot:1
+23 NEW BN,LIST
+24 SET LIST=""
SET BN=""
+25 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+26 KILL PARMS
+27 SET PARMS=LIST
End DoDot:1
+28 ;
+29 ; If from queued list, need to move over into Tracked Event file
+30 SET OTYPE=TYPE
+31 IF TYPE="Q"
Begin DoDot:1
+32 SET STAT="T"
+33 ; Queue history record
+34 DO QHIS^BTPWPTMP
+35 ;
+36 ; File update
+37 DO FL^BTPWPTMP
+38 ; Move record into Tracked Event file
+39 SET RDUE=""
SET FDUE=""
SET NDUE=""
+40 DO MV^BTPWPTMP
+41 ;
+42 ;Make sure CMIEN is defined
+43 SET CMIEN=$PIECE($GET(^BTPWQ(RIEN,0)),U,14)
End DoDot:1
+44 ;
+45 IF TYPE="T"
Begin DoDot:1
+46 ; If batch processing from tracked events, move the history
+47 SET CMIEN=RIEN
SET RIEN=$PIECE(^BTPWP(CMIEN,0),U,14)
+48 NEW PIEN
+49 SET PIEN=CMIEN
End DoDot:1
+50 ;
+51 SET VFIEN=$ORDER(^BQI(90506.3,"B","CMET Batch Process",""))
+52 IF VFIEN=""
SET BMXSEC="RPC Call Failed: CMET Batch Process Definition does not exist."
QUIT
+53 SET FILE=$PIECE(^BQI(90506.3,VFIEN,0),U,2)
SET IENS=CMIEN_","
+54 ;
+55 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+56 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+57 SET NAME=$PIECE(PDATA,"=",1)
SET VALUE=$PIECE(PDATA,"=",2,99)
+58 IF VALUE=""
SET VALUE="@"
+59 ;I VALUE="" Q
+60 SET PFIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
+61 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+62 SET PTYP=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
+63 IF PTYP="D"
SET VALUE=$$DATE^BQIUL1(VALUE)
+64 IF PTYP="C"
Begin DoDot:2
+65 SET CHIEN=$ORDER(^BQI(90506.3,VFIEN,10,PFIEN,5,"B",VALUE,""))
IF CHIEN=""
QUIT
+66 SET VALUE=$PIECE(^BQI(90506.3,VFIEN,10,PFIEN,5,CHIEN,0),U,2)
End DoDot:2
+67 ;
+68 ;Word Processing Field
+69 IF PTYP="W"
Begin DoDot:2
+70 NEW FIELD,LN,I,P
+71 SET FIELD=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
IF FIELD=""
QUIT
+72 IF VALUE="@"
SET BTPWDTA(FILE,IENS,FIELD)="@"
QUIT
+73 FOR LN=1:1:$LENGTH(VALUE,$CHAR(10))
SET P=$PIECE(VALUE,$CHAR(10),LN)
SET BTPWWP(FIELD,LN)=P
End DoDot:2
QUIT
+74 ;
+75 SET @NAME=VALUE
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+76 ;
+77 SET BTPWPRC=$PIECE(^BTPWP(CMIEN,0),U,1)
SET BTPWINFD=$GET(BTPWPFLD)
+78 DO PREP(BTPWPRC)
+79 IF BTPWINFD=""
SET BTPWPFLD=$PIECE(^BTPWP(CMIEN,0),U,3)
SET BTPWPFLD=$$FLDUE^BTPWPUTL(BTPWPRC,BTPWPFLD,"")
+80 IF BTPWINFD'=""
SET BTPWPFLD=$PIECE(^BTPWP(CMIEN,0),U,3)
SET BTPWPFLD=$$FLDUE^BTPWPUTL(BTPWPRC,BTPWPFLD,"",BTPWINFD)
+81 ;
+82 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+83 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+84 SET NAME=$PIECE(PDATA,"=",1)
+85 SET PFIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
+86 IF PFIEN=""
SET BMXSEC=NAME_" not a valid parameter for this update"
QUIT
+87 SET FIELD=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
+88 SET PTYP=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,1)),U,1)
IF PTYP="W"
QUIT
+89 SET EXEC=$GET(^BQI(90506.3,VFIEN,10,PFIEN,7))
+90 IF EXEC'=""
XECUTE EXEC
QUIT
+91 IF FIELD=""
QUIT
+92 SET BTPWDTA(FILE,IENS,FIELD)=@NAME
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+93 ;
+94 ; Set the due by dates
+95 SET BTPWDTA(90620,CMIEN_",",1.05)=DT
SET BTPWDTA(90620,CMIEN_",",1.06)=DT
SET BTPWDTA(90620,CMIEN_",",1.07)=DT
+96 ;
+97 ; Set the Follow-up Needed field
+98 SET BTPWDTA(90620,CMIEN_",",1.11)="Y"
+99 ;
+100 ;S BTPWDTA(90620,CMIEN_",",1.09)=$$NOW^XLFDT(),BTPWDTA(90620,CMIEN_",",1.1)=DUZ
+101 ;
+102 DO FND
+103 DO NOT
+104 DO FOL
+105 ;
+106 ;File WP fields
+107 IF $DATA(BTPWWP)
Begin DoDot:1
+108 NEW FIELD,WPVAR
+109 SET WPVAR="COM"
+110 SET FIELD=""
FOR
SET FIELD=$ORDER(BTPWWP(FIELD))
IF FIELD=""
QUIT
Begin DoDot:2
+111 NEW COM
+112 MERGE COM=BTPWWP(FIELD)
+113 ;
+114 ;Log History Entry
+115 DO WLOG^BTPWHIST(.COM,"90620:"_FIELD,IENS,DUZ,DTTM,"Event Update")
+116 ;
+117 ;Save WP field
+118 DO WP^DIE(90620,IENS,FIELD,"",WPVAR)
End DoDot:2
End DoDot:1
+119 ;
+120 SET RESULT=1_U
+121 IF $DATA(ERROR)>0
SET RESULT=-1_U
+122 KILL ERROR
+123 ;
+124 ;Log History Entry
+125 IF $DATA(BTPWDTA)>0
DO RLOG^BTPWHIST(.BTPWDTA,DUZ,DTTM,"Event Update")
+126 ;
+127 ;File information
+128 IF $DATA(BTPWDTA)>0
DO FILE^DIE("","BTPWDTA","ERROR")
+129 IF $DATA(ERROR)>0
SET RESULT=-1_U_$GET(ERROR("DIERR",1,"TEXT",1))
+130 IF $PIECE(RESULT,U,1)'=-1
SET RESULT=1_U_U_$GET(CMIEN)
+131 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
+132 ;
DONE ;
+1 DO UNL^BTPWLOCK(OTYPE,RIEN)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
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
+7 ;
FND ; Create Finding record
+1 NEW DA,DIC,DLAYGO,IENS,BTUPD,X,DIC,DA,DLAYGO
+2 IF $GET(BTPFNDTM)=""
SET BTPFNDTM=$$NOW^XLFDT()
+3 IF $GET(BTPFLND)=""
SET BTPFLND="Y"
+4 SET DA(1)=CMIEN
SET X=BTPFNDTM
+5 SET DIC="^BTPWP("_DA(1)_",10,"
SET DIC(0)="LMNZ"
SET DLAYGO=90620.01
SET DIC("P")=DLAYGO
+6 KILL DO,DD
DO FILE^DICN
+7 SET DA=+Y
+8 SET IENS=$$IENS^DILF(.DA)
+9 SET BTUPD(90620.01,IENS,.02)=BTPWPFND
+10 SET BTUPD(90620.01,IENS,.03)=BTPWFNTR
+11 SET BTUPD(90620.01,IENS,.04)=$$NOW^XLFDT()
+12 SET BTUPD(90620.01,IENS,.05)=DUZ
+13 SET BTUPD(90620.01,IENS,.07)=BTPWPFOL
+14 ;
+15 ;Log History Entry
+16 IF $DATA(BTUPD)>0
DO RLOG^BTPWHIST(.BTUPD,DUZ,DTTM,"Event Update")
+17 ;
+18 ;File information
+19 DO FILE^DIE("","BTUPD","ERROR")
+20 QUIT
+21 ;
FOL ; Create Followup record
+1 NEW X,DIC,DA,Y,DIE,IENS
+2 IF $GET(BTPWPFOL)=""!($GET(BTPWPFLD)="")
QUIT
+3 IF $GET(BTPWPFLD)=""
SET X=$$NOW^XLFDT()
+4 IF $GET(BTPWPFLD)'=""
SET X=BTPWPFLD
+5 SET DA(1)=CMIEN
+6 SET DIC(0)="L"
SET DIC="^BTPWP("_DA(1)_",12,"
SET DIE=DIC
+7 IF $GET(^BTPWP(DA(1),2,0))=""
SET ^BTPWP(DA(1),12,0)="^90620.012D^^"
+8 KILL DO,DD
DO FILE^DICN
SET DA=+Y
IF DA=-1
QUIT
+9 SET IENS=$$IENS^DILF(.DA)
+10 ;
+11 SET BTPWDTA(90620.012,IENS,.02)=BTPWPFOL
+12 SET BTPWDTA(90620.012,IENS,.03)=$$NOW^XLFDT()
+13 SET BTPWDTA(90620.012,IENS,.04)=DUZ
+14 SET BTPWDTA(90620.012,IENS,.05)=$$DATE^BQIUL1(BTPWPFLD)
+15 SET BTPWDTA(90620.012,IENS,.06)=$$FUT(BTPWPFOL,BTPWPFLD)
+16 QUIT
+17 ;
NOT ; Create Notification record
+1 NEW X,DA,DIC,IENS,DIE,Y,ABR
+2 ;
+3 IF BTPWPNOT=""
QUIT
+4 ;
+5 IF $GET(BTPWPNTD)=""
SET BTPWPNTD=$$DT^XLFDT()
+6 SET X=BTPWPNTD
SET DA(1)=CMIEN
+7 SET DIC(0)="L"
SET DIC="^BTPWP("_DA(1)_",11,"
SET DIE=DIC
+8 IF $GET(^BTPWP(DA(1),2,0))=""
SET ^BTPWP(DA(1),11,0)="^90620.011D^^"
+9 KILL DO,DD
DO FILE^DICN
SET DA=+Y
IF DA=-1
QUIT
+10 SET IENS=$$IENS^DILF(.DA)
+11 ;
+12 SET BTPWDTA(90620.011,IENS,.02)=BTPWPNOT
+13 SET BTPWDTA(90620.011,IENS,.03)=$$NOW^XLFDT()
+14 SET BTPWDTA(90620.011,IENS,.04)=DUZ
+15 SET BTPWDTA(90620.011,IENS,.05)=$GET(TIUDA)
+16 SET BTPWDTA(90620.011,IENS,.11)=$GET(BTPWVIEN)
+17 QUIT
+18 ;
FUT(BTPWPFOL,BTPWPFLD) ;EP - Create future followup record
+1 NEW BTPWDFN,PIEN,BTUPD
+2 SET BTPWDFN=$PIECE(^BTPWP(CMIEN,0),U,2)
+3 SET PIEN=$$REC^BTPWPTMP(BTPWPFOL)
+4 SET BTUPD(90620,PIEN_",",.02)=BTPWDFN
SET BTUPD(90620,PIEN_",",.11)=CMIEN
+5 SET BTUPD(90620,PIEN_",",1.03)=DUZ
SET BTUPD(90620,PIEN_",",.13)=BTPWPFLD
+6 SET BTUPD(90620,PIEN_",",1.01)="F"
SET BTUPD(90620,PIEN_",",1.02)=$$NOW^XLFDT()
+7 SET BTUPD(90620,PIEN_",",1.1)=DUZ
SET BTUPD(90620,PIEN_",",1.09)=BTUPD(90620,PIEN_",",1.02)
+8 SET BTUPD(90620,PIEN_",",.12)=$$GET1^DIQ(90620,CMIEN_",",.12,"I")
+9 SET BTUPD(90620,PIEN_",",.16)=$$GET1^DIQ(9000001,BTPWDFN_",",1117,"I")
+10 ;
+11 ;Log History Entry
+12 IF $DATA(BTUPD)>0
DO RLOG^BTPWHIST(.BTUPD,DUZ,DTTM,"Event Update")
+13 ;
+14 ;File information
+15 DO FILE^DIE("","BTUPD","ERROR")
+16 QUIT PIEN
+17 ;
PREP(BTPWPRC) ;EP -- Prepare variables
+1 NEW IEN,VALUE,SOURCE
+2 SET IEN=""
SET VALUE=""
+3 SET IEN=$ORDER(^BTPW(90628,1,2,"B",BTPWPRC,IEN))
+4 IF IEN=""
SET BMXSEC="RPC Failed: This procedure is not on file for batch events"
QUIT
+5 SET SOURCE="BTPWPFND"
SET TYPE="T"
SET VALUE=$PIECE($GET(^BTPW(90628,1,2,IEN,1)),U,1)
Begin DoDot:1
+6 SET @SOURCE=VALUE
DO ARAY(SOURCE)
End DoDot:1
+7 SET SOURCE="BTPWFNTR"
Begin DoDot:1
+8 NEW IIEN
+9 SET IIEN=$ORDER(^BTPW(90621,BTPWPRC,6,"B",BTPWPFND,""))
IF IIEN=""
QUIT
+10 SET VALUE=$PIECE(^BTPW(90621,BTPWPRC,6,IIEN,0),U,2)
+11 SET @SOURCE=VALUE
DO ARAY(SOURCE)
End DoDot:1
+12 ; For followup event, same as selected event
+13 SET SOURCE="BTPWPFOL"
SET VALUE=BTPWPRC
SET @SOURCE=VALUE
DO ARAY(SOURCE)
+14 ; For close reason, Event Complete = 1
+15 SET SOURCE="BTPWPCLR"
SET VALUE=1
SET @SOURCE=VALUE
DO ARAY(SOURCE)
+16 SET SOURCE="BTPWSTGE"
SET VALUE="C"
SET @SOURCE=VALUE
DO ARAY(SOURCE)
+17 QUIT
+18 ;
ARAY(NAME) ; EP
+1 NEW PFIEN,FIELD,EXEC
+2 SET PFIEN=$ORDER(^BQI(90506.3,VFIEN,10,"AC",NAME,""))
+3 IF PFIEN=""
QUIT
+4 SET FIELD=$PIECE($GET(^BQI(90506.3,VFIEN,10,PFIEN,3)),U,1)
+5 SET EXEC=$GET(^BQI(90506.3,VFIEN,10,PFIEN,7))
+6 IF EXEC'=""
XECUTE EXEC
QUIT
+7 IF FIELD=""
QUIT
+8 SET BTPWDTA(FILE,IENS,FIELD)=@NAME
+9 QUIT
