Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLGZ.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/PXRMDLGZ.m
r613 r623 1 PXRMDLGZ ; SLC/PJH - Link reminder to dialog. ;01/11/2007 2 ;;2.0;CLINICAL REMINDERS;**4,6**;Feb 04, 2005;Build 123 3 ; 4 ;Called by option PXRM DIALOG/COMPONENT EDIT 5 ; 6 START N BY,DATA,DDES,DHD,DIC,DNAM,DTYP,FLDS,FR,L,LOGIC,NOW,PNAM,TO,Y 7 N PXRMBG,PXRMHD,PXRMDIEN,PXRMGTYP,PXRMDTYP,PXRMITEM,PXRMMODE,PXRMNAME 8 N PXRMTEMP,PXRMTITL,PXRMVIEW 9 ;Refresh on return 10 S VALMBCK="R" 11 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 12 ;Default is display dialog elements 13 S PXRMDTYP="R",PXRMGTYP="DLGR",PXRMVIEW="AN" 14 ;Select dialog for display 15 F D Q:'PXRMTEMP 16 .S PXRMTEMP="" 17 .D START^PXRMSEL(.PXRMHD,.PXRMGTYP,"PXRMTEMP") Q:'PXRMTEMP 18 .N X S X="IORESET" 19 .D ENDR^%ZISS,@(PXRMGTYP_"("_PXRMTEMP_")") 20 END Q 21 ; 22 ;Reminder View 23 ;------------- 24 DLGR(PXRMITEM) ; 25 N PXRMDIEN,PXRMCS1,PXRMCS2 26 ;Format headings to include reminder and name 27 S DATA=$G(^PXD(811.9,PXRMITEM,0)),RNAM=$P(DATA,U),PNAM=$P(DATA,U,3) 28 S PXRMHD="REMINDER NAME: "_RNAM 29 ; 30 ;Dialog History 31 F D Q:'PXRMDIEN 32 .D START^PXRMDLGH(PXRMITEM,.PXRMDIEN,"PXRMDIEN") Q:'PXRMDIEN 33 .N PXRMHD,VALMBCK,VALMBG,VALMSG,VIEW,X,XMZ 34 .S DNAM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U) 35 .I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)]"" S DNAM=DNAM_" (DISABLED)" 36 .S PXRMHD="REMINDER DIALOG NAME: "_DNAM 37 .S PXRMCS1=$$FILE^PXRMEXCS(801.41,PXRMDIEN) 38 .S X="IORESET" 39 .D ENDR^%ZISS,EN^VALM("PXRM DIALOG LIST") 40 .I PXRMDIEN,$D(^PXRMD(801.41,PXRMDIEN,0)) D 41 ..S PXRMCS2=$$FILE^PXRMEXCS(801.41,PXRMDIEN) Q:+PXRMCS2=0 42 ..Q:PXRMCS1=PXRMCS2 43 ..D SEHIST^PXRMUTIL(801.41,"^PXRMD(801,41,",PXRMDIEN) 44 .W IORESET 45 .D KILL^%ZISS 46 Q 47 ; 48 ;Edit element/prompt/group 49 ;------------------------- 50 DLGE(PXRMDIEN) ; 51 N LOCK,LFIND 52 ;Check for Uneditable flag 53 S LOCK=$P($G(^PXRMD(801.41,PXRMTEMP,100)),U,4) 54 S LFIND=$P($G(^PXRMD(801.41,PXRMTEMP,1)),U,5) 55 I LOCK=1,$G(LFIND)'="",$G(LFIND)'["ORD",'$G(PXRMINST) D Q 56 .W !,"This item can not be edited" H 2 57 ; 58 S PXRMHD="Dialog Name: ",PXRMDIEN=PXRMTEMP 59 ;Format headings to include dialog name 60 S DATA=$G(^PXRMD(801.41,PXRMDIEN,0)),DDES=$P(DATA,U),DTYP=$P(DATA,U,4) 61 ;Test 62 I DTYP="G" D DLG(PXRMDIEN) Q 63 ; 64 S PXRMHD=PXRMHD_" "_DDES W PXRMHD,! 65 ;Edit selected dialog 66 D EDIT^PXRMDEDT(DTYP,PXRMDIEN,0) 67 Q 68 ; 69 ;Reminder dialog view 70 ;-------------------- 71 DLG(PXRMDIEN) ; 72 S PXRMDIEN=PXRMTEMP 73 S PXRMNAME=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U) 74 S PXRMITEM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U,2) 75 ;Format headings to include dialog name 76 S PXRMHD=PXRMHD_PXRMNAME 77 ;Check if the set is disable and add to header if disabled 78 I $P(^PXRMD(801.41,PXRMDIEN,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)" 79 ;Listman option 80 D EN^VALM("PXRM DIALOG LIST") 81 W IORESET 82 D KILL^%ZISS 83 Q 84 ; 85 ;Other subroutines 86 ; 87 ;Ask update or no 88 ;---------------- 89 ASK(YESNO) ; 90 N X,Y,TEXT,DIR 91 K DIROUT,DIRUT,DTOUT,DUOUT 92 S DIR(0)="YA0" 93 S DIR("A")="LINK THIS REMINDER TO DIALOG - "_$P(PXRMHD,": ",2)_": " 94 S DIR("B")="Y" 95 S DIR("?")="Enter Y or N. For detailed help type ??" 96 S DIR("??")=U_"D HLP^PXRMDLGY(1)" 97 D ^DIR K DIR 98 I $D(DIROUT) S DTOUT=1 99 I $D(DTOUT)!($D(DUOUT)) Q 100 S YESNO=$E(Y(0)) 101 Q 102 ; 103 ;Display dialogs autogenerated from this reminder 104 ;------------------------------------------------ 105 DISP(RIEN) ; 106 N ARRAY,DSUB,FIRST 107 ;Get OTHER dialogs 108 S FIRST=1,DSUB="" 109 F S DSUB=$O(^PXRMD(801.41,"AG",RIEN,DSUB)) Q:'DSUB D 110 .W ! 111 .D:FIRST 112 ..W "DIALOGS ALREADY GENERATED FROM THIS REMINDER:",!! S FIRST=0 113 .W ?20,$P($G(^PXRMD(801.41,DSUB,0)),U) 114 ; 115 I 'FIRST W ! 116 ; 117 Q 118 ; 119 ;Display linked reminders 120 ;------------------------ 121 DISPL(DIEN) ; 122 N ARRAY,DLG,RSUB,FIRST,RNAM 123 S RSUB=$P($G(^PXRMD(801.41,DIEN,0)),U,2) 124 I RSUB W !!,"SOURCE REMINDER: "_$P($G(^PXD(811.9,RSUB,0)),U) 125 ;Linked reminders 126 S FIRST=1,RNAM="" 127 F S RNAM=$O(^PXD(811.9,"B",RNAM)) Q:RNAM="" D 128 .S RSUB=$O(^PXD(811.9,"B",RNAM,"")) Q:'RSUB 129 .S DLG=$P($G(^PXD(811.9,RSUB,51)),U) Q:DLG'=DIEN 130 .W ! I FIRST W !,"REMINDERS ALREADY LINKED TO THIS DIALOG:",!! S FIRST=0 131 .W ?18,$P($G(^PXD(811.9,RSUB,0)),U) 132 Q 133 ; 134 ;Link a dialog (called by protocol PXRM DIALOG/REMINDER LINK) 135 ;------------- 136 LINK(DIEN) ; 137 F D Q:$D(DTOUT)!$D(DUOUT) 138 .W IORESET 139 .S VALMBCK="R" 140 .;Display linked reminders 141 .D DISPL(DIEN) 142 .; 143 .N ANS,DIC,DIR,DLG,LIT1,PNAME,PXRMREM,REM 144 .S DIC("A")="SELECT A REMINDER TO LINK OR CHANGE: " 145 .S LIT1="You must select a reminder!" 146 .D SEL(811.9,"AEQMZ",.PXRMREM) 147 .Q:$D(DTOUT)!$D(DUOUT) 148 .S REM=$P(PXRMREM(1),U),PNAME=$P(PXRMREM(1),U,3) 149 .I PNAME]"" W !!,"REMINDER PRINT NAME: "_PNAME,! 150 .;Display related dialogs 151 .D DISP(REM) 152 .;Check if already linked 153 .S DLG=$P($G(^PXD(811.9,REM,51)),U) 154 .;Reconfirm to link reminder 155 .I 'DLG S ANS="" D ASK(.ANS) Q:ANS'="Y" 156 .; 157 .N DA,DR,DIE 158 .;Edit selected reminder 159 .S DA=REM 160 .;Settup local variables 161 .S DIE="^PXD(811.9,",DR=51 162 .;If no link force entry 163 .I 'DLG S DR=DR_"///"_PXRMNAME 164 .D ^DIE 165 Q 166 ; 167 ;Link a Reminder (called by protocol PXRM DIALOG LINK) 168 ;--------------- 169 RLINK(REM) ; 170 N DLG 171 ;Re-display reminder name 172 W IORESET 173 W !,PXRMHD 174 ; 175 N DA,DR,DIE 176 ;Edit selected reminder 177 S DA=REM 178 ;Settup local variables 179 S DIE="^PXD(811.9,",DR=51 180 ;If no link force entry 181 D ^DIE 182 Q 183 ; 184 ;General help text routine. 185 ;-------------------------- 186 HLP(CALL) ; 187 N HTEXT 188 N DIWF,DIWL,DIWR,IC 189 S DIWF="C75",DIWL=0,DIWR=75 190 ; 191 I CALL=1 D 192 .S HTEXT(1)="Enter Yes to link reminder to this dialog." 193 I CALL=2 D 194 .S HTEXT(1)="Enter Yes to link reminder to this dialog." 195 K ^UTILITY($J,"W") 196 S IC="" 197 F S IC=$O(HTEXT(IC)) Q:IC="" D 198 . S X=HTEXT(IC) 199 . D ^DIWP 200 W ! 201 S IC=0 202 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 203 . W !,^UTILITY($J,"W",0,IC,0) 204 K ^UTILITY($J,"W") 205 W ! 206 Q 207 ; 208 ;Reminder selection 209 ;------------------ 210 SEL(FILE,MODE,ARRAY) ; 211 N X,Y,CNT 212 K DIROUT,DIRUT,DTOUT,DUOUT 213 S CNT=0 214 W ! 215 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:CNT>0 Q:(Y=-1)&(CNT>0) 216 .S DIC=FILE,DIC(0)=MODE 217 .D ^DIC 218 .I X=(U_U) S DTOUT=1 219 .I '$D(DTOUT),('$D(DUOUT)) D 220 ..I +Y'=-1 D Q 221 ...S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3) 222 ..W:CNT=0 !,LIT1 223 .K DIC 224 Q 225 ; 226 ;Input transform for FINDING ITEM in 801.41 227 XINP(X) ;Taxonomy findings are not allowed for dialog groups 228 I $P(X,";",2)="PXD(811.2,",$P($G(^PXRMD(801.41,DA,0)),U,4)="G" D Q 0 229 .W $C(7),!,"A taxonomy cannot be entered as the finding item for a group" 230 ;Only applies to MH 231 I $P(X,";",2)'="^YTT(601.71," Q 1 232 I $$OK^PXRMDLL($P(X,";")) Q 1 233 W *7,!,"This test is not appropriate for the GUI",! 234 Q 0 1 PXRMDLGZ ; SLC/PJH - Link reminder to dialog. ;05/31/2006 2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21 3 ; 4 ;Called by option PXRM DIALOG/COMPONENT EDIT 5 ; 6 START N BY,DATA,DDES,DHD,DIC,DNAM,DTYP,FLDS,FR,L,LOGIC,NOW,PNAM,TO,Y 7 N PXRMBG,PXRMHD,PXRMDIEN,PXRMGTYP,PXRMDTYP,PXRMITEM,PXRMMODE,PXRMNAME 8 N PXRMTEMP,PXRMTITL,PXRMVIEW 9 ;Refresh on return 10 S VALMBCK="R" 11 S VALMSG="+ Next Screen - Prev Screen ?? More Actions" 12 ;Default is display dialog elements 13 S PXRMDTYP="R",PXRMGTYP="DLGR",PXRMVIEW="AN" 14 ;Select dialog for display 15 F D Q:'PXRMTEMP 16 .S PXRMTEMP="" 17 .D START^PXRMSEL(.PXRMHD,.PXRMGTYP,"PXRMTEMP") Q:'PXRMTEMP 18 .N X S X="IORESET" 19 .D ENDR^%ZISS,@(PXRMGTYP_"("_PXRMTEMP_")") 20 END Q 21 ; 22 ;Reminder View 23 ;------------- 24 DLGR(PXRMITEM) ; 25 N PXRMDIEN,PXRMCS1,PXRMCS2 26 ;Format headings to include reminder and name 27 S DATA=$G(^PXD(811.9,PXRMITEM,0)),RNAM=$P(DATA,U),PNAM=$P(DATA,U,3) 28 S PXRMHD="REMINDER NAME: "_RNAM 29 ; 30 ;Dialog History 31 F D Q:'PXRMDIEN 32 .D START^PXRMDLGH(PXRMITEM,.PXRMDIEN,"PXRMDIEN") Q:'PXRMDIEN 33 .N PXRMHD,VALMBCK,VALMBG,VALMSG,VIEW,X,XMZ 34 .S DNAM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U) 35 .I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)]"" S DNAM=DNAM_" (DISABLED)" 36 .S PXRMHD="REMINDER DIALOG NAME: "_DNAM 37 .S PXRMCS1=$$FILE^PXRMEXCS(801.41,PXRMDIEN) 38 .S X="IORESET" 39 .D ENDR^%ZISS,EN^VALM("PXRM DIALOG LIST") 40 .I PXRMDIEN,$D(^PXRMD(801.41,PXRMDIEN,0)) D 41 ..S PXRMCS2=$$FILE^PXRMEXCS(801.41,PXRMDIEN) Q:+PXRMCS2=0 42 ..Q:PXRMCS1=PXRMCS2 43 ..D SEHIST^PXRMUTIL(801.41,"^PXRMD(801,41,",PXRMDIEN) 44 .W IORESET 45 .D KILL^%ZISS 46 Q 47 ; 48 ;Edit element/prompt/group 49 ;------------------------- 50 DLGE(PXRMDIEN) ; 51 N LOCK,LFIND 52 ;Check for Uneditable flag 53 S LOCK=$P($G(^PXRMD(801.41,PXRMTEMP,100)),U,4) 54 S LFIND=$P($G(^PXRMD(801.41,PXRMTEMP,1)),U,5) 55 I LOCK=1,$G(LFIND)'="",$G(LFIND)'["ORD",'$G(PXRMINST) D Q 56 .W !,"This item can not be edited" H 2 57 ; 58 S PXRMHD="Dialog Name: ",PXRMDIEN=PXRMTEMP 59 ;Format headings to include dialog name 60 S DATA=$G(^PXRMD(801.41,PXRMDIEN,0)),DDES=$P(DATA,U),DTYP=$P(DATA,U,4) 61 ;Test 62 I DTYP="G" D DLG(PXRMDIEN) Q 63 ; 64 S PXRMHD=PXRMHD_" "_DDES W PXRMHD,! 65 ;Edit selected dialog 66 D EDIT^PXRMDEDT(DTYP,PXRMDIEN,0) 67 Q 68 ; 69 ;Reminder dialog view 70 ;-------------------- 71 DLG(PXRMDIEN) ; 72 S PXRMDIEN=PXRMTEMP 73 S PXRMNAME=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U) 74 S PXRMITEM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U,2) 75 ;Format headings to include dialog name 76 S PXRMHD=PXRMHD_PXRMNAME 77 ;Check if the set is disable and add to header if disabled 78 I $P(^PXRMD(801.41,PXRMDIEN,0),U,3)]"" S PXRMHD=PXRMHD_" (DISABLED)" 79 ;Listman option 80 D EN^VALM("PXRM DIALOG LIST") 81 W IORESET 82 D KILL^%ZISS 83 Q 84 ; 85 ;Other subroutines 86 ; 87 ;Ask update or no 88 ;---------------- 89 ASK(YESNO) ; 90 N X,Y,TEXT,DIR 91 K DIROUT,DIRUT,DTOUT,DUOUT 92 S DIR(0)="YA0" 93 S DIR("A")="LINK THIS REMINDER TO DIALOG - "_$P(PXRMHD,": ",2)_": " 94 S DIR("B")="Y" 95 S DIR("?")="Enter Y or N. For detailed help type ??" 96 S DIR("??")=U_"D HLP^PXRMDLGY(1)" 97 D ^DIR K DIR 98 I $D(DIROUT) S DTOUT=1 99 I $D(DTOUT)!($D(DUOUT)) Q 100 S YESNO=$E(Y(0)) 101 Q 102 ; 103 ;Display dialogs autogenerated from this reminder 104 ;------------------------------------------------ 105 DISP(RIEN) ; 106 N ARRAY,DSUB,FIRST 107 ;Get OTHER dialogs 108 S FIRST=1,DSUB="" 109 F S DSUB=$O(^PXRMD(801.41,"AG",RIEN,DSUB)) Q:'DSUB D 110 .W ! 111 .D:FIRST 112 ..W "DIALOGS ALREADY GENERATED FROM THIS REMINDER:",!! S FIRST=0 113 .W ?20,$P($G(^PXRMD(801.41,DSUB,0)),U) 114 ; 115 I 'FIRST W ! 116 ; 117 Q 118 ; 119 ;Display linked reminders 120 ;------------------------ 121 DISPL(DIEN) ; 122 N ARRAY,DLG,RSUB,FIRST,RNAM 123 S RSUB=$P($G(^PXRMD(801.41,DIEN,0)),U,2) 124 I RSUB W !!,"SOURCE REMINDER: "_$P($G(^PXD(811.9,RSUB,0)),U) 125 ;Linked reminders 126 S FIRST=1,RNAM="" 127 F S RNAM=$O(^PXD(811.9,"B",RNAM)) Q:RNAM="" D 128 .S RSUB=$O(^PXD(811.9,"B",RNAM,"")) Q:'RSUB 129 .S DLG=$P($G(^PXD(811.9,RSUB,51)),U) Q:DLG'=DIEN 130 .W ! I FIRST W !,"REMINDERS ALREADY LINKED TO THIS DIALOG:",!! S FIRST=0 131 .W ?18,$P($G(^PXD(811.9,RSUB,0)),U) 132 Q 133 ; 134 ;Link a dialog (called by protocol PXRM DIALOG/REMINDER LINK) 135 ;------------- 136 LINK(DIEN) ; 137 F D Q:$D(DTOUT)!$D(DUOUT) 138 .W IORESET 139 .S VALMBCK="R" 140 .;Display linked reminders 141 .D DISPL(DIEN) 142 .; 143 .N ANS,DIC,DIR,DLG,LIT1,PNAME,PXRMREM,REM 144 .S DIC("A")="SELECT A REMINDER TO LINK OR CHANGE: " 145 .S LIT1="You must select a reminder!" 146 .D SEL(811.9,"AEQMZ",.PXRMREM) 147 .Q:$D(DTOUT)!$D(DUOUT) 148 .S REM=$P(PXRMREM(1),U),PNAME=$P(PXRMREM(1),U,3) 149 .I PNAME]"" W !!,"REMINDER PRINT NAME: "_PNAME,! 150 .;Display related dialogs 151 .D DISP(REM) 152 .;Check if already linked 153 .S DLG=$P($G(^PXD(811.9,REM,51)),U) 154 .;Reconfirm to link reminder 155 .I 'DLG S ANS="" D ASK(.ANS) Q:ANS'="Y" 156 .; 157 .N DA,DR,DIE 158 .;Edit selected reminder 159 .S DA=REM 160 .;Settup local variables 161 .S DIE="^PXD(811.9,",DR=51 162 .;If no link force entry 163 .I 'DLG S DR=DR_"///"_PXRMNAME 164 .D ^DIE 165 Q 166 ; 167 ;Link a Reminder (called by protocol PXRM DIALOG LINK) 168 ;--------------- 169 RLINK(REM) ; 170 N DLG 171 ;Re-display reminder name 172 W IORESET 173 W !,PXRMHD 174 ; 175 N DA,DR,DIE 176 ;Edit selected reminder 177 S DA=REM 178 ;Settup local variables 179 S DIE="^PXD(811.9,",DR=51 180 ;If no link force entry 181 D ^DIE 182 Q 183 ; 184 ;General help text routine. 185 ;-------------------------- 186 HLP(CALL) ; 187 N HTEXT 188 N DIWF,DIWL,DIWR,IC 189 S DIWF="C75",DIWL=0,DIWR=75 190 ; 191 I CALL=1 D 192 .S HTEXT(1)="Enter Yes to link reminder to this dialog." 193 I CALL=2 D 194 .S HTEXT(1)="Enter Yes to link reminder to this dialog." 195 K ^UTILITY($J,"W") 196 S IC="" 197 F S IC=$O(HTEXT(IC)) Q:IC="" D 198 . S X=HTEXT(IC) 199 . D ^DIWP 200 W ! 201 S IC=0 202 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 203 . W !,^UTILITY($J,"W",0,IC,0) 204 K ^UTILITY($J,"W") 205 W ! 206 Q 207 ; 208 ;Reminder selection 209 ;------------------ 210 SEL(FILE,MODE,ARRAY) ; 211 N X,Y,CNT 212 K DIROUT,DIRUT,DTOUT,DUOUT 213 S CNT=0 214 W ! 215 F D Q:$D(DTOUT) Q:$D(DUOUT) Q:CNT>0 Q:(Y=-1)&(CNT>0) 216 .S DIC=FILE,DIC(0)=MODE 217 .D ^DIC 218 .I X=(U_U) S DTOUT=1 219 .I '$D(DTOUT),('$D(DUOUT)) D 220 ..I +Y'=-1 D Q 221 ...S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3) 222 ..W:CNT=0 !,LIT1 223 .K DIC 224 Q 225 ; 226 ;Input transform for FINDING ITEM in 801.41 227 XINP(X) ;Taxonomy findings are not allowed for dialog groups 228 I $P(X,";",2)="PXD(811.2,",$P($G(^PXRMD(801.41,DA,0)),U,4)="G" D Q 0 229 .W $C(7),!,"A taxonomy cannot be entered as the finding item for a group" 230 ;Only applies to MH 231 I $P(X,";",2)'="YTT(601," Q 1 232 ;GAF 233 I $P($G(^YTT(601,$P(X,";"),0)),U)="GAF" Q 1 234 ;Check if a VALID GUI test 235 I $P($G(^YTT(601.6,$P(X,";"),0)),U,4)="Y" Q 1 236 ;else 237 W *7,!,"This test is not appropriate for the GUI",! 238 Q 0
Note:
See TracChangeset
for help on using the changeset viewer.
