- BQIPLCP ;PRXM/HC/KJH-Copy Panel Functions ; 2 Feb 2006 4:05 PM
- ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
- ;
- Q
- ;
- EN(DATA,OWNR,OPLIEN,NPLNM,LYOUT) ; EP - BQI COPY PANEL
- ; Description
- ; Creates a copy of the original panel specified by OWNR and PLIEN
- ; under the current user (DUZ). All data is copied, except that the
- ; new panel name will be "Copy of "_OldPanelName if this is the first
- ; copy or "Copy (n) of "_OldPanelName if this is a subsequent copy.
- ;
- ; All data is copied from the original panel except the panel creation
- ; date/time (which is set to NOW). If the panel OWNR and the DUZ are
- ; different then the shared access information will also not be copied.
- ; Input:
- ; OWNR - Owner of the panel
- ; OPLIEN - Original panel IEN
- ; NPLNM - New panel name
- ; LYOUT - Flag to indicate whether to copy the layouts as well
- ; Output:
- ; DATA = name of global (passed by reference) in which the data is stored
- ;
- ; PLIEN - panel IEN (for the new panel)
- ; PLID - panel ID (DUZ of new owner and panel ien)
- ; PLNM - panel name (new panel name)
- ; or
- ; BMXSEC - if record can't be locked or if $D(ERROR)
- ; when filing or M error encountered
- ;
- NEW UID,X,BQII
- S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
- S DATA=$NA(^TMP("BQIPLCP",UID))
- K ^TMP("BQIPLCP",UID)
- S LYOUT=$S($G(LYOUT)="Y":1,1:0)
- ;
- NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPLCP D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
- ;
- ; Create owner (DUZ) if new to iCare - If unable to do so - error
- I '$$OWNR^BQIPLUSR(DUZ) S BMXSEC="Unable to create panel" Q
- ;
- ; Create header record
- S BQII=0,^TMP("BQIPLCP",UID,BQII)="I00010PANEL_IEN^T00020PANEL_ID^T00120PANEL_NAME"_$C(30)
- ;
- N DA,DIK,OIENS,IENS,BQINEW,ERROR,OPLNM,SRCTYP
- ;
- ; Get panel name from 'original' panel
- S DA=OPLIEN,DA(1)=OWNR,OIENS=$$IENS^DILF(.DA)
- S OPLNM=$$GET1^DIQ(90505.01,OIENS,".01","I")
- ;
- ; Create a new panel and name
- D FILE I $G(BMXSEC)]"" Q
- ;
- ; Copy PANEL DEFINITION (0 node)
- M ^BQICARE(DUZ,1,PLIEN,0)=^BQICARE(OWNR,1,OPLIEN,0)
- ;
- ; Copy IPC field/Category
- S $P(^BQICARE(DUZ,1,PLIEN,2),U)=$P($G(^BQICARE(OWNR,1,OPLIEN,2)),U)
- S:DUZ=OWNR $P(^BQICARE(DUZ,1,PLIEN,2),U,2)=$P($G(^BQICARE(OWNR,1,OPLIEN,2)),U,2)
- S:DUZ'=OWNR $P(^BQICARE(DUZ,1,PLIEN,2),U,2)=$P($G(^BQICARE(OWNR,1,OPLIEN,30,DUZ,0)),U,6)
- ;
- ; Update panel name, creation date/time, last updated by
- ; and updated date/time for 'new' panel
- S DA(1)=DUZ,DA=PLIEN,IENS=$$IENS^DILF(.DA)
- S BQINEW(90505.01,IENS,.01)=PLNM
- I $$GET1^DIQ(90505.01,IENS,.02,"I")="" S BQINEW(90505.01,IENS,.02)=$$NOW^XLFDT()
- S BQINEW(90505.01,IENS,.04)=DUZ
- S BQINEW(90505.01,IENS,.05)=$$NOW^XLFDT()
- D FILE^DIE("","BQINEW","ERROR")
- ;
- ; If an error occurred, remove the half-filed panel and return BMXSEC.
- I $D(ERROR) D Q
- . S DIK="^BQICARE("_DA(1)_",1,"
- . D ^DIK
- . S BMXSEC="Error encountered while copying panel definition."
- . Q
- ;
- ; Copy data
- D CPY(OWNR,OPLIEN,PLIEN)
- ;
- ; Check type of panel if moving a share
- I OWNR'=DUZ D
- . NEW DA,IENS
- . S DA(1)=DUZ,DA=PLIEN,IENS=$$IENS^DILF(.DA)
- . S SRCTYP=$$GET1^DIQ(90505.01,IENS,.03,"I")
- . I SRCTYP'="Y" Q
- . S BQIUPD(90505.01,IENS,.03)="M"
- . D FILE^DIE("","BQIUPD","ERROR")
- . K BQIUPD
- . K DESC
- . D DESC^BQIPDSCM(DUZ,PLIEN,.DESC)
- . D WP^DIE(90505.01,IENS,5,"","DESC")
- . K DESC
- . NEW DFN
- . S DFN=0
- . F S DFN=$O(^BQICARE(DUZ,1,PLIEN,40,DFN)) Q:'DFN D
- .. I $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)'="" Q
- .. S $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)="A"
- .. S $P(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,4)=$$NOW^XLFDT()
- ;
- ; if user selected to copy the layout
- I LYOUT D LAY(OWNR,OPLIEN,PLIEN)
- ;
- ; Return panel IEN, ID, and NAME on success
- S PLID=$$PLID^BQIUG1(DUZ,PLIEN)
- S BQII=BQII+1,^TMP("BQIPLCP",UID,BQII)=PLIEN_"^"_PLID_"^"_PLNM_$C(30)
- S BQII=BQII+1,^TMP("BQIPLCP",UID,BQII)=$C(31)
- K PLID,PLNM
- Q
- ;
- FILE ; Create name and file new panel under current DUZ
- L +^BQICARE(DUZ,1,0):5
- ; NOTE: It is possible that the lock should be extended around the whole copy procedure.
- ; Potential problem is that the panel could become available to a shared user during
- ; the IX^DIK process but before the panel x-ref completes. This is a very small
- ; period of time, but should still be tested.
- I '$T S BMXSEC="Unable to create panel" Q ; Error - unable to assign next panel IEN
- D
- . ; First try to create a new name for the panel using "Copy of "_OldName.
- . N DA,PIENS,ERROR,II
- . S PLNM=$S($G(NPLNM)'="":NPLNM,1:"Copy of "_OPLNM)
- . S DA(1)=DUZ,DA=""
- . S PIENS=$$IENS^DILF(.DA)
- . I $$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")=0 Q ; New panel name not currently in use.
- . ; Otherwise create a new name for the panel using "Copy (n) of "_OldName.
- . F II=1:1 D I PLNM]"" Q
- .. N DA,PIENS,ERROR
- .. S PLNM="Copy ("_II_") of "_OPLNM
- .. S DA(1)=DUZ,DA=""
- .. S PIENS=$$IENS^DILF(.DA)
- .. I $$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")=0 Q ; New panel name not currently in use.
- .. S PLNM="" ; Clear panel name if currently in use
- . Q
- ; File new panel
- N DA,X,DINUM,DIC,DIE,DLAYGO
- S DA(1)=DUZ,X=PLNM,DLAYGO=90505.01
- S DIC="^BQICARE("_DA(1)_",1,",DIE=DIC
- S DIC(0)="L",DIC("P")=DLAYGO
- K DO,DD D FILE^DICN
- S (DA,PLIEN)=+Y
- I PLIEN=-1 S BMXSEC="Error encountered while filing panel."
- L -^BQICARE(DUZ,1,0)
- Q
- ;
- ERR ;
- L -^BQICARE(DUZ,1,0)
- 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
- ;
- CPY(OWNR,OPLIEN,PLIEN) ;EP -- Copy data from one panel to another
- ; Input
- ; OWNR - Owner of panel
- ; OPLIEN - Original panel IEN
- ; PLIEN - New panel IEN
- ;
- ; Copy PANEL DEFINITION (remaining nodes)
- ;
- I $D(^BQICARE(OWNR,1,OPLIEN,3)) M ^BQICARE(DUZ,1,PLIEN,3)=^BQICARE(OWNR,1,OPLIEN,3)
- I $D(^BQICARE(OWNR,1,OPLIEN,5)) M ^BQICARE(DUZ,1,PLIEN,5)=^BQICARE(OWNR,1,OPLIEN,5)
- ;
- ; Copy PARAMETER DEFINITION
- I $D(^BQICARE(OWNR,1,OPLIEN,10)) M ^BQICARE(DUZ,1,PLIEN,10)=^BQICARE(OWNR,1,OPLIEN,10)
- ;
- ; Copy FILTER DEFINITION
- I $D(^BQICARE(OWNR,1,OPLIEN,15)) M ^BQICARE(DUZ,1,PLIEN,15)=^BQICARE(OWNR,1,OPLIEN,15)
- ;
- ; Copy PATIENT LIST
- I $D(^BQICARE(OWNR,1,OPLIEN,40)) M ^BQICARE(DUZ,1,PLIEN,40)=^BQICARE(OWNR,1,OPLIEN,40)
- ;
- ; Update cross references for merged entries
- S DIK="^BQICARE("_DA(1)_",1,"
- D IX^DIK
- Q
- ;
- LAY(OWNR,OPLIEN,PLIEN) ;EP - Copy the layouts
- NEW LYI,TMPLNM,DIK,DA,TMIEN,TMTYP
- ;
- ; if the user is the owner
- ;
- I OWNR=DUZ D
- . M ^BQICARE(DUZ,1,PLIEN,4)=^BQICARE(OWNR,1,OPLIEN,4) ;Template References
- . M ^BQICARE(DUZ,1,PLIEN,20)=^BQICARE(OWNR,1,OPLIEN,20) ;Patient Layout
- . M ^BQICARE(DUZ,1,PLIEN,22)=^BQICARE(OWNR,1,OPLIEN,22) ;Reminders
- . M ^BQICARE(DUZ,1,PLIEN,25)=^BQICARE(OWNR,1,OPLIEN,25) ;Nat'l Meas
- . M ^BQICARE(DUZ,1,PLIEN,23)=^BQICARE(OWNR,1,OPLIEN,23) ;Care Mgmt Layouts (Asthma and HIV/AIDS)
- ;
- ; if the user is not the owner, create customized
- I OWNR'=DUZ D
- . M ^BQICARE(DUZ,1,PLIEN,4)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,4)
- . S $P(^BQICARE(DUZ,1,PLIEN,4,0),U,2)="90505.14"
- . M ^BQICARE(DUZ,1,PLIEN,20)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,20)
- . S $P(^BQICARE(DUZ,1,PLIEN,20,0),U,2)="90505.05P"
- . M ^BQICARE(DUZ,1,PLIEN,22)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,22)
- . S $P(^BQICARE(DUZ,1,PLIEN,22,0),U,2)="90505.122"
- . M ^BQICARE(DUZ,1,PLIEN,23)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,23)
- . S $P(^BQICARE(DUZ,1,PLIEN,23,0),U,2)="90505.123"
- . 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"
- . M ^BQICARE(DUZ,1,PLIEN,25)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,25)
- . S $P(^BQICARE(DUZ,1,PLIEN,25,0),U,2)="90505.125"
- ;
- ; Update cross references for merged entries
- S DIK="^BQICARE(",DA=DUZ
- D IX^DIK
- Q
- BQIPLCP ;PRXM/HC/KJH-Copy Panel Functions ; 2 Feb 2006 4:05 PM
- +1 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59
- +2 ;
- +3 QUIT
- +4 ;
- EN(DATA,OWNR,OPLIEN,NPLNM,LYOUT) ; EP - BQI COPY PANEL
- +1 ; Description
- +2 ; Creates a copy of the original panel specified by OWNR and PLIEN
- +3 ; under the current user (DUZ). All data is copied, except that the
- +4 ; new panel name will be "Copy of "_OldPanelName if this is the first
- +5 ; copy or "Copy (n) of "_OldPanelName if this is a subsequent copy.
- +6 ;
- +7 ; All data is copied from the original panel except the panel creation
- +8 ; date/time (which is set to NOW). If the panel OWNR and the DUZ are
- +9 ; different then the shared access information will also not be copied.
- +10 ; Input:
- +11 ; OWNR - Owner of the panel
- +12 ; OPLIEN - Original panel IEN
- +13 ; NPLNM - New panel name
- +14 ; LYOUT - Flag to indicate whether to copy the layouts as well
- +15 ; Output:
- +16 ; DATA = name of global (passed by reference) in which the data is stored
- +17 ;
- +18 ; PLIEN - panel IEN (for the new panel)
- +19 ; PLID - panel ID (DUZ of new owner and panel ien)
- +20 ; PLNM - panel name (new panel name)
- +21 ; or
- +22 ; BMXSEC - if record can't be locked or if $D(ERROR)
- +23 ; when filing or M error encountered
- +24 ;
- +25 NEW UID,X,BQII
- +26 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
- +27 SET DATA=$NAME(^TMP("BQIPLCP",UID))
- +28 KILL ^TMP("BQIPLCP",UID)
- +29 SET LYOUT=$SELECT($GET(LYOUT)="Y":1,1:0)
- +30 ;
- +31 ; SAC 2006 2.2.3.3.2
- NEW $ESTACK,$ETRAP
- SET $ETRAP="D ERR^BQIPLCP D UNWIND^%ZTER"
- +32 ;
- +33 ; Create owner (DUZ) if new to iCare - If unable to do so - error
- +34 IF '$$OWNR^BQIPLUSR(DUZ)
- SET BMXSEC="Unable to create panel"
- QUIT
- +35 ;
- +36 ; Create header record
- +37 SET BQII=0
- SET ^TMP("BQIPLCP",UID,BQII)="I00010PANEL_IEN^T00020PANEL_ID^T00120PANEL_NAME"_$CHAR(30)
- +38 ;
- +39 NEW DA,DIK,OIENS,IENS,BQINEW,ERROR,OPLNM,SRCTYP
- +40 ;
- +41 ; Get panel name from 'original' panel
- +42 SET DA=OPLIEN
- SET DA(1)=OWNR
- SET OIENS=$$IENS^DILF(.DA)
- +43 SET OPLNM=$$GET1^DIQ(90505.01,OIENS,".01","I")
- +44 ;
- +45 ; Create a new panel and name
- +46 DO FILE
- IF $GET(BMXSEC)]""
- QUIT
- +47 ;
- +48 ; Copy PANEL DEFINITION (0 node)
- +49 MERGE ^BQICARE(DUZ,1,PLIEN,0)=^BQICARE(OWNR,1,OPLIEN,0)
- +50 ;
- +51 ; Copy IPC field/Category
- +52 SET $PIECE(^BQICARE(DUZ,1,PLIEN,2),U)=$PIECE($GET(^BQICARE(OWNR,1,OPLIEN,2)),U)
- +53 IF DUZ=OWNR
- SET $PIECE(^BQICARE(DUZ,1,PLIEN,2),U,2)=$PIECE($GET(^BQICARE(OWNR,1,OPLIEN,2)),U,2)
- +54 IF DUZ'=OWNR
- SET $PIECE(^BQICARE(DUZ,1,PLIEN,2),U,2)=$PIECE($GET(^BQICARE(OWNR,1,OPLIEN,30,DUZ,0)),U,6)
- +55 ;
- +56 ; Update panel name, creation date/time, last updated by
- +57 ; and updated date/time for 'new' panel
- +58 SET DA(1)=DUZ
- SET DA=PLIEN
- SET IENS=$$IENS^DILF(.DA)
- +59 SET BQINEW(90505.01,IENS,.01)=PLNM
- +60 IF $$GET1^DIQ(90505.01,IENS,.02,"I")=""
- SET BQINEW(90505.01,IENS,.02)=$$NOW^XLFDT()
- +61 SET BQINEW(90505.01,IENS,.04)=DUZ
- +62 SET BQINEW(90505.01,IENS,.05)=$$NOW^XLFDT()
- +63 DO FILE^DIE("","BQINEW","ERROR")
- +64 ;
- +65 ; If an error occurred, remove the half-filed panel and return BMXSEC.
- +66 IF $DATA(ERROR)
- Begin DoDot:1
- +67 SET DIK="^BQICARE("_DA(1)_",1,"
- +68 DO ^DIK
- +69 SET BMXSEC="Error encountered while copying panel definition."
- +70 QUIT
- End DoDot:1
- QUIT
- +71 ;
- +72 ; Copy data
- +73 DO CPY(OWNR,OPLIEN,PLIEN)
- +74 ;
- +75 ; Check type of panel if moving a share
- +76 IF OWNR'=DUZ
- Begin DoDot:1
- +77 NEW DA,IENS
- +78 SET DA(1)=DUZ
- SET DA=PLIEN
- SET IENS=$$IENS^DILF(.DA)
- +79 SET SRCTYP=$$GET1^DIQ(90505.01,IENS,.03,"I")
- +80 IF SRCTYP'="Y"
- QUIT
- +81 SET BQIUPD(90505.01,IENS,.03)="M"
- +82 DO FILE^DIE("","BQIUPD","ERROR")
- +83 KILL BQIUPD
- +84 KILL DESC
- +85 DO DESC^BQIPDSCM(DUZ,PLIEN,.DESC)
- +86 DO WP^DIE(90505.01,IENS,5,"","DESC")
- +87 KILL DESC
- +88 NEW DFN
- +89 SET DFN=0
- +90 FOR
- SET DFN=$ORDER(^BQICARE(DUZ,1,PLIEN,40,DFN))
- IF 'DFN
- QUIT
- Begin DoDot:2
- +91 IF $PIECE(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)'=""
- QUIT
- +92 SET $PIECE(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,2)="A"
- +93 SET $PIECE(^BQICARE(DUZ,1,PLIEN,40,DFN,0),U,4)=$$NOW^XLFDT()
- End DoDot:2
- End DoDot:1
- +94 ;
- +95 ; if user selected to copy the layout
- +96 IF LYOUT
- DO LAY(OWNR,OPLIEN,PLIEN)
- +97 ;
- +98 ; Return panel IEN, ID, and NAME on success
- +99 SET PLID=$$PLID^BQIUG1(DUZ,PLIEN)
- +100 SET BQII=BQII+1
- SET ^TMP("BQIPLCP",UID,BQII)=PLIEN_"^"_PLID_"^"_PLNM_$CHAR(30)
- +101 SET BQII=BQII+1
- SET ^TMP("BQIPLCP",UID,BQII)=$CHAR(31)
- +102 KILL PLID,PLNM
- +103 QUIT
- +104 ;
- FILE ; Create name and file new panel under current DUZ
- +1 LOCK +^BQICARE(DUZ,1,0):5
- +2 ; NOTE: It is possible that the lock should be extended around the whole copy procedure.
- +3 ; Potential problem is that the panel could become available to a shared user during
- +4 ; the IX^DIK process but before the panel x-ref completes. This is a very small
- +5 ; period of time, but should still be tested.
- +6 ; Error - unable to assign next panel IEN
- IF '$TEST
- SET BMXSEC="Unable to create panel"
- QUIT
- +7 Begin DoDot:1
- +8 ; First try to create a new name for the panel using "Copy of "_OldName.
- +9 NEW DA,PIENS,ERROR,II
- +10 SET PLNM=$SELECT($GET(NPLNM)'="":NPLNM,1:"Copy of "_OPLNM)
- +11 SET DA(1)=DUZ
- SET DA=""
- +12 SET PIENS=$$IENS^DILF(.DA)
- +13 ; New panel name not currently in use.
- IF $$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")=0
- QUIT
- +14 ; Otherwise create a new name for the panel using "Copy (n) of "_OldName.
- +15 FOR II=1:1
- Begin DoDot:2
- +16 NEW DA,PIENS,ERROR
- +17 SET PLNM="Copy ("_II_") of "_OPLNM
- +18 SET DA(1)=DUZ
- SET DA=""
- +19 SET PIENS=$$IENS^DILF(.DA)
- +20 ; New panel name not currently in use.
- IF $$FIND1^DIC(90505.01,PIENS,"X",PLNM,"","","ERROR")=0
- QUIT
- +21 ; Clear panel name if currently in use
- SET PLNM=""
- End DoDot:2
- IF PLNM]""
- QUIT
- +22 QUIT
- End DoDot:1
- +23 ; File new panel
- +24 NEW DA,X,DINUM,DIC,DIE,DLAYGO
- +25 SET DA(1)=DUZ
- SET X=PLNM
- SET DLAYGO=90505.01
- +26 SET DIC="^BQICARE("_DA(1)_",1,"
- SET DIE=DIC
- +27 SET DIC(0)="L"
- SET DIC("P")=DLAYGO
- +28 KILL DO,DD
- DO FILE^DICN
- +29 SET (DA,PLIEN)=+Y
- +30 IF PLIEN=-1
- SET BMXSEC="Error encountered while filing panel."
- +31 LOCK -^BQICARE(DUZ,1,0)
- +32 QUIT
- +33 ;
- ERR ;
- +1 LOCK -^BQICARE(DUZ,1,0)
- +2 DO ^%ZTER
- +3 NEW Y,ERRDTM
- +4 SET Y=$$NOW^XLFDT()
- XECUTE ^DD("DD")
- SET ERRDTM=Y
- +5 SET BMXSEC="Recording that an error occurred at "_ERRDTM
- +6 QUIT
- +7 ;
- CPY(OWNR,OPLIEN,PLIEN) ;EP -- Copy data from one panel to another
- +1 ; Input
- +2 ; OWNR - Owner of panel
- +3 ; OPLIEN - Original panel IEN
- +4 ; PLIEN - New panel IEN
- +5 ;
- +6 ; Copy PANEL DEFINITION (remaining nodes)
- +7 ;
- +8 IF $DATA(^BQICARE(OWNR,1,OPLIEN,3))
- MERGE ^BQICARE(DUZ,1,PLIEN,3)=^BQICARE(OWNR,1,OPLIEN,3)
- +9 IF $DATA(^BQICARE(OWNR,1,OPLIEN,5))
- MERGE ^BQICARE(DUZ,1,PLIEN,5)=^BQICARE(OWNR,1,OPLIEN,5)
- +10 ;
- +11 ; Copy PARAMETER DEFINITION
- +12 IF $DATA(^BQICARE(OWNR,1,OPLIEN,10))
- MERGE ^BQICARE(DUZ,1,PLIEN,10)=^BQICARE(OWNR,1,OPLIEN,10)
- +13 ;
- +14 ; Copy FILTER DEFINITION
- +15 IF $DATA(^BQICARE(OWNR,1,OPLIEN,15))
- MERGE ^BQICARE(DUZ,1,PLIEN,15)=^BQICARE(OWNR,1,OPLIEN,15)
- +16 ;
- +17 ; Copy PATIENT LIST
- +18 IF $DATA(^BQICARE(OWNR,1,OPLIEN,40))
- MERGE ^BQICARE(DUZ,1,PLIEN,40)=^BQICARE(OWNR,1,OPLIEN,40)
- +19 ;
- +20 ; Update cross references for merged entries
- +21 SET DIK="^BQICARE("_DA(1)_",1,"
- +22 DO IX^DIK
- +23 QUIT
- +24 ;
- LAY(OWNR,OPLIEN,PLIEN) ;EP - Copy the layouts
- +1 NEW LYI,TMPLNM,DIK,DA,TMIEN,TMTYP
- +2 ;
- +3 ; if the user is the owner
- +4 ;
- +5 IF OWNR=DUZ
- Begin DoDot:1
- +6 ;Template References
- MERGE ^BQICARE(DUZ,1,PLIEN,4)=^BQICARE(OWNR,1,OPLIEN,4)
- +7 ;Patient Layout
- MERGE ^BQICARE(DUZ,1,PLIEN,20)=^BQICARE(OWNR,1,OPLIEN,20)
- +8 ;Reminders
- MERGE ^BQICARE(DUZ,1,PLIEN,22)=^BQICARE(OWNR,1,OPLIEN,22)
- +9 ;Nat'l Meas
- MERGE ^BQICARE(DUZ,1,PLIEN,25)=^BQICARE(OWNR,1,OPLIEN,25)
- +10 ;Care Mgmt Layouts (Asthma and HIV/AIDS)
- MERGE ^BQICARE(DUZ,1,PLIEN,23)=^BQICARE(OWNR,1,OPLIEN,23)
- End DoDot:1
- +11 ;
- +12 ; if the user is not the owner, create customized
- +13 IF OWNR'=DUZ
- Begin DoDot:1
- +14 MERGE ^BQICARE(DUZ,1,PLIEN,4)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,4)
- +15 SET $PIECE(^BQICARE(DUZ,1,PLIEN,4,0),U,2)="90505.14"
- +16 MERGE ^BQICARE(DUZ,1,PLIEN,20)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,20)
- +17 SET $PIECE(^BQICARE(DUZ,1,PLIEN,20,0),U,2)="90505.05P"
- +18 MERGE ^BQICARE(DUZ,1,PLIEN,22)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,22)
- +19 SET $PIECE(^BQICARE(DUZ,1,PLIEN,22,0),U,2)="90505.122"
- +20 MERGE ^BQICARE(DUZ,1,PLIEN,23)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,23)
- +21 SET $PIECE(^BQICARE(DUZ,1,PLIEN,23,0),U,2)="90505.123"
- +22 NEW I
- SET I=0
- FOR
- SET I=$ORDER(^BQICARE(DUZ,1,PLIEN,23,I))
- IF 'I
- QUIT
- SET $PIECE(^BQICARE(DUZ,1,PLIEN,23,I,1,0),U,2)="90505.1231"
- +23 MERGE ^BQICARE(DUZ,1,PLIEN,25)=^BQICARE(OWNR,1,OPLIEN,30,DUZ,25)
- +24 SET $PIECE(^BQICARE(DUZ,1,PLIEN,25,0),U,2)="90505.125"
- End DoDot:1
- +25 ;
- +26 ; Update cross references for merged entries
- +27 SET DIK="^BQICARE("
- SET DA=DUZ
- +28 DO IX^DIK
- +29 QUIT