Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDEDT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDEDT.m
r613 r623 1 PXRMDEDT ; SLC/PJH - Edit PXRM reminder dialog. ;10/18/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;Used by protocol PXRM SELECTION ADD/PXRM GENERAL ADD 5 ; 6 ;Add Dialog 7 ;---------- 8 ADD N DA,DIC,Y,DTOUT,DUOUT,DTYP,DLAYGO,HED 9 S HED="ADD DIALOG" 10 W IORESET 11 F D Q:$D(DTOUT) 12 .S DIC="^PXRMD(801.41," 13 .;Set the starting place for additions. 14 .D SETSTART^PXRMCOPY(DIC) 15 .S DIC(0)="AELMQ",DLAYGO=801.41 16 .S DIC("A")="Select DIALOG to add: " 17 .S DIC("DR")="4///"_$G(PXRMDTYP) 18 .D ^DIC 19 .I $D(DUOUT) S DTOUT=1 20 .I ($D(DTOUT))!($D(DUOUT)) Q 21 .I Y=-1 K DIC S DTOUT=1 Q 22 .I $P(Y,U,3)'=1 W !,"This dialog name already exists" Q 23 .S DA=$P(Y,U,1) 24 .;Determine dialog type 25 .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 26 .;Enter dialog type if a new entry 27 .I DTYP="" D Q:$D(Y) 28 ..N DIE,DR 29 ..S DIE=801.41,DR=4 30 ..D ^DIE 31 .; 32 .;Edit Dialog 33 .D EDIT(DTYP,DA,0) 34 Q 35 ; 36 ;called by protocol PXRM DIALOG EDIT 37 ;----------------------------------- 38 EDIT(TYP,DA,OIEN) ; 39 Q:'$$LOCK(DA) 40 W IORESET 41 N CS1,CS2,D1,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,DINUSE,TYP,ODA,Y 42 ;Save checksum 43 S VALMBCK="" 44 S CS1=$$FILE^PXRMEXCS(801.41,DA) 45 ; 46 ;Check dialog type 47 S TYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 48 S DIE="^PXRMD(801.41,",DIDEL=801.41,DINUSE=0,ODA=DA 49 ;Reminder Dialog 50 I TYP="R" S DR="[PXRM EDIT REMINDER DIALOG]" 51 ;Dialog Element 52 I TYP="E" S DR="[PXRM EDIT ELEMENT]" 53 ;Additional Prompt 54 ;I TYP="P" S DR="[PXRM EDIT PROMPT]" 55 ;Forced Value 56 I TYP="F" S DR="[PXRM EDIT FORCED VALUE]" 57 ;Dialog Group (Finding item dialog) 58 I TYP="G" S DR="[PXRM EDIT GROUP]" ;S VALMBCK="R" 59 ;Result Group 60 I TYP="S" S DR="[PXRM RESULT GROUP]" 61 ;Result Element 62 I TYP="T" S DR="[PXRM RESULT ELEMENT]" 63 ;Allows limited edit of national dialogs 64 I $P($G(^PXRMD(801.41,DA,100)),U)="N" D 65 .I TYP="T",+$P($G(^PXMRD(801.41,DA,100)),U,4)=0 Q 66 .I $G(PXRMINST)=1,DUZ(0)="@" Q 67 .S DR="[PXRM EDIT NATIONAL DIALOG]",DINUSE=1 68 ; 69 I "GEPF"[TYP D 70 .I '$D(^PXRMD(801.41,"AD",DA)) W !,"Not used by any other dialog",! Q 71 .I PXRMGTYP'="DLG" S DINUSE=1 Q 72 .I PXRMGTYP="DLG" D Q 73 ..N SUB 74 ..S SUB=0 75 ..F S SUB=$O(^PXRMD(801.41,"AD",DA,SUB)) Q:'SUB Q:DINUSE D 76 ...I SUB'=PXRMDIEN S DINUSE=1 77 I DINUSE D 78 .W !,"Current dialog element/group name: "_$P($G(^PXRMD(801.41,DA,0)),U) 79 .I TYP="S" Q 80 .I PXRMGTYP="DLGE" D 81 ..W !,"Used by:" D USE^PXRMDLST(DA,10,"") 82 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q 83 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,"") 84 .I PXRMGTYP'="DLGE" D 85 ..W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN) 86 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q 87 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,PXRMDIEN) 88 ; 89 ;Save list of components 90 N COMP D COMP^PXRMDEDX(DA,.COMP) 91 ;Edit dialog then unlock 92 I TYP'="P" D ^DIE D UNLOCK(ODA) I $G(DA)="",$G(OIEN)>0 D 93 .S DA=OIEN,DR="118////@" D ^DIE K DA 94 I TYP="P" D PROMPT(DA) D UNLOCK(ODA) 95 I '$D(DUOUT)&($G(D1)'="") D Q 96 . I $P($G(^PXRMD(801.41,DA,10,D1,0)),U,2)="" D Q 97 . . S DA(1)=DA,DA=D1 Q:'DA 98 . . S DIK="^PXRMD(801.41,"_DA(1)_",10," 99 . . D ^DIK 100 . . S VALMBG=1 101 I '$D(DA) D Q 102 .;Clear any pointers from #811.9 103 .I $D(PXRMDIEN) D PURGE(PXRMDIEN) 104 .;Option to delete components 105 .I $D(COMP) D DELETE^PXRMDEDX(.COMP) 106 .S VALMBCK="R" 107 ; 108 ;Update edit history 109 I (TYP'="R") D 110 .S CS2=$$FILE^PXRMEXCS(801.41,DA) Q:CS2=CS1 Q:+CS2=0 111 .S DIC="^PXRMD(801.41," 112 .D SEHIST^PXRMUTIL(801.41,DIC,DA) 113 ; 114 ;Redisplay changes (reminder dialog option only) 115 I PXRMGTYP="DLG",TYP="R" D 116 .;Get name of reminder dialog again 117 .S Y=$P($G(^PXRMD(801.41,DA,0)),U) 118 .;Format headings to include dialog name 119 .S PXRMHD="REMINDER DIALOG NAME: "_$P(Y,U) 120 .;Check if the set is disable and add to header if disabled 121 .I $P(^PXRMD(801.41,DA,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)" 122 .;Reset header in case name has changed 123 .S VALMHDR(1)=PXRMHD 124 Q 125 ; 126 ;Add SINGLE dialog element (protocol PXRM DIALOG SELECTION ITEM) 127 ;------------------------- 128 ESEL(PXRMDIEN,SEL) ; 129 N DA,DIC,DLAYGO,DNEW,DTOUT,DUOUT,DTYP,Y 130 ; 131 S DIC="^PXRMD(801.41," 132 S DLAYGO="801.41" 133 ;Set the starting place for additions. 134 D SETSTART^PXRMCOPY(DIC) 135 S DIC(0)="AEMQL" 136 S DIC("A")="Select new DIALOG ELEMENT: " 137 S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)" 138 S DIC("DR")="4///E" 139 W ! 140 D ^DIC 141 I $D(DUOUT) S DTOUT=1 142 I ($D(DTOUT))!($D(DUOUT)) Q 143 I Y=-1 K DIC S DTOUT=1 Q 144 S DA=$P(Y,U,1) Q:'DA 145 S DNEW=$P(Y,U,3) 146 ;Group points to itself 147 I 'DNEW,$$VGROUP(DA,PXRMDIEN) Q 148 ;Add to dialog 149 D EADD(SEL,DA,PXRMDIEN) 150 ;Determine dialog type 151 S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 152 ; 153 ;Edit Dialog 154 I DNEW D EDIT(DTYP,DA) 155 Q 156 ; 157 ;Update dialog component multiple 158 ;-------------------------------- 159 EADD(SEL,NSUB,PXRMDIEN) ; 160 N DA,DATA,NEXT 161 S DATA=$G(^PXRMD(801.41,PXRMDIEN,10,0)),NEXT=$P(DATA,U,3)+1 162 I DATA="" S DATA="^801.412IA" 163 S DA=NSUB,DA(1)=PXRMDIEN 164 S ^PXRMD(801.41,PXRMDIEN,10,NEXT,0)=SEL_U_DA_"^^^^^^^" 165 ;Update next slot 166 S $P(DATA,U,4)=$P(DATA,U,4)+1,$P(DATA,U,3)=NEXT 167 S ^PXRMD(801.41,PXRMDIEN,10,0)=DATA 168 ;Re-index 169 N DIK,DA S DIK="^PXRMD(801.41,",DA=PXRMDIEN 170 D IX^DIK 171 Q 172 ; 173 ;Change Dialog Element Type 174 ;-------------------------- 175 NTYP(TYP) ; 176 N X,Y,DIR K DIROUT,DIRUT,DTOUT,DUOUT 177 S DIR(0)="SA"_U_"E:Element;" 178 S DIR(0)=DIR(0)_"G:Group;" 179 S DIR("A")="Dialog Element Type: " 180 S DIR("B")="E" 181 S DIR("?")="Select from the codes displayed. For detailed help type ??" 182 S DIR("??")=U_"D HELP^PXRMDEDT(3)" 183 D ^DIR K DIR 184 I $D(DIROUT) S DTOUT=1 185 I $D(DTOUT)!($D(DUOUT)) Q 186 S TYP=Y 187 Q 188 ; 189 ;Clear pointers from the reminder file and process ID file 190 ;--------------------------------------------------------- 191 PURGE(DIEN) ; 192 ;Purge pointers to this dialog from reminder file 193 N RIEN 194 S RIEN=0 195 F S RIEN=$O(^PXD(811.9,"AG",DIEN,RIEN)) Q:'RIEN D 196 .K ^PXD(811.9,RIEN,51),^PXD(811.9,"AG",DIEN,RIEN) 197 ; 198 Q 199 ; 200 VGROUP(DA,IEN) ;Check dialog index to see if group will point to itself 201 N FOUND 202 S FOUND=0 203 ; 204 ;Only do check if dialog is a group 205 I $P($G(^PXRMD(801.41,DA,0)),U,4)'="G" Q FOUND 206 ; 207 ;Group cannot be added to itself 208 I DA=IEN D Q FOUND 209 .S FOUND=1 210 .W !,"A group cannot be added to itself" H 2 211 ; 212 ;IEN is the dialog group being added to 213 D VGROUP1(DA,IEN) 214 Q FOUND 215 ; 216 VGROUP1(DA,DIEN) ;Examine all parent dialogs 217 ; 218 ;End search if already found 219 Q:FOUND 220 ; 221 ;Check if dialog being added is a parent at this level 222 I $D(^PXRMD(801.41,"AD",DIEN,DA)) D Q 223 .S FOUND=1 224 .W !,"A group cannot be added as it's own descendant" H 2 225 ; 226 ;If not look at other parents 227 N SUB 228 S SUB=0 229 F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB D Q:FOUND 230 .;Ignore reminder dialogs 231 .I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q 232 .;Repeat check on other parents 233 .D VGROUP1(DA,SUB) 234 Q 235 ; 236 HELP(CALL) ;General help text routine 237 N HTEXT 238 N DIWF,DIWL,DIWR,IC 239 S DIWF="C70",DIWL=0,DIWR=70 240 ; 241 I CALL=1 D 242 .S HTEXT(1)="Select E to edit dialog element. If you wish to create" 243 .S HTEXT(2)="a new dialog element just for this reminder dialog select" 244 .S HTEXT(3)="C to copy and replace the current element. Select D to" 245 .S HTEXT(4)="delete the sequence number/element from the dialog." 246 I CALL=2 D 247 .S HTEXT(1)="Enter Y to copy the current dialog element to a new name" 248 .S HTEXT(2)="and then use this new element in the reminder dialog." 249 I CALL=3 D 250 .S HTEXT(1)="Enter G to change the current dialog element into a dialog" 251 .S HTEXT(2)="group so that additional elements can be added. Enter E to" 252 .S HTEXT(3)="leave the type of the dialog element unchanged." 253 I CALL=4 D 254 .S HTEXT(1)="Enter Y to change the dialog prompt created into a forced" 255 .S HTEXT(2)="value. To edit the new forced value switch to the forced" 256 .S HTEXT(3)="value screen using CV. This option only applies to prompts" 257 .S HTEXT(4)="which update PCE or vitals." 258 .S HTEXT(5)="Enter N to leave the dialog prompt unchanged." 259 K ^UTILITY($J,"W") 260 S IC="" 261 F S IC=$O(HTEXT(IC)) Q:IC="" D 262 . S X=HTEXT(IC) 263 . D ^DIWP 264 W ! 265 S IC=0 266 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 267 . W !,^UTILITY($J,"W",0,IC,0) 268 K ^UTILITY($J,"W") 269 W ! 270 Q 271 ; 272 LOCK(DA) ;Lock the record 273 N OK 274 S OK=1 275 I '$$VEDIT^PXRMUTIL("^PXRMD(801.41,",DA) D 276 .N DTYP 277 .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 278 .;Allow limit edit of Result Elements that are not lock 279 .I DTYP="T",+$P($G(^PXRMD(801.41,DA,100)),U,4)=0 Q 280 .;Allow edit of findings but not component multiple on groups 281 .I DTYP="G",$G(PXRMDIEN),DA'=PXRMDIEN Q 282 .I DTYP="G",$G(PXRMGTYP)="DLGE" Q 283 .;Allow edit of element findings 284 .I DTYP="E" Q 285 .S OK=0 286 .W !!,?5,"VA- and national class reminder dialogs may not be edited" H 2 287 I 'OK Q 0 288 ; 289 L +^PXRMD(801.41,DA):0 I Q 1 290 E W !!,?5,"Another user is editing this file, try later" H 2 Q 0 291 ; 292 PROMPT(IEN) ; 293 N DIE,DR 294 S DIE="^PXRMD(801.41,",DA=IEN 295 S DR=".01;3;100;101;102;24;23;21" 296 S IEN=$G(^PXRMD(801.41,IEN,46)) I $G(IEN)="" G EX 297 I $P($G(^PXRMD(801.42,IEN,0)),U)="COM" S DR=DR_";45" 298 EX ; 299 D ^DIE 300 Q 301 ; 302 UNLOCK(DA) ;Unlock the record 303 L -^PXRMD(801.41,DA) 304 Q 1 PXRMDEDT ; SLC/PJH - Edit PXRM reminder dialog. ;07/28/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;Used by protocol PXRM SELECTION ADD/PXRM GENERAL ADD 5 ; 6 ;Add Dialog 7 ;---------- 8 ADD N DA,DIC,Y,DTOUT,DUOUT,DTYP,DLAYGO,HED 9 S HED="ADD DIALOG" 10 W IORESET 11 F D Q:$D(DTOUT) 12 .S DIC="^PXRMD(801.41," 13 .;Set the starting place for additions. 14 .D SETSTART^PXRMCOPY(DIC) 15 .S DIC(0)="AELMQ",DLAYGO=801.41 16 .S DIC("A")="Select DIALOG to add: " 17 .S DIC("DR")="4///"_$G(PXRMDTYP) 18 .D ^DIC 19 .I $D(DUOUT) S DTOUT=1 20 .I ($D(DTOUT))!($D(DUOUT)) Q 21 .I Y=-1 K DIC S DTOUT=1 Q 22 .I $P(Y,U,3)'=1 W !,"This dialog name already exists" Q 23 .S DA=$P(Y,U,1) 24 .;Determine dialog type 25 .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 26 .;Enter dialog type if a new entry 27 .I DTYP="" D Q:$D(Y) 28 ..N DIE,DR 29 ..S DIE=801.41,DR=4 30 ..D ^DIE 31 .; 32 .;Edit Dialog 33 .D EDIT(DTYP,DA,0) 34 Q 35 ; 36 ;called by protocol PXRM DIALOG EDIT 37 ;----------------------------------- 38 EDIT(TYP,DA,OIEN) ; 39 Q:'$$LOCK(DA) 40 W IORESET 41 N CS1,CS2,D1,DIC,DIDEL,DIE,DR,DTOUT,DUOUT,DINUSE,TYP,ODA,Y 42 ;Save checksum 43 S VALMBCK="" 44 S CS1=$$FILE^PXRMEXCS(801.41,DA) 45 ; 46 ;Check dialog type 47 S TYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 48 S DIE="^PXRMD(801.41,",DIDEL=801.41,DINUSE=0,ODA=DA 49 ;Reminder Dialog 50 I TYP="R" S DR="[PXRM EDIT REMINDER DIALOG]" 51 ;Dialog Element 52 I TYP="E" S DR="[PXRM EDIT ELEMENT]" 53 ;Additional Prompt 54 ;I TYP="P" S DR="[PXRM EDIT PROMPT]" 55 ;Forced Value 56 I TYP="F" S DR="[PXRM EDIT FORCED VALUE]" 57 ;Dialog Group (Finding item dialog) 58 I TYP="G" S DR="[PXRM EDIT GROUP]" ;S VALMBCK="R" 59 ;Result Group 60 I TYP="S" S DR="[PXRM RESULT GROUP]" 61 ;Result Element 62 I TYP="T" S DR="[PXRM RESULT ELEMENT]" 63 ;Allows limited edit of national dialogs 64 I $P($G(^PXRMD(801.41,DA,100)),U)="N" D 65 .I $G(PXRMINST)=1,DUZ(0)="@" Q 66 .S DR="[PXRM EDIT NATIONAL DIALOG]",DINUSE=1 67 ; 68 I "GEPF"[TYP D 69 .I '$D(^PXRMD(801.41,"AD",DA)) W !,"Not used by any other dialog",! Q 70 .I PXRMGTYP'="DLG" S DINUSE=1 Q 71 .I PXRMGTYP="DLG" D Q 72 ..N SUB 73 ..S SUB=0 74 ..F S SUB=$O(^PXRMD(801.41,"AD",DA,SUB)) Q:'SUB Q:DINUSE D 75 ...I SUB'=PXRMDIEN S DINUSE=1 76 I DINUSE D 77 .W !,"Current dialog element/group name: "_$P($G(^PXRMD(801.41,DA,0)),U) 78 .I TYP="S" Q 79 .I PXRMGTYP="DLGE" D 80 ..W !,"Used by:" D USE^PXRMDLST(DA,10,"") 81 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q 82 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,"") 83 .I PXRMGTYP'="DLGE" D 84 ..W !,"Used by:" D USE^PXRMDLST(DA,10,PXRMDIEN) 85 ..I $D(^PXRMD(801.41,"R",DA))'>0 Q 86 ..W !,"Used as a Replacement Element/Group for: " D REPLACE^PXRMDLST(DA,10,PXRMDIEN) 87 ; 88 ;Save list of components 89 N COMP D COMP^PXRMDEDX(DA,.COMP) 90 ;Edit dialog then unlock 91 I TYP'="P" D ^DIE D UNLOCK(ODA) I $G(DA)="",$G(OIEN)>0 D 92 .S DA=OIEN,DR="118////@" D ^DIE K DA 93 I TYP="P" D PROMPT(DA) D UNLOCK(ODA) 94 I '$D(DUOUT)&($G(D1)'="") D Q 95 . I $P($G(^PXRMD(801.41,DA,10,D1,0)),U,2)="" D Q 96 . . S DA(1)=DA,DA=D1 Q:'DA 97 . . S DIK="^PXRMD(801.41,"_DA(1)_",10," 98 . . D ^DIK 99 . . S VALMBG=1 100 I '$D(DA) D Q 101 .;Clear any pointers from #811.9 102 .I $D(PXRMDIEN) D PURGE(PXRMDIEN) 103 .;Option to delete components 104 .I $D(COMP) D DELETE^PXRMDEDX(.COMP) 105 .S VALMBCK="R" 106 ; 107 ;Update edit history 108 I (TYP'="R") D 109 .S CS2=$$FILE^PXRMEXCS(801.41,DA) Q:CS2=CS1 Q:+CS2=0 110 .S DIC="^PXRMD(801.41," 111 .D SEHIST^PXRMUTIL(801.41,DIC,DA) 112 ; 113 ;Redisplay changes (reminder dialog option only) 114 I PXRMGTYP="DLG",TYP="R" D 115 .;Get name of reminder dialog again 116 .S Y=$P($G(^PXRMD(801.41,DA,0)),U) 117 .;Format headings to include dialog name 118 .S PXRMHD="REMINDER DIALOG NAME: "_$P(Y,U) 119 .;Check if the set is disable and add to header if disabled 120 .I $P(^PXRMD(801.41,DA,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)" 121 .;Reset header in case name has changed 122 .S VALMHDR(1)=PXRMHD 123 Q 124 ; 125 ;Add SINGLE dialog element (protocol PXRM DIALOG SELECTION ITEM) 126 ;------------------------- 127 ESEL(PXRMDIEN,SEL) ; 128 N DA,DIC,DLAYGO,DNEW,DTOUT,DUOUT,DTYP,Y 129 ; 130 S DIC="^PXRMD(801.41," 131 S DLAYGO="801.41" 132 ;Set the starting place for additions. 133 D SETSTART^PXRMCOPY(DIC) 134 S DIC(0)="AEMQL" 135 S DIC("A")="Select new DIALOG ELEMENT: " 136 S DIC("S")="I ""EG""[$P(^PXRMD(801.41,Y,0),U,4)" 137 S DIC("DR")="4///E" 138 W ! 139 D ^DIC 140 I $D(DUOUT) S DTOUT=1 141 I ($D(DTOUT))!($D(DUOUT)) Q 142 I Y=-1 K DIC S DTOUT=1 Q 143 S DA=$P(Y,U,1) Q:'DA 144 S DNEW=$P(Y,U,3) 145 ;Group points to itself 146 I 'DNEW,$$VGROUP(DA,PXRMDIEN) Q 147 ;Add to dialog 148 D EADD(SEL,DA,PXRMDIEN) 149 ;Determine dialog type 150 S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 151 ; 152 ;Edit Dialog 153 I DNEW D EDIT(DTYP,DA) 154 Q 155 ; 156 ;Update dialog component multiple 157 ;-------------------------------- 158 EADD(SEL,NSUB,PXRMDIEN) ; 159 N DA,DATA,NEXT 160 S DATA=$G(^PXRMD(801.41,PXRMDIEN,10,0)),NEXT=$P(DATA,U,3)+1 161 I DATA="" S DATA="^801.412IA" 162 S DA=NSUB,DA(1)=PXRMDIEN 163 S ^PXRMD(801.41,PXRMDIEN,10,NEXT,0)=SEL_U_DA_"^^^^^^^" 164 ;Update next slot 165 S $P(DATA,U,4)=$P(DATA,U,4)+1,$P(DATA,U,3)=NEXT 166 S ^PXRMD(801.41,PXRMDIEN,10,0)=DATA 167 ;Re-index 168 N DIK,DA S DIK="^PXRMD(801.41,",DA=PXRMDIEN 169 D IX^DIK 170 Q 171 ; 172 ;Change Dialog Element Type 173 ;-------------------------- 174 NTYP(TYP) ; 175 N X,Y,DIR K DIROUT,DIRUT,DTOUT,DUOUT 176 S DIR(0)="SA"_U_"E:Element;" 177 S DIR(0)=DIR(0)_"G:Group;" 178 S DIR("A")="Dialog Element Type: " 179 S DIR("B")="E" 180 S DIR("?")="Select from the codes displayed. For detailed help type ??" 181 S DIR("??")=U_"D HELP^PXRMDEDT(3)" 182 D ^DIR K DIR 183 I $D(DIROUT) S DTOUT=1 184 I $D(DTOUT)!($D(DUOUT)) Q 185 S TYP=Y 186 Q 187 ; 188 ;Clear pointers from the reminder file and process ID file 189 ;--------------------------------------------------------- 190 PURGE(DIEN) ; 191 ;Purge pointers to this dialog from reminder file 192 N RIEN 193 S RIEN=0 194 F S RIEN=$O(^PXD(811.9,"AG",DIEN,RIEN)) Q:'RIEN D 195 .K ^PXD(811.9,RIEN,51),^PXD(811.9,"AG",DIEN,RIEN) 196 ; 197 Q 198 ; 199 VGROUP(DA,IEN) ;Check dialog index to see if group will point to itself 200 N FOUND 201 S FOUND=0 202 ; 203 ;Only do check if dialog is a group 204 I $P($G(^PXRMD(801.41,DA,0)),U,4)'="G" Q FOUND 205 ; 206 ;Group cannot be added to itself 207 I DA=IEN D Q FOUND 208 .S FOUND=1 209 .W !,"A group cannot be added to itself" H 2 210 ; 211 ;IEN is the dialog group being added to 212 D VGROUP1(DA,IEN) 213 Q FOUND 214 ; 215 VGROUP1(DA,DIEN) ;Examine all parent dialogs 216 ; 217 ;End search if already found 218 Q:FOUND 219 ; 220 ;Check if dialog being added is a parent at this level 221 I $D(^PXRMD(801.41,"AD",DIEN,DA)) D Q 222 .S FOUND=1 223 .W !,"A group cannot be added as it's own descendant" H 2 224 ; 225 ;If not look at other parents 226 N SUB 227 S SUB=0 228 F S SUB=$O(^PXRMD(801.41,"AD",DIEN,SUB)) Q:'SUB D Q:FOUND 229 .;Ignore reminder dialogs 230 .I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q 231 .;Repeat check on other parents 232 .D VGROUP1(DA,SUB) 233 Q 234 ; 235 HELP(CALL) ;General help text routine 236 N HTEXT 237 N DIWF,DIWL,DIWR,IC 238 S DIWF="C70",DIWL=0,DIWR=70 239 ; 240 I CALL=1 D 241 .S HTEXT(1)="Select E to edit dialog element. If you wish to create" 242 .S HTEXT(2)="a new dialog element just for this reminder dialog select" 243 .S HTEXT(3)="C to copy and replace the current element. Select D to" 244 .S HTEXT(4)="delete the sequence number/element from the dialog." 245 I CALL=2 D 246 .S HTEXT(1)="Enter Y to copy the current dialog element to a new name" 247 .S HTEXT(2)="and then use this new element in the reminder dialog." 248 I CALL=3 D 249 .S HTEXT(1)="Enter G to change the current dialog element into a dialog" 250 .S HTEXT(2)="group so that additional elements can be added. Enter E to" 251 .S HTEXT(3)="leave the type of the dialog element unchanged." 252 I CALL=4 D 253 .S HTEXT(1)="Enter Y to change the dialog prompt created into a forced" 254 .S HTEXT(2)="value. To edit the new forced value switch to the forced" 255 .S HTEXT(3)="value screen using CV. This option only applies to prompts" 256 .S HTEXT(4)="which update PCE or vitals." 257 .S HTEXT(5)="Enter N to leave the dialog prompt unchanged." 258 K ^UTILITY($J,"W") 259 S IC="" 260 F S IC=$O(HTEXT(IC)) Q:IC="" D 261 . S X=HTEXT(IC) 262 . D ^DIWP 263 W ! 264 S IC=0 265 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 266 . W !,^UTILITY($J,"W",0,IC,0) 267 K ^UTILITY($J,"W") 268 W ! 269 Q 270 ; 271 LOCK(DA) ;Lock the record 272 N OK 273 S OK=1 274 I '$$VEDIT^PXRMUTIL("^PXRMD(801.41,",DA) D 275 .N DTYP 276 .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4) 277 .;Allow edit of findings but not component multiple on groups 278 .I DTYP="G",$G(PXRMDIEN),DA'=PXRMDIEN Q 279 .I DTYP="G",$G(PXRMGTYP)="DLGE" Q 280 .;Allow edit of element findings 281 .I DTYP="E" Q 282 .S OK=0 283 .W !!,?5,"VA- and national class reminder dialogs may not be edited" H 2 284 I 'OK Q 0 285 ; 286 L +^PXRMD(801.41,DA):0 I Q 1 287 E W !!,?5,"Another user is editing this file, try later" H 2 Q 0 288 ; 289 PROMPT(IEN) ; 290 N DIE,DR 291 S DIE="^PXRMD(801.41,",DA=IEN 292 S DR=".01;3;100;101;102;24;23;21" 293 S IEN=$G(^PXRMD(801.41,IEN,46)) I $G(IEN)="" G EX 294 I $P($G(^PXRMD(801.42,IEN,0)),U)="COM" S DR=DR_";45" 295 EX ; 296 D ^DIE 297 Q 298 ; 299 UNLOCK(DA) ;Unlock the record 300 L -^PXRMD(801.41,DA) 301 Q
Note:
See TracChangeset
for help on using the changeset viewer.
