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 Apr 09, 2024@20:53:34 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
