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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMEXIX 4485 printed Nov 22, 2024@16:55:13 Page 2
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
