PXRMDEDI ;SLC/PJH - Edit PXRM reminder dialog. ;Apr 27, 2021@18:34
;;2.0;CLINICAL REMINDERS;**4,26,45,77**;Feb 04, 2005;Build 5
;
;Used by protocol PXRM DIALOG SELECTION ITEM
;
ASK(PIEN,SEQ) ;Ask if OK to delete
N DDATA,DIR,DTYP,NAME,TYP,X,Y
K DIROUT,DIRUT,DTOUT,DUOUT
S DDATA=$G(^PXRMD(801.41,PIEN,0))
S NAME=$P(DDATA,U),TYP=$P(DDATA,U,4)
S DIR(0)="YA0"
S DIR("A")="Delete sequence "_SEQ_" from "
I TYP="G" S DIR("A")=DIR("A")_"group "_NAME_": "
E S DIR("A")=DIR("A")_"reminder dialog "_NAME_": "
S DIR("B")="N"
S DIR("?")="Enter Y or N. For detailed help type ??"
S DIR("??")=U_"D XHLP^PXRMDLG(1)"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
I $E(Y(0))="N" S DUOUT=1
S VALMBCK="R"
Q
;
DEL(SEQ,PXRMDIEN) ;Delete individual element from dialog or group
N DA,DIK
S DIEN=0
F S DIEN=$O(^PXRMD(801.41,PXRMDIEN,10,DIEN)) Q:'DIEN D
.I $P($G(^PXRMD(801.41,PXRMDIEN,10,DIEN,0)),U)=SEQ D
..S DA(1)=PXRMDIEN,DA=DIEN W !,"DA: "_DA Q:'DA
..S DIK="^PXRMD(801.41,"_DA(1)_",10,"
..D ^DIK
S VALMBG=1
Q
;
IND(DIEN,SEL) ;Edit individual element
W IORESET
N DIC,DIDEL,DR,DTOUT,DTYP,DUOUT,DINUSE,FAIL,HED,LFIND,LOCK,NATIONAL,OIEN,PLOCK,Y
;
S OIEN=0
;Check for Uneditable flag
S LOCK=$P($G(^PXRMD(801.41,DIEN,100)),U,4)
S LFIND=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
I LOCK=1,$G(LFIND)'="",$G(LFIND)'["ORD",'$G(PXRMINST) D Q
.W !,"This item can not be edited" H 2
;
S NATIONAL=0
;Limited edit of National dialogs
I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" D
.I $G(PXRMINST)=1,DUZ(0)="@" Q
.S NATIONAL=1
.S PLOCK=$P($G(^PXRMD(801.41,PXRMDIEN,100)),U,4)
;
N ANS,DATA,PIEN,SEQ
;Get group or reminder dialog ien for this component
S DATA=$G(^TMP("PXRMDLG4",$J,"IEN",SEL))
S PIEN=$P(DATA,U),SEQ=$P(DATA,U,2)
;National dialogs can only be edited
I NATIONAL S ANS="E"
;In Group edit the group can only be edited
I DIEN=PXRMDIEN S ANS="E"
;Ask what to do with local dialogs
S DTYP=$P($G(^PXRMD(801.41,DIEN,0)),U,4) Q:DTYP=""
I (('NATIONAL)&(DIEN'=PXRMDIEN))!((NATIONAL)&($G(PLOCK)=1)&(DIEN'=PXRMDIEN)&($G(LOCK)'=1)) D Q:$D(DUOUT)!$D(DTOUT)
.D PROMPT(.ANS,DIEN) Q:$D(DTOUT)!$D(DUOUT)
.;Display usage
.I "DC"[ANS D
..W !,"Dialog Name: "_$P($G(^PXRMD(801.41,DIEN,0)),U)
.; Verify delete
.I ANS="D" D ASK(PIEN,SEQ)
;Ask what to do with National Dialogs that have a lock on them
;I NATIONAL,DIEN'=PXRMDIEN,$P($G(^PXRMD(801.41,DIEN,100)),U,4)=1 D Q:$D(DUOUT)!$D(DTOUT)
I NATIONAL,DIEN'=PXRMDIEN,LOCK=1,DTYP="G" D Q
.W !,"Cannot modify lock group from a higher level view. Please modify"
.W !,"this group from the group editor screen." H 2
;
;Delete line
I ANS="D" D DEL(SEQ,PIEN) Q
;Copy and Replace option
I ANS="C" D SEL^PXRMDCPY(.DIEN,PIEN) Q:$D(DTOUT)!$D(DUOUT)
;PXRM*2.0*77 - set NATIONAL at selection (IEN) level when get
; to this point if this is a national dialog which
; should not be edited. (PXRMINST is set in
; programmer mode by National Support if editing of
; a national dialog is needed.)
I '$G(PXRMINST),$P($G(^PXRMD(801.41,IEN,100)),"^")="N" S NATIONAL=1
;Determine if a taxonomy dialog
N FIND
S FAIL=0
I ANS="R",$D(^PXRMD(801.41,DIEN,"BL")) D
.N ARRAY,CNT,DIR,SEQ,IDX,DNAME,REPIEN,Y
.S DIR(0)="S"_U,CNT=0,DIR("A")="Replacement Dialog"
.S SEQ=0 F S SEQ=$O(^PXRMD(801.41,IEN,"BL","B",SEQ)) Q:SEQ'>0 D
..S IDX=$O(^PXRMD(801.41,IEN,"BL","B",SEQ,"")) Q:IDX'>0
..S REPIEN=$P($G(^PXRMD(801.41,IEN,"BL",IDX,0)),U,5) Q:REPIEN'>0
..S ARRAY(SEQ)=REPIEN
..S DNAME=$P($G(^PXRMD(801.41,REPIEN,0)),U)
..S CNT=CNT+1,DIR(0)=DIR(0)_SEQ_":"_DNAME_";"
.I CNT=1,REPIEN>0 S OIEN=DIEN,(IEN,DIEN)=REPIEN Q
.D ^DIR
.I $D(DIROUT) S DTOUT=1
.I $D(DTOUT)!($D(DUOUT)) S FAIL=1 Q
.S REPIEN=ARRAY(Y)
.I REPIEN>0 S OIEN=DIEN,(IEN,DIEN)=REPIEN
I FAIL=1 Q
;S OIEN=DIEN,(IEN,DIEN)=$P($G(^PXRMD(801.41,DIEN,49)),U,3)
S FIND=$P($G(^PXRMD(801.41,IEN,1)),U,5),VALMBCK="R"
;Option to change an element to a group
I DTYP="E",'NATIONAL D NTYP^PXRMDEDT(.DTYP) Q:$D(DUOUT)!$D(DTOUT) D:DTYP="G"
.S $P(^PXRMD(801.41,DIEN,0),U,4)=DTYP
.I $P($G(^PXRMD(801.41,DIEN,"TAX")),U)="A" D
..N FDA,MSG
..S FDA(801.41,DIEN_",",.01)=$P($G(^PXRMD(801.41,DIEN,0)),U)
..S FDA(801.41,DIEN_",",123)="N"
..D UPDATE^DIE("","FDA","","MSG")
..I '$D(MSG) W !,"Taxonomy selection set to 'No Pick List'. Review group structure before using in CPRS." Q
..I $D(MSG) D AWRITE^PXRMUTIL("MSG")
.W !,"Dialog element changed to a dialog group"
;Edit Element
D EDIT^PXRMDEDT(DTYP,DIEN,OIEN)
Q
;
PROMPT(ANS,DIEN) ;Select Dialog Element Action
N NAME,X,Y,DIR K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="S"_U_"E:Edit;"
S DIR(0)=DIR(0)_"C:Copy and Replace current element;"
S DIR(0)=DIR(0)_"D:Delete element from this dialog;"
I $D(^PXRMD(801.41,DIEN,"BL")) S DIR(0)=DIR(0)_"R:Edit Replacement Element/Group;"
S DIR("A")="Select Dialog Element Action"
S DIR("B")="E"
S DIR("?")="Select from the codes displayed. For detailed help type ??"
S DIR("??")=U_"D HELP^PXRMDEDI(1)"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S ANS=Y
Q
;
HELP(CALL) ;General help text routine
N HTEXT
N DIWF,DIWL,DIWR,IC
S DIWF="C70",DIWL=0,DIWR=70
;
I CALL=1 D
.S HTEXT(1)="Select E to edit dialog element. If you wish to create"
.S HTEXT(2)="a new dialog element just for this reminder dialog select"
.S HTEXT(3)="C to copy and replace the current element. Select D to"
.S HTEXT(4)="delete the sequence number/element from the dialog."
K ^UTILITY($J,"W")
S IC=""
F S IC=$O(HTEXT(IC)) Q:IC="" D
. S X=HTEXT(IC)
. D ^DIWP
W !
S IC=0
F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
. W !,^UTILITY($J,"W",0,IC,0)
K ^UTILITY($J,"W")
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDEDI 5815 printed Sep 23, 2025@19:19:37 Page 2
PXRMDEDI ;SLC/PJH - Edit PXRM reminder dialog. ;Apr 27, 2021@18:34
+1 ;;2.0;CLINICAL REMINDERS;**4,26,45,77**;Feb 04, 2005;Build 5
+2 ;
+3 ;Used by protocol PXRM DIALOG SELECTION ITEM
+4 ;
ASK(PIEN,SEQ) ;Ask if OK to delete
+1 NEW DDATA,DIR,DTYP,NAME,TYP,X,Y
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DDATA=$GET(^PXRMD(801.41,PIEN,0))
+4 SET NAME=$PIECE(DDATA,U)
SET TYP=$PIECE(DDATA,U,4)
+5 SET DIR(0)="YA0"
+6 SET DIR("A")="Delete sequence "_SEQ_" from "
+7 IF TYP="G"
SET DIR("A")=DIR("A")_"group "_NAME_": "
+8 IF '$TEST
SET DIR("A")=DIR("A")_"reminder dialog "_NAME_": "
+9 SET DIR("B")="N"
+10 SET DIR("?")="Enter Y or N. For detailed help type ??"
+11 SET DIR("??")=U_"D XHLP^PXRMDLG(1)"
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DIROUT)
SET DTOUT=1
+14 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+15 IF $EXTRACT(Y(0))="N"
SET DUOUT=1
+16 SET VALMBCK="R"
+17 QUIT
+18 ;
DEL(SEQ,PXRMDIEN) ;Delete individual element from dialog or group
+1 NEW DA,DIK
+2 SET DIEN=0
+3 FOR
SET DIEN=$ORDER(^PXRMD(801.41,PXRMDIEN,10,DIEN))
if 'DIEN
QUIT
Begin DoDot:1
+4 IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,10,DIEN,0)),U)=SEQ
Begin DoDot:2
+5 SET DA(1)=PXRMDIEN
SET DA=DIEN
WRITE !,"DA: "_DA
if 'DA
QUIT
+6 SET DIK="^PXRMD(801.41,"_DA(1)_",10,"
+7 DO ^DIK
End DoDot:2
End DoDot:1
+8 SET VALMBG=1
+9 QUIT
+10 ;
IND(DIEN,SEL) ;Edit individual element
+1 WRITE IORESET
+2 NEW DIC,DIDEL,DR,DTOUT,DTYP,DUOUT,DINUSE,FAIL,HED,LFIND,LOCK,NATIONAL,OIEN,PLOCK,Y
+3 ;
+4 SET OIEN=0
+5 ;Check for Uneditable flag
+6 SET LOCK=$PIECE($GET(^PXRMD(801.41,DIEN,100)),U,4)
+7 SET LFIND=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
+8 IF LOCK=1
IF $GET(LFIND)'=""
IF $GET(LFIND)'["ORD"
IF '$GET(PXRMINST)
Begin DoDot:1
+9 WRITE !,"This item can not be edited"
HANG 2
End DoDot:1
QUIT
+10 ;
+11 SET NATIONAL=0
+12 ;Limited edit of National dialogs
+13 IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,100)),U)="N"
Begin DoDot:1
+14 IF $GET(PXRMINST)=1
IF DUZ(0)="@"
QUIT
+15 SET NATIONAL=1
+16 SET PLOCK=$PIECE($GET(^PXRMD(801.41,PXRMDIEN,100)),U,4)
End DoDot:1
+17 ;
+18 NEW ANS,DATA,PIEN,SEQ
+19 ;Get group or reminder dialog ien for this component
+20 SET DATA=$GET(^TMP("PXRMDLG4",$JOB,"IEN",SEL))
+21 SET PIEN=$PIECE(DATA,U)
SET SEQ=$PIECE(DATA,U,2)
+22 ;National dialogs can only be edited
+23 IF NATIONAL
SET ANS="E"
+24 ;In Group edit the group can only be edited
+25 IF DIEN=PXRMDIEN
SET ANS="E"
+26 ;Ask what to do with local dialogs
+27 SET DTYP=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)
if DTYP=""
QUIT
+28 IF (('NATIONAL)&(DIEN'=PXRMDIEN))!((NATIONAL)&($GET(PLOCK)=1)&(DIEN'=PXRMDIEN)&($GET(LOCK)'=1))
Begin DoDot:1
+29 DO PROMPT(.ANS,DIEN)
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+30 ;Display usage
+31 IF "DC"[ANS
Begin DoDot:2
+32 WRITE !,"Dialog Name: "_$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
End DoDot:2
+33 ; Verify delete
+34 IF ANS="D"
DO ASK(PIEN,SEQ)
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+35 ;Ask what to do with National Dialogs that have a lock on them
+36 ;I NATIONAL,DIEN'=PXRMDIEN,$P($G(^PXRMD(801.41,DIEN,100)),U,4)=1 D Q:$D(DUOUT)!$D(DTOUT)
+37 IF NATIONAL
IF DIEN'=PXRMDIEN
IF LOCK=1
IF DTYP="G"
Begin DoDot:1
+38 WRITE !,"Cannot modify lock group from a higher level view. Please modify"
+39 WRITE !,"this group from the group editor screen."
HANG 2
End DoDot:1
QUIT
+40 ;
+41 ;Delete line
+42 IF ANS="D"
DO DEL(SEQ,PIEN)
QUIT
+43 ;Copy and Replace option
+44 IF ANS="C"
DO SEL^PXRMDCPY(.DIEN,PIEN)
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+45 ;PXRM*2.0*77 - set NATIONAL at selection (IEN) level when get
+46 ; to this point if this is a national dialog which
+47 ; should not be edited. (PXRMINST is set in
+48 ; programmer mode by National Support if editing of
+49 ; a national dialog is needed.)
+50 IF '$GET(PXRMINST)
IF $PIECE($GET(^PXRMD(801.41,IEN,100)),"^")="N"
SET NATIONAL=1
+51 ;Determine if a taxonomy dialog
+52 NEW FIND
+53 SET FAIL=0
+54 IF ANS="R"
IF $DATA(^PXRMD(801.41,DIEN,"BL"))
Begin DoDot:1
+55 NEW ARRAY,CNT,DIR,SEQ,IDX,DNAME,REPIEN,Y
+56 SET DIR(0)="S"_U
SET CNT=0
SET DIR("A")="Replacement Dialog"
+57 SET SEQ=0
FOR
SET SEQ=$ORDER(^PXRMD(801.41,IEN,"BL","B",SEQ))
if SEQ'>0
QUIT
Begin DoDot:2
+58 SET IDX=$ORDER(^PXRMD(801.41,IEN,"BL","B",SEQ,""))
if IDX'>0
QUIT
+59 SET REPIEN=$PIECE($GET(^PXRMD(801.41,IEN,"BL",IDX,0)),U,5)
if REPIEN'>0
QUIT
+60 SET ARRAY(SEQ)=REPIEN
+61 SET DNAME=$PIECE($GET(^PXRMD(801.41,REPIEN,0)),U)
+62 SET CNT=CNT+1
SET DIR(0)=DIR(0)_SEQ_":"_DNAME_";"
End DoDot:2
+63 IF CNT=1
IF REPIEN>0
SET OIEN=DIEN
SET (IEN,DIEN)=REPIEN
QUIT
+64 DO ^DIR
+65 IF $DATA(DIROUT)
SET DTOUT=1
+66 IF $DATA(DTOUT)!($DATA(DUOUT))
SET FAIL=1
QUIT
+67 SET REPIEN=ARRAY(Y)
+68 IF REPIEN>0
SET OIEN=DIEN
SET (IEN,DIEN)=REPIEN
End DoDot:1
+69 IF FAIL=1
QUIT
+70 ;S OIEN=DIEN,(IEN,DIEN)=$P($G(^PXRMD(801.41,DIEN,49)),U,3)
+71 SET FIND=$PIECE($GET(^PXRMD(801.41,IEN,1)),U,5)
SET VALMBCK="R"
+72 ;Option to change an element to a group
+73 IF DTYP="E"
IF 'NATIONAL
DO NTYP^PXRMDEDT(.DTYP)
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
if DTYP="G"
Begin DoDot:1
+74 SET $PIECE(^PXRMD(801.41,DIEN,0),U,4)=DTYP
+75 IF $PIECE($GET(^PXRMD(801.41,DIEN,"TAX")),U)="A"
Begin DoDot:2
+76 NEW FDA,MSG
+77 SET FDA(801.41,DIEN_",",.01)=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
+78 SET FDA(801.41,DIEN_",",123)="N"
+79 DO UPDATE^DIE("","FDA","","MSG")
+80 IF '$DATA(MSG)
WRITE !,"Taxonomy selection set to 'No Pick List'. Review group structure before using in CPRS."
QUIT
+81 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
End DoDot:2
+82 WRITE !,"Dialog element changed to a dialog group"
End DoDot:1
+83 ;Edit Element
+84 DO EDIT^PXRMDEDT(DTYP,DIEN,OIEN)
+85 QUIT
+86 ;
PROMPT(ANS,DIEN) ;Select Dialog Element Action
+1 NEW NAME,X,Y,DIR
KILL DIROUT,DIRUT,DTOUT,DUOUT
+2 SET DIR(0)="S"_U_"E:Edit;"
+3 SET DIR(0)=DIR(0)_"C:Copy and Replace current element;"
+4 SET DIR(0)=DIR(0)_"D:Delete element from this dialog;"
+5 IF $DATA(^PXRMD(801.41,DIEN,"BL"))
SET DIR(0)=DIR(0)_"R:Edit Replacement Element/Group;"
+6 SET DIR("A")="Select Dialog Element Action"
+7 SET DIR("B")="E"
+8 SET DIR("?")="Select from the codes displayed. For detailed help type ??"
+9 SET DIR("??")=U_"D HELP^PXRMDEDI(1)"
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIROUT)
SET DTOUT=1
+12 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+13 SET ANS=Y
+14 QUIT
+15 ;
HELP(CALL) ;General help text routine
+1 NEW HTEXT
+2 NEW DIWF,DIWL,DIWR,IC
+3 SET DIWF="C70"
SET DIWL=0
SET DIWR=70
+4 ;
+5 IF CALL=1
Begin DoDot:1
+6 SET HTEXT(1)="Select E to edit dialog element. If you wish to create"
+7 SET HTEXT(2)="a new dialog element just for this reminder dialog select"
+8 SET HTEXT(3)="C to copy and replace the current element. Select D to"
+9 SET HTEXT(4)="delete the sequence number/element from the dialog."
End DoDot:1
+10 KILL ^UTILITY($JOB,"W")
+11 SET IC=""
+12 FOR
SET IC=$ORDER(HTEXT(IC))
if IC=""
QUIT
Begin DoDot:1
+13 SET X=HTEXT(IC)
+14 DO ^DIWP
End DoDot:1
+15 WRITE !
+16 SET IC=0
+17 FOR
SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))
if IC=""
QUIT
Begin DoDot:1
+18 WRITE !,^UTILITY($JOB,"W",0,IC,0)
End DoDot:1
+19 KILL ^UTILITY($JOB,"W")
+20 WRITE !
+21 QUIT
