- 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
- PXRMEXIX ;SLC/PJH - Reminder Dialog Exchange checks. ;10/10/2007
- +1 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
- +2 ;
- +3 ;=====================================================================
- +4 ;
- +5 ;Yes/No Prompts
- +6 ;--------------
- ASK(YESNO,TEXT,HELP) ;
- +1 WRITE !
- +2 NEW DIR,X,Y
- +3 KILL DIROUT,DIRUT,DTOUT,DUOUT
- +4 SET DIR(0)="YA0"
- +5 MERGE DIR("A")=TEXT
- +6 SET DIR("B")="Y"
- +7 SET DIR("?")="Enter Y or N. For detailed help type ??"
- +8 SET DIR("??")=U_"D HLP^PXRMEXIX(HELP)"
- +9 DO ^DIR
- KILL DIR
- +10 IF $DATA(DIROUT)
- SET DTOUT=1
- +11 IF $DATA(DTOUT)!($DATA(DUOUT))
- SET PXRMDONE=1
- QUIT
- +12 SET YESNO=$EXTRACT(Y(0))
- +13 QUIT
- +14 ;
- +15 ;Dialog check - all exist, none exist or some exist
- +16 ;--------------------------------------------------
- EXIST(ALL,DNAME,DTYP,INAME) ;
- +1 ;0 - None exist
- +2 ;1 - All exist
- +3 ;2 - Some exist
- +4 ;
- +5 ;Look for component dialogs in DMAP node from PXRMEXIC
- +6 NEW DONE,DOTHER,EXISTS,FILE,MODE
- +7 SET ALL=""
- SET DONE=0
- SET MODE=""
- SET NAME=""
- +8 ;
- +9 IF DTYP="reminder dialog"
- Begin DoDot:1
- +10 FOR
- SET NAME=$ORDER(^TMP("PXRMEXTMP",$JOB,"DMAP",NAME))
- IF NAME=""
- QUIT
- Begin DoDot:2
- +11 ;Check if dialog exists
- +12 SET EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME)
- +13 ;If exists accumulate list of ancestors
- +14 IF EXISTS
- DO OTHER(NAME,.DOTHER)
- +15 ;Quit if some exist and some don't
- +16 IF MODE=1
- IF 'EXISTS
- SET MODE=2
- SET DONE=1
- QUIT
- +17 IF MODE=0
- IF EXISTS
- SET MODE=2
- SET DONE=1
- QUIT
- +18 ;Set all exists flag if dialog found
- +19 IF MODE=""
- IF EXISTS
- SET MODE=1
- +20 ;Set none exists flag if dialog not found
- +21 IF MODE=""
- IF 'EXISTS
- SET MODE=0
- End DoDot:2
- IF DONE
- QUIT
- End DoDot:1
- +22 ;
- +23 IF DTYP'="reminder dialog"
- Begin DoDot:1
- +24 FOR
- SET NAME=$ORDER(INAME(NAME))
- IF NAME=""
- QUIT
- Begin DoDot:2
- +25 ;Treat namechanges as 'done'
- +26 IF $DATA(PXRMNMCH(801.41,NAME))
- QUIT
- +27 ;Check if dialog exists
- +28 SET EXISTS=$$EXISTS^PXRMEXIU(801.41,NAME)
- +29 ;If exists accumulate list of ancestors
- +30 IF EXISTS
- DO OTHER(NAME,.DOTHER)
- +31 ;Quit if some exist and some don't
- +32 IF MODE=1
- IF 'EXISTS
- SET MODE=2
- SET DONE=1
- QUIT
- +33 IF MODE=0
- IF EXISTS
- SET MODE=2
- SET DONE=1
- QUIT
- +34 ;Set all exists flag if dialog found
- +35 IF MODE=""
- IF EXISTS
- SET MODE=1
- +36 ;Set none exists flag if dialog not found
- +37 IF MODE=""
- IF 'EXISTS
- SET MODE=0
- End DoDot:2
- IF DONE
- QUIT
- End DoDot:1
- +38 ;
- +39 ;If all or none exist give option to install all without prompting
- +40 NEW ANS,TEXT
- +41 IF MODE=0
- Begin DoDot:1
- +42 SET TEXT(1)="All dialog components for "_DNAME_" are new."
- End DoDot:1
- +43 IF MODE=1
- Begin DoDot:1
- +44 SET TEXT(1)="All dialog components for "_DNAME_" already exist."
- +45 SET TEXT(2)=""
- SET TEXT(4)=""
- +46 SET TEXT(3)="Components not used by any other dialogs."
- +47 ;Warn if used by other dialogs
- +48 IF $DATA(DOTHER)
- Begin DoDot:2
- +49 SET TEXT(3)="WARNING - some components already used by:"
- +50 NEW CNT,DLIT,DNAME,DTYP,FIRST,NAME
- +51 SET CNT=4
- SET DNAME=""
- SET TEXT(CNT)=""
- +52 FOR
- SET DNAME=$ORDER(DOTHER(DNAME))
- IF DNAME=""
- QUIT
- Begin DoDot:3
- +53 SET NAME=""
- SET FIRST=1
- SET CNT=CNT+1
- +54 SET DTYP=DOTHER(DNAME)
- +55 IF DTYP="R"
- SET DTYP="Reminder Dialog"
- +56 IF DTYP="G"
- SET DTYP="Dialog Group"
- +57 IF DTYP="E"
- SET DTYP="Dialog Element"
- +58 ;S CNT=CNT+1,FIRST=0,TEXT(CNT)=DLIT_NAME_" ("_DTYP_")"
- +59 SET CNT=CNT+1
- SET FIRST=0
- SET TEXT(CNT)=DNAME_" ("_DTYP_")"
- End DoDot:3
- +60 SET CNT=CNT+1
- SET TEXT(CNT)=""
- End DoDot:2
- End DoDot:1
- +61 SET TEXT="Install "_DTYP_" and all components with no further changes: "
- +62 ;Give option to install all descendents
- +63 DO ASK(.ANS,.TEXT,2)
- IF $GET(ANS)="Y"
- SET ALL=1
- +64 IF $GET(ANS)="N"
- SET ALL=0
- +65 QUIT
- +66 ;
- +67 ;Check if used by other dialogs
- +68 ;------------------------------
- OTHER(NAME,LIST) ;
- +1 NEW DDATA,DIEN,DNAME,DTYP,IEN
- +2 SET IEN=$ORDER(^PXRMD(801.41,"B",NAME,0))
- IF 'IEN
- QUIT
- +3 ;Check if used by other dialogs
- +4 IF '$DATA(^PXRMD(801.41,"AD",IEN))
- QUIT
- +5 ;Build list of dialogs using this component
- +6 SET DIEN=0
- +7 FOR
- SET DIEN=$ORDER(^PXRMD(801.41,"AD",IEN,DIEN))
- IF 'DIEN
- QUIT
- Begin DoDot:1
- +8 SET DDATA=$GET(^PXRMD(801.41,DIEN,0))
- IF DDATA=""
- QUIT
- +9 SET DNAME=$PIECE(DDATA,U)
- SET DTYP=$PIECE(DDATA,U,4)
- IF DNAME=""
- QUIT
- +10 ;Include only dialogs that are not part of this reminder dialog
- +11 IF $DATA(^TMP("PXRMEXTMP",$JOB,"DMAP",DNAME))
- QUIT
- +12 SET LIST(DNAME)=DTYP
- End DoDot:1
- +13 QUIT
- +14 ;
- +15 ;General help text routine.
- +16 ;--------------------------
- HLP(CALL) ;
- +1 NEW HTEXT
- +2 NEW DIWF,DIWL,DIWR,IC
- +3 SET DIWF="C75"
- SET DIWL=0
- SET DIWR=75
- +4 ;
- +5 IF CALL=1
- Begin DoDot:1
- +6 SET HTEXT(1)="Enter 'Yes' to install all sub-components or"
- +7 SET HTEXT(2)="enter 'No' to install only the selected dialog."
- End DoDot:1
- +8 IF CALL=2
- Begin DoDot:1
- +9 SET HTEXT(1)="Enter 'Yes' to install without changes."
- +10 SET HTEXT(2)="Enter 'No' to install with changes."
- End DoDot:1
- +11 IF CALL=3
- Begin DoDot:1
- +12 SET HTEXT(1)="Select IFE to INSTALL reminder or dialog from this exchange"
- +13 SET HTEXT(2)="entry. Select DFE to DELETE this entry from the exchange file. "
- +14 SET HTEXT(3)="Select IH to view the installation HISTORY for this entry."
- End DoDot:1
- +15 KILL ^UTILITY($JOB,"W")
- +16 SET IC=""
- +17 FOR
- SET IC=$ORDER(HTEXT(IC))
- IF IC=""
- QUIT
- Begin DoDot:1
- +18 SET X=HTEXT(IC)
- +19 DO ^DIWP
- End DoDot:1
- +20 WRITE !
- +21 SET IC=0
- +22 FOR
- SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))
- IF IC=""
- QUIT
- Begin DoDot:1
- +23 WRITE !,^UTILITY($JOB,"W",0,IC,0)
- End DoDot:1
- +24 KILL ^UTILITY($JOB,"W")
- +25 WRITE !
- +26 QUIT
