- 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 Jan 18, 2025@02:44:49 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