PXRMDCPY ;SLC/PJH - Copy dialog files. ;10/23/2019
;;2.0;CLINICAL REMINDERS;**4,12,45**;Feb 04, 2005;Build 566
;
;Called by label from PXRMDEDT
;
;Yes/No prompts
;--------------
ASK(YESNO,TEXT,HLP,DEFAULT) ;
N X,Y,DIR
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="YA0"
S DIR("A")=TEXT
S DIR("B")=DEFAULT
S DIR("?")="Enter Y or N. For detailed help type ??"
S DIR("??")=U_"D HELP^PXRMDEDT(HLP)"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S YESNO=$E(Y(0))
Q
;
;Copy any dialog
;---------------
ANY W IORESET
N PROMPT,PXRMDANY,ROOT,WHAT
S WHAT="dialog",ROOT="^PXRMD(801.41,",PROMPT="Select the dialog to copy: "
S PXRMDANY=1
D COPY^PXRMCOPY(PROMPT,ROOT,WHAT)
Q
;
;Delete the entry just added
;---------------------------
DELETE S DIK=ROOT,DA=IENN D ^DIK
W !!,"New entry not created due to invalid name!",!
Q
;
;Error Handler
;-------------
ERR(DESC) ;
N ERROR,IC,REF
S ERROR(1)="Unable to update GUI PROCESS file : "_DESC
S ERROR(2)="Error in UPDATE^DIE, needs further investigation"
;Move MSG into ERROR
S REF="MSG"
F IC=3:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
;Screen message
D BMES^XPDUTL(.ERROR)
Q
;
;;Given ROOT return the first
;;---------------------------
;GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
;;after a call to SETSTART.
;N ENTRY,NIEN,OIEN
;S ENTRY=ROOT_0_")"
;S OIEN=$P(@ENTRY,U,3)
;S ENTRY=ROOT_OIEN_")"
;F S NIEN=$O(@ENTRY) Q:+(NIEN-OIEN)>1 Q:+NIEN'>0 S OIEN=NIEN,ENTRY=ROOT_NIEN_")"
;Q OIEN+1
;;
;;Use MERGE to copy ROOT(IENO into ROOT(IENN
;;------------------------------------------
;MERGE(IENN,IENO,ROOT) ;
;N DEST,SOURCE
;;
;S DEST=ROOT_IENN_")"
;;Lock the file before merging.
;L +@DEST:10
;E W !,"Another user is editing this file, try later" H 2 S DUOUT=1 Q
;S SOURCE=ROOT_IENO_")"
;M @DEST=@SOURCE
;;Unlock the file
;L -@DEST
;Q
;;
;Get default name
;----------------
NAME(IEN,ORG) ;
N CNT,NAME,PREV
;
S PREV=0
I $E(ORG,$L(ORG))=")",ORG[" (" D
.S PREV=+$P(ORG," (",2) S:PREV>0 ORG=$P(ORG," (",1)
F CNT=PREV+1:1 S NAME=ORG_" ("_CNT_")" Q:'$D(^PXRMD(801.41,"B",NAME))
Q NAME
;
;Copy selected dialog element OR reminder dialog
;-----------------------------------------------
SEL(IENO,RDIEN) ;
W IORESET S VALMBCK="R"
N ANS,IENN,PROMPT,ROOT,TEXT,WHAT,DPOS
S WHAT="dialog element"
S ROOT="^PXRMD(801.41,"
S PROMPT="Select the dialog to copy: "
S TEXT=$P($G(^PXRMD(801.41,IENO,0)),U)
;
I RDIEN S TEXT="Copy and replace '"_TEXT_"' "
I 'RDIEN S TEXT="Copy reminder dialog '"_TEXT_"' "
D ASK(.ANS,TEXT,2,"Y") Q:$D(DUOUT)!$D(DTOUT) Q:ANS'="Y"
;Copy
D GETORGRC^PXRMCOPY(IENO,.IENN,ROOT,WHAT,1) Q:$D(DUOUT)!$D(DTOUT)
I +$G(IENN)=0 S DTOUT=1 Q
S DPOS=$G(SEQ)
;Replace dialog element in reminder dialog
I RDIEN D
.N DR,DA,DIE
.S DA=0
.F S DA=$O(^PXRMD(801.41,RDIEN,10,"D",IENO,DA)) Q:DA="" D
. . I $P($G(^PXRMD(801.41,RDIEN,10,DA,0)),U)=$G(DPOS) D
. . . S DA(1)=RDIEN
. . . S DR="2///"_IENN
. . . S DIE=ROOT_RDIEN_",10,"
. . . D ^DIE
.;W !,"Replaced element'"_$P(@(ROOT_IENO_",0)"),U)_"'"
.;W !,"with '"_$P(@(ROOT_IENN_",0)"),U)_"'"
.;W !,"on this dialog.",!
;
;Quit screen for edit = yes
I 'RDIEN S VALMBCK="Q" Q
;
N DIR
S DIR(0)="YAO"
S DIR("A")="Do you want to edit now "
S DIR("B")="Y"
D ^DIR
I $D(DIRUT) S DUOUT=1 Q
I $E(Y(0))'="Y" S DUOUT=1 Q
W !
;Reset dialog element ien
S IENO=IENN
Q
;
;Return TRUE (1) if NAME is unique
;---------------------------------
UNIQNAME(NAME,ROOT) ;
N RETVAL,REF
S RETVAL=1,REF=ROOT_"""B"""_","_""""_NAME_""""_")"
I $D(@REF) S RETVAL=0
Q RETVAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDCPY 3730 printed Oct 16, 2024@17:44:27 Page 2
PXRMDCPY ;SLC/PJH - Copy dialog files. ;10/23/2019
+1 ;;2.0;CLINICAL REMINDERS;**4,12,45**;Feb 04, 2005;Build 566
+2 ;
+3 ;Called by label from PXRMDEDT
+4 ;
+5 ;Yes/No prompts
+6 ;--------------
ASK(YESNO,TEXT,HLP,DEFAULT) ;
+1 NEW X,Y,DIR
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="YA0"
+4 SET DIR("A")=TEXT
+5 SET DIR("B")=DEFAULT
+6 SET DIR("?")="Enter Y or N. For detailed help type ??"
+7 SET DIR("??")=U_"D HELP^PXRMDEDT(HLP)"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIROUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET YESNO=$EXTRACT(Y(0))
+12 QUIT
+13 ;
+14 ;Copy any dialog
+15 ;---------------
ANY WRITE IORESET
+1 NEW PROMPT,PXRMDANY,ROOT,WHAT
+2 SET WHAT="dialog"
SET ROOT="^PXRMD(801.41,"
SET PROMPT="Select the dialog to copy: "
+3 SET PXRMDANY=1
+4 DO COPY^PXRMCOPY(PROMPT,ROOT,WHAT)
+5 QUIT
+6 ;
+7 ;Delete the entry just added
+8 ;---------------------------
DELETE SET DIK=ROOT
SET DA=IENN
DO ^DIK
+1 WRITE !!,"New entry not created due to invalid name!",!
+2 QUIT
+3 ;
+4 ;Error Handler
+5 ;-------------
ERR(DESC) ;
+1 NEW ERROR,IC,REF
+2 SET ERROR(1)="Unable to update GUI PROCESS file : "_DESC
+3 SET ERROR(2)="Error in UPDATE^DIE, needs further investigation"
+4 ;Move MSG into ERROR
+5 SET REF="MSG"
+6 FOR IC=3:1
SET REF=$QUERY(@REF)
if REF=""
QUIT
SET ERROR(IC)=REF_"="_@REF
+7 ;Screen message
+8 DO BMES^XPDUTL(.ERROR)
+9 QUIT
+10 ;
+11 ;;Given ROOT return the first
+12 ;;---------------------------
+13 ;GETFOIEN(ROOT) ;Return the first open IEN in ROOT. This should be called
+14 ;;after a call to SETSTART.
+15 ;N ENTRY,NIEN,OIEN
+16 ;S ENTRY=ROOT_0_")"
+17 ;S OIEN=$P(@ENTRY,U,3)
+18 ;S ENTRY=ROOT_OIEN_")"
+19 ;F S NIEN=$O(@ENTRY) Q:+(NIEN-OIEN)>1 Q:+NIEN'>0 S OIEN=NIEN,ENTRY=ROOT_NIEN_")"
+20 ;Q OIEN+1
+21 ;;
+22 ;;Use MERGE to copy ROOT(IENO into ROOT(IENN
+23 ;;------------------------------------------
+24 ;MERGE(IENN,IENO,ROOT) ;
+25 ;N DEST,SOURCE
+26 ;;
+27 ;S DEST=ROOT_IENN_")"
+28 ;;Lock the file before merging.
+29 ;L +@DEST:10
+30 ;E W !,"Another user is editing this file, try later" H 2 S DUOUT=1 Q
+31 ;S SOURCE=ROOT_IENO_")"
+32 ;M @DEST=@SOURCE
+33 ;;Unlock the file
+34 ;L -@DEST
+35 ;Q
+36 ;;
+37 ;Get default name
+38 ;----------------
NAME(IEN,ORG) ;
+1 NEW CNT,NAME,PREV
+2 ;
+3 SET PREV=0
+4 IF $EXTRACT(ORG,$LENGTH(ORG))=")"
IF ORG[" ("
Begin DoDot:1
+5 SET PREV=+$PIECE(ORG," (",2)
if PREV>0
SET ORG=$PIECE(ORG," (",1)
End DoDot:1
+6 FOR CNT=PREV+1:1
SET NAME=ORG_" ("_CNT_")"
if '$DATA(^PXRMD(801.41,"B",NAME))
QUIT
+7 QUIT NAME
+8 ;
+9 ;Copy selected dialog element OR reminder dialog
+10 ;-----------------------------------------------
SEL(IENO,RDIEN) ;
+1 WRITE IORESET
SET VALMBCK="R"
+2 NEW ANS,IENN,PROMPT,ROOT,TEXT,WHAT,DPOS
+3 SET WHAT="dialog element"
+4 SET ROOT="^PXRMD(801.41,"
+5 SET PROMPT="Select the dialog to copy: "
+6 SET TEXT=$PIECE($GET(^PXRMD(801.41,IENO,0)),U)
+7 ;
+8 IF RDIEN
SET TEXT="Copy and replace '"_TEXT_"' "
+9 IF 'RDIEN
SET TEXT="Copy reminder dialog '"_TEXT_"' "
+10 DO ASK(.ANS,TEXT,2,"Y")
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
if ANS'="Y"
QUIT
+11 ;Copy
+12 DO GETORGRC^PXRMCOPY(IENO,.IENN,ROOT,WHAT,1)
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+13 IF +$GET(IENN)=0
SET DTOUT=1
QUIT
+14 SET DPOS=$GET(SEQ)
+15 ;Replace dialog element in reminder dialog
+16 IF RDIEN
Begin DoDot:1
+17 NEW DR,DA,DIE
+18 SET DA=0
+19 FOR
SET DA=$ORDER(^PXRMD(801.41,RDIEN,10,"D",IENO,DA))
if DA=""
QUIT
Begin DoDot:2
+20 IF $PIECE($GET(^PXRMD(801.41,RDIEN,10,DA,0)),U)=$GET(DPOS)
Begin DoDot:3
+21 SET DA(1)=RDIEN
+22 SET DR="2///"_IENN
+23 SET DIE=ROOT_RDIEN_",10,"
+24 DO ^DIE
End DoDot:3
End DoDot:2
+25 ;W !,"Replaced element'"_$P(@(ROOT_IENO_",0)"),U)_"'"
+26 ;W !,"with '"_$P(@(ROOT_IENN_",0)"),U)_"'"
+27 ;W !,"on this dialog.",!
End DoDot:1
+28 ;
+29 ;Quit screen for edit = yes
+30 IF 'RDIEN
SET VALMBCK="Q"
QUIT
+31 ;
+32 NEW DIR
+33 SET DIR(0)="YAO"
+34 SET DIR("A")="Do you want to edit now "
+35 SET DIR("B")="Y"
+36 DO ^DIR
+37 IF $DATA(DIRUT)
SET DUOUT=1
QUIT
+38 IF $EXTRACT(Y(0))'="Y"
SET DUOUT=1
QUIT
+39 WRITE !
+40 ;Reset dialog element ien
+41 SET IENO=IENN
+42 QUIT
+43 ;
+44 ;Return TRUE (1) if NAME is unique
+45 ;---------------------------------
UNIQNAME(NAME,ROOT) ;
+1 NEW RETVAL,REF
+2 SET RETVAL=1
SET REF=ROOT_"""B"""_","_""""_NAME_""""_")"
+3 IF $DATA(@REF)
SET RETVAL=0
+4 QUIT RETVAL
