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

BTPWPTMP.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. UPD(DATA,PARMS) ; EP - BTPW UPDATE CMET TEMP
  1. ; Input Parameters
  1. ; STAT - Status of event N:NOT TRACKED;T:TRACKED
  1. ; RDUE - Findings Due By Date
  1. ; RLIST - List of temporary record IENS to be updated
  1. ; COMMENT - Event Comment Field
  1. ;
  1. NEW UID,II,RESULT,BTI,LIST,BN,BQ,RIEN,CMIEN,STATUS,DUEDT,IEN,COMMENT,STAT,RDUE,RLIST,COM,LN,I,P,CMTVAR
  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^I00010QUEUED_CMET_IEN^I00010TRACKED_CMET_IEN"_$C(30)
  1. ;
  1. ;Re-Assemble parameter list if in an array
  1. S PARMS=$G(PARMS,"")
  1. I PARMS="" D
  1. . N LIST,BN
  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. ;Set up incoming variables
  1. S (STATUS,DUEDT,IEN,COMMENT)=""
  1. F BQ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
  1. .N PDATA,NAME,VALUE,BP,BV
  1. .S PDATA=$P(PARMS,$C(28),BQ) Q:PDATA=""
  1. .S NAME=$P(PDATA,"=",1) Q:NAME=""
  1. .S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
  1. .F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=@NAME_$S(BP=1:"",1:$C(29))_BV
  1. ;
  1. ;Copy input parameters into original variables used by RPC
  1. S STAT=STATUS
  1. S RDUE=DUEDT,RDUE=$$DATE^BQIUL1(RDUE)
  1. M RLIST=IEN
  1. ;
  1. ;Set up comment for processing
  1. S COMMENT=$G(COMMENT,"")
  1. 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
  1. I '$D(COM(1)) S CMTVAR="@"
  1. E S CMTVAR="COM"
  1. ;
  1. ;Assemble List of IENs if in array
  1. I RLIST="" D
  1. . S LIST="",BN=""
  1. . F S BN=$O(RLIST(BN)) Q:BN="" S LIST=LIST_RLIST(BN)
  1. . K RLIST S RLIST=LIST
  1. ;
  1. F BTI=1:1 S RIEN=$P(RLIST,$C(29),BTI) Q:RIEN="" D
  1. . N CMIEN,BTPUPD,ERROR,RESULT
  1. . ;
  1. . ;Dot Structure to process for each event
  1. . D
  1. .. I STAT="N" D QHIS,FL Q
  1. .. I STAT="P" D Q
  1. ... I $P(^BTPWQ(RIEN,0),U,8)'="N" Q
  1. ... D QHIS,FL
  1. .. I STAT="T" D
  1. ... D QHIS,FL
  1. ... D MV
  1. . ;
  1. . ;Return one record per event
  1. . S RESULT=1_U_U_$G(RIEN)_U_$G(CMIEN)
  1. . I $D(BTPUPD)>0 D FILE^DIE("","BTPUPD","ERROR")
  1. . I $D(ERROR)>0 S RESULT=-1_U_$G(ERROR("DIERR",1,"TEXT",1))_U_$G(RIEN)_U_$G(CMIEN)
  1. . S II=II+1,@DATA@(II)=RESULT_$C(30)
  1. ;
  1. DONE ;
  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. FL ;EP - Update file
  1. S BTPUPD(90629,RIEN_",",.08)=STAT
  1. S BTPUPD(90629,RIEN_",",.11)=$$NOW^XLFDT()
  1. S BTPUPD(90629,RIEN_",",.12)=$$GET1^DIQ(200,DUZ_",",.01,"E")
  1. D FILE^DIE("","BTPUPD","ERROR")
  1. ;
  1. ;Save comments - if provided
  1. I $G(CMTVAR)]"" D WP^DIE(90629,RIEN_",",3,"",CMTVAR)
  1. ;
  1. Q
  1. ;
  1. MV ;EP - Move procedure into permanent file
  1. NEW BTDATA,FRIL,DFN,PRCN,VISIT,DIC,DLAYGO,X,PIEN,WHIEN,RARPT,BTPUPD,RCIEN,DTTM
  1. NEW RTMFRM,TMFRAME,FDUE,FTMFRM,NDUE,NTMFRM,CAT,MATCH,VSDTM,DATE,COMM,FIND,FC
  1. S BTDATA=^BTPWQ(RIEN,0)
  1. S PRCN=$P(BTDATA,U,1),DFN=$P(BTDATA,U,2),VISIT=$P(BTDATA,U,4)
  1. S RCIEN=$P(BTDATA,U,5),FRIL=$P(BTDATA,U,6),DATE=$P(BTDATA,U,7)
  1. S COMM=$P(BTDATA,U,16)
  1. S MATCH=$P($G(^BTPWQ(RIEN,1)),U,1),FIND=$P($G(^BTPWQ(RIEN,1)),U,2)
  1. ;
  1. ;Pull current date/time
  1. S DTTM=$$NOW^XLFDT()
  1. ;
  1. I $D(^BTPWP("C",DFN,PRCN,VISIT,RCIEN,FRIL)) Q
  1. ;
  1. 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)
  1. ;
  1. I MATCH D
  1. . S (CMIEN,PIEN)=MATCH
  1. . D RHIS
  1. . S BTPUPD(90620,PIEN_",",.13)="@"
  1. ;
  1. I 'MATCH S PIEN=$$REC(PRCN),CMIEN=PIEN
  1. ;
  1. S BTPUPD(90620,PIEN_",",.02)=DFN,BTPUPD(90620,PIEN_",",.03)=VSDTM
  1. S BTPUPD(90620,PIEN_",",.04)=VISIT,BTPUPD(90620,PIEN_",",.05)=RCIEN
  1. S BTPUPD(90620,PIEN_",",.06)=FRIL,BTPUPD(90620,PIEN_",",.07)=DATE
  1. S BTPUPD(90620,PIEN_",",.09)=WHIEN,BTPUPD(90620,PIEN_",",.1)=RARPT
  1. S BTPUPD(90620,PIEN_",",.15)=ACCN
  1. S BTPUPD(90620,PIEN_",",.08)="T",BTPUPD(90620,PIEN_",",1.01)="O"
  1. S BTPUPD(90620,PIEN_",",.14)=RIEN,BTPUPD(90620,PIEN_",",.16)=COMM
  1. S BTPUPD(90620,PIEN_",",1.02)=DTTM,BTPUPD(90620,PIEN_",",1.03)=DUZ
  1. S BTPUPD(90620,PIEN_",",1.09)=BTPUPD(90620,PIEN_",",1.02),BTPUPD(90620,PIEN_",",1.1)=DUZ
  1. S BTPUPD(90620,PIEN_",",1.05)=RDUE
  1. S BTPUPD(90629,RIEN_",",.14)=PIEN
  1. S BTPUPD(90620,PIEN_",",.12)=CAT
  1. ;
  1. ;Log History Entries
  1. ;Save Date Identified First
  1. N DTIDT,USER
  1. S DTIDT(90620,PIEN_",",.07)=DATE
  1. S USER=DUZ,SIEN=$O(^BTPWQ(RIEN,2,0)) I SIEN]"" S USER=$P($G(^BTPWQ(RIEN,2,SIEN,0)),U,3)
  1. I DATE'="" D RLOG^BTPWHIST(.DTIDT,USER,DATE,"Night Jobs Identified")
  1. ;
  1. ;Now Save Status Changes
  1. D SLOG^BTPWHIST(RIEN,PIEN,DTTM,DUZ,"Status Changes")
  1. ;
  1. ;Save Remaining Information
  1. M DTIDT=BTPUPD K DTIDT(90620,PIEN_",",.07),DTIDT(90620,PIEN_",",.08)
  1. I $D(DTIDT)>0 D RLOG^BTPWHIST(.DTIDT,DUZ,DTTM,"Event Tracked")
  1. K DTIDT,USER
  1. ;End of History Saving Code
  1. ;
  1. ; Move Finding
  1. I FIND'="" D
  1. . S INTR=$$GET1^DIQ(90620.9,FIND_",",.02,"I")
  1. . D FND(PIEN)
  1. . S BTUPD(90620,PIEN_",",1.05)=DT
  1. . D FILE^DIE("","BTUPD","ERROR")
  1. ;
  1. ;File the Information
  1. D FILE^DIE("","BTPUPD","ERROR")
  1. I $D(ERROR) Q
  1. ;
  1. ;Save Status Comment to Tracked File EVENT COMMENTS field
  1. D WP^DIE(90620,PIEN_",",4,"","^BTPWQ(RIEN,3)")
  1. ;
  1. Q
  1. ;
  1. QHIS ; EP - Build queue history record
  1. NEW FDA,PSTAT,PUSR,PDTM,DIC,DA,DIE,X,IENS
  1. ;
  1. S PSTAT=$P(^BTPWQ(RIEN,0),U,8)
  1. S PUSR=$P(^BTPWQ(RIEN,0),U,12)
  1. S PDTM=$P(^BTPWQ(RIEN,0),U,11)
  1. ;
  1. S DIC(0)="L",DA(1)=RIEN,DIC="^BTPWQ("_DA(1)_",2,",DIE=DIC
  1. I $G(^BTPWQ(DA(1),2,0))="" S ^BTPWQ(DA(1),2,0)="^90629.02D^^"
  1. S X=$$NOW^XLFDT()
  1. K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
  1. ;
  1. S IENS=$$IENS^DILF(.DA)
  1. S FDA(90629.02,IENS,.02)=PSTAT
  1. S FDA(90629.02,IENS,.03)=PUSR
  1. S FDA(90629.02,IENS,.04)=PDTM
  1. ;
  1. D FILE^DIE("","FDA","ERROR")
  1. ;
  1. ;Save Status Comment to History
  1. D WP^DIE(90629.02,IENS,1,"","^BTPWQ(RIEN,3)")
  1. Q
  1. ;
  1. RHIS ; EP - Build tracked history record
  1. NEW FDA,PSTATE,PUSR,PDTM,PCREAS,DIC,DA,DIE,X,IENS
  1. ;
  1. S PSTATE=$P($G(^BTPWP(PIEN,1)),U,1)
  1. S PUSR=$P($G(^BTPWP(PIEN,1)),U,3),PUSR=$$GET1^DIQ(200,PUSR_",",.01,"E")
  1. S PDTM=$P($G(^BTPWP(PIEN,1)),U,2)
  1. S PCREAS=$P($G(^BTPWP(PIEN,1)),U,4)
  1. ;
  1. S DIC(0)="L",DA(1)=PIEN,DIC="^BTPWP("_DA(1)_",2,",DIE=DIC
  1. I $G(^BTPWP(DA(1),2,0))="" S ^BTPWP(DA(1),2,0)="^90620.02D^^"
  1. S X=$$NOW^XLFDT()
  1. K DO,DD D FILE^DICN S DA=+Y I DA=-1 Q
  1. ;
  1. S IENS=$$IENS^DILF(.DA)
  1. S FDA(90620.02,IENS,.02)=PSTATE
  1. S FDA(90620.02,IENS,.03)=PUSR
  1. S FDA(90620.02,IENS,.04)=PDTM
  1. S FDA(90620.02,IENS,.05)=PCREAS
  1. D FILE^DIE("","FDA","ERROR")
  1. ;
  1. ;Save State Comment to History
  1. D WP^DIE(90620.02,IENS,1,"","^BTPWP(PIEN,3)")
  1. Q
  1. ;
  1. REC(PRCN) ;EP - Create a new record
  1. NEW DIC,DLAYGO,X,Y
  1. S DIC="^BTPWP(",DIC(0)="LMNZ",DLAYGO=90620,DIC("P")=DLAYGO
  1. S X=PRCN
  1. K DO,DD D FILE^DICN
  1. Q +Y
  1. ;
  1. FND(CMIEN) ;EP - Add a Finding
  1. S BTPFNDTM=$$NOW^XLFDT()
  1. D FND^BTPWPWRS
  1. NEW DA,IENS
  1. S DA(1)=CMIEN,DA=EVIEN,IENS=$$IENS^DILF(.DA)
  1. S BTUPD(90620.01,IENS,.02)=FIND
  1. S BTUPD(90620.01,IENS,.03)=INTR
  1. S BTUPD(90620.01,IENS,.04)=$$NOW^XLFDT()
  1. S BTUPD(90620.01,IENS,.05)=DUZ
  1. D FILE^DIE("","BTUPD","ERROR")
  1. D WP^DIE(90620.01,IENS,1,"","^BTPWQ(RIEN,4)")
  1. Q