BTPWPTMP ;VNGT/HS/ALA-Handle CMET Temporary File ; 04 Feb 2009 2:55 PM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
UPD(DATA,PARMS) ; EP - BTPW UPDATE CMET TEMP
; Input Parameters
; STAT - Status of event N:NOT TRACKED;T:TRACKED
; RDUE - Findings Due By Date
; RLIST - List of temporary record IENS to be updated
; COMMENT - Event Comment Field
;
NEW UID,II,RESULT,BTI,LIST,BN,BQ,RIEN,CMIEN,STATUS,DUEDT,IEN,COMMENT,STAT,RDUE,RLIST,COM,LN,I,P,CMTVAR
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^I00010QUEUED_CMET_IEN^I00010TRACKED_CMET_IEN"_$C(30)
;
;Re-Assemble parameter list if in an array
S PARMS=$G(PARMS,"")
I PARMS="" D
. N LIST,BN
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
;
;Set up incoming variables
S (STATUS,DUEDT,IEN,COMMENT)=""
F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
.N PDATA,NAME,VALUE,BP,BV
.S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
.S NAME=$P(PDATA,"=",1) Q:NAME=""
.S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
.F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=@NAME_$S(BP=1:"",1:$C(29))_BV
;
;Copy input parameters into original variables used by RPC
S STAT=STATUS
S RDUE=DUEDT,RDUE=$$DATE^BQIUL1(RDUE)
M RLIST=IEN
;
;Set up comment for processing
S COMMENT=$G(COMMENT,"")
S LN=0 F I=1:1:$L(COMMENT,$C(10)) S P=$P(COMMENT,$C(10),I) S LN=LN+1,COM(LN)=P
I '$D(COM(1)) S CMTVAR="@"
E S CMTVAR="COM"
;
;Assemble List of IENs if in array
I RLIST="" D
. S LIST="",BN=""
. F S BN=$O(RLIST(BN)) Q:BN="" S LIST=LIST_RLIST(BN)
. K RLIST S RLIST=LIST
;
F BTI=1:1 S RIEN=$P(RLIST,$C(29),BTI) Q:RIEN="" D
. N CMIEN,BTPUPD,ERROR,RESULT
. ;
. ;Dot Structure to process for each event
. D
.. I STAT="N" D QHIS,FL Q
.. I STAT="P" D Q
... I $P(^BTPWQ(RIEN,0),U,8)'="N" Q
... D QHIS,FL
.. I STAT="T" D
... D QHIS,FL
... D MV
. ;
. ;Return one record per event
. S RESULT=1_U_U_$G(RIEN)_U_$G(CMIEN)
. I $D(BTPUPD)>0 D FILE^DIE("","BTPUPD","ERROR")
. I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))_U_$G(RIEN)_U_$G(CMIEN)
. S II=II+1,@DATA@(II)=RESULT_$C(30)
;
DONE ;
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
;
FL ;EP - Update file
S BTPUPD(90629,RIEN_",",.08)=STAT
S BTPUPD(90629,RIEN_",",.11)=$$NOW^XLFDT()
S BTPUPD(90629,RIEN_",",.12)=$$GET1^DIQ(200,DUZ_",",.01,"E")
D FILE^DIE("","BTPUPD","ERROR")
;
;Save comments - if provided
I $G(CMTVAR)]"" D WP^DIE(90629,RIEN_",",3,"",CMTVAR)
;
Q
;
MV ;EP - Move procedure into permanent file
NEW BTDATA,FRIL,DFN,PRCN,VISIT,DIC,DLAYGO,X,PIEN,WHIEN,RARPT,BTPUPD,RCIEN,DTTM
NEW RTMFRM,TMFRAME,FDUE,FTMFRM,NDUE,NTMFRM,CAT,MATCH,VSDTM,DATE,COMM,FIND,FC
S BTDATA=^BTPWQ(RIEN,0)
S PRCN=$P(BTDATA,U,1),DFN=$P(BTDATA,U,2),VISIT=$P(BTDATA,U,4)
S RCIEN=$P(BTDATA,U,5),FRIL=$P(BTDATA,U,6),DATE=$P(BTDATA,U,7)
S COMM=$P(BTDATA,U,16)
S MATCH=$P($G(^BTPWQ(RIEN,1)),U,1),FIND=$P($G(^BTPWQ(RIEN,1)),U,2)
;
;Pull current date/time
S DTTM=$$NOW^XLFDT()
;
I $D(^BTPWP("C",DFN,PRCN,VISIT,RCIEN,FRIL)) Q
;
S VSDTM=$P(BTDATA,U,3),WHIEN=$P(BTDATA,U,9),RARPT=$P(BTDATA,U,10),CAT=$P(BTDATA,U,13),ACCN=$P(BTDATA,U,15)
;
I MATCH D
. S (CMIEN,PIEN)=MATCH
. D RHIS
. S BTPUPD(90620,PIEN_",",.13)="@"
;
I 'MATCH S PIEN=$$REC(PRCN),CMIEN=PIEN
;
S BTPUPD(90620,PIEN_",",.02)=DFN,BTPUPD(90620,PIEN_",",.03)=VSDTM
S BTPUPD(90620,PIEN_",",.04)=VISIT,BTPUPD(90620,PIEN_",",.05)=RCIEN
S BTPUPD(90620,PIEN_",",.06)=FRIL,BTPUPD(90620,PIEN_",",.07)=DATE
S BTPUPD(90620,PIEN_",",.09)=WHIEN,BTPUPD(90620,PIEN_",",.1)=RARPT
S BTPUPD(90620,PIEN_",",.15)=ACCN
S BTPUPD(90620,PIEN_",",.08)="T",BTPUPD(90620,PIEN_",",1.01)="O"
S BTPUPD(90620,PIEN_",",.14)=RIEN,BTPUPD(90620,PIEN_",",.16)=COMM
S BTPUPD(90620,PIEN_",",1.02)=DTTM,BTPUPD(90620,PIEN_",",1.03)=DUZ
S BTPUPD(90620,PIEN_",",1.09)=BTPUPD(90620,PIEN_",",1.02),BTPUPD(90620,PIEN_",",1.1)=DUZ
S BTPUPD(90620,PIEN_",",1.05)=RDUE
S BTPUPD(90629,RIEN_",",.14)=PIEN
S BTPUPD(90620,PIEN_",",.12)=CAT
;
;Log History Entries
;Save Date Identified First
N DTIDT,USER
S DTIDT(90620,PIEN_",",.07)=DATE
S USER=DUZ,SIEN=$O(^BTPWQ(RIEN,2,0)) I SIEN]"" S USER=$P($G(^BTPWQ(RIEN,2,SIEN,0)),U,3)
I DATE'="" D RLOG^BTPWHIST(.DTIDT,USER,DATE,"Night Jobs Identified")
;
;Now Save Status Changes
D SLOG^BTPWHIST(RIEN,PIEN,DTTM,DUZ,"Status Changes")
;
;Save Remaining Information
M DTIDT=BTPUPD K DTIDT(90620,PIEN_",",.07),DTIDT(90620,PIEN_",",.08)
I $D(DTIDT)>0 D RLOG^BTPWHIST(.DTIDT,DUZ,DTTM,"Event Tracked")
K DTIDT,USER
;End of History Saving Code
;
; Move Finding
I FIND'="" D
. S INTR=$$GET1^DIQ(90620.9,FIND_",",.02,"I")
. D FND(PIEN)
. S BTUPD(90620,PIEN_",",1.05)=DT
. D FILE^DIE("","BTUPD","ERROR")
;
;File the Information
D FILE^DIE("","BTPUPD","ERROR")
I $D(ERROR) Q
;
;Save Status Comment to Tracked File EVENT COMMENTS field
D WP^DIE(90620,PIEN_",",4,"","^BTPWQ(RIEN,3)")
;
Q
;
QHIS ; EP - Build queue history record
NEW FDA,PSTAT,PUSR,PDTM,DIC,DA,DIE,X,IENS
;
S PSTAT=$P(^BTPWQ(RIEN,0),U,8)
S PUSR=$P(^BTPWQ(RIEN,0),U,12)
S PDTM=$P(^BTPWQ(RIEN,0),U,11)
;
S DIC(0)="L",DA(1)=RIEN,DIC="^BTPWQ("_DA(1)_",2,",DIE=DIC
I $G(^BTPWQ(DA(1),2,0))="" S ^BTPWQ(DA(1),2,0)="^90629.02D^^"
S X=$$NOW^XLFDT()
K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
;
S IENS=$$IENS^DILF(.DA)
S FDA(90629.02,IENS,.02)=PSTAT
S FDA(90629.02,IENS,.03)=PUSR
S FDA(90629.02,IENS,.04)=PDTM
;
D FILE^DIE("","FDA","ERROR")
;
;Save Status Comment to History
D WP^DIE(90629.02,IENS,1,"","^BTPWQ(RIEN,3)")
Q
;
RHIS ; EP - Build tracked history record
NEW FDA,PSTATE,PUSR,PDTM,PCREAS,DIC,DA,DIE,X,IENS
;
S PSTATE=$P($G(^BTPWP(PIEN,1)),U,1)
S PUSR=$P($G(^BTPWP(PIEN,1)),U,3),PUSR=$$GET1^DIQ(200,PUSR_",",.01,"E")
S PDTM=$P($G(^BTPWP(PIEN,1)),U,2)
S PCREAS=$P($G(^BTPWP(PIEN,1)),U,4)
;
S DIC(0)="L",DA(1)=PIEN,DIC="^BTPWP("_DA(1)_",2,",DIE=DIC
I $G(^BTPWP(DA(1),2,0))="" S ^BTPWP(DA(1),2,0)="^90620.02D^^"
S X=$$NOW^XLFDT()
K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
;
S IENS=$$IENS^DILF(.DA)
S FDA(90620.02,IENS,.02)=PSTATE
S FDA(90620.02,IENS,.03)=PUSR
S FDA(90620.02,IENS,.04)=PDTM
S FDA(90620.02,IENS,.05)=PCREAS
D FILE^DIE("","FDA","ERROR")
;
;Save State Comment to History
D WP^DIE(90620.02,IENS,1,"","^BTPWP(PIEN,3)")
Q
;
REC(PRCN) ;EP - Create a new record
NEW DIC,DLAYGO,X,Y
S DIC="^BTPWP(",DIC(0)="LMNZ",DLAYGO=90620,DIC("P")=DLAYGO
S X=PRCN
K DO,DD D FILE^DICN
Q +Y
;
FND(CMIEN) ;EP - Add a Finding
S BTPFNDTM=$$NOW^XLFDT()
D FND^BTPWPWRS
NEW DA,IENS
S DA(1)=CMIEN,DA=EVIEN,IENS=$$IENS^DILF(.DA)
S BTUPD(90620.01,IENS,.02)=FIND
S BTUPD(90620.01,IENS,.03)=INTR
S BTUPD(90620.01,IENS,.04)=$$NOW^XLFDT()
S BTUPD(90620.01,IENS,.05)=DUZ
D FILE^DIE("","BTUPD","ERROR")
D WP^DIE(90620.01,IENS,1,"","^BTPWQ(RIEN,4)")
Q
BTPWPTMP ;VNGT/HS/ALA-Handle CMET Temporary File ; 04 Feb 2009 2:55 PM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
UPD(DATA,PARMS) ; EP - BTPW UPDATE CMET TEMP
+1 ; Input Parameters
+2 ; STAT - Status of event N:NOT TRACKED;T:TRACKED
+3 ; RDUE - Findings Due By Date
+4 ; RLIST - List of temporary record IENS to be updated
+5 ; COMMENT - Event Comment Field
+6 ;
+7 NEW UID,II,RESULT,BTI,LIST,BN,BQ,RIEN,CMIEN,STATUS,DUEDT,IEN,COMMENT,STAT,RDUE,RLIST,COM,LN,I,P,CMTVAR
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BTPWPTMP",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPTMP D UNWIND^%ZTER"
+14 SET @DATA@(II)="I00010RESULT^T01024MSG^I00010QUEUED_CMET_IEN^I00010TRACKED_CMET_IEN"_$CHAR(30)
+15 ;
+16 ;Re-Assemble parameter list if in an array
+17 SET PARMS=$GET(PARMS,"")
+18 IF PARMS=""
Begin DoDot:1
+19 NEW LIST,BN
+20 SET LIST=""
SET BN=""
+21 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+22 KILL PARMS
+23 SET PARMS=LIST
End DoDot:1
+24 ;
+25 ;Set up incoming variables
+26 SET (STATUS,DUEDT,IEN,COMMENT)=""
+27 FOR BQ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+28 NEW PDATA,NAME,VALUE,BP,BV
+29 SET PDATA=$PIECE(PARMS,$CHAR(28),BQ)
IF PDATA=""
QUIT
+30 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""
QUIT
+31 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+32 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=@NAME_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+33 ;
+34 ;Copy input parameters into original variables used by RPC
+35 SET STAT=STATUS
+36 SET RDUE=DUEDT
SET RDUE=$$DATE^BQIUL1(RDUE)
+37 MERGE RLIST=IEN
+38 ;
+39 ;Set up comment for processing
+40 SET COMMENT=$GET(COMMENT,"")
+41 SET LN=0
FOR I=1:1:$LENGTH(COMMENT,$CHAR(10))
SET P=$PIECE(COMMENT,$CHAR(10),I)
SET LN=LN+1
SET COM(LN)=P
+42 IF '$DATA(COM(1))
SET CMTVAR="@"
+43 IF '$TEST
SET CMTVAR="COM"
+44 ;
+45 ;Assemble List of IENs if in array
+46 IF RLIST=""
Begin DoDot:1
+47 SET LIST=""
SET BN=""
+48 FOR
SET BN=$ORDER(RLIST(BN))
IF BN=""
QUIT
SET LIST=LIST_RLIST(BN)
+49 KILL RLIST
SET RLIST=LIST
End DoDot:1
+50 ;
+51 FOR BTI=1:1
SET RIEN=$PIECE(RLIST,$CHAR(29),BTI)
IF RIEN=""
QUIT
Begin DoDot:1
+52 NEW CMIEN,BTPUPD,ERROR,RESULT
+53 ;
+54 ;Dot Structure to process for each event
+55 Begin DoDot:2
+56 IF STAT="N"
DO QHIS
DO FL
QUIT
+57 IF STAT="P"
Begin DoDot:3
+58 IF $PIECE(^BTPWQ(RIEN,0),U,8)'="N"
QUIT
+59 DO QHIS
DO FL
End DoDot:3
QUIT
+60 IF STAT="T"
Begin DoDot:3
+61 DO QHIS
DO FL
+62 DO MV
End DoDot:3
End DoDot:2
+63 ;
+64 ;Return one record per event
+65 SET RESULT=1_U_U_$GET(RIEN)_U_$GET(CMIEN)
+66 IF $DATA(BTPUPD)>0
DO FILE^DIE("","BTPUPD","ERROR")
+67 IF $DATA(ERROR)>0
SET RESULT=-1_U_$GET(ERROR("DIERR",1,"TEXT",1))_U_$GET(RIEN)_U_$GET(CMIEN)
+68 SET II=II+1
SET @DATA@(II)=RESULT_$CHAR(30)
End DoDot:1
+69 ;
DONE ;
+1 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+2 QUIT
+3 ;
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 ;
FL ;EP - Update file
+1 SET BTPUPD(90629,RIEN_",",.08)=STAT
+2 SET BTPUPD(90629,RIEN_",",.11)=$$NOW^XLFDT()
+3 SET BTPUPD(90629,RIEN_",",.12)=$$GET1^DIQ(200,DUZ_",",.01,"E")
+4 DO FILE^DIE("","BTPUPD","ERROR")
+5 ;
+6 ;Save comments - if provided
+7 IF $GET(CMTVAR)]""
DO WP^DIE(90629,RIEN_",",3,"",CMTVAR)
+8 ;
+9 QUIT
+10 ;
MV ;EP - Move procedure into permanent file
+1 NEW BTDATA,FRIL,DFN,PRCN,VISIT,DIC,DLAYGO,X,PIEN,WHIEN,RARPT,BTPUPD,RCIEN,DTTM
+2 NEW RTMFRM,TMFRAME,FDUE,FTMFRM,NDUE,NTMFRM,CAT,MATCH,VSDTM,DATE,COMM,FIND,FC
+3 SET BTDATA=^BTPWQ(RIEN,0)
+4 SET PRCN=$PIECE(BTDATA,U,1)
SET DFN=$PIECE(BTDATA,U,2)
SET VISIT=$PIECE(BTDATA,U,4)
+5 SET RCIEN=$PIECE(BTDATA,U,5)
SET FRIL=$PIECE(BTDATA,U,6)
SET DATE=$PIECE(BTDATA,U,7)
+6 SET COMM=$PIECE(BTDATA,U,16)
+7 SET MATCH=$PIECE($GET(^BTPWQ(RIEN,1)),U,1)
SET FIND=$PIECE($GET(^BTPWQ(RIEN,1)),U,2)
+8 ;
+9 ;Pull current date/time
+10 SET DTTM=$$NOW^XLFDT()
+11 ;
+12 IF $DATA(^BTPWP("C",DFN,PRCN,VISIT,RCIEN,FRIL))
QUIT
+13 ;
+14 SET VSDTM=$PIECE(BTDATA,U,3)
SET WHIEN=$PIECE(BTDATA,U,9)
SET RARPT=$PIECE(BTDATA,U,10)
SET CAT=$PIECE(BTDATA,U,13)
SET ACCN=$PIECE(BTDATA,U,15)
+15 ;
+16 IF MATCH
Begin DoDot:1
+17 SET (CMIEN,PIEN)=MATCH
+18 DO RHIS
+19 SET BTPUPD(90620,PIEN_",",.13)="@"
End DoDot:1
+20 ;
+21 IF 'MATCH
SET PIEN=$$REC(PRCN)
SET CMIEN=PIEN
+22 ;
+23 SET BTPUPD(90620,PIEN_",",.02)=DFN
SET BTPUPD(90620,PIEN_",",.03)=VSDTM
+24 SET BTPUPD(90620,PIEN_",",.04)=VISIT
SET BTPUPD(90620,PIEN_",",.05)=RCIEN
+25 SET BTPUPD(90620,PIEN_",",.06)=FRIL
SET BTPUPD(90620,PIEN_",",.07)=DATE
+26 SET BTPUPD(90620,PIEN_",",.09)=WHIEN
SET BTPUPD(90620,PIEN_",",.1)=RARPT
+27 SET BTPUPD(90620,PIEN_",",.15)=ACCN
+28 SET BTPUPD(90620,PIEN_",",.08)="T"
SET BTPUPD(90620,PIEN_",",1.01)="O"
+29 SET BTPUPD(90620,PIEN_",",.14)=RIEN
SET BTPUPD(90620,PIEN_",",.16)=COMM
+30 SET BTPUPD(90620,PIEN_",",1.02)=DTTM
SET BTPUPD(90620,PIEN_",",1.03)=DUZ
+31 SET BTPUPD(90620,PIEN_",",1.09)=BTPUPD(90620,PIEN_",",1.02)
SET BTPUPD(90620,PIEN_",",1.1)=DUZ
+32 SET BTPUPD(90620,PIEN_",",1.05)=RDUE
+33 SET BTPUPD(90629,RIEN_",",.14)=PIEN
+34 SET BTPUPD(90620,PIEN_",",.12)=CAT
+35 ;
+36 ;Log History Entries
+37 ;Save Date Identified First
+38 NEW DTIDT,USER
+39 SET DTIDT(90620,PIEN_",",.07)=DATE
+40 SET USER=DUZ
SET SIEN=$ORDER(^BTPWQ(RIEN,2,0))
IF SIEN]""
SET USER=$PIECE($GET(^BTPWQ(RIEN,2,SIEN,0)),U,3)
+41 IF DATE'=""
DO RLOG^BTPWHIST(.DTIDT,USER,DATE,"Night Jobs Identified")
+42 ;
+43 ;Now Save Status Changes
+44 DO SLOG^BTPWHIST(RIEN,PIEN,DTTM,DUZ,"Status Changes")
+45 ;
+46 ;Save Remaining Information
+47 MERGE DTIDT=BTPUPD
KILL DTIDT(90620,PIEN_",",.07),DTIDT(90620,PIEN_",",.08)
+48 IF $DATA(DTIDT)>0
DO RLOG^BTPWHIST(.DTIDT,DUZ,DTTM,"Event Tracked")
+49 KILL DTIDT,USER
+50 ;End of History Saving Code
+51 ;
+52 ; Move Finding
+53 IF FIND'=""
Begin DoDot:1
+54 SET INTR=$$GET1^DIQ(90620.9,FIND_",",.02,"I")
+55 DO FND(PIEN)
+56 SET BTUPD(90620,PIEN_",",1.05)=DT
+57 DO FILE^DIE("","BTUPD","ERROR")
End DoDot:1
+58 ;
+59 ;File the Information
+60 DO FILE^DIE("","BTPUPD","ERROR")
+61 IF $DATA(ERROR)
QUIT
+62 ;
+63 ;Save Status Comment to Tracked File EVENT COMMENTS field
+64 DO WP^DIE(90620,PIEN_",",4,"","^BTPWQ(RIEN,3)")
+65 ;
+66 QUIT
+67 ;
QHIS ; EP - Build queue history record
+1 NEW FDA,PSTAT,PUSR,PDTM,DIC,DA,DIE,X,IENS
+2 ;
+3 SET PSTAT=$PIECE(^BTPWQ(RIEN,0),U,8)
+4 SET PUSR=$PIECE(^BTPWQ(RIEN,0),U,12)
+5 SET PDTM=$PIECE(^BTPWQ(RIEN,0),U,11)
+6 ;
+7 SET DIC(0)="L"
SET DA(1)=RIEN
SET DIC="^BTPWQ("_DA(1)_",2,"
SET DIE=DIC
+8 IF $GET(^BTPWQ(DA(1),2,0))=""
SET ^BTPWQ(DA(1),2,0)="^90629.02D^^"
+9 SET X=$$NOW^XLFDT()
+10 KILL DO,DD
DO FILE^DICN
SET DA=+Y
IF DA=-1
QUIT
+11 ;
+12 SET IENS=$$IENS^DILF(.DA)
+13 SET FDA(90629.02,IENS,.02)=PSTAT
+14 SET FDA(90629.02,IENS,.03)=PUSR
+15 SET FDA(90629.02,IENS,.04)=PDTM
+16 ;
+17 DO FILE^DIE("","FDA","ERROR")
+18 ;
+19 ;Save Status Comment to History
+20 DO WP^DIE(90629.02,IENS,1,"","^BTPWQ(RIEN,3)")
+21 QUIT
+22 ;
RHIS ; EP - Build tracked history record
+1 NEW FDA,PSTATE,PUSR,PDTM,PCREAS,DIC,DA,DIE,X,IENS
+2 ;
+3 SET PSTATE=$PIECE($GET(^BTPWP(PIEN,1)),U,1)
+4 SET PUSR=$PIECE($GET(^BTPWP(PIEN,1)),U,3)
SET PUSR=$$GET1^DIQ(200,PUSR_",",.01,"E")
+5 SET PDTM=$PIECE($GET(^BTPWP(PIEN,1)),U,2)
+6 SET PCREAS=$PIECE($GET(^BTPWP(PIEN,1)),U,4)
+7 ;
+8 SET DIC(0)="L"
SET DA(1)=PIEN
SET DIC="^BTPWP("_DA(1)_",2,"
SET DIE=DIC
+9 IF $GET(^BTPWP(DA(1),2,0))=""
SET ^BTPWP(DA(1),2,0)="^90620.02D^^"
+10 SET X=$$NOW^XLFDT()
+11 KILL DO,DD
DO FILE^DICN
SET DA=+Y
IF DA=-1
QUIT
+12 ;
+13 SET IENS=$$IENS^DILF(.DA)
+14 SET FDA(90620.02,IENS,.02)=PSTATE
+15 SET FDA(90620.02,IENS,.03)=PUSR
+16 SET FDA(90620.02,IENS,.04)=PDTM
+17 SET FDA(90620.02,IENS,.05)=PCREAS
+18 DO FILE^DIE("","FDA","ERROR")
+19 ;
+20 ;Save State Comment to History
+21 DO WP^DIE(90620.02,IENS,1,"","^BTPWP(PIEN,3)")
+22 QUIT
+23 ;
REC(PRCN) ;EP - Create a new record
+1 NEW DIC,DLAYGO,X,Y
+2 SET DIC="^BTPWP("
SET DIC(0)="LMNZ"
SET DLAYGO=90620
SET DIC("P")=DLAYGO
+3 SET X=PRCN
+4 KILL DO,DD
DO FILE^DICN
+5 QUIT +Y
+6 ;
FND(CMIEN) ;EP - Add a Finding
+1 SET BTPFNDTM=$$NOW^XLFDT()
+2 DO FND^BTPWPWRS
+3 NEW DA,IENS
+4 SET DA(1)=CMIEN
SET DA=EVIEN
SET IENS=$$IENS^DILF(.DA)
+5 SET BTUPD(90620.01,IENS,.02)=FIND
+6 SET BTUPD(90620.01,IENS,.03)=INTR
+7 SET BTUPD(90620.01,IENS,.04)=$$NOW^XLFDT()
+8 SET BTUPD(90620.01,IENS,.05)=DUZ
+9 DO FILE^DIE("","BTUPD","ERROR")
+10 DO WP^DIE(90620.01,IENS,1,"","^BTPWQ(RIEN,4)")
+11 QUIT
