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

PXRMDEDT.m

Go to the documentation of this file.
  1. PXRMDEDT ;SLC/PJH - Edit PXRM reminder dialog. ;Jan 31, 2023@08:13:33
  1. ;;2.0;CLINICAL REMINDERS;**4,6,12,17,16,24,26,45,82**;Feb 04, 2005;Build 28
  1. ;
  1. ;Used by protocol PXRM SELECTION ADD/PXRM GENERAL ADD
  1. ;
  1. ;Add Dialog
  1. ;----------
  1. ADD N DA,DIC,Y,DTOUT,DUOUT,DTYP,DLAYGO,HED
  1. S HED="ADD DIALOG"
  1. W IORESET
  1. F D Q:$D(DTOUT)
  1. .S DIC="^PXRMD(801.41,"
  1. .;Set the starting place for additions.
  1. .D SETSTART^PXRMCOPY(DIC)
  1. .S DIC(0)="AELMQ",DLAYGO=801.41
  1. .S DIC("A")="Select DIALOG to add: "
  1. .S DIC("DR")="4///"_$G(PXRMDTYP)
  1. .D ^DIC
  1. .I $D(DUOUT) S DTOUT=1
  1. .I ($D(DTOUT))!($D(DUOUT)) Q
  1. .I Y=-1 K DIC S DTOUT=1 Q
  1. .I $P(Y,U,3)'=1 W !,"This dialog name already exists" Q
  1. .S DA=$P(Y,U,1)
  1. .;Determine dialog type
  1. .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
  1. .;Enter dialog type if a new entry
  1. .I DTYP="" D Q:$D(Y)
  1. ..N DIE,DR
  1. ..S DIE=801.41,DR=4
  1. ..D ^DIE
  1. .;
  1. .;Edit Dialog
  1. .D EDIT(DTYP,DA,0)
  1. Q
  1. ;
  1. EDITD(ROOT,IENN) ;
  1. N DA,DIE,DR,TYPE
  1. S TYPE=$P($G(^PXRMD(801.41,IENN,0)),U,4) I TYPE="" Q
  1. I "PF"[TYPE D
  1. .;Get original process ID
  1. .N SUB S SUB=$P($G(^PXRMD(801.41,IENO,46)),U)
  1. .;Update GUI process in 801.41
  1. .I SUB S DR="46///"_SUB,DIE=ROOT,DA=IENN D ^DIE
  1. .;check if a prompt
  1. .I $P(@(ROOT_IENN_",0)"),U,4)="P" D
  1. ..;Allow PXRM prompts to be changed into forced values
  1. ..N ANS,TEXT
  1. ..S TEXT="Change the new prompt into a forced value :"
  1. ..D ASK^PXRMDCPY(.ANS,TEXT,4,"N") Q:$D(DUOUT)!$D(DTOUT) Q:ANS'="Y"
  1. ..;Store the dialog type
  1. ..S DR="4///F",DIE=ROOT,DA=IENN
  1. ..D ^DIE
  1. .Q
  1. ;
  1. D EDIT(TYPE,IENN)
  1. Q
  1. ;called by protocol PXRM DIALOG EDIT
  1. ;-----------------------------------
  1. EDIT(TYP,DA,OIEN) ;
  1. Q:'$$LOCK(DA)
  1. W IORESET
  1. N CS1,CS2,D1,DIC,DIDEL,DIE,DIK,DR,DTOUT,DUOUT,DINUSE,TYP,ODA,Y
  1. ;Save checksum
  1. S VALMBCK=""
  1. S CS1=$$FILE^PXRMEXCS(801.41,DA)
  1. ;
  1. ;Check dialog type
  1. S TYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
  1. S DIE="^PXRMD(801.41,",DIDEL=801.41,DINUSE=0,ODA=DA
  1. ;Reminder Dialog
  1. I TYP="R" S DR="[PXRM EDIT REMINDER DIALOG]"
  1. ;Dialog Element
  1. I TYP="E" S DR="[PXRM EDIT ELEMENT]"
  1. ;Additional Prompt
  1. ;I TYP="P" S DR="[PXRM EDIT PROMPT]"
  1. ;Forced Value
  1. I TYP="F" S DR="[PXRM EDIT FORCED VALUE]"
  1. ;Dialog Group (Finding item dialog)
  1. I TYP="G" S DR="[PXRM EDIT GROUP]" ;S VALMBCK="R"
  1. ;Result Group
  1. I TYP="S" S DR="[PXRM RESULT GROUP]"
  1. ;Result Element
  1. I TYP="T" S DR="[PXRM RESULT ELEMENT]"
  1. ;Allows limited edit of national dialogs
  1. I $P($G(^PXRMD(801.41,DA,100)),U)="N" D
  1. .I TYP="T",+$P($G(^PXMRD(801.41,DA,100)),U,4)=0 Q
  1. .I $G(PXRMINST)=1,DUZ(0)="@" Q
  1. .I TYP'="R" S DR="[PXRM EDIT NATIONAL DIALOG]",DINUSE=1 Q
  1. .S DR="[PXRM NATIONAL DIALOG EDIT]",DINUSE=1
  1. ;
  1. I "GEPFS"[TYP D
  1. .I '$D(^PXRMD(801.41,"AD",DA)),'$D(^PXRMD(801.41,"BLR",DA)),'$D(^PXRMD(801.41,"RG",DA)) W !,"Not used by any other dialog",! Q
  1. .I PXRMGTYP'="DLG" S DINUSE=1 Q
  1. .I PXRMGTYP="DLG" D Q
  1. ..N SUB
  1. ..S SUB=0
  1. ..F S SUB=$O(^PXRMD(801.41,"AD",DA,SUB)) Q:'SUB Q:DINUSE D
  1. ...I SUB'=PXRMDIEN S DINUSE=1
  1. ..I DINUSE=0,DA'=PXRMDIEN W !,"Used by: Only used in this dialog",!
  1. I DINUSE D
  1. .W !,"Current dialog "_$S(TYP="S":"result group",1:"element/group")_" name: "_$P($G(^PXRMD(801.41,DA,0)),U)
  1. .I TYP="S" W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN,"RG") Q
  1. .I PXRMGTYP="DLGE" D
  1. ..W !,"Used by:" D USE^PXRMDLST(DA,10,"","AD")
  1. ..I $D(^PXRMD(801.41,"BLR",DA))'>0 Q
  1. ..W !,"Used as a Replacement Element/Group for: " D USE^PXRMDLST(DA,10,"","BLR")
  1. .I PXRMGTYP'="DLGE" D
  1. ..W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN,"AD")
  1. ..I $D(^PXRMD(801.41,"BLR",DA))'>0 Q
  1. ..W !,"Used as a Replacement Element/Group for: " D USE^PXRMDLST(DA,10,PXRMDIEN,"BLR")
  1. ;
  1. ;Save list of components
  1. N COMP D COMP^PXRMDEDX(DA,.COMP)
  1. ;Edit dialog then unlock
  1. I TYP'="P" D ^DIE D UNLOCK(ODA) I $G(DA)="",$G(OIEN)>0 D
  1. .;S DA=OIEN,DR="118////@" D ^DIE K DA
  1. I TYP="P" D PROMPT(DA) D UNLOCK(ODA)
  1. ;I '$D(DUOUT)&($G(D1)'="") D Q
  1. I $G(D1)'="" D
  1. . I $P($G(^PXRMD(801.41,DA,10,D1,0)),U,2)="" D Q
  1. . . S DA(1)=DA,DA=D1 Q:'DA
  1. . . S DIK="^PXRMD(801.41,"_DA(1)_",10,"
  1. . . D ^DIK
  1. . . ;S VALMBG=1
  1. I $D(DUOUT) S VALMBG=1 Q
  1. I '$D(DA) D Q
  1. .;Clear any pointers from #811.9
  1. .I $D(PXRMDIEN) D PURGE(PXRMDIEN)
  1. .;Option to delete components
  1. .I $D(COMP) D DELETE^PXRMDEDX(.COMP)
  1. .S VALMBCK="R"
  1. ;
  1. I $D(DA) D
  1. .W !,"Checking reminder dialog for errors.." H 1
  1. .D WRITE^PXRMDLRP(ODA)
  1. ;Update edit history
  1. I (TYP'="R") D
  1. .S CS2=$$FILE^PXRMEXCS(801.41,DA) Q:CS2=CS1 Q:+CS2=0
  1. .S DIC="^PXRMD(801.41,"
  1. .D SEHIST^PXRMUTIL(801.41,DIC,DA)
  1. ;
  1. ;Redisplay changes (reminder dialog option only)
  1. I PXRMGTYP="DLG",TYP="R" D
  1. .;Get name of reminder dialog again
  1. .S Y=$P($G(^PXRMD(801.41,DA,0)),U)
  1. .;Format headings to include dialog name
  1. .S PXRMHD="REMINDER DIALOG NAME: "_$P(Y,U)
  1. .;Check if the set is disable and add to header if disabled
  1. .I $P(^PXRMD(801.41,DA,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)"
  1. .;Reset header in case name has changed
  1. .S VALMHDR(1)=PXRMHD
  1. Q
  1. ;
  1. ;Add SINGLE dialog element (protocol PXRM DIALOG SELECTION ITEM)
  1. ;-------------------------
  1. ESEL(PXRMDIEN,SEL) ;
  1. N DA,DIC,DLAYGO,DNEW,DTOUT,DUOUT,DTYP,Y
  1. ;
  1. S DIC="^PXRMD(801.41,"
  1. S DLAYGO="801.41"
  1. ;Set the starting place for additions.
  1. D SETSTART^PXRMCOPY(DIC)
  1. S DIC(0)="AEMQL"
  1. S DIC("A")="Select new DIALOG ELEMENT: "
  1. S DIC("S")="I ""EGPF""[$P(^PXRMD(801.41,Y,0),U,4)"
  1. S DIC("DR")="4///E"
  1. W !
  1. D ^DIC
  1. I $D(DUOUT) S DTOUT=1
  1. I ($D(DTOUT))!($D(DUOUT)) Q
  1. I Y=-1 K DIC S DTOUT=1 Q
  1. S DA=$P(Y,U,1) Q:'DA
  1. S DNEW=$P(Y,U,3)
  1. ;Group points to itself
  1. I 'DNEW,$$VGROUP(DA,PXRMDIEN) Q
  1. ;Add to dialog
  1. D EADD(SEL,DA,PXRMDIEN)
  1. ;Determine dialog type
  1. S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
  1. ;
  1. ;Edit Dialog
  1. I DNEW D EDIT(DTYP,DA)
  1. Q
  1. ;
  1. ;Update dialog component multiple
  1. ;--------------------------------
  1. EADD(SEL,NSUB,PXRMDIEN) ;
  1. N ERRMSG,FDAIEN,FDA,IENS
  1. S IENS="+2,"_PXRMDIEN_","
  1. S FDA(801.412,IENS,.01)=SEL
  1. S FDA(801.412,IENS,2)=NSUB
  1. D UPDATE^DIE("","FDA","FDAIEN","ERRMSG")
  1. I $D(ERRMSG) D AWRITE^PXRMUTIL("ERRMSG")
  1. Q
  1. ;
  1. ;Change Dialog Element Type
  1. ;--------------------------
  1. NTYP(TYP) ;
  1. N X,Y,DIR K DIROUT,DIRUT,DTOUT,DUOUT
  1. S DIR(0)="SA"_U_"E:Element;"
  1. S DIR(0)=DIR(0)_"G:Group;"
  1. S DIR("A")="Dialog Element Type: "
  1. S DIR("B")="E"
  1. S DIR("?")="Select from the codes displayed. For detailed help type ??"
  1. S DIR("??")=U_"D HELP^PXRMDEDT(3)"
  1. D ^DIR K DIR
  1. I $D(DIROUT) S DTOUT=1
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S TYP=Y
  1. Q
  1. ;
  1. ;Clear pointers from the reminder file and process ID file
  1. ;---------------------------------------------------------
  1. PURGE(DIEN) ;
  1. ;Purge pointers to this dialog from reminder file
  1. N RIEN
  1. S RIEN=0
  1. F S RIEN=$O(^PXD(811.9,"AG",DIEN,RIEN)) Q:'RIEN D
  1. .K ^PXD(811.9,RIEN,51),^PXD(811.9,"AG",DIEN,RIEN)
  1. ;
  1. Q
  1. ;
  1. VGROUP(DA,IEN) ;Check dialog index to see if group will point to itself
  1. N FOUND
  1. S FOUND=0
  1. ;
  1. ;Only do check if dialog is a group
  1. I $P($G(^PXRMD(801.41,DA,0)),U,4)'="G" Q FOUND
  1. ;
  1. ;Group cannot be added to itself
  1. I DA=IEN D Q FOUND
  1. .S FOUND=1
  1. .W !,"A group cannot be added to itself" H 2
  1. ;
  1. ;IEN is the dialog group being added to
  1. D VGROUP1(DA,IEN)
  1. Q FOUND
  1. ;
  1. VGROUP1(DA,DIEN) ;Examine all parent dialogs
  1. ;
  1. ;End search if already found
  1. Q:FOUND
  1. ;
  1. ;Check if dialog being added is a parent at this level
  1. I $D(^PXRMD(801.41,"AD",DIEN,DA)) D Q
  1. .S FOUND=1
  1. .W !,"A group cannot be added as it's own descendant" H 2
  1. ;
  1. ;If not look at other parents
  1. N SUB
  1. S SUB=0
  1. F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB D Q:FOUND
  1. .;Ignore reminder dialogs
  1. .I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q
  1. .;Repeat check on other parents
  1. .D VGROUP1(DA,SUB)
  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. I CALL=2 D
  1. .S HTEXT(1)="Enter Y to copy the current dialog element to a new name"
  1. .S HTEXT(2)="and then use this new element in the reminder dialog."
  1. I CALL=3 D
  1. .S HTEXT(1)="Enter G to change the current dialog element into a dialog"
  1. .S HTEXT(2)="group so that additional elements can be added. Enter E to"
  1. .S HTEXT(3)="leave the type of the dialog element unchanged."
  1. I CALL=4 D
  1. .S HTEXT(1)="Enter Y to change the dialog prompt created into a forced"
  1. .S HTEXT(2)="value. To edit the new forced value switch to the forced"
  1. .S HTEXT(3)="value screen using CV. This option only applies to prompts"
  1. .S HTEXT(4)="which update PCE or vitals."
  1. .S HTEXT(5)="Enter N to leave the dialog prompt unchanged."
  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
  1. ;
  1. LOCK(DA) ;Lock the record
  1. N OK
  1. S OK=1
  1. I '$$VEDIT^PXRMUTIL("^PXRMD(801.41,",DA) D
  1. .N DTYP
  1. .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
  1. .;Allow limit edit of Result Elements that are not lock
  1. .I DTYP="T",+$P($G(^PXRMD(801.41,DA,100)),U,4)=0 Q
  1. .;Allow edit of findings but not component multiple on groups
  1. .I DTYP="G",$G(PXRMDIEN),DA'=PXRMDIEN Q
  1. .I DTYP="G",$G(PXRMGTYP)="DLGE" Q
  1. .;Allow edit of element findings
  1. .I DTYP="E" Q
  1. .I DTYP="R",$$HASPRMPT^PXRMDLG6("GF_PRINT")>0 Q
  1. .S OK=0
  1. .W !!,?5,"VA- and national class reminder dialogs may not be edited" H 2
  1. I 'OK Q 0
  1. ;
  1. L +^PXRMD(801.41,DA):DILOCKTM I Q 1
  1. E W !!,?5,"Another user is editing this entry, try later." H 2 Q 0
  1. ;
  1. PROMPT(IEN) ;
  1. N DIE,DR
  1. S DIE="^PXRMD(801.41,",DA=IEN
  1. S DR=".01;3;100;101;102;24;23;21"
  1. S IEN=$G(^PXRMD(801.41,IEN,46)) I $G(IEN)="" G EX
  1. I $P($G(^PXRMD(801.42,IEN,0)),U)="COM" S DR=DR_";45"
  1. EX ;
  1. D ^DIE
  1. Q
  1. ;
  1. UNLOCK(DA) ;Unlock the record
  1. L -^PXRMD(801.41,DA)
  1. Q