- 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