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

BQIPLCP.m

Go to the documentation of this file.
  1. BQIPLCP ;PRXM/HC/KJH-Copy Panel Functions ; 2 Feb 2006 4:05 PM
  1. ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
  1. ;
  1. Q
  1. ;
  1. EN(DATA,OWNR,OPLIEN,NPLNM,LYOUT) ; EP - BQI COPY PANEL
  1. ; Description
  1. ; Creates a copy of the original panel specified by OWNR and PLIEN
  1. ; under the current user (DUZ). All data is copied, except that the
  1. ; new panel name will be "Copy of "_OldPanelName if this is the first
  1. ; copy or "Copy (n) of "_OldPanelName if this is a subsequent copy.
  1. ;
  1. ; All data is copied from the original panel except the panel creation
  1. ; date/time (which is set to NOW). If the panel OWNR and the DUZ are
  1. ; different then the shared access information will also not be copied.
  1. ; Input:
  1. ; OWNR - Owner of the panel
  1. ; OPLIEN - Original panel IEN
  1. ; NPLNM - New panel name
  1. ; LYOUT - Flag to indicate whether to copy the layouts as well
  1. ; Output:
  1. ; DATA = name of global (passed by reference) in which the data is stored
  1. ;
  1. ; PLIEN - panel IEN (for the new panel)
  1. ; PLID - panel ID (DUZ of new owner and panel ien)
  1. ; PLNM - panel name (new panel name)
  1. ; or
  1. ; BMXSEC - if record can't be locked or if $D(ERROR)
  1. ; when filing or M error encountered
  1. ;
  1. NEW UID,X,BQII
  1. S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1. S DATA=$NA(^TMP("BQIPLCP",UID))
  1. K ^TMP("BQIPLCP",UID)
  1. S LYOUT=$S($G(LYOUT)="Y":1,1:0)
  1. ;
  1. NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLCP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1. ;
  1. ; Create owner (DUZ) if new to iCare - If unable to do so - error
  1. I '$$OWNR^BQIPLUSR(DUZ) S BMXSEC="Unable to create panel" Q
  1. ;
  1. ; Create header record
  1. S BQII=0,^TMP("BQIPLCP",UID,BQII)="I00010PANEL_IEN^T00020PANEL_ID^T00120PANEL_NAME"_$C(30)
  1. ;
  1. N DA,DIK,OIENS,IENS,BQINEW,ERROR,OPLNM,SRCTYP
  1. ;
  1. ; Get panel name from 'original' panel
  1. S DA=OPLIEN,DA(1)=OWNR,OIENS=$$IENS^DILF(.DA)
  1. S OPLNM=$$GET1^DIQ(90505.01,OIENS,".01","I")
  1. ;
  1. ; Create a new panel and name
  1. D FILE I $G(BMXSEC)]"" Q
  1. ;
  1. ; Copy PANEL DEFINITION (0 node)
  1. M ^BQICARE(DUZ,1,PLIEN,0)=^BQICARE(OWNR,1,OPLIEN,0)
  1. ;
  1. ; Copy IPC field/Category
  1. S $P(^BQICARE(DUZ,1,PLIEN,2),U)=$P($G(^BQICARE(OWNR,1,OPLIEN,2)),U)
  1. S:DUZ=OWNR $P(^BQICARE(DUZ,1,PLIEN,2),U,2)=$P($G(^BQICARE(OWNR,1,OPLIEN,2)),U,2)
  1. S:DUZ'=OWNR $P(^BQICARE(DUZ,1,PLIEN,2),U,2)=$P($G(^BQICARE(OWNR,1,OPLIEN,30,DUZ,0)),U,6)
  1. ;
  1. ; Update panel name, creation date/time, last updated by
  1. ; and updated date/time for 'new' panel
  1. S DA(1)=DUZ,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1. S BQINEW(90505.01,IENS,.01)=PLNM
  1. I $$GET1^DIQ(90505.01,IENS,.02,"I")="" S BQINEW(90505.01,IENS,.02)=$$NOW^XLFDT()
  1. S BQINEW(90505.01,IENS,.04)=DUZ
  1. S BQINEW(90505.01,IENS,.05)=$$NOW^XLFDT()
  1. D FILE^DIE("","BQINEW","ERROR")
  1. ;
  1. ; If an error occurred, remove the half-filed panel and return BMXSEC.
  1. I $D(ERROR) D Q
  1. . S DIK="^BQICARE("_DA(1)_",1,"
  1. . D ^DIK
  1. . S BMXSEC="Error encountered while copying panel definition."
  1. . Q
  1. ;
  1. ; Copy data
  1. D CPY(OWNR,OPLIEN,PLIEN)
  1. ;
  1. ; Check type of panel if moving a share
  1. I OWNR'=DUZ D
  1. . NEW DA,IENS
  1. . S DA(1)=DUZ,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1. . S SRCTYP=$$GET1^DIQ(90505.01,IENS,.03,"I")
  1. . I SRCTYP'="Y" Q
  1. . S BQIUPD(90505.01,IENS,.03)="M"
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . K BQIUPD
  1. . K DESC
  1. . D DESC^BQIPDSCM(DUZ,PLIEN,.DESC)
  1. . D WP^DIE(90505.01,IENS,5,"","DESC")
  1. . K DESC
  1. . NEW DFN
  1. . S DFN=0
  1. . F S DFN=$O(^BQICARE(DUZ,1,PLIEN,40,DFN)) Q:'DFN D
  1. .. I $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)'="" Q
  1. .. S $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)="A"
  1. .. S $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,4)=$$NOW^XLFDT()
  1. ;
  1. ; if user selected to copy the layout
  1. I LYOUT D LAY(OWNR,OPLIEN,PLIEN)
  1. ;
  1. ; Return panel IEN, ID, and NAME on success
  1. S PLID=$$PLID^BQIUG1(DUZ,PLIEN)
  1. S BQII=BQII+1,^TMP("BQIPLCP",UID,BQII)=PLIEN_"^"_PLID_"^"_PLNM_$C(30)
  1. S BQII=BQII+1,^TMP("BQIPLCP",UID,BQII)=$C(31)
  1. K PLID,PLNM
  1. Q
  1. ;
  1. FILE ; Create name and file new panel under current DUZ
  1. L +^BQICARE(DUZ,1,0):5
  1. ; NOTE: It is possible that the lock should be extended around the whole copy procedure.
  1. ; Potential problem is that the panel could become available to a shared user during
  1. ; the IX^DIK process but before the panel x-ref completes. This is a very small
  1. ; period of time, but should still be tested.
  1. I '$T S BMXSEC="Unable to create panel" Q ; Error - unable to assign next panel IEN
  1. D
  1. . ; First try to create a new name for the panel using "Copy of "_OldName.
  1. . N DA,PIENS,ERROR,II
  1. . S PLNM=$S($G(NPLNM)'="":NPLNM,1:"Copy of "_OPLNM)
  1. . S DA(1)=DUZ,DA=""
  1. . S PIENS=$$IENS^DILF(.DA)
  1. . I $$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")=0 Q ; New panel name not currently in use.
  1. . ; Otherwise create a new name for the panel using "Copy (n) of "_OldName.
  1. . F II=1:1 D I PLNM]"" Q
  1. .. N DA,PIENS,ERROR
  1. .. S PLNM="Copy ("_II_") of "_OPLNM
  1. .. S DA(1)=DUZ,DA=""
  1. .. S PIENS=$$IENS^DILF(.DA)
  1. .. I $$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")=0 Q ; New panel name not currently in use.
  1. .. S PLNM="" ; Clear panel name if currently in use
  1. . Q
  1. ; File new panel
  1. N DA,X,DINUM,DIC,DIE,DLAYGO
  1. S DA(1)=DUZ,X=PLNM,DLAYGO=90505.01
  1. S DIC="^BQICARE("_DA(1)_",1,",DIE=DIC
  1. S DIC(0)="L",DIC("P")=DLAYGO
  1. K DO,DD D FILE^DICN
  1. S (DA,PLIEN)=+Y
  1. I PLIEN=-1 S BMXSEC="Error encountered while filing panel."
  1. L -^BQICARE(DUZ,1,0)
  1. Q
  1. ;
  1. ERR ;
  1. L -^BQICARE(DUZ,1,0)
  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
  1. ;
  1. CPY(OWNR,OPLIEN,PLIEN) ;EP -- Copy data from one panel to another
  1. ; Input
  1. ; OWNR - Owner of panel
  1. ; OPLIEN - Original panel IEN
  1. ; PLIEN - New panel IEN
  1. ;
  1. ; Copy PANEL DEFINITION (remaining nodes)
  1. ;
  1. I $D(^BQICARE(OWNR,1,OPLIEN,3)) M ^BQICARE(DUZ,1,PLIEN,3)=^BQICARE(OWNR,1,OPLIEN,3)
  1. I $D(^BQICARE(OWNR,1,OPLIEN,5)) M ^BQICARE(DUZ,1,PLIEN,5)=^BQICARE(OWNR,1,OPLIEN,5)
  1. ;
  1. ; Copy PARAMETER DEFINITION
  1. I $D(^BQICARE(OWNR,1,OPLIEN,10)) M ^BQICARE(DUZ,1,PLIEN,10)=^BQICARE(OWNR,1,OPLIEN,10)
  1. ;
  1. ; Copy FILTER DEFINITION
  1. I $D(^BQICARE(OWNR,1,OPLIEN,15)) M ^BQICARE(DUZ,1,PLIEN,15)=^BQICARE(OWNR,1,OPLIEN,15)
  1. ;
  1. ; Copy PATIENT LIST
  1. I $D(^BQICARE(OWNR,1,OPLIEN,40)) M ^BQICARE(DUZ,1,PLIEN,40)=^BQICARE(OWNR,1,OPLIEN,40)
  1. ;
  1. ; Update cross references for merged entries
  1. S DIK="^BQICARE("_DA(1)_",1,"
  1. D IX^DIK
  1. Q
  1. ;
  1. LAY(OWNR,OPLIEN,PLIEN) ;EP - Copy the layouts
  1. NEW LYI,TMPLNM,DIK,DA,TMIEN,TMTYP
  1. ;
  1. ; if the user is the owner
  1. ;
  1. I OWNR=DUZ D
  1. . M ^BQICARE(DUZ,1,PLIEN,4)=^BQICARE(OWNR,1,OPLIEN,4) ;Template References
  1. . M ^BQICARE(DUZ,1,PLIEN,20)=^BQICARE(OWNR,1,OPLIEN,20) ;Patient Layout
  1. . M ^BQICARE(DUZ,1,PLIEN,22)=^BQICARE(OWNR,1,OPLIEN,22) ;Reminders
  1. . M ^BQICARE(DUZ,1,PLIEN,25)=^BQICARE(OWNR,1,OPLIEN,25) ;Nat'l Meas
  1. . M ^BQICARE(DUZ,1,PLIEN,23)=^BQICARE(OWNR,1,OPLIEN,23) ;Care Mgmt Layouts (Asthma and HIV/AIDS)
  1. ;
  1. ; if the user is not the owner, create customized
  1. I OWNR'=DUZ D
  1. . M ^BQICARE(DUZ,1,PLIEN,4)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,4)
  1. . S $P(^BQICARE(DUZ,1,PLIEN,4,0),U,2)="90505.14"
  1. . M ^BQICARE(DUZ,1,PLIEN,20)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,20)
  1. . S $P(^BQICARE(DUZ,1,PLIEN,20,0),U,2)="90505.05P"
  1. . M ^BQICARE(DUZ,1,PLIEN,22)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,22)
  1. . S $P(^BQICARE(DUZ,1,PLIEN,22,0),U,2)="90505.122"
  1. . M ^BQICARE(DUZ,1,PLIEN,23)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,23)
  1. . S $P(^BQICARE(DUZ,1,PLIEN,23,0),U,2)="90505.123"
  1. . N I S I=0 F S I=$O(^BQICARE(DUZ,1,PLIEN,23,I)) Q:'I S $P(^BQICARE(DUZ,1,PLIEN,23,I,1,0),U,2)="90505.1231"
  1. . M ^BQICARE(DUZ,1,PLIEN,25)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,25)
  1. . S $P(^BQICARE(DUZ,1,PLIEN,25,0),U,2)="90505.125"
  1. ;
  1. ; Update cross references for merged entries
  1. S DIK="^BQICARE(",DA=DUZ
  1. D IX^DIK
  1. Q