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

BQIPLRP.m

Go to the documentation of this file.
  1. BQIPLRP ;PRXM/HC/KJH-Replace Panel Functions ; 24 Jan 2006 5:38 PM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. ;
  1. Q
  1. ;
  1. EN(DATA,OWNR,PLIEN,ASSOC,PLNM) ; EP - BQI REPLACE PANEL
  1. ; Description
  1. ; Replaces the original panel (PLIEN) with the new associated panel (ASSOC).
  1. ; Various data is copied from the original panel to the new panel and then
  1. ; the original panel is deleted. The new panel may optionally be renamed
  1. ; during the process. Otherwise, it will assume the name of the original.
  1. ; Input:
  1. ; OWNR - Owner of the panel
  1. ; PLIEN - Original panel IEN
  1. ; ASSOC - New associated panel IEN
  1. ; PLNM - New panel name (optional)
  1. ; Output:
  1. ; DATA = name of global (passed by reference) in which the data is stored
  1. ;
  1. ; RESULT = 1 if the process completed
  1. ; or
  1. ; BMXSEC - if records can't be locked or if $D(ERROR)
  1. ; when filing or M error encountered
  1. ;
  1. N UID,X,BQII
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPLRP",UID))
  1. K ^TMP("BQIPLRP",UID)
  1. ;
  1. ; Check if share and has write access
  1. I '$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
  1. I '$$CKSHR^BQIPLSH(OWNR,ASSOC) S BMXSEC="You do not have write access" Q
  1. ;
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. ; Create header record
  1. S BQII=0,^TMP("BQIPLRP",UID,BQII)="I00010RESULT"_$C(30)
  1. ;
  1. NEW DA,DIK,OIENS,IENS,BQIOLD,BQINEW,ERROR,TEXT,TMP
  1. ;
  1. ; Get information to be copied from 'original' panel
  1. S DA=PLIEN,DA(1)=OWNR,OIENS=$$IENS^DILF(.DA)
  1. ;D GETS^DIQ(90505.01,OIENS,".01;.02","I","BQIOLD")
  1. D GETS^DIQ(90505.01,OIENS,"*","I","BQIOLD")
  1. ;
  1. D SHARE ; Send shared notifications
  1. ;
  1. ; Delete 'original' panel
  1. S DIK="^BQICARE("_DA(1)_",1,"
  1. D ^DIK
  1. ;
  1. ; Update information for 'new' panel
  1. S DA=ASSOC,DA(1)=OWNR,IENS=$$IENS^DILF(.DA)
  1. NEW FLDS
  1. F FLDS=.03:.01:.12,.14,.16 I $$GET1^DIQ(90505.01,IENS,FLDS,"I")="",$G(BQIOLD(90505.01,OIENS,FLDS,"I"))'="" S BQINEW(90505.01,IENS,FLDS)=$G(BQIOLD(90505.01,OIENS,FLDS,"I"))
  1. F FLDS=3.3:.1:3.7 I $$GET1^DIQ(90505.01,IENS,FLDS,"I")="",$G(BQIOLD(90505.01,OIENS,FLDS,"I"))'="" S BQINEW(90505.01,IENS,FLDS)=$G(BQIOLD(90505.01,OIENS,FLDS,"I"))
  1. I $G(BQIOLD(90505.01,OIENS,.01,"I"))'="" S BQINEW(90505.01,IENS,.01)=$G(BQIOLD(90505.01,OIENS,.01,"I"))
  1. I $G(BQIOLD(90505.01,OIENS,.02,"I"))'="" S BQINEW(90505.01,IENS,.02)=$G(BQIOLD(90505.01,OIENS,.02,"I"))
  1. ;
  1. ; Change name if new name was supplied.
  1. ; If new name is currently in use on another panel then just leave the old name.
  1. I $G(PLNM)]"" D
  1. . N DA,PIENS,ERROR
  1. . S DA(1)=OWNR,DA=""
  1. . S PIENS=$$IENS^DILF(.DA)
  1. . S TMP=$$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")
  1. . I TMP'=0 Q ; Name currently in use
  1. . S BQINEW(90505.01,IENS,.01)=PLNM
  1. . Q
  1. ;
  1. ; Remove 'associated IEN' and 'status' information
  1. S BQINEW(90505.01,IENS,.13)="@"
  1. S BQINEW(90505.01,IENS,.15)="@"
  1. ;
  1. ; Save information to 'new' panel
  1. D FILE^DIE("","BQINEW","ERROR")
  1. I $D(ERROR) S BMXSEC="Error encountered while replacing panel." Q
  1. ;
  1. ; Update message notification
  1. S TEXT="Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" has been modified"
  1. I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T" D UPD^BQINOTF(OWNR,ASSOC,TEXT)
  1. ; Report success
  1. I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)="1"_$C(30)
  1. I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
  1. Q
  1. ;
  1. SHARE ; Compare share status from original and new panels and issue notifications
  1. ; PLIEN - Original panel IEN
  1. ; ASSOC - New associated panel IEN
  1. N DA,SHR,SIENS,OSTA,NSTA,TEXT
  1. S DA(2)=OWNR
  1. S SHR=0
  1. F S SHR=$O(^BQICARE(OWNR,1,PLIEN,30,SHR)) Q:'SHR D ; Shared node is DINUM'd
  1. . I '$D(^BQICARE(OWNR,1,ASSOC,30,SHR)) D Q
  1. .. ; Shared user was deleted
  1. .. I SHR=DUZ D Q
  1. ... S TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been removed from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)
  1. ... D FIL^BQINOTF(OWNR,TEXT)
  1. .. S TEXT="You have been deleted from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1. .. D FIL^BQINOTF(SHR,TEXT)
  1. . ;
  1. . S DA=SHR,DA(1)=PLIEN,SIENS=$$IENS^DILF(.DA)
  1. . S OSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
  1. . S DA=SHR,DA(1)=ASSOC,SIENS=$$IENS^DILF(.DA)
  1. . S NSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
  1. . I NSTA="I",NSTA'=OSTA D
  1. .. ; Inactive status notification
  1. .. I SHR=DUZ D Q
  1. ... S TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been inactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1. ... D FIL^BQINOTF(OWNR,TEXT)
  1. .. S TEXT="You have been inactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1. .. D FIL^BQINOTF(SHR,TEXT)
  1. .. ;
  1. S SHR=0
  1. F S SHR=$O(^BQICARE(OWNR,1,ASSOC,30,SHR)) Q:'SHR D ; Shared node is DINUM'd
  1. . I '$D(^BQICARE(OWNR,1,PLIEN,30,SHR)) D Q
  1. .. ; Shared user was added
  1. .. S TEXT="You have been added as a shared user for Panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" by "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1. .. I $P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)'="" D
  1. ... NEW DTSTRT,DTEND
  1. ... S DTSTRT=$P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)
  1. ... S DTEND=$P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,4)
  1. ... S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
  1. .. D FIL^BQINOTF(SHR,TEXT)
  1. Q
  1. ;
  1. ERR ;
  1. D ^%ZTER
  1. N Y,ERRDTM
  1. S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1. S BMXSEC="Recording that an error occurred at "_ERRDTM
  1. Q