source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXIX.m@ 1196

PXRMEXIX ;SLC/PJH - Reminder Dialog Exchange checks. ;10/10/2007
 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
 ;
 ;=====================================================================
 ;
 ;Yes/No Prompts
 ;--------------
ASK(YESNO,TEXT,HELP) ;
 W !
 N DIR,X,Y
 K DIROUT,DIRUT,DTOUT,DUOUT
 S DIR(0)="YA0"
 M DIR("A")=TEXT
 S DIR("B")="Y"
 S DIR("?")="Enter Y or N. For detailed help type ??"
 S DIR("??")=U_"D HLP^PXRMEXIX(HELP)"
 D ^DIR K DIR
 I $D(DIROUT) S DTOUT=1
 I $D(DTOUT)!($D(DUOUT)) S PXRMDONE=1 Q
 S YESNO=$E(Y(0))
 Q
 ;
 ;Dialog check - all exist, none exist or some exist
 ;--------------------------------------------------
EXIST(ALL,DNAME,DTYP,INAME) ;
 ;0 - None exist
 ;1 - All exist
 ;2 - Some exist
 ;
 ;Look for component dialogs in DMAP node from PXRMEXIC
 N DONE,DOTHER,EXISTS,FILE,MODE
 S ALL="",DONE=0,MODE="",NAME=""
 ;
 I DTYP="reminder dialog" D
 .F  S NAME=$O(^TMP("PXRMEXTMP",$J,"DMAP",NAME)) Q:NAME=""  D  Q:DONE
 ..;Check if dialog exists
 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME)
 ..;If exists accumulate list of ancestors
 ..I EXISTS D OTHER(NAME,.DOTHER)
 ..;Quit if some exist and some don't
 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q
 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q
 ..;Set all exists flag if dialog found
 ..I MODE="",EXISTS S MODE=1
 ..;Set none exists flag if dialog not found
 ..I MODE="",'EXISTS S MODE=0
 ;
 I DTYP'="reminder dialog" D
 .F  S NAME=$O(INAME(NAME)) Q:NAME=""  D  Q:DONE
 ..;Treat namechanges as 'done'
 ..I $D(PXRMNMCH(801.41,NAME)) Q
 ..;Check if dialog exists
 ..S EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME)
 ..;If exists accumulate list of ancestors
 ..I EXISTS D OTHER(NAME,.DOTHER)
 ..;Quit if some exist and some don't
 ..I MODE=1,'EXISTS S MODE=2,DONE=1 Q
 ..I MODE=0,EXISTS S MODE=2,DONE=1 Q
 ..;Set all exists flag if dialog found
 ..I MODE="",EXISTS S MODE=1
 ..;Set none exists flag if dialog not found
 ..I MODE="",'EXISTS S MODE=0
 ;
 ;If all or none exist give option to install all without prompting
 N ANS,TEXT
 I MODE=0 D 
 .S TEXT(1)="All dialog components for "_DNAME_" are new."
 I MODE=1 D
 .S TEXT(1)="All dialog components for "_DNAME_" already exist."
 .S TEXT(2)="",TEXT(4)=""
 .S TEXT(3)="Components not used by any other dialogs."
 .;Warn if used by other dialogs
 .I $D(DOTHER) D
 ..S TEXT(3)="WARNING - some components already used by:"
 ..N CNT,DLIT,DNAME,DTYP,FIRST,NAME
 ..S CNT=4,DNAME="",TEXT(CNT)=""
 ..F  S DNAME=$O(DOTHER(DNAME)) Q:DNAME=""  D
 ...S NAME="",FIRST=1,CNT=CNT+1
 ...S DTYP=DOTHER(DNAME)
 ...I DTYP="R" S DTYP="Reminder Dialog"
 ...I DTYP="G" S DTYP="Dialog Group"
 ...I DTYP="E" S DTYP="Dialog Element"
 ...;S CNT=CNT+1,FIRST=0,TEXT(CNT)=DLIT_NAME_" ("_DTYP_")"
 ...S CNT=CNT+1,FIRST=0,TEXT(CNT)=DNAME_" ("_DTYP_")"
 ..S CNT=CNT+1,TEXT(CNT)=""
 S TEXT="Install "_DTYP_" and all components with no further changes: "
 ;Give option to install all descendents
 D ASK(.ANS,.TEXT,2) I $G(ANS)="Y" S ALL=1
 I $G(ANS)="N" S ALL=0
 Q
 ;
 ;Check if used by other dialogs
 ;------------------------------
OTHER(NAME,LIST) ;
 N DDATA,DIEN,DNAME,DTYP,IEN
 S IEN=$O(^PXRMD(801.41,"B",NAME,0)) Q:'IEN
 ;Check if used by other dialogs
 I '$D(^PXRMD(801.41,"AD",IEN)) Q
 ;Build list of dialogs using this component
 S DIEN=0
 F  S DIEN=$O(^PXRMD(801.41,"AD",IEN,DIEN)) Q:'DIEN  D
 .S DDATA=$G(^PXRMD(801.41,DIEN,0)) Q:DDATA=""
 .S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4) Q:DNAME=""
 .;Include only dialogs that are not part of this reminder dialog
 .I $D(^TMP("PXRMEXTMP",$J,"DMAP",DNAME)) Q
 .S LIST(DNAME)=DTYP
 Q
 ;
 ;General help text routine.
 ;--------------------------
HLP(CALL) ;
 N HTEXT
 N DIWF,DIWL,DIWR,IC
 S DIWF="C75",DIWL=0,DIWR=75
 ;
 I CALL=1 D
 .S HTEXT(1)="Enter 'Yes' to install all sub-components or"
 .S HTEXT(2)="enter 'No' to install only the selected dialog."
 I CALL=2 D
 .S HTEXT(1)="Enter 'Yes' to install without changes."
 .S HTEXT(2)="Enter 'No' to install with changes."
 I CALL=3 D
 .S HTEXT(1)="Select IFE to INSTALL reminder or dialog from this exchange"
 .S HTEXT(2)="entry. Select DFE to DELETE this entry from the exchange file. "
 .S HTEXT(3)="Select IH to view the installation HISTORY for this entry."
 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