PXRMDD41 ;SLC/PJH - Reminder Dialog file calls ;10/19/2015 09:13
;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
;
;copied from ORDD41 for dialog reminders
KILL(DLG) ;
Q
;
; Update audit trail when ITEMS changed
REDOX I $D(^PXRMD(801.41,+$G(DA(1)),0)) S $P(^(99),U)=$$NOW^XLFDT
Q
;
SCREEN ;validate dialog type
Q:'$G(DA(1))
N PXRMMTYP
S PXRMMTYP=$P($G(^PXRMD(801.41,DA(1),0)),U,4)
;MH results and Reminder dialogs dissallowed
S DIC("S")="I ""RST""'[$P(^(0),U,4)"
;Dialog elements can only contain prompts/forced values
I PXRMMTYP="E" S DIC("S")="I ""FP""[$P(^(0),U,4)"
;Reminder dialogs can contain only Elements and Groups
I PXRMMTYP="R" S DIC("S")="I ""EG""[$P(^(0),U,4)"
;MH Result Groups can only contain MH Result Elementss
I PXRMMTYP="S" S DIC("S")="I ""T""=$P(^(0),U,4)"
;Dialog groups cannot point to themselves
I PXRMMTYP="G" D
.;S DIC("S")=DIC("S")_",$G(Y)'=DA(1)"
.S DIC("S")=DIC("S")_",$G(Y)'=DA(1),$$VGROUP^PXRMDD41($G(Y),DA(1))=0"
Q
;
; UPDATE last amend date
SET(DLG) ;
S $P(^PXRMD(801.41,DLG,99),U)=$$NOW^XLFDT
Q
;
; -- Ck menu tree to ensure new item is not an ancestor
; Input Xform for Item field #2 of Items subfile #801.412
; expecting DA, DA(1), X from FileMan
TREE ;
D SCREEN
N PXRMDDA,PXRMDD S PXRMDDA=DA(1)
K:X=PXRMDDA X D TREE1
Q
; -- Look for X in ancestors
TREE1 F PXRMDD=0:0 Q:'$D(X) S PXRMDD=$O(^PXRMD(801.41,"AD",PXRMDDA,PXRMDD)) Q:PXRMDD'>0 K:X=PXRMDD X Q:'$D(X) D TREE2
Q
; Back up another level
TREE2 N PXRMDDA S PXRMDDA=PXRMDD N PXRMDD D TREE1
Q
;
VGROUP(DIEN,IEN) ;Check dialog index to see if group will point to itself
N FOUND
S FOUND=0
;
;Only do check if dialog is a group
I $P($G(^PXRMD(801.41,DIEN,0)),U,4)'="G" Q FOUND
;
;Group cannot be added to itself
I DIEN=IEN S FOUND=1 Q FOUND
;
;IEN is the dialog group being added to
D VGROUP1(DIEN,IEN)
Q FOUND
;
VGROUP1(DIEN,IEN) ;Examine all parent dialogs
;
;End search if already found
Q:FOUND
;
;Check if dialog being added is a parent at this level
I $D(^PXRMD(801.41,"AD",IEN,DIEN)) S FOUND=1 Q
;
;If not look at other parents
N SUB,TIEN
S SUB=0
F S SUB=$O(^PXRMD(801.41,"AD",IEN,SUB)) Q:'SUB D Q:FOUND
.;Ignore reminder dialogs
.I $P($G(^PXRMD(801.41,SUB,0)),U,4)'="G" Q
.;Repeat check on other parents
.D VGROUP1(DIEN,SUB)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDD41 2393 printed Oct 16, 2024@17:44:28 Page 2
PXRMDD41 ;SLC/PJH - Reminder Dialog file calls ;10/19/2015 09:13
+1 ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
+2 ;
+3 ;copied from ORDD41 for dialog reminders
KILL(DLG) ;
+1 QUIT
+2 ;
+3 ; Update audit trail when ITEMS changed
REDOX IF $DATA(^PXRMD(801.41,+$GET(DA(1)),0))
SET $PIECE(^(99),U)=$$NOW^XLFDT
+1 QUIT
+2 ;
SCREEN ;validate dialog type
+1 if '$GET(DA(1))
QUIT
+2 NEW PXRMMTYP
+3 SET PXRMMTYP=$PIECE($GET(^PXRMD(801.41,DA(1),0)),U,4)
+4 ;MH results and Reminder dialogs dissallowed
+5 SET DIC("S")="I ""RST""'[$P(^(0),U,4)"
+6 ;Dialog elements can only contain prompts/forced values
+7 IF PXRMMTYP="E"
SET DIC("S")="I ""FP""[$P(^(0),U,4)"
+8 ;Reminder dialogs can contain only Elements and Groups
+9 IF PXRMMTYP="R"
SET DIC("S")="I ""EG""[$P(^(0),U,4)"
+10 ;MH Result Groups can only contain MH Result Elementss
+11 IF PXRMMTYP="S"
SET DIC("S")="I ""T""=$P(^(0),U,4)"
+12 ;Dialog groups cannot point to themselves
+13 IF PXRMMTYP="G"
Begin DoDot:1
+14 ;S DIC("S")=DIC("S")_",$G(Y)'=DA(1)"
+15 SET DIC("S")=DIC("S")_",$G(Y)'=DA(1),$$VGROUP^PXRMDD41($G(Y),DA(1))=0"
End DoDot:1
+16 QUIT
+17 ;
+18 ; UPDATE last amend date
SET(DLG) ;
+1 SET $PIECE(^PXRMD(801.41,DLG,99),U)=$$NOW^XLFDT
+2 QUIT
+3 ;
+4 ; -- Ck menu tree to ensure new item is not an ancestor
+5 ; Input Xform for Item field #2 of Items subfile #801.412
+6 ; expecting DA, DA(1), X from FileMan
TREE ;
+1 DO SCREEN
+2 NEW PXRMDDA,PXRMDD
SET PXRMDDA=DA(1)
+3 if X=PXRMDDA
KILL X
DO TREE1
+4 QUIT
+5 ; -- Look for X in ancestors
TREE1 FOR PXRMDD=0:0
if '$DATA(X)
QUIT
SET PXRMDD=$ORDER(^PXRMD(801.41,"AD",PXRMDDA,PXRMDD))
if PXRMDD'>0
QUIT
if X=PXRMDD
KILL X
if '$DATA(X)
QUIT
DO TREE2
+1 QUIT
+2 ; Back up another level
TREE2 NEW PXRMDDA
SET PXRMDDA=PXRMDD
NEW PXRMDD
DO TREE1
+1 QUIT
+2 ;
VGROUP(DIEN,IEN) ;Check dialog index to see if group will point to itself
+1 NEW FOUND
+2 SET FOUND=0
+3 ;
+4 ;Only do check if dialog is a group
+5 IF $PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)'="G"
QUIT FOUND
+6 ;
+7 ;Group cannot be added to itself
+8 IF DIEN=IEN
SET FOUND=1
QUIT FOUND
+9 ;
+10 ;IEN is the dialog group being added to
+11 DO VGROUP1(DIEN,IEN)
+12 QUIT FOUND
+13 ;
VGROUP1(DIEN,IEN) ;Examine all parent dialogs
+1 ;
+2 ;End search if already found
+3 if FOUND
QUIT
+4 ;
+5 ;Check if dialog being added is a parent at this level
+6 IF $DATA(^PXRMD(801.41,"AD",IEN,DIEN))
SET FOUND=1
QUIT
+7 ;
+8 ;If not look at other parents
+9 NEW SUB,TIEN
+10 SET SUB=0
+11 FOR
SET SUB=$ORDER(^PXRMD(801.41,"AD",IEN,SUB))
if 'SUB
QUIT
Begin DoDot:1
+12 ;Ignore reminder dialogs
+13 IF $PIECE($GET(^PXRMD(801.41,SUB,0)),U,4)'="G"
QUIT
+14 ;Repeat check on other parents
+15 DO VGROUP1(DIEN,SUB)
End DoDot:1
if FOUND
QUIT
+16 QUIT
