- BQIPLRP ;PRXM/HC/KJH-Replace Panel Functions ; 24 Jan 2006 5:38 PM
- ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- ;
- Q
- ;
- EN(DATA,OWNR,PLIEN,ASSOC,PLNM) ; EP - BQI REPLACE PANEL
- ; Description
- ; Replaces the original panel (PLIEN) with the new associated panel (ASSOC).
- ; Various data is copied from the original panel to the new panel and then
- ; the original panel is deleted. The new panel may optionally be renamed
- ; during the process. Otherwise, it will assume the name of the original.
- ; Input:
- ; OWNR - Owner of the panel
- ; PLIEN - Original panel IEN
- ; ASSOC - New associated panel IEN
- ; PLNM - New panel name (optional)
- ; Output:
- ; DATA = name of global (passed by reference) in which the data is stored
- ;
- ; RESULT = 1 if the process completed
- ; or
- ; BMXSEC - if records can't be locked or if $D(ERROR)
- ; when filing or M error encountered
- ;
- N UID,X,BQII
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPLRP",UID))
- K ^TMP("BQIPLRP",UID)
- ;
- ; Check if share and has write access
- I '$$CKSHR^BQIPLSH(OWNR,PLIEN) S BMXSEC="You do not have write access" Q
- I '$$CKSHR^BQIPLSH(OWNR,ASSOC) S BMXSEC="You do not have write access" Q
- ;
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLRP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- ; Create header record
- S BQII=0,^TMP("BQIPLRP",UID,BQII)="I00010RESULT"_$C(30)
- ;
- NEW DA,DIK,OIENS,IENS,BQIOLD,BQINEW,ERROR,TEXT,TMP
- ;
- ; Get information to be copied from 'original' panel
- S DA=PLIEN,DA(1)=OWNR,OIENS=$$IENS^DILF(.DA)
- ;D GETS^DIQ(90505.01,OIENS,".01;.02","I","BQIOLD")
- D GETS^DIQ(90505.01,OIENS,"*","I","BQIOLD")
- ;
- D SHARE ; Send shared notifications
- ;
- ; Delete 'original' panel
- S DIK="^BQICARE("_DA(1)_",1,"
- D ^DIK
- ;
- ; Update information for 'new' panel
- S DA=ASSOC,DA(1)=OWNR,IENS=$$IENS^DILF(.DA)
- NEW FLDS
- 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"))
- 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"))
- I $G(BQIOLD(90505.01,OIENS,.01,"I"))'="" S BQINEW(90505.01,IENS,.01)=$G(BQIOLD(90505.01,OIENS,.01,"I"))
- I $G(BQIOLD(90505.01,OIENS,.02,"I"))'="" S BQINEW(90505.01,IENS,.02)=$G(BQIOLD(90505.01,OIENS,.02,"I"))
- ;
- ; Change name if new name was supplied.
- ; If new name is currently in use on another panel then just leave the old name.
- I $G(PLNM)]"" D
- . N DA,PIENS,ERROR
- . S DA(1)=OWNR,DA=""
- . S PIENS=$$IENS^DILF(.DA)
- . S TMP=$$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")
- . I TMP'=0 Q ; Name currently in use
- . S BQINEW(90505.01,IENS,.01)=PLNM
- . Q
- ;
- ; Remove 'associated IEN' and 'status' information
- S BQINEW(90505.01,IENS,.13)="@"
- S BQINEW(90505.01,IENS,.15)="@"
- ;
- ; Save information to 'new' panel
- D FILE^DIE("","BQINEW","ERROR")
- I $D(ERROR) S BMXSEC="Error encountered while replacing panel." Q
- ;
- ; Update message notification
- S TEXT="Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" has been modified"
- I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T" D UPD^BQINOTF(OWNR,ASSOC,TEXT)
- ; Report success
- I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)="1"_$C(30)
- I $D(BQII),$D(DATA) S BQII=BQII+1,@DATA@(BQII)=$C(31)
- Q
- ;
- SHARE ; Compare share status from original and new panels and issue notifications
- ; PLIEN - Original panel IEN
- ; ASSOC - New associated panel IEN
- N DA,SHR,SIENS,OSTA,NSTA,TEXT
- S DA(2)=OWNR
- S SHR=0
- F S SHR=$O(^BQICARE(OWNR,1,PLIEN,30,SHR)) Q:'SHR D ; Shared node is DINUM'd
- . I '$D(^BQICARE(OWNR,1,ASSOC,30,SHR)) D Q
- .. ; Shared user was deleted
- .. I SHR=DUZ D Q
- ... S TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been removed from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)
- ... D FIL^BQINOTF(OWNR,TEXT)
- .. S TEXT="You have been deleted from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
- .. D FIL^BQINOTF(SHR,TEXT)
- . ;
- . S DA=SHR,DA(1)=PLIEN,SIENS=$$IENS^DILF(.DA)
- . S OSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
- . S DA=SHR,DA(1)=ASSOC,SIENS=$$IENS^DILF(.DA)
- . S NSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
- . I NSTA="I",NSTA'=OSTA D
- .. ; Inactive status notification
- .. I SHR=DUZ D Q
- ... 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")
- ... D FIL^BQINOTF(OWNR,TEXT)
- .. 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")
- .. D FIL^BQINOTF(SHR,TEXT)
- .. ;
- S SHR=0
- F S SHR=$O(^BQICARE(OWNR,1,ASSOC,30,SHR)) Q:'SHR D ; Shared node is DINUM'd
- . I '$D(^BQICARE(OWNR,1,PLIEN,30,SHR)) D Q
- .. ; Shared user was added
- .. 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")
- .. I $P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)'="" D
- ... NEW DTSTRT,DTEND
- ... S DTSTRT=$P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)
- ... S DTEND=$P(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,4)
- ... S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
- .. D FIL^BQINOTF(SHR,TEXT)
- Q
- ;
- ERR ;
- D ^%ZTER
- N Y,ERRDTM
- S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
- S BMXSEC="Recording that an error occurred at "_ERRDTM
- Q
- BQIPLRP ;PRXM/HC/KJH-Replace Panel Functions ; 24 Jan 2006 5:38 PM
- +1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
- +2 ;
- +3 QUIT
- +4 ;
- EN(DATA,OWNR,PLIEN,ASSOC,PLNM) ; EP - BQI REPLACE PANEL
- +1 ; Description
- +2 ; Replaces the original panel (PLIEN) with the new associated panel (ASSOC).
- +3 ; Various data is copied from the original panel to the new panel and then
- +4 ; the original panel is deleted. The new panel may optionally be renamed
- +5 ; during the process. Otherwise, it will assume the name of the original.
- +6 ; Input:
- +7 ; OWNR - Owner of the panel
- +8 ; PLIEN - Original panel IEN
- +9 ; ASSOC - New associated panel IEN
- +10 ; PLNM - New panel name (optional)
- +11 ; Output:
- +12 ; DATA = name of global (passed by reference) in which the data is stored
- +13 ;
- +14 ; RESULT = 1 if the process completed
- +15 ; or
- +16 ; BMXSEC - if records can't be locked or if $D(ERROR)
- +17 ; when filing or M error encountered
- +18 ;
- +19 NEW UID,X,BQII
- +20 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +21 SET DATA=$NAME(^TMP("BQIPLRP",UID))
- +22 KILL ^TMP("BQIPLRP",UID)
- +23 ;
- +24 ; Check if share and has write access
- +25 IF '$$CKSHR^BQIPLSH(OWNR,PLIEN)
- SET BMXSEC="You do not have write access"
- QUIT
- +26 IF '$$CKSHR^BQIPLSH(OWNR,ASSOC)
- SET BMXSEC="You do not have write access"
- QUIT
- +27 ;
- +28 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPLRP D UNWIND^%ZTER"
- +29 ;
- +30 ; Create header record
- +31 SET BQII=0
- SET ^TMP("BQIPLRP",UID,BQII)="I00010RESULT"_$CHAR(30)
- +32 ;
- +33 NEW DA,DIK,OIENS,IENS,BQIOLD,BQINEW,ERROR,TEXT,TMP
- +34 ;
- +35 ; Get information to be copied from 'original' panel
- +36 SET DA=PLIEN
- SET DA(1)=OWNR
- SET OIENS=$$IENS^DILF(.DA)
- +37 ;D GETS^DIQ(90505.01,OIENS,".01;.02","I","BQIOLD")
- +38 DO GETS^DIQ(90505.01,OIENS,"*","I","BQIOLD")
- +39 ;
- +40 ; Send shared notifications
- DO SHARE
- +41 ;
- +42 ; Delete 'original' panel
- +43 SET DIK="^BQICARE("_DA(1)_",1,"
- +44 DO ^DIK
- +45 ;
- +46 ; Update information for 'new' panel
- +47 SET DA=ASSOC
- SET DA(1)=OWNR
- SET IENS=$$IENS^DILF(.DA)
- +48 NEW FLDS
- +49 FOR FLDS=.03:.01:.12,.14,.16
- IF $$GET1^DIQ(90505.01,IENS,FLDS,"I")=""
- IF $GET(BQIOLD(90505.01,OIENS,FLDS,"I"))'=""
- SET BQINEW(90505.01,IENS,FLDS)=$GET(BQIOLD(90505.01,OIENS,FLDS,"I"))
- +50 FOR FLDS=3.3:.1:3.7
- IF $$GET1^DIQ(90505.01,IENS,FLDS,"I")=""
- IF $GET(BQIOLD(90505.01,OIENS,FLDS,"I"))'=""
- SET BQINEW(90505.01,IENS,FLDS)=$GET(BQIOLD(90505.01,OIENS,FLDS,"I"))
- +51 IF $GET(BQIOLD(90505.01,OIENS,.01,"I"))'=""
- SET BQINEW(90505.01,IENS,.01)=$GET(BQIOLD(90505.01,OIENS,.01,"I"))
- +52 IF $GET(BQIOLD(90505.01,OIENS,.02,"I"))'=""
- SET BQINEW(90505.01,IENS,.02)=$GET(BQIOLD(90505.01,OIENS,.02,"I"))
- +53 ;
- +54 ; Change name if new name was supplied.
- +55 ; If new name is currently in use on another panel then just leave the old name.
- +56 IF $GET(PLNM)]""
- Begin DoDot:1
- +57 NEW DA,PIENS,ERROR
- +58 SET DA(1)=OWNR
- SET DA=""
- +59 SET PIENS=$$IENS^DILF(.DA)
- +60 SET TMP=$$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")
- +61 ; Name currently in use
- IF TMP'=0
- QUIT
- +62 SET BQINEW(90505.01,IENS,.01)=PLNM
- +63 QUIT
- End DoDot:1
- +64 ;
- +65 ; Remove 'associated IEN' and 'status' information
- +66 SET BQINEW(90505.01,IENS,.13)="@"
- +67 SET BQINEW(90505.01,IENS,.15)="@"
- +68 ;
- +69 ; Save information to 'new' panel
- +70 DO FILE^DIE("","BQINEW","ERROR")
- +71 IF $DATA(ERROR)
- SET BMXSEC="Error encountered while replacing panel."
- QUIT
- +72 ;
- +73 ; Update message notification
- +74 SET TEXT="Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" has been modified"
- +75 IF $$GET1^DIQ(90505.01,IENS,.13,"I")'="T"
- DO UPD^BQINOTF(OWNR,ASSOC,TEXT)
- +76 ; Report success
- +77 IF $DATA(BQII)
- IF $DATA(DATA)
- SET BQII=BQII+1
- SET @DATA@(BQII)="1"_$CHAR(30)
- +78 IF $DATA(BQII)
- IF $DATA(DATA)
- SET BQII=BQII+1
- SET @DATA@(BQII)=$CHAR(31)
- +79 QUIT
- +80 ;
- SHARE ; Compare share status from original and new panels and issue notifications
- +1 ; PLIEN - Original panel IEN
- +2 ; ASSOC - New associated panel IEN
- +3 NEW DA,SHR,SIENS,OSTA,NSTA,TEXT
- +4 SET DA(2)=OWNR
- +5 SET SHR=0
- +6 ; Shared node is DINUM'd
- FOR
- SET SHR=$ORDER(^BQICARE(OWNR,1,PLIEN,30,SHR))
- IF 'SHR
- QUIT
- Begin DoDot:1
- +7 IF '$DATA(^BQICARE(OWNR,1,ASSOC,30,SHR))
- Begin DoDot:2
- +8 ; Shared user was deleted
- +9 IF SHR=DUZ
- Begin DoDot:3
- +10 SET TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been removed from sharing panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)
- +11 DO FIL^BQINOTF(OWNR,TEXT)
- End DoDot:3
- QUIT
- +12 SET TEXT="You have been deleted from sharing panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
- +13 DO FIL^BQINOTF(SHR,TEXT)
- End DoDot:2
- QUIT
- +14 ;
- +15 SET DA=SHR
- SET DA(1)=PLIEN
- SET SIENS=$$IENS^DILF(.DA)
- +16 SET OSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
- +17 SET DA=SHR
- SET DA(1)=ASSOC
- SET SIENS=$$IENS^DILF(.DA)
- +18 SET NSTA=$$GET1^DIQ(90505.03,SIENS,.02,"I")
- +19 IF NSTA="I"
- IF NSTA'=OSTA
- Begin DoDot:2
- +20 ; Inactive status notification
- +21 IF SHR=DUZ
- Begin DoDot:3
- +22 SET TEXT=$$GET1^DIQ(200,SHR_",",.01,"E")_" has been inactivated as a share for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
- +23 DO FIL^BQINOTF(OWNR,TEXT)
- End DoDot:3
- QUIT
- +24 SET TEXT="You have been inactivated as a share for panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
- +25 DO FIL^BQINOTF(SHR,TEXT)
- +26 ;
- End DoDot:2
- End DoDot:1
- +27 SET SHR=0
- +28 ; Shared node is DINUM'd
- FOR
- SET SHR=$ORDER(^BQICARE(OWNR,1,ASSOC,30,SHR))
- IF 'SHR
- QUIT
- Begin DoDot:1
- +29 IF '$DATA(^BQICARE(OWNR,1,PLIEN,30,SHR))
- Begin DoDot:2
- +30 ; Shared user was added
- +31 SET TEXT="You have been added as a shared user for Panel "_$PIECE(^BQICARE(OWNR,1,PLIEN,0),U,1)_" by "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
- +32 IF $PIECE(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)'=""
- Begin DoDot:3
- +33 NEW DTSTRT,DTEND
- +34 SET DTSTRT=$PIECE(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,3)
- +35 SET DTEND=$PIECE(^BQICARE(OWNR,1,ASSOC,30,SHR,0),U,4)
- +36 SET TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
- End DoDot:3
- +37 DO FIL^BQINOTF(SHR,TEXT)
- End DoDot:2
- QUIT
- End DoDot:1
- +38 QUIT
- +39 ;
- 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 QUIT