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