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

PXRMDCPY.m

Go to the documentation of this file.
  1. PXRMDCPY ;SLC/PJH - Copy dialog files. ;10/23/2019
  1. ;;2.0;CLINICAL REMINDERS;**4,12,45**;Feb 04, 2005;Build 566
  1. ;
  1. ;Called by label from PXRMDEDT
  1. ;
  1. ;Yes/No prompts
  1. ;--------------
  1. ASK(YESNO,TEXT,HLP,DEFAULT) ;
  1. N X,Y,DIR
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="YA0"
  1. S DIR("A")=TEXT
  1. S DIR("B")=DEFAULT
  1. S DIR("?")="Enter Y or N. For detailed help type ??"
  1. S DIR("??")=U_"D HELP^PXRMDEDT(HLP)"
  1. D ^DIR K DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S YESNO=$E(Y(0))
  1. Q
  1. ;
  1. ;Copy any dialog
  1. ;---------------
  1. ANY W IORESET
  1. N PROMPT,PXRMDANY,ROOT,WHAT
  1. S WHAT="dialog",ROOT="^PXRMD(801.41,",PROMPT="Select the dialog to copy: "
  1. S PXRMDANY=1
  1. D COPY^PXRMCOPY(PROMPT,ROOT,WHAT)
  1. Q
  1. ;
  1. ;Delete the entry just added
  1. ;---------------------------
  1. DELETE S DIK=ROOT,DA=IENN D ^DIK
  1. W !!,"New entry not created due to invalid name!",!
  1. Q
  1. ;
  1. ;Error Handler
  1. ;-------------
  1. ERR(DESC) ;
  1. N ERROR,IC,REF
  1. S ERROR(1)="Unable to update GUI PROCESS file : "_DESC
  1. S ERROR(2)="Error in UPDATE^DIE, needs further investigation"
  1. ;Move MSG into ERROR
  1. S REF="MSG"
  1. F IC=3:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
  1. ;Screen message
  1. D BMES^XPDUTL(.ERROR)
  1. Q
  1. ;
  1. ;;Given ROOT return the first
  1. ;;---------------------------
  1. ;GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
  1. ;;after a call to SETSTART.
  1. ;N ENTRY,NIEN,OIEN
  1. ;S ENTRY=ROOT_0_")"
  1. ;S OIEN=$P(@ENTRY,U,3)
  1. ;S ENTRY=ROOT_OIEN_")"
  1. ;F S NIEN=$O(@ENTRY) Q:+(NIEN-OIEN)>1 Q:+NIEN'>0 S OIEN=NIEN,ENTRY=ROOT_NIEN_")"
  1. ;Q OIEN+1
  1. ;;
  1. ;;Use MERGE to copy ROOT(IENO into ROOT(IENN
  1. ;;------------------------------------------
  1. ;MERGE(IENN,IENO,ROOT) ;
  1. ;N DEST,SOURCE
  1. ;;
  1. ;S DEST=ROOT_IENN_")"
  1. ;;Lock the file before merging.
  1. ;L +@DEST:10
  1. ;E W !,"Another user is editing this file, try later" H 2 S DUOUT=1 Q
  1. ;S SOURCE=ROOT_IENO_")"
  1. ;M @DEST=@SOURCE
  1. ;;Unlock the file
  1. ;L -@DEST
  1. ;Q
  1. ;;
  1. ;Get default name
  1. ;----------------
  1. NAME(IEN,ORG) ;
  1. N CNT,NAME,PREV
  1. ;
  1. S PREV=0
  1. I $E(ORG,$L(ORG))=")",ORG[" (" D
  1. .S PREV=+$P(ORG," (",2) S:PREV>0 ORG=$P(ORG," (",1)
  1. F CNT=PREV+1:1 S NAME=ORG_" ("_CNT_")" Q:'$D(^PXRMD(801.41,"B",NAME))
  1. Q NAME
  1. ;
  1. ;Copy selected dialog element OR reminder dialog
  1. ;-----------------------------------------------
  1. SEL(IENO,RDIEN) ;
  1. W IORESET S VALMBCK="R"
  1. N ANS,IENN,PROMPT,ROOT,TEXT,WHAT,DPOS
  1. S WHAT="dialog element"
  1. S ROOT="^PXRMD(801.41,"
  1. S PROMPT="Select the dialog to copy: "
  1. S TEXT=$P($G(^PXRMD(801.41,IENO,0)),U)
  1. ;
  1. I RDIEN S TEXT="Copy and replace '"_TEXT_"' "
  1. I 'RDIEN S TEXT="Copy reminder dialog '"_TEXT_"' "
  1. D ASK(.ANS,TEXT,2,"Y") Q:$D(DUOUT)!$D(DTOUT) Q:ANS'="Y"
  1. ;Copy
  1. D GETORGRC^PXRMCOPY(IENO,.IENN,ROOT,WHAT,1) Q:$D(DUOUT)!$D(DTOUT)
  1. I +$G(IENN)=0 S DTOUT=1 Q
  1. S DPOS=$G(SEQ)
  1. ;Replace dialog element in reminder dialog
  1. I RDIEN D
  1. .N DR,DA,DIE
  1. .S DA=0
  1. .F S DA=$O(^PXRMD(801.41,RDIEN,10,"D",IENO,DA)) Q:DA="" D
  1. . . I $P($G(^PXRMD(801.41,RDIEN,10,DA,0)),U)=$G(DPOS) D
  1. . . . S DA(1)=RDIEN
  1. . . . S DR="2///"_IENN
  1. . . . S DIE=ROOT_RDIEN_",10,"
  1. . . . D ^DIE
  1. .;W !,"Replaced element'"_$P(@(ROOT_IENO_",0)"),U)_"'"
  1. .;W !,"with '"_$P(@(ROOT_IENN_",0)"),U)_"'"
  1. .;W !,"on this dialog.",!
  1. ;
  1. ;Quit screen for edit = yes
  1. I 'RDIEN S VALMBCK="Q" Q
  1. ;
  1. N DIR
  1. S DIR(0)="YAO"
  1. S DIR("A")="Do you want to edit now "
  1. S DIR("B")="Y"
  1. D ^DIR
  1. I $D(DIRUT) S DUOUT=1 Q
  1. I $E(Y(0))'="Y" S DUOUT=1 Q
  1. W !
  1. ;Reset dialog element ien
  1. S IENO=IENN
  1. Q
  1. ;
  1. ;Return TRUE (1) if NAME is unique
  1. ;---------------------------------
  1. UNIQNAME(NAME,ROOT) ;
  1. N RETVAL,REF
  1. S RETVAL=1,REF=ROOT_"""B"""_","_""""_NAME_""""_")"
  1. I $D(@REF) S RETVAL=0
  1. Q RETVAL