source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMDEDT.m@ 636

PXRMDEDT ; SLC/PJH - Edit PXRM reminder dialog. ;07/28/2006
 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
 ;
 ;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
 ;
 ;called by protocol PXRM DIALOG EDIT
 ;-----------------------------------
EDIT(TYP,DA,OIEN) ;
 Q:'$$LOCK(DA)
 W IORESET
 N CS1,CS2,D1,DIC,DIDEL,DIE,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 $G(PXRMINST)=1,DUZ(0)="@" Q
 .S DR="[PXRM EDIT NATIONAL DIALOG]",DINUSE=1
 ;
 I "GEPF"[TYP D
 .I '$D(^PXRMD(801.41,"AD",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 D
 .W !,"Current dialog element/group name: "_$P($G(^PXRMD(801.41,DA,0)),U)
 .I TYP="S" Q
 .I PXRMGTYP="DLGE" D
 ..W !,"Used by:" D USE^PXRMDLST(DA,10,"")
 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q
 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,"")
 .I PXRMGTYP'="DLGE" D
 ..W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN)
 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q
 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,PXRMDIEN)
 ;
 ;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 $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(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"
 ;
 ;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 ""EG""[$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 DA,DATA,NEXT
 S DATA=$G(^PXRMD(801.41,PXRMDIEN,10,0)),NEXT=$P(DATA,U,3)+1
 I DATA="" S DATA="^801.412IA"
 S DA=NSUB,DA(1)=PXRMDIEN
 S ^PXRMD(801.41,PXRMDIEN,10,NEXT,0)=SEL_U_DA_"^^^^^^^"
 ;Update next slot
 S $P(DATA,U,4)=$P(DATA,U,4)+1,$P(DATA,U,3)=NEXT
 S ^PXRMD(801.41,PXRMDIEN,10,0)=DATA
 ;Re-index
 N DIK,DA S DIK="^PXRMD(801.41,",DA=PXRMDIEN
 D IX^DIK
 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 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
 .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):0 I  Q 1
 E  W !!,?5,"Another user is editing this file, 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