source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCMEDT5.m@ 1141

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

initial load of WorldVistAEHR

File size: 5.6 KB
RevLine 
[613]1ORCMEDT5 ;SLC/MKB-Misc menu utilities ;03:29 PM 12 Feb 1999
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**8,46**;Dec 17, 1997
3SEARCH ; -- Search/replace menu items
4 N ORDLG
5 F S ORDLG=$$DIC Q:ORDLG'>0 D SR1(ORDLG) W !!
6 Q
7 ;
8SR1(ORX) ; -- list parents, get replacement
9 N DA,DR,DIE,DIK,I,J,ORDAD,ORY,ORNMBR,NUM,ORI,ORDAD,ORNM
10 I '$O(^ORD(101.41,"AD",+ORX,0)) W !,$P(ORX,U,2)_" has no ancestors." Q
11 W @IOF,"Ancestors of "_$P(ORX,U,2),!?4,"Name",?69,"Type",!,$$REPEAT^XLFSTR("-",79)
12 S (I,ORDAD)=0 F S I=$O(^ORD(101.41,"AD",+ORX,I)) Q:I'>0 D
13 . S J=0 F S J=$O(^ORD(101.41,"AD",+ORX,I,J)) Q:J'>0 D
14 . . S ORDAD=ORDAD+1,ORDAD(ORDAD)=I_U_J
15 . . W !,ORDAD,?4,$P(^ORD(101.41,I,0),U),?69,$$TYPE($P(^(0),U,4))
16 W !,$$REPEAT^XLFSTR("-",79)
17 S ORY=$$REPLWITH(ORX) Q:ORY="^"
18 D SELECT(ORY,ORDAD,.ORNMBR) Q:ORNMBR="^"
19 Q:'$$OK W !!,$S(ORY="@":"Removing",1:"Replacing "_$P(ORX,U,2)_" with "_$P(ORY,U,2))_" in:"
20 F ORI=1:1:$L(ORNMBR,",") S NUM=$P(ORNMBR,",",ORI) I NUM D
21 . S DA(1)=+ORDAD(NUM),DA=$P(ORDAD(NUM),U,2),DIE="^ORD(101.41,"_DA(1)_",10,"
22 . S ORDAD=DA(1),ORNM=$P(^ORD(101.41,ORDAD,0),U) W !?3,ORNM_" ..."
23 . I '$$VALID(ORY,ORDAD,.ORERR) D Q
24 . . W "not "_$S(ORY="@":"removed.",1:"changed."),!?3,">> "_$G(ORERR)
25 . . S I=0 F S I=$O(ORERR(I)) Q:I'>0 W !?25,"=>"_ORERR(I)
26 . I ORY="@" S DIK=DIE D ^DIK W "done." Q
27 . S DR="2////"_+ORY D ^DIE W $S($P(^ORD(101.41,DA(1),10,DA,0),U,2)=+ORY:"done.",1:"error - not replaced.")
28 Q
29 ;
30TYPE(X) ; -- Returns name of dialog type
31 N Y S Y=$S(X="P":"prompt",X="D":"dialog",X="Q":"quick order",X="O":"order set",X="M":"menu",X="A":"action",1:"")
32 Q Y
33 ;
34DIC() ; -- ^DIC on Order Dialog file
35 N X,Y,DIC
36 S DIC=101.41,DIC(0)="AEQM",DIC("A")="Search for: "
37 S DIC("?")="Enter the name of the dialog component you wish to search for."
38 D ^DIC
39 Q Y
40 ;
41SELECT(ORY,MAX,Y) ; -- Select which Dlgs to replace items
42 N X,DIR
43 S DIR(0)="LA^1:"_MAX,DIR("A")=$S(ORY="@":"Remove in: ",1:"Replace in: "),DIR("B")=$S(MAX>1:"1-"_MAX,1:"1")
44 ; S DIR("?")
45 D ^DIR S:$D(DTOUT)!(X["^") Y="^"
46 Q
47 ;
48OK() ; -- Are you ready?
49 N X,Y,DIR
50 S DIR(0)="YA",DIR("A")="Are you ready? ",DIR("B")="NO"
51 W ! D ^DIR
52 Q +Y
53 ;
54REPLWITH(ORIT) ; -- Remove item, or select replacement
55 N X,Y,DIR,DIC
56 S DIR(0)="FAO^1:63",DIR("A")="Replace "_$P(ORIT,U,2)_" with: "
57 S DIR("?")="Enter the name of the item you wish to replace this one with, or @ to remove this item; to quit without changing anything, press <return>."
58R1 D ^DIR I X="@" Q "@"
59 I $D(DTOUT)!("^"[X) Q "^"
60 S DIC=101.41,DIC(0)="EQM" D ^DIC I Y'>0 G R1
61 Q Y
62 ;
63VALID(ITM,DAD,ERR) ; -- Ck if ITM may be placed on DAD
64 N DTYPE,ITYPE,Y S Y=0
65 S DTYPE=$P(^ORD(101.41,DAD,0),U,4) I DTYPE="D",$$NMSP^ORCD($P(^(0),U,7))'="OR" S ERR="Only generic ordering dialogs are editable." G VQ
66 I ITM="@" S Y=1 G VQ ; ok to delete
67 S ITYPE=$P(^ORD(101.41,+ITM,0),U,4)
68 I ITYPE="P",DTYPE'="D" S ERR="A prompt may not be added to a "_$$TYPE(DTYPE)_"." G VQ
69 I ITYPE="A","DOM"'[DTYPE S ERR="An action may not be added to a "_$$TYPE(DTYPE)_"." G VQ
70 I "DQOM"[ITYPE,"OM"'[DTYPE S ERR="A "_$$TYPE(ITYPE)_" may not be added to a "_$$TYPE(DTYPE)_"." G VQ
71 D RECURSV(+ITM,DAD,.ERR) I $D(ERR) S Y=0 G VQ
72 S Y=1 ; ok
73VQ Q Y
74 ;
75RECURSV(ITEM,MENU,MSG) ; -- Return 1 or 0, if recursive reference to ITEM
76 N STACK,CNT S STACK=0,CNT=0
77 K MSG D CHKPAR(MENU)
78 Q
79CHKPAR(MENU) ; follow tree to check parents
80 N PMENU,I
81 S STACK=STACK+1,STACK(STACK)=MENU,STACK("B",MENU)=STACK,PMENU=0
82 F S PMENU=$O(^ORD(101.41,"AD",MENU,PMENU)) Q:'PMENU D Q:$D(MSG)
83 . I PMENU=ITEM D Q
84 . . S MSG="Recursive Reference: "_$P(^ORD(101.41,ITEM,0),U)
85 . . F I=STACK:-1:1 S CNT=CNT+1,MSG(CNT)=$P(^ORD(101.41,STACK(I),0),U)
86 . I $D(STACK("B",PMENU)) Q
87 . D CHKPAR(PMENU)
88 K STACK(STACK),STACK("B",MENU) S STACK=STACK-1
89 Q
90 ;
91INUSE(MENU) ; -- Returns 1 or 0, if MENU is in use by parameter
92 N PARAM,ENT,Y
93 S PARAM=$O(^XTV(8989.51,"B","OR ADD ORDERS MENU",0)),Y=0
94 S ENT="" F S ENT=$O(^XTV(8989.5,"AC",PARAM,ENT)) Q:ENT="" I $G(^(ENT,1))=MENU S Y=1 Q
95 Q Y
96 ;
97ASSIGN ; -- Assign menu to user(s)
98 D FULL^VALM1
99 D EDITPAR^XPAREDIT("OR ADD ORDERS MENU")
100 S VALMBCK="R"
101 Q
102 ;
103INQ ; -- Inquire to Order Dialog file
104 N X,Y,DIC,DA,DR,DIQ
105 S DIC="^ORD(101.41,",DIC(0)="AEQM"
106 F D ^DIC Q:Y'>0 S DA=+Y W ! D EN^DIQ W !
107 Q
108 ;
109OUTPUT(ORY) ; -- Output Xform for Value field of Response multiple
110 N ORDIALOG,ORP,ORZ S ORZ=ORY
111 S ORP=$P($G(^ORD(101.41,D0,6,D1,0)),U,2)
112 I ORP S ORDIALOG(ORP,0)=$P($G(^ORD(101.41,ORP,1)),U,1,2),ORDIALOG(ORP,1)=ORY,ORZ=$$EXT^ORCD(ORP,1)
113 Q ORZ
114 ;
115AOPAR ; -- List of add order menus assigned to users
116 N BY,DHD,DIC,FLDS,FR,TO
117 S DIC=8989.5
118 S FR="OR ADD ORDERS MENU,?",TO="OR ADD ORDERS MENU,?"
119 S BY="@.02,@1;S2;""Add order menu: """
120 S DHD="CPRS Add order menu list"
121 S FLDS="VALUE;N;""Menu"",ENTITY;""User/Location/etc."";C40"
122 D EN1^DIP
123 Q
124 ;
125DISABLE ; -- Disable order dialogs
126 N X,Y,DIC,DIR,ORDIS,ORI K ^TMP("ORDISABLE",$J)
127 S DIC=101.41,DIC(0)="AEQM",DIC("A")="Select ORDER DIALOG: ",DIC("?")="Enter the name of an order dialog you wish to disable."
128 S DIC("W")="I $L($P(^(0),U,3)) W !?3,"">> disabled: ""_$P(^(0),U,3)"
129 F D ^DIC Q:Y'>0 S ^TMP("ORDISABLE",$J,+Y)="" S DIC("A")="ANOTHER ONE: "
130 Q:'$O(^TMP("ORDISABLE",$J,0)) ;none selected
131 W !!,"Enter a message to disable the dialog(s), or @ to enable again."
132 S DIR(0)="FAO^1:40",DIR("A")="MESSAGE: "
133 S DIR("?")="Enter up to 40 characters explaining why use of this dialog has been disabled that will display if the dialog is selected, or @ to enable the dialog again."
134 D ^DIR G:$D(DTOUT)!$D(DUOUT)!(X="") DQ S ORDIS=X
135 I '$$OK W !,"Nothing "_$S(ORDIS="@":"en",1:"dis")_"abled." H 1 G DQ
136 S ORI=0 F S ORI=$O(^TMP("ORDISABLE",$J,ORI)) Q:ORI'>0 S $P(^ORD(101.41,ORI,0),U,3)=$S(ORDIS="@":"",1:ORDIS) W "."
137 W !,"done." H 1
138DQ K ^TMP("ORDISABLE",$J)
139 Q
Note: See TracBrowser for help on using the repository browser.