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

PXRMDEDI.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;Used by protocol PXRM DIALOG SELECTION ITEM
  1. ;
  1. ASK(PIEN,SEQ) ;Ask if OK to delete
  1. N DDATA,DIR,DTYP,NAME,TYP,X,Y
  1. K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DDATA=$G(^PXRMD(801.41,PIEN,0))
  1. S NAME=$P(DDATA,U),TYP=$P(DDATA,U,4)
  1. S DIR(0)="YA0"
  1. S DIR("A")="Delete sequence "_SEQ_" from "
  1. I TYP="G" S DIR("A")=DIR("A")_"group "_NAME_": "
  1. E S DIR("A")=DIR("A")_"reminder dialog "_NAME_": "
  1. S DIR("B")="N"
  1. S DIR("?")="Enter Y or N. For detailed help type ??"
  1. S DIR("??")=U_"D XHLP^PXRMDLG(1)"
  1. D ^DIR K DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. I $E(Y(0))="N" S DUOUT=1
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. DEL(SEQ,PXRMDIEN) ;Delete individual element from dialog or group
  1. N DA,DIK
  1. S DIEN=0
  1. F S DIEN=$O(^PXRMD(801.41,PXRMDIEN,10,DIEN)) Q:'DIEN D
  1. .I $P($G(^PXRMD(801.41,PXRMDIEN,10,DIEN,0)),U)=SEQ D
  1. ..S DA(1)=PXRMDIEN,DA=DIEN W !,"DA: "_DA Q:'DA
  1. ..S DIK="^PXRMD(801.41,"_DA(1)_",10,"
  1. ..D ^DIK
  1. S VALMBG=1
  1. Q
  1. ;
  1. IND(DIEN,SEL) ;Edit individual element
  1. W IORESET
  1. N DIC,DIDEL,DR,DTOUT,DTYP,DUOUT,DINUSE,FAIL,HED,LFIND,LOCK,NATIONAL,OIEN,PLOCK,Y
  1. ;
  1. S OIEN=0
  1. ;Check for Uneditable flag
  1. S LOCK=$P($G(^PXRMD(801.41,DIEN,100)),U,4)
  1. S LFIND=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
  1. I LOCK=1,$G(LFIND)'="",$G(LFIND)'["ORD",'$G(PXRMINST) D Q
  1. .W !,"This item can not be edited" H 2
  1. ;
  1. S NATIONAL=0
  1. ;Limited edit of National dialogs
  1. I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" D
  1. .I $G(PXRMINST)=1,DUZ(0)="@" Q
  1. .S NATIONAL=1
  1. .S PLOCK=$P($G(^PXRMD(801.41,PXRMDIEN,100)),U,4)
  1. ;
  1. N ANS,DATA,PIEN,SEQ
  1. ;Get group or reminder dialog ien for this component
  1. S DATA=$G(^TMP("PXRMDLG4",$J,"IEN",SEL))
  1. S PIEN=$P(DATA,U),SEQ=$P(DATA,U,2)
  1. ;National dialogs can only be edited
  1. I NATIONAL S ANS="E"
  1. ;In Group edit the group can only be edited
  1. I DIEN=PXRMDIEN S ANS="E"
  1. ;Ask what to do with local dialogs
  1. S DTYP=$P($G(^PXRMD(801.41,DIEN,0)),U,4) Q:DTYP=""
  1. I (('NATIONAL)&(DIEN'=PXRMDIEN))!((NATIONAL)&($G(PLOCK)=1)&(DIEN'=PXRMDIEN)&($G(LOCK)'=1)) D Q:$D(DUOUT)!$D(DTOUT)
  1. .D PROMPT(.ANS,DIEN) Q:$D(DTOUT)!$D(DUOUT)
  1. .;Display usage
  1. .I "DC"[ANS D
  1. ..W !,"Dialog Name: "_$P($G(^PXRMD(801.41,DIEN,0)),U)
  1. .; Verify delete
  1. .I ANS="D" D ASK(PIEN,SEQ)
  1. ;Ask what to do with National Dialogs that have a lock on them
  1. ;I NATIONAL,DIEN'=PXRMDIEN,$P($G(^PXRMD(801.41,DIEN,100)),U,4)=1 D Q:$D(DUOUT)!$D(DTOUT)
  1. I NATIONAL,DIEN'=PXRMDIEN,LOCK=1,DTYP="G" D Q
  1. .W !,"Cannot modify lock group from a higher level view. Please modify"
  1. .W !,"this group from the group editor screen." H 2
  1. ;
  1. ;Delete line
  1. I ANS="D" D DEL(SEQ,PIEN) Q
  1. ;Copy and Replace option
  1. I ANS="C" D SEL^PXRMDCPY(.DIEN,PIEN) Q:$D(DTOUT)!$D(DUOUT)
  1. ;PXRM*2.0*77 - set NATIONAL at selection (IEN) level when get
  1. ; to this point if this is a national dialog which
  1. ; should not be edited. (PXRMINST is set in
  1. ; programmer mode by National Support if editing of
  1. ; a national dialog is needed.)
  1. I '$G(PXRMINST),$P($G(^PXRMD(801.41,IEN,100)),"^")="N" S NATIONAL=1
  1. ;Determine if a taxonomy dialog
  1. N FIND
  1. S FAIL=0
  1. I ANS="R",$D(^PXRMD(801.41,DIEN,"BL")) D
  1. .N ARRAY,CNT,DIR,SEQ,IDX,DNAME,REPIEN,Y
  1. .S DIR(0)="S"_U,CNT=0,DIR("A")="Replacement Dialog"
  1. .S SEQ=0 F S SEQ=$O(^PXRMD(801.41,IEN,"BL","B",SEQ)) Q:SEQ'>0 D
  1. ..S IDX=$O(^PXRMD(801.41,IEN,"BL","B",SEQ,"")) Q:IDX'>0
  1. ..S REPIEN=$P($G(^PXRMD(801.41,IEN,"BL",IDX,0)),U,5) Q:REPIEN'>0
  1. ..S ARRAY(SEQ)=REPIEN
  1. ..S DNAME=$P($G(^PXRMD(801.41,REPIEN,0)),U)
  1. ..S CNT=CNT+1,DIR(0)=DIR(0)_SEQ_":"_DNAME_";"
  1. .I CNT=1,REPIEN>0 S OIEN=DIEN,(IEN,DIEN)=REPIEN Q
  1. .D ^DIR
  1. .I $D(DIROUT) S DTOUT=1
  1. .I $D(DTOUT)!($D(DUOUT)) S FAIL=1 Q
  1. .S REPIEN=ARRAY(Y)
  1. .I REPIEN>0 S OIEN=DIEN,(IEN,DIEN)=REPIEN
  1. I FAIL=1 Q
  1. ;S OIEN=DIEN,(IEN,DIEN)=$P($G(^PXRMD(801.41,DIEN,49)),U,3)
  1. S FIND=$P($G(^PXRMD(801.41,IEN,1)),U,5),VALMBCK="R"
  1. ;Option to change an element to a group
  1. I DTYP="E",'NATIONAL D NTYP^PXRMDEDT(.DTYP) Q:$D(DUOUT)!$D(DTOUT) D:DTYP="G"
  1. .S $P(^PXRMD(801.41,DIEN,0),U,4)=DTYP
  1. .I $P($G(^PXRMD(801.41,DIEN,"TAX")),U)="A" D
  1. ..N FDA,MSG
  1. ..S FDA(801.41,DIEN_",",.01)=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1. ..S FDA(801.41,DIEN_",",123)="N"
  1. ..D UPDATE^DIE("","FDA","","MSG")
  1. ..I '$D(MSG) W !,"Taxonomy selection set to 'No Pick List'. Review group structure before using in CPRS." Q
  1. ..I $D(MSG) D AWRITE^PXRMUTIL("MSG")
  1. .W !,"Dialog element changed to a dialog group"
  1. ;Edit Element
  1. D EDIT^PXRMDEDT(DTYP,DIEN,OIEN)
  1. Q
  1. ;
  1. PROMPT(ANS,DIEN) ;Select Dialog Element Action
  1. N NAME,X,Y,DIR K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="S"_U_"E:Edit;"
  1. S DIR(0)=DIR(0)_"C:Copy and Replace current element;"
  1. S DIR(0)=DIR(0)_"D:Delete element from this dialog;"
  1. I $D(^PXRMD(801.41,DIEN,"BL")) S DIR(0)=DIR(0)_"R:Edit Replacement Element/Group;"
  1. S DIR("A")="Select Dialog Element Action"
  1. S DIR("B")="E"
  1. S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1. S DIR("??")=U_"D HELP^PXRMDEDI(1)"
  1. D ^DIR K DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S ANS=Y
  1. Q
  1. ;
  1. HELP(CALL) ;General help text routine
  1. N HTEXT
  1. N DIWF,DIWL,DIWR,IC
  1. S DIWF="C70",DIWL=0,DIWR=70
  1. ;
  1. I CALL=1 D
  1. .S HTEXT(1)="Select E to edit dialog element. If you wish to create"
  1. .S HTEXT(2)="a new dialog element just for this reminder dialog select"
  1. .S HTEXT(3)="C to copy and replace the current element. Select D to"
  1. .S HTEXT(4)="delete the sequence number/element from the dialog."
  1. K ^UTILITY($J,"W")
  1. S IC=""
  1. F S IC=$O(HTEXT(IC)) Q:IC="" D
  1. . S X=HTEXT(IC)
  1. . D ^DIWP
  1. W !
  1. S IC=0
  1. F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
  1. . W !,^UTILITY($J,"W",0,IC,0)
  1. K ^UTILITY($J,"W")
  1. W !
  1. Q