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

BQIPLSH.m

Go to the documentation of this file. 
  1. BQIPLSH ;PRXM/HC/ALA - Panel Sharing Update ; 07 Nov 2005  3:53 PM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;**3**;Apr 01, 2015;Build 5
  1.  ;
  1.  Q
  1.  ;
  1. EN(DATA,OWNR,PLIEN,WHO,ACTION,ACCESS,DTSTRT,DTEND,LTYPE,OVRRD) ; EP -- BQI UPDATE SHARE LIST BY PANEL
  1.  ;Description
  1.  ;  Add/Update/Remove a panel share, given the owner ien, panel ien, WHO ien, share action flag, and access.
  1.  ;
  1.  ;Input
  1.  ;  OWNR  - Owner of the panel
  1.  ;  PLIEN - Panel internal entry number
  1.  ;  WHO   - internal entry number of who is being added as
  1.  ;          a share person
  1.  ;  ACTION - Action flag 'U' for update, 'D' for delete, 'A' for add
  1.  ;  ACCESS - Access flag 'R' for read only, 'RW' for read/write
  1.  ;           and 'I' for inactive
  1.  ;  DTSTRT - Start share date
  1.  ;  DTEND  - End share date
  1.  ;  LTYPE  - Layout Type (Y-Share All,N-No Sharing,A-Asthma,D-Patient,H-HIV/AIDS,R-Reminder,G-Nat'l Measures)
  1.  ;                       (Q-Queued,T-Tracked,P-Planned)
  1.  ;  OVRRD  - Override Flag (1-Override Shared User Layout, 0/Null-Do not Override)
  1.  ;  
  1.  ;Output
  1.  ;  RESULT - 1 for Success, 0 for Failure, <0 for Error.
  1.  ;  
  1.  NEW UID,II,DFN,X,RESULT,OACTION,NDA
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQISHARE",UID))
  1.  K @DATA
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLSH D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  ;
  1.  S @DATA@(II)="I00010RESULT"_$C(30)
  1.  ;
  1.  S DTSTRT=$$DATE^BQIUL1($G(DTSTRT))
  1.  S DTEND=$$DATE^BQIUL1($G(DTEND))
  1.  S LTYPE=$G(LTYPE,"") S:LTYPE="" LTYPE="N"
  1.  S OVRRD=$G(OVRRD,"")
  1.  ;
  1.  ; Branch off to specific tag, depending on action.
  1.  S OACTION=ACTION ; Save original action - add is reset to update
  1.  I ACTION="A" S RESULT=$$ASHR() I RESULT>0 S ACTION="U"
  1.  I ACTION="D"!(ACTION="U") S RESULT=$$USHR()
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  ;
  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.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ASHR() ;EP - Add a person to share a panel
  1.  ;
  1.  ;Description
  1.  ;  Adds a person to a panel owned by someone else
  1.  ; 
  1.  ;Output
  1.  ;  Y - if -1, then it wasn't successful, otherwise it should
  1.  ;      be the same as the WHO since the field is DINUM'd
  1.  ;
  1.  NEW DA,X,DINUM,DIC,DIE,DLAYGO,ERROR,Y
  1.  S DA(2)=OWNR,DA(1)=PLIEN,(X,DINUM)=WHO
  1.  S DIC="^BQICARE("_DA(2)_",1,"_DA(1)_",30,",DIE=DIC
  1.  S DLAYGO=90505.03,DIC(0)="LN",DIC("P")=DLAYGO
  1.  I '$D(^BQICARE(DA(2),1,DA(1),30,0)) S ^BQICARE(DA(2),1,DA(1),30,0)="^90505.03P^^"
  1.  K DO,DD D FILE^DICN S NDA=+Y
  1.  I NDA<1 Q NDA
  1.  ;
  1.  ; Update flags when sharing
  1.  NEW DFN
  1.  S DFN=0
  1.  F  S DFN=$O(^BQICARE(OWNR,1,PLIEN,40,DFN)) Q:'DFN  D
  1.  . D UPU^BQIFLAG(DFN,WHO)
  1.  ;
  1.  ; Layout Sharing
  1.  I LTYPE]"" D  I $D(ERROR) Q -1
  1.  . ;Update SHARE LAYOUTS field
  1.  . N DA,IENS,BQISHARE
  1.  . S DA(2)=OWNR,DA(1)=PLIEN,DA=WHO
  1.  . S IENS=$$IENS^DILF(.DA)
  1.  . S BQISHARE(90505.03,IENS,.05)=$S(LTYPE="N":0,1:1)
  1.  . D FILE^DIE("","BQISHARE","ERROR")
  1.  . ;
  1.  . ;Copy Layouts
  1.  . I LTYPE="N" Q
  1.  . D CPLAY
  1.  ;
  1.  ; Send notification
  1.  NEW TEXT,DA,IENS
  1.  S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  S TEXT="You have been added as a shared user for Panel "_$$GET1^DIQ(90505.01,IENS,.01,"E")_" by "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1.  I $G(DTSTRT)'="" S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)
  1.  ;
  1.  I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
  1.  Q NDA
  1.  ;
  1. USHR() ;EP - Update a share record
  1.  ;
  1.  ;Description
  1.  ;  Update a share record with data
  1.  ;
  1.  NEW DA,SIENS,BQISHRUP,ERROR,TEXT,IENS
  1.  S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1.  S DA(2)=OWNR,DA(1)=PLIEN,DA=WHO
  1.  S SIENS=$$IENS^DILF(.DA)
  1.  I ACTION="D" D
  1.  . S BQISHRUP(90505.03,SIENS,.01)="@"
  1.  . I WHO=DUZ D  Q
  1.  .. S TEXT=$$GET1^DIQ(200,DUZ_",",.01,"E")_" has been removed from sharing panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)
  1.  .. I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" 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.  . I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
  1.  ;
  1.  I ACTION="U" D
  1.  . I $G(ACCESS)="I",$$GET1^DIQ(90505.03,SIENS,.02,"I")'="I" D
  1.  .. I WHO=DUZ D  Q
  1.  ... S TEXT=$$GET1^DIQ(200,WHO_",",.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.  ... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" 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.  .. I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
  1.  . I $G(ACCESS)'="I" D
  1.  .. N ODTST,ODTEND
  1.  .. S ODTST=$$GET1^DIQ(90505.03,SIENS,.03,"I")
  1.  .. S ODTEND=$$GET1^DIQ(90505.03,SIENS,.04,"I")
  1.  .. ; Date notifications should only be issued for an update
  1.  .. I OACTION="U",ODTST'=$G(DTSTRT)!(ODTEND'=$G(DTEND)) D
  1.  ... I ODTEND,ODTEND<$G(DTSTRT) D  Q  ; reinstated share
  1.  .... I WHO=DUZ D  Q
  1.  ..... S TEXT=$$GET1^DIQ(200,WHO_",",.01,"E")_" has been reactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1.  ..... I $G(DTSTRT)'="" S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
  1.  ..... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(OWNR,TEXT)
  1.  .... S TEXT="You have been reactivated as a share for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1.  .... S TEXT=TEXT_" temporarily from "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
  1.  .... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
  1.  ... I WHO=DUZ D  Q
  1.  .... S TEXT=$$GET1^DIQ(200,WHO_",",.01,"E")_"'s share dates have been changed for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1.  .... I $G(DTSTRT)'="" S TEXT=TEXT_".  The new dates are "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
  1.  .... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(OWNR,TEXT)
  1.  ... S TEXT="Your share dates have been changed for panel "_$P(^BQICARE(OWNR,1,PLIEN,0),U,1)_" for "_$$GET1^DIQ(90505,OWNR_",",.01,"E")
  1.  ... S TEXT=TEXT_".  The new dates are "_$$FMTE^BQIUL1(DTSTRT)_" thru "_$$FMTE^BQIUL1(DTEND)_"."
  1.  ... I $$GET1^DIQ(90505.01,IENS,.13,"I")'="T",$$GET1^DIQ(90505.01,IENS,.15,"I")="" D FIL^BQINOTF(WHO,TEXT)
  1.  . S BQISHRUP(90505.03,SIENS,.02)=$G(ACCESS)
  1.  . S BQISHRUP(90505.03,SIENS,.03)=$G(DTSTRT)
  1.  . S BQISHRUP(90505.03,SIENS,.04)=$G(DTEND)
  1.  D FILE^DIE("","BQISHRUP","ERROR")
  1.  I $D(ERROR) Q 0
  1.  Q 1
  1.  ;
  1. CKSHR(OWNR,PLIEN) ;EP -- Check the write rights of a shared person
  1.  ;
  1.  ;Description
  1.  ;  This function checks the write status of a shared user
  1.  ;Input
  1.  ;  OWNR  - Owner of the panel
  1.  ;  PLIEN - Panel internal entry number
  1.  ;Output
  1.  ;  1 - if okay to write to the panel
  1.  ;  0 - if not okay to write to the panel
  1.  ;
  1.  NEW DA,IENS,ACCESS
  1.  I DUZ=OWNR Q 1
  1.  S DA(2)=OWNR,DA(1)=PLIEN,DA=DUZ
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S ACCESS=$$GET1^DIQ(90505.03,IENS,.02,"I")
  1.  I ACCESS="RW" Q 1
  1.  Q 0
  1.  ;
  1. CPLAY ;EP -- Copy Owner Layout to Shared User
  1.  ;
  1.  ;Description
  1.  ;  This function copies the layouts from the panel owner to the selected shared user
  1.  ;
  1.  ;N BQIUPD,ERROR,LAYDD,LAYFLD,OLAY,RESULT,SLAYDD,TMPIEN
  1.  ;
  1.  ;Set up dictionary/field values
  1.  ; Templates
  1.  NEW TMPIEN,VWN
  1.  S TMPIEN=0
  1.  I $G(^BQICARE(OWNR,1,PLIEN,4,TMPIEN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN))="" D
  1.  . S ^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN)=^BQICARE(OWNR,1,PLIEN,4,TMPIEN)
  1.  . F  S TMPIEN=$O(^BQICARE(OWNR,1,PLIEN,4,TMPIEN)) Q:'TMPIEN  D
  1.  .. S TMPNM=$P($G(^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)),U) Q:TMPNM=""
  1.  .. I TMPNM'[" Default" Q
  1.  .. S ^BQICARE(OWNR,1,PLIEN,30,NDA,4,TMPIEN,0)=^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)
  1.  ; Patient
  1.  S VWN=0
  1.  I $G(^BQICARE(OWNR,1,PLIEN,20,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN))="" D
  1.  . S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN)=^BQICARE(OWNR,1,PLIEN,20,VWN)
  1.  . F  S VWN=$O(^BQICARE(OWNR,1,PLIEN,20,VWN)) Q:'VWN  D
  1.  .. S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,VWN,0)=^BQICARE(OWNR,1,PLIEN,20,VWN,0)
  1.  ; Reminder
  1.  S VWN=0
  1.  I $G(^BQICARE(OWNR,1,PLIEN,22,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN))="" D
  1.  . S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN)=^BQICARE(OWNR,1,PLIEN,22,VWN)
  1.  . F  S VWN=$O(^BQICARE(OWNR,1,PLIEN,22,VWN)) Q:'VWN  D
  1.  .. S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,VWN,0)=^BQICARE(OWNR,1,PLIEN,22,VWN,0)
  1.  ; Natl Measures
  1.  S VWN=0
  1.  I $G(^BQICARE(OWNR,1,PLIEN,25,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN))="" D
  1.  . S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN)=^BQICARE(OWNR,1,PLIEN,25,VWN)
  1.  . F  S VWN=$O(^BQICARE(OWNR,1,PLIEN,25,VWN)) Q:'VWN  D
  1.  .. S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,VWN,0)=^BQICARE(OWNR,1,PLIEN,25,VWN,0)
  1.  ; Care Management
  1.  S VWN=0
  1.  I $G(^BQICARE(OWNR,1,PLIEN,23,VWN))'="",$G(^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN))="" D
  1.  . S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN)=^BQICARE(OWNR,1,PLIEN,23,VWN)
  1.  . F  S VWN=$O(^BQICARE(OWNR,1,PLIEN,23,VWN)) Q:'VWN  D
  1.  .. S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,0)=^BQICARE(OWNR,1,PLIEN,23,VWN,0)
  1.  .. S CVN=0
  1.  .. S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,1,CVN)=^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN)
  1.  .. F  S CVN=$O(^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN)) Q:'CVN  D
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,VWN,1,CVN,0)=^BQICARE(OWNR,1,PLIEN,23,VWN,1,CVN,0)
  1.  ;
  1.  NEW DA,DIK
  1.  S DA=NDA,DA(1)=PLIEN,DA(2)=OWNR,DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",30,"
  1.  D IX1^DIK
  1.  ;
  1.  ;Non-default templates turn into customized
  1.  NEW TMPIEN,TMPNM,TN,TYP,CN,CMN,FILE,CVN
  1.  S TMPIEN=0
  1.  F  S TMPIEN=$O(^BQICARE(OWNR,1,PLIEN,4,TMPIEN)) Q:'TMPIEN  D
  1.  . S TMPNM=$P($G(^BQICARE(OWNR,1,PLIEN,4,TMPIEN,0)),"^",1) Q:TMPNM=""
  1.  . I TMPNM[" Default" Q
  1.  . S TN=$O(^BQICARE(OWNR,15,"B",TMPNM,"")) I TN="" Q
  1.  . S TYP=$P(^BQICARE(OWNR,15,TN,0),"^",2)
  1.  . S CN=$O(^BQI(90506.5,"C",TYP,"")) I CN="" Q
  1.  . S CMN=$P(^BQI(90506.5,CN,0),"^",1)
  1.  . S FILE=$P($G(^BQI(90506.5,CN,2)),"^",5) I FILE="" Q
  1.  . I FILE=90505.3231 D
  1.  .. S CNM=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,23,"B",CMN,""))
  1.  .. I CNM'="" S CVN=CNM I $O(^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,0))'="" Q
  1.  .. I CNM="" S CVN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,23,"B"),-1),CVN=CVN+1
  1.  .. ;copy over the template into customized
  1.  .. I $G(^BQICARE(OWNR,1,PLIEN,30,NDA,23,0))="" S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,0)="^90505.123^"_CVN_"^"_CVN
  1.  .. S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,0)=CMN
  1.  .. S N=0 F  S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N  D
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,23,CVN,1,0)="^90505.1231^"_N_"^"_N
  1.  . I FILE=90505.322 D
  1.  .. S CMN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,22,0)) I CMN'="" Q
  1.  .. S N=0 F  S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N  D
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,22,0)="90505.322^"_N_"^"_N
  1.  . I FILE=90505.06 D
  1.  .. S CMN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,20,0)) I CMN'="" Q
  1.  .. S N=0 F  S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N  D
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,20,0)="90505.06^"_N_"^"_N
  1.  . I FILE=90505.325 D
  1.  .. S CMN=$O(^BQICARE(OWNR,1,PLIEN,30,NDA,25,0)) I CMN'="" Q
  1.  .. S N=0 F  S N=$O(^BQICARE(OWNR,15,TN,1,N)) Q:'N  D
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,N,0)=^BQICARE(OWNR,15,TN,1,N,0)
  1.  ... S ^BQICARE(OWNR,1,PLIEN,30,NDA,25,0)="^90505.125^"_N_"^"_N
  1.  ;
  1.  ; Cross-reference
  1.  NEW DA,DIK
  1.  S DA=NDA,DA(1)=PLIEN,DA(2)=OWNR,DIK="^BQICARE("_DA(2)_",1,"_DA(1)_",30,"
  1.  D IX1^DIK
  1.  ;Check Override field
  1.  S:$G(OVRRD)'=1 OVRRD=0
  1.  ;
  1.  ;Initialize Result Variable
  1.  S RESULT=1
  1.  Q