source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDD41.m@ 794

Last change on this file since 794 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1PXRMDD41 ; 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 ;
7KILL(DLG) ;
8 Q
9 ;
10 ; Update audit trail when ITEMS changed
11REDOX I $D(^PXRMD(801.41,+$G(DA(1)),0)) S $P(^(99),U)=$$NOW^XLFDT
12 Q
13 ;
14SCREEN ;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
32SET(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
39TREE ;
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
45TREE1 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
48TREE2 N PXRMDDA S PXRMDDA=PXRMDD N PXRMDD D TREE1
49 Q
Note: See TracBrowser for help on using the repository browser.