- PXRMDEDT ;SLC/PJH - Edit PXRM reminder dialog. ;Jan 31, 2023@08:13:33
- ;;2.0;CLINICAL REMINDERS;**4,6,12,17,16,24,26,45,82**;Feb 04, 2005;Build 28
- ;
- ;Used by protocol PXRM SELECTION ADD/PXRM GENERAL ADD
- ;
- ;Add Dialog
- ;----------
- ADD N DA,DIC,Y,DTOUT,DUOUT,DTYP,DLAYGO,HED
- S HED="ADD DIALOG"
- W IORESET
- F D Q:$D(DTOUT)
- .S DIC="^PXRMD(801.41,"
- .;Set the starting place for additions.
- .D SETSTART^PXRMCOPY(DIC)
- .S DIC(0)="AELMQ",DLAYGO=801.41
- .S DIC("A")="Select DIALOG to add: "
- .S DIC("DR")="4///"_$G(PXRMDTYP)
- .D ^DIC
- .I $D(DUOUT) S DTOUT=1
- .I ($D(DTOUT))!($D(DUOUT)) Q
- .I Y=-1 K DIC S DTOUT=1 Q
- .I $P(Y,U,3)'=1 W !,"This dialog name already exists" Q
- .S DA=$P(Y,U,1)
- .;Determine dialog type
- .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
- .;Enter dialog type if a new entry
- .I DTYP="" D Q:$D(Y)
- ..N DIE,DR
- ..S DIE=801.41,DR=4
- ..D ^DIE
- .;
- .;Edit Dialog
- .D EDIT(DTYP,DA,0)
- Q
- ;
- EDITD(ROOT,IENN) ;
- N DA,DIE,DR,TYPE
- S TYPE=$P($G(^PXRMD(801.41,IENN,0)),U,4) I TYPE="" Q
- I "PF"[TYPE D
- .;Get original process ID
- .N SUB S SUB=$P($G(^PXRMD(801.41,IENO,46)),U)
- .;Update GUI process in 801.41
- .I SUB S DR="46///"_SUB,DIE=ROOT,DA=IENN D ^DIE
- .;check if a prompt
- .I $P(@(ROOT_IENN_",0)"),U,4)="P" D
- ..;Allow PXRM prompts to be changed into forced values
- ..N ANS,TEXT
- ..S TEXT="Change the new prompt into a forced value :"
- ..D ASK^PXRMDCPY(.ANS,TEXT,4,"N") Q:$D(DUOUT)!$D(DTOUT) Q:ANS'="Y"
- ..;Store the dialog type
- ..S DR="4///F",DIE=ROOT,DA=IENN
- ..D ^DIE
- .Q
- ;
- D EDIT(TYPE,IENN)
- Q
- ;called by protocol PXRM DIALOG EDIT
- ;-----------------------------------
- EDIT(TYP,DA,OIEN) ;
- Q:'$$LOCK(DA)
- W IORESET
- N CS1,CS2,D1,DIC,DIDEL,DIE,DIK,DR,DTOUT,DUOUT,DINUSE,TYP,ODA,Y
- ;Save checksum
- S VALMBCK=""
- S CS1=$$FILE^PXRMEXCS(801.41,DA)
- ;
- ;Check dialog type
- S TYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
- S DIE="^PXRMD(801.41,",DIDEL=801.41,DINUSE=0,ODA=DA
- ;Reminder Dialog
- I TYP="R" S DR="[PXRM EDIT REMINDER DIALOG]"
- ;Dialog Element
- I TYP="E" S DR="[PXRM EDIT ELEMENT]"
- ;Additional Prompt
- ;I TYP="P" S DR="[PXRM EDIT PROMPT]"
- ;Forced Value
- I TYP="F" S DR="[PXRM EDIT FORCED VALUE]"
- ;Dialog Group (Finding item dialog)
- I TYP="G" S DR="[PXRM EDIT GROUP]" ;S VALMBCK="R"
- ;Result Group
- I TYP="S" S DR="[PXRM RESULT GROUP]"
- ;Result Element
- I TYP="T" S DR="[PXRM RESULT ELEMENT]"
- ;Allows limited edit of national dialogs
- I $P($G(^PXRMD(801.41,DA,100)),U)="N" D
- .I TYP="T",+$P($G(^PXMRD(801.41,DA,100)),U,4)=0 Q
- .I $G(PXRMINST)=1,DUZ(0)="@" Q
- .I TYP'="R" S DR="[PXRM EDIT NATIONAL DIALOG]",DINUSE=1 Q
- .S DR="[PXRM NATIONAL DIALOG EDIT]",DINUSE=1
- ;
- I "GEPFS"[TYP D
- .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
- .I PXRMGTYP'="DLG" S DINUSE=1 Q
- .I PXRMGTYP="DLG" D Q
- ..N SUB
- ..S SUB=0
- ..F S SUB=$O(^PXRMD(801.41,"AD",DA,SUB)) Q:'SUB Q:DINUSE D
- ...I SUB'=PXRMDIEN S DINUSE=1
- ..I DINUSE=0,DA'=PXRMDIEN W !,"Used by: Only used in this dialog",!
- I DINUSE D
- .W !,"Current dialog "_$S(TYP="S":"result group",1:"element/group")_" name: "_$P($G(^PXRMD(801.41,DA,0)),U)
- .I TYP="S" W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN,"RG") Q
- .I PXRMGTYP="DLGE" D
- ..W !,"Used by:" D USE^PXRMDLST(DA,10,"","AD")
- ..I $D(^PXRMD(801.41,"BLR",DA))'>0 Q
- ..W !,"Used as a Replacement Element/Group for: " D USE^PXRMDLST(DA,10,"","BLR")
- .I PXRMGTYP'="DLGE" D
- ..W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN,"AD")
- ..I $D(^PXRMD(801.41,"BLR",DA))'>0 Q
- ..W !,"Used as a Replacement Element/Group for: " D USE^PXRMDLST(DA,10,PXRMDIEN,"BLR")
- ;
- ;Save list of components
- N COMP D COMP^PXRMDEDX(DA,.COMP)
- ;Edit dialog then unlock
- I TYP'="P" D ^DIE D UNLOCK(ODA) I $G(DA)="",$G(OIEN)>0 D
- .;S DA=OIEN,DR="118////@" D ^DIE K DA
- I TYP="P" D PROMPT(DA) D UNLOCK(ODA)
- ;I '$D(DUOUT)&($G(D1)'="") D Q
- I $G(D1)'="" D
- . I $P($G(^PXRMD(801.41,DA,10,D1,0)),U,2)="" D Q
- . . S DA(1)=DA,DA=D1 Q:'DA
- . . S DIK="^PXRMD(801.41,"_DA(1)_",10,"
- . . D ^DIK
- . . ;S VALMBG=1
- I $D(DUOUT) S VALMBG=1 Q
- I '$D(DA) D Q
- .;Clear any pointers from #811.9
- .I $D(PXRMDIEN) D PURGE(PXRMDIEN)
- .;Option to delete components
- .I $D(COMP) D DELETE^PXRMDEDX(.COMP)
- .S VALMBCK="R"
- ;
- I $D(DA) D
- .W !,"Checking reminder dialog for errors.." H 1
- .D WRITE^PXRMDLRP(ODA)
- ;Update edit history
- I (TYP'="R") D
- .S CS2=$$FILE^PXRMEXCS(801.41,DA) Q:CS2=CS1 Q:+CS2=0
- .S DIC="^PXRMD(801.41,"
- .D SEHIST^PXRMUTIL(801.41,DIC,DA)
- ;
- ;Redisplay changes (reminder dialog option only)
- I PXRMGTYP="DLG",TYP="R" D
- .;Get name of reminder dialog again
- .S Y=$P($G(^PXRMD(801.41,DA,0)),U)
- .;Format headings to include dialog name
- .S PXRMHD="REMINDER DIALOG NAME: "_$P(Y,U)
- .;Check if the set is disable and add to header if disabled
- .I $P(^PXRMD(801.41,DA,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)"
- .;Reset header in case name has changed
- .S VALMHDR(1)=PXRMHD
- Q
- ;
- ;Add SINGLE dialog element (protocol PXRM DIALOG SELECTION ITEM)
- ;-------------------------
- ESEL(PXRMDIEN,SEL) ;
- N DA,DIC,DLAYGO,DNEW,DTOUT,DUOUT,DTYP,Y
- ;
- S DIC="^PXRMD(801.41,"
- S DLAYGO="801.41"
- ;Set the starting place for additions.
- D SETSTART^PXRMCOPY(DIC)
- S DIC(0)="AEMQL"
- S DIC("A")="Select new DIALOG ELEMENT: "
- S DIC("S")="I ""EGPF""[$P(^PXRMD(801.41,Y,0),U,4)"
- S DIC("DR")="4///E"
- W !
- D ^DIC
- I $D(DUOUT) S DTOUT=1
- I ($D(DTOUT))!($D(DUOUT)) Q
- I Y=-1 K DIC S DTOUT=1 Q
- S DA=$P(Y,U,1) Q:'DA
- S DNEW=$P(Y,U,3)
- ;Group points to itself
- I 'DNEW,$$VGROUP(DA,PXRMDIEN) Q
- ;Add to dialog
- D EADD(SEL,DA,PXRMDIEN)
- ;Determine dialog type
- S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
- ;
- ;Edit Dialog
- I DNEW D EDIT(DTYP,DA)
- Q
- ;
- ;Update dialog component multiple
- ;--------------------------------
- EADD(SEL,NSUB,PXRMDIEN) ;
- N ERRMSG,FDAIEN,FDA,IENS
- S IENS="+2,"_PXRMDIEN_","
- S FDA(801.412,IENS,.01)=SEL
- S FDA(801.412,IENS,2)=NSUB
- D UPDATE^DIE("","FDA","FDAIEN","ERRMSG")
- I $D(ERRMSG) D AWRITE^PXRMUTIL("ERRMSG")
- Q
- ;
- ;Change Dialog Element Type
- ;--------------------------
- NTYP(TYP) ;
- N X,Y,DIR K DIROUT,DIRUT,DTOUT,DUOUT
- S DIR(0)="SA"_U_"E:Element;"
- S DIR(0)=DIR(0)_"G:Group;"
- S DIR("A")="Dialog Element Type: "
- S DIR("B")="E"
- S DIR("?")="Select from the codes displayed. For detailed help type ??"
- S DIR("??")=U_"D HELP^PXRMDEDT(3)"
- D ^DIR K DIR
- I $D(DIROUT) S DTOUT=1
- I $D(DTOUT)!($D(DUOUT)) Q
- S TYP=Y
- Q
- ;
- ;Clear pointers from the reminder file and process ID file
- ;---------------------------------------------------------
- PURGE(DIEN) ;
- ;Purge pointers to this dialog from reminder file
- N RIEN
- S RIEN=0
- F S RIEN=$O(^PXD(811.9,"AG",DIEN,RIEN)) Q:'RIEN D
- .K ^PXD(811.9,RIEN,51),^PXD(811.9,"AG",DIEN,RIEN)
- ;
- Q
- ;
- VGROUP(DA,IEN) ;Check dialog index to see if group will point to itself
- N FOUND
- S FOUND=0
- ;
- ;Only do check if dialog is a group
- I $P($G(^PXRMD(801.41,DA,0)),U,4)'="G" Q FOUND
- ;
- ;Group cannot be added to itself
- I DA=IEN D Q FOUND
- .S FOUND=1
- .W !,"A group cannot be added to itself" H 2
- ;
- ;IEN is the dialog group being added to
- D VGROUP1(DA,IEN)
- Q FOUND
- ;
- VGROUP1(DA,DIEN) ;Examine all parent dialogs
- ;
- ;End search if already found
- Q:FOUND
- ;
- ;Check if dialog being added is a parent at this level
- I $D(^PXRMD(801.41,"AD",DIEN,DA)) D Q
- .S FOUND=1
- .W !,"A group cannot be added as it's own descendant" H 2
- ;
- ;If not look at other parents
- N SUB
- S SUB=0
- F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB D Q:FOUND
- .;Ignore reminder dialogs
- .I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q
- .;Repeat check on other parents
- .D VGROUP1(DA,SUB)
- 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."
- I CALL=2 D
- .S HTEXT(1)="Enter Y to copy the current dialog element to a new name"
- .S HTEXT(2)="and then use this new element in the reminder dialog."
- I CALL=3 D
- .S HTEXT(1)="Enter G to change the current dialog element into a dialog"
- .S HTEXT(2)="group so that additional elements can be added. Enter E to"
- .S HTEXT(3)="leave the type of the dialog element unchanged."
- I CALL=4 D
- .S HTEXT(1)="Enter Y to change the dialog prompt created into a forced"
- .S HTEXT(2)="value. To edit the new forced value switch to the forced"
- .S HTEXT(3)="value screen using CV. This option only applies to prompts"
- .S HTEXT(4)="which update PCE or vitals."
- .S HTEXT(5)="Enter N to leave the dialog prompt unchanged."
- 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
- ;
- LOCK(DA) ;Lock the record
- N OK
- S OK=1
- I '$$VEDIT^PXRMUTIL("^PXRMD(801.41,",DA) D
- .N DTYP
- .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
- .;Allow limit edit of Result Elements that are not lock
- .I DTYP="T",+$P($G(^PXRMD(801.41,DA,100)),U,4)=0 Q
- .;Allow edit of findings but not component multiple on groups
- .I DTYP="G",$G(PXRMDIEN),DA'=PXRMDIEN Q
- .I DTYP="G",$G(PXRMGTYP)="DLGE" Q
- .;Allow edit of element findings
- .I DTYP="E" Q
- .I DTYP="R",$$HASPRMPT^PXRMDLG6("GF_PRINT")>0 Q
- .S OK=0
- .W !!,?5,"VA- and national class reminder dialogs may not be edited" H 2
- I 'OK Q 0
- ;
- L +^PXRMD(801.41,DA):DILOCKTM I Q 1
- E W !!,?5,"Another user is editing this entry, try later." H 2 Q 0
- ;
- PROMPT(IEN) ;
- N DIE,DR
- S DIE="^PXRMD(801.41,",DA=IEN
- S DR=".01;3;100;101;102;24;23;21"
- S IEN=$G(^PXRMD(801.41,IEN,46)) I $G(IEN)="" G EX
- I $P($G(^PXRMD(801.42,IEN,0)),U)="COM" S DR=DR_";45"
- EX ;
- D ^DIE
- Q
- ;
- UNLOCK(DA) ;Unlock the record
- L -^PXRMD(801.41,DA)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDEDT 10075 printed Jan 18, 2025@02:44:52 Page 2
- 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
- +2 ;
- +3 ;Used by protocol PXRM SELECTION ADD/PXRM GENERAL ADD
- +4 ;
- +5 ;Add Dialog
- +6 ;----------
- ADD NEW DA,DIC,Y,DTOUT,DUOUT,DTYP,DLAYGO,HED
- +1 SET HED="ADD DIALOG"
- +2 WRITE IORESET
- +3 FOR
- Begin DoDot:1
- +4 SET DIC="^PXRMD(801.41,"
- +5 ;Set the starting place for additions.
- +6 DO SETSTART^PXRMCOPY(DIC)
- +7 SET DIC(0)="AELMQ"
- SET DLAYGO=801.41
- +8 SET DIC("A")="Select DIALOG to add: "
- +9 SET DIC("DR")="4///"_$GET(PXRMDTYP)
- +10 DO ^DIC
- +11 IF $DATA(DUOUT)
- SET DTOUT=1
- +12 IF ($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- +13 IF Y=-1
- KILL DIC
- SET DTOUT=1
- QUIT
- +14 IF $PIECE(Y,U,3)'=1
- WRITE !,"This dialog name already exists"
- QUIT
- +15 SET DA=$PIECE(Y,U,1)
- +16 ;Determine dialog type
- +17 SET DTYP=$PIECE($GET(^PXRMD(801.41,DA,0)),U,4)
- +18 ;Enter dialog type if a new entry
- +19 IF DTYP=""
- Begin DoDot:2
- +20 NEW DIE,DR
- +21 SET DIE=801.41
- SET DR=4
- +22 DO ^DIE
- End DoDot:2
- if $DATA(Y)
- QUIT
- +23 ;
- +24 ;Edit Dialog
- +25 DO EDIT(DTYP,DA,0)
- End DoDot:1
- if $DATA(DTOUT)
- QUIT
- +26 QUIT
- +27 ;
- EDITD(ROOT,IENN) ;
- +1 NEW DA,DIE,DR,TYPE
- +2 SET TYPE=$PIECE($GET(^PXRMD(801.41,IENN,0)),U,4)
- IF TYPE=""
- QUIT
- +3 IF "PF"[TYPE
- Begin DoDot:1
- +4 ;Get original process ID
- +5 NEW SUB
- SET SUB=$PIECE($GET(^PXRMD(801.41,IENO,46)),U)
- +6 ;Update GUI process in 801.41
- +7 IF SUB
- SET DR="46///"_SUB
- SET DIE=ROOT
- SET DA=IENN
- DO ^DIE
- +8 ;check if a prompt
- +9 IF $PIECE(@(ROOT_IENN_",0)"),U,4)="P"
- Begin DoDot:2
- +10 ;Allow PXRM prompts to be changed into forced values
- +11 NEW ANS,TEXT
- +12 SET TEXT="Change the new prompt into a forced value :"
- +13 DO ASK^PXRMDCPY(.ANS,TEXT,4,"N")
- if $DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- if ANS'="Y"
- QUIT
- +14 ;Store the dialog type
- +15 SET DR="4///F"
- SET DIE=ROOT
- SET DA=IENN
- +16 DO ^DIE
- End DoDot:2
- +17 QUIT
- End DoDot:1
- +18 ;
- +19 DO EDIT(TYPE,IENN)
- +20 QUIT
- +21 ;called by protocol PXRM DIALOG EDIT
- +22 ;-----------------------------------
- EDIT(TYP,DA,OIEN) ;
- +1 if '$$LOCK(DA)
- QUIT
- +2 WRITE IORESET
- +3 NEW CS1,CS2,D1,DIC,DIDEL,DIE,DIK,DR,DTOUT,DUOUT,DINUSE,TYP,ODA,Y
- +4 ;Save checksum
- +5 SET VALMBCK=""
- +6 SET CS1=$$FILE^PXRMEXCS(801.41,DA)
- +7 ;
- +8 ;Check dialog type
- +9 SET TYP=$PIECE($GET(^PXRMD(801.41,DA,0)),U,4)
- +10 SET DIE="^PXRMD(801.41,"
- SET DIDEL=801.41
- SET DINUSE=0
- SET ODA=DA
- +11 ;Reminder Dialog
- +12 IF TYP="R"
- SET DR="[PXRM EDIT REMINDER DIALOG]"
- +13 ;Dialog Element
- +14 IF TYP="E"
- SET DR="[PXRM EDIT ELEMENT]"
- +15 ;Additional Prompt
- +16 ;I TYP="P" S DR="[PXRM EDIT PROMPT]"
- +17 ;Forced Value
- +18 IF TYP="F"
- SET DR="[PXRM EDIT FORCED VALUE]"
- +19 ;Dialog Group (Finding item dialog)
- +20 ;S VALMBCK="R"
- IF TYP="G"
- SET DR="[PXRM EDIT GROUP]"
- +21 ;Result Group
- +22 IF TYP="S"
- SET DR="[PXRM RESULT GROUP]"
- +23 ;Result Element
- +24 IF TYP="T"
- SET DR="[PXRM RESULT ELEMENT]"
- +25 ;Allows limited edit of national dialogs
- +26 IF $PIECE($GET(^PXRMD(801.41,DA,100)),U)="N"
- Begin DoDot:1
- +27 IF TYP="T"
- IF +$PIECE($GET(^PXMRD(801.41,DA,100)),U,4)=0
- QUIT
- +28 IF $GET(PXRMINST)=1
- IF DUZ(0)="@"
- QUIT
- +29 IF TYP'="R"
- SET DR="[PXRM EDIT NATIONAL DIALOG]"
- SET DINUSE=1
- QUIT
- +30 SET DR="[PXRM NATIONAL DIALOG EDIT]"
- SET DINUSE=1
- End DoDot:1
- +31 ;
- +32 IF "GEPFS"[TYP
- Begin DoDot:1
- +33 IF '$DATA(^PXRMD(801.41,"AD",DA))
- IF '$DATA(^PXRMD(801.41,"BLR",DA))
- IF '$DATA(^PXRMD(801.41,"RG",DA))
- WRITE !,"Not used by any other dialog",!
- QUIT
- +34 IF PXRMGTYP'="DLG"
- SET DINUSE=1
- QUIT
- +35 IF PXRMGTYP="DLG"
- Begin DoDot:2
- +36 NEW SUB
- +37 SET SUB=0
- +38 FOR
- SET SUB=$ORDER(^PXRMD(801.41,"AD",DA,SUB))
- if 'SUB
- QUIT
- if DINUSE
- QUIT
- Begin DoDot:3
- +39 IF SUB'=PXRMDIEN
- SET DINUSE=1
- End DoDot:3
- +40 IF DINUSE=0
- IF DA'=PXRMDIEN
- WRITE !,"Used by: Only used in this dialog",!
- End DoDot:2
- QUIT
- End DoDot:1
- +41 IF DINUSE
- Begin DoDot:1
- +42 WRITE !,"Current dialog "_$SELECT(TYP="S":"result group",1:"element/group")_" name: "_$PIECE($GET(^PXRMD(801.41,DA,0)),U)
- +43 IF TYP="S"
- WRITE !,"Used by:"
- DO USE^PXRMDLST(DA,10,PXRMDIEN,"RG")
- QUIT
- +44 IF PXRMGTYP="DLGE"
- Begin DoDot:2
- +45 WRITE !,"Used by:"
- DO USE^PXRMDLST(DA,10,"","AD")
- +46 IF $DATA(^PXRMD(801.41,"BLR",DA))'>0
- QUIT
- +47 WRITE !,"Used as a Replacement Element/Group for: "
- DO USE^PXRMDLST(DA,10,"","BLR")
- End DoDot:2
- +48 IF PXRMGTYP'="DLGE"
- Begin DoDot:2
- +49 WRITE !,"Used by:"
- DO USE^PXRMDLST(DA,10,PXRMDIEN,"AD")
- +50 IF $DATA(^PXRMD(801.41,"BLR",DA))'>0
- QUIT
- +51 WRITE !,"Used as a Replacement Element/Group for: "
- DO USE^PXRMDLST(DA,10,PXRMDIEN,"BLR")
- End DoDot:2
- End DoDot:1
- +52 ;
- +53 ;Save list of components
- +54 NEW COMP
- DO COMP^PXRMDEDX(DA,.COMP)
- +55 ;Edit dialog then unlock
- +56 IF TYP'="P"
- DO ^DIE
- DO UNLOCK(ODA)
- IF $GET(DA)=""
- IF $GET(OIEN)>0
- Begin DoDot:1
- +57 ;S DA=OIEN,DR="118////@" D ^DIE K DA
- End DoDot:1
- +58 IF TYP="P"
- DO PROMPT(DA)
- DO UNLOCK(ODA)
- +59 ;I '$D(DUOUT)&($G(D1)'="") D Q
- +60 IF $GET(D1)'=""
- Begin DoDot:1
- +61 IF $PIECE($GET(^PXRMD(801.41,DA,10,D1,0)),U,2)=""
- Begin DoDot:2
- +62 SET DA(1)=DA
- SET DA=D1
- if 'DA
- QUIT
- +63 SET DIK="^PXRMD(801.41,"_DA(1)_",10,"
- +64 DO ^DIK
- +65 ;S VALMBG=1
- End DoDot:2
- QUIT
- End DoDot:1
- +66 IF $DATA(DUOUT)
- SET VALMBG=1
- QUIT
- +67 IF '$DATA(DA)
- Begin DoDot:1
- +68 ;Clear any pointers from #811.9
- +69 IF $DATA(PXRMDIEN)
- DO PURGE(PXRMDIEN)
- +70 ;Option to delete components
- +71 IF $DATA(COMP)
- DO DELETE^PXRMDEDX(.COMP)
- +72 SET VALMBCK="R"
- End DoDot:1
- QUIT
- +73 ;
- +74 IF $DATA(DA)
- Begin DoDot:1
- +75 WRITE !,"Checking reminder dialog for errors.."
- HANG 1
- +76 DO WRITE^PXRMDLRP(ODA)
- End DoDot:1
- +77 ;Update edit history
- +78 IF (TYP'="R")
- Begin DoDot:1
- +79 SET CS2=$$FILE^PXRMEXCS(801.41,DA)
- if CS2=CS1
- QUIT
- if +CS2=0
- QUIT
- +80 SET DIC="^PXRMD(801.41,"
- +81 DO SEHIST^PXRMUTIL(801.41,DIC,DA)
- End DoDot:1
- +82 ;
- +83 ;Redisplay changes (reminder dialog option only)
- +84 IF PXRMGTYP="DLG"
- IF TYP="R"
- Begin DoDot:1
- +85 ;Get name of reminder dialog again
- +86 SET Y=$PIECE($GET(^PXRMD(801.41,DA,0)),U)
- +87 ;Format headings to include dialog name
- +88 SET PXRMHD="REMINDER DIALOG NAME: "_$PIECE(Y,U)
- +89 ;Check if the set is disable and add to header if disabled
- +90 IF $PIECE(^PXRMD(801.41,DA,0),U,3)]""
- SET PXRMHD=PXRMHD_" (DISABLED)"
- +91 ;Reset header in case name has changed
- +92 SET VALMHDR(1)=PXRMHD
- End DoDot:1
- +93 QUIT
- +94 ;
- +95 ;Add SINGLE dialog element (protocol PXRM DIALOG SELECTION ITEM)
- +96 ;-------------------------
- ESEL(PXRMDIEN,SEL) ;
- +1 NEW DA,DIC,DLAYGO,DNEW,DTOUT,DUOUT,DTYP,Y
- +2 ;
- +3 SET DIC="^PXRMD(801.41,"
- +4 SET DLAYGO="801.41"
- +5 ;Set the starting place for additions.
- +6 DO SETSTART^PXRMCOPY(DIC)
- +7 SET DIC(0)="AEMQL"
- +8 SET DIC("A")="Select new DIALOG ELEMENT: "
- +9 SET DIC("S")="I ""EGPF""[$P(^PXRMD(801.41,Y,0),U,4)"
- +10 SET DIC("DR")="4///E"
- +11 WRITE !
- +12 DO ^DIC
- +13 IF $DATA(DUOUT)
- SET DTOUT=1
- +14 IF ($DATA(DTOUT))!($DATA(DUOUT))
- QUIT
- +15 IF Y=-1
- KILL DIC
- SET DTOUT=1
- QUIT
- +16 SET DA=$PIECE(Y,U,1)
- if 'DA
- QUIT
- +17 SET DNEW=$PIECE(Y,U,3)
- +18 ;Group points to itself
- +19 IF 'DNEW
- IF $$VGROUP(DA,PXRMDIEN)
- QUIT
- +20 ;Add to dialog
- +21 DO EADD(SEL,DA,PXRMDIEN)
- +22 ;Determine dialog type
- +23 SET DTYP=$PIECE($GET(^PXRMD(801.41,DA,0)),U,4)
- +24 ;
- +25 ;Edit Dialog
- +26 IF DNEW
- DO EDIT(DTYP,DA)
- +27 QUIT
- +28 ;
- +29 ;Update dialog component multiple
- +30 ;--------------------------------
- EADD(SEL,NSUB,PXRMDIEN) ;
- +1 NEW ERRMSG,FDAIEN,FDA,IENS
- +2 SET IENS="+2,"_PXRMDIEN_","
- +3 SET FDA(801.412,IENS,.01)=SEL
- +4 SET FDA(801.412,IENS,2)=NSUB
- +5 DO UPDATE^DIE("","FDA","FDAIEN","ERRMSG")
- +6 IF $DATA(ERRMSG)
- DO AWRITE^PXRMUTIL("ERRMSG")
- +7 QUIT
- +8 ;
- +9 ;Change Dialog Element Type
- +10 ;--------------------------
- NTYP(TYP) ;
- +1 NEW X,Y,DIR
- KILL DIROUT,DIRUT,DTOUT,DUOUT
- +2 SET DIR(0)="SA"_U_"E:Element;"
- +3 SET DIR(0)=DIR(0)_"G:Group;"
- +4 SET DIR("A")="Dialog Element Type: "
- +5 SET DIR("B")="E"
- +6 SET DIR("?")="Select from the codes displayed. For detailed help type ??"
- +7 SET DIR("??")=U_"D HELP^PXRMDEDT(3)"
- +8 DO ^DIR
- KILL DIR
- +9 IF $DATA(DIROUT)
- SET DTOUT=1
- +10 IF $DATA(DTOUT)!($DATA(DUOUT))
- QUIT
- +11 SET TYP=Y
- +12 QUIT
- +13 ;
- +14 ;Clear pointers from the reminder file and process ID file
- +15 ;---------------------------------------------------------
- PURGE(DIEN) ;
- +1 ;Purge pointers to this dialog from reminder file
- +2 NEW RIEN
- +3 SET RIEN=0
- +4 FOR
- SET RIEN=$ORDER(^PXD(811.9,"AG",DIEN,RIEN))
- if 'RIEN
- QUIT
- Begin DoDot:1
- +5 KILL ^PXD(811.9,RIEN,51),^PXD(811.9,"AG",DIEN,RIEN)
- End DoDot:1
- +6 ;
- +7 QUIT
- +8 ;
- VGROUP(DA,IEN) ;Check dialog index to see if group will point to itself
- +1 NEW FOUND
- +2 SET FOUND=0
- +3 ;
- +4 ;Only do check if dialog is a group
- +5 IF $PIECE($GET(^PXRMD(801.41,DA,0)),U,4)'="G"
- QUIT FOUND
- +6 ;
- +7 ;Group cannot be added to itself
- +8 IF DA=IEN
- Begin DoDot:1
- +9 SET FOUND=1
- +10 WRITE !,"A group cannot be added to itself"
- HANG 2
- End DoDot:1
- QUIT FOUND
- +11 ;
- +12 ;IEN is the dialog group being added to
- +13 DO VGROUP1(DA,IEN)
- +14 QUIT FOUND
- +15 ;
- VGROUP1(DA,DIEN) ;Examine all parent dialogs
- +1 ;
- +2 ;End search if already found
- +3 if FOUND
- QUIT
- +4 ;
- +5 ;Check if dialog being added is a parent at this level
- +6 IF $DATA(^PXRMD(801.41,"AD",DIEN,DA))
- Begin DoDot:1
- +7 SET FOUND=1
- +8 WRITE !,"A group cannot be added as it's own descendant"
- HANG 2
- End DoDot:1
- QUIT
- +9 ;
- +10 ;If not look at other parents
- +11 NEW SUB
- +12 SET SUB=0
- +13 FOR
- SET SUB=$ORDER(^PXRMD(801.41,"AD",DIEN,SUB))
- if 'SUB
- QUIT
- Begin DoDot:1
- +14 ;Ignore reminder dialogs
- +15 IF $PIECE($GET(^PXRMD(801.41,SUB,0)),U,4)'="G"
- QUIT
- +16 ;Repeat check on other parents
- +17 DO VGROUP1(DA,SUB)
- End DoDot:1
- if FOUND
- QUIT
- +18 QUIT
- +19 ;
- 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 IF CALL=2
- Begin DoDot:1
- +11 SET HTEXT(1)="Enter Y to copy the current dialog element to a new name"
- +12 SET HTEXT(2)="and then use this new element in the reminder dialog."
- End DoDot:1
- +13 IF CALL=3
- Begin DoDot:1
- +14 SET HTEXT(1)="Enter G to change the current dialog element into a dialog"
- +15 SET HTEXT(2)="group so that additional elements can be added. Enter E to"
- +16 SET HTEXT(3)="leave the type of the dialog element unchanged."
- End DoDot:1
- +17 IF CALL=4
- Begin DoDot:1
- +18 SET HTEXT(1)="Enter Y to change the dialog prompt created into a forced"
- +19 SET HTEXT(2)="value. To edit the new forced value switch to the forced"
- +20 SET HTEXT(3)="value screen using CV. This option only applies to prompts"
- +21 SET HTEXT(4)="which update PCE or vitals."
- +22 SET HTEXT(5)="Enter N to leave the dialog prompt unchanged."
- End DoDot:1
- +23 KILL ^UTILITY($JOB,"W")
- +24 SET IC=""
- +25 FOR
- SET IC=$ORDER(HTEXT(IC))
- if IC=""
- QUIT
- Begin DoDot:1
- +26 SET X=HTEXT(IC)
- +27 DO ^DIWP
- End DoDot:1
- +28 WRITE !
- +29 SET IC=0
- +30 FOR
- SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))
- if IC=""
- QUIT
- Begin DoDot:1
- +31 WRITE !,^UTILITY($JOB,"W",0,IC,0)
- End DoDot:1
- +32 KILL ^UTILITY($JOB,"W")
- +33 WRITE !
- +34 QUIT
- +35 ;
- LOCK(DA) ;Lock the record
- +1 NEW OK
- +2 SET OK=1
- +3 IF '$$VEDIT^PXRMUTIL("^PXRMD(801.41,",DA)
- Begin DoDot:1
- +4 NEW DTYP
- +5 SET DTYP=$PIECE($GET(^PXRMD(801.41,DA,0)),U,4)
- +6 ;Allow limit edit of Result Elements that are not lock
- +7 IF DTYP="T"
- IF +$PIECE($GET(^PXRMD(801.41,DA,100)),U,4)=0
- QUIT
- +8 ;Allow edit of findings but not component multiple on groups
- +9 IF DTYP="G"
- IF $GET(PXRMDIEN)
- IF DA'=PXRMDIEN
- QUIT
- +10 IF DTYP="G"
- IF $GET(PXRMGTYP)="DLGE"
- QUIT
- +11 ;Allow edit of element findings
- +12 IF DTYP="E"
- QUIT
- +13 IF DTYP="R"
- IF $$HASPRMPT^PXRMDLG6("GF_PRINT")>0
- QUIT
- +14 SET OK=0
- +15 WRITE !!,?5,"VA- and national class reminder dialogs may not be edited"
- HANG 2
- End DoDot:1
- +16 IF 'OK
- QUIT 0
- +17 ;
- +18 LOCK +^PXRMD(801.41,DA):DILOCKTM
- IF $TEST
- QUIT 1
- +19 IF '$TEST
- WRITE !!,?5,"Another user is editing this entry, try later."
- HANG 2
- QUIT 0
- +20 ;
- PROMPT(IEN) ;
- +1 NEW DIE,DR
- +2 SET DIE="^PXRMD(801.41,"
- SET DA=IEN
- +3 SET DR=".01;3;100;101;102;24;23;21"
- +4 SET IEN=$GET(^PXRMD(801.41,IEN,46))
- IF $GET(IEN)=""
- GOTO EX
- +5 IF $PIECE($GET(^PXRMD(801.42,IEN,0)),U)="COM"
- SET DR=DR_";45"
- EX ;
- +1 DO ^DIE
- +2 QUIT
- +3 ;
- UNLOCK(DA) ;Unlock the record
- +1 LOCK -^PXRMD(801.41,DA)
- +2 QUIT