Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXIX.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/PXRMEXIX.m
r613 r623 1 PXRMEXIX ;SLC/PJH - Reminder Dialog Exchange checks. ;10/10/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ;===================================================================== 5 ; 6 ;Yes/No Prompts 7 ;-------------- 8 ASK(YESNO,TEXT,HELP) ; 9 W ! 10 N DIR,X,Y 11 K DIROUT,DIRUT,DTOUT,DUOUT 12 S DIR(0)="YA0" 13 M DIR("A")=TEXT 14 S DIR("B")="Y" 15 S DIR("?")="Enter Y or N. For detailed help type ??" 16 S DIR("??")=U_"D HLP^PXRMEXIX(HELP)" 17 D ^DIR K DIR 18 I $D(DIROUT) S DTOUT=1 19 I $D(DTOUT)!($D(DUOUT)) S PXRMDONE=1 Q 20 S YESNO=$E(Y(0)) 21 Q 22 ; 23 ;Dialog check - all exist, none exist or some exist 24 ;-------------------------------------------------- 25 EXIST(ALL,DNAME,DTYP,INAME) ; 26 ;0 - None exist 27 ;1 - All exist 28 ;2 - Some exist 29 ; 30 ;Look for component dialogs in DMAP node from PXRMEXIC 31 N DONE,DOTHER,EXISTS,FILE,MODE 32 S ALL="",DONE=0,MODE="",NAME="" 33 ; 34 I DTYP="reminder dialog" D 35 .F S NAME=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME)) Q:NAME="" D Q:DONE 36 ..;Check if dialog exists 37 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME) 38 ..;If exists accumulate list of ancestors 39 ..I EXISTS D OTHER(NAME,.DOTHER) 40 ..;Quit if some exist and some don't 41 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q 42 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q 43 ..;Set all exists flag if dialog found 44 ..I MODE="",EXISTS S MODE=1 45 ..;Set none exists flag if dialog not found 46 ..I MODE="",'EXISTS S MODE=0 47 ; 48 I DTYP'="reminder dialog" D 49 .F S NAME=$O(INAME(NAME)) Q:NAME="" D Q:DONE 50 ..;Treat namechanges as 'done' 51 ..I $D(PXRMNMCH(801.41,NAME)) Q 52 ..;Check if dialog exists 53 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME) 54 ..;If exists accumulate list of ancestors 55 ..I EXISTS D OTHER(NAME,.DOTHER) 56 ..;Quit if some exist and some don't 57 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q 58 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q 59 ..;Set all exists flag if dialog found 60 ..I MODE="",EXISTS S MODE=1 61 ..;Set none exists flag if dialog not found 62 ..I MODE="",'EXISTS S MODE=0 63 ; 64 ;If all or none exist give option to install all without prompting 65 N ANS,TEXT 66 I MODE=0 D 67 .S TEXT(1)="All dialog components for "_DNAME_" are new." 68 I MODE=1 D 69 .S TEXT(1)="All dialog components for "_DNAME_" already exist." 70 .S TEXT(2)="",TEXT(4)="" 71 .S TEXT(3)="Components not used by any other dialogs." 72 .;Warn if used by other dialogs 73 .I $D(DOTHER) D 74 ..S TEXT(3)="WARNING - some components already used by:" 75 ..N CNT,DLIT,DNAME,DTYP,FIRST,NAME 76 ..S CNT=4,DNAME="",TEXT(CNT)="" 77 ..F S DNAME=$O(DOTHER(DNAME)) Q:DNAME="" D 78 ...S NAME="",FIRST=1,CNT=CNT+1 79 ...S DTYP=DOTHER(DNAME) 80 ...I DTYP="R" S DTYP="Reminder Dialog" 81 ...I DTYP="G" S DTYP="Dialog Group" 82 ...I DTYP="E" S DTYP="Dialog Element" 83 ...;S CNT=CNT+1,FIRST=0,TEXT(CNT)=DLIT_NAME_" ("_DTYP_")" 84 ...S CNT=CNT+1,FIRST=0,TEXT(CNT)=DNAME_" ("_DTYP_")" 85 ..S CNT=CNT+1,TEXT(CNT)="" 86 S TEXT="Install "_DTYP_" and all components with no further changes: " 87 ;Give option to install all descendents 88 D ASK(.ANS,.TEXT,2) I $G(ANS)="Y" S ALL=1 89 I $G(ANS)="N" S ALL=0 90 Q 91 ; 92 ;Check if used by other dialogs 93 ;------------------------------ 94 OTHER(NAME,LIST) ; 95 N DDATA,DIEN,DNAME,DTYP,IEN 96 S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN 97 ;Check if used by other dialogs 98 I '$D(^PXRMD(801.41,"AD",IEN)) Q 99 ;Build list of dialogs using this component 100 S DIEN=0 101 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN D 102 .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA="" 103 .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME="" 104 .;Include only dialogs that are not part of this reminder dialog 105 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q 106 .S LIST(DNAME)=DTYP 107 Q 108 ; 109 ;General help text routine. 110 ;-------------------------- 111 HLP(CALL) ; 112 N HTEXT 113 N DIWF,DIWL,DIWR,IC 114 S DIWF="C75",DIWL=0,DIWR=75 115 ; 116 I CALL=1 D 117 .S HTEXT(1)="Enter 'Yes' to install all sub-components or" 118 .S HTEXT(2)="enter 'No' to install only the selected dialog." 119 I CALL=2 D 120 .S HTEXT(1)="Enter 'Yes' to install without changes." 121 .S HTEXT(2)="Enter 'No' to install with changes." 122 I CALL=3 D 123 .S HTEXT(1)="Select IFE to INSTALL reminder or dialog from this exchange" 124 .S HTEXT(2)="entry. Select DFE to DELETE this entry from the exchange file. " 125 .S HTEXT(3)="Select IH to view the installation HISTORY for this entry." 126 K ^UTILITY($J,"W") 127 S IC="" 128 F S IC=$O(HTEXT(IC)) Q:IC="" D 129 . S X=HTEXT(IC) 130 . D ^DIWP 131 W ! 132 S IC=0 133 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 134 . W !,^UTILITY($J,"W",0,IC,0) 135 K ^UTILITY($J,"W") 136 W ! 137 Q 1 PXRMEXIX ;SLC/PJH - Reminder Dialog Exchange checks. ;12/22/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ; 4 ;===================================================================== 5 ; 6 ;Yes/No Prompts 7 ;-------------- 8 ASK(YESNO,TEXT,HELP) ; 9 W ! 10 N DIR,X,Y 11 K DIROUT,DIRUT,DTOUT,DUOUT 12 S DIR(0)="YA0" 13 M DIR("A")=TEXT 14 S DIR("B")="Y" 15 S DIR("?")="Enter Y or N. For detailed help type ??" 16 S DIR("??")=U_"D HLP^PXRMEXIX(HELP)" 17 D ^DIR K DIR 18 I $D(DIROUT) S DTOUT=1 19 I $D(DTOUT)!($D(DUOUT)) S PXRMDONE=1 Q 20 S YESNO=$E(Y(0)) 21 Q 22 ; 23 ;Dialog check - all exist, none exist or some exist 24 ;-------------------------------------------------- 25 EXIST(ALL,DNAME,DTYP,INAME) ; 26 ;0 - None exist 27 ;1 - All exist 28 ;2 - Some exist 29 ; 30 ;Look for component dialogs in DMAP node from PXRMEXIC 31 N DONE,DOTHER,EXISTS,FILE,MODE 32 S ALL="",DONE=0,MODE="",NAME="" 33 ; 34 I DTYP="reminder dialog" D 35 .F S NAME=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME)) Q:NAME="" D Q:DONE 36 ..;Check if dialog exists 37 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME) 38 ..;If exists accumulate list of ancestors 39 ..I EXISTS D OTHER(NAME,.DOTHER) 40 ..;Quit if some exist and some don't 41 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q 42 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q 43 ..;Set all exists flag if dialog found 44 ..I MODE="",EXISTS S MODE=1 45 ..;Set none exists flag if dialog not found 46 ..I MODE="",'EXISTS S MODE=0 47 ; 48 I DTYP'="reminder dialog" D 49 .F S NAME=$O(INAME(NAME)) Q:NAME="" D Q:DONE 50 ..;Treat namechanges as 'done' 51 ..I $D(PXRMNMCH(801.41,NAME)) Q 52 ..;Check if dialog exists 53 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME) 54 ..;If exists accumulate list of ancestors 55 ..I EXISTS D OTHER(NAME,.DOTHER) 56 ..;Quit if some exist and some don't 57 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q 58 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q 59 ..;Set all exists flag if dialog found 60 ..I MODE="",EXISTS S MODE=1 61 ..;Set none exists flag if dialog not found 62 ..I MODE="",'EXISTS S MODE=0 63 ; 64 ;If all or none exist give option to install all without prompting 65 N ANS,TEXT 66 I MODE=0 D 67 .S TEXT(1)="All dialog components for "_DNAME_" are new." 68 I MODE=1 D 69 .S TEXT(1)="All dialog components for "_DNAME_" already exist." 70 .S TEXT(2)="",TEXT(4)="" 71 .S TEXT(3)="Components not used by any other dialogs." 72 .;Warn if used by other dialogs 73 .I $D(DOTHER) D 74 ..S TEXT(3)="WARNING - some components already used by:" 75 ..N CNT,DLIT,DNAME,DTYP,FIRST,NAME 76 ..S CNT=4,DNAME="",TEXT(CNT)="" 77 ..F S DNAME=$O(DOTHER(DNAME)) Q:DNAME="" D 78 ...S NAME="",FIRST=1,CNT=CNT+1 79 ...S DTYP=DOTHER(DNAME) 80 ...I DTYP="R" S DTYP="Reminder Dialog" 81 ...I DTYP="G" S DTYP="Dialog Group" 82 ...I DTYP="E" S DTYP="Dialog Element" 83 ...;S CNT=CNT+1,FIRST=0,TEXT(CNT)=DLIT_NAME_" ("_DTYP_")" 84 ...S CNT=CNT+1,FIRST=0,TEXT(CNT)=DNAME_" ("_DTYP_")" 85 ..S CNT=CNT+1,TEXT(CNT)="" 86 S TEXT="Install "_DTYP_" and all components with no further changes:" 87 ;Give option to install all descendents 88 D ASK(.ANS,.TEXT,2) I $G(ANS)="Y" S ALL=1 89 Q 90 ; 91 ;Check if used by other dialogs 92 ;------------------------------ 93 OTHER(NAME,LIST) ; 94 N DDATA,DIEN,DNAME,DTYP,IEN 95 S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN 96 ;Check if used by other dialogs 97 I '$D(^PXRMD(801.41,"AD",IEN)) Q 98 ;Build list of dialogs using this component 99 S DIEN=0 100 F S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN D 101 .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA="" 102 .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME="" 103 .;Include only dialogs that are not part of this reminder dialog 104 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q 105 .S LIST(DNAME)=DTYP 106 Q 107 ; 108 ;General help text routine. 109 ;-------------------------- 110 HLP(CALL) ; 111 N HTEXT 112 N DIWF,DIWL,DIWR,IC 113 S DIWF="C75",DIWL=0,DIWR=75 114 ; 115 I CALL=1 D 116 .S HTEXT(1)="Enter 'Yes' to if you are installing all sub-components or" 117 .S HTEXT(2)="enter 'No' to install only the selected dialog." 118 I CALL=2 D 119 .S HTEXT(1)="Enter 'Yes' to if you are installing without changes." 120 .S HTEXT(2)="enter 'No' to install with changes." 121 I CALL=3 D 122 .S HTEXT(1)="Select IFE to INSTALL reminder or dialog from this exchange" 123 .S HTEXT(2)="entry. Select DFE to DELETE this entry from the exchange file. " 124 .S HTEXT(3)="Select IH to view the installation HISTORY for this entry." 125 K ^UTILITY($J,"W") 126 S IC="" 127 F S IC=$O(HTEXT(IC)) Q:IC="" D 128 . S X=HTEXT(IC) 129 . D ^DIWP 130 W ! 131 S IC=0 132 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D 133 . W !,^UTILITY($J,"W",0,IC,0) 134 K ^UTILITY($J,"W") 135 W ! 136 Q
Note:
See TracChangeset
for help on using the changeset viewer.
