1 | PXRMDD41 ; SLC/PJH Reminder Dialog file calls ;11/22/2000
|
---|
2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
3 | ;
|
---|
4 | ;copied from ORDD41 for dialog reminders
|
---|
5 | ;
|
---|
6 | ;
|
---|
7 | KILL(DLG) ;
|
---|
8 | Q
|
---|
9 | ;
|
---|
10 | ; Update audit trail when ITEMS changed
|
---|
11 | REDOX I $D(^PXRMD(801.41,+$G(DA(1)),0)) S $P(^(99),U)=$$NOW^XLFDT
|
---|
12 | Q
|
---|
13 | ;
|
---|
14 | SCREEN ;validate dialog type
|
---|
15 | Q:'$G(DA(1))
|
---|
16 | N PXRMMTYP
|
---|
17 | S PXRMMTYP=$P($G(^PXRMD(801.41,DA(1),0)),U,4)
|
---|
18 | ;MH results and Reminder dialogs dissallowed
|
---|
19 | S DIC("S")="I ""RST""'[$P(^(0),U,4)"
|
---|
20 | ;Dialog elements can only contain prompts/forced values
|
---|
21 | I PXRMMTYP="E" S DIC("S")="I ""FP""[$P(^(0),U,4)"
|
---|
22 | ;Reminder dialogs can contain only Elements and Groups
|
---|
23 | I PXRMMTYP="R" S DIC("S")="I ""EG""[$P(^(0),U,4)"
|
---|
24 | ;MH Result Groups can only contain MH Result Elementss
|
---|
25 | I PXRMMTYP="S" S DIC("S")="I ""T""=$P(^(0),U,4)"
|
---|
26 | ;Dialog groups cannot point to themselves
|
---|
27 | I PXRMMTYP="G" D
|
---|
28 | .S DIC("S")=DIC("S")_"&($G(Y)'=DA(1))"
|
---|
29 | Q
|
---|
30 | ;
|
---|
31 | ; UPDATE last amend date
|
---|
32 | SET(DLG) ;
|
---|
33 | S $P(^PXRMD(801.41,DLG,99),U)=$$NOW^XLFDT
|
---|
34 | Q
|
---|
35 | ;
|
---|
36 | ; -- Ck menu tree to ensure new item is not an ancestor
|
---|
37 | ; Input Xform for Item field #2 of Items subfile #801.412
|
---|
38 | ; expecting DA, DA(1), X from FileMan
|
---|
39 | TREE ;
|
---|
40 | D SCREEN
|
---|
41 | N PXRMDDA,PXRMDD S PXRMDDA=DA(1)
|
---|
42 | K:X=PXRMDDA X D TREE1
|
---|
43 | Q
|
---|
44 | ; -- Look for X in ancestors
|
---|
45 | 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
|
---|
46 | Q
|
---|
47 | ; Back up another level
|
---|
48 | TREE2 N PXRMDDA S PXRMDDA=PXRMDD N PXRMDD D TREE1
|
---|
49 | Q
|
---|